From 8efdb3f90d3d8ba849fd5e009d4f8e6868718929 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 4 Dec 2017 09:36:21 -0700 Subject: [PATCH 01/61] Added an inversion scheme to estimate traction parameters and bmlt_float This is the first version of a scheme to invert for basal traction parameters and sub-shelf melting by relaxing the ice toward a target ice thickness. The method is similar to that of Pollard & DeConto (2012). I added a new config option, which_ho_inversion, with three values: (0) HO_INVERSION_NONE. Default behavior; code works as before. (1) HO_INVERSION_COMPUTE. Compute basal traction parameters C_p and C_c, aka powerlaw_c and coulomb_c, for each grid cell so as to relax the ice thickness (thck) toward the observed thickness (thck_obs) read from the input file. At the same time, compute a bmlt_float field that restores the thickness of floating cells to thck_obs each time step. (2) HO_INVERSION_PRESCRIBE. For grounded grid cells, use C_p and C_c as computed from a previous inversion and read from the input file. For floating cells, use bmlt_float from a previous inversion. Option (1), but not (2), is implemented with this commit. It works for the Schoof basal sliding law (which_ho_babc = 11), but not for other sliding laws. It could be implemented later for the Tsai sliding law. To implement this option, I added several 2D fields which can be included in I/O: - thck_obs = observational target thickness field - powerlaw_c_2d = 2D field of C_p - coulomb_c_2d = 2D field of C_c Recall that for the Schoof law, C_p dominates (giving power-law behavior) in most regions, but C_C can dominate (giving Coulomb behavior) where N is small and u is large (e.g., near the grounding line). The target thickness, thck_obs, can be read from the input file. If this field is not present in the input file, CISM sets thck_obs = thck at initialization. The powerlaw_c_2d field can also be read from the input file. If not present, CISM sets it to a sensible default value, basal_physics%powerlaw_c (a constant already used for the Schoof sliding law). During the run, powerlaw_c_2d is prognosed, and then couloumb_c_2d is diagnosed as powerlaw_c_2d/powerlaw_coulomb_ratio, where the ratio is a prescribed parameter. Then coulomb_c_2d is limited to be <= 1, so the basal shear stress will not exceed the effective pressure N. I added a new subroutine, calc_basal_inversion, to prognose C_p during the run. Evolution of C_p is described by dC_p/dt = (C_p/t_inv) * [-(H - H_obs)/H_inv - dH_dt/dH_dt_inv]. Here, t_inv is a time scale for inversion H_inv is a thickness scale (set to 50 m for now) dH_dt_inv is a growth rate scale If the ice is thicker than the target, and/or the thickness is increasing, C_p decreases to make the bed more slippery and reduce the thickness. If the ice is thinner than the target, and/or the thickness is decreasing, C_p increases to make the bed rougher and increase the thickness. The two terms in brackets can compete with each other, with their relative strength controlled by the parameters H_inv and dH_dt_inv. After C_p is computed, it is smoothed with a Laplacian smoother that suppresses B-grid noise and speeds convergence. The smoother has a factor that determines how strong the smoothing is. For relatively strong 4-1-1-1-1 smoothing, this factor would be 0.125. With smaller values, the values in neighboring edge cells have smaller weights. I set the default value to 0.05, which usually is large enough to suppress noise. Once the inversion has run for a while and the C_p field is sufficiently smooth, it may be desirable to continue the inversion with a smaller smoothing factor. With a large factor, spatial gradients in C_p cannot be as large. As a result, it may not be possible to adjust C_p to its optimal value. In some cases the smoothing may be strong enough to reverse the sign of the change in C_p. For instance, the thickness error may call for reducing C_p, but if the cell lies in a "bowl" of low C_p, the smoother may push C_p in the opposite direction. In this case, C_p is held fixed. That is, the smoother can halt the decline, but it is not allowed to drive C_p in the other direction. It is assumed that C_p and C_c are independent of basal temperature and basal water depth. Any dependence of basal stress on basal temperature or water depth would be included in N, or implicitly in the basal velocity. There are several new config parameters for inversion. Parameters and default values are: * t_inv = 200 yr * H_inv = 50 m * dH_dt_inv = 0.5 m/yr * powerlaw_c_min = 2.e3 Pa (m/yr)^(-1/3) * powerlaw_c_max = 1.e5 Pa (m/yr)^(-1/3) * powerlaw_coulomb_ratio = 2.e4 Pa (m/yr)^(-1/3) * smoothing factor = 0.05 These values give good results for a MISMIP+ test case but may not be optimal for more realistic problems. The scheme is intended for application to marine ice sheets, not just land-based ice. In order to get good behavior near the GL, I found that where the observed ice is floating, I needed to prescribe basal melting to maintain thck = thck_obs. Where the observed ice is grounded, the thickness is free to evolve. For some experiments, initially grounded ice becomes floating, but it later re-grounds, provided the run is reasonably well behaved. I applied the inversion scheme to a MISMIP+ problem spun up for 20 ka using the Schoof sliding law, with N computed as in Leguy et al. (2014) using p = 1. The spinup has C_p = 10000 Pa (m/yr)^(-1/3) and C_c = 0.50 everywhere. I initialized C_p to values ranging from 5000 to 20000. I verified that over several millennia, C_p and C_c gradually converge to the MISMIP+ values, with thck converging to thck_obs to a very good approximation. After ~2 ka, thck - thck_obs << 1 m everywhere, and C_p is within << 1% of the target value. Minor changes: - I changed HO_BABC_COULOMB_CONST_BASAL_FLWA to HO_BABC_COULOMB_POWERLAW_SCHOOF. For a while, we've been referring to this sliding law as the Schoof law. - I changed 'coulomb_C' to 'coulomb_c' and 'powerlaw_C' to 'powerlaw_c' wherever they appear. Bill Sacks pointed out that config parameters with upper-case characters can be mishandled. Answers change only for configurations using the new inversion option. Future work: (1) Support inversion for the Tsai sliding law in addition to Schoof. (2) Implement and test which_ho_inversion = 2: Prescribe 2D fields of C_p and C_c based on values obtained from inversion. (3) Apply to problems with prognostic temperature. (MISMIP+ has temperature and flwa prescribed.) (4) Apply to more realistic geometry (e.g., all Antarctica). (5) Optimize the inversion parameters. --- libglide/glam_strs2.F90 | 4 +- libglide/glide_setup.F90 | 121 +++++-- libglide/glide_types.F90 | 99 ++++- libglide/glide_vars.def | 33 ++ libglissade/glissade.F90 | 276 ++++++++++++-- libglissade/glissade_basal_traction.F90 | 462 +++++++++++++++++++++--- libglissade/glissade_calving.F90 | 70 ++-- libglissade/glissade_transport.F90 | 9 +- libglissade/glissade_velo_higher.F90 | 39 +- 9 files changed, 944 insertions(+), 169 deletions(-) diff --git a/libglide/glam_strs2.F90 b/libglide/glam_strs2.F90 index fabd4d16..359b468a 100644 --- a/libglide/glam_strs2.F90 +++ b/libglide/glam_strs2.F90 @@ -3386,7 +3386,7 @@ subroutine bodyset(ew, ns, up, & elseif( whichbabc == HO_BABC_BETA_CONSTANT .or. whichbabc == HO_BABC_YIELD_PICARD .or. & whichbabc == HO_BABC_BETA_LARGE .or. whichbabc == HO_BABC_BETA_EXTERNAL .or. & whichbabc == HO_BABC_POWERLAW .or. whichbabc == HO_BABC_COULOMB_FRICTION .or. & - whichbabc == HO_BABC_COULOMB_CONST_BASAL_FLWA .or. whichbabc == HO_BABC_SIMPLE) then + whichbabc == HO_BABC_COULOMB_POWERLAW_SCHOOF .or. whichbabc == HO_BABC_SIMPLE) then bcflag = (/1,1/) ! flag for specififed stress at bed: Tau_zx = beta * u_bed, ! where beta is MacAyeal-type traction parameter @@ -3601,7 +3601,7 @@ subroutine bodyset(ew, ns, up, & elseif( whichbabc == HO_BABC_BETA_CONSTANT .or. whichbabc == HO_BABC_YIELD_PICARD .or. & whichbabc == HO_BABC_BETA_LARGE .or. whichbabc == HO_BABC_BETA_EXTERNAL .or. & whichbabc == HO_BABC_POWERLAW .or. whichbabc == HO_BABC_COULOMB_FRICTION .or. & - whichbabc == HO_BABC_COULOMB_CONST_BASAL_FLWA .or. whichbabc == HO_BABC_SIMPLE) then + whichbabc == HO_BABC_COULOMB_POWERLAW_SCHOOF .or. whichbabc == HO_BABC_SIMPLE) then bcflag = (/1,1/) ! flag for specififed stress at bed: Tau_zx = beta * u_bed, ! where beta is MacAyeal-type traction parameter diff --git a/libglide/glide_setup.F90 b/libglide/glide_setup.F90 index 164848a7..16b0ec7c 100644 --- a/libglide/glide_setup.F90 +++ b/libglide/glide_setup.F90 @@ -207,6 +207,10 @@ subroutine glide_scale_params(model) model%basal_melt%bmlt_float_omega = model%basal_melt%bmlt_float_omega / scyr model%basal_melt%bmlt_float_const = model%basal_melt%bmlt_float_const / scyr + ! scale basal inversion parameters + model%basal_physics%inversion_timescale = model%basal_physics%inversion_timescale * scyr + model%basal_physics%inversion_dthck_dt_scale = model%basal_physics%inversion_dthck_dt_scale / scyr + ! scale SMB/acab parameters model%climate%overwrite_acab_value = model%climate%overwrite_acab_value*tim0/(scyr*thk0) model%climate%overwrite_acab_minthck = model%climate%overwrite_acab_minthck / thk0 @@ -610,6 +614,7 @@ subroutine handle_ho_options(section, model) call GetValue(section, 'which_ho_disp', model%options%which_ho_disp) call GetValue(section, 'which_ho_thermal_timestep', model%options%which_ho_thermal_timestep) call GetValue(section, 'which_ho_babc', model%options%which_ho_babc) + call GetValue(section, 'which_ho_inversion', model%options%which_ho_inversion) call GetValue(section, 'which_ho_bwat', model%options%which_ho_bwat) call GetValue(section, 'which_ho_effecpress', model%options%which_ho_effecpress) call GetValue(section, 'which_ho_resid', model%options%which_ho_resid) @@ -818,6 +823,11 @@ subroutine print_options(model) 'power law using effective pressure ', & 'simple pattern of beta ' /) + character(len=*), dimension(0:2), parameter :: ho_whichinversion = (/ & + 'no inversion for basal parameters or melting ', & + 'invert for basal parameters and subshelf melting ', & + 'prescribe parameters from previous inversion ' /) + character(len=*), dimension(0:2), parameter :: ho_whichbwat = (/ & 'zero basal water depth ', & 'constant basal water depth ', & @@ -1292,6 +1302,30 @@ subroutine print_options(model) call write_log('Error, HO basal BC input out of range', GM_FATAL) end if + write(message,*) 'ho_whichinversion : ',model%options%which_ho_inversion, & + ho_whichinversion(model%options%which_ho_inversion) + call write_log(message) + if (model%options%which_ho_inversion < 0 .or. & + model%options%which_ho_inversion >= size(ho_whichinversion)) then + call write_log('Error, HO basal inversion input out of range', GM_FATAL) + end if + + ! Note: Inversion is currently supported only for Schoof sliding law + ! TODO - Support for Tsai law also + if (model%options%which_ho_inversion /= 0) then +! if (model%options%which_ho_babc == HO_BABC_COULOMB_POWERLAW_SCHOOF .or. & +! model%options%which_ho_babc == HO_BABC_COULOMB_POWERLAW_TSAI) then + if (model%options%which_ho_babc == HO_BABC_COULOMB_POWERLAW_SCHOOF) then + ! inversion is supported + else + call write_log('Error, basal inversion is not supported for this basal BC option') + write(message,*) 'Inversion is supported for which_ho_babc =', & +! HO_BABC_COULOMB_POWERLAW_SCHOOF, ' or ', HO_BABC_COULOMB_POWERLAW_TSAI + HO_BABC_COULOMB_POWERLAW_SCHOOF + call write_log(message, GM_FATAL) + endif + endif + ! unsupported ho-babc options !TODO - Decide if some of these are now supported? if (model%options%which_ho_babc == HO_BABC_YIELD_NEWTON) then @@ -1302,11 +1336,6 @@ subroutine print_options(model) call write_log('Weertman-style power law higher-order basal boundary condition is not currently scientifically & &supported. USE AT YOUR OWN RISK.', GM_WARNING) endif - if (model%options%which_ho_babc == HO_BABC_COULOMB_FRICTION .or. & - model%options%which_ho_babc == HO_BABC_COULOMB_CONST_BASAL_FLWA) then - call write_log('Coulomb friction law higher-order basal boundary condition is not currently scientifically supported. & - &USE AT YOUR OWN RISK.', GM_WARNING) - endif write(message,*) 'ho_whichbwat : ',model%options%which_ho_bwat, & ho_whichbwat(model%options%which_ho_bwat) @@ -1574,21 +1603,27 @@ subroutine handle_parameters(section, model) call GetValue(section,'ho_beta_small', model%basal_physics%ho_beta_small) call GetValue(section,'ho_beta_large', model%basal_physics%ho_beta_large) - ! basal physics parameters + ! basal friction parameters call GetValue(section, 'friction_powerlaw_k', model%basal_physics%friction_powerlaw_k) - call GetValue(section, 'coulomb_c', model%basal_physics%Coulomb_C) - call GetValue(section, 'coulomb_bump_max_slope', model%basal_physics%Coulomb_Bump_max_slope) - call GetValue(section, 'coulomb_bump_wavelength', model%basal_physics%Coulomb_bump_wavelength) + call GetValue(section, 'coulomb_c', model%basal_physics%coulomb_c) + call GetValue(section, 'coulomb_bump_max_slope', model%basal_physics%coulomb_bump_max_slope) + call GetValue(section, 'coulomb_bump_wavelength', model%basal_physics%coulomb_bump_wavelength) call GetValue(section, 'flwa_basal', model%basal_physics%flwa_basal) - call GetValue(section, 'powerlaw_c', model%basal_physics%powerlaw_C) + call GetValue(section, 'powerlaw_c', model%basal_physics%powerlaw_c) call GetValue(section, 'powerlaw_m', model%basal_physics%powerlaw_m) + + ! effective pressure parameters call GetValue(section, 'p_ocean_penetration', model%basal_physics%p_ocean_penetration) call GetValue(section, 'effecpress_delta', model%basal_physics%effecpress_delta) call GetValue(section, 'effecpress_bpmp_threshold', model%basal_physics%effecpress_bpmp_threshold) call GetValue(section, 'effecpress_bmlt_threshold', model%basal_physics%effecpress_bmlt_threshold) + + ! basal water parameters call GetValue(section, 'const_bwat', model%basal_physics%const_bwat) call GetValue(section, 'bwat_till_max', model%basal_physics%bwat_till_max) call GetValue(section, 'c_drainage', model%basal_physics%c_drainage) + + ! pseudo-plastic parameters call GetValue(section, 'pseudo_plastic_q', model%basal_physics%pseudo_plastic_q) call GetValue(section, 'pseudo_plastic_u0', model%basal_physics%pseudo_plastic_u0) call GetValue(section, 'pseudo_plastic_phimin', model%basal_physics%pseudo_plastic_phimin) @@ -1596,6 +1631,14 @@ subroutine handle_parameters(section, model) call GetValue(section, 'pseudo_plastic_bedmin', model%basal_physics%pseudo_plastic_bedmin) call GetValue(section, 'pseudo_plastic_bedmax', model%basal_physics%pseudo_plastic_bedmax) + ! basal inversion parameters + call GetValue(section, 'powerlaw_c_max', model%basal_physics%powerlaw_c_max) + call GetValue(section, 'powerlaw_c_min', model%basal_physics%powerlaw_c_min) + call GetValue(section, 'powerlaw_coulomb_ratio', model%basal_physics%powerlaw_coulomb_ratio) + call GetValue(section, 'inversion_timescale', model%basal_physics%inversion_timescale) + call GetValue(section, 'inversion_thck_scale', model%basal_physics%inversion_thck_scale) + call GetValue(section, 'inversion_dthck_dt_scale', model%basal_physics%inversion_dthck_dt_scale) + ! ISMIP-HOM parameters call GetValue(section,'periodic_offset_ew',model%numerics%periodic_offset_ew) call GetValue(section,'periodic_offset_ns',model%numerics%periodic_offset_ns) @@ -1867,31 +1910,48 @@ subroutine print_parameters(model) call write_log('Error, must have ewn = nsn for ISMIP-HOM test C', GM_FATAL) endif elseif (model%options%which_ho_babc == HO_BABC_POWERLAW) then - write(message,*) 'C coefficient for power law, Pa (m/yr)^(-1/3): ', model%basal_physics%powerlaw_C + write(message,*) 'C coefficient for power law, Pa (m/yr)^(-1/3): ', model%basal_physics%powerlaw_c call write_log(message) write(message,*) 'm exponent for power law : ', model%basal_physics%powerlaw_m call write_log(message) - elseif (model%options%which_ho_babc == HO_BABC_COULOMB_FRICTION .or. & - model%options%which_ho_babc == HO_BABC_COULOMB_CONST_BASAL_FLWA) then - write(message,*) 'C coefficient for Coulomb friction law : ', model%basal_physics%Coulomb_C + elseif (model%options%which_ho_babc == HO_BABC_COULOMB_FRICTION) then + write(message,*) 'C coefficient for Coulomb friction law : ', model%basal_physics%coulomb_c + call write_log(message) + write(message,*) 'bed bump max slope for Coulomb friction law : ', model%basal_physics%coulomb_bump_max_slope call write_log(message) - write(message,*) 'bed bump max. slope for Coulomb friction law : ', model%basal_physics%Coulomb_Bump_max_slope + write(message,*) 'bed bump wavelength for Coulomb friction law : ', model%basal_physics%coulomb_bump_wavelength call write_log(message) - write(message,*) 'bed bump wavelength for Coulomb friction law : ', model%basal_physics%Coulomb_bump_wavelength + elseif (model%options%which_ho_babc == HO_BABC_COULOMB_POWERLAW_SCHOOF) then + write(message,*) 'C coefficient for Coulomb friction law : ', model%basal_physics%coulomb_c call write_log(message) - if (model%options%which_ho_babc == HO_BABC_COULOMB_CONST_BASAL_FLWA) then - write(message,*) 'constant basal flwa for Coulomb friction law : ', model%basal_physics%flwa_basal + write(message,*) 'C coefficient for power law, Pa (m/yr)^(-1/3): ', model%basal_physics%powerlaw_c + call write_log(message) + write(message,*) 'm exponent for power law : ', model%basal_physics%powerlaw_m + call write_log(message) + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then + call write_log(' NOTE: powerlaw_c and coulomb_c will be modified by inversion') + write(message,*) 'powerlaw_c max, Pa (m/yr)^(-1/3) : ', model%basal_physics%powerlaw_c_max + call write_log(message) + write(message,*) 'powerlaw_c min, Pa (m/yr)^(-1/3) : ', model%basal_physics%powerlaw_c_min + call write_log(message) + write(message,*) 'powerlaw_c/coulomb_c ratio : ', model%basal_physics%powerlaw_coulomb_ratio + call write_log(message) + write(message,*) 'inversion timescale (yr) : ', model%basal_physics%inversion_timescale + call write_log(message) + write(message,*) 'inversion thickness scale (m) : ', model%basal_physics%inversion_thck_scale + call write_log(message) + write(message,*) 'inversion dthck/dt scale (m/yr) : ', model%basal_physics%inversion_dthck_dt_scale call write_log(message) endif elseif (model%options%which_ho_babc == HO_BABC_COULOMB_POWERLAW_TSAI) then - write(message,*) 'C coefficient for Coulomb friction law : ', model%basal_physics%Coulomb_C + write(message,*) 'C coefficient for Coulomb friction law : ', model%basal_physics%coulomb_c call write_log(message) - write(message,*) 'C coefficient for power law, Pa (m/yr)^(-1/3): ', model%basal_physics%powerlaw_C + write(message,*) 'C coefficient for power law, Pa (m/yr)^(-1/3): ', model%basal_physics%powerlaw_c call write_log(message) write(message,*) 'm exponent for power law : ', model%basal_physics%powerlaw_m call write_log(message) elseif (model%options%which_ho_babc == HO_BABC_POWERLAW_EFFECPRESS) then - !TODO - Use powerlaw_C instead of friction_powerlaw_k? Allow p and q to be set in config file instead of hard-wired? + !TODO - Use powerlaw_c instead of friction_powerlaw_k? Allow p and q to be set in config file instead of hard-wired? write(message,*) 'roughness parameter, k, for power-law friction law : ',model%basal_physics%friction_powerlaw_k call write_log(message) endif @@ -2299,9 +2359,9 @@ subroutine define_glide_restart_variables(options) end select ! smb_input - ! If bmlt_float is read from an external file at startup, then it needs to be in the restart file select case (options%whichbmlt_float) + ! If bmlt_float is read from an external file at startup, then it needs to be in the restart file case (BMLT_FLOAT_EXTERNAL) call glide_add_to_restart_variable_list('bmlt_float_external') @@ -2456,7 +2516,7 @@ subroutine define_glide_restart_variables(options) ! basal sliding option select case (options%which_ho_babc) - case (HO_BABC_POWERLAW, HO_BABC_COULOMB_FRICTION, HO_BABC_COULOMB_CONST_BASAL_FLWA) + case (HO_BABC_POWERLAW, HO_BABC_COULOMB_FRICTION, HO_BABC_COULOMB_POWERLAW_SCHOOF) ! These friction laws need effective pressure !TODO - Does effecpress need to be a restart variable? call glide_add_to_restart_variable_list('effecpress') @@ -2472,6 +2532,21 @@ subroutine define_glide_restart_variables(options) call glide_add_to_restart_variable_list('beta') end select + ! basal inversion option + select case(options%which_ho_inversion) + case (HO_INVERSION_COMPUTE, HO_INVERSION_PRESCRIBED) + ! If computing powerlaw_c_2d by inversion, this field is needed for restart. + ! Also needed if prescribing powerlaw_c_2d from a previous inversion. + ! Note: coulomb_c_2d is not a restart field, since the ratio powerlaw_c/coulomb_c is fixed. + call glide_add_to_restart_variable_list('powerlaw_c_2d') + end select + + ! If inverting for basal parameters and/or subshelf melting based on thck_obs, + ! then thck_obs needs to be in the restart file; + if (options%which_ho_inversion == HO_INVERSION_COMPUTE) then + call glide_add_to_restart_variable_list('thck_obs') + endif + ! geothermal heat flux option select case (options%gthf) case(GTHF_COMPUTE) diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index c9c5ef32..2bcab45b 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -216,11 +216,15 @@ module glide_types integer, parameter :: HO_BABC_ISHOMC = 8 integer, parameter :: HO_BABC_POWERLAW = 9 integer, parameter :: HO_BABC_COULOMB_FRICTION = 10 - integer, parameter :: HO_BABC_COULOMB_CONST_BASAL_FLWA = 11 + integer, parameter :: HO_BABC_COULOMB_POWERLAW_SCHOOF = 11 integer, parameter :: HO_BABC_COULOMB_POWERLAW_TSAI = 12 integer, parameter :: HO_BABC_POWERLAW_EFFECPRESS = 13 integer, parameter :: HO_BABC_SIMPLE = 14 + integer, parameter :: HO_INVERSION_NONE = 0 + integer, parameter :: HO_INVERSION_COMPUTE = 1 + integer, parameter :: HO_INVERSION_PRESCRIBED = 2 + integer, parameter :: HO_BWAT_NONE = 0 integer, parameter :: HO_BWAT_CONSTANT = 1 integer, parameter :: HO_BWAT_LOCAL_TILL = 2 @@ -607,6 +611,15 @@ module glide_types !> \item[14] simple hard-coded pattern (useful for debugging) !> \end{description} + integer :: which_ho_inversion + !> Flag for basal traction inversion options + !> Note: Inversion is currently supported for which_ho_babc = 11 only + !> \begin{description} + !> \item[0] no inversion + !> \item[1] invert for basal traction parameters and subshelf melting + !> \item[2] apply parameters and subshelf melting from previous inversion + !> \end{description} + integer :: which_ho_bwat = 0 !> Basal water depth: !> \begin{description} @@ -817,6 +830,9 @@ module glide_types real(dp),dimension(:,:),pointer :: topg => null() !> The elevation of the topography, divided by \texttt{thk0}. + real(dp),dimension(:,:),pointer :: thck_obs => null() + !> Observed ice thickness, divided by \texttt{thk0}. + real(dp),dimension(:,:),pointer :: f_flotation => null() !> flotation function, (rhoi*thck) / (-rhoo*(topg-eus)) !> previously was f_pattyn = -rhoo*(topg-eus)/(rhoi*thck) @@ -1237,14 +1253,20 @@ module glide_types ! The other fields are used in Glissade only. ! bmlt fields for grounded and floating ice - real(dp),dimension(:,:), pointer :: bmlt => null() !> Basal melt rate (> 0 for melt, < 0 for freeze-on) - !> bmlt = bmlt_ground + bmlt_float - real(dp),dimension(:,:), pointer :: bmlt_applied => null() !> Basal melt rate applied to ice - !> = 0 for ice-free cells with bmlt > 0 - real(dp),dimension(:,:), pointer :: bmlt_ground => null() !> Basal melt rate for grounded ice - real(dp),dimension(:,:), pointer :: bmlt_float => null() !> basal melt rate for floating ice - real(dp),dimension(:,:), pointer :: bmlt_float_external => null() !> External basal melt rate field - real(dp),dimension(:,:), pointer :: bmlt_float_anomaly => null() !> Basal melt rate anomaly field + real(dp), dimension(:,:), pointer :: & + bmlt => null(), & !> basal melt rate (> 0 for melt, < 0 for freeze-on) + !> bmlt = bmlt_ground + bmlt_float + bmlt_applied => null(), & !> basal melt rate applied to ice + !> = 0 for ice-free cells with bmlt > 0 + bmlt_ground => null(), & !> basal melt rate for grounded ice + bmlt_float => null(), & !> basal melt rate for floating ice + bmlt_float_external => null(), & !> external basal melt rate field + bmlt_float_anomaly => null(), & !> basal melt rate anomaly field + bmlt_float_inversion => null() !> basal melt rate computed by inversion; + !> relaxes thickness of floating ice toward observed target + + integer, dimension(:,:), pointer :: & + bmlt_inversion_mask => null() !> = 1 where bmlt is applied for inversion, else = 0 real(dp) :: bmlt_float_factor = 1.0d0 !> adjustment factor for external bmlt_float field @@ -1264,8 +1286,8 @@ module glide_types !> set to 480 km for MISMIP+ Ice2r ! initMIP-Antarctica parameters - real(dp) :: bmlt_anomaly_timescale = 0.0d0 !> number of years over which the bmlt_float anomaly is phased in linearly - !> If set to zero, then the anomaly is applied immediately. + real(dp) :: bmlt_anomaly_timescale = 0.0d0 !> number of years over which the bmlt_float anomaly is phased in linearly + !> If set to zero, then the anomaly is applied immediately. end type glide_basal_melt @@ -1339,6 +1361,8 @@ module glide_types real(dp), dimension(:,:), pointer :: C_space_factor => null() !< spatial factor for basal shear stress (no dimension) real(dp), dimension(:,:), pointer :: C_space_factor_stag => null() !< spatial factor for basal shear stress on staggered grid (no dimension) real(dp), dimension(:,:), pointer :: tau_c => null() !< yield stress for plastic sliding (Pa) + real(dp), dimension(:,:), pointer :: powerlaw_c_2d => null() !< spatially varying powerlaw_c field, Pa m^(-1/3) yr^(1/3) + real(dp), dimension(:,:), pointer :: coulomb_c_2d => null() !< spatially varying coulomb_c field (unitless) ! parameters for reducing the effective pressure where the bed is warm, saturated or connected to the ocean real(dp) :: effecpress_delta = 0.02d0 !< multiplier for effective pressure N where the bed is saturated and/or thawed (unitless) @@ -1366,23 +1390,38 @@ module glide_types !< The default value is from Bindschadler (1983) based on fits to observations, converted to CISM units. ! parameters for Coulomb friction sliding law (default values from Pimentel et al. 2010) - real(dp) :: Coulomb_C = 0.42d0 !< basal stress constant (no dimension) - !< Pimentel et al. have Coulomb_C = 0.84*m_max, where m_max = Coulomb_Bump_max_slope - real(dp) :: Coulomb_bump_wavelength = 2.0d0 !< bed rock wavelength at subgrid scale precision (m) - real(dp) :: Coulomb_bump_max_slope = 0.5d0 !< maximum bed bump slope at subgrid scale precision (no dimension) - real(dp) :: flwa_basal = 1.0d-16 !< Glen's A at the bed for the Schoof (2005) Coulomb friction law, in units Pa^{-n} yr^{-1} + real(dp) :: coulomb_c = 0.42d0 !< basal stress constant (no dimension) + !< Pimentel et al. have coulomb_c = 0.84*m_max, where m_max = coulomb_bump_max_slope + real(dp) :: coulomb_bump_wavelength = 2.0d0 !< bedrock wavelength at subgrid scale precision (m) + real(dp) :: coulomb_bump_max_slope = 0.5d0 !< maximum bed bump slope at subgrid scale precision (no dimension) + real(dp) :: flwa_basal = 1.0d-16 !< Glen's A at the bed for Schoof (2005) Coulomb friction law (Pa^{-n} yr^{-1}) !< = 3.1688d-24 Pa{-n} s{-1}, the value used by Leguy et al. (2014) ! parameters for power law, taub_b = C * u_b^(1/m); used for HO_BABC_COULOMB_POWERLAW_TSAI ! The default values are from Asay-Davis et al. (2016). - ! The value of powerlaw_C suggested by Tsai et al. (2015) is 7.624d6 Pa m^(-1/3) s^(1/3). + ! The value of powerlaw_c suggested by Tsai et al. (2015) is 7.624d6 Pa m^(-1/3) s^(1/3). ! This value can be converted to CISM units by dividing by scyr^(1/3), to obtain 2.413d4 Pa m^(-1/3) yr^(1/3). - ! Note: The Tsai et al. Coulomb friction law uses Coulomb_C above, with + ! Note: The Tsai et al. Coulomb friction law uses coulomb_c above, with ! effective pressure N as in Leguy et al. (2014) with p_ocean_penetration = 1. - real(dp) :: powerlaw_C = 1.0d4 !< friction coefficient in power law, units of Pa m^(-1/3) yr^(1/3) + real(dp) :: powerlaw_c = 1.0d4 !< friction coefficient in power law, units of Pa m^(-1/3) yr^(1/3) real(dp) :: powerlaw_m = 3.d0 !< exponent in power law (unitless) + ! parameters for inversion of basal friction coefficients + ! Note: These values work well for MISMIP+, but may not be optimal for whole ice sheets. + ! Note: inversion_timescale and inversion_dthck_dt_scale are later rescaled to SI units (s and m/s). + + real(dp) :: & + powerlaw_c_max = 1.0d5, & !< Pa (m/yr)^(-1/3) + powerlaw_c_min = 2.0d3, & !< Pa (m/yr)^(-1/3) + powerlaw_coulomb_ratio = 2.0d4 !< powerlaw_c/coulomb_c (same units as powerlaw_c)) + + real(dp) :: & + inversion_timescale = 200.d0, & !< inversion timescale (yr); must be > 0 + inversion_thck_scale = 50.d0, & !< thickness inversion scale (m); must be > 0 + inversion_dthck_dt_scale = 0.50d0, & !< dthck_dt inversion scale (m/yr); must be > 0 + inversion_smoothing_factor = 0.05d0 !< factor for smoothing powerlaw_c (larger => more smoothing) + ! parameter for constant basal water ! Note: This parameter applies to HO_BWAT_CONSTANT only. ! For Glide's BWATER_CONST, the constant value is hardwired in subroutine calcbwat. @@ -1804,6 +1843,8 @@ subroutine glide_allocarr(model) !> \item \texttt{bmlt_float(ewn,nsn)} !> \item \texttt{bmlt_float_external(ewn,nsn)} !> \item \texttt{bmlt_float_anomaly(ewn,nsn)} + !> \item \texttt{bmlt_float_inversion(ewn,nsn)} + !> \item \texttt{bmlt_inversion_mask(ewn,nsn)} !> \end{itemize} !> In \texttt{model\%plume}: @@ -1863,6 +1904,7 @@ subroutine glide_allocarr(model) !> \item \texttt{usrf(ewn,nsn))} !> \item \texttt{lsrf(ewn,nsn))} !> \item \texttt{topg(ewn,nsn))} + !> \item \texttt{thck_obs(ewn,nsn))} !> \item \texttt{mask(ewn,nsn))} !> \item \texttt{age(upn-1,ewn,nsn))} !> \item \texttt{tracers(ewn,nsn,ntracers,upn-1)} @@ -2067,6 +2109,7 @@ subroutine glide_allocarr(model) call coordsystem_allocate(model%general%ice_grid, model%geometry%usrf) call coordsystem_allocate(model%general%ice_grid, model%geometry%lsrf) call coordsystem_allocate(model%general%ice_grid, model%geometry%topg) + call coordsystem_allocate(model%general%ice_grid, model%geometry%thck_obs) call coordsystem_allocate(model%general%ice_grid, model%geometry%thkmask) call coordsystem_allocate(model%general%velo_grid, model%geometry%stagmask) call coordsystem_allocate(model%general%ice_grid, model%geometry%cell_area) @@ -2126,12 +2169,14 @@ subroutine glide_allocarr(model) ! whenever running glam/glissade !! if ( (model%options%which_ho_babc == HO_BABC_POWERLAW) .or. & !! (model%options%which_ho_babc == HO_BABC_COULOMB_FRICTION) .or. & -!! (model%options%which_ho_babc == HO_BABC_COULOMB_CONST_BASAL_FLWA) .or. & +!! (model%options%which_ho_babc == HO_BABC_COULOMB_POWERLAW_SCHOOF) .or. & !! (model%options%whichbwat == BWATER_OCEAN_PENETRATION) ) then call coordsystem_allocate(model%general%velo_grid, model%basal_physics%bpmp_mask) call coordsystem_allocate(model%general%ice_grid, model%basal_physics%effecpress) call coordsystem_allocate(model%general%velo_grid, model%basal_physics%effecpress_stag) call coordsystem_allocate(model%general%velo_grid, model%basal_physics%tau_c) + call coordsystem_allocate(model%general%ice_grid, model%basal_physics%powerlaw_c_2d) + call coordsystem_allocate(model%general%ice_grid, model%basal_physics%coulomb_c_2d) call coordsystem_allocate(model%general%ice_grid, model%basal_physics%C_space_factor) call coordsystem_allocate(model%general%velo_grid, model%basal_physics%C_space_factor_stag) call coordsystem_allocate(model%general%velo_grid, model%basal_physics%mintauf) @@ -2149,6 +2194,10 @@ subroutine glide_allocarr(model) if (model%options%whichbmlt_float == BMLT_FLOAT_EXTERNAL) then call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_float_external) endif + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then + call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_float_inversion) + call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_inversion_mask) + endif if (model%options%whichbmlt_float == BMLT_FLOAT_MISOMIP) then call coordsystem_allocate(model%general%ice_grid, model%plume%T_basal) call coordsystem_allocate(model%general%ice_grid, model%plume%S_basal) @@ -2460,6 +2509,10 @@ subroutine glide_deallocarr(model) deallocate(model%basal_physics%effecpress_stag) if (associated(model%basal_physics%tau_c)) & deallocate(model%basal_physics%tau_c) + if (associated(model%basal_physics%powerlaw_c_2d)) & + deallocate(model%basal_physics%powerlaw_c_2d) + if (associated(model%basal_physics%coulomb_c_2d)) & + deallocate(model%basal_physics%coulomb_c_2d) if (associated(model%basal_physics%C_space_factor)) & deallocate(model%basal_physics%C_space_factor) if (associated(model%basal_physics%C_space_factor_stag)) & @@ -2481,6 +2534,10 @@ subroutine glide_deallocarr(model) deallocate(model%basal_melt%bmlt_float_external) if (associated(model%basal_melt%bmlt_float_anomaly)) & deallocate(model%basal_melt%bmlt_float_anomaly) + if (associated(model%basal_melt%bmlt_float_inversion)) & + deallocate(model%basal_melt%bmlt_float_inversion) + if (associated(model%basal_melt%bmlt_inversion_mask)) & + deallocate(model%basal_melt%bmlt_inversion_mask) ! plume arrays if (associated(model%plume%T_basal)) & @@ -2526,6 +2583,8 @@ subroutine glide_deallocarr(model) deallocate(model%geometry%lsrf) if (associated(model%geometry%topg)) & deallocate(model%geometry%topg) + if (associated(model%geometry%thck_obs)) & + deallocate(model%geometry%thck_obs) if (associated(model%geometry%thkmask)) & deallocate(model%geometry%thkmask) if (associated(model%geometry%stagmask)) & diff --git a/libglide/glide_vars.def b/libglide/glide_vars.def index e295161a..145eb029 100644 --- a/libglide/glide_vars.def +++ b/libglide/glide_vars.def @@ -300,6 +300,14 @@ standard_name: floating_ice_basal_melt_rate_anomaly coordinates: lon lat load: 1 +[bmlt_float_inversion] +dimensions: time, y1, x1 +units: meter/year +long_name: basal melt rate for floating ice from inversion +data: data%basal_melt%bmlt_float_inversion +factor: scyr +coordinates: lon lat + #WHL - A number of plume-related fields follow. [T_ambient] @@ -478,6 +486,15 @@ standard_name: stag_land_ice_thickness load: 0 coordinates: lon lat +[thck_obs] +dimensions: time, y1, x1 +units: meter +long_name: observed ice thickness +data: data%geometry%thck_obs +factor: thk0 +load: 1 +coordinates: lon lat + [calving_thck] dimensions: time, y1, x1 units: meter @@ -817,6 +834,22 @@ data: data%basal_physics%C_space_factor load: 1 coordinates: lon lat +[powerlaw_c_2d] +dimensions: time, y1, x1 +units: Pa (m/yr)**(-1/3) +long_name: spatially varying C for powerlaw sliding +data: data%basal_physics%powerlaw_c_2d +load: 1 +coordinates: lon lat + +[coulomb_c_2d] +dimensions: time, y1, x1 +units: unitless [0,1] +long_name: spatially varying C for Coulomb sliding +data: data%basal_physics%coulomb_c_2d +load: 0 +coordinates: lon lat + [artm] dimensions: time, y1, x1 units: degree_Celsius diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index 13471ba2..69a57d5a 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -95,6 +95,7 @@ subroutine glissade_initialise(model, evolve_ice) use glissade_therm, only: glissade_init_therm use glissade_transport, only: glissade_overwrite_acab_mask use glissade_basal_water, only: glissade_basal_water_init + use glissade_masks, only: glissade_get_masks use glimmer_scales use glide_mask use isostasy @@ -119,9 +120,10 @@ subroutine glissade_initialise(model, evolve_ice) character(len=100) :: message - real(dp) :: smb_maxval ! max value of abs(smb) + real(dp) :: var_maxval ! max value of a given variable; = 0 if not yet read in integer :: i, j, k logical :: l_evolve_ice ! local version of evolve_ice + integer, dimension(:,:), allocatable :: ice_mask if (present(evolve_ice)) then l_evolve_ice = evolve_ice @@ -218,9 +220,9 @@ subroutine glissade_initialise(model, evolve_ice) if (model%options%smb_input == SMB_INPUT_MMYR_WE) then ! make sure a nonzero SMB was read in - smb_maxval = maxval(abs(model%climate%smb)) - smb_maxval = parallel_reduce_max(smb_maxval) - if (smb_maxval < 1.0d-11) then + var_maxval = maxval(abs(model%climate%smb)) + var_maxval = parallel_reduce_max(var_maxval) + if (var_maxval < 1.0d-11) then write(message,*) 'Error: Failed to read in a nonzero SMB field with smb_input =', SMB_INPUT_MMYR_WE call write_log(trim(message), GM_FATAL) endif @@ -592,6 +594,53 @@ subroutine glissade_initialise(model, evolve_ice) ! An update is done here regardless of code options, just to be on the safe side. call parallel_halo(model%stress%efvs) + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then + + ! Save the initial ice thickness, if it will be used as the observational target for inversion. + ! Note: If calving is done at initialization, the target is the post-calving thickness. + ! The inversion will not try to put ice where, e.g., initial icebergs are removed. + + ! Check whether thck_obs has been read in already. + ! If not, then set thck_obs to the initial thickness (possibly modified by initial calving). + var_maxval = maxval(model%geometry%thck_obs) + var_maxval = parallel_reduce_max(var_maxval) + if (var_maxval > 0.0d0) then + ! do nothing; thck_obs has been read in already (e.g., after restart) + else + model%geometry%thck_obs(:,:) = model%geometry%thck(:,:) + endif + + call parallel_halo(model%geometry%thck_obs) + + ! Initialize a mask for inversion. + ! Basal melting will be applied wherever the observed target ice is floating. + + allocate(ice_mask(model%general%ewn, model%general%nsn)) ! required argument for subroutine + + call glissade_get_masks(model%general%ewn, model%general%nsn, & + model%geometry%thck_obs*thk0, & + model%geometry%topg*thk0, & + model%climate%eus*thk0, & + 0.0d0, & ! thklim = 0 + ice_mask, & + floating_mask = model%basal_melt%bmlt_inversion_mask) + + !TODO - Modify bmlt_inversion_mask adjacent to land cells. + + ! Check whether powerlaw_c_2d has been read in already. + ! If not, then set to a constant value. + var_maxval = maxval(model%basal_physics%powerlaw_c_2d) + var_maxval = parallel_reduce_max(var_maxval) + if (var_maxval > 0.0d0) then + ! do nothing; powerlaw_c_2d has been read in already (e.g., after restart) + else + model%basal_physics%powerlaw_c_2d(:,:) = model%basal_physics%powerlaw_c + endif + + call parallel_halo(model%basal_physics%powerlaw_c_2d) + + endif ! which_ho_inversion + ! recalculate the lower and upper ice surface call glide_calclsrf(model%geometry%thck, model%geometry%topg, model%climate%eus, model%geometry%lsrf) model%geometry%usrf = max(0.d0, model%geometry%thck + model%geometry%lsrf) @@ -850,6 +899,13 @@ subroutine glissade_bmlt_float_solve(model) integer :: i, j + integer :: itest, jtest, rtest + + ! Set debug diagnostics + rtest = model%numerics%rdiag_local + itest = model%numerics%idiag_local + jtest = model%numerics%jdiag_local + ! ------------------------------------------------------------------------ ! Compute the basal melt rate beneath floating ice. ! Note: model%basal_melt is a derived type with various fields and parameters @@ -902,14 +958,6 @@ subroutine glissade_bmlt_float_solve(model) model%basal_melt%bmlt_anomaly_timescale, & ! yr previous_time) ! yr - !WHL - debug -! if (this_rank==model%numerics%rdiag_local) then -! i = model%numerics%idiag_local -! j = model%numerics%jdiag_local -! print*, 'i, j, total anomaly (m/yr), previous_time, new bmlt (m/yr):', & -! i, j, model%basal_melt%bmlt_float_anomaly(i,j)*thk0*scyr/tim0, previous_time, model%basal_melt%bmlt_float(i,j) -! endif - endif else ! other options include BMLT_FLOAT_CONSTANT, BMLT_FLOAT_MISMIP AND BMLT_FLOAT_MISOMIP @@ -934,9 +982,10 @@ subroutine glissade_bmlt_float_solve(model) endif ! whichbmlt_float - ! For all bmlt_float options, limit the melting to cells where ice is present and floating + ! Limit the melting to cells where ice is present and floating. ! Note: For this to work correctly, basal melting must be applied before the floating mask changes ! (i.e., before horizontal transport). + where (floating_mask == 0) model%basal_melt%bmlt_float = 0.0d0 endwhere @@ -1096,6 +1145,7 @@ subroutine glissade_transport_solve(model) type(glide_global_type), intent(inout) :: model ! model instance + logical, parameter :: verbose_inversion = .false. ! --- Local variables --- @@ -1107,6 +1157,7 @@ subroutine glissade_transport_solve(model) acab_unscaled, & ! surface mass balance (m/s) bmlt_unscaled ! = bmlt (m/s) if basal mass balance is included in continuity equation, else = 0 + !TODO - Remove ice_mask obs, compute inversion mask at startup ! masks integer, dimension(model%general%ewn, model%general%nsn) :: & ice_mask, & ! = 1 if thck > 0, else = 0 @@ -1130,11 +1181,13 @@ subroutine glissade_transport_solve(model) logical :: do_upwind_transport ! logical for whether transport code should do upwind transport or incremental remapping ! set to true for EVOL_UPWIND, else = false - integer :: ntracers ! number of tracers to be transported + integer :: ntracers ! number of tracers to be transported + + real(dp) :: thck_flotation integer :: i, j, k integer :: ewn, nsn, upn - + !WHL - debug integer :: itest, jtest, rtest @@ -1224,7 +1277,6 @@ subroutine glissade_transport_solve(model) model%climate%acab_corrected) endif - ! temporary in/out arrays in SI units thck_unscaled(:,:) = model%geometry%thck(:,:) * thk0 acab_unscaled(:,:) = model%climate%acab_corrected(:,:) * thk0/tim0 @@ -1311,8 +1363,8 @@ subroutine glissade_transport_solve(model) thck_unscaled(:,:), & ! m acab_unscaled(:,:), & ! m/s bmlt_unscaled(:,:), & ! m/s - model%climate%acab_applied(:,:), & ! m on output; m/s below - model%basal_melt%bmlt_applied(:,:), & ! m on output; m/s below + model%climate%acab_applied(:,:), & ! m/s + model%basal_melt%bmlt_applied(:,:), & ! m/s ocean_mask(:,:), & effective_areafrac(:,:), & model%geometry%ntracers, & @@ -1321,10 +1373,6 @@ subroutine glissade_transport_solve(model) model%geometry%tracers_lsrf(:,:,:), & model%options%which_ho_vertical_remap) - ! convert applied mass balance from m/s back to scaled model units - model%climate%acab_applied(:,:) = model%climate%acab_applied(:,:)/thk0 * tim0 - model%basal_melt%bmlt_applied(:,:) = model%basal_melt%bmlt_applied(:,:)/thk0 * tim0 - ! halo updates for thickness and tracers, to prepare for transport. call parallel_halo(thck_unscaled) call parallel_halo_tracers(model%geometry%tracers) @@ -1428,9 +1476,173 @@ subroutine glissade_transport_solve(model) enddo ! subcycling + ! If inverting for bmlt beneath floating ice, then compute bmlt_float_inversion here, + ! and again call the mass balance driver. + ! Note: It would be simpler to include bmlt_float_inversion in the previous call + ! to the mass balance driver. However, the relaxation of thck toward thck_obs would then + ! be followed by horizontal transport, causing thck and thck_obs to diverge again. + + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then + + ! thickness tendency dH/dt from one step to the next (m/s) + ! This tendency is used when inverting for basal traction parameters. + ! It is recomputed at the end of the time step for diagnostics. + + model%geometry%dthck_dt(:,:) = (thck_unscaled(:,:) - model%geometry%thck_old(:,:)*thk0) & + / (model%numerics%dt * tim0) + + ! Where the observed ice is floating, compute a basal melt rate (or freezing rate, if bmlt < 0) + ! that will restore the ice thickness to the observed target. + + where (model%basal_melt%bmlt_inversion_mask == 1) + model%basal_melt%bmlt_float_inversion = & + (thck_unscaled - model%geometry%thck_obs*thk0) / (model%numerics%dt*tim0) + elsewhere + model%basal_melt%bmlt_float_inversion = 0.0d0 + endwhere + + ! ------------------------------------------------------------------------ + ! Get masks used by glissade_mass_balance_driver. + ! Pass thklim = 0 to identify cells with thck > 0 (not thck > thklim). + ! ------------------------------------------------------------------------ + + call glissade_get_masks(model%general%ewn, model%general%nsn, & + thck_unscaled, & ! m + model%geometry%topg*thk0, & ! m + model%climate%eus*thk0, & ! m + 0.0d0, & ! thklim = 0 + ice_mask, & + floating_mask = floating_mask, & + ocean_mask = ocean_mask) + + ! For purposes of inversion, assign all cells an effective fraction of 1 or 0. + ! Calving-front cells are treated the same as other ice-covered cells. + where (ocean_mask == 1) + effective_areafrac = 0.0d0 + elsewhere + effective_areafrac = 1.0d0 + endwhere + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'Inverting for bmlt_float: rank, i, j =', rtest, i, j + print*, 'thck (m), thck_obs (m), bmlt_float_inversion (m/yr):', thck_unscaled(i,j), & + model%geometry%thck_obs(i,j)*thk0, model%basal_melt%bmlt_float_inversion(i,j)*scyr + print*, ' ' + print*, 'bmlt_inversion_mask:' + do j = jtest+3, jtest-3, -1 + do i = itest-4, itest+4 + write(6,'(i12)',advance='no') model%basal_melt%bmlt_inversion_mask(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'floating_mask:' + do j = jtest+3, jtest-3, -1 + do i = itest-4, itest+4 + write(6,'(i12)',advance='no') floating_mask(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'thck (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-4, itest+4 + write(6,'(f12.5)',advance='no') thck_unscaled(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'thck - thck_obs (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-4, itest+4 + write(6,'(f12.5)',advance='no') thck_unscaled(i,j) - model%geometry%thck_obs(i,j)*thk0 + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'thck_flotation (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-4, itest+4 + write(6,'(f12.5)',advance='no') -(rhoo/rhoi)*model%geometry%topg(i,j)*thk0 + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'bmlt_float_inversion (m/yr):' + do j = jtest+3, jtest-3, -1 + do i = itest-4, itest+4 + write(6,'(f12.5)',advance='no') model%basal_melt%bmlt_float_inversion(i,j)*scyr + enddo + write(6,*) ' ' + enddo + + + endif + + ! Zero out acab since this call uses bmlt_float_inversion only + acab_unscaled(:,:) = 0.0d0 + + ! Apply basal melting for inversion. + ! Note: Basal melting applied during this call is added to bmlt_applied. + call glissade_mass_balance_driver(model%numerics%dt * tim0, & + model%numerics%dew * len0, model%numerics%dns * len0, & + model%general%ewn, model%general%nsn, & + model%general%upn-1, model%numerics%sigma, & + thck_unscaled(:,:), & ! m + acab_unscaled(:,:), & ! m/s + model%basal_melt%bmlt_float_inversion(:,:), & ! m/s + model%climate%acab_applied(:,:), & ! m/s + model%basal_melt%bmlt_applied(:,:), & ! m/s + ocean_mask(:,:), & + effective_areafrac(:,:), & + model%geometry%ntracers, & + model%geometry%tracers(:,:,:,:), & + model%geometry%tracers_usrf(:,:,:), & + model%geometry%tracers_lsrf(:,:,:), & + model%options%which_ho_vertical_remap) + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'After inversion:' + print*, ' ' + print*, 'thck (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-4, itest+4 + write(6,'(f12.5)',advance='no') thck_unscaled(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'thck - thck_obs (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-4, itest+4 + write(6,'(f12.5)',advance='no') thck_unscaled(i,j) - model%geometry%thck_obs(i,j)*thk0 + enddo + write(6,*) ' ' + enddo + + endif + + ! Note: Subroutine calc_basal_inversion, which inverts for basal parameters, + ! is called later, during the velocity solve. + ! It requires the same ice mask and floating mask as the velocity solver. + + endif ! which_ho_inversion + ! copy tracers (temp/enthalpy, etc.) from model%geometry%tracers back to standard arrays call glissade_transport_finish_tracers(model) + ! convert applied mass balance from m/s back to scaled model units + model%climate%acab_applied(:,:) = model%climate%acab_applied(:,:)/thk0 * tim0 + model%basal_melt%bmlt_applied(:,:) = model%basal_melt%bmlt_applied(:,:)/thk0 * tim0 + ! convert thck back to scaled units ! (acab_unscaled is intent(in) above, so no need to scale it back) model%geometry%thck(:,:) = thck_unscaled(:,:) / thk0 @@ -2349,6 +2561,16 @@ subroutine glissade_diagnostic_variable_solve(model) enddo enddo + ! thickness tendency dH/dt from one step to the next (m/s) + ! Note: This diagnostic will not be correct on the first step of a restart + + do j = 1, model%general%nsn + do i = 1, model%general%ewn + model%geometry%dthck_dt(i,j) = (model%geometry%thck(i,j) - model%geometry%thck_old(i,j))*thk0 & + / (model%numerics%dt * tim0) + enddo + enddo + ! surface mass balance in units of mm/yr w.e. ! (model%climate%acab * scale_acab) has units of m/yr of ice ! Note: This is not necessary (and can destroy exact restart) if the SMB was already input in units of mm/yr @@ -2362,16 +2584,6 @@ subroutine glissade_diagnostic_variable_solve(model) model%geometry%basal_mbal_flux(:,:) = rhoi * (-model%basal_melt%bmlt_applied(:,:)) * thk0/tim0 model%geometry%calving_flux(:,:) = rhoi * (-model%calving%calving_thck(:,:)*thk0) / (model%numerics%dt*tim0) - ! thickness tendency dH/dt from one step to the next (m/s) - ! Note: This diagnostic will not be correct on the first step of a restart - - do j = 1, model%general%nsn - do i = 1, model%general%ewn - model%geometry%dthck_dt(i,j) = (model%geometry%thck(i,j) - model%geometry%thck_old(i,j)) * thk0 & - / (model%numerics%dt * tim0) - enddo - enddo - ! real-valued masks ! unstaggered grid diff --git a/libglissade/glissade_basal_traction.F90 b/libglissade/glissade_basal_traction.F90 index 394b79b0..15ecc044 100644 --- a/libglissade/glissade_basal_traction.F90 +++ b/libglissade/glissade_basal_traction.F90 @@ -56,7 +56,7 @@ module glissade_basal_traction implicit none private - public :: calcbeta, calc_effective_pressure + public :: calcbeta, calc_effective_pressure, calc_basal_inversion !*********************************************************************** @@ -73,7 +73,11 @@ subroutine calcbeta (whichbabc, & mask, beta_external, & beta, & topg, eus, & - f_ground) + ice_mask, & + floating_mask, & + f_ground, & + which_ho_inversion, & + itest, jtest, rtest) ! subroutine to calculate map of beta sliding parameter, based on ! user input ("whichbabc" flag, from config file as "which_ho_babc"). @@ -99,20 +103,25 @@ subroutine calcbeta (whichbabc, & real(dp), intent(in), dimension(:,:) :: thisvel, othervel ! basal velocity components (m/yr) type(glide_basal_physics), intent(in) :: basal_physics ! basal physics object real(dp), intent(in), dimension(:,:) :: flwa_basal ! flwa for the basal ice layer (Pa^{-3} yr^{-1}) - real(dp), intent(in), dimension(:,:) :: thck ! ice thickness + real(dp), intent(in), dimension(:,:) :: thck ! ice thickness (m) integer, intent(in), dimension(:,:) :: mask ! staggered grid mask real(dp), intent(in), dimension(:,:) :: beta_external ! fixed beta read from external file (Pa yr/m) real(dp), intent(inout), dimension(:,:) :: beta ! basal traction coefficient (Pa yr/m) ! Note: This is beta_internal in glissade - real(dp), intent(in), dimension(:,:), optional :: f_ground ! grounded ice fraction, 0 <= f_ground <= 1 ! Note: Adding fields for parallel ISHOM-C test case real(dp), dimension(:,:), allocatable :: beta_global ! beta on the global grid real(dp), dimension(:,:), allocatable :: beta_extend ! beta extended to the ice grid (dimensions ewn, nsn) ! Note: optional arguments topg and eus are used for pseudo-plastic sliding law - real(dp), intent(in), dimension(:,:), optional :: topg ! bed topography (m) - real(dp), intent(in), optional :: eus ! eustatic sea level (m) relative to z = 0 + !TODO - Make these argument non-optional? Can do this after removing the call to calcbeta from Glam. + real(dp), intent(in), dimension(:,:), optional :: topg ! bed topography (m) + real(dp), intent(in), optional :: eus ! eustatic sea level (m) relative to z = 0 + integer, intent(in), dimension(:,:), optional :: ice_mask ! = 1 where ice is present (thck > thklim), else = 0 + integer, intent(in), dimension(:,:), optional :: floating_mask ! = 1 where ice is present and floating, else = 0 + real(dp), intent(in), dimension(:,:), optional :: f_ground ! grounded ice fraction, 0 <= f_ground <= 1 + integer, intent(in), optional :: which_ho_inversion ! basal inversion option + integer, intent(in), optional :: itest, jtest, rtest ! coordinates of diagnostic point ! Local variables @@ -123,24 +132,29 @@ subroutine calcbeta (whichbabc, & real(dp) :: dx, dy integer :: ew, ns - real(dp), dimension(size(beta,1), size(beta,2)) :: speed ! ice speed, sqrt(uvel^2 + vvel^2), m/yr + real(dp), dimension(size(beta,1), size(beta,2)) :: speed ! ice speed, sqrt(uvel^2 + vvel^2), m/yr ! variables for power law real(dp) :: powerlaw_p, powerlaw_q ! variables for Coulomb friction law - real(dp) :: Coulomb_C ! Coulomb law friction coefficient (unitless) - real(dp) :: powerlaw_C ! power law friction coefficient (Pa m^{-1/3} yr^{1/3}) + real(dp) :: coulomb_c ! Coulomb law friction coefficient (unitless) + real(dp) :: powerlaw_c ! power law friction coefficient (Pa m^{-1/3} yr^{1/3}) real(dp) :: lambda_max ! wavelength of bedrock bumps at subgrid scale (m) real(dp) :: m_max ! maximum bed obstacle slope (unitless) real(dp) :: m ! exponent m in power law - real(dp), dimension(size(beta,1), size(beta,2)) :: big_lambda ! bedrock characteristics - integer, dimension(size(thck,1), size(thck,2)) :: imask ! ice grid mask 1=ice, 0=no ice - real(dp), dimension(size(beta,1), size(beta,2)) :: flwa_basal_stag ! flwa for the basal ice layer on the staggered grid - ! Note: Units are Pa^{-n} yr^{-1} + integer, dimension(size(thck,1), size(thck,2)) :: & + imask, & ! = 1 where thck > 0, else = 1 + grounded_mask ! = 1 where ice is present (thck > thklim) and not floating + real(dp), dimension(size(beta,1), size(beta,2)) :: & + big_lambda, & ! bedrock characteristics + flwa_basal_stag, & ! basal flwa interpolated to the staggered grid (Pa^{-n} yr^{-1}) + stag_powerlaw_c_2d, & ! powerlaw_c_2d interpolated to the staggered grid + stag_coulomb_c_2d ! coulomb_c_2d interpolated to the staggered grid + ! variables for Tsai et al. parameterization real(dp) :: taub_powerlaw ! basal shear stress given by a power law as in Tsai et al. (2015) - real(dp) :: taub_Coulomb ! basal shear stress given by Coulomb friction as in Tsai et al. (2015) + real(dp) :: taub_coulomb ! basal shear stress given by Coulomb friction as in Tsai et al. (2015) ! variables for pseudo-plastic law real(dp) :: q ! exponent for pseudo-plastic law (unitless) @@ -154,13 +168,24 @@ subroutine calcbeta (whichbabc, & real(dp) :: tau_c ! yield stress for pseudo-plastic law (unitless) real(dp) :: numerator, denominator + ! option to invert for basal parameters + integer :: which_inversion ! basal inversion option + character(len=300) :: message integer :: iglobal, jglobal !WHL - debug + logical, parameter :: verbose_beta = .false. !! integer :: istop, jstop + !TODO - Can remove the extra variable when which_ho_inversion is a non-optional argument + if (present(which_ho_inversion)) then + which_inversion = which_ho_inversion + else + which_inversion = HO_INVERSION_NONE + endif + select case(whichbabc) case(HO_BABC_BETA_CONSTANT) ! spatially uniform beta value; useful for debugging and test cases @@ -197,7 +222,6 @@ subroutine calcbeta (whichbabc, & q = basal_physics%pseudo_plastic_q u0 = basal_physics%pseudo_plastic_u0 - !TODO - Check presence of topg and eus if (present(topg) .and. present(eus)) then do ns = 1, nsn-1 @@ -246,8 +270,6 @@ subroutine calcbeta (whichbabc, & !!! since beta is updated here, communicate that info to halos call staggered_parallel_halo(beta) - !WHL - Removed the unused BETA_BWAT option - case(HO_BABC_BETA_LARGE) ! frozen (u=v=0) ice-bed interface !Note: This option is redundant in that it could be implemented using HO_BETA_CONST @@ -332,7 +354,7 @@ subroutine calcbeta (whichbabc, & ! m should be a positive exponent speed(:,:) = dsqrt(thisvel(:,:)**2 + othervel(:,:)**2 + smallnum**2) - beta(:,:) = basal_physics%powerlaw_C * speed(:,:)**(1.0d0/basal_physics%powerlaw_m - 1.0d0) + beta(:,:) = basal_physics%powerlaw_c * speed(:,:)**(1.0d0/basal_physics%powerlaw_m - 1.0d0) case(HO_BABC_POWERLAW_EFFECPRESS) ! a power law that uses effective pressure !TODO - Remove POWERLAW_EFFECPRESS option? Rarely if ever used. @@ -360,14 +382,14 @@ subroutine calcbeta (whichbabc, & ! Coulomb sliding law: Schoof 2005 PRS, eqn. 6.2 (see also Pimentel, Flowers & Schoof 2010 JGR) ! Set up parameters needed for the friction law - m_max = basal_physics%Coulomb_bump_max_slope ! maximum bed obstacle slope(unitless) - lambda_max = basal_physics%Coulomb_bump_wavelength ! wavelength of bedrock bumps (m) - Coulomb_C = basal_physics%Coulomb_C ! basal shear stress factor (Pa (m^-1 y)^1/3) + m_max = basal_physics%coulomb_bump_max_slope ! maximum bed obstacle slope(unitless) + lambda_max = basal_physics%coulomb_bump_wavelength ! wavelength of bedrock bumps (m) + coulomb_c = basal_physics%coulomb_c ! basal shear stress factor (Pa (m^-1 y)^1/3) ! Need flwa of the basal layer on the staggered grid !TODO - Pass in ice_mask instead of computing imask here? ! (Small difference: ice_mask = 1 where thck > thklim rather than thck > 0) - where (thck > 0.0) + where (thck > 0.d0) imask = 1 elsewhere imask = 0 @@ -380,14 +402,14 @@ subroutine calcbeta (whichbabc, & ! Compute biglambda = wavelength of bedrock bumps [m] * flwa [Pa^-n yr^-1] / max bed obstacle slope [dimensionless] big_lambda(:,:) = (lambda_max / m_max) * flwa_basal_stag(:,:) - ! Note: For MISMIP3D, Coulomb_C is multiplied by a spatial factor (C_space_factor) which is + ! Note: For MISMIP3D, coulomb_c is multiplied by a spatial factor (C_space_factor) which is ! read in during initialization. This factor is typically between 0 and 1. ! If this factor is not present in the input file, it is set to 1 everywhere. ! Compute beta ! gn = Glen's n from physcon module speed(:,:) = dsqrt(thisvel(:,:)**2 + othervel(:,:)**2 + smallnum**2) - beta(:,:) = Coulomb_C * basal_physics%C_space_factor_stag(:,:) * & + beta(:,:) = coulomb_c * basal_physics%C_space_factor_stag(:,:) * & basal_physics%effecpress_stag(:,:) * speed(:,:)**(1.0d0/gn - 1.0d0) * & (speed(:,:) + basal_physics%effecpress_stag(:,:)**gn * big_lambda)**(-1.0d0/gn) @@ -397,42 +419,107 @@ subroutine calcbeta (whichbabc, & beta = 1.0d8 end where - case(HO_BABC_COULOMB_CONST_BASAL_FLWA) + case(HO_BABC_COULOMB_POWERLAW_SCHOOF) ! Use a constant value of basal flwa. ! This allows several Coulomb parameters (lambda_max, m_max and flwa_basal) - ! to be combined into a single parameter powerlaw_C, as in the Tsai power law below. + ! to be combined into a single parameter powerlaw_c, as in the Tsai power law below. ! ! The equation for tau_b = beta * u_b is ! - ! powerlaw_C * Coulomb_C * N + ! powerlaw_c * coulomb_c * N ! tau_b = ---------------------------------------------- u_b^{1/m} - ! [powerlaw_C^m * u_b + (Coulomb_C * N)^m]^{1/m} + ! [powerlaw_c^m * u_b + (coulomb_c * N)^m]^{1/m} ! ! where m = powerlaw_m ! ! This is the second modified basal traction law in MISMIP+. See Eq. 11 of Asay-Davis et al. (2016). - ! Note: powerlaw_C corresponds to beta^2 in their notation, and Coulomb_C corresponds to alpha^2. + ! Note: powerlaw_c corresponds to beta^2 in their notation, and coulomb_c corresponds to alpha^2. + ! + ! Depending on the value of which_ho_inversion, there are different ways to apply this sliding law: + ! (0) Set powerlaw_c and coulomb_c to a constant everywhere. + ! (1) Obtain spatially varying powerlaw_c_2d and coulomb_c_2d fields by inversion. + ! (2) Use spatially varying powerlaw_c_2d and coulomb_c_2d fields prescribed from a previous inversion. + ! For either (1) or (2), use the 2D fields. - powerlaw_C = basal_physics%powerlaw_C - Coulomb_C = basal_physics%Coulomb_C - m = basal_physics%powerlaw_m + if (which_inversion == HO_INVERSION_NONE) then - do ns = 1, nsn-1 - do ew = 1, ewn-1 + ! use constant powerlaw_c and coulomb_c + powerlaw_c = basal_physics%powerlaw_c + coulomb_c = basal_physics%coulomb_c + m = basal_physics%powerlaw_m - speed(ew,ns) = dsqrt(thisvel(ew,ns)**2 + othervel(ew,ns)**2 + smallnum**2) + do ns = 1, nsn-1 + do ew = 1, ewn-1 + + speed(ew,ns) = dsqrt(thisvel(ew,ns)**2 + othervel(ew,ns)**2 + smallnum**2) - numerator = powerlaw_C * Coulomb_C * basal_physics%effecpress_stag(ew,ns) - denominator = ( powerlaw_C**m * speed(ew,ns) + & - (Coulomb_C * basal_physics%effecpress_stag(ew,ns))**m )**(1.d0/m) + numerator = powerlaw_c * coulomb_c * basal_physics%effecpress_stag(ew,ns) + denominator = ( powerlaw_c**m * speed(ew,ns) + & + (coulomb_c * basal_physics%effecpress_stag(ew,ns))**m )**(1.d0/m) - beta(ew,ns) = (numerator/denominator) * speed(ew,ns)**(1.d0/m - 1.d0) + beta(ew,ns) = (numerator/denominator) * speed(ew,ns)**(1.d0/m - 1.d0) + enddo enddo - enddo - !TODO - Verify that the results are similar to Tsai + else ! use powerlaw_c and coulomb_c from inversion + + m = basal_physics%powerlaw_m + + ! Interpolate powerlaw_c_2d and coulomb_c_2d to the velocity grid. + ! stagger_margin_in = 1: Interpolate using only the values in cells with grounded ice. + + where (ice_mask == 1 .and. floating_mask == 0) + grounded_mask = 1 + elsewhere + grounded_mask = 0 + endwhere + + call glissade_stagger(ewn, nsn, & + basal_physics%powerlaw_c_2d, stag_powerlaw_c_2d, & + grounded_mask, stagger_margin_in = 1) + + call glissade_stagger(ewn, nsn, & + basal_physics%coulomb_c_2d, stag_coulomb_c_2d, & + grounded_mask, stagger_margin_in = 1) + + ! Replace zeroes with default values to avoid divzero issues + where (stag_powerlaw_c_2d == 0.0d0) + stag_powerlaw_c_2d = basal_physics%powerlaw_c + endwhere + + where (stag_coulomb_c_2d == 0.0d0) + stag_coulomb_c_2d = basal_physics%coulomb_c + endwhere + + do ns = 1, nsn-1 + do ew = 1, ewn-1 + + speed(ew,ns) = dsqrt(thisvel(ew,ns)**2 + othervel(ew,ns)**2 + smallnum**2) + + numerator = stag_powerlaw_c_2d(ew,ns) * stag_coulomb_c_2d(ew,ns) & + * basal_physics%effecpress_stag(ew,ns) + denominator = ( stag_powerlaw_c_2d(ew,ns)**m * speed(ew,ns) + & + (stag_coulomb_c_2d(ew,ns) * basal_physics%effecpress_stag(ew,ns))**m )**(1.d0/m) + + beta(ew,ns) = (numerator/denominator) * speed(ew,ns)**(1.d0/m - 1.d0) + + !WHL - debug + if (verbose_beta .and. present(rtest) .and. present(itest) .and. present(jtest)) then + if (this_rank == rtest .and. ew == itest .and. ns == jtest) then + write(6,*) 'r, i, j, denom_u, denom_N, speed, beta, taub:', & + rtest, itest, jtest, & + (stag_powerlaw_c_2d(ew,ns)**m * speed(ew,ns))**(1.d0/m), & + stag_coulomb_c_2d(ew,ns) * basal_physics%effecpress_stag(ew,ns), & + speed(ew,ns), beta(ew,ns), beta(ew,ns)*speed(ew,ns) + endif + endif + + enddo + enddo + + endif ! which_inversion ! Limit for numerical stability !TODO - Is limiting needed? @@ -452,36 +539,40 @@ subroutine calcbeta (whichbabc, & ! Basal stress representation based on Tsai et al. (2015) ! The basal stress is the minimum of two values: - ! (1) power law: tau_b = powerlaw_C * |u_b|^(1/powerlaw_m) - ! (2) Coulomb friction: tau_b = Coulomb_C * N + ! (1) power law: tau_b = powerlaw_c * |u_b|^(1/powerlaw_m) + ! (2) Coulomb friction: tau_b = coulomb_c * N ! N = effective pressure = rhoi*g*(H - H_f) ! H_f = flotation thickness = (rhow/rhoi)*(eus-topg) ! This value of N is obtained by setting basal_water = BWATER_OCEAN_PENETRATION = 4 ! with p_ocean_penetration = 1.0 in the config file. - ! The other parameters (powerlaw_C, powerlaw_m and Coulomb_C) can also be set in the config file. + ! The other parameters (powerlaw_c, powerlaw_m and coulomb_c) can also be set in the config file. !WHL - debug - write out basal stresses ! write(6,*) ' ' -! write(6,*) 'powerlaw_C, powerlaw_m, Coulomb_C =', basal_physics%powerlaw_C, basal_physics%powerlaw_m, basal_physics%Coulomb_C -! write(6,*) 'Apply Tsai parameterization: i, j, speed, beta, taub, taub_powerlaw, taub_Coulomb, effecpress:' +! write(6,*) 'powerlaw_c, powerlaw_m, Coulomb_c =', & +! basal_physics%powerlaw_c, basal_physics%powerlaw_m, basal_physics%coulomb_c +! write(6,*) 'Apply Tsai parameterization: i, j, speed, beta, taub, taub_powerlaw, taub_coulomb, effecpress:' + + !TODO - Add basal inversion option for Tsai, if it works for Schoof do ns = 1, nsn-1 do ew = 1, ewn-1 speed(ew,ns) = dsqrt(thisvel(ew,ns)**2 + othervel(ew,ns)**2 + smallnum**2) - taub_powerlaw = basal_physics%powerlaw_C * speed(ew,ns)**(1.d0/basal_physics%powerlaw_m) - taub_Coulomb = basal_physics%Coulomb_C * basal_physics%effecpress_stag(ew,ns) + taub_powerlaw = basal_physics%powerlaw_c * speed(ew,ns)**(1.d0/basal_physics%powerlaw_m) + taub_coulomb = basal_physics%coulomb_c * basal_physics%effecpress_stag(ew,ns) - if (taub_Coulomb <= taub_powerlaw) then ! apply Coulomb stress, which is smaller - beta(ew,ns) = taub_Coulomb / speed(ew,ns) + if (taub_coulomb <= taub_powerlaw) then ! apply Coulomb stress, which is smaller + beta(ew,ns) = taub_coulomb / speed(ew,ns) else ! apply power-law stress beta(ew,ns) = taub_powerlaw / speed(ew,ns) endif ! !WHL - debug - Write values along a flowline ! if (ns == jtest .and. ew >= itest .and. ew <= itest+15) then -! write(6,*) ew, ns, speed(ew,ns), beta(ew,ns), speed(ew,ns)*beta(ew,ns), taub_powerlaw, taub_Coulomb, basal_physics%effecpress_stag(ew,ns) +! write(6,*) ew, ns, speed(ew,ns), beta(ew,ns), speed(ew,ns)*beta(ew,ns), & +! taub_powerlaw, taub_coulomb, basal_physics%effecpress_stag(ew,ns) ! endif enddo ! ew @@ -512,6 +603,7 @@ subroutine calcbeta (whichbabc, & ! ! If f_ground in not passed in (as for Glam), then check for areas where the ice is floating ! and make sure beta in these regions is 0. + !TODO - Replace GLIDE_IS_FLOAT with floating_mask if (present(f_ground)) then ! Multiply beta by grounded ice fraction @@ -711,6 +803,7 @@ subroutine calc_effective_pressure (which_effecpress, & case(HO_EFFECPRESS_BWAT) ! Initialize for the case where bwat isn't present, and also for points with bwat == 0 + basal_physics%effecpress(:,:) = overburden(:,:) if (present(bwat)) then @@ -724,7 +817,9 @@ subroutine calc_effective_pressure (which_effecpress, & do j = 1, nsn do i = 1, ewn + if (bwat(i,j) > 0.0d0) then + relative_bwat = max(0.0d0, min(bwat(i,j)/basal_physics%bwat_till_max, 1.0d0)) ! Eq. 23 from Bueler & van Pelt (2015) @@ -735,6 +830,7 @@ subroutine calc_effective_pressure (which_effecpress, & ! The following line (if uncommented) would implement Eq. 5 of Aschwanden et al. (2016). ! Results are similar to Bueler & van Pelt, but the dropoff in N from P_0 to delta*P_0 begins ! with a larger value of bwat (~0.7*bwat_till_max instead of 0.6*bwat_till_max). + !! basal_physics%effecpress(i,j) = basal_physics%effecpress_delta * overburden(i,j) & !! * 10.d0**((basal_physics%e_0/basal_physics%C_c) * (1.0d0 - relative_bwat)) @@ -743,7 +839,6 @@ subroutine calc_effective_pressure (which_effecpress, & !! basal_physics%effecpress(i,j) = overburden(i,j) * & !! (basal_physics%effecpress_delta + (1.0d0 - relative_bwat) * (1.0d0 - basal_physics%effecpress_delta)) - ! limit so as not to exceed overburden basal_physics%effecpress(i,j) = min(basal_physics%effecpress(i,j), overburden(i,j)) end if @@ -815,6 +910,269 @@ subroutine calc_effective_pressure (which_effecpress, & end subroutine calc_effective_pressure +!*********************************************************************** + + subroutine calc_basal_inversion(dt, & + nx, ny, & + itest, jtest, rtest, & + basal_physics, & + ice_mask, floating_mask, & + thck, dthck_dt, & + thck_obs) + + ! Compute spatially varying fields, powerlaw_c_2d and coulomb_c_2d, by inversion. + ! The method is similar to that of Pollard & DeConto (TC, 2012), and is applied to all grounded ice. + ! Where thck > thck_obs, powerlaw_c and coulomb_c are reduced to increase sliding. + ! Where thck < thck_obs, powerlaw_c and coulomb_c are increased to reduce sliding. + ! Note: powerlaw_c is constrained to lie within a prescribed range. + ! The ratio of powerlaw_c to coulomb_c is fixed (except that coulomb_c must be <= 1). + + use parallel + + real(dp), intent(in) :: dt ! time step (s) + + integer, intent(in) :: & + nx, ny ! grid dimensions + + integer, intent(in) :: & + itest, jtest, rtest ! coordinates of diagnostic point + + type(glide_basal_physics), intent(inout) :: & + basal_physics ! basal physics object + + integer, dimension(nx,ny), intent(in) :: & + ice_mask, & ! = 1 where ice is present (thk > thklim), else = 0 + floating_mask ! = 1 where ice is present and floating, else = 0 + + real(dp), dimension(nx,ny), intent(in) :: & + thck, & ! ice thickness (m) + dthck_dt, & ! rate of change of ice thickness (m/s) + thck_obs ! observed thickness (m) + + ! local variables + + real(dp), dimension(nx,ny) :: & + dthck, & ! thck - thck_obs on ice grid + old_powerlaw_c, & ! old value of powerlaw_c_2d (start of timestep) + temp_powerlaw_c, & ! temporary value of powerlaw_c_2d (before smoothing) + dpowerlaw_c ! change in powerlaw_c + + real(dp) :: term1, term2 + real(dp) :: factor + real(dp) :: dpowerlaw_c_smooth + + integer :: i, j + integer :: ii, jj + + ! inversion parameters in basal_physics derived type: + ! * powerlaw_c_max = upper bound for powerlaw_c, Pa (m/yr)^(-1/3) + ! * powerlaw_c_min = lower bound for powerlaw_c, Pa (m/yr)^(-1/3) + ! * powerlaw_coulomb_ratio = powerlaw_c/coulomb_c (same units as powerlaw_c) + ! * inversion_timescale = inversion timescale (s); must be > 0 + ! * inversion_thck_scale = thickness inversion scale (m); must be > 0 + ! * inversion_dthck_dt_scale = dthck_dt inversion scale (m/s); must be > 0 + ! * inversion_smoothing_factor = factor for smoothing powerlaw_c_2d; higher => more smoothing + ! + ! Note on smoothing: A smoothing factor of 1/8 gives a 4-1-1-1-1 smoother. + ! This is numerically well behaved, but may oversmooth in bowl-shaped regions; + ! a smaller value may be better as H converges toward H_obs. + + logical, parameter :: verbose_inversion = .false. + + ! Save the starting value + old_powerlaw_c(:,:) = basal_physics%powerlaw_c_2d(:,:) + dpowerlaw_c(:,:) = 0.0d0 + + ! Compute difference between current and target thickness + dthck(:,:) = thck(:,:) - thck_obs(:,:) + + ! Loop over cells + ! Note: powerlaw_c_2d and coulomb_c_2d are computed at cell centers where thck is located. + ! Later, they are interpolated to vertices where beta and basal velocity are located. + + do j = 1, ny + do i = 1, nx + + if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! ice is present and grounded + + ! Invert for powerlaw_c_2d and coulomb_c based on dthck and dthck_dt + term1 = -dthck(i,j) / basal_physics%inversion_thck_scale + term2 = -dthck_dt(i,j) / basal_physics%inversion_dthck_dt_scale + + dpowerlaw_c(i,j) = (dt/basal_physics%inversion_timescale) & + * basal_physics%powerlaw_c_2d(i,j) * (term1 + term2) + + ! Limit to prevent huge change in one step + if (abs(dpowerlaw_c(i,j)) > 0.05 * basal_physics%powerlaw_c_2d(i,j)) then + if (dpowerlaw_c(i,j) > 0.0d0) then + dpowerlaw_c(i,j) = 0.05d0 * basal_physics%powerlaw_c_2d(i,j) + else + dpowerlaw_c(i,j) = -0.05d0 * basal_physics%powerlaw_c_2d(i,j) + endif + endif + + basal_physics%powerlaw_c_2d(i,j) = basal_physics%powerlaw_c_2d(i,j) + dpowerlaw_c(i,j) + + ! Limit to a physically reasonable range + basal_physics%powerlaw_c_2d(i,j) = min(basal_physics%powerlaw_c_2d(i,j), basal_physics%powerlaw_c_max) + basal_physics%powerlaw_c_2d(i,j) = max(basal_physics%powerlaw_c_2d(i,j), basal_physics%powerlaw_c_min) + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest .and. i==itest .and. j==jtest) then + print*, ' ' + print*, 'Invert for powerlaw_c and coulomb_c: rank, i, j =', rtest, itest, jtest + print*, 'thck, thck_obs, dthck, dthck_dt:', thck(i,j), thck_obs(i,j), dthck(i,j), dthck_dt(i,j)*scyr + print*, '-dthck/thck_scale, -dthck_dt/dthck_dt_scale, sum =', & + -dthck(i,j)/basal_physics%inversion_thck_scale, & + -dthck_dt(i,j)/basal_physics%inversion_dthck_dt_scale, & + term1 + term2 + print*, 'dpowerlaw_c, newpowerlaw_c =', dpowerlaw_c(i,j), basal_physics%powerlaw_c_2d(i,j) + endif + + else ! ice_mask = 0 or floating_mask = 1 + + ! set to default value + basal_physics%powerlaw_c_2d(i,j) = basal_physics%powerlaw_c + + endif ! ice_mask = 1 and floating_mask = 0 + + enddo ! i + enddo ! j + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'Before smoothing, powerlaw_c:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_2d(i,j) + enddo + write(6,*) ' ' + enddo + endif + + ! Save the value just computed + temp_powerlaw_c(:,:) = basal_physics%powerlaw_c_2d(:,:) + + ! Apply Laplacian smoothing to C_p. + ! Since C_p is at cell centers but is interpolated to vertices, smoothing can damp checkerboard noise. + !TODO - Write an operator for Laplacian smoothing? + do j = 2, ny-1 + do i = 2, nx-1 + if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! cell (i,j) is grounded + + dpowerlaw_c_smooth = -4.0d0 * basal_physics%inversion_smoothing_factor * temp_powerlaw_c(i,j) + do jj = j-1, j+1 + do ii = i-1, i+1 + if ((ii == i .or. jj == j) .and. (ii /= i .or. jj /= j)) then ! edge neighbor + if (ice_mask(ii,jj) == 1 .and. floating_mask(ii,jj) == 0) then ! cell (ii,jj) is grounded + dpowerlaw_c_smooth = dpowerlaw_c_smooth & + + basal_physics%inversion_smoothing_factor*temp_powerlaw_c(ii,jj) + else + dpowerlaw_c_smooth = dpowerlaw_c_smooth & + + basal_physics%inversion_smoothing_factor*temp_powerlaw_c(i,j) + endif + endif + enddo + enddo + + ! Note: If smoothing is too strong, it can reverse the sign of the change in powerlaw_c. + ! The logic below ensures that if powerlaw_c_2d is increasing, the smoothing can reduce + ! the change to zero, but not cause powerlaw_c to decrease relative to old_powerlaw_c + ! (and similarly if powerlaw_c_2d is decreasing). + + if (dpowerlaw_c(i,j) > 0.0d0) then + if (temp_powerlaw_c(i,j) + dpowerlaw_c_smooth > old_powerlaw_c(i,j)) then + basal_physics%powerlaw_c_2d(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth + else + ! allow the smoothing to hold Cp at its old value, but not reduce Cp + basal_physics%powerlaw_c_2d(i,j) = old_powerlaw_c(i,j) + endif + elseif (dpowerlaw_c(i,j) < 0.0d0) then + if (temp_powerlaw_c(i,j) + dpowerlaw_c_smooth < old_powerlaw_c(i,j)) then + basal_physics%powerlaw_c_2d(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth + else + ! allow the smoothing to hold Cp at its old value, but not increase Cp + basal_physics%powerlaw_c_2d(i,j) = old_powerlaw_c(i,j) + endif + endif ! dpowerlaw_c > 0 + + ! The next 5 lines are commented out. If used in place of the limiting above, + ! this code not only prevents the sign of the change from reversing, but also + ! prevents the smoothing from more than doubling the original change. + ! It would take more testing to determine whether or not this is a good idea. + +! if (abs(dpowerlaw_c_smooth) > abs(dpowerlaw_c(i,j))) then +! factor = abs(dpowerlaw_c(i,j)) / abs(dpowerlaw_c_smooth) +! dpowerlaw_c_smooth = dpowerlaw_c_smooth * factor +! endif +! basal_physics%powerlaw_c_2d(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth + + endif ! cell is grounded + + if (verbose_inversion .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, 'Smoothing correction, new powerlaw_c:', dpowerlaw_c_smooth, basal_physics%powerlaw_c_2d(i,j) + endif + + enddo + enddo + + call parallel_halo(basal_physics%powerlaw_c_2d) + + ! Set coulomb_c assuming a fixed ratio of powerlaw_c/coulomb_c + basal_physics%coulomb_c_2d(:,:) = basal_physics%powerlaw_c_2d(:,:) / basal_physics%powerlaw_coulomb_ratio + + ! Limit coulomb_c to be <= 1, so that basal stress <= effective pressure N + basal_physics%coulomb_c_2d(:,:) = min(basal_physics%coulomb_c_2d(:,:), 1.0d0) + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + + i = itest + j = jtest + print*, 'thck (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck(i,j) + enddo + write(6,*) ' ' + enddo + print*, 'thck - thck_obs:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') dthck(i,j) + enddo + write(6,*) ' ' + enddo + print*, 'dthck_dt (m/yr):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') dthck_dt(i,j)*scyr + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'After smoothing, powerlaw_c:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_2d(i,j) + enddo + write(6,*) ' ' + enddo + print*, 'coulomb_c:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.4)',advance='no') basal_physics%coulomb_c_2d(i,j) + enddo + write(6,*) ' ' + enddo + + endif + + end subroutine calc_basal_inversion + !*********************************************************************** end module glissade_basal_traction diff --git a/libglissade/glissade_calving.F90 b/libglissade/glissade_calving.F90 index 96efc560..ad93c551 100644 --- a/libglissade/glissade_calving.F90 +++ b/libglissade/glissade_calving.F90 @@ -99,7 +99,7 @@ subroutine glissade_calving_mask_init(dx, dy, & ! calving_mask was read from the input file; do not need to compute a mask here - if (main_task) print*, 'Calving_mask was read from the input file' + if (verbose_calving .and. main_task) print*, 'Calving_mask was read from the input file' elseif (calving_front_x > 0.0d0 .or. calving_front_y > 0.0d0) then @@ -490,7 +490,7 @@ subroutine glissade_calve_ice(which_calving, & print*, ' ' print*, 'floating_mask, itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(i10)',advance='no') floating_mask(i,j) @@ -501,7 +501,7 @@ subroutine glissade_calve_ice(which_calving, & print*, ' ' print*, 'calving_front_mask, itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(i10)',advance='no') calving_front_mask(i,j) @@ -511,7 +511,7 @@ subroutine glissade_calve_ice(which_calving, & print*, ' ' print*, 'thck_calving_front (m), itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') thck_calving_front(i,j)*thk0 @@ -521,7 +521,7 @@ subroutine glissade_calve_ice(which_calving, & print*, ' ' print*, 'thck (m), itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') thck(i,j)*thk0 @@ -651,7 +651,7 @@ subroutine glissade_calve_ice(which_calving, & if (verbose_calving .and. this_rank == rtest) then print*, ' ' print*, 'eigenprod (yr-2), itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(e10.2)',advance='no') eigenprod(i,j) * scyr*scyr @@ -663,7 +663,7 @@ subroutine glissade_calve_ice(which_calving, & print*, 'Finished eigencalving, task =', this_rank print*, ' ' print*, 'calving_thck (m), itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') calving_thck(i,j)*thk0 @@ -672,7 +672,7 @@ subroutine glissade_calve_ice(which_calving, & enddo print*, ' ' print*, 'new thck (m), itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') thck(i,j)*thk0 @@ -715,7 +715,7 @@ subroutine glissade_calve_ice(which_calving, & print*, ' ' print*, 'calving_front_mask, itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(i10)',advance='no') calving_front_mask(i,j) @@ -725,7 +725,7 @@ subroutine glissade_calve_ice(which_calving, & print*, ' ' print*, 'thck_calving_front (m), itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') thck_calving_front(i,j)*thk0 @@ -735,7 +735,7 @@ subroutine glissade_calve_ice(which_calving, & print*, ' ' print*, 'thck (m), itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') thck(i,j)*thk0 @@ -831,7 +831,7 @@ subroutine glissade_calve_ice(which_calving, & print*, 'Did thickness-based calving, task =', this_rank print*, ' ' print*, 'Thickness-based calving_thck (m), itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 ! write(6,'(f10.3)',advance='no') calving_thck(i,j)*thk0 @@ -841,7 +841,7 @@ subroutine glissade_calve_ice(which_calving, & enddo print*, ' ' print*, 'new thck (m), itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') thck(i,j)*thk0 @@ -879,7 +879,7 @@ subroutine glissade_calve_ice(which_calving, & print*, ' ' print*, 'calving_front_mask, itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(i10)',advance='no') calving_front_mask(i,j) @@ -890,7 +890,7 @@ subroutine glissade_calve_ice(which_calving, & print*, ' ' print*, 'thck_calving_front (m), itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') thck_calving_front(i,j)*thk0 @@ -900,7 +900,7 @@ subroutine glissade_calve_ice(which_calving, & print*, ' ' print*, 'calving_thck (m) from limiting, itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') (calving_thck(i,j) - calving_thck_init(i,j))*thk0 @@ -909,7 +909,7 @@ subroutine glissade_calve_ice(which_calving, & enddo print*, ' ' print*, 'new thck (m), itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') thck(i,j)*thk0 @@ -928,7 +928,7 @@ subroutine glissade_calve_ice(which_calving, & print*, 'Limit advance of calving front' print*, ' ' print*, 'starting thck, itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') thck(i,j)*thk0 @@ -941,7 +941,7 @@ subroutine glissade_calve_ice(which_calving, & if (verbose_calving .and. this_rank==rtest) then print*, ' ' print*, 'calving_mask, itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(i10)',advance='no') calving_mask(i,j) @@ -964,7 +964,7 @@ subroutine glissade_calve_ice(which_calving, & if (verbose_calving .and. this_rank==rtest) then print*, ' ' print*, 'new thck, itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') thck(i,j)*thk0 @@ -1137,7 +1137,7 @@ subroutine glissade_calve_ice(which_calving, & if (verbose_calving .and. this_rank==rtest) then print*, ' ' print*, 'calving_domain_mask, itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(L10)',advance='no') calving_domain_mask(i,j) @@ -1293,7 +1293,7 @@ subroutine glissade_calve_ice(which_calving, & if (verbose_calving .and. this_rank==rtest) then print*, ' ' print*, 'After calving, new thck: itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') thck(i,j)*thk0 @@ -1328,7 +1328,7 @@ subroutine glissade_calve_ice(which_calving, & if (verbose_calving .and. this_rank==rtest) then print*, ' ' print*, 'marine_cliff_mask, itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(i10)',advance='no') marine_cliff_mask(i,j) @@ -1341,7 +1341,7 @@ subroutine glissade_calve_ice(which_calving, & if (verbose_calving .and. this_rank==rtest) then print*, ' ' print*, 'thckmax_cliff, itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 factor = taumax_cliff / (rhoi*grav) ! units are Pa for taumax, m for factor @@ -1436,7 +1436,7 @@ subroutine glissade_calve_ice(which_calving, & print*, ' ' print*, 'Final calving_thck (m), itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') calving_thck(i,j)*thk0 @@ -1446,7 +1446,7 @@ subroutine glissade_calve_ice(which_calving, & print*, ' ' print*, 'Final thck (m), itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') thck(i,j)*thk0 @@ -1596,7 +1596,7 @@ subroutine glissade_remove_icebergs(& print*, 'In glissade_remove_icebergs' print*, ' ' print*, 'thck, itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') thck(i,j)*thk0 @@ -1605,7 +1605,7 @@ subroutine glissade_remove_icebergs(& enddo print*, ' ' print*, 'calving_front_mask, itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(i10)',advance='no') calving_front_mask(i,j) @@ -1614,7 +1614,7 @@ subroutine glissade_remove_icebergs(& enddo print*, ' ' print*, 'thck_calving_front, itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') thck_calving_front(i,j)*thk0 @@ -1623,7 +1623,7 @@ subroutine glissade_remove_icebergs(& enddo print*, ' ' print*, 'active_ice_mask, itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(i10)',advance='no') active_ice_mask(i,j) @@ -1684,7 +1684,7 @@ subroutine glissade_remove_icebergs(& print*, 'cull_calving_front: After removing CF cells, n =', n print*, ' ' print*, 'thck, itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') thck(i,j)*thk0 @@ -1693,7 +1693,7 @@ subroutine glissade_remove_icebergs(& enddo print*, ' ' print*, 'calving_front_mask, itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(i10)',advance='no') calving_front_mask(i,j) @@ -1702,7 +1702,7 @@ subroutine glissade_remove_icebergs(& enddo print*, ' ' print*, 'thck_calving_front, itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') thck_calving_front(i,j)*thk0 @@ -1711,7 +1711,7 @@ subroutine glissade_remove_icebergs(& enddo print*, ' ' print*, 'active_ice_mask, itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(i10)',advance='no') active_ice_mask(i,j) @@ -1864,7 +1864,7 @@ subroutine glissade_remove_icebergs(& print*, 'Done in glissade_remove_icebergs' print*, ' ' print*, 'thck, itest, jtest, rank =', itest, jtest, rtest - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') thck(i,j)*thk0 diff --git a/libglissade/glissade_transport.F90 b/libglissade/glissade_transport.F90 index 7e4f55f3..0c985567 100644 --- a/libglissade/glissade_transport.F90 +++ b/libglissade/glissade_transport.F90 @@ -1417,7 +1417,12 @@ subroutine glissade_add_smb(nx, ny, & character(len=100) :: message - ! Initialize the applied mass balance and the melt potential. + ! Temporarily, convert the applied mass balance (intent inout) from m/s to m. + ! It is converted back to m/s for output. + acab_applied(:,:) = acab_applied(:,:) * dt + bmlt_applied(:,:) = bmlt_applied(:,:) * dt + + ! Initialize the melt potential. ! These terms are adjusted below if energy is available for melting ! when no ice is present. @@ -1602,7 +1607,7 @@ subroutine glissade_add_smb(nx, ny, & enddo endif - ! convert diagnostic output from m to m/s + ! convert applied mass balance from m to m/s acab_applied(:,:) = acab_applied(:,:) / dt bmlt_applied(:,:) = bmlt_applied(:,:) / dt diff --git a/libglissade/glissade_velo_higher.F90 b/libglissade/glissade_velo_higher.F90 index 828057a9..08ad579b 100644 --- a/libglissade/glissade_velo_higher.F90 +++ b/libglissade/glissade_velo_higher.F90 @@ -666,7 +666,7 @@ subroutine glissade_velo_higher_solve(model, & ! the local SIA solver (HO_APPROX_LOCAL_SIA) in glissade_velo_sia.F90. !---------------------------------------------------------------- - use glissade_basal_traction, only: calcbeta, calc_effective_pressure + use glissade_basal_traction, only: calcbeta, calc_effective_pressure, calc_basal_inversion use glissade_therm, only: glissade_pressure_melting_point !---------------------------------------------------------------- @@ -708,6 +708,7 @@ subroutine glissade_velo_higher_solve(model, & stagwbndsigma ! stagsigma augmented by sigma = 0 and 1 at upper and lower surfaces real(dp) :: & + dt, & ! time step (s) thklim, & ! minimum ice thickness for active grounded cells (m) thck_gradient_ramp, & ! thickness scale over which gradients are ramped up from zero to full value (m) max_slope, & ! maximum slope allowed for surface gradient computations (unitless) @@ -719,6 +720,8 @@ subroutine glissade_velo_higher_solve(model, & thck, & ! ice thickness (m) usrf, & ! upper surface elevation (m) topg, & ! elevation of topography (m) + thck_obs, & ! observed ice thickness (m), for inversion + dthck_dt, & ! rate of change of ice thickness (m/s), for inversion bpmp, & ! pressure melting point temperature (C) bwat, & ! basal water thickness (m) bmlt, & ! basal melt rate (m/yr) @@ -758,6 +761,7 @@ subroutine glissade_velo_higher_solve(model, & integer :: & whichbabc, & ! option for basal boundary condition + whichinversion, & ! option for basal traction inversion whicheffecpress, & ! option for effective pressure calculation whichefvs, & ! option for effective viscosity calculation ! (calculate it or make it uniform) @@ -1022,6 +1026,8 @@ subroutine glissade_velo_higher_solve(model, & thck => model%geometry%thck(:,:) usrf => model%geometry%usrf(:,:) topg => model%geometry%topg(:,:) + thck_obs => model%geometry%thck_obs(:,:) + dthck_dt => model%geometry%dthck_dt(:,:) ! Note: dthck_dt has units of m/s; no rescaling needed stagmask => model%geometry%stagmask(:,:) f_ground => model%geometry%f_ground(:,:) f_flotation => model%geometry%f_flotation(:,:) @@ -1060,6 +1066,7 @@ subroutine glissade_velo_higher_solve(model, & umask_no_penetration => model%velocity%umask_no_penetration(:,:) vmask_no_penetration => model%velocity%vmask_no_penetration(:,:) + dt = model%numerics%dt thklim = model%numerics%thklim thck_gradient_ramp = model%numerics%thck_gradient_ramp max_slope = model%paramets%max_slope @@ -1068,6 +1075,7 @@ subroutine glissade_velo_higher_solve(model, & pmp_threshold = model%temper%pmp_threshold whichbabc = model%options%which_ho_babc + whichinversion = model%options%which_ho_inversion whicheffecpress = model%options%which_ho_effecpress whichefvs = model%options%which_ho_efvs whichresid = model%options%which_ho_resid @@ -2139,6 +2147,27 @@ subroutine glissade_velo_higher_solve(model, & endif + !------------------------------------------------------------------------------ + ! Compute powerlaw_c_2d and coulomb_c_2d fields, if needed + ! (part of basal_physics derived type) + ! Note: dt and thck_obs are not rescaled by the scale_input subroutine, in order + ! to avoid accumulating errors by repeated multiplication and division. + !------------------------------------------------------------------------------ + + if (whichinversion == HO_INVERSION_COMPUTE) then + + call calc_basal_inversion(dt*tim0, & ! s + nx, ny, & + itest, jtest, rtest, & + model%basal_physics, & + ice_mask, & + floating_mask, & + thck, & ! m + dthck_dt, & ! m/s + thck_obs*thk0) ! m + + endif + !------------------------------------------------------------------------------ ! Main outer loop: Iterate to solve the nonlinear problem !------------------------------------------------------------------------------ @@ -2458,7 +2487,11 @@ subroutine glissade_velo_higher_solve(model, & beta*tau0/(vel0*scyr), & ! external beta (intent in) beta_internal, & ! beta weighted by f_ground (intent out) topg, eus, & - f_ground) + ice_mask, & + floating_mask, & + f_ground, & + whichinversion, & + itest, jtest, rtest) if (verbose_beta) then maxbeta = maxval(beta_internal(:,:)) @@ -2636,7 +2669,7 @@ subroutine glissade_velo_higher_solve(model, & endif if (whichbabc == HO_BABC_COULOMB_FRICTION .or. & - whichbabc == HO_BABC_COULOMB_CONST_BASAL_FLWA) then + whichbabc == HO_BABC_COULOMB_POWERLAW_SCHOOF) then print*, ' ' print*, 'C_space_factor_stag, itest, rank =', itest, rtest do j = ny-1, 1, -1 From be06428102149226a89eea1e0911e3274be22a82 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 11 Dec 2017 16:36:29 -0600 Subject: [PATCH 02/61] Added a subroutine to find interior lakes I wrote a subroutine to find interior lakes. These are defined as connected regions where ice is present and floating, but there is no path through other floating cells to ice-free ocean. The logic is similar to the algorithm used to remove icebergs. This subroutine is called at the start of the inversion procedure, when CISM computes a mask to identify floating cells whose thickness should be restored to observations. Lakes are now excluded from this mask, since it is unphysical to apply ocean melting to ice that is isolated from the ocean. For now, the subroutine glissade_find_lakes is in the calving module, just before the flood-fill utility subroutine. Later, it should probably go somewhere else. I tested the new code on idealized lake geometry, and then on the 8-km Antarctic grid. As far as I can tell, it correctly identifies all lakes. --- libglissade/glissade.F90 | 43 +++++- libglissade/glissade_calving.F90 | 224 +++++++++++++++++++++++++++++++ 2 files changed, 261 insertions(+), 6 deletions(-) diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index 69a57d5a..36ce2a8d 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -107,6 +107,7 @@ subroutine glissade_initialise(model, evolve_ice) use glissade_velo_higher, only: glissade_velo_higher_init use glide_diagnostics, only: glide_init_diag use glissade_calving, only: glissade_calving_mask_init, glissade_calve_ice + use glissade_calving, only: glissade_find_lakes !TODO - Move this subroutine? use glimmer_paramets, only: thk0, len0, tim0, evs0 use felix_dycore_interface, only: felix_velo_init @@ -123,7 +124,13 @@ subroutine glissade_initialise(model, evolve_ice) real(dp) :: var_maxval ! max value of a given variable; = 0 if not yet read in integer :: i, j, k logical :: l_evolve_ice ! local version of evolve_ice - integer, dimension(:,:), allocatable :: ice_mask + integer, dimension(:,:), allocatable :: & + ice_mask, & ! = 1 where ice is present, else = 0 + floating_mask, & ! = 1 where ice is present and floating, else = 0 + ocean_mask, & ! = 1 if topg is below sea level and ice is absent, else = 0 + lake_mask ! = 1 for floating cells disconnected from the ocean + + integer :: itest, jtest, rtest if (present(evolve_ice)) then l_evolve_ice = evolve_ice @@ -507,6 +514,11 @@ subroutine glissade_initialise(model, evolve_ice) endwhere endif + ! Set debug diagnostics + rtest = model%numerics%rdiag_local + itest = model%numerics%idiag_local + jtest = model%numerics%jdiag_local + ! initialize the calving scheme as needed ! Currently, only the CALVING_GRID_MASK option requires initialization ! Note: calving_front_x and calving_front_y already have units of m, so do not require multiplying by len0 @@ -543,8 +555,7 @@ subroutine glissade_initialise(model, evolve_ice) model%options%which_ho_calving_front, & model%options%remove_icebergs, & model%options%limit_marine_cliffs, & - model%numerics%idiag_local, model%numerics%jdiag_local, & - model%numerics%rdiag_local, & + itest, jtest, rtest, & model%geometry%thck, & model%isostasy%relx, & model%geometry%topg, & @@ -596,6 +607,8 @@ subroutine glissade_initialise(model, evolve_ice) if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then + !TODO - Move the following code to an inversion_init subroutine? + ! Save the initial ice thickness, if it will be used as the observational target for inversion. ! Note: If calving is done at initialization, the target is the post-calving thickness. ! The inversion will not try to put ice where, e.g., initial icebergs are removed. @@ -613,9 +626,13 @@ subroutine glissade_initialise(model, evolve_ice) call parallel_halo(model%geometry%thck_obs) ! Initialize a mask for inversion. - ! Basal melting will be applied wherever the observed target ice is floating. + ! Basal melting will be applied wherever the observed target ice is floating, + ! provided the floating ice has a connection to the ocean. - allocate(ice_mask(model%general%ewn, model%general%nsn)) ! required argument for subroutine + allocate(ice_mask(model%general%ewn, model%general%nsn)) + allocate(floating_mask(model%general%ewn, model%general%nsn)) + allocate(ocean_mask(model%general%ewn, model%general%nsn)) + allocate(lake_mask(model%general%ewn, model%general%nsn)) call glissade_get_masks(model%general%ewn, model%general%nsn, & model%geometry%thck_obs*thk0, & @@ -623,7 +640,21 @@ subroutine glissade_initialise(model, evolve_ice) model%climate%eus*thk0, & 0.0d0, & ! thklim = 0 ice_mask, & - floating_mask = model%basal_melt%bmlt_inversion_mask) + floating_mask = floating_mask, & + ocean_mask = ocean_mask) + + ! Identify floating cells that will not be restored to the target thickness + + call glissade_find_lakes(model%general%ewn, model%general%nsn, & + itest, jtest, rtest, & + ice_mask, floating_mask, & + ocean_mask, lake_mask) + + where (floating_mask == 1 .and. lake_mask == 0) + model%basal_melt%bmlt_inversion_mask = 1 + elsewhere + model%basal_melt%bmlt_inversion_mask = 0 + endwhere !TODO - Modify bmlt_inversion_mask adjacent to land cells. diff --git a/libglissade/glissade_calving.F90 b/libglissade/glissade_calving.F90 index ad93c551..6a00dd2f 100644 --- a/libglissade/glissade_calving.F90 +++ b/libglissade/glissade_calving.F90 @@ -1875,6 +1875,230 @@ subroutine glissade_remove_icebergs(& end subroutine glissade_remove_icebergs +!**************************************************************************** + + subroutine glissade_find_lakes(nx, ny, & + itest, jtest, rtest, & + ice_mask, floating_mask, & + ocean_mask, lake_mask) + + ! Identify cells with basal lakes: i.e., cells that are floating but have + ! no connection through other floating cells to the ocean. + + !TODO - Move this subroutine elsewhere (e.g., glissade_basal_traction) + + integer, intent(in) :: nx, ny !> horizontal grid dimensions + + integer, intent(in) :: itest, jtest, rtest !> coordinates of diagnostic point + + integer, dimension(nx,ny), intent(in) :: & + ice_mask, & !> = 1 where ice is present (thck > thklim), else = 0 + floating_mask, & !> = 1 where ice is present (thck > thklim) and floating, else = 0 + ocean_mask !> = 1 where topg is below sea level and ice is absent, else = 0 + + integer, dimension(nx,ny), intent(out) :: & + lake_mask !> = 1 for floating cells disconnected from the ocean, else = 0 + + ! local variables + + integer, dimension(nx,ny) :: & + color ! integer 'color' for identifying icebergs + + integer :: i, j + integer :: count, maxcount_fill ! loop counters + + logical, parameter :: verbose_lakes = .false. + + !WHL - debug + real(dp) :: sum_fill_local, sum_fill_global + integer :: ig, jg + + if (verbose_lakes .and. this_rank == rtest) then + print*, ' ' + print*, 'In glissade_find_lakes, itest, jtest, rank =', itest, jtest, rtest + print*, ' ' + print*, 'ice_mask' + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = itest-3, itest+3 + write(6,'(i10)',advance='no') ice_mask(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'floating_mask' + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = itest-3, itest+3 + write(6,'(i10)',advance='no') floating_mask(i,j) + enddo + write(6,*) ' ' + enddo + endif + + ! initialize + ! Floating cells receive the initial color; + ! grounded cells and ice-free cells receive the boundary color. + + do j = 1, ny + do i = 1, nx + if (floating_mask(i,j) == 1) then + color(i,j) = initial_color + else ! grounded or ice-free + color(i,j) = boundary_color + endif + enddo + enddo + + ! Loop through cells, identifying floating cells that border the ocean. + ! Fill each such floating cell, and then recursively fill floating neighbor cells. + ! We may have to do this several times to incorporate connections between neighboring processors. + + maxcount_fill = max(ewtasks,nstasks) + + if (verbose_lakes .and. main_task) print*, 'maxcount_fill =', maxcount_fill + + do count = 1, maxcount_fill + + if (count == 1) then ! identify floating cells adjacent to ocean cells, which can seed the fill + + do j = 2, ny-1 + do i = 2, nx-1 + if (floating_mask(i,j) == 1) then + if (ocean_mask(i-1,j) == 1 .or. ocean_mask(i+1,j) == 1 .or. & + ocean_mask(i,j-1) == 1 .or. ocean_mask(i,j+1) == 1) then + + if (color(i,j) /= boundary_color .and. color(i,j) /= fill_color) then + + ! assign the fill color to this cell, and recursively fill floating neighbor cells + call glissade_fill(nx, ny, & + i, j, & + color, floating_mask) + endif + endif ! adjacent to ocean + endif ! floating + enddo ! i + enddo ! j + + else ! count > 1 + + ! Check for halo cells that were just filled on neighbor processors + ! Note: In order for a halo cell to seed the fill on this processor, it must not only have the fill color, + ! but also must be an active cell. + !TODO - Only need to check whether color = fill_color? + + call parallel_halo(color) + + ! west halo layer + i = nhalo + do j = 1, ny + if (color(i,j) == fill_color .and. floating_mask(i,j) == 1) then + call glissade_fill(nx, ny, & + i+1, j, & + color, floating_mask) + endif + enddo + + ! east halo layers + i = nx - nhalo + 1 + do j = 1, ny + if (color(i,j) == fill_color .and. floating_mask(i,j) == 1) then + call glissade_fill(nx, ny, & + i-1, j, & + color, floating_mask) + endif + enddo + + ! south halo layer + j = nhalo + do i = nhalo+1, nx-nhalo ! already checked halo corners above + if (color(i,j) == fill_color .and. floating_mask(i,j) == 1) then + call glissade_fill(nx, ny, & + i, j+1, & + color, floating_mask) + endif + enddo + + ! north halo layer + j = ny-nhalo+1 + do i = nhalo+1, nx-nhalo ! already checked halo corners above + if (color(i,j) == fill_color .and. floating_mask(i,j) == 1) then + call glissade_fill(nx, ny, & + i, j-1, & + color, floating_mask) + endif + enddo + + endif ! count = 1 + + sum_fill_local = 0 + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + if (color(i,j) == fill_color) sum_fill_local = sum_fill_local + 1 + enddo + enddo + + !WHL - If running a large problem, may want to reduce the frequency of this global sum + sum_fill_global = parallel_reduce_sum(sum_fill_local) + + if (verbose_lakes .and. main_task) then + print*, 'this_rank, sum_fill_local, sum_fill_global:', this_rank, sum_fill_local, sum_fill_global + endif + + enddo ! count + + ! Identify lake cells: floating cells that still have the initial color. + + lake_mask(:,:) = 0 + + do j = 1, ny + do i = 1, nx + if (color(i,j) == initial_color .and. floating_mask(i,j) == 1) then + lake_mask(i,j) = 1 + + if (verbose_lakes .and. this_rank == rtest) then + call parallel_globalindex(i, j, ig, jg) + print*, 'Lake cell: task, i, j, ig, jg =', this_rank, i, j, ig, jg + endif + + endif + enddo + enddo + + call parallel_halo(lake_mask) + + if (verbose_lakes .and. this_rank == rtest) then + print*, ' ' + print*, 'color, rank =', this_rank + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = nx-10, nx + write(6,'(i10)',advance='no') color(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'floating_mask, rank =', this_rank + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = nx-10, nx + write(6,'(i10)',advance='no') floating_mask(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'lake_mask, rank =', this_rank + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = nx-10, nx + write(6,'(i10)',advance='no') lake_mask(i,j) + enddo + write(6,*) ' ' + enddo + endif + + end subroutine glissade_find_lakes + !**************************************************************************** recursive subroutine glissade_fill(nx, ny, & From a498f456ede007067ee9cd9aade9a710ca7fe2d9 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 11 Dec 2017 17:04:28 -0600 Subject: [PATCH 03/61] Switched location of initial calving mask call For the calving mask option (whichcalving = 5), subroutine glissade_calving_mask_init is called at initialization to identify cells where any floating ice is assumed to calve. I moved this call from just before to just after the initial calving call. The reason is that the initial calving can cull cells at the calving front, and we want the calving mask to reflect the calving-front location after the culling. This turns out to be important for Antarctic inversion, because restoring the ice thickness in culled cells can lead to dynamics instabilities. This commit can be answer-changing for runs that use a calving mask and also have initial calving. --- libglissade/glissade.F90 | 48 +++++++++++++++++++++------------------- 1 file changed, 25 insertions(+), 23 deletions(-) diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index 36ce2a8d..e6ef61e9 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -519,20 +519,6 @@ subroutine glissade_initialise(model, evolve_ice) itest = model%numerics%idiag_local jtest = model%numerics%jdiag_local - ! initialize the calving scheme as needed - ! Currently, only the CALVING_GRID_MASK option requires initialization - ! Note: calving_front_x and calving_front_y already have units of m, so do not require multiplying by len0 - - if (model%options%whichcalving == CALVING_GRID_MASK .and. model%options%is_restart == RESTART_FALSE) then - - call glissade_calving_mask_init(& - model%numerics%dew*len0, model%numerics%dns*len0, & - model%geometry%thck*thk0, model%geometry%topg*thk0, & - model%climate%eus*thk0, model%numerics%thklim*thk0, & - model%calving%calving_front_x, model%calving%calving_front_y, & - model%calving%calving_mask) - endif - ! initial calving, if desired ! Note: Do this only for a cold start with evolving ice, not for a restart if (l_evolve_ice .and. & @@ -546,6 +532,8 @@ subroutine glissade_initialise(model, evolve_ice) ! which if true can remove floating peninsulas in the input data by ! preceding the call to remove_icebergs with removal of one or more ! layers of calving_front cells. + ! Culling may also be used to remove a row of thin cells (~1 m) + ! at the calving front, as present in some input data sets. ! The call to calving during glissade_tstep does not include this argument, ! since we do not want to remove calving_front cells every timestep. ! ------------------------------------------------------------------------ @@ -597,6 +585,21 @@ subroutine glissade_initialise(model, evolve_ice) endif ! initial calving + ! Initialize the no-advance calving_mask, if desired + ! Note: This is done after initial calving, which may include iceberg removal or front culling. + ! The calving front that exists after initial culling is the one that is held fixed during the simulation. + ! Note: calving_front_x and calving_front_y already have units of m, so do not require multiplying by len0. + + if (model%options%whichcalving == CALVING_GRID_MASK .and. model%options%is_restart == RESTART_FALSE) then + + call glissade_calving_mask_init(& + model%numerics%dew*len0, model%numerics%dns*len0, & + model%geometry%thck*thk0, model%geometry%topg*thk0, & + model%climate%eus*thk0, model%numerics%thklim*thk0, & + model%calving%calving_front_x, model%calving%calving_front_y, & + model%calving%calving_mask) + endif + ! Note: The DIVA solver needs a halo update for effective viscosity. ! This is done at the end of glissade_diagnostic_variable_solve, which in most cases is sufficient. ! However, if we are (1) reading efvs from an input file and (2) solving for velocity before @@ -1565,7 +1568,7 @@ subroutine glissade_transport_solve(model) print*, ' ' print*, 'bmlt_inversion_mask:' do j = jtest+3, jtest-3, -1 - do i = itest-4, itest+4 + do i = itest-3, itest+3 write(6,'(i12)',advance='no') model%basal_melt%bmlt_inversion_mask(i,j) enddo write(6,*) ' ' @@ -1573,7 +1576,7 @@ subroutine glissade_transport_solve(model) print*, ' ' print*, 'floating_mask:' do j = jtest+3, jtest-3, -1 - do i = itest-4, itest+4 + do i = itest-3, itest+3 write(6,'(i12)',advance='no') floating_mask(i,j) enddo write(6,*) ' ' @@ -1581,7 +1584,7 @@ subroutine glissade_transport_solve(model) print*, ' ' print*, 'thck (m):' do j = jtest+3, jtest-3, -1 - do i = itest-4, itest+4 + do i = itest-3, itest+3 write(6,'(f12.5)',advance='no') thck_unscaled(i,j) enddo write(6,*) ' ' @@ -1589,7 +1592,7 @@ subroutine glissade_transport_solve(model) print*, ' ' print*, 'thck - thck_obs (m):' do j = jtest+3, jtest-3, -1 - do i = itest-4, itest+4 + do i = itest-3, itest+3 write(6,'(f12.5)',advance='no') thck_unscaled(i,j) - model%geometry%thck_obs(i,j)*thk0 enddo write(6,*) ' ' @@ -1597,7 +1600,7 @@ subroutine glissade_transport_solve(model) print*, ' ' print*, 'thck_flotation (m):' do j = jtest+3, jtest-3, -1 - do i = itest-4, itest+4 + do i = itest-3, itest+3 write(6,'(f12.5)',advance='no') -(rhoo/rhoi)*model%geometry%topg(i,j)*thk0 enddo write(6,*) ' ' @@ -1605,13 +1608,12 @@ subroutine glissade_transport_solve(model) print*, ' ' print*, 'bmlt_float_inversion (m/yr):' do j = jtest+3, jtest-3, -1 - do i = itest-4, itest+4 + do i = itest-3, itest+3 write(6,'(f12.5)',advance='no') model%basal_melt%bmlt_float_inversion(i,j)*scyr enddo write(6,*) ' ' enddo - endif ! Zero out acab since this call uses bmlt_float_inversion only @@ -1645,7 +1647,7 @@ subroutine glissade_transport_solve(model) print*, ' ' print*, 'thck (m):' do j = jtest+3, jtest-3, -1 - do i = itest-4, itest+4 + do i = itest-3, itest+3 write(6,'(f12.5)',advance='no') thck_unscaled(i,j) enddo write(6,*) ' ' @@ -1653,7 +1655,7 @@ subroutine glissade_transport_solve(model) print*, ' ' print*, 'thck - thck_obs (m):' do j = jtest+3, jtest-3, -1 - do i = itest-4, itest+4 + do i = itest-3, itest+3 write(6,'(f12.5)',advance='no') thck_unscaled(i,j) - model%geometry%thck_obs(i,j)*thk0 enddo write(6,*) ' ' From cd047ac73c8027a5565199e410820304fd61f489 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 11 Dec 2017 18:08:12 -0600 Subject: [PATCH 04/61] Made calving-front cells active if adjacent to land When the subgrid calving front scheme is turned on (which_ho_calving_front = 1), most calving-front cells are inactive. Previously, CF cells have been active only if their thickness is greater than or equal to the thickness of upstream interior ice. With this commit, calving-front cells are also active if they are adjacent to land cells. This change fixes a numerical instability that turned up during an Antarctic inversion. Recall that the purpose of the CF scheme is to avoid unstable, inaccurate dynamics resulting from a thin CF cell adjacent to a much thicker cell (giving a large gradient in surface elevation). When the upstream cell is land-based (and by definition grounded), a large elevation gradient between adjacent cells is not likely to destabilize the model, and might be realistic. This commit is answer-changing for marine ice simulations with calving-front cells adjacent to land, if the CF scheme is turned on. --- libglissade/glissade_masks.F90 | 26 +++++++++++++++++++------- 1 file changed, 19 insertions(+), 7 deletions(-) diff --git a/libglissade/glissade_masks.F90 b/libglissade/glissade_masks.F90 index 9457496d..8268acfd 100644 --- a/libglissade/glissade_masks.F90 +++ b/libglissade/glissade_masks.F90 @@ -277,7 +277,7 @@ subroutine glissade_get_masks(nx, ny, & ! and choose the minimum nonzero thickness do jj = j-1, j+1 do ii = i-1, i+1 - if (ii == i .or. jj == j) then ! edge neighbors only + if ((ii == i .or. jj == j) .and. (ii /= i .or. jj /= j)) then ! edge neighbors if ( (grounded_mask(ii,jj) == 1 .and. topg(ii,jj) < eus) .or. & floating_interior_mask(ii,jj) == 1) then if (thck_calving_front(i,j) > 0.0d0) then @@ -321,23 +321,35 @@ subroutine glissade_get_masks(nx, ny, & if (present(active_ice_mask)) then + if (.not.present(land_mask)) then + call write_log('Must pass land_mask to compute active_ice_mask with calving-front option', GM_FATAL) + endif + ! reset active_ice_mask active_ice_mask(:,:) = 0 - ! Mark ice-filled cells as active, except cells on the calving front with thck < thck_calving front. - do j = 1, ny - do i = 1, nx + ! Mark ice-filled cells as active. + ! Calving-front cells, however, are inactive, unless they have thck >= thck_calving front or + ! are adjacent to land cells. + do j = 2, ny-1 + do i = 2, nx-1 if (ice_mask(i,j) == 1) then if (calving_front_mask(i,j) == 0) then active_ice_mask(i,j) = 1 - elseif (calving_front_mask(i,j) == 1 .and. & - thck_calving_front(i,j) > 0.0d0 .and. thck(i,j) >= thck_calving_front(i,j)) then - active_ice_mask(i,j) = 1 + elseif (calving_front_mask(i,j) == 1) then + if (thck_calving_front(i,j) > 0.0d0 .and. thck(i,j) >= thck_calving_front(i,j)) then + active_ice_mask(i,j) = 1 + elseif (land_mask(i-1,j) == 1 .or. land_mask(i+1,j) == 1 .or. & + land_mask(i,j-1) == 1 .or. land_mask(i,j+1) == 1) then + active_ice_mask(i,j) = 1 + endif endif endif ! ice_mask enddo enddo + call parallel_halo(active_ice_mask) + endif ! active_ice_mask is present else ! no subgrid calving front From 2980f043e387a0f5fa14af7d56146daf50d1d112 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 11 Dec 2017 18:42:30 -0600 Subject: [PATCH 05/61] Do not invert for bmlt_float in cells adjacent to land With this commit, there is a second exception to the rule that we invert for bmlt_float in cells that are initially floating: we do not invert in cells adjacent to land. Inverting for bmlt_float in cells adjacent to land can result in instabilities in Antarctic runs. (The other exception is for lake cells, which have no connection to the ocean.) --- libglissade/glissade.F90 | 29 ++++++++++++++++++++++------- 1 file changed, 22 insertions(+), 7 deletions(-) diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index e6ef61e9..d03f1d90 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -128,6 +128,7 @@ subroutine glissade_initialise(model, evolve_ice) ice_mask, & ! = 1 where ice is present, else = 0 floating_mask, & ! = 1 where ice is present and floating, else = 0 ocean_mask, & ! = 1 if topg is below sea level and ice is absent, else = 0 + land_mask, & ! = 1 if topg is at or above sea level, else = 0 lake_mask ! = 1 for floating cells disconnected from the ocean integer :: itest, jtest, rtest @@ -634,6 +635,7 @@ subroutine glissade_initialise(model, evolve_ice) allocate(ice_mask(model%general%ewn, model%general%nsn)) allocate(floating_mask(model%general%ewn, model%general%nsn)) + allocate(land_mask(model%general%ewn, model%general%nsn)) allocate(ocean_mask(model%general%ewn, model%general%nsn)) allocate(lake_mask(model%general%ewn, model%general%nsn)) @@ -644,7 +646,8 @@ subroutine glissade_initialise(model, evolve_ice) 0.0d0, & ! thklim = 0 ice_mask, & floating_mask = floating_mask, & - ocean_mask = ocean_mask) + ocean_mask = ocean_mask, & + land_mask = land_mask) ! Identify floating cells that will not be restored to the target thickness @@ -653,13 +656,25 @@ subroutine glissade_initialise(model, evolve_ice) ice_mask, floating_mask, & ocean_mask, lake_mask) - where (floating_mask == 1 .and. lake_mask == 0) - model%basal_melt%bmlt_inversion_mask = 1 - elsewhere - model%basal_melt%bmlt_inversion_mask = 0 - endwhere + model%basal_melt%bmlt_inversion_mask(:,:) = 0 + + do j = 2, model%general%nsn-1 + do i = 2, model%general%ewn-1 + if (floating_mask(i,j) == 1) then + ! check for land neighbors + if (land_mask(i-1,j) == 1 .or. land_mask(i+1,j) == 1 .or. & + land_mask(i,j-1) == 1 .or. land_mask(i,j+1) == 1) then + ! mask = 0; do not invert for bmlt_float + elseif (lake_mask(i,j) == 1) then + ! mask = 0; do not invert for bmlt_float + else + model%basal_melt%bmlt_inversion_mask(i,j) = 1 + endif + endif + enddo + enddo - !TODO - Modify bmlt_inversion_mask adjacent to land cells. + call parallel_halo(model%basal_melt%bmlt_inversion_mask) ! Check whether powerlaw_c_2d has been read in already. ! If not, then set to a constant value. From 1cd187aedb71044f919b1535b76d4d553356a479 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 18 Dec 2017 15:38:40 -0700 Subject: [PATCH 06/61] Added code for forward runs using parameters from inversion Previous commits included code for computing basal sliding and basal melt fields by inversion, relaxing toward a target ice thickness (which_ho_inversion = 1). This commit includes code to support option which_ho_inversion = 2, in which basal sliding and melt fields from a previous inversion are applied: * For which_ho_inversion = HO_INVERSION_PRESCRIBED = 2, CISM checks during glissade initialization that powerlaw_c_2d and bmlt_float_inversion have been read in. During each time step, bmlt_float_inversion is applied after transport, wherever the ice is currently floating. * In glide_types.F90, I added '_tavg' (time-average) versions of powerlaw_c_2d and bmlt_float_inversion. To write time-average fields instead of snapshots, the user should uncomment the line 'average: 1' for each field in glide_vars.def. Time-average fields may work better than snapshots for the forward run. Note: In Antarctic runs, I found that there are issues with having different physics assumptions in the forward run (option 2) compared to the inversion run (option 1). Specifically, bmlt_float_inversion is computed wherever the ice was initially floating, but is applied only where the ice is currently floating. This difference makes it possible for the grounding line to advance in the forward run instead of staying put as in the inversion run. I'll try to fix this issue in upcoming commits. Answers change only for option which_ho_inversion = 2. --- libglide/glide_types.F90 | 16 ++- libglide/glide_vars.def | 4 + libglissade/glissade.F90 | 128 ++++++++++++++++++++++++ libglissade/glissade_basal_traction.F90 | 3 +- 4 files changed, 147 insertions(+), 4 deletions(-) diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index 2bcab45b..1e493bcf 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -1108,7 +1108,7 @@ module glide_types !> holds fields and parameters related to calving !> Note: The 3D damage field is prognostic; the 2D damage_column field is diagnosed from the 3D damage field. real(dp),dimension(:,:), pointer :: calving_thck => null() !> thickness loss in grid cell due to calving - !< scaled by thk0 like mass balance, thickness, etc. + !> scaled by thk0 like mass balance, thickness, etc. integer, dimension(:,:), pointer :: calving_mask => null() !> calve floating ice wherever the mask = 1 (whichcalving = CALVING_GRID_MASK) real(dp),dimension(:,:), pointer :: thck_calving_front => null()!> effective ice thickness at calving front, divided by \texttt{thk0}. real(dp),dimension(:,:), pointer :: strain_rate_eigenprod !> product of eigenvalues of 2D horizontal strain rate tensor (s^-2) @@ -1262,8 +1262,9 @@ module glide_types bmlt_float => null(), & !> basal melt rate for floating ice bmlt_float_external => null(), & !> external basal melt rate field bmlt_float_anomaly => null(), & !> basal melt rate anomaly field - bmlt_float_inversion => null() !> basal melt rate computed by inversion; + bmlt_float_inversion => null(), & !> basal melt rate computed by inversion; !> relaxes thickness of floating ice toward observed target + bmlt_float_inversion_tavg => null() !> basal melt rate computed by inversion (time average) integer, dimension(:,:), pointer :: & bmlt_inversion_mask => null() !> = 1 where bmlt is applied for inversion, else = 0 @@ -1337,7 +1338,7 @@ module glide_types end type glide_plume !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - + !TODO - Change '!<' to '!>' type glide_basal_physics !< Holds variables related to basal physics associated with ice dynamics !< See glissade_basal_traction.F90 for usage details @@ -1362,6 +1363,8 @@ module glide_types real(dp), dimension(:,:), pointer :: C_space_factor_stag => null() !< spatial factor for basal shear stress on staggered grid (no dimension) real(dp), dimension(:,:), pointer :: tau_c => null() !< yield stress for plastic sliding (Pa) real(dp), dimension(:,:), pointer :: powerlaw_c_2d => null() !< spatially varying powerlaw_c field, Pa m^(-1/3) yr^(1/3) + real(dp), dimension(:,:), pointer :: powerlaw_c_2d_tavg => null() !< spatially varying powerlaw_c field, Pa m^(-1/3) yr^(1/3) + !< time-averaged to provide input for a forward run real(dp), dimension(:,:), pointer :: coulomb_c_2d => null() !< spatially varying coulomb_c field (unitless) ! parameters for reducing the effective pressure where the bed is warm, saturated or connected to the ocean @@ -1844,6 +1847,7 @@ subroutine glide_allocarr(model) !> \item \texttt{bmlt_float_external(ewn,nsn)} !> \item \texttt{bmlt_float_anomaly(ewn,nsn)} !> \item \texttt{bmlt_float_inversion(ewn,nsn)} + !> \item \texttt{bmlt_float_inversion_tavg(ewn,nsn)} !> \item \texttt{bmlt_inversion_mask(ewn,nsn)} !> \end{itemize} @@ -2176,6 +2180,7 @@ subroutine glide_allocarr(model) call coordsystem_allocate(model%general%velo_grid, model%basal_physics%effecpress_stag) call coordsystem_allocate(model%general%velo_grid, model%basal_physics%tau_c) call coordsystem_allocate(model%general%ice_grid, model%basal_physics%powerlaw_c_2d) + call coordsystem_allocate(model%general%ice_grid, model%basal_physics%powerlaw_c_2d_tavg) call coordsystem_allocate(model%general%ice_grid, model%basal_physics%coulomb_c_2d) call coordsystem_allocate(model%general%ice_grid, model%basal_physics%C_space_factor) call coordsystem_allocate(model%general%velo_grid, model%basal_physics%C_space_factor_stag) @@ -2196,6 +2201,7 @@ subroutine glide_allocarr(model) endif if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_float_inversion) + call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_float_inversion_tavg) call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_inversion_mask) endif if (model%options%whichbmlt_float == BMLT_FLOAT_MISOMIP) then @@ -2511,6 +2517,8 @@ subroutine glide_deallocarr(model) deallocate(model%basal_physics%tau_c) if (associated(model%basal_physics%powerlaw_c_2d)) & deallocate(model%basal_physics%powerlaw_c_2d) + if (associated(model%basal_physics%powerlaw_c_2d_tavg)) & + deallocate(model%basal_physics%powerlaw_c_2d_tavg) if (associated(model%basal_physics%coulomb_c_2d)) & deallocate(model%basal_physics%coulomb_c_2d) if (associated(model%basal_physics%C_space_factor)) & @@ -2536,6 +2544,8 @@ subroutine glide_deallocarr(model) deallocate(model%basal_melt%bmlt_float_anomaly) if (associated(model%basal_melt%bmlt_float_inversion)) & deallocate(model%basal_melt%bmlt_float_inversion) + if (associated(model%basal_melt%bmlt_float_inversion_tavg)) & + deallocate(model%basal_melt%bmlt_float_inversion_tavg) if (associated(model%basal_melt%bmlt_inversion_mask)) & deallocate(model%basal_melt%bmlt_inversion_mask) diff --git a/libglide/glide_vars.def b/libglide/glide_vars.def index 145eb029..b554cf23 100644 --- a/libglide/glide_vars.def +++ b/libglide/glide_vars.def @@ -307,6 +307,8 @@ long_name: basal melt rate for floating ice from inversion data: data%basal_melt%bmlt_float_inversion factor: scyr coordinates: lon lat +#WHL - Uncomment to compute bmlt_float_inversion_tavg +#average: 1 #WHL - A number of plume-related fields follow. @@ -841,6 +843,8 @@ long_name: spatially varying C for powerlaw sliding data: data%basal_physics%powerlaw_c_2d load: 1 coordinates: lon lat +#WHL - Uncomment to compute powerlaw_c_2d_tavg +#average: 1 [coulomb_c_2d] dimensions: time, y1, x1 diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index d03f1d90..05c04b9c 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -688,6 +688,46 @@ subroutine glissade_initialise(model, evolve_ice) call parallel_halo(model%basal_physics%powerlaw_c_2d) + elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then + + ! prescribing basal friction coefficient and basal melting from previous inversion + + ! Check that the required fields from the inversion are present: powerlaw_c_2d and bmlt_float_inversion. + + ! Note: A good way to supply powerlaw_c_2d is to compute powerlaw_c_2d_tavg + ! over some period at the end of the inversion run, after the ice is spun up. + ! To output this field from the inversion run, uncomment 'average: 1' under + ! powerlaw_c_2d in glide_vars.def, then configure and rebuild the code. + ! After the inversion run, rename powerlaw_c_2d_tavg as powerlaw_c_2d and + ! copy it to the input file for the prescribed run. + ! And similarly for bmlt_float_inversion_tavg and bmlt_float_inversion + + var_maxval = maxval(model%basal_physics%powerlaw_c_2d) + var_maxval = parallel_reduce_max(var_maxval) + if (var_maxval > 0.0d0) then + ! powerlaw_c_2d has been read in as required + write(message,*) 'powerlaw_c_2d has been read from input file' + call write_log(trim(message)) + else + write(message,*) 'ERROR: Must read powerlaw_c_2d from input file to use this inversion option' + call write_log(trim(message), GM_FATAL) + endif + + call parallel_halo(model%basal_physics%powerlaw_c_2d) + + var_maxval = maxval(abs(model%basal_melt%bmlt_float_inversion)) + var_maxval = parallel_reduce_max(var_maxval) + if (var_maxval > 0.0d0) then + ! bmlt_float_inversion has been read in as required + write(message,*) 'bmlt_float_inversion has been read from input file' + call write_log(trim(message)) + else + write(message,*) 'ERROR: Must read bmlt_float_inversion from input file to use this inversion option' + call write_log(trim(message), GM_FATAL) + endif + + call parallel_halo(model%basal_melt%bmlt_float_inversion) + endif ! which_ho_inversion ! recalculate the lower and upper ice surface @@ -1682,6 +1722,94 @@ subroutine glissade_transport_solve(model) ! is called later, during the velocity solve. ! It requires the same ice mask and floating mask as the velocity solver. + elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then + + ! ------------------------------------------------------------------------ + ! Get masks used by glissade_mass_balance_driver. + ! Pass thklim = 0 to identify cells with thck > 0 (not thck > thklim). + ! ------------------------------------------------------------------------ + + call glissade_get_masks(model%general%ewn, model%general%nsn, & + thck_unscaled, & ! m + model%geometry%topg*thk0, & ! m + model%climate%eus*thk0, & ! m + 0.0d0, & ! thklim = 0 + ice_mask, & + floating_mask = floating_mask, & + ocean_mask = ocean_mask) + + ! For purposes of inversion, assign all cells an effective fraction of 1 or 0. + ! Calving-front cells are treated the same as other ice-covered cells. + where (ocean_mask == 1) + effective_areafrac = 0.0d0 + elsewhere + effective_areafrac = 1.0d0 + endwhere + + ! Zero out bmlt_float for floating cells. + !TODO - Modify to apply bmlt_float to cells that were fully floating before transport. + + where (floating_mask == 0) + model%basal_melt%bmlt_float_inversion = 0.0d0 + endwhere + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'Prescribing bmlt_float from inversion: rank, i, j =', rtest, i, j + print*, 'thck (m), bmlt_float_inversion (m/yr):', thck_unscaled(i,j), & + model%basal_melt%bmlt_float_inversion(i,j)*scyr + print*, ' ' + print*, 'floating_mask:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(i12)',advance='no') floating_mask(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'thck (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f12.5)',advance='no') thck_unscaled(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'bmlt_float_inversion (m/yr):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f12.5)',advance='no') model%basal_melt%bmlt_float_inversion(i,j)*scyr + enddo + write(6,*) ' ' + enddo + + endif + + ! Zero out acab since this call uses bmlt_float_inversion only + acab_unscaled(:,:) = 0.0d0 + + ! Apply basal melting for inversion. + ! Note: Basal melting applied during this call is added to bmlt_applied. + call glissade_mass_balance_driver(model%numerics%dt * tim0, & + model%numerics%dew * len0, model%numerics%dns * len0, & + model%general%ewn, model%general%nsn, & + model%general%upn-1, model%numerics%sigma, & + thck_unscaled(:,:), & ! m + acab_unscaled(:,:), & ! m/s + model%basal_melt%bmlt_float_inversion(:,:), & ! m/s + model%climate%acab_applied(:,:), & ! m/s + model%basal_melt%bmlt_applied(:,:), & ! m/s + ocean_mask(:,:), & + effective_areafrac(:,:), & + model%geometry%ntracers, & + model%geometry%tracers(:,:,:,:), & + model%geometry%tracers_usrf(:,:,:), & + model%geometry%tracers_lsrf(:,:,:), & + model%options%which_ho_vertical_remap) + endif ! which_ho_inversion ! copy tracers (temp/enthalpy, etc.) from model%geometry%tracers back to standard arrays diff --git a/libglissade/glissade_basal_traction.F90 b/libglissade/glissade_basal_traction.F90 index 15ecc044..1246e86b 100644 --- a/libglissade/glissade_basal_traction.F90 +++ b/libglissade/glissade_basal_traction.F90 @@ -463,7 +463,8 @@ subroutine calcbeta (whichbabc, & enddo enddo - else ! use powerlaw_c and coulomb_c from inversion + elseif (which_inversion == HO_INVERSION_COMPUTE .or. & + which_inversion == HO_INVERSION_PRESCRIBED) then ! use powerlaw_c and coulomb_c from inversion m = basal_physics%powerlaw_m From ee8bd3957c0090d7e7efc7574f1a6bd3ac88d88b Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Tue, 19 Dec 2017 15:31:17 -0700 Subject: [PATCH 07/61] Added a new glissade module for inversion I created a module called glissade_inversion.F90. For now, this module hass two working subroutines: - invert_basal_traction, which is identical to the calc_basal_inversion subroutine previously in glissade_basal_traction.F90 - glissade_init_inversion, which contains code that was previously inlined in glissade.F90 I plan to write another subroutine to invert for bmlt_float_inversion, using a method similar to the method used for powerlaw_c_2d. This commit is BFB. --- libglissade/glissade.F90 | 124 +----- libglissade/glissade_basal_traction.F90 | 270 +------------ libglissade/glissade_inversion.F90 | 486 ++++++++++++++++++++++++ libglissade/glissade_velo_higher.F90 | 21 +- 4 files changed, 507 insertions(+), 394 deletions(-) create mode 100644 libglissade/glissade_inversion.F90 diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index 05c04b9c..f5f1b1e2 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -108,6 +108,7 @@ subroutine glissade_initialise(model, evolve_ice) use glide_diagnostics, only: glide_init_diag use glissade_calving, only: glissade_calving_mask_init, glissade_calve_ice use glissade_calving, only: glissade_find_lakes !TODO - Move this subroutine? + use glissade_inversion, only: glissade_init_inversion use glimmer_paramets, only: thk0, len0, tim0, evs0 use felix_dycore_interface, only: felix_velo_init @@ -609,124 +610,11 @@ subroutine glissade_initialise(model, evolve_ice) ! An update is done here regardless of code options, just to be on the safe side. call parallel_halo(model%stress%efvs) - if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then - !TODO - Move the following code to an inversion_init subroutine? + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & + model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then - ! Save the initial ice thickness, if it will be used as the observational target for inversion. - ! Note: If calving is done at initialization, the target is the post-calving thickness. - ! The inversion will not try to put ice where, e.g., initial icebergs are removed. - - ! Check whether thck_obs has been read in already. - ! If not, then set thck_obs to the initial thickness (possibly modified by initial calving). - var_maxval = maxval(model%geometry%thck_obs) - var_maxval = parallel_reduce_max(var_maxval) - if (var_maxval > 0.0d0) then - ! do nothing; thck_obs has been read in already (e.g., after restart) - else - model%geometry%thck_obs(:,:) = model%geometry%thck(:,:) - endif - - call parallel_halo(model%geometry%thck_obs) - - ! Initialize a mask for inversion. - ! Basal melting will be applied wherever the observed target ice is floating, - ! provided the floating ice has a connection to the ocean. - - allocate(ice_mask(model%general%ewn, model%general%nsn)) - allocate(floating_mask(model%general%ewn, model%general%nsn)) - allocate(land_mask(model%general%ewn, model%general%nsn)) - allocate(ocean_mask(model%general%ewn, model%general%nsn)) - allocate(lake_mask(model%general%ewn, model%general%nsn)) - - call glissade_get_masks(model%general%ewn, model%general%nsn, & - model%geometry%thck_obs*thk0, & - model%geometry%topg*thk0, & - model%climate%eus*thk0, & - 0.0d0, & ! thklim = 0 - ice_mask, & - floating_mask = floating_mask, & - ocean_mask = ocean_mask, & - land_mask = land_mask) - - ! Identify floating cells that will not be restored to the target thickness - - call glissade_find_lakes(model%general%ewn, model%general%nsn, & - itest, jtest, rtest, & - ice_mask, floating_mask, & - ocean_mask, lake_mask) - - model%basal_melt%bmlt_inversion_mask(:,:) = 0 - - do j = 2, model%general%nsn-1 - do i = 2, model%general%ewn-1 - if (floating_mask(i,j) == 1) then - ! check for land neighbors - if (land_mask(i-1,j) == 1 .or. land_mask(i+1,j) == 1 .or. & - land_mask(i,j-1) == 1 .or. land_mask(i,j+1) == 1) then - ! mask = 0; do not invert for bmlt_float - elseif (lake_mask(i,j) == 1) then - ! mask = 0; do not invert for bmlt_float - else - model%basal_melt%bmlt_inversion_mask(i,j) = 1 - endif - endif - enddo - enddo - - call parallel_halo(model%basal_melt%bmlt_inversion_mask) - - ! Check whether powerlaw_c_2d has been read in already. - ! If not, then set to a constant value. - var_maxval = maxval(model%basal_physics%powerlaw_c_2d) - var_maxval = parallel_reduce_max(var_maxval) - if (var_maxval > 0.0d0) then - ! do nothing; powerlaw_c_2d has been read in already (e.g., after restart) - else - model%basal_physics%powerlaw_c_2d(:,:) = model%basal_physics%powerlaw_c - endif - - call parallel_halo(model%basal_physics%powerlaw_c_2d) - - elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then - - ! prescribing basal friction coefficient and basal melting from previous inversion - - ! Check that the required fields from the inversion are present: powerlaw_c_2d and bmlt_float_inversion. - - ! Note: A good way to supply powerlaw_c_2d is to compute powerlaw_c_2d_tavg - ! over some period at the end of the inversion run, after the ice is spun up. - ! To output this field from the inversion run, uncomment 'average: 1' under - ! powerlaw_c_2d in glide_vars.def, then configure and rebuild the code. - ! After the inversion run, rename powerlaw_c_2d_tavg as powerlaw_c_2d and - ! copy it to the input file for the prescribed run. - ! And similarly for bmlt_float_inversion_tavg and bmlt_float_inversion - - var_maxval = maxval(model%basal_physics%powerlaw_c_2d) - var_maxval = parallel_reduce_max(var_maxval) - if (var_maxval > 0.0d0) then - ! powerlaw_c_2d has been read in as required - write(message,*) 'powerlaw_c_2d has been read from input file' - call write_log(trim(message)) - else - write(message,*) 'ERROR: Must read powerlaw_c_2d from input file to use this inversion option' - call write_log(trim(message), GM_FATAL) - endif - - call parallel_halo(model%basal_physics%powerlaw_c_2d) - - var_maxval = maxval(abs(model%basal_melt%bmlt_float_inversion)) - var_maxval = parallel_reduce_max(var_maxval) - if (var_maxval > 0.0d0) then - ! bmlt_float_inversion has been read in as required - write(message,*) 'bmlt_float_inversion has been read from input file' - call write_log(trim(message)) - else - write(message,*) 'ERROR: Must read bmlt_float_inversion from input file to use this inversion option' - call write_log(trim(message), GM_FATAL) - endif - - call parallel_halo(model%basal_melt%bmlt_float_inversion) + call glissade_init_inversion(model) endif ! which_ho_inversion @@ -1718,8 +1606,8 @@ subroutine glissade_transport_solve(model) endif - ! Note: Subroutine calc_basal_inversion, which inverts for basal parameters, - ! is called later, during the velocity solve. + ! Note: Subroutine invert_basal_traction, which inverts for basal parameters, + ! is called later, during the velocity solve. ! It requires the same ice mask and floating mask as the velocity solver. elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then diff --git a/libglissade/glissade_basal_traction.F90 b/libglissade/glissade_basal_traction.F90 index 1246e86b..06fdc57d 100644 --- a/libglissade/glissade_basal_traction.F90 +++ b/libglissade/glissade_basal_traction.F90 @@ -56,7 +56,7 @@ module glissade_basal_traction implicit none private - public :: calcbeta, calc_effective_pressure, calc_basal_inversion + public :: calcbeta, calc_effective_pressure !*********************************************************************** @@ -911,271 +911,9 @@ subroutine calc_effective_pressure (which_effecpress, & end subroutine calc_effective_pressure -!*********************************************************************** - - subroutine calc_basal_inversion(dt, & - nx, ny, & - itest, jtest, rtest, & - basal_physics, & - ice_mask, floating_mask, & - thck, dthck_dt, & - thck_obs) - - ! Compute spatially varying fields, powerlaw_c_2d and coulomb_c_2d, by inversion. - ! The method is similar to that of Pollard & DeConto (TC, 2012), and is applied to all grounded ice. - ! Where thck > thck_obs, powerlaw_c and coulomb_c are reduced to increase sliding. - ! Where thck < thck_obs, powerlaw_c and coulomb_c are increased to reduce sliding. - ! Note: powerlaw_c is constrained to lie within a prescribed range. - ! The ratio of powerlaw_c to coulomb_c is fixed (except that coulomb_c must be <= 1). - - use parallel - - real(dp), intent(in) :: dt ! time step (s) - - integer, intent(in) :: & - nx, ny ! grid dimensions - - integer, intent(in) :: & - itest, jtest, rtest ! coordinates of diagnostic point - - type(glide_basal_physics), intent(inout) :: & - basal_physics ! basal physics object - - integer, dimension(nx,ny), intent(in) :: & - ice_mask, & ! = 1 where ice is present (thk > thklim), else = 0 - floating_mask ! = 1 where ice is present and floating, else = 0 - - real(dp), dimension(nx,ny), intent(in) :: & - thck, & ! ice thickness (m) - dthck_dt, & ! rate of change of ice thickness (m/s) - thck_obs ! observed thickness (m) - - ! local variables - - real(dp), dimension(nx,ny) :: & - dthck, & ! thck - thck_obs on ice grid - old_powerlaw_c, & ! old value of powerlaw_c_2d (start of timestep) - temp_powerlaw_c, & ! temporary value of powerlaw_c_2d (before smoothing) - dpowerlaw_c ! change in powerlaw_c - - real(dp) :: term1, term2 - real(dp) :: factor - real(dp) :: dpowerlaw_c_smooth - - integer :: i, j - integer :: ii, jj - - ! inversion parameters in basal_physics derived type: - ! * powerlaw_c_max = upper bound for powerlaw_c, Pa (m/yr)^(-1/3) - ! * powerlaw_c_min = lower bound for powerlaw_c, Pa (m/yr)^(-1/3) - ! * powerlaw_coulomb_ratio = powerlaw_c/coulomb_c (same units as powerlaw_c) - ! * inversion_timescale = inversion timescale (s); must be > 0 - ! * inversion_thck_scale = thickness inversion scale (m); must be > 0 - ! * inversion_dthck_dt_scale = dthck_dt inversion scale (m/s); must be > 0 - ! * inversion_smoothing_factor = factor for smoothing powerlaw_c_2d; higher => more smoothing - ! - ! Note on smoothing: A smoothing factor of 1/8 gives a 4-1-1-1-1 smoother. - ! This is numerically well behaved, but may oversmooth in bowl-shaped regions; - ! a smaller value may be better as H converges toward H_obs. - - logical, parameter :: verbose_inversion = .false. - - ! Save the starting value - old_powerlaw_c(:,:) = basal_physics%powerlaw_c_2d(:,:) - dpowerlaw_c(:,:) = 0.0d0 - - ! Compute difference between current and target thickness - dthck(:,:) = thck(:,:) - thck_obs(:,:) - - ! Loop over cells - ! Note: powerlaw_c_2d and coulomb_c_2d are computed at cell centers where thck is located. - ! Later, they are interpolated to vertices where beta and basal velocity are located. - - do j = 1, ny - do i = 1, nx - - if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! ice is present and grounded - - ! Invert for powerlaw_c_2d and coulomb_c based on dthck and dthck_dt - term1 = -dthck(i,j) / basal_physics%inversion_thck_scale - term2 = -dthck_dt(i,j) / basal_physics%inversion_dthck_dt_scale - - dpowerlaw_c(i,j) = (dt/basal_physics%inversion_timescale) & - * basal_physics%powerlaw_c_2d(i,j) * (term1 + term2) - - ! Limit to prevent huge change in one step - if (abs(dpowerlaw_c(i,j)) > 0.05 * basal_physics%powerlaw_c_2d(i,j)) then - if (dpowerlaw_c(i,j) > 0.0d0) then - dpowerlaw_c(i,j) = 0.05d0 * basal_physics%powerlaw_c_2d(i,j) - else - dpowerlaw_c(i,j) = -0.05d0 * basal_physics%powerlaw_c_2d(i,j) - endif - endif - - basal_physics%powerlaw_c_2d(i,j) = basal_physics%powerlaw_c_2d(i,j) + dpowerlaw_c(i,j) - - ! Limit to a physically reasonable range - basal_physics%powerlaw_c_2d(i,j) = min(basal_physics%powerlaw_c_2d(i,j), basal_physics%powerlaw_c_max) - basal_physics%powerlaw_c_2d(i,j) = max(basal_physics%powerlaw_c_2d(i,j), basal_physics%powerlaw_c_min) - - !WHL - debug - if (verbose_inversion .and. this_rank == rtest .and. i==itest .and. j==jtest) then - print*, ' ' - print*, 'Invert for powerlaw_c and coulomb_c: rank, i, j =', rtest, itest, jtest - print*, 'thck, thck_obs, dthck, dthck_dt:', thck(i,j), thck_obs(i,j), dthck(i,j), dthck_dt(i,j)*scyr - print*, '-dthck/thck_scale, -dthck_dt/dthck_dt_scale, sum =', & - -dthck(i,j)/basal_physics%inversion_thck_scale, & - -dthck_dt(i,j)/basal_physics%inversion_dthck_dt_scale, & - term1 + term2 - print*, 'dpowerlaw_c, newpowerlaw_c =', dpowerlaw_c(i,j), basal_physics%powerlaw_c_2d(i,j) - endif - - else ! ice_mask = 0 or floating_mask = 1 - - ! set to default value - basal_physics%powerlaw_c_2d(i,j) = basal_physics%powerlaw_c - - endif ! ice_mask = 1 and floating_mask = 0 - - enddo ! i - enddo ! j - - !WHL - debug - if (verbose_inversion .and. this_rank == rtest) then - i = itest - j = jtest - print*, ' ' - print*, 'Before smoothing, powerlaw_c:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_2d(i,j) - enddo - write(6,*) ' ' - enddo - endif - - ! Save the value just computed - temp_powerlaw_c(:,:) = basal_physics%powerlaw_c_2d(:,:) - - ! Apply Laplacian smoothing to C_p. - ! Since C_p is at cell centers but is interpolated to vertices, smoothing can damp checkerboard noise. - !TODO - Write an operator for Laplacian smoothing? - do j = 2, ny-1 - do i = 2, nx-1 - if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! cell (i,j) is grounded - - dpowerlaw_c_smooth = -4.0d0 * basal_physics%inversion_smoothing_factor * temp_powerlaw_c(i,j) - do jj = j-1, j+1 - do ii = i-1, i+1 - if ((ii == i .or. jj == j) .and. (ii /= i .or. jj /= j)) then ! edge neighbor - if (ice_mask(ii,jj) == 1 .and. floating_mask(ii,jj) == 0) then ! cell (ii,jj) is grounded - dpowerlaw_c_smooth = dpowerlaw_c_smooth & - + basal_physics%inversion_smoothing_factor*temp_powerlaw_c(ii,jj) - else - dpowerlaw_c_smooth = dpowerlaw_c_smooth & - + basal_physics%inversion_smoothing_factor*temp_powerlaw_c(i,j) - endif - endif - enddo - enddo - - ! Note: If smoothing is too strong, it can reverse the sign of the change in powerlaw_c. - ! The logic below ensures that if powerlaw_c_2d is increasing, the smoothing can reduce - ! the change to zero, but not cause powerlaw_c to decrease relative to old_powerlaw_c - ! (and similarly if powerlaw_c_2d is decreasing). - - if (dpowerlaw_c(i,j) > 0.0d0) then - if (temp_powerlaw_c(i,j) + dpowerlaw_c_smooth > old_powerlaw_c(i,j)) then - basal_physics%powerlaw_c_2d(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth - else - ! allow the smoothing to hold Cp at its old value, but not reduce Cp - basal_physics%powerlaw_c_2d(i,j) = old_powerlaw_c(i,j) - endif - elseif (dpowerlaw_c(i,j) < 0.0d0) then - if (temp_powerlaw_c(i,j) + dpowerlaw_c_smooth < old_powerlaw_c(i,j)) then - basal_physics%powerlaw_c_2d(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth - else - ! allow the smoothing to hold Cp at its old value, but not increase Cp - basal_physics%powerlaw_c_2d(i,j) = old_powerlaw_c(i,j) - endif - endif ! dpowerlaw_c > 0 - - ! The next 5 lines are commented out. If used in place of the limiting above, - ! this code not only prevents the sign of the change from reversing, but also - ! prevents the smoothing from more than doubling the original change. - ! It would take more testing to determine whether or not this is a good idea. - -! if (abs(dpowerlaw_c_smooth) > abs(dpowerlaw_c(i,j))) then -! factor = abs(dpowerlaw_c(i,j)) / abs(dpowerlaw_c_smooth) -! dpowerlaw_c_smooth = dpowerlaw_c_smooth * factor -! endif -! basal_physics%powerlaw_c_2d(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth - - endif ! cell is grounded - - if (verbose_inversion .and. this_rank==rtest .and. i==itest .and. j==jtest) then - print*, 'Smoothing correction, new powerlaw_c:', dpowerlaw_c_smooth, basal_physics%powerlaw_c_2d(i,j) - endif - - enddo - enddo - - call parallel_halo(basal_physics%powerlaw_c_2d) - - ! Set coulomb_c assuming a fixed ratio of powerlaw_c/coulomb_c - basal_physics%coulomb_c_2d(:,:) = basal_physics%powerlaw_c_2d(:,:) / basal_physics%powerlaw_coulomb_ratio - - ! Limit coulomb_c to be <= 1, so that basal stress <= effective pressure N - basal_physics%coulomb_c_2d(:,:) = min(basal_physics%coulomb_c_2d(:,:), 1.0d0) - - !WHL - debug - if (verbose_inversion .and. this_rank == rtest) then - - i = itest - j = jtest - print*, 'thck (m):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck(i,j) - enddo - write(6,*) ' ' - enddo - print*, 'thck - thck_obs:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') dthck(i,j) - enddo - write(6,*) ' ' - enddo - print*, 'dthck_dt (m/yr):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') dthck_dt(i,j)*scyr - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'After smoothing, powerlaw_c:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_2d(i,j) - enddo - write(6,*) ' ' - enddo - print*, 'coulomb_c:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.4)',advance='no') basal_physics%coulomb_c_2d(i,j) - enddo - write(6,*) ' ' - enddo - - endif - - end subroutine calc_basal_inversion - -!*********************************************************************** +!======================================================================= end module glissade_basal_traction -!*********************************************************************** +!======================================================================= + diff --git a/libglissade/glissade_inversion.F90 b/libglissade/glissade_inversion.F90 new file mode 100644 index 00000000..e2c91d69 --- /dev/null +++ b/libglissade/glissade_inversion.F90 @@ -0,0 +1,486 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glissade_inversion.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2017 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +module glissade_inversion + + use glimmer_physcon, only: scyr + use glimmer_paramets, only: thk0 + use glimmer_log + use glide_types + use parallel + + implicit none + + !----------------------------------------------------------------------------- + ! Subroutines to invert for basal fields (including basal traction beneath + ! grounded ice and basal melting beneath floating ice) by relaxing toward + ! a target ice thickness field. + !----------------------------------------------------------------------------- + +!*********************************************************************** + +contains + +!*********************************************************************** + + subroutine glissade_init_inversion(model) + + use glissade_masks, only: glissade_get_masks + use glissade_calving, only: glissade_find_lakes !TODO - Move this subroutine? + + ! Initialize inversion for fields of basal traction and basal melting + + type(glide_global_type), intent(inout) :: model ! model instance + + ! local variables + + real(dp) :: var_maxval ! max value of a given variable; = 0 if not yet read in + + integer :: ewn, nsn + integer :: itest, jtest, rtest ! coordinates of diagnostic point + integer :: i, j + + integer, dimension(:,:), allocatable :: & + ice_mask, & ! = 1 where ice is present, else = 0 + floating_mask, & ! = 1 where ice is present and floating, else = 0 + ocean_mask, & ! = 1 if topg is below sea level and ice is absent, else = 0 + land_mask, & ! = 1 if topg is at or above sea level, else = 0 + lake_mask ! = 1 for floating cells disconnected from the ocean + + character(len=100) :: message + + ! set grid dimensions + ewn = model%general%ewn + nsn = model%general%nsn + + ! Set debug diagnostics + rtest = model%numerics%rdiag_local + itest = model%numerics%idiag_local + jtest = model%numerics%jdiag_local + + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then + + !TODO - Move the following code to an inversion_init subroutine? + + ! Save the initial ice thickness, if it will be used as the observational target for inversion. + ! Note: If calving is done at initialization, the target is the post-calving thickness. + ! The inversion will not try to put ice where, e.g., initial icebergs are removed. + + ! Check whether thck_obs has been read in already. + ! If not, then set thck_obs to the initial thickness (possibly modified by initial calving). + var_maxval = maxval(model%geometry%thck_obs) + var_maxval = parallel_reduce_max(var_maxval) + if (var_maxval > 0.0d0) then + ! do nothing; thck_obs has been read in already (e.g., after restart) + else + model%geometry%thck_obs(:,:) = model%geometry%thck(:,:) + endif + + call parallel_halo(model%geometry%thck_obs) + + ! Initialize a mask for inversion. + ! Basal melting will be applied wherever the observed target ice is floating, + ! provided the floating ice has a connection to the ocean. + + allocate(ice_mask(ewn,nsn)) + allocate(floating_mask(ewn,nsn)) + allocate(land_mask(ewn,nsn)) + allocate(ocean_mask(ewn,nsn)) + allocate(lake_mask(ewn,nsn)) + + call glissade_get_masks(ewn, nsn, & + model%geometry%thck_obs*thk0, & + model%geometry%topg*thk0, & + model%climate%eus*thk0, & + 0.0d0, & ! thklim = 0 + ice_mask, & + floating_mask = floating_mask, & + ocean_mask = ocean_mask, & + land_mask = land_mask) + + ! Identify lake cells: floating interior cells that will not be restored + ! to the target thickness + + call glissade_find_lakes(ewn, nsn, & + itest, jtest, rtest, & + ice_mask, floating_mask, & + ocean_mask, lake_mask) + + model%basal_melt%bmlt_inversion_mask(:,:) = 0 + + do j = 2, nsn - 1 + do i = 2, ewn - 1 + if (floating_mask(i,j) == 1) then + ! check for land neighbors + if (land_mask(i-1,j) == 1 .or. land_mask(i+1,j) == 1 .or. & + land_mask(i,j-1) == 1 .or. land_mask(i,j+1) == 1) then + ! mask = 0; do not invert for bmlt_float + elseif (lake_mask(i,j) == 1) then + ! mask = 0; do not invert for bmlt_float + else + model%basal_melt%bmlt_inversion_mask(i,j) = 1 + endif + endif + enddo + enddo + + call parallel_halo(model%basal_melt%bmlt_inversion_mask) + + ! Check whether powerlaw_c_2d has been read in already. + ! If not, then set to a constant value. + var_maxval = maxval(model%basal_physics%powerlaw_c_2d) + var_maxval = parallel_reduce_max(var_maxval) + if (var_maxval > 0.0d0) then + ! do nothing; powerlaw_c_2d has been read in already (e.g., after restart) + else + model%basal_physics%powerlaw_c_2d(:,:) = model%basal_physics%powerlaw_c + endif + + call parallel_halo(model%basal_physics%powerlaw_c_2d) + + elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then + + ! prescribing basal friction coefficient and basal melting from previous inversion + + ! Check that the required fields from the inversion are present: powerlaw_c_2d and bmlt_float_inversion. + + ! Note: A good way to supply powerlaw_c_2d is to compute powerlaw_c_2d_tavg + ! over some period at the end of the inversion run, after the ice is spun up. + ! To output this field from the inversion run, uncomment 'average: 1' under + ! powerlaw_c_2d in glide_vars.def, then configure and rebuild the code. + ! After the inversion run, rename powerlaw_c_2d_tavg as powerlaw_c_2d and + ! copy it to the input file for the prescribed run. + ! And similarly for bmlt_float_inversion_tavg and bmlt_float_inversion + + var_maxval = maxval(model%basal_physics%powerlaw_c_2d) + var_maxval = parallel_reduce_max(var_maxval) + if (var_maxval > 0.0d0) then + ! powerlaw_c_2d has been read in as required + write(message,*) 'powerlaw_c_2d has been read from input file' + call write_log(trim(message)) + else + write(message,*) 'ERROR: Must read powerlaw_c_2d from input file to use this inversion option' + call write_log(trim(message), GM_FATAL) + endif + + call parallel_halo(model%basal_physics%powerlaw_c_2d) + + var_maxval = maxval(abs(model%basal_melt%bmlt_float_inversion)) + var_maxval = parallel_reduce_max(var_maxval) + if (var_maxval > 0.0d0) then + ! bmlt_float_inversion has been read in as required + write(message,*) 'bmlt_float_inversion has been read from input file' + call write_log(trim(message)) + else + write(message,*) 'ERROR: Must read bmlt_float_inversion from input file to use this inversion option' + call write_log(trim(message), GM_FATAL) + endif + + call parallel_halo(model%basal_melt%bmlt_float_inversion) + + endif ! which_ho_inversion + + end subroutine glissade_init_inversion + +!*********************************************************************** + +!TODO - Change to invert_basal_traction? + + subroutine invert_basal_traction(dt, & + nx, ny, & + itest, jtest, rtest, & + basal_physics, & + ice_mask, floating_mask, & + thck, dthck_dt, & + thck_obs) + + ! Compute spatially varying fields, powerlaw_c_2d and coulomb_c_2d, by inversion. + ! The method is similar to that of Pollard & DeConto (TC, 2012), and is applied to all grounded ice. + ! Where thck > thck_obs, powerlaw_c and coulomb_c are reduced to increase sliding. + ! Where thck < thck_obs, powerlaw_c and coulomb_c are increased to reduce sliding. + ! Note: powerlaw_c is constrained to lie within a prescribed range. + ! The ratio of powerlaw_c to coulomb_c is fixed (except that coulomb_c must be <= 1). + + real(dp), intent(in) :: dt ! time step (s) + + integer, intent(in) :: & + nx, ny ! grid dimensions + + integer, intent(in) :: & + itest, jtest, rtest ! coordinates of diagnostic point + + type(glide_basal_physics), intent(inout) :: & + basal_physics ! basal physics object + + integer, dimension(nx,ny), intent(in) :: & + ice_mask, & ! = 1 where ice is present (thk > thklim), else = 0 + floating_mask ! = 1 where ice is present and floating, else = 0 + + real(dp), dimension(nx,ny), intent(in) :: & + thck, & ! ice thickness (m) + dthck_dt, & ! rate of change of ice thickness (m/s) + thck_obs ! observed thickness (m) + + ! local variables + + real(dp), dimension(nx,ny) :: & + dthck, & ! thck - thck_obs on ice grid + old_powerlaw_c, & ! old value of powerlaw_c_2d (start of timestep) + temp_powerlaw_c, & ! temporary value of powerlaw_c_2d (before smoothing) + dpowerlaw_c ! change in powerlaw_c + + real(dp) :: term1, term2 + real(dp) :: factor + real(dp) :: dpowerlaw_c_smooth + + integer :: i, j + integer :: ii, jj + + ! inversion parameters in basal_physics derived type: + ! * powerlaw_c_max = upper bound for powerlaw_c, Pa (m/yr)^(-1/3) + ! * powerlaw_c_min = lower bound for powerlaw_c, Pa (m/yr)^(-1/3) + ! * powerlaw_coulomb_ratio = powerlaw_c/coulomb_c (same units as powerlaw_c) + ! * inversion_timescale = inversion timescale (s); must be > 0 + ! * inversion_thck_scale = thickness inversion scale (m); must be > 0 + ! * inversion_dthck_dt_scale = dthck_dt inversion scale (m/s); must be > 0 + ! * inversion_smoothing_factor = factor for smoothing powerlaw_c_2d; higher => more smoothing + ! + ! Note on smoothing: A smoothing factor of 1/8 gives a 4-1-1-1-1 smoother. + ! This is numerically well behaved, but may oversmooth in bowl-shaped regions; + ! a smaller value may be better as H converges toward H_obs. + + logical, parameter :: verbose_inversion = .false. + + ! Save the starting value + old_powerlaw_c(:,:) = basal_physics%powerlaw_c_2d(:,:) + dpowerlaw_c(:,:) = 0.0d0 + + ! Compute difference between current and target thickness + dthck(:,:) = thck(:,:) - thck_obs(:,:) + + ! Loop over cells + ! Note: powerlaw_c_2d and coulomb_c_2d are computed at cell centers where thck is located. + ! Later, they are interpolated to vertices where beta and basal velocity are located. + + do j = 1, ny + do i = 1, nx + + if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! ice is present and grounded + + ! Invert for powerlaw_c_2d and coulomb_c based on dthck and dthck_dt + term1 = -dthck(i,j) / basal_physics%inversion_thck_scale + term2 = -dthck_dt(i,j) / basal_physics%inversion_dthck_dt_scale + + dpowerlaw_c(i,j) = (dt/basal_physics%inversion_timescale) & + * basal_physics%powerlaw_c_2d(i,j) * (term1 + term2) + + ! Limit to prevent huge change in one step + if (abs(dpowerlaw_c(i,j)) > 0.05 * basal_physics%powerlaw_c_2d(i,j)) then + if (dpowerlaw_c(i,j) > 0.0d0) then + dpowerlaw_c(i,j) = 0.05d0 * basal_physics%powerlaw_c_2d(i,j) + else + dpowerlaw_c(i,j) = -0.05d0 * basal_physics%powerlaw_c_2d(i,j) + endif + endif + + basal_physics%powerlaw_c_2d(i,j) = basal_physics%powerlaw_c_2d(i,j) + dpowerlaw_c(i,j) + + ! Limit to a physically reasonable range + basal_physics%powerlaw_c_2d(i,j) = min(basal_physics%powerlaw_c_2d(i,j), basal_physics%powerlaw_c_max) + basal_physics%powerlaw_c_2d(i,j) = max(basal_physics%powerlaw_c_2d(i,j), basal_physics%powerlaw_c_min) + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest .and. i==itest .and. j==jtest) then + print*, ' ' + print*, 'Invert for powerlaw_c and coulomb_c: rank, i, j =', rtest, itest, jtest + print*, 'thck, thck_obs, dthck, dthck_dt:', thck(i,j), thck_obs(i,j), dthck(i,j), dthck_dt(i,j)*scyr + print*, '-dthck/thck_scale, -dthck_dt/dthck_dt_scale, sum =', & + -dthck(i,j)/basal_physics%inversion_thck_scale, & + -dthck_dt(i,j)/basal_physics%inversion_dthck_dt_scale, & + term1 + term2 + print*, 'dpowerlaw_c, newpowerlaw_c =', dpowerlaw_c(i,j), basal_physics%powerlaw_c_2d(i,j) + endif + + else ! ice_mask = 0 or floating_mask = 1 + + ! set to default value + basal_physics%powerlaw_c_2d(i,j) = basal_physics%powerlaw_c + + endif ! ice_mask = 1 and floating_mask = 0 + + enddo ! i + enddo ! j + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'Before smoothing, powerlaw_c:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_2d(i,j) + enddo + write(6,*) ' ' + enddo + endif + + ! Save the value just computed + temp_powerlaw_c(:,:) = basal_physics%powerlaw_c_2d(:,:) + + ! Apply Laplacian smoothing to C_p. + ! Since C_p is at cell centers but is interpolated to vertices, smoothing can damp checkerboard noise. + !TODO - Write an operator for Laplacian smoothing? + do j = 2, ny-1 + do i = 2, nx-1 + if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! cell (i,j) is grounded + + dpowerlaw_c_smooth = -4.0d0 * basal_physics%inversion_smoothing_factor * temp_powerlaw_c(i,j) + do jj = j-1, j+1 + do ii = i-1, i+1 + if ((ii == i .or. jj == j) .and. (ii /= i .or. jj /= j)) then ! edge neighbor + if (ice_mask(ii,jj) == 1 .and. floating_mask(ii,jj) == 0) then ! cell (ii,jj) is grounded + dpowerlaw_c_smooth = dpowerlaw_c_smooth & + + basal_physics%inversion_smoothing_factor*temp_powerlaw_c(ii,jj) + else + dpowerlaw_c_smooth = dpowerlaw_c_smooth & + + basal_physics%inversion_smoothing_factor*temp_powerlaw_c(i,j) + endif + endif + enddo + enddo + + ! Note: If smoothing is too strong, it can reverse the sign of the change in powerlaw_c. + ! The logic below ensures that if powerlaw_c_2d is increasing, the smoothing can reduce + ! the change to zero, but not cause powerlaw_c to decrease relative to old_powerlaw_c + ! (and similarly if powerlaw_c_2d is decreasing). + + if (dpowerlaw_c(i,j) > 0.0d0) then + if (temp_powerlaw_c(i,j) + dpowerlaw_c_smooth > old_powerlaw_c(i,j)) then + basal_physics%powerlaw_c_2d(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth + else + ! allow the smoothing to hold Cp at its old value, but not reduce Cp + basal_physics%powerlaw_c_2d(i,j) = old_powerlaw_c(i,j) + endif + elseif (dpowerlaw_c(i,j) < 0.0d0) then + if (temp_powerlaw_c(i,j) + dpowerlaw_c_smooth < old_powerlaw_c(i,j)) then + basal_physics%powerlaw_c_2d(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth + else + ! allow the smoothing to hold Cp at its old value, but not increase Cp + basal_physics%powerlaw_c_2d(i,j) = old_powerlaw_c(i,j) + endif + endif ! dpowerlaw_c > 0 + + ! The next 5 lines are commented out. If used in place of the limiting above, + ! this code not only prevents the sign of the change from reversing, but also + ! prevents the smoothing from more than doubling the original change. + ! It would take more testing to determine whether or not this is a good idea. + +! if (abs(dpowerlaw_c_smooth) > abs(dpowerlaw_c(i,j))) then +! factor = abs(dpowerlaw_c(i,j)) / abs(dpowerlaw_c_smooth) +! dpowerlaw_c_smooth = dpowerlaw_c_smooth * factor +! endif +! basal_physics%powerlaw_c_2d(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth + + endif ! cell is grounded + + if (verbose_inversion .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, 'Smoothing correction, new powerlaw_c:', dpowerlaw_c_smooth, basal_physics%powerlaw_c_2d(i,j) + endif + + enddo + enddo + + call parallel_halo(basal_physics%powerlaw_c_2d) + + ! Set coulomb_c assuming a fixed ratio of powerlaw_c/coulomb_c + basal_physics%coulomb_c_2d(:,:) = basal_physics%powerlaw_c_2d(:,:) / basal_physics%powerlaw_coulomb_ratio + + ! Limit coulomb_c to be <= 1, so that basal stress <= effective pressure N + basal_physics%coulomb_c_2d(:,:) = min(basal_physics%coulomb_c_2d(:,:), 1.0d0) + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + + i = itest + j = jtest + print*, 'thck (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck(i,j) + enddo + write(6,*) ' ' + enddo + print*, 'thck - thck_obs:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') dthck(i,j) + enddo + write(6,*) ' ' + enddo + print*, 'dthck_dt (m/yr):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') dthck_dt(i,j)*scyr + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'After smoothing, powerlaw_c:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_2d(i,j) + enddo + write(6,*) ' ' + enddo + print*, 'coulomb_c:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.4)',advance='no') basal_physics%coulomb_c_2d(i,j) + enddo + write(6,*) ' ' + enddo + + endif + + end subroutine invert_basal_traction + + !*********************************************************************** + + subroutine invert_basal_melt(model) + + !TODO - Add computations including smoothing + + type(glide_global_type), intent(inout) :: model ! model instance + + + end subroutine invert_basal_melt + +!======================================================================= + + end module glissade_inversion + +!======================================================================= diff --git a/libglissade/glissade_velo_higher.F90 b/libglissade/glissade_velo_higher.F90 index 08ad579b..eae42a32 100644 --- a/libglissade/glissade_velo_higher.F90 +++ b/libglissade/glissade_velo_higher.F90 @@ -666,7 +666,8 @@ subroutine glissade_velo_higher_solve(model, & ! the local SIA solver (HO_APPROX_LOCAL_SIA) in glissade_velo_sia.F90. !---------------------------------------------------------------- - use glissade_basal_traction, only: calcbeta, calc_effective_pressure, calc_basal_inversion + use glissade_basal_traction, only: calcbeta, calc_effective_pressure + use glissade_inversion, only: invert_basal_traction use glissade_therm, only: glissade_pressure_melting_point !---------------------------------------------------------------- @@ -2156,15 +2157,15 @@ subroutine glissade_velo_higher_solve(model, & if (whichinversion == HO_INVERSION_COMPUTE) then - call calc_basal_inversion(dt*tim0, & ! s - nx, ny, & - itest, jtest, rtest, & - model%basal_physics, & - ice_mask, & - floating_mask, & - thck, & ! m - dthck_dt, & ! m/s - thck_obs*thk0) ! m + call invert_basal_traction(dt*tim0, & ! s + nx, ny, & + itest, jtest, rtest, & + model%basal_physics, & + ice_mask, & + floating_mask, & + thck, & ! m + dthck_dt, & ! m/s + thck_obs*thk0) ! m endif From 90e709960603395b8b350cfbfc1af7318c61e68f Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Thu, 21 Dec 2017 07:42:33 -0700 Subject: [PATCH 08/61] Changed inversion method for bmlt_float Previously, the bmlt_float_inversion field was computed as the net melt rate needed to immediately restore the model thickness in initially floating cells to the observed thickness. With this commit there are several changes: - Inversion is applied not to cells that were initially floating (i.e., in the observed data set), but to cells that are floating (and are not lakes) at the current time step. I verified in a MISMIP+ test case that the GL converges to the desired location even when initially-floating-but-now-grounded cells have bmlt_float_inversion = 0. - Instead of restoring the thickness in all floating cells at each time step, the melt rate is relaxed toward the target thickness with a prescribed time scale. - After bmlt_float-inversion is initially computed, Laplacian smoothing is applied with a smoothing factor. This is similar to the smoothing done for the powerlaw_c field. It is hoped that the smoothing will result in a smoother bmlt_float_inversion field for Antarctic simulations. To support these changes, I wrote subroutine invert_bmlt_float in the inversion module. I added user-configurable parameters inversion_bmlt_timescale and inversion_bmlt_smoothing_factor, with default values (for now) of 10 yr and 0.01, respectively. I inserted '_babc' in the names of some existing parameters used to invert for powerlaw_c. I also fixed a minor bug. In previous runs, the smoothing factor for babc was supposed to be user-configurable, but in fact the default value in glide_types was not changed. I tested these changes in a MISMIP+ test case. In a run without inversion, I applied a small, uniform basal melt rate to floating cells and ran to steady state. Then in a run with inversion, I was able to recover the initial melt rate. This commit is answer-changing only for runs with inversion. --- libglide/glide_setup.F90 | 40 +++- libglide/glide_types.F90 | 15 +- libglissade/glissade.F90 | 60 ++--- libglissade/glissade_inversion.F90 | 361 +++++++++++++++++++++-------- 4 files changed, 340 insertions(+), 136 deletions(-) diff --git a/libglide/glide_setup.F90 b/libglide/glide_setup.F90 index 16b0ec7c..b9a0aa86 100644 --- a/libglide/glide_setup.F90 +++ b/libglide/glide_setup.F90 @@ -208,8 +208,9 @@ subroutine glide_scale_params(model) model%basal_melt%bmlt_float_const = model%basal_melt%bmlt_float_const / scyr ! scale basal inversion parameters - model%basal_physics%inversion_timescale = model%basal_physics%inversion_timescale * scyr - model%basal_physics%inversion_dthck_dt_scale = model%basal_physics%inversion_dthck_dt_scale / scyr + model%basal_physics%inversion_babc_timescale = model%basal_physics%inversion_babc_timescale * scyr + model%basal_physics%inversion_babc_dthck_dt_scale = model%basal_physics%inversion_babc_dthck_dt_scale / scyr + model%basal_melt%inversion_bmlt_timescale = model%basal_melt%inversion_bmlt_timescale * scyr ! scale SMB/acab parameters model%climate%overwrite_acab_value = model%climate%overwrite_acab_value*tim0/(scyr*thk0) @@ -1635,9 +1636,12 @@ subroutine handle_parameters(section, model) call GetValue(section, 'powerlaw_c_max', model%basal_physics%powerlaw_c_max) call GetValue(section, 'powerlaw_c_min', model%basal_physics%powerlaw_c_min) call GetValue(section, 'powerlaw_coulomb_ratio', model%basal_physics%powerlaw_coulomb_ratio) - call GetValue(section, 'inversion_timescale', model%basal_physics%inversion_timescale) - call GetValue(section, 'inversion_thck_scale', model%basal_physics%inversion_thck_scale) - call GetValue(section, 'inversion_dthck_dt_scale', model%basal_physics%inversion_dthck_dt_scale) + call GetValue(section, 'inversion_babc_timescale', model%basal_physics%inversion_babc_timescale) + call GetValue(section, 'inversion_babc_thck_scale', model%basal_physics%inversion_babc_thck_scale) + call GetValue(section, 'inversion_babc_dthck_dt_scale', model%basal_physics%inversion_babc_dthck_dt_scale) + call GetValue(section, 'inversion_babc_smoothing_factor', model%basal_physics%inversion_babc_smoothing_factor) + call GetValue(section, 'inversion_bmlt_timescale', model%basal_melt%inversion_bmlt_timescale) + call GetValue(section, 'inversion_bmlt_smoothing_factor', model%basal_melt%inversion_bmlt_smoothing_factor) ! ISMIP-HOM parameters call GetValue(section,'periodic_offset_ew',model%numerics%periodic_offset_ew) @@ -1930,17 +1934,31 @@ subroutine print_parameters(model) call write_log(message) if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then call write_log(' NOTE: powerlaw_c and coulomb_c will be modified by inversion') - write(message,*) 'powerlaw_c max, Pa (m/yr)^(-1/3) : ', model%basal_physics%powerlaw_c_max + write(message,*) 'powerlaw_c max, Pa (m/yr)^(-1/3) : ', & + model%basal_physics%powerlaw_c_max call write_log(message) - write(message,*) 'powerlaw_c min, Pa (m/yr)^(-1/3) : ', model%basal_physics%powerlaw_c_min + write(message,*) 'powerlaw_c min, Pa (m/yr)^(-1/3) : ', & + model%basal_physics%powerlaw_c_min call write_log(message) - write(message,*) 'powerlaw_c/coulomb_c ratio : ', model%basal_physics%powerlaw_coulomb_ratio + write(message,*) 'powerlaw_c/coulomb_c ratio : ', & + model%basal_physics%powerlaw_coulomb_ratio call write_log(message) - write(message,*) 'inversion timescale (yr) : ', model%basal_physics%inversion_timescale + write(message,*) 'inversion basal traction timescale (yr) : ', & + model%basal_physics%inversion_babc_timescale call write_log(message) - write(message,*) 'inversion thickness scale (m) : ', model%basal_physics%inversion_thck_scale + write(message,*) 'inversion thickness scale (m) : ', & + model%basal_physics%inversion_babc_thck_scale call write_log(message) - write(message,*) 'inversion dthck/dt scale (m/yr) : ', model%basal_physics%inversion_dthck_dt_scale + write(message,*) 'inversion dthck/dt scale (m/yr) : ', & + model%basal_physics%inversion_babc_dthck_dt_scale + call write_log(message) + write(message,*) 'inversion basal traction smoothing factor : ', & + model%basal_physics%inversion_babc_smoothing_factor + write(message,*) 'inversion basal melting timescale (yr) : ', & + model%basal_melt%inversion_bmlt_timescale + call write_log(message) + write(message,*) 'inversion basal melting smoothing factor : ', & + model%basal_melt%inversion_bmlt_smoothing_factor call write_log(message) endif elseif (model%options%which_ho_babc == HO_BABC_COULOMB_POWERLAW_TSAI) then diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index 1e493bcf..fe5b7a77 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -1289,6 +1289,11 @@ module glide_types ! initMIP-Antarctica parameters real(dp) :: bmlt_anomaly_timescale = 0.0d0 !> number of years over which the bmlt_float anomaly is phased in linearly !> If set to zero, then the anomaly is applied immediately. + ! inversion parameters + real(dp) :: & + inversion_bmlt_timescale = 10.d0, & !> inversion timescale (yr); + !> relaxation is immediate if timescale = 0 + inversion_bmlt_smoothing_factor = 0.01d0 !> factor for smoothing bmlt_float_inversion (larger => more smoothing) end type glide_basal_melt @@ -1412,7 +1417,7 @@ module glide_types ! parameters for inversion of basal friction coefficients ! Note: These values work well for MISMIP+, but may not be optimal for whole ice sheets. - ! Note: inversion_timescale and inversion_dthck_dt_scale are later rescaled to SI units (s and m/s). + ! Note: inversion_babc_timescale and inversion_babc_dthck_dt_scale are later rescaled to SI units (s and m/s). real(dp) :: & powerlaw_c_max = 1.0d5, & !< Pa (m/yr)^(-1/3) @@ -1420,10 +1425,10 @@ module glide_types powerlaw_coulomb_ratio = 2.0d4 !< powerlaw_c/coulomb_c (same units as powerlaw_c)) real(dp) :: & - inversion_timescale = 200.d0, & !< inversion timescale (yr); must be > 0 - inversion_thck_scale = 50.d0, & !< thickness inversion scale (m); must be > 0 - inversion_dthck_dt_scale = 0.50d0, & !< dthck_dt inversion scale (m/yr); must be > 0 - inversion_smoothing_factor = 0.05d0 !< factor for smoothing powerlaw_c (larger => more smoothing) + inversion_babc_timescale = 200.d0, & !< inversion timescale (yr); must be > 0 + inversion_babc_thck_scale = 50.d0, & !< thickness inversion scale (m); must be > 0 + inversion_babc_dthck_dt_scale = 0.50d0, & !< dthck_dt inversion scale (m/yr); must be > 0 + inversion_babc_smoothing_factor = 0.05d0 !< factor for smoothing powerlaw_c (larger => more smoothing) ! parameter for constant basal water ! Note: This parameter applies to HO_BWAT_CONSTANT only. diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index f5f1b1e2..e7c2fccf 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -129,8 +129,7 @@ subroutine glissade_initialise(model, evolve_ice) ice_mask, & ! = 1 where ice is present, else = 0 floating_mask, & ! = 1 where ice is present and floating, else = 0 ocean_mask, & ! = 1 if topg is below sea level and ice is absent, else = 0 - land_mask, & ! = 1 if topg is at or above sea level, else = 0 - lake_mask ! = 1 for floating cells disconnected from the ocean + land_mask ! = 1 if topg is at or above sea level, else = 0 integer :: itest, jtest, rtest @@ -1116,13 +1115,15 @@ subroutine glissade_transport_solve(model) glissade_overwrite_acab, & glissade_add_mbal_anomaly use glissade_masks, only: glissade_get_masks + use glissade_inversion, only: invert_bmlt_float use glide_thck, only: glide_calclsrf ! TODO - Make this a glissade subroutine, or inline implicit none type(glide_global_type), intent(inout) :: model ! model instance - logical, parameter :: verbose_inversion = .false. +!! logical, parameter :: verbose_inversion = .false. + logical, parameter :: verbose_inversion = .true. ! --- Local variables --- @@ -1134,12 +1135,12 @@ subroutine glissade_transport_solve(model) acab_unscaled, & ! surface mass balance (m/s) bmlt_unscaled ! = bmlt (m/s) if basal mass balance is included in continuity equation, else = 0 - !TODO - Remove ice_mask obs, compute inversion mask at startup ! masks integer, dimension(model%general%ewn, model%general%nsn) :: & ice_mask, & ! = 1 if thck > 0, else = 0 floating_mask, & ! = 1 where ice is present and floating, else = 0 ocean_mask, & ! = 1 if topg is below sea level and thck = 0, else = 0 + land_mask, & ! = 1 if topg is at or above sea level, else = 0 calving_front_mask ! = 1 where ice is floating and borders an ocean cell, else = 0 real(dp), dimension(model%general%ewn, model%general%nsn) :: & @@ -1164,8 +1165,6 @@ subroutine glissade_transport_solve(model) integer :: i, j, k integer :: ewn, nsn, upn - - !WHL - debug integer :: itest, jtest, rtest rtest = -999 @@ -1463,23 +1462,13 @@ subroutine glissade_transport_solve(model) ! thickness tendency dH/dt from one step to the next (m/s) ! This tendency is used when inverting for basal traction parameters. - ! It is recomputed at the end of the time step for diagnostics. + ! It is recomputed at the end of the time step for diagnostic output. model%geometry%dthck_dt(:,:) = (thck_unscaled(:,:) - model%geometry%thck_old(:,:)*thk0) & / (model%numerics%dt * tim0) - ! Where the observed ice is floating, compute a basal melt rate (or freezing rate, if bmlt < 0) - ! that will restore the ice thickness to the observed target. - - where (model%basal_melt%bmlt_inversion_mask == 1) - model%basal_melt%bmlt_float_inversion = & - (thck_unscaled - model%geometry%thck_obs*thk0) / (model%numerics%dt*tim0) - elsewhere - model%basal_melt%bmlt_float_inversion = 0.0d0 - endwhere - ! ------------------------------------------------------------------------ - ! Get masks used by glissade_mass_balance_driver. + ! Get masks used by glissade_mass_balance_driver and the inversion calculation. ! Pass thklim = 0 to identify cells with thck > 0 (not thck > thklim). ! ------------------------------------------------------------------------ @@ -1490,7 +1479,8 @@ subroutine glissade_transport_solve(model) 0.0d0, & ! thklim = 0 ice_mask, & floating_mask = floating_mask, & - ocean_mask = ocean_mask) + ocean_mask = ocean_mask, & + land_mask = land_mask) ! For purposes of inversion, assign all cells an effective fraction of 1 or 0. ! Calving-front cells are treated the same as other ice-covered cells. @@ -1500,6 +1490,21 @@ subroutine glissade_transport_solve(model) effective_areafrac = 1.0d0 endwhere + ! Invert for bmlt_float_inversion, adjusting the melt rate to relax toward the observed thickness. + ! As the inversion converges, the difference (thck - thck_obs) should approach zero. + ! Note: basal_melt%bmlt_float_inversion is passed out with units of m/s + + call invert_bmlt_float(model%numerics%dt * tim0, & ! s + model%general%ewn, model%general%nsn, & + itest, jtest, rtest, & + model%basal_melt, & + thck_unscaled, & + model%geometry%thck_obs*thk0, & + ice_mask, & + floating_mask, & + ocean_mask, & + land_mask) + !WHL - debug if (verbose_inversion .and. this_rank == rtest) then i = itest @@ -1586,7 +1591,7 @@ subroutine glissade_transport_solve(model) i = itest j = jtest print*, ' ' - print*, 'After inversion:' + print*, 'After inversion and BMB:' print*, ' ' print*, 'thck (m):' do j = jtest+3, jtest-3, -1 @@ -1634,11 +1639,11 @@ subroutine glissade_transport_solve(model) effective_areafrac = 1.0d0 endwhere - ! Zero out bmlt_float for floating cells. - !TODO - Modify to apply bmlt_float to cells that were fully floating before transport. - - where (floating_mask == 0) - model%basal_melt%bmlt_float_inversion = 0.0d0 + ! Set bmlt_float based on bmlt_float_inversion, limited to floating cells + where (floating_mask == 1) + bmlt_unscaled = model%basal_melt%bmlt_float_inversion + elsewhere + bmlt_unscaled = 0.0d0 endwhere !WHL - debug @@ -1647,8 +1652,7 @@ subroutine glissade_transport_solve(model) j = jtest print*, ' ' print*, 'Prescribing bmlt_float from inversion: rank, i, j =', rtest, i, j - print*, 'thck (m), bmlt_float_inversion (m/yr):', thck_unscaled(i,j), & - model%basal_melt%bmlt_float_inversion(i,j)*scyr + print*, 'thck (m), bmlt_float (m/yr):', thck_unscaled(i,j), bmlt_unscaled(i,j)*scyr print*, ' ' print*, 'floating_mask:' do j = jtest+3, jtest-3, -1 @@ -1687,7 +1691,7 @@ subroutine glissade_transport_solve(model) model%general%upn-1, model%numerics%sigma, & thck_unscaled(:,:), & ! m acab_unscaled(:,:), & ! m/s - model%basal_melt%bmlt_float_inversion(:,:), & ! m/s + bmlt_unscaled(:,:), & ! m/s model%climate%acab_applied(:,:), & ! m/s model%basal_melt%bmlt_applied(:,:), & ! m/s ocean_mask(:,:), & diff --git a/libglissade/glissade_inversion.F90 b/libglissade/glissade_inversion.F90 index e2c91d69..ea16e54a 100644 --- a/libglissade/glissade_inversion.F90 +++ b/libglissade/glissade_inversion.F90 @@ -49,7 +49,6 @@ module glissade_inversion subroutine glissade_init_inversion(model) use glissade_masks, only: glissade_get_masks - use glissade_calving, only: glissade_find_lakes !TODO - Move this subroutine? ! Initialize inversion for fields of basal traction and basal melting @@ -59,32 +58,10 @@ subroutine glissade_init_inversion(model) real(dp) :: var_maxval ! max value of a given variable; = 0 if not yet read in - integer :: ewn, nsn - integer :: itest, jtest, rtest ! coordinates of diagnostic point - integer :: i, j - - integer, dimension(:,:), allocatable :: & - ice_mask, & ! = 1 where ice is present, else = 0 - floating_mask, & ! = 1 where ice is present and floating, else = 0 - ocean_mask, & ! = 1 if topg is below sea level and ice is absent, else = 0 - land_mask, & ! = 1 if topg is at or above sea level, else = 0 - lake_mask ! = 1 for floating cells disconnected from the ocean - character(len=100) :: message - ! set grid dimensions - ewn = model%general%ewn - nsn = model%general%nsn - - ! Set debug diagnostics - rtest = model%numerics%rdiag_local - itest = model%numerics%idiag_local - jtest = model%numerics%jdiag_local - if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then - !TODO - Move the following code to an inversion_init subroutine? - ! Save the initial ice thickness, if it will be used as the observational target for inversion. ! Note: If calving is done at initialization, the target is the post-calving thickness. ! The inversion will not try to put ice where, e.g., initial icebergs are removed. @@ -101,54 +78,6 @@ subroutine glissade_init_inversion(model) call parallel_halo(model%geometry%thck_obs) - ! Initialize a mask for inversion. - ! Basal melting will be applied wherever the observed target ice is floating, - ! provided the floating ice has a connection to the ocean. - - allocate(ice_mask(ewn,nsn)) - allocate(floating_mask(ewn,nsn)) - allocate(land_mask(ewn,nsn)) - allocate(ocean_mask(ewn,nsn)) - allocate(lake_mask(ewn,nsn)) - - call glissade_get_masks(ewn, nsn, & - model%geometry%thck_obs*thk0, & - model%geometry%topg*thk0, & - model%climate%eus*thk0, & - 0.0d0, & ! thklim = 0 - ice_mask, & - floating_mask = floating_mask, & - ocean_mask = ocean_mask, & - land_mask = land_mask) - - ! Identify lake cells: floating interior cells that will not be restored - ! to the target thickness - - call glissade_find_lakes(ewn, nsn, & - itest, jtest, rtest, & - ice_mask, floating_mask, & - ocean_mask, lake_mask) - - model%basal_melt%bmlt_inversion_mask(:,:) = 0 - - do j = 2, nsn - 1 - do i = 2, ewn - 1 - if (floating_mask(i,j) == 1) then - ! check for land neighbors - if (land_mask(i-1,j) == 1 .or. land_mask(i+1,j) == 1 .or. & - land_mask(i,j-1) == 1 .or. land_mask(i,j+1) == 1) then - ! mask = 0; do not invert for bmlt_float - elseif (lake_mask(i,j) == 1) then - ! mask = 0; do not invert for bmlt_float - else - model%basal_melt%bmlt_inversion_mask(i,j) = 1 - endif - endif - enddo - enddo - - call parallel_halo(model%basal_melt%bmlt_inversion_mask) - ! Check whether powerlaw_c_2d has been read in already. ! If not, then set to a constant value. var_maxval = maxval(model%basal_physics%powerlaw_c_2d) @@ -207,7 +136,11 @@ end subroutine glissade_init_inversion !*********************************************************************** -!TODO - Change to invert_basal_traction? + !TODO - Add code to set powerlaw_c for prescribed case. + ! Use prescribed values where available, and otherwise extrapolate from nearby values. + ! In this way, we can avoid having very wrong values where the GL has advanced. + +!*********************************************************************** subroutine invert_basal_traction(dt, & nx, ny, & @@ -260,13 +193,13 @@ subroutine invert_basal_traction(dt, & integer :: ii, jj ! inversion parameters in basal_physics derived type: - ! * powerlaw_c_max = upper bound for powerlaw_c, Pa (m/yr)^(-1/3) - ! * powerlaw_c_min = lower bound for powerlaw_c, Pa (m/yr)^(-1/3) - ! * powerlaw_coulomb_ratio = powerlaw_c/coulomb_c (same units as powerlaw_c) - ! * inversion_timescale = inversion timescale (s); must be > 0 - ! * inversion_thck_scale = thickness inversion scale (m); must be > 0 - ! * inversion_dthck_dt_scale = dthck_dt inversion scale (m/s); must be > 0 - ! * inversion_smoothing_factor = factor for smoothing powerlaw_c_2d; higher => more smoothing + ! * powerlaw_c_max = upper bound for powerlaw_c, Pa (m/yr)^(-1/3) + ! * powerlaw_c_min = lower bound for powerlaw_c, Pa (m/yr)^(-1/3) + ! * powerlaw_coulomb_ratio = powerlaw_c/coulomb_c (same units as powerlaw_c) + ! * inversion_babc_timescale = inversion timescale (s); must be > 0 + ! * inversion_babc_thck_scale = thickness inversion scale (m); must be > 0 + ! * inversion_babc_dthck_dt_scale = dthck_dt inversion scale (m/s); must be > 0 + ! * inversion_babc_smoothing_factor = factor for smoothing powerlaw_c_2d; higher => more smoothing ! ! Note on smoothing: A smoothing factor of 1/8 gives a 4-1-1-1-1 smoother. ! This is numerically well behaved, but may oversmooth in bowl-shaped regions; @@ -291,10 +224,10 @@ subroutine invert_basal_traction(dt, & if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! ice is present and grounded ! Invert for powerlaw_c_2d and coulomb_c based on dthck and dthck_dt - term1 = -dthck(i,j) / basal_physics%inversion_thck_scale - term2 = -dthck_dt(i,j) / basal_physics%inversion_dthck_dt_scale + term1 = -dthck(i,j) / basal_physics%inversion_babc_thck_scale + term2 = -dthck_dt(i,j) / basal_physics%inversion_babc_dthck_dt_scale - dpowerlaw_c(i,j) = (dt/basal_physics%inversion_timescale) & + dpowerlaw_c(i,j) = (dt/basal_physics%inversion_babc_timescale) & * basal_physics%powerlaw_c_2d(i,j) * (term1 + term2) ! Limit to prevent huge change in one step @@ -318,8 +251,8 @@ subroutine invert_basal_traction(dt, & print*, 'Invert for powerlaw_c and coulomb_c: rank, i, j =', rtest, itest, jtest print*, 'thck, thck_obs, dthck, dthck_dt:', thck(i,j), thck_obs(i,j), dthck(i,j), dthck_dt(i,j)*scyr print*, '-dthck/thck_scale, -dthck_dt/dthck_dt_scale, sum =', & - -dthck(i,j)/basal_physics%inversion_thck_scale, & - -dthck_dt(i,j)/basal_physics%inversion_dthck_dt_scale, & + -dthck(i,j)/basal_physics%inversion_babc_thck_scale, & + -dthck_dt(i,j)/basal_physics%inversion_babc_dthck_dt_scale, & term1 + term2 print*, 'dpowerlaw_c, newpowerlaw_c =', dpowerlaw_c(i,j), basal_physics%powerlaw_c_2d(i,j) endif @@ -358,16 +291,16 @@ subroutine invert_basal_traction(dt, & do i = 2, nx-1 if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! cell (i,j) is grounded - dpowerlaw_c_smooth = -4.0d0 * basal_physics%inversion_smoothing_factor * temp_powerlaw_c(i,j) + dpowerlaw_c_smooth = -4.0d0 * basal_physics%inversion_babc_smoothing_factor * temp_powerlaw_c(i,j) do jj = j-1, j+1 do ii = i-1, i+1 if ((ii == i .or. jj == j) .and. (ii /= i .or. jj /= j)) then ! edge neighbor if (ice_mask(ii,jj) == 1 .and. floating_mask(ii,jj) == 0) then ! cell (ii,jj) is grounded dpowerlaw_c_smooth = dpowerlaw_c_smooth & - + basal_physics%inversion_smoothing_factor*temp_powerlaw_c(ii,jj) + + basal_physics%inversion_babc_smoothing_factor*temp_powerlaw_c(ii,jj) else dpowerlaw_c_smooth = dpowerlaw_c_smooth & - + basal_physics%inversion_smoothing_factor*temp_powerlaw_c(i,j) + + basal_physics%inversion_babc_smoothing_factor*temp_powerlaw_c(i,j) endif endif enddo @@ -470,17 +403,261 @@ end subroutine invert_basal_traction !*********************************************************************** - subroutine invert_basal_melt(model) + subroutine invert_bmlt_float(dt, & + nx, ny, & + itest, jtest, rtest, & + basal_melt, & + thck, & + thck_obs, & + ice_mask, & + floating_mask, & + ocean_mask, & + land_mask) + + ! Compute spatially varying bmlt_float by inversion. + ! Where thck > thck_obs, bmlt_float_inversion is increased. + ! Where thck < thck_obs, bmlt_float_inversion is decreased. + ! Note: bmlt_float_inversion is defined as positive for melting, negative for freezing. + + !TODO - Move this subroutine? + use glissade_calving, only: glissade_find_lakes - !TODO - Add computations including smoothing + real(dp), intent(in) :: dt ! time step (s) - type(glide_global_type), intent(inout) :: model ! model instance + integer, intent(in) :: & + nx, ny ! grid dimensions + + integer, intent(in) :: & + itest, jtest, rtest ! coordinates of diagnostic point + + type(glide_basal_melt), intent(inout) :: & + basal_melt ! basal melt object + + real(dp), dimension(nx,ny), intent(in) :: & + thck, & ! ice thickness (m) + thck_obs ! observed thickness (m) + + ! Note: When this subroutine is called, ice_mask = 1 where thck > 0, not thck > thklim. + integer, dimension(nx,ny), intent(in) :: & + ice_mask, & ! = 1 where ice is present, else = 0 + floating_mask, & ! = 1 where ice is present and floating, else = 0 + ocean_mask, & ! = 1 where ice is absent and topg < eus, else = 0 + land_mask ! = 1 where topg >= eus, else = 0 + + ! local variables + + integer, dimension(nx,ny) :: & + lake_mask ! = 1 for floating cells disconnected from the ocean + + real(dp), dimension(nx,ny) :: & + dthck, & ! thck - thck_obs on ice grid + old_bmlt_float, & ! old value of bmlt_float_inversion (start of timestep) + temp_bmlt_float, & ! temporary value of bmlt_float_inversion (before smoothing) + dbmlt_float ! change in bmlt_float_inversion + + real(dp) :: term1, dbmlt_float_smooth + + integer :: i, j, ii, jj + + ! Where the observed ice is floating, adjust the basal melt rate (or freezing rate, if bmlt < 0) + ! so as to relax the ice thickness toward the observed target. + ! Note: This subroutine should be called after other mass-balance terms have been applied, + ! and after horizontal transport. + ! We compute the difference (H - bmlt_float_inversion*dt) - H_obs, + ! which is the thickness error that would remain after applying the current bmlt_float_inversion. + ! We then increase or decrease bmlt_float_inversion with a characteristic timescale, + ! thereby reducing the thickness error. + ! As the timescale approaches zero, the adjusted bmlt_float_inversion will approach the value + ! needed to give H = H_obs. + + logical, parameter :: verbose_inversion = .false. + + if (verbose_inversion .and. main_task) then + print*, ' ' + print*, 'In invert_bmlt_float' + endif + + ! Identify lake cells: floating interior cells that will not be restored + ! to the target thickness + + call glissade_find_lakes(nx, ny, & + itest, jtest, rtest, & + ice_mask, floating_mask, & + ocean_mask, lake_mask) + + ! Compute a mask of cells where bmlt_float_inversion will be computed + !TODO - Make bmlt_inversion_mask a local field? + + basal_melt%bmlt_inversion_mask(:,:) = 0 + + do j = 2, ny-1 + do i = 2, nx-1 + if (floating_mask(i,j) == 1) then + ! check for land neighbors + if (land_mask(i-1,j) == 1 .or. land_mask(i+1,j) == 1 .or. & + land_mask(i,j-1) == 1 .or. land_mask(i,j+1) == 1) then + ! mask = 0; do not invert for bmlt_float + elseif (lake_mask(i,j) == 1) then + ! mask = 0; do not invert for bmlt_float + else + basal_melt%bmlt_inversion_mask(i,j) = 1 + endif + endif + enddo + enddo + + call parallel_halo(basal_melt%bmlt_inversion_mask) + + ! Save the starting value of bmlt_float_inversion + old_bmlt_float(:,:) = basal_melt%bmlt_float_inversion(:,:) + dbmlt_float(:,:) = 0.0d0 + + ! Compute difference between the current and target thickness + dthck(:,:) = thck(:,:) - thck_obs(:,:) + + ! Loop over cells + do j = 1, ny + do i = 1, nx + + if (basal_melt%bmlt_inversion_mask(i,j) == 1) then + + if (basal_melt%inversion_bmlt_timescale > 0.0d0) then + ! Adjust bmlt_float_inversion to reduce the thickness error + dbmlt_float(i,j) = (dthck(i,j) - basal_melt%bmlt_float_inversion(i,j)*dt) & + / basal_melt%inversion_bmlt_timescale + else + ! Set bmlt_float_inversion such that thck = thck_obs after inversion + dbmlt_float(i,j) = dthck(i,j)/dt - basal_melt%bmlt_float_inversion(i,j) + endif + + basal_melt%bmlt_float_inversion(i,j) = basal_melt%bmlt_float_inversion(i,j) + dbmlt_float(i,j) + + !WHL - I think this may not be needed + ! Limit to a physically reasonable range +! basal_melt%bmlt_float_inversion(i,j) = min(basal_melt%bmlt_float_inversion(i,j), basal_melt%bmlt_float_inversion_max) +! basal_melt%bmlt_float_inversion(i,j) = max(basal_melt%bmlt_float_inversion(i,j), basal_melt%bmlt_float_inversion_min) + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest .and. i==itest .and. j==jtest) then + print*, ' ' + print*, 'Invert for bmlt_float_inversion: rank, i, j =', rtest, itest, jtest + print*, 'thck, thck_obs, dthck, bmlt*dt:', & + thck(i,j), thck_obs(i,j), dthck(i,j), basal_melt%bmlt_float_inversion(i,j)*dt + print*, 'dbmlt_float, new bmlt_float (m/yr) =', dbmlt_float(i,j)*scyr, basal_melt%bmlt_float_inversion(i,j)*scyr + endif + + else ! bmlt_inversion_mask = 0 + + basal_melt%bmlt_float_inversion(i,j) = 0.0d0 + + endif ! bmlt_inversion_mask + + enddo ! i + enddo ! j + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'Before smoothing, bmlt_float (m/yr):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') basal_melt%bmlt_float_inversion(i,j)*scyr + enddo + write(6,*) ' ' + enddo + endif + + ! Save the value just computed + temp_bmlt_float(:,:) = basal_melt%bmlt_float_inversion(:,:) + + ! Apply Laplacian smoothing to bmlt_float_inversion. + !TODO - Write an operator for Laplacian smoothing? + do j = 2, ny-1 + do i = 2, nx-1 + if (basal_melt%bmlt_inversion_mask(i,j) == 1) then + + dbmlt_float_smooth = -4.0d0 * basal_melt%inversion_bmlt_smoothing_factor * temp_bmlt_float(i,j) + do jj = j-1, j+1 + do ii = i-1, i+1 + if ((ii == i .or. jj == j) .and. (ii /= i .or. jj /= j)) then ! edge neighbor + if (basal_melt%bmlt_inversion_mask(ii,jj) == 1) then ! inverting for bmlt_float in cell (ii,jj) + dbmlt_float_smooth = dbmlt_float_smooth & + + basal_melt%inversion_bmlt_smoothing_factor*temp_bmlt_float(ii,jj) + else + dbmlt_float_smooth = dbmlt_float_smooth & + + basal_melt%inversion_bmlt_smoothing_factor*temp_bmlt_float(i,j) + endif + endif + enddo + enddo + + ! Note: If smoothing is too strong, it can reverse the sign of the change in bmlt_float. + ! The logic below ensures that if bmlt_float is increasing, the smoothing can reduce + ! the change to zero, but not cause bmlt_float to decrease relative to old_bmlt_float + ! (and similarly if bmlt_float is decreasing). + + if (dbmlt_float(i,j) > 0.0d0) then + if (temp_bmlt_float(i,j) + dbmlt_float_smooth > old_bmlt_float(i,j)) then + basal_melt%bmlt_float_inversion(i,j) = temp_bmlt_float(i,j) + dbmlt_float_smooth + else + ! allow the smoothing to hold bmlt_float at its old value, but not reduce bmlt_float + basal_melt%bmlt_float_inversion(i,j) = old_bmlt_float(i,j) + endif + elseif (dbmlt_float(i,j) < 0.0d0) then + if (temp_bmlt_float(i,j) + dbmlt_float_smooth < old_bmlt_float(i,j)) then + basal_melt%bmlt_float_inversion(i,j) = temp_bmlt_float(i,j) + dbmlt_float_smooth + else + ! allow the smoothing to hold bmlt_float at its old value, but not increase bmlt_float + basal_melt%bmlt_float_inversion(i,j) = old_bmlt_float(i,j) + endif + endif ! dbmlt_float > 0 + + endif ! bmlt_inversion_mask = 1 + + if (verbose_inversion .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, 'Smoothing correction, new bmlt_float:', dbmlt_float_smooth*scyr, basal_melt%bmlt_float_inversion(i,j)*scyr + endif + + enddo + enddo + + call parallel_halo(basal_melt%bmlt_float_inversion) + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, 'thck (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck(i,j) + enddo + write(6,*) ' ' + enddo + print*, 'thck - bmlt*dt - thck_obs:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') dthck(i,j) - basal_melt%bmlt_float_inversion(i,j)*dt + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'After smoothing, bmlt_float_inversion (m/yr):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') basal_melt%bmlt_float_inversion(i,j)*scyr + enddo + write(6,*) ' ' + enddo + endif - end subroutine invert_basal_melt + end subroutine invert_bmlt_float !======================================================================= - end module glissade_inversion +end module glissade_inversion !======================================================================= From 225b41942110c7df515341af8ddcc2d7ea9e7e0c Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Thu, 21 Dec 2017 17:44:15 -0700 Subject: [PATCH 09/61] Added and renamed some inversion fields For which_ho_inversion = 2, the prescribed fields from a previous inversion are now called powerlaw_c_prescribed and bmlt_float_prescribed. For which_ho_inversion = 1, the powerlaw_c and bmlt_float fields obtained by inversion and written to the restart file are now called powerlaw_c_inversion and bmlt_float_inversion. With this commit, the tavg versions of these variables are also written to the restart file. At the end of the inversion spin-up, the tavg variables can be renamed with the 'prescribed' suffix and read in for the forward run. The purpose of these changes is to make variable names consistent and to simplify the transition from the inversion spin-up to the forward run. With these changes (if I haven't left out anything), the restart file from the spin-up can be used to start the forward run with no changes other than renaming two variables and the file itself. Another change: I removed effecpress from the restart file, and I removed C_space_factor for which_ho_babc options that do not use C_space_factor. This could have been done earlier, but I did it with this commit to avoid having an overly long list of restart variables. At some point we may need to allow a longer restart variable list. Note: While testing the code, I discovered that time averages are computed correctly for tavg variables only if these variables are listed in exactly one output file. If listed in more than one output file (including the restart file), the accumulation and averaging are incorrect because the accumulation subroutine is called more than once per time step. I did not see an easy way to fix this, but I added a comment in the template for glide_io.F90. --- libglide/glide_setup.F90 | 45 +++++++--- libglide/glide_types.F90 | 43 +++++---- libglide/glide_vars.def | 30 +++++-- libglimmer/glimmer_config.F90 | 2 +- libglimmer/ncdf_template.F90.in | 7 ++ libglissade/glissade_basal_traction.F90 | 44 +++++----- libglissade/glissade_inversion.F90 | 110 ++++++++++++------------ libglissade/glissade_velo_higher.F90 | 4 +- 8 files changed, 172 insertions(+), 113 deletions(-) diff --git a/libglide/glide_setup.F90 b/libglide/glide_setup.F90 index b9a0aa86..145376b4 100644 --- a/libglide/glide_setup.F90 +++ b/libglide/glide_setup.F90 @@ -1954,6 +1954,7 @@ subroutine print_parameters(model) call write_log(message) write(message,*) 'inversion basal traction smoothing factor : ', & model%basal_physics%inversion_babc_smoothing_factor + call write_log(message) write(message,*) 'inversion basal melting timescale (yr) : ', & model%basal_melt%inversion_bmlt_timescale call write_log(message) @@ -2534,15 +2535,16 @@ subroutine define_glide_restart_variables(options) ! basal sliding option select case (options%which_ho_babc) - case (HO_BABC_POWERLAW, HO_BABC_COULOMB_FRICTION, HO_BABC_COULOMB_POWERLAW_SCHOOF) - ! These friction laws need effective pressure - !TODO - Does effecpress need to be a restart variable? - call glide_add_to_restart_variable_list('effecpress') + !WHL - Removed effecpress as a restart variable; it is recomputed with each velocity solve. +!! case (HO_BABC_POWERLAW, HO_BABC_COULOMB_FRICTION, HO_BABC_COULOMB_POWERLAW_SCHOOF) +!! ! These friction laws need effective pressure +!! call glide_add_to_restart_variable_list('effecpress') +!! case(HO_BABC_COULOMB_POWERLAW_TSAI) +!! call glide_add_to_restart_variable_list('effecpress') + case (HO_BABC_COULOMB_FRICTION) + call glide_add_to_restart_variable_list('C_space_factor') ! C_space_factor needs to be in restart file if not = 1 everywhere !TODO - Add C_space_factor to the restart file only if not = 1 everywhere? - call glide_add_to_restart_variable_list('C_space_factor') - case(HO_BABC_COULOMB_POWERLAW_TSAI) - call glide_add_to_restart_variable_list('effecpress') case default ! Other HO basal boundary conditions may need the external beta field (although there are a few that don't) !Note: If using beta from an external file, then 'beta' here needs to be the fixed, external field, @@ -2552,11 +2554,30 @@ subroutine define_glide_restart_variables(options) ! basal inversion option select case(options%which_ho_inversion) - case (HO_INVERSION_COMPUTE, HO_INVERSION_PRESCRIBED) - ! If computing powerlaw_c_2d by inversion, this field is needed for restart. - ! Also needed if prescribing powerlaw_c_2d from a previous inversion. - ! Note: coulomb_c_2d is not a restart field, since the ratio powerlaw_c/coulomb_c is fixed. - call glide_add_to_restart_variable_list('powerlaw_c_2d') + case (HO_INVERSION_COMPUTE) + ! If computing powerlaw_c and bmlt_float by inversion, these fields are needed for restart. + ! Note: coulomb_c_inversion is not a restart field, since the ratio powerlaw_c/coulomb_c is fixed. + call glide_add_to_restart_variable_list('powerlaw_c_inversion') + call glide_add_to_restart_variable_list('bmlt_float_inversion') + ! If the restart file will be used to initialize a forward run, + ! then we also want the time-average versions of these fields, + ! which will serve as prescribed fields for the forward run. + ! (Not strictly necessary except for the final run of the inversion, + ! but included for generality) + ! Note: If these fields are written to the restart file, they should not be written + ! to any other output file; else the time average will be wrong. + call glide_add_to_restart_variable_list('powerlaw_c_inversion_tavg') + call glide_add_to_restart_variable_list('bmlt_float_inversion_tavg') + case (HO_INVERSION_PRESCRIBED) + ! If powerlaw_c and bmlt_float are prescribed from a previous inversion, + ! then the prescribed fields are needed to initialize the model. + ! Note: At startup, the '_prescribed' fields typically are copies of '_tavg' fields + ! from the inversion. + ! The powerlaw_c_prescribed field can be extrapolated at startup + ! using a nearest-neighbor approach so that a value is available everywhere. + ! The extrapolated field is then written out and read in for subsequent restarts. + call glide_add_to_restart_variable_list('powerlaw_c_prescribed') + call glide_add_to_restart_variable_list('bmlt_float_prescribed') end select ! If inverting for basal parameters and/or subshelf melting based on thck_obs, diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index fe5b7a77..03046a83 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -1264,7 +1264,8 @@ module glide_types bmlt_float_anomaly => null(), & !> basal melt rate anomaly field bmlt_float_inversion => null(), & !> basal melt rate computed by inversion; !> relaxes thickness of floating ice toward observed target - bmlt_float_inversion_tavg => null() !> basal melt rate computed by inversion (time average) + bmlt_float_inversion_tavg => null(), & !> basal melt rate computed by inversion (time average) + bmlt_float_prescribed => null() !> basal melt rate prescribed from a previous inversion integer, dimension(:,:), pointer :: & bmlt_inversion_mask => null() !> = 1 where bmlt is applied for inversion, else = 0 @@ -1367,10 +1368,10 @@ module glide_types real(dp), dimension(:,:), pointer :: C_space_factor => null() !< spatial factor for basal shear stress (no dimension) real(dp), dimension(:,:), pointer :: C_space_factor_stag => null() !< spatial factor for basal shear stress on staggered grid (no dimension) real(dp), dimension(:,:), pointer :: tau_c => null() !< yield stress for plastic sliding (Pa) - real(dp), dimension(:,:), pointer :: powerlaw_c_2d => null() !< spatially varying powerlaw_c field, Pa m^(-1/3) yr^(1/3) - real(dp), dimension(:,:), pointer :: powerlaw_c_2d_tavg => null() !< spatially varying powerlaw_c field, Pa m^(-1/3) yr^(1/3) - !< time-averaged to provide input for a forward run - real(dp), dimension(:,:), pointer :: coulomb_c_2d => null() !< spatially varying coulomb_c field (unitless) + real(dp), dimension(:,:), pointer :: powerlaw_c_inversion => null() !< spatially varying powerlaw_c field, Pa m^(-1/3) yr^(1/3) + real(dp), dimension(:,:), pointer :: powerlaw_c_inversion_tavg => null() !< spatially varying powerlaw_c field, time average + real(dp), dimension(:,:), pointer :: powerlaw_c_prescribed => null() !< powerlaw_c field, prescribed from a previous inversion + real(dp), dimension(:,:), pointer :: coulomb_c_inversion => null() !< spatially varying coulomb_c field (unitless) ! parameters for reducing the effective pressure where the bed is warm, saturated or connected to the ocean real(dp) :: effecpress_delta = 0.02d0 !< multiplier for effective pressure N where the bed is saturated and/or thawed (unitless) @@ -1853,6 +1854,7 @@ subroutine glide_allocarr(model) !> \item \texttt{bmlt_float_anomaly(ewn,nsn)} !> \item \texttt{bmlt_float_inversion(ewn,nsn)} !> \item \texttt{bmlt_float_inversion_tavg(ewn,nsn)} + !> \item \texttt{bmlt_float_prescribed(ewn,nsn)} !> \item \texttt{bmlt_inversion_mask(ewn,nsn)} !> \end{itemize} @@ -2184,14 +2186,17 @@ subroutine glide_allocarr(model) call coordsystem_allocate(model%general%ice_grid, model%basal_physics%effecpress) call coordsystem_allocate(model%general%velo_grid, model%basal_physics%effecpress_stag) call coordsystem_allocate(model%general%velo_grid, model%basal_physics%tau_c) - call coordsystem_allocate(model%general%ice_grid, model%basal_physics%powerlaw_c_2d) - call coordsystem_allocate(model%general%ice_grid, model%basal_physics%powerlaw_c_2d_tavg) - call coordsystem_allocate(model%general%ice_grid, model%basal_physics%coulomb_c_2d) call coordsystem_allocate(model%general%ice_grid, model%basal_physics%C_space_factor) call coordsystem_allocate(model%general%velo_grid, model%basal_physics%C_space_factor_stag) call coordsystem_allocate(model%general%velo_grid, model%basal_physics%mintauf) !! endif - + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & + model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then + call coordsystem_allocate(model%general%ice_grid, model%basal_physics%powerlaw_c_inversion) + call coordsystem_allocate(model%general%ice_grid, model%basal_physics%powerlaw_c_inversion_tavg) + call coordsystem_allocate(model%general%ice_grid, model%basal_physics%powerlaw_c_prescribed) + call coordsystem_allocate(model%general%ice_grid, model%basal_physics%coulomb_c_inversion) + endif endif ! glam/glissade ! bmlt arrays @@ -2204,9 +2209,11 @@ subroutine glide_allocarr(model) if (model%options%whichbmlt_float == BMLT_FLOAT_EXTERNAL) then call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_float_external) endif - if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & + model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_float_inversion) call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_float_inversion_tavg) + call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_float_prescribed) call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_inversion_mask) endif if (model%options%whichbmlt_float == BMLT_FLOAT_MISOMIP) then @@ -2520,12 +2527,14 @@ subroutine glide_deallocarr(model) deallocate(model%basal_physics%effecpress_stag) if (associated(model%basal_physics%tau_c)) & deallocate(model%basal_physics%tau_c) - if (associated(model%basal_physics%powerlaw_c_2d)) & - deallocate(model%basal_physics%powerlaw_c_2d) - if (associated(model%basal_physics%powerlaw_c_2d_tavg)) & - deallocate(model%basal_physics%powerlaw_c_2d_tavg) - if (associated(model%basal_physics%coulomb_c_2d)) & - deallocate(model%basal_physics%coulomb_c_2d) + if (associated(model%basal_physics%powerlaw_c_inversion)) & + deallocate(model%basal_physics%powerlaw_c_inversion) + if (associated(model%basal_physics%powerlaw_c_inversion_tavg)) & + deallocate(model%basal_physics%powerlaw_c_inversion_tavg) + if (associated(model%basal_physics%powerlaw_c_prescribed)) & + deallocate(model%basal_physics%powerlaw_c_prescribed) + if (associated(model%basal_physics%coulomb_c_inversion)) & + deallocate(model%basal_physics%coulomb_c_inversion) if (associated(model%basal_physics%C_space_factor)) & deallocate(model%basal_physics%C_space_factor) if (associated(model%basal_physics%C_space_factor_stag)) & @@ -2551,6 +2560,8 @@ subroutine glide_deallocarr(model) deallocate(model%basal_melt%bmlt_float_inversion) if (associated(model%basal_melt%bmlt_float_inversion_tavg)) & deallocate(model%basal_melt%bmlt_float_inversion_tavg) + if (associated(model%basal_melt%bmlt_float_prescribed)) & + deallocate(model%basal_melt%bmlt_float_prescribed) if (associated(model%basal_melt%bmlt_inversion_mask)) & deallocate(model%basal_melt%bmlt_inversion_mask) diff --git a/libglide/glide_vars.def b/libglide/glide_vars.def index b554cf23..19361a6c 100644 --- a/libglide/glide_vars.def +++ b/libglide/glide_vars.def @@ -307,8 +307,15 @@ long_name: basal melt rate for floating ice from inversion data: data%basal_melt%bmlt_float_inversion factor: scyr coordinates: lon lat -#WHL - Uncomment to compute bmlt_float_inversion_tavg -#average: 1 +average: 1 + +[bmlt_float_prescribed] +dimensions: time, y1, x1 +units: meter/year +long_name: prescribed basal melt rate for floating ice +data: data%basal_melt%bmlt_float_prescribed +factor: scyr +coordinates: lon lat #WHL - A number of plume-related fields follow. @@ -836,21 +843,28 @@ data: data%basal_physics%C_space_factor load: 1 coordinates: lon lat -[powerlaw_c_2d] +[powerlaw_c_inversion] dimensions: time, y1, x1 units: Pa (m/yr)**(-1/3) long_name: spatially varying C for powerlaw sliding -data: data%basal_physics%powerlaw_c_2d +data: data%basal_physics%powerlaw_c_inversion +load: 1 +coordinates: lon lat +average: 1 + +[powerlaw_c_prescribed] +dimensions: time, y1, x1 +units: Pa (m/yr)**(-1/3) +long_name: prescribed spatially varying C for powerlaw sliding +data: data%basal_physics%powerlaw_c_prescribed load: 1 coordinates: lon lat -#WHL - Uncomment to compute powerlaw_c_2d_tavg -#average: 1 -[coulomb_c_2d] +[coulomb_c_inversion] dimensions: time, y1, x1 units: unitless [0,1] long_name: spatially varying C for Coulomb sliding -data: data%basal_physics%coulomb_c_2d +data: data%basal_physics%coulomb_c_inversion load: 0 coordinates: lon lat diff --git a/libglimmer/glimmer_config.F90 b/libglimmer/glimmer_config.F90 index 74aace4b..4c677cc1 100644 --- a/libglimmer/glimmer_config.F90 +++ b/libglimmer/glimmer_config.F90 @@ -791,7 +791,7 @@ subroutine GetValueChar(section,name,val) use glimmer_log implicit none type(ConfigSection), pointer :: section !< the section from which the value is loaded - character(len=*),intent(in) :: name !< the name of the key + character(len=*), intent(in) :: name !< the name of the key character(len=*), intent(inout) :: val !< the value type(ConfigValue), pointer :: value diff --git a/libglimmer/ncdf_template.F90.in b/libglimmer/ncdf_template.F90.in index 6a8bffc3..fda91c64 100644 --- a/libglimmer/ncdf_template.F90.in +++ b/libglimmer/ncdf_template.F90.in @@ -491,6 +491,13 @@ contains !***************************************************************************** #ifdef HAVE_AVG subroutine NAME_avg_accumulate(outfile,data,model) + + ! Accumulate time averages for 'tavg' variables + ! NOTE: This subroutine works for tavg variables that are written to exactly one output file. + ! If we try to write tavg variables to multiple output files, the accumulated values + ! will be too large, because this subroutine will be called more than once per time step. + ! TODO: Write code to check for doubly listed tavg variables and throw a fatal error. + use parallel use glide_types use DATAMOD diff --git a/libglissade/glissade_basal_traction.F90 b/libglissade/glissade_basal_traction.F90 index 06fdc57d..9c55b3b6 100644 --- a/libglissade/glissade_basal_traction.F90 +++ b/libglissade/glissade_basal_traction.F90 @@ -149,8 +149,8 @@ subroutine calcbeta (whichbabc, & real(dp), dimension(size(beta,1), size(beta,2)) :: & big_lambda, & ! bedrock characteristics flwa_basal_stag, & ! basal flwa interpolated to the staggered grid (Pa^{-n} yr^{-1}) - stag_powerlaw_c_2d, & ! powerlaw_c_2d interpolated to the staggered grid - stag_coulomb_c_2d ! coulomb_c_2d interpolated to the staggered grid + stag_powerlaw_c_inversion, & ! powerlaw_c_inversion interpolated to the staggered grid + stag_coulomb_c_inversion ! coulomb_c_inversion interpolated to the staggered grid ! variables for Tsai et al. parameterization real(dp) :: taub_powerlaw ! basal shear stress given by a power law as in Tsai et al. (2015) @@ -438,8 +438,8 @@ subroutine calcbeta (whichbabc, & ! ! Depending on the value of which_ho_inversion, there are different ways to apply this sliding law: ! (0) Set powerlaw_c and coulomb_c to a constant everywhere. - ! (1) Obtain spatially varying powerlaw_c_2d and coulomb_c_2d fields by inversion. - ! (2) Use spatially varying powerlaw_c_2d and coulomb_c_2d fields prescribed from a previous inversion. + ! (1) Obtain spatially varying powerlaw_c and coulomb_c fields by inversion. + ! (2) Use spatially varying powerlaw_c and coulomb_c fields prescribed from a previous inversion. ! For either (1) or (2), use the 2D fields. if (which_inversion == HO_INVERSION_NONE) then @@ -468,7 +468,7 @@ subroutine calcbeta (whichbabc, & m = basal_physics%powerlaw_m - ! Interpolate powerlaw_c_2d and coulomb_c_2d to the velocity grid. + ! Interpolate powerlaw_c and coulomb_c to the velocity grid. ! stagger_margin_in = 1: Interpolate using only the values in cells with grounded ice. where (ice_mask == 1 .and. floating_mask == 0) @@ -477,21 +477,25 @@ subroutine calcbeta (whichbabc, & grounded_mask = 0 endwhere - call glissade_stagger(ewn, nsn, & - basal_physics%powerlaw_c_2d, stag_powerlaw_c_2d, & - grounded_mask, stagger_margin_in = 1) + call glissade_stagger(ewn, nsn, & + basal_physics%powerlaw_c_inversion, & + stag_powerlaw_c_inversion, & + grounded_mask, & + stagger_margin_in = 1) - call glissade_stagger(ewn, nsn, & - basal_physics%coulomb_c_2d, stag_coulomb_c_2d, & - grounded_mask, stagger_margin_in = 1) + call glissade_stagger(ewn, nsn, & + basal_physics%coulomb_c_inversion, & + stag_coulomb_c_inversion, & + grounded_mask, & + stagger_margin_in = 1) ! Replace zeroes with default values to avoid divzero issues - where (stag_powerlaw_c_2d == 0.0d0) - stag_powerlaw_c_2d = basal_physics%powerlaw_c + where (stag_powerlaw_c_inversion == 0.0d0) + stag_powerlaw_c_inversion = basal_physics%powerlaw_c endwhere - where (stag_coulomb_c_2d == 0.0d0) - stag_coulomb_c_2d = basal_physics%coulomb_c + where (stag_coulomb_c_inversion == 0.0d0) + stag_coulomb_c_inversion = basal_physics%coulomb_c endwhere do ns = 1, nsn-1 @@ -499,10 +503,10 @@ subroutine calcbeta (whichbabc, & speed(ew,ns) = dsqrt(thisvel(ew,ns)**2 + othervel(ew,ns)**2 + smallnum**2) - numerator = stag_powerlaw_c_2d(ew,ns) * stag_coulomb_c_2d(ew,ns) & + numerator = stag_powerlaw_c_inversion(ew,ns) * stag_coulomb_c_inversion(ew,ns) & * basal_physics%effecpress_stag(ew,ns) - denominator = ( stag_powerlaw_c_2d(ew,ns)**m * speed(ew,ns) + & - (stag_coulomb_c_2d(ew,ns) * basal_physics%effecpress_stag(ew,ns))**m )**(1.d0/m) + denominator = ( stag_powerlaw_c_inversion(ew,ns)**m * speed(ew,ns) + & + (stag_coulomb_c_inversion(ew,ns) * basal_physics%effecpress_stag(ew,ns))**m )**(1.d0/m) beta(ew,ns) = (numerator/denominator) * speed(ew,ns)**(1.d0/m - 1.d0) @@ -511,8 +515,8 @@ subroutine calcbeta (whichbabc, & if (this_rank == rtest .and. ew == itest .and. ns == jtest) then write(6,*) 'r, i, j, denom_u, denom_N, speed, beta, taub:', & rtest, itest, jtest, & - (stag_powerlaw_c_2d(ew,ns)**m * speed(ew,ns))**(1.d0/m), & - stag_coulomb_c_2d(ew,ns) * basal_physics%effecpress_stag(ew,ns), & + (stag_powerlaw_c_inversion(ew,ns)**m * speed(ew,ns))**(1.d0/m), & + stag_coulomb_c_inversion(ew,ns) * basal_physics%effecpress_stag(ew,ns), & speed(ew,ns), beta(ew,ns), beta(ew,ns)*speed(ew,ns) endif endif diff --git a/libglissade/glissade_inversion.F90 b/libglissade/glissade_inversion.F90 index ea16e54a..29451be3 100644 --- a/libglissade/glissade_inversion.F90 +++ b/libglissade/glissade_inversion.F90 @@ -78,57 +78,55 @@ subroutine glissade_init_inversion(model) call parallel_halo(model%geometry%thck_obs) - ! Check whether powerlaw_c_2d has been read in already. + ! Check whether powerlaw_c_inversion has been read in already. ! If not, then set to a constant value. - var_maxval = maxval(model%basal_physics%powerlaw_c_2d) + var_maxval = maxval(model%basal_physics%powerlaw_c_inversion) var_maxval = parallel_reduce_max(var_maxval) if (var_maxval > 0.0d0) then - ! do nothing; powerlaw_c_2d has been read in already (e.g., after restart) + ! do nothing; powerlaw_c_inversion has been read in already (e.g., after restart) else - model%basal_physics%powerlaw_c_2d(:,:) = model%basal_physics%powerlaw_c + model%basal_physics%powerlaw_c_inversion(:,:) = model%basal_physics%powerlaw_c endif - call parallel_halo(model%basal_physics%powerlaw_c_2d) + call parallel_halo(model%basal_physics%powerlaw_c_inversion) elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then ! prescribing basal friction coefficient and basal melting from previous inversion - ! Check that the required fields from the inversion are present: powerlaw_c_2d and bmlt_float_inversion. + ! Check that the required fields from the inversion are present: powerlaw_c_inversion and bmlt_float_inversion. - ! Note: A good way to supply powerlaw_c_2d is to compute powerlaw_c_2d_tavg + ! Note: A good way to supply powerlaw_c_prescribed is to compute powerlaw_c_inversion_tavg ! over some period at the end of the inversion run, after the ice is spun up. - ! To output this field from the inversion run, uncomment 'average: 1' under - ! powerlaw_c_2d in glide_vars.def, then configure and rebuild the code. - ! After the inversion run, rename powerlaw_c_2d_tavg as powerlaw_c_2d and + ! After the inversion run, rename powerlaw_c_inversion_tavg as powerlaw_c_presribed and ! copy it to the input file for the prescribed run. - ! And similarly for bmlt_float_inversion_tavg and bmlt_float_inversion + ! And similarly for bmlt_float_inversion_tavg and bmlt_float_prescribed - var_maxval = maxval(model%basal_physics%powerlaw_c_2d) + var_maxval = maxval(model%basal_physics%powerlaw_c_prescribed) var_maxval = parallel_reduce_max(var_maxval) if (var_maxval > 0.0d0) then - ! powerlaw_c_2d has been read in as required - write(message,*) 'powerlaw_c_2d has been read from input file' + ! powerlaw_c_prescribed has been read in as required + write(message,*) 'powerlaw_c_prescribed has been read from input file' call write_log(trim(message)) else - write(message,*) 'ERROR: Must read powerlaw_c_2d from input file to use this inversion option' + write(message,*) 'ERROR: Must read powerlaw_c_prescribed from input file to use this inversion option' call write_log(trim(message), GM_FATAL) endif - call parallel_halo(model%basal_physics%powerlaw_c_2d) + call parallel_halo(model%basal_physics%powerlaw_c_prescribed) - var_maxval = maxval(abs(model%basal_melt%bmlt_float_inversion)) + var_maxval = maxval(abs(model%basal_melt%bmlt_float_prescribed)) var_maxval = parallel_reduce_max(var_maxval) if (var_maxval > 0.0d0) then - ! bmlt_float_inversion has been read in as required - write(message,*) 'bmlt_float_inversion has been read from input file' + ! bmlt_float_prescribed has been read in as required + write(message,*) 'bmlt_float_prescribed has been read from input file' call write_log(trim(message)) else - write(message,*) 'ERROR: Must read bmlt_float_inversion from input file to use this inversion option' + write(message,*) 'ERROR: Must read bmlt_float_prescribed from input file to use this inversion option' call write_log(trim(message), GM_FATAL) endif - call parallel_halo(model%basal_melt%bmlt_float_inversion) + call parallel_halo(model%basal_melt%bmlt_float_prescribed) endif ! which_ho_inversion @@ -136,7 +134,7 @@ end subroutine glissade_init_inversion !*********************************************************************** - !TODO - Add code to set powerlaw_c for prescribed case. + !TODO - Add code to extend powerlaw_c for prescribed case. ! Use prescribed values where available, and otherwise extrapolate from nearby values. ! In this way, we can avoid having very wrong values where the GL has advanced. @@ -150,7 +148,7 @@ subroutine invert_basal_traction(dt, & thck, dthck_dt, & thck_obs) - ! Compute spatially varying fields, powerlaw_c_2d and coulomb_c_2d, by inversion. + ! Compute spatially varying fields, powerlaw_c_inversion and coulomb_c_inversion, by inversion. ! The method is similar to that of Pollard & DeConto (TC, 2012), and is applied to all grounded ice. ! Where thck > thck_obs, powerlaw_c and coulomb_c are reduced to increase sliding. ! Where thck < thck_obs, powerlaw_c and coulomb_c are increased to reduce sliding. @@ -181,8 +179,8 @@ subroutine invert_basal_traction(dt, & real(dp), dimension(nx,ny) :: & dthck, & ! thck - thck_obs on ice grid - old_powerlaw_c, & ! old value of powerlaw_c_2d (start of timestep) - temp_powerlaw_c, & ! temporary value of powerlaw_c_2d (before smoothing) + old_powerlaw_c, & ! old value of powerlaw_c_inversion (start of timestep) + temp_powerlaw_c, & ! temporary value of powerlaw_c_inversion (before smoothing) dpowerlaw_c ! change in powerlaw_c real(dp) :: term1, term2 @@ -199,7 +197,7 @@ subroutine invert_basal_traction(dt, & ! * inversion_babc_timescale = inversion timescale (s); must be > 0 ! * inversion_babc_thck_scale = thickness inversion scale (m); must be > 0 ! * inversion_babc_dthck_dt_scale = dthck_dt inversion scale (m/s); must be > 0 - ! * inversion_babc_smoothing_factor = factor for smoothing powerlaw_c_2d; higher => more smoothing + ! * inversion_babc_smoothing_factor = factor for smoothing powerlaw_c_inversion; higher => more smoothing ! ! Note on smoothing: A smoothing factor of 1/8 gives a 4-1-1-1-1 smoother. ! This is numerically well behaved, but may oversmooth in bowl-shaped regions; @@ -208,42 +206,44 @@ subroutine invert_basal_traction(dt, & logical, parameter :: verbose_inversion = .false. ! Save the starting value - old_powerlaw_c(:,:) = basal_physics%powerlaw_c_2d(:,:) + old_powerlaw_c(:,:) = basal_physics%powerlaw_c_inversion(:,:) dpowerlaw_c(:,:) = 0.0d0 ! Compute difference between current and target thickness dthck(:,:) = thck(:,:) - thck_obs(:,:) ! Loop over cells - ! Note: powerlaw_c_2d and coulomb_c_2d are computed at cell centers where thck is located. - ! Later, they are interpolated to vertices where beta and basal velocity are located. + ! Note: powerlaw_c_inversion and coulomb_c_inversion are computed at cell centers where thck is located. + ! Later, they are interpolated to vertices where bdeta and basal velocity are located. do j = 1, ny do i = 1, nx if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! ice is present and grounded - ! Invert for powerlaw_c_2d and coulomb_c based on dthck and dthck_dt + ! Invert for powerlaw_c and coulomb_c based on dthck and dthck_dt term1 = -dthck(i,j) / basal_physics%inversion_babc_thck_scale term2 = -dthck_dt(i,j) / basal_physics%inversion_babc_dthck_dt_scale dpowerlaw_c(i,j) = (dt/basal_physics%inversion_babc_timescale) & - * basal_physics%powerlaw_c_2d(i,j) * (term1 + term2) + * basal_physics%powerlaw_c_inversion(i,j) * (term1 + term2) ! Limit to prevent huge change in one step - if (abs(dpowerlaw_c(i,j)) > 0.05 * basal_physics%powerlaw_c_2d(i,j)) then + if (abs(dpowerlaw_c(i,j)) > 0.05 * basal_physics%powerlaw_c_inversion(i,j)) then if (dpowerlaw_c(i,j) > 0.0d0) then - dpowerlaw_c(i,j) = 0.05d0 * basal_physics%powerlaw_c_2d(i,j) + dpowerlaw_c(i,j) = 0.05d0 * basal_physics%powerlaw_c_inversion(i,j) else - dpowerlaw_c(i,j) = -0.05d0 * basal_physics%powerlaw_c_2d(i,j) + dpowerlaw_c(i,j) = -0.05d0 * basal_physics%powerlaw_c_inversion(i,j) endif endif - basal_physics%powerlaw_c_2d(i,j) = basal_physics%powerlaw_c_2d(i,j) + dpowerlaw_c(i,j) + basal_physics%powerlaw_c_inversion(i,j) = basal_physics%powerlaw_c_inversion(i,j) + dpowerlaw_c(i,j) ! Limit to a physically reasonable range - basal_physics%powerlaw_c_2d(i,j) = min(basal_physics%powerlaw_c_2d(i,j), basal_physics%powerlaw_c_max) - basal_physics%powerlaw_c_2d(i,j) = max(basal_physics%powerlaw_c_2d(i,j), basal_physics%powerlaw_c_min) + basal_physics%powerlaw_c_inversion(i,j) = min(basal_physics%powerlaw_c_inversion(i,j), & + basal_physics%powerlaw_c_max) + basal_physics%powerlaw_c_inversion(i,j) = max(basal_physics%powerlaw_c_inversion(i,j), & + basal_physics%powerlaw_c_min) !WHL - debug if (verbose_inversion .and. this_rank == rtest .and. i==itest .and. j==jtest) then @@ -254,13 +254,13 @@ subroutine invert_basal_traction(dt, & -dthck(i,j)/basal_physics%inversion_babc_thck_scale, & -dthck_dt(i,j)/basal_physics%inversion_babc_dthck_dt_scale, & term1 + term2 - print*, 'dpowerlaw_c, newpowerlaw_c =', dpowerlaw_c(i,j), basal_physics%powerlaw_c_2d(i,j) + print*, 'dpowerlaw_c, newpowerlaw_c =', dpowerlaw_c(i,j), basal_physics%powerlaw_c_inversion(i,j) endif else ! ice_mask = 0 or floating_mask = 1 ! set to default value - basal_physics%powerlaw_c_2d(i,j) = basal_physics%powerlaw_c + basal_physics%powerlaw_c_inversion(i,j) = basal_physics%powerlaw_c endif ! ice_mask = 1 and floating_mask = 0 @@ -275,14 +275,14 @@ subroutine invert_basal_traction(dt, & print*, 'Before smoothing, powerlaw_c:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_2d(i,j) + write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_inversion(i,j) enddo write(6,*) ' ' enddo endif ! Save the value just computed - temp_powerlaw_c(:,:) = basal_physics%powerlaw_c_2d(:,:) + temp_powerlaw_c(:,:) = basal_physics%powerlaw_c_inversion(:,:) ! Apply Laplacian smoothing to C_p. ! Since C_p is at cell centers but is interpolated to vertices, smoothing can damp checkerboard noise. @@ -307,23 +307,23 @@ subroutine invert_basal_traction(dt, & enddo ! Note: If smoothing is too strong, it can reverse the sign of the change in powerlaw_c. - ! The logic below ensures that if powerlaw_c_2d is increasing, the smoothing can reduce + ! The logic below ensures that if powerlaw_c is increasing, the smoothing can reduce ! the change to zero, but not cause powerlaw_c to decrease relative to old_powerlaw_c - ! (and similarly if powerlaw_c_2d is decreasing). + ! (and similarly if powerlaw_c is decreasing). if (dpowerlaw_c(i,j) > 0.0d0) then if (temp_powerlaw_c(i,j) + dpowerlaw_c_smooth > old_powerlaw_c(i,j)) then - basal_physics%powerlaw_c_2d(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth + basal_physics%powerlaw_c_inversion(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth else ! allow the smoothing to hold Cp at its old value, but not reduce Cp - basal_physics%powerlaw_c_2d(i,j) = old_powerlaw_c(i,j) + basal_physics%powerlaw_c_inversion(i,j) = old_powerlaw_c(i,j) endif elseif (dpowerlaw_c(i,j) < 0.0d0) then if (temp_powerlaw_c(i,j) + dpowerlaw_c_smooth < old_powerlaw_c(i,j)) then - basal_physics%powerlaw_c_2d(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth + basal_physics%powerlaw_c_inversion(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth else ! allow the smoothing to hold Cp at its old value, but not increase Cp - basal_physics%powerlaw_c_2d(i,j) = old_powerlaw_c(i,j) + basal_physics%powerlaw_c_inversion(i,j) = old_powerlaw_c(i,j) endif endif ! dpowerlaw_c > 0 @@ -336,24 +336,26 @@ subroutine invert_basal_traction(dt, & ! factor = abs(dpowerlaw_c(i,j)) / abs(dpowerlaw_c_smooth) ! dpowerlaw_c_smooth = dpowerlaw_c_smooth * factor ! endif -! basal_physics%powerlaw_c_2d(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth +! basal_physics%powerlaw_c_inversion(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth endif ! cell is grounded if (verbose_inversion .and. this_rank==rtest .and. i==itest .and. j==jtest) then - print*, 'Smoothing correction, new powerlaw_c:', dpowerlaw_c_smooth, basal_physics%powerlaw_c_2d(i,j) + print*, 'Smoothing correction, new powerlaw_c:', & + dpowerlaw_c_smooth, basal_physics%powerlaw_c_inversion(i,j) endif enddo enddo - call parallel_halo(basal_physics%powerlaw_c_2d) + call parallel_halo(basal_physics%powerlaw_c_inversion) ! Set coulomb_c assuming a fixed ratio of powerlaw_c/coulomb_c - basal_physics%coulomb_c_2d(:,:) = basal_physics%powerlaw_c_2d(:,:) / basal_physics%powerlaw_coulomb_ratio + basal_physics%coulomb_c_inversion(:,:) = basal_physics%powerlaw_c_inversion(:,:) & + / basal_physics%powerlaw_coulomb_ratio ! Limit coulomb_c to be <= 1, so that basal stress <= effective pressure N - basal_physics%coulomb_c_2d(:,:) = min(basal_physics%coulomb_c_2d(:,:), 1.0d0) + basal_physics%coulomb_c_inversion(:,:) = min(basal_physics%coulomb_c_inversion(:,:), 1.0d0) !WHL - debug if (verbose_inversion .and. this_rank == rtest) then @@ -385,14 +387,14 @@ subroutine invert_basal_traction(dt, & print*, 'After smoothing, powerlaw_c:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_2d(i,j) + write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_inversion(i,j) enddo write(6,*) ' ' enddo print*, 'coulomb_c:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.4)',advance='no') basal_physics%coulomb_c_2d(i,j) + write(6,'(f10.4)',advance='no') basal_physics%coulomb_c_inversion(i,j) enddo write(6,*) ' ' enddo diff --git a/libglissade/glissade_velo_higher.F90 b/libglissade/glissade_velo_higher.F90 index eae42a32..3958e29b 100644 --- a/libglissade/glissade_velo_higher.F90 +++ b/libglissade/glissade_velo_higher.F90 @@ -2149,8 +2149,8 @@ subroutine glissade_velo_higher_solve(model, & endif !------------------------------------------------------------------------------ - ! Compute powerlaw_c_2d and coulomb_c_2d fields, if needed - ! (part of basal_physics derived type) + ! Compute powerlaw_c and coulomb_c fields by inversion, if needed + ! (part of basal_physics derived type). ! Note: dt and thck_obs are not rescaled by the scale_input subroutine, in order ! to avoid accumulating errors by repeated multiplication and division. !------------------------------------------------------------------------------ From b29c00fc6f2565cc29c5bca0f7e6f09453cf94b2 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Fri, 22 Dec 2017 13:16:14 -0700 Subject: [PATCH 10/61] Added code to set powerlaw_c in forward runs with inverted parameters This commit includes a new subroutine, prescribe_basal_traction, that sets powerlaw_c in all cells for forward runs. This subroutine is needed because the grounding line can advance and retreat in forward runs, relative to its position at the end of the inversion run. In this case we should set powerlaw_c to a value other than what was computed during the inversion. Let Cp = the value to be set, and Cp_presc = the prescribed value from the inversion run. The rules are as follows: (1) Read in Cp_presc at initialization, and set Cp = Cp_presc. (2) For grounded cells at runtime: (a) If Cp > 0, leave Cp as is. (b) If Cp = 0, either set Cp = Cp_presc (if Cp_presc /= 0), or else extrapolate Cp from a neighbor cell. In most cases a nonzero neighbor value will exist, because the GL is unlikely to advance more than 1 cell per time step. (3) For ice-free and floating cells at runtime, set Cp = 0. If a floating cell later regrounds, follow rule (2). The time-varying Cp is placed in array powerlaw_c_inversion. The time-independent Cp_presc is placed in array powerlaw_c_prescribed. For forward runs, both these fields are written to the restart file. A related change: During the inversion run, Cp is now set to zero in floating cells, instead of being set to a nonzero default value. When a floating cell regrounds, Cp is set to a nonzero default value and is adjusted from there. Thus, when Cp is written to the restart file, we have Cp = 0 for all floating cells. If this field is subsequently read in for a forward run, floating cells have Cp_presc = 0, instead of a default value that might be unrealistic. I ran a multistage MISMIP+ test as follows: (1) 2ka spinup with Cp = 1.0e4 and bmlt_float = 0.30 m/yr (2) 2ka inversion run, attempting to recover Cp and bmlt_float given the target thickness from (1) (3) 1 ka forward run, given inverted Cp and bmlt_float from (2) I verified that (2) does a good job of recovering Cp and bmlt_float while maintaining the GL position. Also, I verified that (3) keeps the GL in place and does not allow large changes in thickness. The next step is to test these changes for an Antarctic run. --- libglide/glide_setup.F90 | 23 +-- libglide/glide_vars.def | 2 + libglissade/glissade.F90 | 82 +++++----- libglissade/glissade_basal_traction.F90 | 1 + libglissade/glissade_inversion.F90 | 191 ++++++++++++++++++++---- libglissade/glissade_velo_higher.F90 | 16 +- 6 files changed, 238 insertions(+), 77 deletions(-) diff --git a/libglide/glide_setup.F90 b/libglide/glide_setup.F90 index 145376b4..8c6a9566 100644 --- a/libglide/glide_setup.F90 +++ b/libglide/glide_setup.F90 @@ -1303,7 +1303,7 @@ subroutine print_options(model) call write_log('Error, HO basal BC input out of range', GM_FATAL) end if - write(message,*) 'ho_whichinversion : ',model%options%which_ho_inversion, & + write(message,*) 'ho_whichinversion : ',model%options%which_ho_inversion, & ho_whichinversion(model%options%which_ho_inversion) call write_log(message) if (model%options%which_ho_inversion < 0 .or. & @@ -2566,18 +2566,23 @@ subroutine define_glide_restart_variables(options) ! but included for generality) ! Note: If these fields are written to the restart file, they should not be written ! to any other output file; else the time average will be wrong. + !TODO - Consider whether it is better to restart from snapshots. call glide_add_to_restart_variable_list('powerlaw_c_inversion_tavg') call glide_add_to_restart_variable_list('bmlt_float_inversion_tavg') case (HO_INVERSION_PRESCRIBED) - ! If powerlaw_c and bmlt_float are prescribed from a previous inversion, - ! then the prescribed fields are needed to initialize the model. - ! Note: At startup, the '_prescribed' fields typically are copies of '_tavg' fields - ! from the inversion. - ! The powerlaw_c_prescribed field can be extrapolated at startup - ! using a nearest-neighbor approach so that a value is available everywhere. - ! The extrapolated field is then written out and read in for subsequent restarts. + ! Write powerlaw_c_inversion to the restart file, because it is + ! continually adjusted at runtime as the grounding line moves. + ! Also write bmlt_float_inversion. It is not adjusted at runtime, so we need + ! either bmlt_float_inversion or bmlt_float_prescribed, but not both. + call glide_add_to_restart_variable_list('powerlaw_c_inversion') + call glide_add_to_restart_variable_list('bmlt_float_inversion') + ! If powerlaw_c is prescribed from a previous inversion, then the + ! prescribed field is needed at runtime to set powerlaw_c_inversion + ! when floating ice regrounds. + ! The prescribed bmlt_float field is needed only at initialization + ! to set bmlt_float_inversion, so it is not needed for restart. call glide_add_to_restart_variable_list('powerlaw_c_prescribed') - call glide_add_to_restart_variable_list('bmlt_float_prescribed') +!! call glide_add_to_restart_variable_list('bmlt_float_prescribed') end select ! If inverting for basal parameters and/or subshelf melting based on thck_obs, diff --git a/libglide/glide_vars.def b/libglide/glide_vars.def index 19361a6c..3ae7eeb5 100644 --- a/libglide/glide_vars.def +++ b/libglide/glide_vars.def @@ -306,6 +306,7 @@ units: meter/year long_name: basal melt rate for floating ice from inversion data: data%basal_melt%bmlt_float_inversion factor: scyr +load: 1 coordinates: lon lat average: 1 @@ -315,6 +316,7 @@ units: meter/year long_name: prescribed basal melt rate for floating ice data: data%basal_melt%bmlt_float_prescribed factor: scyr +load: 1 coordinates: lon lat #WHL - A number of plume-related fields follow. diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index e7c2fccf..fd4e7a03 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -1122,8 +1122,8 @@ subroutine glissade_transport_solve(model) type(glide_global_type), intent(inout) :: model ! model instance -!! logical, parameter :: verbose_inversion = .false. - logical, parameter :: verbose_inversion = .true. + logical, parameter :: verbose_inversion = .false. +!! logical, parameter :: verbose_inversion = .true. ! --- Local variables --- @@ -1458,14 +1458,8 @@ subroutine glissade_transport_solve(model) ! to the mass balance driver. However, the relaxation of thck toward thck_obs would then ! be followed by horizontal transport, causing thck and thck_obs to diverge again. - if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then - - ! thickness tendency dH/dt from one step to the next (m/s) - ! This tendency is used when inverting for basal traction parameters. - ! It is recomputed at the end of the time step for diagnostic output. - - model%geometry%dthck_dt(:,:) = (thck_unscaled(:,:) - model%geometry%thck_old(:,:)*thk0) & - / (model%numerics%dt * tim0) + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & + model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then ! ------------------------------------------------------------------------ ! Get masks used by glissade_mass_balance_driver and the inversion calculation. @@ -1490,20 +1484,37 @@ subroutine glissade_transport_solve(model) effective_areafrac = 1.0d0 endwhere - ! Invert for bmlt_float_inversion, adjusting the melt rate to relax toward the observed thickness. - ! As the inversion converges, the difference (thck - thck_obs) should approach zero. - ! Note: basal_melt%bmlt_float_inversion is passed out with units of m/s - - call invert_bmlt_float(model%numerics%dt * tim0, & ! s - model%general%ewn, model%general%nsn, & - itest, jtest, rtest, & - model%basal_melt, & - thck_unscaled, & - model%geometry%thck_obs*thk0, & - ice_mask, & - floating_mask, & - ocean_mask, & - land_mask) + ! For the inversion run, compute bmlt_float_inversion, and compute dthck_dt + ! for use in the later computation of powerlaw_c_inversion. + ! Note: powerlaw_c_inversion is computed in the velocity solver. + ! If bmlt_float is prescribed from a previous inversion, it does not need + ! to be recomputed here. + + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then + + ! thickness tendency dH/dt from one step to the next (m/s) + ! This tendency is used when inverting for basal traction parameters. + ! It is recomputed at the end of the time step for diagnostic output. + + model%geometry%dthck_dt(:,:) = (thck_unscaled(:,:) - model%geometry%thck_old(:,:)*thk0) & + / (model%numerics%dt * tim0) + + ! Invert for bmlt_float_inversion, adjusting the melt rate to relax toward the observed thickness. + ! As the inversion converges, the difference (thck - thck_obs) should approach zero. + ! Note: basal_melt%bmlt_float_inversion is passed out with units of m/s + + call invert_bmlt_float(model%numerics%dt * tim0, & ! s + model%general%ewn, model%general%nsn, & + itest, jtest, rtest, & + model%basal_melt, & + thck_unscaled, & + model%geometry%thck_obs*thk0, & + ice_mask, & + floating_mask, & + ocean_mask, & + land_mask) + + endif ! which_ho_inversion !WHL - debug if (verbose_inversion .and. this_rank == rtest) then @@ -1514,18 +1525,10 @@ subroutine glissade_transport_solve(model) print*, 'thck (m), thck_obs (m), bmlt_float_inversion (m/yr):', thck_unscaled(i,j), & model%geometry%thck_obs(i,j)*thk0, model%basal_melt%bmlt_float_inversion(i,j)*scyr print*, ' ' - print*, 'bmlt_inversion_mask:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(i12)',advance='no') model%basal_melt%bmlt_inversion_mask(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' print*, 'floating_mask:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(i12)',advance='no') floating_mask(i,j) + write(6,'(i10)',advance='no') floating_mask(i,j) enddo write(6,*) ' ' enddo @@ -1533,7 +1536,7 @@ subroutine glissade_transport_solve(model) print*, 'thck (m):' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f12.5)',advance='no') thck_unscaled(i,j) + write(6,'(f10.3)',advance='no') thck_unscaled(i,j) enddo write(6,*) ' ' enddo @@ -1541,7 +1544,7 @@ subroutine glissade_transport_solve(model) print*, 'thck - thck_obs (m):' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f12.5)',advance='no') thck_unscaled(i,j) - model%geometry%thck_obs(i,j)*thk0 + write(6,'(f10.3)',advance='no') thck_unscaled(i,j) - model%geometry%thck_obs(i,j)*thk0 enddo write(6,*) ' ' enddo @@ -1549,7 +1552,7 @@ subroutine glissade_transport_solve(model) print*, 'thck_flotation (m):' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f12.5)',advance='no') -(rhoo/rhoi)*model%geometry%topg(i,j)*thk0 + write(6,'(f10.3)',advance='no') -(rhoo/rhoi)*model%geometry%topg(i,j)*thk0 enddo write(6,*) ' ' enddo @@ -1557,7 +1560,7 @@ subroutine glissade_transport_solve(model) print*, 'bmlt_float_inversion (m/yr):' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f12.5)',advance='no') model%basal_melt%bmlt_float_inversion(i,j)*scyr + write(6,'(f10.3)',advance='no') model%basal_melt%bmlt_float_inversion(i,j)*scyr enddo write(6,*) ' ' enddo @@ -1596,7 +1599,7 @@ subroutine glissade_transport_solve(model) print*, 'thck (m):' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f12.5)',advance='no') thck_unscaled(i,j) + write(6,'(f10.3)',advance='no') thck_unscaled(i,j) enddo write(6,*) ' ' enddo @@ -1604,11 +1607,10 @@ subroutine glissade_transport_solve(model) print*, 'thck - thck_obs (m):' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f12.5)',advance='no') thck_unscaled(i,j) - model%geometry%thck_obs(i,j)*thk0 + write(6,'(f10.3)',advance='no') thck_unscaled(i,j) - model%geometry%thck_obs(i,j)*thk0 enddo write(6,*) ' ' enddo - endif ! Note: Subroutine invert_basal_traction, which inverts for basal parameters, diff --git a/libglissade/glissade_basal_traction.F90 b/libglissade/glissade_basal_traction.F90 index 9c55b3b6..0b50bb99 100644 --- a/libglissade/glissade_basal_traction.F90 +++ b/libglissade/glissade_basal_traction.F90 @@ -470,6 +470,7 @@ subroutine calcbeta (whichbabc, & ! Interpolate powerlaw_c and coulomb_c to the velocity grid. ! stagger_margin_in = 1: Interpolate using only the values in cells with grounded ice. + ! Zero values in floating and ice-free cells are ignored. where (ice_mask == 1 .and. floating_mask == 0) grounded_mask = 1 diff --git a/libglissade/glissade_inversion.F90 b/libglissade/glissade_inversion.F90 index 29451be3..2c304e86 100644 --- a/libglissade/glissade_inversion.F90 +++ b/libglissade/glissade_inversion.F90 @@ -40,6 +40,9 @@ module glissade_inversion ! a target ice thickness field. !----------------------------------------------------------------------------- + logical, parameter :: verbose_inversion = .false. +!! logical, parameter :: verbose_inversion = .true. + !*********************************************************************** contains @@ -48,8 +51,6 @@ module glissade_inversion subroutine glissade_init_inversion(model) - use glissade_masks, only: glissade_get_masks - ! Initialize inversion for fields of basal traction and basal melting type(glide_global_type), intent(inout) :: model ! model instance @@ -128,15 +129,26 @@ subroutine glissade_init_inversion(model) call parallel_halo(model%basal_melt%bmlt_float_prescribed) - endif ! which_ho_inversion + ! If not a restart, then initialize powerlaw_c_inversion and bmlt_float_inversion to presribed values. + ! If a restart run, both fields are read from the restart file. + ! Note: powerlaw_c_inversion is adjusted at runtime where either + ! (1) Ice is grounded in the forward run but powerlaw_c was not computed in the inversion run, or + ! (2) Ice is floating in the forward run + ! Note: bmlt_float_inversion is not adjusted at runtime. + ! If an interior lake were to form at runtime in a region that was an ice shelf during inversion, + ! we might have nonzero bmlt_float_prescribed where we want bmlt_float_inversion = 0. + ! Ignore that possibility for now. - end subroutine glissade_init_inversion + if (model%options%is_restart == RESTART_FALSE) then -!*********************************************************************** + model%basal_physics%powerlaw_c_inversion(:,:) = model%basal_physics%powerlaw_c_prescribed(:,:) + model%basal_melt%bmlt_float_inversion(:,:) = model%basal_melt%bmlt_float_prescribed(:,:) - !TODO - Add code to extend powerlaw_c for prescribed case. - ! Use prescribed values where available, and otherwise extrapolate from nearby values. - ! In this way, we can avoid having very wrong values where the GL has advanced. + endif + + endif ! which_ho_inversion + + end subroutine glissade_init_inversion !*********************************************************************** @@ -203,8 +215,6 @@ subroutine invert_basal_traction(dt, & ! This is numerically well behaved, but may oversmooth in bowl-shaped regions; ! a smaller value may be better as H converges toward H_obs. - logical, parameter :: verbose_inversion = .false. - ! Save the starting value old_powerlaw_c(:,:) = basal_physics%powerlaw_c_inversion(:,:) dpowerlaw_c(:,:) = 0.0d0 @@ -221,7 +231,13 @@ subroutine invert_basal_traction(dt, & if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! ice is present and grounded - ! Invert for powerlaw_c and coulomb_c based on dthck and dthck_dt + ! If this cell has just grounded, it will have powerlaw_c = 0 from when it was ice-free or floating. + ! Give it a sensible default value before proceeding. + if (basal_physics%powerlaw_c_inversion(i,j) == 0.0d0) then + basal_physics%powerlaw_c_inversion(i,j) = basal_physics%powerlaw_c + endif + + ! Invert for powerlaw_c based on dthck and dthck_dt term1 = -dthck(i,j) / basal_physics%inversion_babc_thck_scale term2 = -dthck_dt(i,j) / basal_physics%inversion_babc_dthck_dt_scale @@ -259,15 +275,20 @@ subroutine invert_basal_traction(dt, & else ! ice_mask = 0 or floating_mask = 1 - ! set to default value - basal_physics%powerlaw_c_inversion(i,j) = basal_physics%powerlaw_c + ! set powerlaw_c = 0 + ! Note: Zero values are ignored when interpolating powerlaw_c to vertices, + ! and in forward runs where powerlaw_c is prescribed from a previous inversion. + ! Warning: If a cell is grounded some of the time and floating the rest of the time, + ! the time-averaging routine will accumulate zero values as if they are real. + ! Time-average fields should be used with caution. + + basal_physics%powerlaw_c_inversion(i,j) = 0.0d0 endif ! ice_mask = 1 and floating_mask = 0 enddo ! i enddo ! j - !WHL - debug if (verbose_inversion .and. this_rank == rtest) then i = itest j = jtest @@ -284,8 +305,8 @@ subroutine invert_basal_traction(dt, & ! Save the value just computed temp_powerlaw_c(:,:) = basal_physics%powerlaw_c_inversion(:,:) - ! Apply Laplacian smoothing to C_p. - ! Since C_p is at cell centers but is interpolated to vertices, smoothing can damp checkerboard noise. + ! Apply Laplacian smoothing. + ! Since powerlaw_c lives at cell centers but is interpolated to vertices, smoothing can damp checkerboard noise. !TODO - Write an operator for Laplacian smoothing? do j = 2, ny-1 do i = 2, nx-1 @@ -340,11 +361,6 @@ subroutine invert_basal_traction(dt, & endif ! cell is grounded - if (verbose_inversion .and. this_rank==rtest .and. i==itest .and. j==jtest) then - print*, 'Smoothing correction, new powerlaw_c:', & - dpowerlaw_c_smooth, basal_physics%powerlaw_c_inversion(i,j) - endif - enddo enddo @@ -357,9 +373,7 @@ subroutine invert_basal_traction(dt, & ! Limit coulomb_c to be <= 1, so that basal stress <= effective pressure N basal_physics%coulomb_c_inversion(:,:) = min(basal_physics%coulomb_c_inversion(:,:), 1.0d0) - !WHL - debug if (verbose_inversion .and. this_rank == rtest) then - i = itest j = jtest print*, 'thck (m):' @@ -398,13 +412,140 @@ subroutine invert_basal_traction(dt, & enddo write(6,*) ' ' enddo - endif end subroutine invert_basal_traction !*********************************************************************** + subroutine prescribe_basal_traction(nx, ny, & + itest, jtest, rtest, & + ice_mask, & + floating_mask, & + powerlaw_c_prescribed, & + powerlaw_c) + + ! Compute Cp = powerlaw_c when Cp is prescribed from a previous inversion run. + ! - For cells where the ice is grounded and a prescribed Cp exists, + ! we simply have Cp = Cp_prescribed. + ! - For cells where the ice is grounded and prescribed Cp = 0 (since the cell + ! was floating or ice-free in the inversion run), we set Cp by extrapolating + ! from neighboring cells, if possible. In principle, the extrapolation could + ! be extended indefinitely as the grounding line advances, but the extrapolation + ! would likely not be accurate over large distances. + ! - For cells where the ice is floating (whether or not a prescribed Cp exists), + ! we set Cp = 0. + + integer, intent(in) :: & + nx, ny ! grid dimensions + + integer, intent(in) :: & + itest, jtest, rtest ! coordinates of diagnostic point + + integer, dimension(nx,ny), intent(in) :: & + ice_mask, & ! = 1 where ice is present, else = 0 + floating_mask ! = 1 where ice is present and floating, else = 0 + + real(dp), dimension(nx,ny), intent(in) :: & + powerlaw_c_prescribed ! powerlaw_c prescribed from previous inversion + + real(dp), dimension(nx,ny), intent(inout) :: & + powerlaw_c ! powerlaw_c adjusted or extended as needed + + ! local variables + + real(dp), dimension(nx,ny) :: & + new_powerlaw_c ! new powerlaw_c values extrapolated from existing values + + integer :: i, j, ii, jj + + integer :: count ! counter + real(dp) :: sum_powerlaw_c ! sum of powerlaw_c in neighbor cells + + ! Zero out powerlaw_c where ice is not grounded + where (ice_mask == 0 .or. floating_mask == 1) + powerlaw_c = 0.0d0 + endwhere + + ! Compute new values of powerlaw_c in newly grounded cells + new_powerlaw_c(:,:) = 0.0d0 + + do j = 2, ny-1 + do i = 2, nx-1 + if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! grounded ice + + if (powerlaw_c(i,j) > 0.0d0) then + + ! cell was already grounded; use the current value + + elseif (powerlaw_c_prescribed(i,j) > 0.0d0) then ! use the prescribed value + + new_powerlaw_c(i,j) = powerlaw_c_prescribed(i,j) + + else ! extrapolate from neighbor cells + + count = 0 + sum_powerlaw_c = 0.0d0 + do jj = j-1, j+1 + do ii = i-1, i+1 + if ( (ii == i .or. jj == j) .and. (ii /= i .or. jj /= j) ) then ! edge neighbors + if (powerlaw_c(ii,jj) > 0.0d0) then + count = count + 1 + sum_powerlaw_c = sum_powerlaw_c + powerlaw_c(ii,jj) + endif + endif + enddo + enddo + if (count > 0) then + new_powerlaw_c(i,j) = sum_powerlaw_c/count + endif + + endif ! powerlaw_c > 0 + + endif ! grounded + enddo ! i + enddo ! j + + ! Fill in new values + where (new_powerlaw_c > 0.0d0) + powerlaw_c = new_powerlaw_c + endwhere + + call parallel_halo(powerlaw_c) + + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'floating_mask:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(i10)',advance='no') floating_mask(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'powerlaw_c_prescribed:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.2)',advance='no') powerlaw_c_prescribed(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'computed powerlaw_c:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.2)',advance='no') powerlaw_c(i,j) + enddo + write(6,*) ' ' + enddo + endif ! verbose + + end subroutine prescribe_basal_traction + +!*********************************************************************** + subroutine invert_bmlt_float(dt, & nx, ny, & itest, jtest, rtest, & @@ -472,8 +613,6 @@ subroutine invert_bmlt_float(dt, & ! As the timescale approaches zero, the adjusted bmlt_float_inversion will approach the value ! needed to give H = H_obs. - logical, parameter :: verbose_inversion = .false. - if (verbose_inversion .and. main_task) then print*, ' ' print*, 'In invert_bmlt_float' diff --git a/libglissade/glissade_velo_higher.F90 b/libglissade/glissade_velo_higher.F90 index 3958e29b..06f8d767 100644 --- a/libglissade/glissade_velo_higher.F90 +++ b/libglissade/glissade_velo_higher.F90 @@ -667,7 +667,7 @@ subroutine glissade_velo_higher_solve(model, & !---------------------------------------------------------------- use glissade_basal_traction, only: calcbeta, calc_effective_pressure - use glissade_inversion, only: invert_basal_traction + use glissade_inversion, only: invert_basal_traction, prescribe_basal_traction use glissade_therm, only: glissade_pressure_melting_point !---------------------------------------------------------------- @@ -2151,6 +2151,9 @@ subroutine glissade_velo_higher_solve(model, & !------------------------------------------------------------------------------ ! Compute powerlaw_c and coulomb_c fields by inversion, if needed ! (part of basal_physics derived type). + ! Note: If powerlaw_c is prescribed from a previous inversion, it may need to be + ! adjusted in cells that were floating during the inversion but are now grounded, + ! or vice versa. ! Note: dt and thck_obs are not rescaled by the scale_input subroutine, in order ! to avoid accumulating errors by repeated multiplication and division. !------------------------------------------------------------------------------ @@ -2167,6 +2170,15 @@ subroutine glissade_velo_higher_solve(model, & dthck_dt, & ! m/s thck_obs*thk0) ! m + elseif (whichinversion == HO_INVERSION_PRESCRIBED) then + + call prescribe_basal_traction(nx, ny, & + itest, jtest, rtest, & + ice_mask, & + floating_mask, & + model%basal_physics%powerlaw_c_prescribed, & + model%basal_physics%powerlaw_c_inversion) + endif !------------------------------------------------------------------------------ @@ -2334,7 +2346,7 @@ subroutine glissade_velo_higher_solve(model, & write(6,'(i6)',advance='no') j !! do i = 1, nx-1 do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') f_ground(i,j) + write(6,'(f10.5)',advance='no') f_ground(i,j) enddo write(6,*) ' ' enddo From 921e9b538ed32e909bf245fdc1e7717eeb9985ec Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Fri, 22 Dec 2017 23:21:38 -0700 Subject: [PATCH 11/61] Do not invert for bmlt_float in initially grounded cells After running some Antarctic tests and getting some oscillations, I revised the criteria for computing bmlt_float_inversion. Previously, bmlt_float_inversion was computed in all floating cells (except lake cells and cells adjacent to land). With this commit, bmlt_float_inversion is computed in cells that are both initially floating and currently floating. It is not computed in cells that are initially grounded. This change gives smoother results in MISMIP+ tests. Other changes: - I changed the default values of inversion_bmlt_timescale and inversion_bmlt_smoothing factor to 0. These values give better behavior and faster convergence than nonzero values. At some point I might remove these parameters from the code. - I fixed a logic error in the powerlaw_c inversion. In newly grounded cells, old_powerlaw_c should not be set until after the cell gets a sensible, nonzero starting value. This value is now computed by extrapolating from grounded neighbors. - I set verbose_inversion = .true. for now. --- libglide/glide_types.F90 | 4 +- libglissade/glissade.F90 | 21 +++++--- libglissade/glissade_inversion.F90 | 76 ++++++++++++++++++---------- libglissade/glissade_velo_higher.F90 | 14 ----- 4 files changed, 66 insertions(+), 49 deletions(-) diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index 03046a83..91778ee8 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -1292,9 +1292,9 @@ module glide_types !> If set to zero, then the anomaly is applied immediately. ! inversion parameters real(dp) :: & - inversion_bmlt_timescale = 10.d0, & !> inversion timescale (yr); + inversion_bmlt_timescale = 0.d0, & !> inversion timescale (yr); !> relaxation is immediate if timescale = 0 - inversion_bmlt_smoothing_factor = 0.01d0 !> factor for smoothing bmlt_float_inversion (larger => more smoothing) + inversion_bmlt_smoothing_factor = 0.0d0 !> factor for smoothing bmlt_float_inversion (larger => more smoothing) end type glide_basal_melt diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index fd4e7a03..b6772d56 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -1122,8 +1122,8 @@ subroutine glissade_transport_solve(model) type(glide_global_type), intent(inout) :: model ! model instance - logical, parameter :: verbose_inversion = .false. -!! logical, parameter :: verbose_inversion = .true. +!! logical, parameter :: verbose_inversion = .false. + logical, parameter :: verbose_inversion = .true. ! --- Local variables --- @@ -1144,6 +1144,7 @@ subroutine glissade_transport_solve(model) calving_front_mask ! = 1 where ice is floating and borders an ocean cell, else = 0 real(dp), dimension(model%general%ewn, model%general%nsn) :: & + thck_flotation, & ! thickness at which ice is exactly floating thck_calving_front, & ! effective thickness of ice at the calving front effective_areafrac ! effective fractional area of ice at the calving front @@ -1161,8 +1162,6 @@ subroutine glissade_transport_solve(model) integer :: ntracers ! number of tracers to be transported - real(dp) :: thck_flotation - integer :: i, j, k integer :: ewn, nsn, upn integer :: itest, jtest, rtest @@ -1484,6 +1483,13 @@ subroutine glissade_transport_solve(model) effective_areafrac = 1.0d0 endwhere + ! Compute the flotation thickness + where (model%geometry%topg < 0.0d0) + thck_flotation = -(rhoo/rhoi)*model%geometry%topg*thk0 + elsewhere + thck_flotation = 0.0d0 + endwhere + ! For the inversion run, compute bmlt_float_inversion, and compute dthck_dt ! for use in the later computation of powerlaw_c_inversion. ! Note: powerlaw_c_inversion is computed in the velocity solver. @@ -1507,8 +1513,9 @@ subroutine glissade_transport_solve(model) model%general%ewn, model%general%nsn, & itest, jtest, rtest, & model%basal_melt, & - thck_unscaled, & - model%geometry%thck_obs*thk0, & + thck_unscaled, & ! m + model%geometry%thck_obs*thk0, & ! m + thck_flotation, & ! m ice_mask, & floating_mask, & ocean_mask, & @@ -1552,7 +1559,7 @@ subroutine glissade_transport_solve(model) print*, 'thck_flotation (m):' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') -(rhoo/rhoi)*model%geometry%topg(i,j)*thk0 + write(6,'(f10.3)',advance='no') thck_flotation(i,j) enddo write(6,*) ' ' enddo diff --git a/libglissade/glissade_inversion.F90 b/libglissade/glissade_inversion.F90 index 2c304e86..be9d4c34 100644 --- a/libglissade/glissade_inversion.F90 +++ b/libglissade/glissade_inversion.F90 @@ -40,8 +40,8 @@ module glissade_inversion ! a target ice thickness field. !----------------------------------------------------------------------------- - logical, parameter :: verbose_inversion = .false. -!! logical, parameter :: verbose_inversion = .true. +!! logical, parameter :: verbose_inversion = .false. + logical, parameter :: verbose_inversion = .true. !*********************************************************************** @@ -198,9 +198,10 @@ subroutine invert_basal_traction(dt, & real(dp) :: term1, term2 real(dp) :: factor real(dp) :: dpowerlaw_c_smooth + real(dp) :: sum_powerlaw_c - integer :: i, j - integer :: ii, jj + integer :: i, j, ii, jj + integer :: count ! inversion parameters in basal_physics derived type: ! * powerlaw_c_max = upper bound for powerlaw_c, Pa (m/yr)^(-1/3) @@ -215,13 +216,44 @@ subroutine invert_basal_traction(dt, & ! This is numerically well behaved, but may oversmooth in bowl-shaped regions; ! a smaller value may be better as H converges toward H_obs. - ! Save the starting value - old_powerlaw_c(:,:) = basal_physics%powerlaw_c_inversion(:,:) dpowerlaw_c(:,:) = 0.0d0 ! Compute difference between current and target thickness dthck(:,:) = thck(:,:) - thck_obs(:,:) + ! Check for newly grounded cells that have powerlaw_c = 0 (from when they were ice-free or floating). + ! Give these cells a sensible default value by extrapolating from neighbor cells. + do j = 2, ny-1 + do i = 2, nx-1 + if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! grounded ice + if (basal_physics%powerlaw_c_inversion(i,j) == 0.0d0) then + + ! initialize powerlaw_c by extrapolating from neighbor cells + count = 0 + sum_powerlaw_c = 0.0d0 + do jj = j-1, j+1 + do ii = i-1, i+1 + if ( (ii == i .or. jj == j) .and. (ii /= i .or. jj /= j) ) then ! edge neighbors + if (basal_physics%powerlaw_c_inversion(ii,jj) > 0.0d0) then + count = count + 1 + sum_powerlaw_c = sum_powerlaw_c + basal_physics%powerlaw_c_inversion(ii,jj) + endif + endif + enddo + enddo + if (count > 0) then + basal_physics%powerlaw_c_inversion(i,j) = sum_powerlaw_c/count + else ! set to a sensible default + basal_physics%powerlaw_c_inversion(i,j) = basal_physics%powerlaw_c + endif + + endif ! powerlaw_c_inversion = 0 + endif ! grounded ice + enddo ! i + enddo ! j + + call parallel_halo(basal_physics%powerlaw_c_inversion) + ! Loop over cells ! Note: powerlaw_c_inversion and coulomb_c_inversion are computed at cell centers where thck is located. ! Later, they are interpolated to vertices where bdeta and basal velocity are located. @@ -231,11 +263,8 @@ subroutine invert_basal_traction(dt, & if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! ice is present and grounded - ! If this cell has just grounded, it will have powerlaw_c = 0 from when it was ice-free or floating. - ! Give it a sensible default value before proceeding. - if (basal_physics%powerlaw_c_inversion(i,j) == 0.0d0) then - basal_physics%powerlaw_c_inversion(i,j) = basal_physics%powerlaw_c - endif + ! Save the starting value + old_powerlaw_c(i,j) = basal_physics%powerlaw_c_inversion(i,j) ! Invert for powerlaw_c based on dthck and dthck_dt term1 = -dthck(i,j) / basal_physics%inversion_babc_thck_scale @@ -284,7 +313,7 @@ subroutine invert_basal_traction(dt, & basal_physics%powerlaw_c_inversion(i,j) = 0.0d0 - endif ! ice_mask = 1 and floating_mask = 0 + endif ! grounded ice enddo ! i enddo ! j @@ -552,6 +581,7 @@ subroutine invert_bmlt_float(dt, & basal_melt, & thck, & thck_obs, & + thck_flotation, & ice_mask, & floating_mask, & ocean_mask, & @@ -578,7 +608,8 @@ subroutine invert_bmlt_float(dt, & real(dp), dimension(nx,ny), intent(in) :: & thck, & ! ice thickness (m) - thck_obs ! observed thickness (m) + thck_obs, & ! observed thickness (m) + thck_flotation ! thickness at which ice becomes afloat ! Note: When this subroutine is called, ice_mask = 1 where thck > 0, not thck > thklim. integer, dimension(nx,ny), intent(in) :: & @@ -598,7 +629,7 @@ subroutine invert_bmlt_float(dt, & temp_bmlt_float, & ! temporary value of bmlt_float_inversion (before smoothing) dbmlt_float ! change in bmlt_float_inversion - real(dp) :: term1, dbmlt_float_smooth + real(dp) :: dbmlt_float_smooth integer :: i, j, ii, jj @@ -634,13 +665,15 @@ subroutine invert_bmlt_float(dt, & do j = 2, ny-1 do i = 2, nx-1 if (floating_mask(i,j) == 1) then - ! check for land neighbors if (land_mask(i-1,j) == 1 .or. land_mask(i+1,j) == 1 .or. & land_mask(i,j-1) == 1 .or. land_mask(i,j+1) == 1) then - ! mask = 0; do not invert for bmlt_float + ! has a land neighbor; do not invert for bmlt_float elseif (lake_mask(i,j) == 1) then - ! mask = 0; do not invert for bmlt_float + ! no connection to ocean; do not invert for bmlt_float + elseif (thck_obs(i,j) > thck_flotation(i,j)) then + ! initially grounded; do not invert for bmlt_float else + ! OK to invert for bmlt_float basal_melt%bmlt_inversion_mask(i,j) = 1 endif endif @@ -673,11 +706,6 @@ subroutine invert_bmlt_float(dt, & basal_melt%bmlt_float_inversion(i,j) = basal_melt%bmlt_float_inversion(i,j) + dbmlt_float(i,j) - !WHL - I think this may not be needed - ! Limit to a physically reasonable range -! basal_melt%bmlt_float_inversion(i,j) = min(basal_melt%bmlt_float_inversion(i,j), basal_melt%bmlt_float_inversion_max) -! basal_melt%bmlt_float_inversion(i,j) = max(basal_melt%bmlt_float_inversion(i,j), basal_melt%bmlt_float_inversion_min) - !WHL - debug if (verbose_inversion .and. this_rank == rtest .and. i==itest .and. j==jtest) then print*, ' ' @@ -757,10 +785,6 @@ subroutine invert_bmlt_float(dt, & endif ! bmlt_inversion_mask = 1 - if (verbose_inversion .and. this_rank==rtest .and. i==itest .and. j==jtest) then - print*, 'Smoothing correction, new bmlt_float:', dbmlt_float_smooth*scyr, basal_melt%bmlt_float_inversion(i,j)*scyr - endif - enddo enddo diff --git a/libglissade/glissade_velo_higher.F90 b/libglissade/glissade_velo_higher.F90 index 06f8d767..ca35fd50 100644 --- a/libglissade/glissade_velo_higher.F90 +++ b/libglissade/glissade_velo_higher.F90 @@ -2681,20 +2681,6 @@ subroutine glissade_velo_higher_solve(model, & enddo endif - if (whichbabc == HO_BABC_COULOMB_FRICTION .or. & - whichbabc == HO_BABC_COULOMB_POWERLAW_SCHOOF) then - print*, ' ' - print*, 'C_space_factor_stag, itest, rank =', itest, rtest - do j = ny-1, 1, -1 - write(6,'(i6)',advance='no') j -!! do i = 1, nx-1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') model%basal_physics%C_space_factor_stag(i,j) - enddo - write(6,*) ' ' - enddo - endif - endif ! verbose_beta !------------------------------------------------------------------- From 668aa3489375416da55a0358ff6fce889ecaa3fc Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Wed, 27 Dec 2017 16:57:20 -0700 Subject: [PATCH 12/61] Fixes for forward runs with inverted parameters I made several code fixes in the process of doing forward Antarctic runs with prescribed parameters from a previous inversion: - CISM now writes bmlt_float_prescribed to the restart file for the forward run. I am not sure this is required, but it makes things cleaner if bmlt_float_prescribed is read in from a restart file at the start of the run. (That is, if the forward run starts in restart mode rather than init mode.) - I added logic to initialize bmlt_float_inversion and powerlaw_c_inversion correctly if they are not read in from the input/restart file. - I removed some unused lines of code from glissade.F90. - I changed some logic in glissade_add_smb such that when bmlt < 0 (i.e., freeze-on), ice is added only to cells with ice, and not to open ocean cells. Adding ice to open ocean cells results in a mass conservation error. If at some point we want to allow frazil ice formation in open ocean cells, this could be implemented with an additional call to glissade_mass_balance_driver with ocean_mask = 0 and effective_areafrac = 1 everywhere. This commit is answer-changing only for forward runs with inverted parameters, or for the unusual case that a nonzero basal melt field is prescribed for open ocean. --- libglide/glide_setup.F90 | 7 +- libglissade/glissade.F90 | 103 +++-------------------------- libglissade/glissade_inversion.F90 | 36 +++++++--- libglissade/glissade_transport.F90 | 51 ++++++++------ 4 files changed, 75 insertions(+), 122 deletions(-) diff --git a/libglide/glide_setup.F90 b/libglide/glide_setup.F90 index 8c6a9566..bfeedfbe 100644 --- a/libglide/glide_setup.F90 +++ b/libglide/glide_setup.F90 @@ -2579,10 +2579,11 @@ subroutine define_glide_restart_variables(options) ! If powerlaw_c is prescribed from a previous inversion, then the ! prescribed field is needed at runtime to set powerlaw_c_inversion ! when floating ice regrounds. - ! The prescribed bmlt_float field is needed only at initialization - ! to set bmlt_float_inversion, so it is not needed for restart. + ! Currently, the prescribed bmlt_float field is used only at initialization + ! to set bmlt_float_inversion, so it is not strictly needed for restart. + ! Might want to remove it later. call glide_add_to_restart_variable_list('powerlaw_c_prescribed') -!! call glide_add_to_restart_variable_list('bmlt_float_prescribed') + call glide_add_to_restart_variable_list('bmlt_float_prescribed') end select ! If inverting for basal parameters and/or subshelf melting based on thck_obs, diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index b6772d56..abe2505b 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -1521,6 +1521,17 @@ subroutine glissade_transport_solve(model) ocean_mask, & land_mask) + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'Inverting for bmlt_float: rank, i, j =', rtest, i, j + print*, 'thck (m), thck_obs (m), bmlt_float_inversion (m/yr):', thck_unscaled(i,j), & + model%geometry%thck_obs(i,j)*thk0, model%basal_melt%bmlt_float_inversion(i,j)*scyr + print*, ' ' + endif + endif ! which_ho_inversion !WHL - debug @@ -1528,10 +1539,6 @@ subroutine glissade_transport_solve(model) i = itest j = jtest print*, ' ' - print*, 'Inverting for bmlt_float: rank, i, j =', rtest, i, j - print*, 'thck (m), thck_obs (m), bmlt_float_inversion (m/yr):', thck_unscaled(i,j), & - model%geometry%thck_obs(i,j)*thk0, model%basal_melt%bmlt_float_inversion(i,j)*scyr - print*, ' ' print*, 'floating_mask:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 @@ -1571,7 +1578,6 @@ subroutine glissade_transport_solve(model) enddo write(6,*) ' ' enddo - endif ! Zero out acab since this call uses bmlt_float_inversion only @@ -1624,93 +1630,6 @@ subroutine glissade_transport_solve(model) ! is called later, during the velocity solve. ! It requires the same ice mask and floating mask as the velocity solver. - elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then - - ! ------------------------------------------------------------------------ - ! Get masks used by glissade_mass_balance_driver. - ! Pass thklim = 0 to identify cells with thck > 0 (not thck > thklim). - ! ------------------------------------------------------------------------ - - call glissade_get_masks(model%general%ewn, model%general%nsn, & - thck_unscaled, & ! m - model%geometry%topg*thk0, & ! m - model%climate%eus*thk0, & ! m - 0.0d0, & ! thklim = 0 - ice_mask, & - floating_mask = floating_mask, & - ocean_mask = ocean_mask) - - ! For purposes of inversion, assign all cells an effective fraction of 1 or 0. - ! Calving-front cells are treated the same as other ice-covered cells. - where (ocean_mask == 1) - effective_areafrac = 0.0d0 - elsewhere - effective_areafrac = 1.0d0 - endwhere - - ! Set bmlt_float based on bmlt_float_inversion, limited to floating cells - where (floating_mask == 1) - bmlt_unscaled = model%basal_melt%bmlt_float_inversion - elsewhere - bmlt_unscaled = 0.0d0 - endwhere - - !WHL - debug - if (verbose_inversion .and. this_rank == rtest) then - i = itest - j = jtest - print*, ' ' - print*, 'Prescribing bmlt_float from inversion: rank, i, j =', rtest, i, j - print*, 'thck (m), bmlt_float (m/yr):', thck_unscaled(i,j), bmlt_unscaled(i,j)*scyr - print*, ' ' - print*, 'floating_mask:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(i12)',advance='no') floating_mask(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'thck (m):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f12.5)',advance='no') thck_unscaled(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'bmlt_float_inversion (m/yr):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f12.5)',advance='no') model%basal_melt%bmlt_float_inversion(i,j)*scyr - enddo - write(6,*) ' ' - enddo - - endif - - ! Zero out acab since this call uses bmlt_float_inversion only - acab_unscaled(:,:) = 0.0d0 - - ! Apply basal melting for inversion. - ! Note: Basal melting applied during this call is added to bmlt_applied. - call glissade_mass_balance_driver(model%numerics%dt * tim0, & - model%numerics%dew * len0, model%numerics%dns * len0, & - model%general%ewn, model%general%nsn, & - model%general%upn-1, model%numerics%sigma, & - thck_unscaled(:,:), & ! m - acab_unscaled(:,:), & ! m/s - bmlt_unscaled(:,:), & ! m/s - model%climate%acab_applied(:,:), & ! m/s - model%basal_melt%bmlt_applied(:,:), & ! m/s - ocean_mask(:,:), & - effective_areafrac(:,:), & - model%geometry%ntracers, & - model%geometry%tracers(:,:,:,:), & - model%geometry%tracers_usrf(:,:,:), & - model%geometry%tracers_lsrf(:,:,:), & - model%options%which_ho_vertical_remap) - endif ! which_ho_inversion ! copy tracers (temp/enthalpy, etc.) from model%geometry%tracers back to standard arrays diff --git a/libglissade/glissade_inversion.F90 b/libglissade/glissade_inversion.F90 index be9d4c34..5ea6cb4a 100644 --- a/libglissade/glissade_inversion.F90 +++ b/libglissade/glissade_inversion.F90 @@ -97,11 +97,11 @@ subroutine glissade_init_inversion(model) ! Check that the required fields from the inversion are present: powerlaw_c_inversion and bmlt_float_inversion. - ! Note: A good way to supply powerlaw_c_prescribed is to compute powerlaw_c_inversion_tavg + ! Note: A good way to supply powerlaw_c_prescribed is to compute powerlaw_c_inversion ! over some period at the end of the inversion run, after the ice is spun up. ! After the inversion run, rename powerlaw_c_inversion_tavg as powerlaw_c_presribed and ! copy it to the input file for the prescribed run. - ! And similarly for bmlt_float_inversion_tavg and bmlt_float_prescribed + ! And similarly for bmlt_float_inversion and bmlt_float_prescribed var_maxval = maxval(model%basal_physics%powerlaw_c_prescribed) var_maxval = parallel_reduce_max(var_maxval) @@ -130,23 +130,43 @@ subroutine glissade_init_inversion(model) call parallel_halo(model%basal_melt%bmlt_float_prescribed) ! If not a restart, then initialize powerlaw_c_inversion and bmlt_float_inversion to presribed values. - ! If a restart run, both fields are read from the restart file. + ! If a restart run, both fields typically are read from the restart file. + ! An exception would be if we are starting an inversion run in restart mode, using a restart file + ! from the end of a spin-up with inversion. In this case the restart file would contain the fields + ! powerlaw_c_prescribed and bmlt_float_prescribed, and we still need to initialize powerlaw_c_inversion + ! and bmlt_float_inversion. + ! Note: powerlaw_c_inversion is adjusted at runtime where either ! (1) Ice is grounded in the forward run but powerlaw_c was not computed in the inversion run, or ! (2) Ice is floating in the forward run - ! Note: bmlt_float_inversion is not adjusted at runtime. + ! Note: Currently, bmlt_float_inversion is not adjusted at runtime. ! If an interior lake were to form at runtime in a region that was an ice shelf during inversion, ! we might have nonzero bmlt_float_prescribed where we want bmlt_float_inversion = 0. ! Ignore that possibility for now. - if (model%options%is_restart == RESTART_FALSE) then - + var_maxval = maxval(abs(model%basal_physics%powerlaw_c_inversion)) + var_maxval = parallel_reduce_max(var_maxval) + if (var_maxval > 0.0d0) then + ! powerlaw_c_inversion has been read from a restart file; nothing to do here + else + ! initialize powerlaw_c_inversion model%basal_physics%powerlaw_c_inversion(:,:) = model%basal_physics%powerlaw_c_prescribed(:,:) - model%basal_melt%bmlt_float_inversion(:,:) = model%basal_melt%bmlt_float_prescribed(:,:) + endif + call parallel_halo(model%basal_physics%powerlaw_c_inversion) + + var_maxval = maxval(abs(model%basal_melt%bmlt_float_inversion)) + var_maxval = parallel_reduce_max(var_maxval) + if (var_maxval > 0.0d0) then + ! bmlt_float_inversion has been read from a restart file; nothing to do here + else + ! initialize bmlt_float_inversion + model%basal_melt%bmlt_float_inversion(:,:) = model%basal_melt%bmlt_float_prescribed(:,:) endif - endif ! which_ho_inversion + call parallel_halo(model%basal_melt%bmlt_float_inversion) + + endif ! which_ho_inversion end subroutine glissade_init_inversion diff --git a/libglissade/glissade_transport.F90 b/libglissade/glissade_transport.F90 index 0c985567..0182d41f 100644 --- a/libglissade/glissade_transport.F90 +++ b/libglissade/glissade_transport.F90 @@ -534,10 +534,6 @@ subroutine glissade_mass_balance_driver(dt, & endif ! main_task - ! Update msum_init and mtsum_init for the next conservation check - msum_init = msum_final ! msum_final computed above after glissade_add_smb - mtsum_init(:) = mtsum_final(:) ! mtsum_final computed above after glissade_add_smb - endif ! conservation_check ! Recompute thickness @@ -1311,6 +1307,8 @@ subroutine global_conservation (msum_init, msum_final, & call write_log(message) write (message,*) 'Final global mass (adjusted for melt potential) =', msum_final - melt_potential call write_log(message) + write (message,*) 'Absolute error =', diff + call write_log(message) write (message,*) 'Fractional error =', abs(diff)/msum_init call write_log(message) endif @@ -1460,8 +1458,7 @@ subroutine glissade_add_smb(nx, ny, & if (ocean_mask(i,j) == 1) then ! no accumulation in open ocean - ! TODO - Is this the correct treatment of the melt potential for accumulation over the ocean? - melt_potential(i,j) = melt_potential(i,j) - sfc_accum + ! do nothing else ! not ocean; accumulate ice @@ -1520,29 +1517,44 @@ subroutine glissade_add_smb(nx, ny, & ! Note: It is possible that we could have residual energy remaining for surface ablation ! while ice is freezing on at the bed, in which case the surface ablation should ! be subtracted from the bed accumulation. We ignore this possibility for now. - ! Note: If bmlt < 0 (i.e., freeze-on), we allow ice growth even in ice-free ocean cells. - ! That is, freeze-on in ocean cells is interpreted as frazil ice growth. + + ! Note: Freeze-on (bmlt < 0) is allowed only in ice-covered cells, not ice-free ocean. + ! Allowing freeze-on in ice-free ocean would introduce mass conservation errors, + ! given the current logic with effective_areafrac. + ! If it is desired to implement a field of frazil ice formation that could grow ice + ! in open ocean as well as sub-shelf cavities and open ocean, this field could be passed + ! into glissade_mass_balance_driver in a separate call (i.e., independent of the standard + ! acab and bmlt fields) with ocean_mask = 0 and effective_areafrac = 1 everywhere. + ! Then the following code would allow frazil growth, as desired. if (bmlt(i,j) < 0.d0) then ! freeze-on, added to lowest layer bed_accum = -bmlt(i,j)*dt - bmlt_applied(i,j) = bmlt_applied(i,j) - bed_accum*effective_areafrac(i,j) ! bmlt_applied < 0 for freeze-on + if (ocean_mask(i,j) == 1) then ! no accumulation in open ocean + + ! do nothing + + else ! not ocean; accumulate ice + + bmlt_applied(i,j) = bmlt_applied(i,j) - bed_accum*effective_areafrac(i,j) ! bmlt_applied < 0 for freeze-on + + ! adjust mass-tracer product for the bottom layer - ! adjust mass-tracer product for the bottom layer + do nt = 1, ntracer !TODO - Put this loop on the outside for speedup? - do nt = 1, ntracer !TODO - Put this loop on the outside for speedup? + thck_tracer(i,j,nt,nlyr) = thck_layer(i,j,nlyr) * tracer(i,j,nt,nlyr) & + + bed_accum * tracer_lsrf(i,j,nt) - thck_tracer(i,j,nt,nlyr) = thck_layer(i,j,nlyr) * tracer(i,j,nt,nlyr) & - + bed_accum * tracer_lsrf(i,j,nt) + enddo ! ntracer - enddo ! ntracer + ! new bottom layer thickess + thck_layer(i,j,nlyr) = thck_layer(i,j,nlyr) + bed_accum - ! new bottom layer thickess - thck_layer(i,j,nlyr) = thck_layer(i,j,nlyr) + bed_accum + ! new tracer values in bottom layer + tracer(i,j,:,nlyr) = thck_tracer(i,j,:,nlyr) / thck_layer(i,j,nlyr) - ! new tracer values in bottom layer - tracer(i,j,:,nlyr) = thck_tracer(i,j,:,nlyr) / thck_layer(i,j,nlyr) + endif ! ocean_mask = 1 elseif (bmlt(i,j) > 0.d0) then ! basal melting in one or more layers @@ -1568,7 +1580,8 @@ subroutine glissade_add_smb(nx, ny, & ! Also accumulate the remaining melt energy if (bed_ablat > 0.d0) then - bmlt_applied(i,j) = bmlt_applied(i,j) - bed_ablat*effective_areafrac(i,j) ! bmlt_applied is less than input bmlt + ! bmlt_applied is less than input bmlt + bmlt_applied(i,j) = bmlt_applied(i,j) - bed_ablat*effective_areafrac(i,j) melt_potential(i,j) = melt_potential(i,j) + bed_ablat endif From ced7f9a96c02dfec7210efa0a54f348a818ca62e Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 5 Mar 2018 11:14:54 -0700 Subject: [PATCH 13/61] Various changes to make inversion and forward runs more robust This commit included a number of changes to make Antarctic inversion runs and subsequent forward runs more robust: - I changed the rules for computing and applying bmlt_float_inversion. The new rules are: (1) Any ice-filled cell that is floating in observations is restored after transport to its target thickness. This includes cells that are either floating or grounded after transport. (Such cells are always floating before transport, having been restored during the previous step, but might be grounded after transport.) (2) Any ice-filled cell that is grounded in observations but floating (or very lightly grounded) after transport is restored to a target grounded thickness. This grounded thickness, however, is not the observed thickness, but rather Hf + thck_over_flot. Here, thck_over_flot is a small thickness (1 m by default). "Very lightly grounded" means that Hf < H < Hf + thck_over_flot. The reason for not restoring grounded cells all the way to the observed value is that we would like the basal sliding coefficients to adjust to help ground the ice more firmly, rather than rely on large negative basal melt rates. - I changed the order of operations in glissade_transport_solve. The new order is: (1) Tracer setup and CFL check (2) Horizontal transport (subcycling as needed) (3) Masks for mass balance driver (4) Adjust acab as needed (5) Adjust bmlt as needed, including bmlt_float_inversion if desired (6) Mass balance update, including acab and bmlt (7) Tracer finish (8) Adjust powerlaw_c_inversion, if desired Thus there is only one call per timestep to the mass balance driver, including all SMB and BMB terms. With this call, bmlt_float_inversion can be used to restore all floating cells to a target thickness. - I added a new subroutine, prescribe_bmlt_float, for forward runs. Generally, this subroutine simply copies bmlt_float_prescribed to bmlt_float_inversion. But it restricts bmlt_float_inversion to cells that are floating before and/or after transport. If a cell grounds during the forward run, then bmlt_float_inversion is cut off. - In the bmlt_float_inversion subroutines, I removed the check for interior lake cells. Now, bmlt_float_inversion can be nonzero for any floating cell, including lake cells. - I changed the method for initializing powerlaw_c_inversion. It is now initialized to powerlaw_c_max (= 1.e5 by default), so that basal sliding is at first very close to zero, and then increases gradually in response to thickness changes. This change helps the model spin up more smoothly and gradually. - I changed the method for setting powerlaw_c_inversion in newly grounded grid cells. Instead of extrapolating values from neighbor cells, we now simply assign a default value based on whether the cell is land-based or marine-based. - I modified the rules for iceberg calving at inactive calving fronts. Previously, any cell not connected to grounded cells by a path passing through active floating cells was calved as an iceberg. Now, an inactive CF cell is allowed to remain if it borders an active floating cell diagonally and also shares an edge with at least one inactive floating cell. This change prevents repeated removal and restoration of cells that lie at the corners of inactive calving fronts (with associated large fluctuations in bmlt_float_inversion). - I changed the critera for determining when calving-front cells are active. Previously, calving-front cells bordering land cells were active. Now, calving-front cells bordering any grounded cell (including marine-based cells) are active. It remains the case that CF cells with thck >= thck_calving_front are active, but ">=' now includes a small error term so that equality is not subject to roundoff errors. Together, these changes reduce flickering between grounded and floating cells in inversion runs, and reduce the size of changes in bmlt_float_inversion between one time step and the next. This is important for getting a forward run whose behavior is similar to the inversion run, without major advance or retreat of grounding lines. Other changes: - I added a config parameter, beta_powerlaw_umax. When this parameter is set to a nonzero value, it is used as the maximum value of the ice speed in basal power laws (including SCHOOF and TSAI) where beta = beta(u). This prevents beta from continuing to decrease as the speed increases. Although not very physical, this change can improve stability and reduce computational cost by reducing large velocities in a small number of grid cells. Note that the ice speed itself is not limited--only its value in the formula for beta. By default, beta_powerlaw_umax = 0, implying no speed limit. - Instead of enforcing a fixed ratio between powerlaw_c_inversion and coulomb_c_inversion, I set coulomb_c_inversion to a user-prescribed constant in inversion runs. - I removed some config parameters that are no longer used: inversion_bmlt_timescale, inversion_bmlt_smoothing_factor, powerlaw_coulomb_ratio. - I changed default values of some basal sliding inversion parameters, to match values found to work well in Antarctic simulations. - I added diagnostics to print global indices for the vertex with the largest residual, when verbose_residual = T. This is useful for identifying cells that are slow to converge. - I added diagnostics to print the maximum difference in bmlt_float_inversion at a single grid cell between one timestep and the next. This is useful for indentifying cells where bmlt_float_inverison is flickering. This commit is answer-changing for runs with inversion. Because of the change in order of operations between transport and mass balance, it also is answer-changing for runs with a nonzero mass balance. Answers also can change for runs with a subgrid-scale calving front. --- libglide/glide_setup.F90 | 33 +- libglide/glide_types.F90 | 61 +- libglissade/glissade.F90 | 754 ++++++++++++++---------- libglissade/glissade_basal_traction.F90 | 25 +- libglissade/glissade_calving.F90 | 41 +- libglissade/glissade_inversion.F90 | 644 ++++++++++++-------- libglissade/glissade_masks.F90 | 55 +- libglissade/glissade_velo_higher.F90 | 117 ++-- 8 files changed, 1038 insertions(+), 692 deletions(-) diff --git a/libglide/glide_setup.F90 b/libglide/glide_setup.F90 index bfeedfbe..45073fa9 100644 --- a/libglide/glide_setup.F90 +++ b/libglide/glide_setup.F90 @@ -210,7 +210,6 @@ subroutine glide_scale_params(model) ! scale basal inversion parameters model%basal_physics%inversion_babc_timescale = model%basal_physics%inversion_babc_timescale * scyr model%basal_physics%inversion_babc_dthck_dt_scale = model%basal_physics%inversion_babc_dthck_dt_scale / scyr - model%basal_melt%inversion_bmlt_timescale = model%basal_melt%inversion_bmlt_timescale * scyr ! scale SMB/acab parameters model%climate%overwrite_acab_value = model%climate%overwrite_acab_value*tim0/(scyr*thk0) @@ -1612,6 +1611,7 @@ subroutine handle_parameters(section, model) call GetValue(section, 'flwa_basal', model%basal_physics%flwa_basal) call GetValue(section, 'powerlaw_c', model%basal_physics%powerlaw_c) call GetValue(section, 'powerlaw_m', model%basal_physics%powerlaw_m) + call GetValue(section, 'beta_powerlaw_umax', model%basal_physics%beta_powerlaw_umax) ! effective pressure parameters call GetValue(section, 'p_ocean_penetration', model%basal_physics%p_ocean_penetration) @@ -1635,13 +1635,10 @@ subroutine handle_parameters(section, model) ! basal inversion parameters call GetValue(section, 'powerlaw_c_max', model%basal_physics%powerlaw_c_max) call GetValue(section, 'powerlaw_c_min', model%basal_physics%powerlaw_c_min) - call GetValue(section, 'powerlaw_coulomb_ratio', model%basal_physics%powerlaw_coulomb_ratio) call GetValue(section, 'inversion_babc_timescale', model%basal_physics%inversion_babc_timescale) call GetValue(section, 'inversion_babc_thck_scale', model%basal_physics%inversion_babc_thck_scale) call GetValue(section, 'inversion_babc_dthck_dt_scale', model%basal_physics%inversion_babc_dthck_dt_scale) call GetValue(section, 'inversion_babc_smoothing_factor', model%basal_physics%inversion_babc_smoothing_factor) - call GetValue(section, 'inversion_bmlt_timescale', model%basal_melt%inversion_bmlt_timescale) - call GetValue(section, 'inversion_bmlt_smoothing_factor', model%basal_melt%inversion_bmlt_smoothing_factor) ! ISMIP-HOM parameters call GetValue(section,'periodic_offset_ew',model%numerics%periodic_offset_ew) @@ -1940,9 +1937,6 @@ subroutine print_parameters(model) write(message,*) 'powerlaw_c min, Pa (m/yr)^(-1/3) : ', & model%basal_physics%powerlaw_c_min call write_log(message) - write(message,*) 'powerlaw_c/coulomb_c ratio : ', & - model%basal_physics%powerlaw_coulomb_ratio - call write_log(message) write(message,*) 'inversion basal traction timescale (yr) : ', & model%basal_physics%inversion_babc_timescale call write_log(message) @@ -1955,12 +1949,6 @@ subroutine print_parameters(model) write(message,*) 'inversion basal traction smoothing factor : ', & model%basal_physics%inversion_babc_smoothing_factor call write_log(message) - write(message,*) 'inversion basal melting timescale (yr) : ', & - model%basal_melt%inversion_bmlt_timescale - call write_log(message) - write(message,*) 'inversion basal melting smoothing factor : ', & - model%basal_melt%inversion_bmlt_smoothing_factor - call write_log(message) endif elseif (model%options%which_ho_babc == HO_BABC_COULOMB_POWERLAW_TSAI) then write(message,*) 'C coefficient for Coulomb friction law : ', model%basal_physics%coulomb_c @@ -1975,6 +1963,16 @@ subroutine print_parameters(model) call write_log(message) endif + if (model%basal_physics%beta_powerlaw_umax > 0.0d0) then + write(message,*) 'max ice speed (m/yr) when evaluating beta(u) : ', model%basal_physics%beta_powerlaw_umax + call write_log(message) + endif + + if (model%basal_physics%beta_grounded_min > 0.d0) then + write(message,*) 'min beta, grounded ice (Pa yr/m) : ', model%basal_physics%beta_grounded_min + call write_log(message) + endif + if (model%options%which_ho_effecpress == HO_EFFECPRESS_BPMP) then write(message,*) 'effective pressure delta : ', model%basal_physics%effecpress_delta call write_log(message) @@ -2003,11 +2001,6 @@ subroutine print_parameters(model) call write_log(message) endif - if (model%basal_physics%beta_grounded_min > 0.d0) then - write(message,*) 'min beta, grounded ice (Pa yr/m): ', model%basal_physics%beta_grounded_min - call write_log(message) - endif - if (model%numerics%idiag < 1 .or. model%numerics%idiag > model%general%ewn & .or. & model%numerics%jdiag < 1 .or. model%numerics%jdiag > model%general%nsn) then @@ -2566,8 +2559,8 @@ subroutine define_glide_restart_variables(options) ! but included for generality) ! Note: If these fields are written to the restart file, they should not be written ! to any other output file; else the time average will be wrong. - !TODO - Consider whether it is better to restart from snapshots. - call glide_add_to_restart_variable_list('powerlaw_c_inversion_tavg') + !TODO - If bmlt_float_inversion is steady, do not need a tavg version? +!! call glide_add_to_restart_variable_list('powerlaw_c_inversion_tavg') call glide_add_to_restart_variable_list('bmlt_float_inversion_tavg') case (HO_INVERSION_PRESCRIBED) ! Write powerlaw_c_inversion to the restart file, because it is diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index 91778ee8..1de9a817 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -1252,7 +1252,13 @@ module glide_types !Note: In the Glide dycore, the only active field in this type is bmlt. ! The other fields are used in Glissade only. + !WHL - debug + real(dp), dimension(:,:), pointer :: & + bmlt_applied_old => null(), & + bmlt_applied_diff => null() + ! bmlt fields for grounded and floating ice + real(dp), dimension(:,:), pointer :: & bmlt => null(), & !> basal melt rate (> 0 for melt, < 0 for freeze-on) !> bmlt = bmlt_ground + bmlt_float @@ -1261,14 +1267,22 @@ module glide_types bmlt_ground => null(), & !> basal melt rate for grounded ice bmlt_float => null(), & !> basal melt rate for floating ice bmlt_float_external => null(), & !> external basal melt rate field - bmlt_float_anomaly => null(), & !> basal melt rate anomaly field + bmlt_float_anomaly => null() !> basal melt rate anomaly field + + ! Notes on inversion fields: + ! With which_ho_inversion = HO_INVERSION_COMPUTE, bmlt_float_inversion is computed and applied during each step. + ! For which_ho_inversion = HO_INVERSION_PRESCRIBED, bmlt_float_prescribed (as computed in a + ! previous inversion run) is read from the input file. + + real(dp), dimension(:,:), pointer :: & bmlt_float_inversion => null(), & !> basal melt rate computed by inversion; !> relaxes thickness of floating ice toward observed target bmlt_float_inversion_tavg => null(), & !> basal melt rate computed by inversion (time average) bmlt_float_prescribed => null() !> basal melt rate prescribed from a previous inversion integer, dimension(:,:), pointer :: & - bmlt_inversion_mask => null() !> = 1 where bmlt is applied for inversion, else = 0 + grounded_mask_start=> null(), & !> = 1 where ice is grounded at start of timestep, else = 0 + floating_mask_start=> null() !> = 1 where ice is floating at start of timestep, else = 0 real(dp) :: bmlt_float_factor = 1.0d0 !> adjustment factor for external bmlt_float field @@ -1290,11 +1304,6 @@ module glide_types ! initMIP-Antarctica parameters real(dp) :: bmlt_anomaly_timescale = 0.0d0 !> number of years over which the bmlt_float anomaly is phased in linearly !> If set to zero, then the anomaly is applied immediately. - ! inversion parameters - real(dp) :: & - inversion_bmlt_timescale = 0.d0, & !> inversion timescale (yr); - !> relaxation is immediate if timescale = 0 - inversion_bmlt_smoothing_factor = 0.0d0 !> factor for smoothing bmlt_float_inversion (larger => more smoothing) end type glide_basal_melt @@ -1406,7 +1415,7 @@ module glide_types real(dp) :: flwa_basal = 1.0d-16 !< Glen's A at the bed for Schoof (2005) Coulomb friction law (Pa^{-n} yr^{-1}) !< = 3.1688d-24 Pa{-n} s{-1}, the value used by Leguy et al. (2014) - ! parameters for power law, taub_b = C * u_b^(1/m); used for HO_BABC_COULOMB_POWERLAW_TSAI + ! parameters for power law, taub_b = C * u_b^(1/m); used for HO_BABC_COULOMB_POWERLAW_TSAI/SCHOOF ! The default values are from Asay-Davis et al. (2016). ! The value of powerlaw_c suggested by Tsai et al. (2015) is 7.624d6 Pa m^(-1/3) s^(1/3). ! This value can be converted to CISM units by dividing by scyr^(1/3), to obtain 2.413d4 Pa m^(-1/3) yr^(1/3). @@ -1416,20 +1425,23 @@ module glide_types real(dp) :: powerlaw_c = 1.0d4 !< friction coefficient in power law, units of Pa m^(-1/3) yr^(1/3) real(dp) :: powerlaw_m = 3.d0 !< exponent in power law (unitless) + ! parameter to limit the min value of beta for various power laws + real(dp) :: beta_powerlaw_umax = 0.0d0 !< upper limit of ice speed (m/yr) when evaluating powerlaw beta + !< Where u > umax, let u = umax when evaluating beta(u) + ! parameters for inversion of basal friction coefficients ! Note: These values work well for MISMIP+, but may not be optimal for whole ice sheets. ! Note: inversion_babc_timescale and inversion_babc_dthck_dt_scale are later rescaled to SI units (s and m/s). real(dp) :: & powerlaw_c_max = 1.0d5, & !< Pa (m/yr)^(-1/3) - powerlaw_c_min = 2.0d3, & !< Pa (m/yr)^(-1/3) - powerlaw_coulomb_ratio = 2.0d4 !< powerlaw_c/coulomb_c (same units as powerlaw_c)) + powerlaw_c_min = 1.0d2 !< Pa (m/yr)^(-1/3) real(dp) :: & - inversion_babc_timescale = 200.d0, & !< inversion timescale (yr); must be > 0 - inversion_babc_thck_scale = 50.d0, & !< thickness inversion scale (m); must be > 0 - inversion_babc_dthck_dt_scale = 0.50d0, & !< dthck_dt inversion scale (m/yr); must be > 0 - inversion_babc_smoothing_factor = 0.05d0 !< factor for smoothing powerlaw_c (larger => more smoothing) + inversion_babc_timescale = 500.d0, & !< inversion timescale (yr); must be > 0 + inversion_babc_thck_scale = 100.d0, & !< thickness inversion scale (m); must be > 0 + inversion_babc_dthck_dt_scale = 0.10d0, & !< dthck_dt inversion scale (m/yr); must be > 0 + inversion_babc_smoothing_factor = 1.0d-2 !< factor for smoothing powerlaw_c (larger => more smoothing) ! parameter for constant basal water ! Note: This parameter applies to HO_BWAT_CONSTANT only. @@ -1855,7 +1867,8 @@ subroutine glide_allocarr(model) !> \item \texttt{bmlt_float_inversion(ewn,nsn)} !> \item \texttt{bmlt_float_inversion_tavg(ewn,nsn)} !> \item \texttt{bmlt_float_prescribed(ewn,nsn)} - !> \item \texttt{bmlt_inversion_mask(ewn,nsn)} + !> \item \texttt{grounded_mask_start(ewn,nsn)} + !> \item \texttt{floating_mask_start(ewn,nsn)} !> \end{itemize} !> In \texttt{model\%plume}: @@ -2202,6 +2215,11 @@ subroutine glide_allocarr(model) ! bmlt arrays call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt) call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_applied) + + !WHL - debug + call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_applied_old) + call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_applied_diff) + if (model%options%whichdycore == DYCORE_GLISSADE) then call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_ground) call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_float) @@ -2214,7 +2232,8 @@ subroutine glide_allocarr(model) call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_float_inversion) call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_float_inversion_tavg) call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_float_prescribed) - call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_inversion_mask) + call coordsystem_allocate(model%general%ice_grid, model%basal_melt%grounded_mask_start) + call coordsystem_allocate(model%general%ice_grid, model%basal_melt%floating_mask_start) endif if (model%options%whichbmlt_float == BMLT_FLOAT_MISOMIP) then call coordsystem_allocate(model%general%ice_grid, model%plume%T_basal) @@ -2562,8 +2581,14 @@ subroutine glide_deallocarr(model) deallocate(model%basal_melt%bmlt_float_inversion_tavg) if (associated(model%basal_melt%bmlt_float_prescribed)) & deallocate(model%basal_melt%bmlt_float_prescribed) - if (associated(model%basal_melt%bmlt_inversion_mask)) & - deallocate(model%basal_melt%bmlt_inversion_mask) + if (associated(model%basal_melt%grounded_mask_start)) & + deallocate(model%basal_melt%grounded_mask_start) + if (associated(model%basal_melt%floating_mask_start)) & + deallocate(model%basal_melt%floating_mask_start) + if (associated(model%basal_melt%bmlt_applied_old)) & + deallocate(model%basal_melt%bmlt_applied_old) + if (associated(model%basal_melt%bmlt_applied_diff)) & + deallocate(model%basal_melt%bmlt_applied_diff) ! plume arrays if (associated(model%plume%T_basal)) & diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index abe2505b..a0768876 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -62,19 +62,23 @@ module glissade use glide_lithot use glimmer_config use glissade_test, only: glissade_test_halo, glissade_test_transport + use glide_thck, only: glide_calclsrf ! TODO - Make this a glissade subroutine, or inline implicit none integer, private, parameter :: dummyunit=99 logical, parameter :: verbose_glissade = .false. -!! logical, parameter :: verbose_glissade = .true. ! Change any of the following logical parameters to true to carry out simple tests logical, parameter :: test_transport = .false. ! if true, call test_transport subroutine real(dp), parameter :: thk_init = 500.d0 ! initial thickness (m) for test_transport logical, parameter :: test_halo = .false. ! if true, call test_halo subroutine +!! logical, parameter :: verbose_inversion = .false. + logical, parameter :: verbose_inversion = .true. + + contains !======================================================================= @@ -100,7 +104,6 @@ subroutine glissade_initialise(model, evolve_ice) use glide_mask use isostasy use glimmer_map_init - use glide_thck, only : glide_calclsrf use glam_strs2, only : glam_velo_init use glimmer_coordinates, only: coordsystem_new use glissade_grid_operators, only: glissade_stagger @@ -573,7 +576,7 @@ subroutine glissade_initialise(model, evolve_ice) !TODO: Think about what halo updates are needed after calving. Just thck and thkmask? ! halo updates - call parallel_halo(model%geometry%thck) ! Updated halo values of thck are needed below in calc_lsrf + call parallel_halo(model%geometry%thck) ! Updated halo values of thck are needed below in calclsrf ! The mask needs to be recalculated after calving. ! Note: glide_set_mask includes a halo update for thkmask. @@ -643,7 +646,7 @@ subroutine glissade_tstep(model, time) ! --- Local variables --- integer :: i, j - + ! ======================== ! Update internal clock @@ -739,9 +742,11 @@ subroutine glissade_tstep(model, time) call glissade_bmlt_float_solve(model) - ! Add bmlt_float to bmlt_ground to determine bmlt. + ! Add bmlt_float to bmlt_ground to determine the total bmlt + ! Note: bmlt = bmlt_ground + bmlt_float may not be equal to the applied melt rate in a given cell, - ! if there are subsequent corrections or if ice is thin or absent in the cell. + ! if ice is thin or absent in the cell. + ! Note: bmlt does not include bmlt_float_inversion, which is a separate input/output field. ! Note: bmlt_ground is computed in glissade_therm_driver. ! If glissade_therm_driver is called twice per time step, then bmlt_ground from ! the second time is not included in the transport solve, but is diagnostic only. @@ -904,6 +909,26 @@ subroutine glissade_bmlt_float_solve(model) ice_mask, & floating_mask = floating_mask) + !TODO - Delete this code when satisfied the grounded_start_mask is no longer needed. + ! If inverting for basal melt, then compute masks of grounded and floating ice + ! before horizontal transport. + ! This mask are used later when computing bmlt_float_inversion. + + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & + model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then + + where (ice_mask == 1 .and. floating_mask == 0) + model%basal_melt%grounded_mask_start = 1 + elsewhere + model%basal_melt%grounded_mask_start = 0 + endwhere + + model%basal_melt%floating_mask_start(:,:) = floating_mask(:,:) + + endif + + ! Compute bmlt_float depending on the whichbmlt_float option + if (model%options%whichbmlt_float == BMLT_FLOAT_NONE) then model%basal_melt%bmlt_float(:,:) = 0.0d0 @@ -919,23 +944,6 @@ subroutine glissade_bmlt_float_solve(model) model%basal_melt%bmlt_float(:,:) = model%basal_melt%bmlt_float(:,:) * model%basal_melt%bmlt_float_factor endif - ! Compute a corrected bmlt_float field that includes any prescribed anomalies. - - if (model%options%enable_bmlt_anomaly) then - - ! Compute the previous time - ! Note: When being ramped up, the anomaly is not incremented until after the final time step of the year. - ! This is the reason for passing the previous time to the subroutine. - previous_time = model%numerics%time - model%numerics%dt * tim0/scyr - - ! Add the bmlt_float anomaly where ice is present and floating - call glissade_add_mbal_anomaly(model%basal_melt%bmlt_float, & ! scaled model units - model%basal_melt%bmlt_float_anomaly, & ! scaled model units - model%basal_melt%bmlt_anomaly_timescale, & ! yr - previous_time) ! yr - - endif - else ! other options include BMLT_FLOAT_CONSTANT, BMLT_FLOAT_MISMIP AND BMLT_FLOAT_MISOMIP !TODO - Call separate subroutines for each of these three options? @@ -958,6 +966,24 @@ subroutine glissade_bmlt_float_solve(model) endif ! whichbmlt_float + ! If desired, add a bmlt_anomaly field. + ! This is done for the initMIP Greenland and Antarctic experimennts. + + if (model%options%enable_bmlt_anomaly) then + + ! Compute the previous time + ! Note: When being ramped up, the anomaly is not incremented until after the final time step of the year. + ! This is the reason for passing the previous time to the subroutine. + previous_time = model%numerics%time - model%numerics%dt * tim0/scyr + + ! Add the bmlt_float anomaly where ice is present and floating + call glissade_add_mbal_anomaly(model%basal_melt%bmlt_float, & ! scaled model units + model%basal_melt%bmlt_float_anomaly, & ! scaled model units + model%basal_melt%bmlt_anomaly_timescale, & ! yr + previous_time) ! yr + + endif + ! Limit the melting to cells where ice is present and floating. ! Note: For this to work correctly, basal melting must be applied before the floating mask changes ! (i.e., before horizontal transport). @@ -1115,16 +1141,13 @@ subroutine glissade_transport_solve(model) glissade_overwrite_acab, & glissade_add_mbal_anomaly use glissade_masks, only: glissade_get_masks - use glissade_inversion, only: invert_bmlt_float - use glide_thck, only: glide_calclsrf ! TODO - Make this a glissade subroutine, or inline + use glissade_inversion, only: invert_bmlt_float, prescribe_bmlt_float, & + invert_basal_traction, prescribe_basal_traction implicit none type(glide_global_type), intent(inout) :: model ! model instance -!! logical, parameter :: verbose_inversion = .false. - logical, parameter :: verbose_inversion = .true. - ! --- Local variables --- integer :: sc ! subcycling index @@ -1190,8 +1213,14 @@ subroutine glissade_transport_solve(model) endif !------------------------------------------------------------------------- - ! First apply the surface and basal mass balance in each grid cell. - ! Then transport ice thickness and temperature, given the horizontal velocity (u,v). + ! First transport ice thickness and temperature, given the horizontal velocity (u,v). + ! Then apply the surface and basal mass balance in each grid cell. + ! Note: The main reason to do both transport and mass balance in one subroutine is + ! that both operations require tracer array setup and cleanup (e.g., copying the + ! various tracer fields into generic tracer arrays). With this arrangement, + ! the tracer operations need to be done only once. + ! TODO: It might be cleaner to do horizontal transport and mass balance in + ! separate subroutines, at the cost of added tracer operations. !------------------------------------------------------------------------- ! MJH: I put the no thickness evolution option here so that it is still possible ! (but not required) to use IR to advect temperature when thickness evolution is turned off. @@ -1207,106 +1236,9 @@ subroutine glissade_transport_solve(model) call t_startf('glissade_transport_driver') - ! Compute a corrected acab field that includes any prescribed anomalies. - ! Typically, acab_corrected = acab, but sometimes (e.g., for initMIP) it includes a time-dependent anomaly. - ! Note that acab itself does not change in time. - -!! print*, 'maxval(acab_anomaly):', maxval(model%climate%acab_anomaly) -!! print*, 'minval(acab_anomaly):', minval(model%climate%acab_anomaly) - - ! initialize - model%climate%acab_corrected(:,:) = model%climate%acab(:,:) - - ! Optionally, multiply acab by a scalar adjustment factor - if (model%climate%acab_factor /= 1.0d0) then - model%climate%acab_corrected(:,:) = model%climate%acab_corrected(:,:) * model%climate%acab_factor - endif - - if (model%options%enable_acab_anomaly) then - - ! Note: When being ramped up, the anomaly is not incremented until after the final time step of the year. - ! This is the reason for passing the previous time to the subroutine. - previous_time = model%numerics%time - model%numerics%dt * tim0/scyr - - call glissade_add_mbal_anomaly(model%climate%acab_corrected, & ! scaled model units - model%climate%acab_anomaly, & ! scaled model units - model%climate%acab_anomaly_timescale, & ! yr - previous_time) - - !WHL - debug -!! if (this_rank==rtest) then -!! i = model%numerics%idiag -!! j = model%numerics%jdiag -!! print*, 'i, j, total anomaly (m/yr), previous_time, new acab (m/yr):', & -!! i, j, model%climate%acab_anomaly(i,j)*thk0*scyr/tim0, previous_time, model%climate%acab_corrected(i,j) -!! endif - - endif - - ! Optionally, overwrite acab_corrected where overwrite_acab_mask = 1. - - if (model%options%overwrite_acab /= 0) then - - call glissade_overwrite_acab(model%climate%overwrite_acab_mask, & - model%climate%overwrite_acab_value, & - model%climate%acab_corrected) - endif - - ! temporary in/out arrays in SI units - thck_unscaled(:,:) = model%geometry%thck(:,:) * thk0 - acab_unscaled(:,:) = model%climate%acab_corrected(:,:) * thk0/tim0 - - ! Add bmlt to the continuity equation in SI units (m/s) - if (model%options%basal_mbal == BASAL_MBAL_CONTINUITY) then ! include bmlt in continuity equation - bmlt_unscaled(:,:) = model%basal_melt%bmlt(:,:) * thk0/tim0 - else ! do not include bmlt in continuity equation - bmlt_unscaled(:,:) = 0.0d0 - endif - - ! ------------------------------------------------------------------------ - ! Get masks used by glissade_mass_balance_driver. - ! Pass thklim = 0 to identify cells with thck > 0 (not thck > thklim). - ! Use ocean_mask to identify ocean cells where positive acab should not be applied. - ! Use thck_calving_front to compute a fractional area for calving_front cells. - ! ------------------------------------------------------------------------ - - call glissade_get_masks(model%general%ewn, model%general%nsn, & - thck_unscaled, & ! m - model%geometry%topg*thk0, & ! m - model%climate%eus*thk0, & ! m - 0.0d0, & ! thklim = 0 - ice_mask, & - floating_mask = floating_mask, & - ocean_mask = ocean_mask, & - which_ho_calving_front = model%options%which_ho_calving_front, & - calving_front_mask = calving_front_mask, & - thck_calving_front = thck_calving_front) - - ! Compute the effective fractional area of calving_front cells - - do j = 1, model%general%nsn - do i = 1, model%general%ewn - if (calving_front_mask(i,j) == 1 .and. thck_calving_front(i,j) > 0.0d0) then - effective_areafrac(i,j) = thck_unscaled(i,j) / thck_calving_front(i,j) - effective_areafrac(i,j) = min(effective_areafrac(i,j), 1.0d0) - elseif (ocean_mask(i,j) == 1) then - effective_areafrac(i,j) = 0.0d0 ! acab and bmlt not applied to ice-free ocean cells - else ! non-CF ice-covered cells and/or land cells - effective_areafrac(i,j) = 1.0d0 - endif - enddo - enddo - - ! Initialize the applied acab and bmlt. - ! Note: These are smaller in magnitude than the input acab and bmlt for cells where either - ! (1) the full column melts, and energy remains for melting, or - ! (2) a positive mass balance is ignored, because a cell is ice-free ocean - - model%climate%acab_applied = 0.0d0 - model%basal_melt%bmlt_applied = 0.0d0 - ! For the enthalpy option, derive enthalpy from temperature and waterfrac. ! Must transport enthalpy rather than temperature/waterfrac to conserve energy. + !TODO: Move this code to glissade_transport_setup_tracers? if (model%options%whichtemp == TEMP_ENTHALPY) then ! Use IR to transport enthalpy ! Note: glissade_temp2enth expects SI units @@ -1320,42 +1252,19 @@ subroutine glissade_transport_solve(model) endif ! TEMP_ENTHALPY ! copy tracers (temp/enthalpy, etc.) into model%geometry%tracers - ! (includes a halo update for tracers) call glissade_transport_setup_tracers (model) - ! ------------------------------------------------------------------------ - ! Apply the surface mass balance (acab) and basal mass balance (bmlt). - ! Note: This subroutine assumes SI units: - ! * dt (s) - ! * dew, dns, thck (m) - ! * acab, bmlt (m/s) - ! ------------------------------------------------------------------------ - - call glissade_mass_balance_driver(model%numerics%dt * tim0, & - model%numerics%dew * len0, model%numerics%dns * len0, & - model%general%ewn, model%general%nsn, & - model%general%upn-1, model%numerics%sigma, & - thck_unscaled(:,:), & ! m - acab_unscaled(:,:), & ! m/s - bmlt_unscaled(:,:), & ! m/s - model%climate%acab_applied(:,:), & ! m/s - model%basal_melt%bmlt_applied(:,:), & ! m/s - ocean_mask(:,:), & - effective_areafrac(:,:), & - model%geometry%ntracers, & - model%geometry%tracers(:,:,:,:), & - model%geometry%tracers_usrf(:,:,:), & - model%geometry%tracers_lsrf(:,:,:), & - model%options%which_ho_vertical_remap) + ! temporary in/out array in SI units + thck_unscaled(:,:) = model%geometry%thck(:,:) * thk0 - ! halo updates for thickness and tracers, to prepare for transport. + ! pre-transport halo updates for thickness and tracers call parallel_halo(thck_unscaled) call parallel_halo_tracers(model%geometry%tracers) call parallel_halo_tracers(model%geometry%tracers_usrf) call parallel_halo_tracers(model%geometry%tracers_lsrf) ! pre-transport halo updates for velocity - ! Velocity update might be needed if velo was not updated in halo at the end of the previous diagnostic solve + ! Velocity update might be needed if velo has not been updated in the halo since the previous diagnostic solve. ! (just to be on the safe side). call staggered_parallel_halo(model%velocity%uvel) @@ -1451,186 +1360,274 @@ subroutine glissade_transport_solve(model) enddo ! subcycling - ! If inverting for bmlt beneath floating ice, then compute bmlt_float_inversion here, - ! and again call the mass balance driver. - ! Note: It would be simpler to include bmlt_float_inversion in the previous call - ! to the mass balance driver. However, the relaxation of thck toward thck_obs would then - ! be followed by horizontal transport, causing thck and thck_obs to diverge again. + !------------------------------------------------------------------------- + ! Apply the surface and basal mass balances. + ! Note: The basal mass balance has been computed in subroutine glissade_bmlt_float_solve. + !------------------------------------------------------------------------- - if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & - model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then + ! ------------------------------------------------------------------------ + ! Get masks used for the mass balance calculation. + ! Pass thklim = 0 to identify cells with thck > 0 (not thck > thklim). + ! Use ocean_mask to identify ocean cells where positive acab should not be applied. + ! Use thck_calving_front to compute a fractional area for calving_front cells. + ! ------------------------------------------------------------------------ - ! ------------------------------------------------------------------------ - ! Get masks used by glissade_mass_balance_driver and the inversion calculation. - ! Pass thklim = 0 to identify cells with thck > 0 (not thck > thklim). - ! ------------------------------------------------------------------------ + call glissade_get_masks(model%general%ewn, model%general%nsn, & + thck_unscaled, & ! m + model%geometry%topg*thk0, & ! m + model%climate%eus*thk0, & ! m + 0.0d0, & ! thklim = 0 + ice_mask, & + floating_mask = floating_mask, & + land_mask = land_mask, & + ocean_mask = ocean_mask, & + which_ho_calving_front = model%options%which_ho_calving_front, & + calving_front_mask = calving_front_mask, & + thck_calving_front = thck_calving_front) - call glissade_get_masks(model%general%ewn, model%general%nsn, & - thck_unscaled, & ! m - model%geometry%topg*thk0, & ! m - model%climate%eus*thk0, & ! m - 0.0d0, & ! thklim = 0 - ice_mask, & - floating_mask = floating_mask, & - ocean_mask = ocean_mask, & - land_mask = land_mask) - - ! For purposes of inversion, assign all cells an effective fraction of 1 or 0. - ! Calving-front cells are treated the same as other ice-covered cells. - where (ocean_mask == 1) - effective_areafrac = 0.0d0 - elsewhere - effective_areafrac = 1.0d0 - endwhere + ! Compute the effective fractional area of calving_front cells. - ! Compute the flotation thickness - where (model%geometry%topg < 0.0d0) - thck_flotation = -(rhoo/rhoi)*model%geometry%topg*thk0 - elsewhere - thck_flotation = 0.0d0 - endwhere + do j = 1, model%general%nsn + do i = 1, model%general%ewn + if (calving_front_mask(i,j) == 1 .and. thck_calving_front(i,j) > 0.0d0) then + effective_areafrac(i,j) = thck_unscaled(i,j) / thck_calving_front(i,j) + effective_areafrac(i,j) = min(effective_areafrac(i,j), 1.0d0) + elseif (ocean_mask(i,j) == 1) then + effective_areafrac(i,j) = 0.0d0 ! acab and bmlt not applied to ice-free ocean cells + else ! non-CF ice-covered cells and/or land cells + effective_areafrac(i,j) = 1.0d0 + endif + enddo + enddo - ! For the inversion run, compute bmlt_float_inversion, and compute dthck_dt - ! for use in the later computation of powerlaw_c_inversion. - ! Note: powerlaw_c_inversion is computed in the velocity solver. - ! If bmlt_float is prescribed from a previous inversion, it does not need - ! to be recomputed here. + !------------------------------------------------------------------------- + ! Adjust the surface mass balance (acab) as needed. + !------------------------------------------------------------------------- - if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then + ! Compute a corrected acab field that includes any prescribed anomalies. + ! Typically, acab_corrected = acab, but sometimes (e.g., for initMIP) it includes a time-dependent anomaly. + ! Note that acab itself does not change in time. - ! thickness tendency dH/dt from one step to the next (m/s) - ! This tendency is used when inverting for basal traction parameters. - ! It is recomputed at the end of the time step for diagnostic output. - - model%geometry%dthck_dt(:,:) = (thck_unscaled(:,:) - model%geometry%thck_old(:,:)*thk0) & - / (model%numerics%dt * tim0) - - ! Invert for bmlt_float_inversion, adjusting the melt rate to relax toward the observed thickness. - ! As the inversion converges, the difference (thck - thck_obs) should approach zero. - ! Note: basal_melt%bmlt_float_inversion is passed out with units of m/s - - call invert_bmlt_float(model%numerics%dt * tim0, & ! s - model%general%ewn, model%general%nsn, & - itest, jtest, rtest, & - model%basal_melt, & - thck_unscaled, & ! m - model%geometry%thck_obs*thk0, & ! m - thck_flotation, & ! m - ice_mask, & - floating_mask, & - ocean_mask, & - land_mask) +!! print*, 'maxval(acab_anomaly):', maxval(model%climate%acab_anomaly) +!! print*, 'minval(acab_anomaly):', minval(model%climate%acab_anomaly) - !WHL - debug - if (verbose_inversion .and. this_rank == rtest) then - i = itest - j = jtest - print*, ' ' - print*, 'Inverting for bmlt_float: rank, i, j =', rtest, i, j - print*, 'thck (m), thck_obs (m), bmlt_float_inversion (m/yr):', thck_unscaled(i,j), & - model%geometry%thck_obs(i,j)*thk0, model%basal_melt%bmlt_float_inversion(i,j)*scyr - print*, ' ' - endif + ! initialize + model%climate%acab_corrected(:,:) = model%climate%acab(:,:) + + ! Optionally, multiply acab by a scalar adjustment factor + if (model%climate%acab_factor /= 1.0d0) then + model%climate%acab_corrected(:,:) = model%climate%acab_corrected(:,:) * model%climate%acab_factor + endif + + if (model%options%enable_acab_anomaly) then - endif ! which_ho_inversion + ! Note: When being ramped up, the anomaly is not incremented until after the final time step of the year. + ! This is the reason for passing the previous time to the subroutine. + previous_time = model%numerics%time - model%numerics%dt * tim0/scyr + + call glissade_add_mbal_anomaly(model%climate%acab_corrected, & ! scaled model units + model%climate%acab_anomaly, & ! scaled model units + model%climate%acab_anomaly_timescale, & ! yr + previous_time) + + !WHL - debug +!! if (this_rank==rtest) then +!! i = model%numerics%idiag +!! j = model%numerics%jdiag +!! print*, 'i, j, total anomaly (m/yr), previous_time, new acab (m/yr):', & +!! i, j, model%climate%acab_anomaly(i,j)*thk0*scyr/tim0, previous_time, model%climate%acab_corrected(i,j) +!! endif + + endif + + ! Optionally, overwrite acab_corrected where overwrite_acab_mask = 1. + + if (model%options%overwrite_acab /= 0) then + + call glissade_overwrite_acab(model%climate%overwrite_acab_mask, & + model%climate%overwrite_acab_value, & + model%climate%acab_corrected) + endif + + !------------------------------------------------------------------------- + ! Handle the basal mass balance. + !------------------------------------------------------------------------- + + ! Add bmlt to the continuity equation in SI units (m/s) + ! Note: bmlt is the sum of bmlt_ground (computed in glissade_thermal_solve) and bmlt_float + ! (computed in glissade_bmlt_float_solve). + + if (model%options%basal_mbal == BASAL_MBAL_CONTINUITY) then ! include bmlt in continuity equation + bmlt_unscaled(:,:) = model%basal_melt%bmlt(:,:) * thk0/tim0 + else ! do not include bmlt in continuity equation + bmlt_unscaled(:,:) = 0.0d0 + endif + + ! ------------------------------------------------------------------------ + ! If inverting for bmlt beneath floating ice, then compute bmlt_float_inversion here. + ! ------------------------------------------------------------------------ + + ! Note: Other kinds of basal melting are handled in subroutine glissade_bmlt_float_solve. + ! Inversion is done here, after transport, when there is an updated ice thickness. + ! Then bmlt_float_inversion is added to the previously computed bmlt. + ! Note: Usually, whichbmlt_float = 0 when doing inversion. + ! However, for the HO_INVERSION_PRESCRIBED option, we may want to add a basal melting anomaly + ! as for the initMIP anomaly experiments. In that case the anomaly is already part of bmlt_float. + ! Note: If the basal melt GLP is turned on, it sets bmlt_float = 0 in partly floating cells. + ! However, it does not limit bmlt_float_inversion, which is applied to all floating cells, + ! including partly floating cells (in order to match observed thicknesses at the grounding line). + + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then + + ! Invert for bmlt_float_inversion, adjusting the melt rate to relax toward the observed thickness. + ! Note: basal_melt%bmlt_float_inversion is passed out with units of m/s + + call invert_bmlt_float(model%numerics%dt * tim0, & ! s + model%general%ewn, model%general%nsn, & + itest, jtest, rtest, & + model%basal_melt, & + thck_unscaled, & ! m + model%geometry%thck_obs*thk0, & ! m + model%geometry%topg*thk0, & ! m + model%climate%acab_corrected*thk0/tim0, & ! m/s + model%basal_melt%bmlt*thk0/tim0, & ! m/s + ice_mask, & + floating_mask, & + land_mask) !WHL - debug if (verbose_inversion .and. this_rank == rtest) then i = itest j = jtest print*, ' ' - print*, 'floating_mask:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(i10)',advance='no') floating_mask(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'thck (m):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck_unscaled(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'thck - thck_obs (m):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck_unscaled(i,j) - model%geometry%thck_obs(i,j)*thk0 - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'thck_flotation (m):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck_flotation(i,j) - enddo - write(6,*) ' ' - enddo + print*, 'Inverting for bmlt_float: rank, i, j =', rtest, i, j + print*, 'thck (m), thck_obs (m), bmlt_float_inversion (m/yr):', thck_unscaled(i,j), & + model%geometry%thck_obs(i,j)*thk0, model%basal_melt%bmlt_float_inversion(i,j)*scyr print*, ' ' - print*, 'bmlt_float_inversion (m/yr):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') model%basal_melt%bmlt_float_inversion(i,j)*scyr - enddo - write(6,*) ' ' - enddo endif - ! Zero out acab since this call uses bmlt_float_inversion only - acab_unscaled(:,:) = 0.0d0 - - ! Apply basal melting for inversion. - ! Note: Basal melting applied during this call is added to bmlt_applied. - call glissade_mass_balance_driver(model%numerics%dt * tim0, & - model%numerics%dew * len0, model%numerics%dns * len0, & - model%general%ewn, model%general%nsn, & - model%general%upn-1, model%numerics%sigma, & - thck_unscaled(:,:), & ! m - acab_unscaled(:,:), & ! m/s - model%basal_melt%bmlt_float_inversion(:,:), & ! m/s - model%climate%acab_applied(:,:), & ! m/s - model%basal_melt%bmlt_applied(:,:), & ! m/s - ocean_mask(:,:), & - effective_areafrac(:,:), & - model%geometry%ntracers, & - model%geometry%tracers(:,:,:,:), & - model%geometry%tracers_usrf(:,:,:), & - model%geometry%tracers_lsrf(:,:,:), & - model%options%which_ho_vertical_remap) + elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then + + ! Prescribe bmlt_float from a previous inversion. + ! Although bmlt_float is prescribed, it may need to be limited or ignored, + ! for example to avoid melting beneath grounded ice. + + call prescribe_bmlt_float(model%numerics%dt * tim0, & ! s + model%general%ewn, model%general%nsn, & + itest, jtest, rtest, & + model%basal_melt, & + thck_unscaled, & ! m + model%geometry%topg*thk0, & ! m + ice_mask, & + floating_mask, & + land_mask) !WHL - debug if (verbose_inversion .and. this_rank == rtest) then i = itest j = jtest print*, ' ' - print*, 'After inversion and BMB:' - print*, ' ' - print*, 'thck (m):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck_unscaled(i,j) - enddo - write(6,*) ' ' - enddo + print*, 'Prescribe bmlt_float: rank, i, j =', rtest, i, j + print*, 'thck (m), bmlt_float_prescribed, bmlt_float_inversion (m/yr):', thck_unscaled(i,j), & + model%basal_melt%bmlt_float_prescribed(i,j)*scyr, & + model%basal_melt%bmlt_float_inversion(i,j)*scyr print*, ' ' - print*, 'thck - thck_obs (m):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck_unscaled(i,j) - model%geometry%thck_obs(i,j)*thk0 - enddo - write(6,*) ' ' - enddo endif - ! Note: Subroutine invert_basal_traction, which inverts for basal parameters, - ! is called later, during the velocity solve. - ! It requires the same ice mask and floating mask as the velocity solver. + endif ! which_ho_inversion - endif ! which_ho_inversion + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & + model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then + + ! Add bmlt_float_inversion to bmlt_unscaled, the melt rate passed to the mass balance driver. + ! Both fields have units of m/s. + + ! Note: The bmlt array passed to glissade_mass_balance_driver is assumed to apply + ! only to the ice-covered fraction of the cell, as measured by effective_areafrac. + ! For example, if bmlt = 1 m/yr and effective_areafrac = 0.5, the melt rate + ! is applied to only 50% of the ice. The effective melt rate is thus 0.5 m/yr. + ! However, bmlt_float_inversion is assumed to apply to the full cell area. + ! For example, if the mean ice thickness (i.e., thck) is 100 m and the target + ! thickness is 50 m, then we would have bmlt_float_inversion = (100 - 50)/dt. + ! Suppose effective_areafrac = 0.5. Then we should divide bmlt_float_inversion by 0.5 + ! when adding it to bmlt, because bmlt will be applied to only half the cell + ! in glissade_mass_balance_driver. + + where (effective_areafrac > 0.0d0) + bmlt_unscaled = bmlt_unscaled + model%basal_melt%bmlt_float_inversion/effective_areafrac + endwhere + + endif + + ! Convert acab_corrected to a temporary in/out array in SI units (m/s) + acab_unscaled(:,:) = model%climate%acab_corrected(:,:) * thk0/tim0 + + ! Initialize the applied acab and bmlt. + ! Note: These are smaller in magnitude than the input acab and bmlt for cells where either + ! (1) the full column melts, and energy remains for melting, or + ! (2) a positive mass balance is ignored, because a cell is ice-free ocean + + model%climate%acab_applied = 0.0d0 + model%basal_melt%bmlt_applied = 0.0d0 + + ! ------------------------------------------------------------------------ + ! Apply the surface mass balance (acab) and basal mass balance (bmlt). + ! Note: This subroutine assumes SI units: + ! * dt (s) + ! * dew, dns, thck (m) + ! * acab, bmlt (m/s) + ! ------------------------------------------------------------------------ + + call glissade_mass_balance_driver(model%numerics%dt * tim0, & + model%numerics%dew * len0, model%numerics%dns * len0, & + model%general%ewn, model%general%nsn, & + model%general%upn-1, model%numerics%sigma, & + thck_unscaled(:,:), & ! m + acab_unscaled(:,:), & ! m/s + bmlt_unscaled(:,:), & ! m/s + model%climate%acab_applied(:,:), & ! m/s + model%basal_melt%bmlt_applied(:,:), & ! m/s + ocean_mask(:,:), & + effective_areafrac(:,:), & + model%geometry%ntracers, & + model%geometry%tracers(:,:,:,:), & + model%geometry%tracers_usrf(:,:,:), & + model%geometry%tracers_lsrf(:,:,:), & + model%options%which_ho_vertical_remap) + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest +! print*, ' ' +! print*, 'bmlt to mass balance driver (m/yr, per unit ice area):' +! do j = jtest+3, jtest-3, -1 +! do i = itest-3, itest+3 +! write(6,'(f10.3)',advance='no') bmlt_unscaled(i,j)*scyr +! enddo +! write(6,*) ' ' +! enddo +! print*, ' ' +! print*, 'effective_areafrac:' +! do j = jtest+3, jtest-3, -1 +! do i = itest-3, itest+3 +! write(6,'(f10.3)',advance='no') effective_areafrac(i,j) +! enddo +! write(6,*) ' ' +! enddo + print*, ' ' + print*, 'New thck (m) after acab and bmlt:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck_unscaled(i,j) + enddo + write(6,*) ' ' + enddo + endif + + !------------------------------------------------------------------------- + ! Cleanup + !------------------------------------------------------------------------- ! copy tracers (temp/enthalpy, etc.) from model%geometry%tracers back to standard arrays call glissade_transport_finish_tracers(model) @@ -1658,20 +1655,88 @@ subroutine glissade_transport_solve(model) endif ! TEMP_ENTHALPY + + !------------------------------------------------------------------------- + ! Determine the basal traction field, powerlaw_c_inversion, if desired. + ! Note: If powerlaw_c is prescribed from a previous inversion, it may need to be adjusted + ! in cells that were floating during the inversion but are now grounded, or vice versa. + !------------------------------------------------------------------------- + + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & + model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then + + ! ------------------------------------------------------------------------ + ! Recompute ice_mask and floating_mask before the inversion calculation. + ! Pass thklim = 0 to identify cells with thck > 0 (not thck > thklim). + ! ------------------------------------------------------------------------ + + call glissade_get_masks(model%general%ewn, model%general%nsn, & + thck_unscaled, & ! m + model%geometry%topg*thk0, & ! m + model%climate%eus*thk0, & ! m + 0.0d0, & ! thklim = 0 + ice_mask, & + floating_mask = floating_mask) + + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then + + ! Compute the thickness tendency dH/dt from one step to the next (m/s). + ! This tendency is used when inverting for powerlaw_c_inversion. + ! Note: We set dthck_dt = 0 for inactive cells (thck <= thklim at the start of the time step). + ! This helps prevent the following cycle: + ! - While Cp is increasing, a cell thins to H < thklim and becomes inactive. + ! - Once inactive, the cell thickens (reducing Cp) and becomes active. + ! - Once active again, the cell resumes thinning, reducing Cp. And so on. + ! Note: dthck_dt is recomputed at the end of the time step for diagnostic output. + + where (model%geometry%thck_old > model%numerics%thklim) + model%geometry%dthck_dt = (model%geometry%thck - model%geometry%thck_old) * thk0 & + / (model%numerics%dt * tim0) + elsewhere + model%geometry%dthck_dt = 0.0d0 + endwhere + + ! Invert for the basal traction parameter, powerlaw_c_inversion. + ! Note: For inversion purposes, ice_mask = 1 where thck > 0.0 (not where thck > thklim). + + call invert_basal_traction(model%numerics%dt*tim0, & ! s + model%general%ewn, model%general%nsn, & + itest, jtest, rtest, & + model%basal_physics, & + ice_mask, & + floating_mask, & + land_mask, & + model%geometry%thck*thk0, & ! m + model%geometry%dthck_dt, & ! m/s + model%geometry%thck_obs*thk0) ! m + + elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then + + call prescribe_basal_traction(model%general%ewn, model%general%nsn, & + itest, jtest, rtest, & + model%basal_physics, & + ice_mask, & + floating_mask, & + land_mask) + + endif ! which_ho_inversion (compute or prescribed) + + endif ! which_ho_inversion + if (this_rank==rtest .and. verbose_glissade) then print*, ' ' print*, 'After glissade_transport_driver:' print*, 'max, min thck (m)=', maxval(model%geometry%thck)*thk0, minval(model%geometry%thck)*thk0 print*, 'max, min acab (m/yr) =', & - maxval(model%climate%acab_corrected)*scale_acab, & - minval(model%climate%acab_corrected)*scale_acab + maxval(model%climate%acab_corrected)*scale_acab, & + minval(model%climate%acab_corrected)*scale_acab print*, 'max, min artm =', maxval(model%climate%artm), minval(model%climate%artm) print*, 'thklim =', model%numerics%thklim * thk0 print*, 'max, min temp =', maxval(model%temper%temp), minval(model%temper%temp) print*, ' ' print*, 'thck:' write(6,'(a6)',advance='no') ' ' -!! do i = 1, model%general%ewn +!! do i = 1, model%general%ewn do i = itest-5, itest+5 write(6,'(i14)',advance='no') i enddo @@ -1698,7 +1763,7 @@ subroutine glissade_transport_solve(model) do j = jtest+2, jtest-2, -1 write(6,'(i6)',advance='no') j !! do i = 1, model%general%ewn - do i = itest-5, itest+5 + do i = itest-5, itest+5 write(6,'(f14.7)',advance='no') model%temper%temp(k,i,j) enddo write(6,*) ' ' @@ -1713,7 +1778,7 @@ subroutine glissade_transport_solve(model) ! restore old thickness model%geometry%thck(:,:) = model%geometry%thck_old(:,:) endif - + end select !------------------------------------------------------------------------ @@ -1721,7 +1786,7 @@ subroutine glissade_transport_solve(model) ! Note that glide_calclsrf loops over all cells, including halos, ! so halo updates are not needed for lsrf and usrf. !TODO - Not sure this update is needed here. It is done at the start - ! of the diagnostic solve, but may not be needed for calving and isostasy. + ! of the diagnostic solve, but may not be needed for calving. !------------------------------------------------------------------------ call glide_calclsrf(model%geometry%thck, model%geometry%topg, & @@ -1801,7 +1866,7 @@ subroutine glissade_calving_solve(model) !TODO: Are any other halo updates needed after calving? ! halo updates - call parallel_halo(model%geometry%thck) ! Updated halo values of thck are needed below in calc_lsrf + call parallel_halo(model%geometry%thck) ! Updated halo values of thck are needed below in calclsrf ! Eliminate ice from cells where a no-advance mask prohibits it. ! Add this ice to the calving field for mass conservation diagnostics. @@ -1817,6 +1882,12 @@ subroutine glissade_calving_solve(model) enddo enddo + ! update the upper and lower surfaces + + call glide_calclsrf(model%geometry%thck, model%geometry%topg, & + model%climate%eus, model%geometry%lsrf) + model%geometry%usrf(:,:) = max(0.d0, model%geometry%thck(:,:) + model%geometry%lsrf(:,:)) + end subroutine glissade_calving_solve !======================================================================= @@ -1945,6 +2016,10 @@ subroutine glissade_diagnostic_variable_solve(model) a, b, c, root, & ! terms in quadratic formula lambda1, lambda2 ! eigenvalues of horizontal strain rate tensor + !WHL - debug + real(dp) :: my_max_diff, global_max_diff + integer :: iglobal, jglobal, ii, jj + rtest = -999 itest = 1 jtest = 1 @@ -2580,6 +2655,46 @@ subroutine glissade_diagnostic_variable_solve(model) model%geometry%basal_mbal_flux(:,:) = rhoi * (-model%basal_melt%bmlt_applied(:,:)) * thk0/tim0 model%geometry%calving_flux(:,:) = rhoi * (-model%calving%calving_thck(:,:)*thk0) / (model%numerics%dt*tim0) + !WHL - temporary debug - compute max diff in bmlt_applied + + if (model%numerics%tstep_count > 0) then + model%basal_melt%bmlt_applied_diff(:,:) = & + abs(model%basal_melt%bmlt_applied(:,:) - model%basal_melt%bmlt_applied_old(:,:)) + + my_max_diff = maxval(model%basal_melt%bmlt_applied_diff) + global_max_diff = parallel_reduce_max(my_max_diff) + + if (abs((my_max_diff - global_max_diff)/global_max_diff) < 1.0d-6) then + do j = nhalo+1, model%general%nsn-nhalo + do i = nhalo+1, model%general%ewn-nhalo + if (abs((model%basal_melt%bmlt_applied_diff(i,j) - global_max_diff)/global_max_diff) < 1.0d-6) then + ii = i; jj = j + print*, ' ' + print*, 'task, i, j, global_max_diff (m/yr):', this_rank, i, j, global_max_diff * scyr*thk0/tim0 + print*, 'bmlt_float_inversion:', model%basal_melt%bmlt_float_inversion(i,j) * scyr + print*, 'bmlt_applied old, new:', model%basal_melt%bmlt_applied_old(i,j) * scyr*thk0/tim0, & + model%basal_melt%bmlt_applied(i,j) * scyr*thk0/tim0 + call parallel_globalindex(i, j, iglobal, jglobal) + print*, 'global i, j =', iglobal, jglobal + + print*, ' ' + print*, 'bmlt_applied:' + do jj = j-3, j+3 + write(6,'(i8)',advance='no') jj + do ii = i-3, i+3 + write(6,'(f10.3)',advance='no') model%basal_melt%bmlt_applied(ii,jj) * scyr*thk0/tim0 + enddo + print*, ' ' + enddo + + endif + enddo + enddo + endif + + model%basal_melt%bmlt_applied_old(:,:) = model%basal_melt%bmlt_applied(:,:) + endif + ! real-valued masks ! unstaggered grid @@ -2591,6 +2706,17 @@ subroutine glissade_diagnostic_variable_solve(model) model%geometry%floating_mask(i,j) = 1.0d0 model%geometry%grounded_mask(i,j) = 0.0d0 else + + !WHL - debug - Identify cells where grounded_mask flips between time steps. + if (model%geometry%grounded_mask(i,j) == 0) then ! grounded at previous step + if (i == itest .and. j == jtest .and. this_rank == rtest) then + print*, 'grounded_mask flipped from 0 to 1:, rank, i, j, ice_mask, thck =', & + this_rank, i, j, ice_mask(i,j), model%geometry%thck(i,j)*thk0 + call parallel_globalindex(i, j, iglobal, jglobal) + print*, 'iglobal, jglobal =', iglobal, jglobal + endif + endif + model%geometry%grounded_mask(i,j) = 1.0d0 model%geometry%floating_mask(i,j) = 0.0d0 endif diff --git a/libglissade/glissade_basal_traction.F90 b/libglissade/glissade_basal_traction.F90 index 0b50bb99..8eaf7c30 100644 --- a/libglissade/glissade_basal_traction.F90 +++ b/libglissade/glissade_basal_traction.F90 @@ -186,6 +186,20 @@ subroutine calcbeta (whichbabc, & which_inversion = HO_INVERSION_NONE endif + ! Compute the ice speed: used in power laws where beta = beta(u). + ! Enforce a minimum speed to prevent beta from become very large when velocity is small. + speed(:,:) = dsqrt(thisvel(:,:)**2 + othervel(:,:)**2 + smallnum**2) + + ! If beta_powerlaw_umax is set to a nonzero value, then limit the speed to this value. + ! Note: The actual ice speed can be greater than umax. This is just a way of shutting off the feedback + ! between beta and ice speed (beta down as speed up) when the ice speed is large. + ! It helps make the model more stable. + if (basal_physics%beta_powerlaw_umax > 0.0d0) then + speed(:,:) = min(speed(:,:), basal_physics%beta_powerlaw_umax) + endif + + ! Compute beta based on whichbabc + select case(whichbabc) case(HO_BABC_BETA_CONSTANT) ! spatially uniform beta value; useful for debugging and test cases @@ -240,7 +254,6 @@ subroutine calcbeta (whichbabc, & ! compute beta based on tan(phi), N and u tau_c = tanphi * basal_physics%effecpress_stag(ew,ns) - speed(ew,ns) = sqrt(thisvel(ew,ns)**2 + othervel(ew,ns)**2 + smallnum**2) beta(ew,ns) = tau_c / (u0**q * speed(ew,ns)**(1.0d0 - q)) !WHL - debug @@ -353,7 +366,6 @@ subroutine calcbeta (whichbabc, & ! implying beta = C * ub^(1/m - 1) ! m should be a positive exponent - speed(:,:) = dsqrt(thisvel(:,:)**2 + othervel(:,:)**2 + smallnum**2) beta(:,:) = basal_physics%powerlaw_c * speed(:,:)**(1.0d0/basal_physics%powerlaw_m - 1.0d0) case(HO_BABC_POWERLAW_EFFECPRESS) ! a power law that uses effective pressure @@ -371,7 +383,6 @@ subroutine calcbeta (whichbabc, & powerlaw_p = 3.0d0 powerlaw_q = 1.0d0 - speed(:,:) = dsqrt(thisvel(:,:)**2 + othervel(:,:)**2 + smallnum**2) beta(:,:) = basal_physics%friction_powerlaw_k**(-1.0d0/powerlaw_p) & * basal_physics%effecpress_stag(:,:)**(powerlaw_q/powerlaw_p) & * speed(:,:)**(1.0d0/powerlaw_p - 1.0d0) @@ -408,7 +419,6 @@ subroutine calcbeta (whichbabc, & ! Compute beta ! gn = Glen's n from physcon module - speed(:,:) = dsqrt(thisvel(:,:)**2 + othervel(:,:)**2 + smallnum**2) beta(:,:) = coulomb_c * basal_physics%C_space_factor_stag(:,:) * & basal_physics%effecpress_stag(:,:) * speed(:,:)**(1.0d0/gn - 1.0d0) * & (speed(:,:) + basal_physics%effecpress_stag(:,:)**gn * big_lambda)**(-1.0d0/gn) @@ -452,12 +462,9 @@ subroutine calcbeta (whichbabc, & do ns = 1, nsn-1 do ew = 1, ewn-1 - speed(ew,ns) = dsqrt(thisvel(ew,ns)**2 + othervel(ew,ns)**2 + smallnum**2) - numerator = powerlaw_c * coulomb_c * basal_physics%effecpress_stag(ew,ns) denominator = ( powerlaw_c**m * speed(ew,ns) + & (coulomb_c * basal_physics%effecpress_stag(ew,ns))**m )**(1.d0/m) - beta(ew,ns) = (numerator/denominator) * speed(ew,ns)**(1.d0/m - 1.d0) enddo @@ -502,8 +509,6 @@ subroutine calcbeta (whichbabc, & do ns = 1, nsn-1 do ew = 1, ewn-1 - speed(ew,ns) = dsqrt(thisvel(ew,ns)**2 + othervel(ew,ns)**2 + smallnum**2) - numerator = stag_powerlaw_c_inversion(ew,ns) * stag_coulomb_c_inversion(ew,ns) & * basal_physics%effecpress_stag(ew,ns) denominator = ( stag_powerlaw_c_inversion(ew,ns)**m * speed(ew,ns) + & @@ -564,8 +569,6 @@ subroutine calcbeta (whichbabc, & do ns = 1, nsn-1 do ew = 1, ewn-1 - speed(ew,ns) = dsqrt(thisvel(ew,ns)**2 + othervel(ew,ns)**2 + smallnum**2) - taub_powerlaw = basal_physics%powerlaw_c * speed(ew,ns)**(1.d0/basal_physics%powerlaw_m) taub_coulomb = basal_physics%coulomb_c * basal_physics%effecpress_stag(ew,ns) diff --git a/libglissade/glissade_calving.F90 b/libglissade/glissade_calving.F90 index 6a00dd2f..3929db67 100644 --- a/libglissade/glissade_calving.F90 +++ b/libglissade/glissade_calving.F90 @@ -1836,16 +1836,35 @@ subroutine glissade_remove_icebergs(& ! Icebergs are cells that still have the initial color and are not on land. ! Remove ice in these cells, adding it to the calving field. ! Note: Inactive land-based cells are not considered to be icebergs. - do j = 1, ny - do i = 1, nx + ! Note: Another exception is that we do not remove cells that are + ! (1) adjacent to at least one floating cell (sharing an edge), and + ! (2) connected diagonally to active cells with the fill color. + ! Such cells are considered part of the inactive calving front and are + ! allowed to continue filling instead of calving. + + + do j = 2, ny-1 + do i = 2, nx-1 if (color(i,j) == initial_color .and. land_mask(i,j) == 0) then - !WHL - debug - if (verbose_calving .and. thck(i,j) > 0.0 .and. this_rank == rtest) then -!! print*, 'Remove iceberg: task, i, j, thck =', this_rank, i, j, thck(i,j)*thk0 + if ( ( color(i-1,j+1)==fill_color .and. active_ice_mask(i-1,j+1)==1 .and. & + (floating_mask(i-1,j)==1 .or. floating_mask(i,j+1)==1) ) & + .or. ( color(i+1,j+1)==fill_color .and. active_ice_mask(i+1,j+1)==1 .and. & + (floating_mask(i+1,j)==1 .or. floating_mask(i,j+1)==1) ) & + .or. ( color(i-1,j-1)==fill_color .and. active_ice_mask(i-1,j-1)==1 .and. & + (floating_mask(i-1,j)==1 .or. floating_mask(i,j-1)==1) ) & + .or. ( color(i+1,j-1)==fill_color .and. active_ice_mask(i+1,j-1)==1 .and. & + (floating_mask(i+1,j)==1 .or. floating_mask(i,j-1)==1) ) ) then + ! do nothing; this cell is part of the inactive calving front + else ! not part of the inactive calving front; calve as an iceberg + !WHL - debug +!! if (verbose_calving .and. thck(i,j) > 0.0 .and. this_rank == rtest) then +!! print*, 'Remove iceberg: task, i, j, thck =', this_rank, i, j, thck(i,j)*thk0 +!! endif + calving_thck(i,j) = calving_thck(i,j) + thck(i,j) + thck(i,j) = 0.0d0 + !TODO - Also handle tracers? E.g., set damage(:,i,j) = 0.d0? endif - calving_thck(i,j) = calving_thck(i,j) + thck(i,j) - thck(i,j) = 0.0d0 - !TODO - Also handle tracers? E.g., set damage(:,i,j) = 0.d0? + endif enddo enddo @@ -2072,7 +2091,7 @@ subroutine glissade_find_lakes(nx, ny, & print*, 'color, rank =', this_rank do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j - do i = nx-10, nx + do i = itest-3, itest+3 write(6,'(i10)',advance='no') color(i,j) enddo write(6,*) ' ' @@ -2081,7 +2100,7 @@ subroutine glissade_find_lakes(nx, ny, & print*, 'floating_mask, rank =', this_rank do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j - do i = nx-10, nx + do i = itest-3, itest+3 write(6,'(i10)',advance='no') floating_mask(i,j) enddo write(6,*) ' ' @@ -2090,7 +2109,7 @@ subroutine glissade_find_lakes(nx, ny, & print*, 'lake_mask, rank =', this_rank do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j - do i = nx-10, nx + do i = itest-3, itest+3 write(6,'(i10)',advance='no') lake_mask(i,j) enddo write(6,*) ' ' diff --git a/libglissade/glissade_inversion.F90 b/libglissade/glissade_inversion.F90 index 5ea6cb4a..626e2a19 100644 --- a/libglissade/glissade_inversion.F90 +++ b/libglissade/glissade_inversion.F90 @@ -43,6 +43,14 @@ module glissade_inversion !! logical, parameter :: verbose_inversion = .false. logical, parameter :: verbose_inversion = .true. + !TODO - Make these config parameters? + real(dp), parameter :: & + powerlaw_c_land = 20000.d0, & + powerlaw_c_marine = 1000.d0 + + real(dp), parameter :: & + bmlt_inversion_thck_over_flot = 1.0d0 ! Ice restored from floating to grounded is this much thicker than thck_flotation (m) + !*********************************************************************** contains @@ -53,14 +61,39 @@ subroutine glissade_init_inversion(model) ! Initialize inversion for fields of basal traction and basal melting + use glissade_masks, only: glissade_get_masks + use parallel + type(glide_global_type), intent(inout) :: model ! model instance ! local variables - real(dp) :: var_maxval ! max value of a given variable; = 0 if not yet read in + integer :: i, j + + integer :: itest, jtest, rtest ! local diagnostic point + + real(dp) :: var_maxval ! max value of a given real variable; = 0.0 if not yet read in + integer :: var_maxval_int ! max value of a given integer variable; = 0 if not yet read in character(len=100) :: message + integer, dimension(model%general%ewn, model%general%nsn) :: & + ice_mask, & ! = 1 where ice is present, else = 0 + floating_mask, & ! = 1 where ice is present and floating, else = 0 + ocean_mask, & ! = 1 where ice is absent and topg < eus, else = 0 + land_mask ! = 1 where topg >= eus, else = 0 + + ! Set local diagnostic point + rtest = -999 + itest = 1 + jtest = 1 + if (this_rank == model%numerics%rdiag_local) then + rtest = model%numerics%rdiag_local + itest = model%numerics%idiag_local + jtest = model%numerics%jdiag_local + endif + + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then ! Save the initial ice thickness, if it will be used as the observational target for inversion. @@ -86,7 +119,8 @@ subroutine glissade_init_inversion(model) if (var_maxval > 0.0d0) then ! do nothing; powerlaw_c_inversion has been read in already (e.g., after restart) else - model%basal_physics%powerlaw_c_inversion(:,:) = model%basal_physics%powerlaw_c + ! setting to a large value so that basal flow starts slow and gradually speeds up as needed + model%basal_physics%powerlaw_c_inversion(:,:) = model%basal_physics%powerlaw_c_max endif call parallel_halo(model%basal_physics%powerlaw_c_inversion) @@ -139,10 +173,6 @@ subroutine glissade_init_inversion(model) ! Note: powerlaw_c_inversion is adjusted at runtime where either ! (1) Ice is grounded in the forward run but powerlaw_c was not computed in the inversion run, or ! (2) Ice is floating in the forward run - ! Note: Currently, bmlt_float_inversion is not adjusted at runtime. - ! If an interior lake were to form at runtime in a region that was an ice shelf during inversion, - ! we might have nonzero bmlt_float_prescribed where we want bmlt_float_inversion = 0. - ! Ignore that possibility for now. var_maxval = maxval(abs(model%basal_physics%powerlaw_c_inversion)) var_maxval = parallel_reduce_max(var_maxval) @@ -172,20 +202,22 @@ end subroutine glissade_init_inversion !*********************************************************************** - subroutine invert_basal_traction(dt, & - nx, ny, & - itest, jtest, rtest, & - basal_physics, & - ice_mask, floating_mask, & - thck, dthck_dt, & + subroutine invert_basal_traction(dt, & + nx, ny, & + itest, jtest, rtest, & + basal_physics, & + ice_mask, & + floating_mask, & + land_mask, & + thck, & + dthck_dt, & thck_obs) - ! Compute spatially varying fields, powerlaw_c_inversion and coulomb_c_inversion, by inversion. + ! Compute a spatially varying basal traction field, powerlaw_c_inversion. ! The method is similar to that of Pollard & DeConto (TC, 2012), and is applied to all grounded ice. - ! Where thck > thck_obs, powerlaw_c and coulomb_c are reduced to increase sliding. - ! Where thck < thck_obs, powerlaw_c and coulomb_c are increased to reduce sliding. + ! Where thck > thck_obs, powerlaw_c is reduced to increase sliding. + ! Where thck < thck_obs, powerlaw_c is increased to reduce sliding. ! Note: powerlaw_c is constrained to lie within a prescribed range. - ! The ratio of powerlaw_c to coulomb_c is fixed (except that coulomb_c must be <= 1). real(dp), intent(in) :: dt ! time step (s) @@ -199,8 +231,9 @@ subroutine invert_basal_traction(dt, & basal_physics ! basal physics object integer, dimension(nx,ny), intent(in) :: & - ice_mask, & ! = 1 where ice is present (thk > thklim), else = 0 - floating_mask ! = 1 where ice is present and floating, else = 0 + ice_mask, & ! = 1 where ice is present (thk > 0), else = 0 + floating_mask, & ! = 1 where ice is present and floating, else = 0 + land_mask ! = 1 if topg > eus, else = 0 real(dp), dimension(nx,ny), intent(in) :: & thck, & ! ice thickness (m) @@ -226,7 +259,6 @@ subroutine invert_basal_traction(dt, & ! inversion parameters in basal_physics derived type: ! * powerlaw_c_max = upper bound for powerlaw_c, Pa (m/yr)^(-1/3) ! * powerlaw_c_min = lower bound for powerlaw_c, Pa (m/yr)^(-1/3) - ! * powerlaw_coulomb_ratio = powerlaw_c/coulomb_c (same units as powerlaw_c) ! * inversion_babc_timescale = inversion timescale (s); must be > 0 ! * inversion_babc_thck_scale = thickness inversion scale (m); must be > 0 ! * inversion_babc_dthck_dt_scale = dthck_dt inversion scale (m/s); must be > 0 @@ -247,26 +279,14 @@ subroutine invert_basal_traction(dt, & do i = 2, nx-1 if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! grounded ice if (basal_physics%powerlaw_c_inversion(i,j) == 0.0d0) then - - ! initialize powerlaw_c by extrapolating from neighbor cells - count = 0 - sum_powerlaw_c = 0.0d0 - do jj = j-1, j+1 - do ii = i-1, i+1 - if ( (ii == i .or. jj == j) .and. (ii /= i .or. jj /= j) ) then ! edge neighbors - if (basal_physics%powerlaw_c_inversion(ii,jj) > 0.0d0) then - count = count + 1 - sum_powerlaw_c = sum_powerlaw_c + basal_physics%powerlaw_c_inversion(ii,jj) - endif - endif - enddo - enddo - if (count > 0) then - basal_physics%powerlaw_c_inversion(i,j) = sum_powerlaw_c/count - else ! set to a sensible default - basal_physics%powerlaw_c_inversion(i,j) = basal_physics%powerlaw_c + ! set to a sensible default + ! If on land, set to a typical land value + ! If grounded marine ice, set to a smaller value + if (land_mask(i,j) == 1) then + basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_land + else + basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_marine endif - endif ! powerlaw_c_inversion = 0 endif ! grounded ice enddo ! i @@ -275,8 +295,8 @@ subroutine invert_basal_traction(dt, & call parallel_halo(basal_physics%powerlaw_c_inversion) ! Loop over cells - ! Note: powerlaw_c_inversion and coulomb_c_inversion are computed at cell centers where thck is located. - ! Later, they are interpolated to vertices where bdeta and basal velocity are located. + ! Note: powerlaw_c_inversion is computed at cell centers where thck is located. + ! Later, it is interpolated to vertices where beta and basal velocity are located. do j = 1, ny do i = 1, nx @@ -397,30 +417,15 @@ subroutine invert_basal_traction(dt, & endif endif ! dpowerlaw_c > 0 - ! The next 5 lines are commented out. If used in place of the limiting above, - ! this code not only prevents the sign of the change from reversing, but also - ! prevents the smoothing from more than doubling the original change. - ! It would take more testing to determine whether or not this is a good idea. - -! if (abs(dpowerlaw_c_smooth) > abs(dpowerlaw_c(i,j))) then -! factor = abs(dpowerlaw_c(i,j)) / abs(dpowerlaw_c_smooth) -! dpowerlaw_c_smooth = dpowerlaw_c_smooth * factor -! endif -! basal_physics%powerlaw_c_inversion(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth - endif ! cell is grounded - enddo enddo call parallel_halo(basal_physics%powerlaw_c_inversion) - ! Set coulomb_c assuming a fixed ratio of powerlaw_c/coulomb_c - basal_physics%coulomb_c_inversion(:,:) = basal_physics%powerlaw_c_inversion(:,:) & - / basal_physics%powerlaw_coulomb_ratio - - ! Limit coulomb_c to be <= 1, so that basal stress <= effective pressure N - basal_physics%coulomb_c_inversion(:,:) = min(basal_physics%coulomb_c_inversion(:,:), 1.0d0) + ! Set coulomb_c to a constant + !TODO - Switch from array to constant field in basal traction subroutine + basal_physics%coulomb_c_inversion(:,:) = basal_physics%coulomb_c if (verbose_inversion .and. this_rank == rtest) then i = itest @@ -454,13 +459,6 @@ subroutine invert_basal_traction(dt, & enddo write(6,*) ' ' enddo - print*, 'coulomb_c:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.4)',advance='no') basal_physics%coulomb_c_inversion(i,j) - enddo - write(6,*) ' ' - enddo endif end subroutine invert_basal_traction @@ -469,19 +467,17 @@ end subroutine invert_basal_traction subroutine prescribe_basal_traction(nx, ny, & itest, jtest, rtest, & + basal_physics, & ice_mask, & floating_mask, & - powerlaw_c_prescribed, & - powerlaw_c) + land_mask) ! Compute Cp = powerlaw_c when Cp is prescribed from a previous inversion run. ! - For cells where the ice is grounded and a prescribed Cp exists, ! we simply have Cp = Cp_prescribed. - ! - For cells where the ice is grounded and prescribed Cp = 0 (since the cell - ! was floating or ice-free in the inversion run), we set Cp by extrapolating - ! from neighboring cells, if possible. In principle, the extrapolation could - ! be extended indefinitely as the grounding line advances, but the extrapolation - ! would likely not be accurate over large distances. + ! - For cells where the ice is grounded and the prescribed Cp = 0 (since the cell + ! was floating or ice-free in the inversion run), we set Cp to a sensible default + ! based on whether the cell is land-based or marine-based. ! - For cells where the ice is floating (whether or not a prescribed Cp exists), ! we set Cp = 0. @@ -491,15 +487,13 @@ subroutine prescribe_basal_traction(nx, ny, & integer, intent(in) :: & itest, jtest, rtest ! coordinates of diagnostic point - integer, dimension(nx,ny), intent(in) :: & - ice_mask, & ! = 1 where ice is present, else = 0 - floating_mask ! = 1 where ice is present and floating, else = 0 - - real(dp), dimension(nx,ny), intent(in) :: & - powerlaw_c_prescribed ! powerlaw_c prescribed from previous inversion + type(glide_basal_physics), intent(inout) :: & + basal_physics ! basal physics object - real(dp), dimension(nx,ny), intent(inout) :: & - powerlaw_c ! powerlaw_c adjusted or extended as needed + integer, dimension(nx,ny), intent(in) :: & + ice_mask, & ! = 1 where ice is present (thck > 0), else = 0 + floating_mask, & ! = 1 where ice is present and floating, else = 0 + land_mask ! = 1 where topg >= eus, else = 0 ! local variables @@ -511,42 +505,31 @@ subroutine prescribe_basal_traction(nx, ny, & integer :: count ! counter real(dp) :: sum_powerlaw_c ! sum of powerlaw_c in neighbor cells - ! Zero out powerlaw_c where ice is not grounded + ! Zero out powerlaw_c where ice is not present (thck > 0) and grounded where (ice_mask == 0 .or. floating_mask == 1) - powerlaw_c = 0.0d0 + basal_physics%powerlaw_c_inversion = 0.0d0 endwhere - ! Compute new values of powerlaw_c in newly grounded cells - new_powerlaw_c(:,:) = 0.0d0 + ! Assign values of powerlaw_c in newly grounded cells do j = 2, ny-1 do i = 2, nx-1 if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! grounded ice - if (powerlaw_c(i,j) > 0.0d0) then + if (basal_physics%powerlaw_c_inversion(i,j) > 0.0d0) then - ! cell was already grounded; use the current value + ! nothing to do here; cell was already grounded - elseif (powerlaw_c_prescribed(i,j) > 0.0d0) then ! use the prescribed value + elseif (basal_physics%powerlaw_c_prescribed(i,j) > 0.0d0) then ! use the prescribed value - new_powerlaw_c(i,j) = powerlaw_c_prescribed(i,j) + basal_physics%powerlaw_c_inversion(i,j) = basal_physics%powerlaw_c_prescribed(i,j) - else ! extrapolate from neighbor cells + else ! assign a sensible default - count = 0 - sum_powerlaw_c = 0.0d0 - do jj = j-1, j+1 - do ii = i-1, i+1 - if ( (ii == i .or. jj == j) .and. (ii /= i .or. jj /= j) ) then ! edge neighbors - if (powerlaw_c(ii,jj) > 0.0d0) then - count = count + 1 - sum_powerlaw_c = sum_powerlaw_c + powerlaw_c(ii,jj) - endif - endif - enddo - enddo - if (count > 0) then - new_powerlaw_c(i,j) = sum_powerlaw_c/count + if (land_mask(i,j) == 1) then + basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_land + else + basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_marine endif endif ! powerlaw_c > 0 @@ -555,12 +538,7 @@ subroutine prescribe_basal_traction(nx, ny, & enddo ! i enddo ! j - ! Fill in new values - where (new_powerlaw_c > 0.0d0) - powerlaw_c = new_powerlaw_c - endwhere - - call parallel_halo(powerlaw_c) + call parallel_halo(basal_physics%powerlaw_c_inversion) if (verbose_inversion .and. this_rank == rtest) then i = itest @@ -577,15 +555,15 @@ subroutine prescribe_basal_traction(nx, ny, & print*, 'powerlaw_c_prescribed:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.2)',advance='no') powerlaw_c_prescribed(i,j) + write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_prescribed(i,j) enddo write(6,*) ' ' enddo print*, ' ' - print*, 'computed powerlaw_c:' + print*, 'current powerlaw_c:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.2)',advance='no') powerlaw_c(i,j) + write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_inversion(i,j) enddo write(6,*) ' ' enddo @@ -601,20 +579,19 @@ subroutine invert_bmlt_float(dt, & basal_melt, & thck, & thck_obs, & - thck_flotation, & + topg, & + acab, & + bmlt, & ice_mask, & floating_mask, & - ocean_mask, & land_mask) ! Compute spatially varying bmlt_float by inversion. - ! Where thck > thck_obs, bmlt_float_inversion is increased. - ! Where thck < thck_obs, bmlt_float_inversion is decreased. + ! Apply a melt/freezing rate that will restore the ice in floating grid cells to the target thickness. + ! Cells that are floating and should be grounded are thickened enough to be lightly grounded, + ! but generally not all the way to the target thickness. ! Note: bmlt_float_inversion is defined as positive for melting, negative for freezing. - !TODO - Move this subroutine? - use glissade_calving, only: glissade_find_lakes - real(dp), intent(in) :: dt ! time step (s) integer, intent(in) :: & @@ -629,127 +606,249 @@ subroutine invert_bmlt_float(dt, & real(dp), dimension(nx,ny), intent(in) :: & thck, & ! ice thickness (m) thck_obs, & ! observed thickness (m) - thck_flotation ! thickness at which ice becomes afloat + topg, & ! bedrock topography (m) + acab, & ! surface mass balance (m/s), including runtime adjustments + bmlt - ! Note: When this subroutine is called, ice_mask = 1 where thck > 0, not thck > thklim. + ! Note: When this subroutine is called, ice_mask = 1 where thck > 0, not thck > thklim. integer, dimension(nx,ny), intent(in) :: & ice_mask, & ! = 1 where ice is present, else = 0 floating_mask, & ! = 1 where ice is present and floating, else = 0 - ocean_mask, & ! = 1 where ice is absent and topg < eus, else = 0 land_mask ! = 1 where topg >= eus, else = 0 ! local variables integer, dimension(nx,ny) :: & - lake_mask ! = 1 for floating cells disconnected from the ocean + bmlt_inversion_mask, & ! = 1 for cells where bmlt_float is computed and applied, else = 0 + floating_mask_bmlt ! = 1 for cells that are durably floating, else = 0 + ! (where "durably floating" is defined as floating both before and after transport) - real(dp), dimension(nx,ny) :: & - dthck, & ! thck - thck_obs on ice grid - old_bmlt_float, & ! old value of bmlt_float_inversion (start of timestep) - temp_bmlt_float, & ! temporary value of bmlt_float_inversion (before smoothing) - dbmlt_float ! change in bmlt_float_inversion + real(dp), dimension(nx,ny):: & + thck_flotation, & ! thickness at which ice becomes afloat (m) + thck_cavity, & ! thickness of ocean cavity beneath floating ice (m) + thck_target ! thickness target (m); = thck_obs unless thck_obs > thck_flotation - real(dp) :: dbmlt_float_smooth + integer :: i, j, ii, jj, iglobal, jglobal - integer :: i, j, ii, jj + character(len=100) :: message + + real(dp) :: bmlt_factor ! factor for reducing basal melting + + real(dp), parameter :: inversion_bmlt_timescale = 0.0d0*scyr ! timescale for freezing in cavities (m/s) ! Where the observed ice is floating, adjust the basal melt rate (or freezing rate, if bmlt < 0) - ! so as to relax the ice thickness toward the observed target. + ! so as to relax the ice thickness toward a target thickness based on observations. ! Note: This subroutine should be called after other mass-balance terms have been applied, - ! and after horizontal transport. - ! We compute the difference (H - bmlt_float_inversion*dt) - H_obs, - ! which is the thickness error that would remain after applying the current bmlt_float_inversion. - ! We then increase or decrease bmlt_float_inversion with a characteristic timescale, - ! thereby reducing the thickness error. - ! As the timescale approaches zero, the adjusted bmlt_float_inversion will approach the value - ! needed to give H = H_obs. + ! after horizontal transport, and preferably after calving. if (verbose_inversion .and. main_task) then print*, ' ' print*, 'In invert_bmlt_float' endif - ! Identify lake cells: floating interior cells that will not be restored - ! to the target thickness - - call glissade_find_lakes(nx, ny, & - itest, jtest, rtest, & - ice_mask, floating_mask, & - ocean_mask, lake_mask) - - ! Compute a mask of cells where bmlt_float_inversion will be computed - !TODO - Make bmlt_inversion_mask a local field? + ! Compute the flotation thickness + where (topg < 0.0d0) + thck_flotation = -(rhoo/rhoi)*topg + elsewhere + thck_flotation = 0.0d0 + endwhere - basal_melt%bmlt_inversion_mask(:,:) = 0 + ! Compute the ocean cavity thickness beneath floating ice + where (floating_mask == 1) + thck_cavity = -topg - (rhoi/rhoo)*thck + elsewhere + thck_cavity = 0.0d0 + endwhere + ! Restore selected cells to a target thickness based on observations. + ! The rules are: + ! (1) Any ice-filled cell that is floating in observations is restored after transport + ! to its target thickness. + ! This includes cells that are either floating or grounded after transport. + ! (2) Any ice-filled cell that is grounded in observations but floating (or very lightly grounded) + ! after transport is restored to a target grounded thickness. This grounded thickness, however, + ! is not the observed thickness, but rather Hf + thck_over_flot. + ! Here, thck_over_float is a small thickness (1 m by default), and "very lightly grounded" + ! means that Hf < H < Hf + thck_over_flot. + ! The reason for not restoring grounded cells all the way to the observed value is that + ! we would like the basal sliding coefficients to adjust to help ground the ice more firmly, + ! rather than rely on large negative basal melt rates. + + ! Compute a mask of floating cells where bmlt_float_inversion will be computed. + ! The mask excludes land-based cells. + ! It includes cells that are + ! (1) floating in observations (even if they are grounded in the model, after transport), or + ! (2) grounded in observations but floating in the model (after transport) + + ! initialize + bmlt_inversion_mask(:,:) = 0 + thck_target(:,:) = 0.0d0 + + ! loop over cells do j = 2, ny-1 do i = 2, nx-1 - if (floating_mask(i,j) == 1) then - if (land_mask(i-1,j) == 1 .or. land_mask(i+1,j) == 1 .or. & - land_mask(i,j-1) == 1 .or. land_mask(i,j+1) == 1) then - ! has a land neighbor; do not invert for bmlt_float - elseif (lake_mask(i,j) == 1) then - ! no connection to ocean; do not invert for bmlt_float - elseif (thck_obs(i,j) > thck_flotation(i,j)) then - ! initially grounded; do not invert for bmlt_float - else - ! OK to invert for bmlt_float - basal_melt%bmlt_inversion_mask(i,j) = 1 + if (land_mask(i,j) == 1) then + + ! do nothing; bmlt_float_inversion = 0 + + !TODO - Relax thck(i,j) > 0 requirement? + elseif (thck(i,j) > 0.0d0 .and. thck_obs(i,j) > 0.0d0) then ! ice-covered marine cell in obs + + if (thck_obs(i,j) < thck_flotation(i,j)) then + + ! floating in obs; restore to thck_obs + + bmlt_inversion_mask(i,j) = 1 + thck_target(i,j) = thck_obs(i,j) + + !TODO - Remove the error check when satisfied that things are working. + if (thck(i,j) >= thck_flotation(i,j) .and. basal_melt%grounded_mask_start(i,j) == 1) then + ! This is not supposed to happen, so throw a fatal error. + call parallel_globalindex(i, j, iglobal, jglobal) + + print*, 'Error, floating cell has grounded:, task, i, j, H_obs, H_f, H:', & + this_rank, i, j, thck_obs(i,j), thck_flotation(i,j), thck(i,j) + print*, 'iglobal, jglobal =', iglobal, jglobal + write(message,*) 'ERROR in invert_bmlt_float: Cell that should be floating has grounded' + call write_log(message, GM_FATAL) + endif + + elseif (thck_obs(i,j) >= thck_flotation(i,j) .and. & + thck(i,j) < thck_flotation(i,j) + bmlt_inversion_thck_over_flot) then + + ! grounded in obs but currently floating; reground but do not set thck = thck_obs. + ! The reason for this is that we would prefer to adjust basal sliding parameters to bring + ! the thickness closer to observations, instead of relying on an artificially large bmlt_float. + bmlt_inversion_mask(i,j) = 1 + thck_target(i,j) = thck_flotation(i,j) + bmlt_inversion_thck_over_flot + endif + endif - enddo - enddo + enddo ! i + enddo ! j - call parallel_halo(basal_melt%bmlt_inversion_mask) + call parallel_halo(bmlt_inversion_mask) + call parallel_halo(thck_target) - ! Save the starting value of bmlt_float_inversion - old_bmlt_float(:,:) = basal_melt%bmlt_float_inversion(:,:) - dbmlt_float(:,:) = 0.0d0 - ! Compute difference between the current and target thickness - dthck(:,:) = thck(:,:) - thck_obs(:,:) + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'thck_target:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck_target(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + endif + + ! Now compute bmlt_float_inversion based on the thickness target. + ! Account for the surface mass balance, recalling that acab and bmlt have opposite sign conventions. + ! (acab > 0 for positive SMB, whereas bmlt > 0 for negative BMB.) + ! Typically, the background bmlt = 0 for floating cells when computing bmlt_float_inversion, + ! but we might be computing bmlt_float_inversion for cells that were grounded at the start + ! of the time step and thus have nonzero bmlt. + + basal_melt%bmlt_float_inversion(:,:) = 0.0d0 - ! Loop over cells do j = 1, ny do i = 1, nx + if (bmlt_inversion_mask(i,j) == 1) then - if (basal_melt%bmlt_inversion_mask(i,j) == 1) then + basal_melt%bmlt_float_inversion(i,j) = (thck(i,j) - thck_target(i,j))/dt + acab(i,j) - bmlt(i,j) - if (basal_melt%inversion_bmlt_timescale > 0.0d0) then - ! Adjust bmlt_float_inversion to reduce the thickness error - dbmlt_float(i,j) = (dthck(i,j) - basal_melt%bmlt_float_inversion(i,j)*dt) & - / basal_melt%inversion_bmlt_timescale - else - ! Set bmlt_float_inversion such that thck = thck_obs after inversion - dbmlt_float(i,j) = dthck(i,j)/dt - basal_melt%bmlt_float_inversion(i,j) - endif - - basal_melt%bmlt_float_inversion(i,j) = basal_melt%bmlt_float_inversion(i,j) + dbmlt_float(i,j) + ! Adjust to account for the surface mass balance. !WHL - debug if (verbose_inversion .and. this_rank == rtest .and. i==itest .and. j==jtest) then print*, ' ' print*, 'Invert for bmlt_float_inversion: rank, i, j =', rtest, itest, jtest - print*, 'thck, thck_obs, dthck, bmlt*dt:', & - thck(i,j), thck_obs(i,j), dthck(i,j), basal_melt%bmlt_float_inversion(i,j)*dt - print*, 'dbmlt_float, new bmlt_float (m/yr) =', dbmlt_float(i,j)*scyr, basal_melt%bmlt_float_inversion(i,j)*scyr + print*, 'thck, thck_obs, acab*dt, bmlt*dt:', & + thck(i,j), thck_obs(i,j), acab(i,j)*dt, & + basal_melt%bmlt_float_inversion(i,j)*dt endif - else ! bmlt_inversion_mask = 0 + endif ! bmlt_inversion_mask = 1 - basal_melt%bmlt_float_inversion(i,j) = 0.0d0 + enddo ! i + enddo ! j - endif ! bmlt_inversion_mask + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'bmlt_inversion_mask:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(i10)',advance='no') bmlt_inversion_mask(i,j) + enddo + write(6,*) ' ' + enddo + endif - enddo ! i - enddo ! j + !TODO - Test this code further, or delete it? So far, I haven't found a timescale to work well. + ! If a nonzero timescale is specified, then multiply bmlt_float_inversion by a factor + ! proportional to dt/timescale, in the range (0,1]. + + if (inversion_bmlt_timescale > 0.0d0) then + bmlt_factor = min(dt/inversion_bmlt_timescale, 1.0d0) + basal_melt%bmlt_float_inversion(:,:) = basal_melt%bmlt_float_inversion(:,:) * bmlt_factor + endif + + call parallel_halo(basal_melt%bmlt_float_inversion) !WHL - debug if (verbose_inversion .and. this_rank == rtest) then i = itest j = jtest print*, ' ' - print*, 'Before smoothing, bmlt_float (m/yr):' + print*, 'thck_flotation (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck_flotation(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'Before bmlt inversion, floating_mask:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(i10)',advance='no') floating_mask(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'thck_cavity (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck_cavity(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'thck (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'thck_obs (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck_obs(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'bmlt_float_inversion (m/yr):' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') basal_melt%bmlt_float_inversion(i,j)*scyr @@ -758,78 +857,150 @@ subroutine invert_bmlt_float(dt, & enddo endif - ! Save the value just computed - temp_bmlt_float(:,:) = basal_melt%bmlt_float_inversion(:,:) + end subroutine invert_bmlt_float + +!*********************************************************************** + + subroutine prescribe_bmlt_float(dt, & + nx, ny, & + itest, jtest, rtest, & + basal_melt, & + thck, & + topg, & + ice_mask, & + floating_mask, & + land_mask) + + ! Prescribe bmlt_float based on the value computed from inversion. + ! Note: bmlt_float_inversion is defined as positive for melting, negative for freezing. + ! This field is applied only beneath floating ice. + + real(dp), intent(in) :: dt ! time step (s) + + integer, intent(in) :: & + nx, ny ! grid dimensions + + integer, intent(in) :: & + itest, jtest, rtest ! coordinates of diagnostic point + + type(glide_basal_melt), intent(inout) :: & + basal_melt ! basal melt object + + real(dp), dimension(nx,ny), intent(in) :: & + thck, & ! ice thickness (m) + topg ! bedrock elevation (m) + + ! Note: When this subroutine is called, ice_mask = 1 where thck > 0, not thck > thklim. + integer, dimension(nx,ny), intent(in) :: & + ice_mask, & ! = 1 where ice is present, else = 0 + floating_mask, & ! = 1 where ice is present and floating, else = 0 + land_mask ! = 1 where topg >= eus, else = 0 + + ! local variables + + integer, dimension(nx,ny) :: & + bmlt_inversion_mask ! = 1 for cells where bmlt_float is computed and applied, else = 0 + + real(dp), dimension(nx,ny):: & + thck_flotation, & ! flotation thickness (m) + thck_final ! final thickness (m) if full melt rate is applied + + integer :: i, j, ii, jj + + real(dp) :: dthck ! thickness change (m) + + ! Note: This subroutine should be called after other mass-balance terms have been applied, + ! after horizontal transport, and preferably after calving. + + if (verbose_inversion .and. main_task) then + print*, ' ' + print*, 'In prescribe_bmlt_float' + endif + + ! Make a mask to identify cells that were floating at the start of the time step (before transport) + ! or are floating now (after transport). These are cells to which + + ! Compute the flotation thickness + where (topg < 0.0d0) + thck_flotation = -(rhoo/rhoi)*topg + elsewhere + thck_flotation = 0.0d0 + endwhere + + ! Compute a mask of floating cells where bmlt_float_inversion can potentially be computed. + ! The rule is that bmlt_float_inversion can be applied to any grid cell that is afloat either + ! before or after transport, with the exception of ice-free cells (with thck = 0) and land-based cells. + ! Note: The land mask is probably not needed, since land cells are excluded from the inversion. + ! But this mask is included for generality, in case of dynamic topography. + + bmlt_inversion_mask(:,:) = 0.0d0 + thck_final(:,:) = 0.0d0 - ! Apply Laplacian smoothing to bmlt_float_inversion. - !TODO - Write an operator for Laplacian smoothing? do j = 2, ny-1 do i = 2, nx-1 - if (basal_melt%bmlt_inversion_mask(i,j) == 1) then - - dbmlt_float_smooth = -4.0d0 * basal_melt%inversion_bmlt_smoothing_factor * temp_bmlt_float(i,j) - do jj = j-1, j+1 - do ii = i-1, i+1 - if ((ii == i .or. jj == j) .and. (ii /= i .or. jj /= j)) then ! edge neighbor - if (basal_melt%bmlt_inversion_mask(ii,jj) == 1) then ! inverting for bmlt_float in cell (ii,jj) - dbmlt_float_smooth = dbmlt_float_smooth & - + basal_melt%inversion_bmlt_smoothing_factor*temp_bmlt_float(ii,jj) - else - dbmlt_float_smooth = dbmlt_float_smooth & - + basal_melt%inversion_bmlt_smoothing_factor*temp_bmlt_float(i,j) - endif - endif - enddo - enddo + if (land_mask(i,j) == 1) then - ! Note: If smoothing is too strong, it can reverse the sign of the change in bmlt_float. - ! The logic below ensures that if bmlt_float is increasing, the smoothing can reduce - ! the change to zero, but not cause bmlt_float to decrease relative to old_bmlt_float - ! (and similarly if bmlt_float is decreasing). + ! do nothing; bmlt_float_inversion = 0 - if (dbmlt_float(i,j) > 0.0d0) then - if (temp_bmlt_float(i,j) + dbmlt_float_smooth > old_bmlt_float(i,j)) then - basal_melt%bmlt_float_inversion(i,j) = temp_bmlt_float(i,j) + dbmlt_float_smooth - else - ! allow the smoothing to hold bmlt_float at its old value, but not reduce bmlt_float - basal_melt%bmlt_float_inversion(i,j) = old_bmlt_float(i,j) - endif - elseif (dbmlt_float(i,j) < 0.0d0) then - if (temp_bmlt_float(i,j) + dbmlt_float_smooth < old_bmlt_float(i,j)) then - basal_melt%bmlt_float_inversion(i,j) = temp_bmlt_float(i,j) + dbmlt_float_smooth - else - ! allow the smoothing to hold bmlt_float at its old value, but not increase bmlt_float - basal_melt%bmlt_float_inversion(i,j) = old_bmlt_float(i,j) - endif - endif ! dbmlt_float > 0 + elseif ( ice_mask(i,j) == 1 .and. & + (basal_melt%floating_mask_start(i,j) == 1 .or. floating_mask(i,j) == 1) ) then - endif ! bmlt_inversion_mask = 1 + bmlt_inversion_mask(i,j) = 1 + dthck = -basal_melt%bmlt_float_prescribed(i,j) * dt + thck_final(i,j) = min(thck(i,j) + dthck, thck_flotation(i,j) + bmlt_inversion_thck_over_flot) + endif enddo enddo - call parallel_halo(basal_melt%bmlt_float_inversion) + call parallel_halo(bmlt_inversion_mask) + call parallel_halo(thck_final) + + ! Now compute bmlt_float_inversion based on the final thickness. + + basal_melt%bmlt_float_inversion(:,:) = 0.0d0 + + do j = 1, ny + do i = 1, nx + if (bmlt_inversion_mask(i,j) == 1) then + + basal_melt%bmlt_float_inversion(i,j) = (thck(i,j) - thck_final(i,j)) / dt + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest .and. i==itest .and. j==jtest) then + print*, ' ' + print*, 'Prescribe bmlt_float_inversion: rank, i, j =', rtest, itest, jtest + print*, 'thck, mask, bmlt*dt:', thck(i,j), bmlt_inversion_mask(i,j), & + basal_melt%bmlt_float_inversion(i,j)*dt + endif + + endif ! bmlt_inversion_mask = 1 + + enddo ! i + enddo ! j !WHL - debug if (verbose_inversion .and. this_rank == rtest) then i = itest j = jtest - print*, 'thck (m):' + print*, ' ' + print*, 'thck_final:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck(i,j) + write(6,'(f10.3)',advance='no') thck_final(i,j) enddo write(6,*) ' ' enddo - print*, 'thck - bmlt*dt - thck_obs:' + print*, ' ' + print*, 'bmlt_inversion_mask:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') dthck(i,j) - basal_melt%bmlt_float_inversion(i,j)*dt + write(6,'(i10)',advance='no') bmlt_inversion_mask(i,j) enddo write(6,*) ' ' enddo print*, ' ' - print*, 'After smoothing, bmlt_float_inversion (m/yr):' + print*, 'prescribed bmlt_float (m/yr):' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') basal_melt%bmlt_float_inversion(i,j)*scyr @@ -838,9 +1009,8 @@ subroutine invert_bmlt_float(dt, & enddo endif + end subroutine prescribe_bmlt_float - end subroutine invert_bmlt_float - !======================================================================= end module glissade_inversion diff --git a/libglissade/glissade_masks.F90 b/libglissade/glissade_masks.F90 index 8268acfd..486cd827 100644 --- a/libglissade/glissade_masks.F90 +++ b/libglissade/glissade_masks.F90 @@ -143,6 +143,9 @@ subroutine glissade_get_masks(nx, ny, & real(dp), dimension(nx,ny), intent(out), optional :: & thck_calving_front ! effective ice thickness at the calving front + !TODO - Make eps10 a model parameter? + real(dp), parameter :: eps10 = 1.0d-10 ! small number + !---------------------------------------------------------------- ! Local arguments !---------------------------------------------------------------- @@ -225,7 +228,7 @@ subroutine glissade_get_masks(nx, ny, & ! Optionally, compute the calving_front mask and effective calving_front thickness - if (present(calving_front_mask) .and. present(thck_calving_front) .and. present(which_ho_calving_front)) then + if (present(calving_front_mask) .and. present(which_ho_calving_front)) then if (which_ho_calving_front == HO_CALVING_FRONT_SUBGRID) then @@ -264,12 +267,14 @@ subroutine glissade_get_masks(nx, ny, & call parallel_halo(calving_front_mask) call parallel_halo(floating_interior_mask) - ! Compute an effective thickness in calving-front cells. - ! This is set to the minimum nonzero thickness in a marine-based neighbor (either floating - ! or grounded) that is not at the calving front. - thck_calving_front(:,:) = 0.0d0 + if (present(thck_calving_front)) then - do j = 2, ny-1 + ! Compute an effective thickness in calving-front cells. + ! This is set to the minimum nonzero thickness in a marine-based neighbor (either floating + ! or grounded) that is not at the calving front. + thck_calving_front(:,:) = 0.0d0 + + do j = 2, ny-1 do i = 2, nx-1 if (calving_front_mask(i,j) == 1) then @@ -312,17 +317,20 @@ subroutine glissade_get_masks(nx, ny, & endif ! calving front cell enddo ! i - enddo ! j + enddo ! j + + call parallel_halo(thck_calving_front) - call parallel_halo(thck_calving_front) + endif ! present(thck_calving_front) ! Optionally, update the active_ice_mask so that calving_front cells with thck < thck_calving_front are inactive, ! but those with thck >= thck_calving_front are active. if (present(active_ice_mask)) then - if (.not.present(land_mask)) then - call write_log('Must pass land_mask to compute active_ice_mask with calving-front option', GM_FATAL) + if (.not.present(thck_calving_front)) then + call write_log & + ('Must pass thck_calving_front to compute active_ice_mask with calving-front option', GM_FATAL) endif ! reset active_ice_mask @@ -330,17 +338,25 @@ subroutine glissade_get_masks(nx, ny, & ! Mark ice-filled cells as active. ! Calving-front cells, however, are inactive, unless they have thck >= thck_calving front or - ! are adjacent to land cells. + ! are adjacent to grounded cells. + do j = 2, ny-1 do i = 2, nx-1 if (ice_mask(i,j) == 1) then if (calving_front_mask(i,j) == 0) then active_ice_mask(i,j) = 1 elseif (calving_front_mask(i,j) == 1) then - if (thck_calving_front(i,j) > 0.0d0 .and. thck(i,j) >= thck_calving_front(i,j)) then + !WHL - There is a possible rounding issue here, if two adjacent cells are both being restored + ! (via inversion for bmlt_float) to the same thickness. For this reason, let the + ! cell be active if thck is very close to thck_calving front, but slightly less. + + if (thck_calving_front(i,j) > 0.0d0 .and. & + thck(i,j)*(1.0d0 + eps10) >= thck_calving_front(i,j)) then active_ice_mask(i,j) = 1 - elseif (land_mask(i-1,j) == 1 .or. land_mask(i+1,j) == 1 .or. & - land_mask(i,j-1) == 1 .or. land_mask(i,j+1) == 1) then + elseif (grounded_mask(i-1,j) == 1 .or. grounded_mask(i+1,j) == 1 .or. & + grounded_mask(i,j-1) == 1 .or. grounded_mask(i,j+1) == 1 .or. & + grounded_mask(i-1,j+1) == 1 .or. grounded_mask(i+1,j+1) == 1 .or. & + grounded_mask(i-1,j-1) == 1 .or. grounded_mask(i+1,j-1) == 1) then active_ice_mask(i,j) = 1 endif endif @@ -355,18 +371,13 @@ subroutine glissade_get_masks(nx, ny, & else ! no subgrid calving front calving_front_mask(:,:) = 0 - thck_calving_front(:,:) = 0.0d0 + if (present(thck_calving_front)) thck_calving_front(:,:) = 0.0d0 + ! Note: active_ice_mask, if present, was set above and need not be reset endif ! which_ho_calving_front - elseif ( (present(calving_front_mask) .and. .not.present(thck_calving_front)) & - .or. & - (present(thck_calving_front) .and. .not.present(calving_front_mask)) ) then - - call write_log('Must pass calving_front_mask and thck_calving_front together', GM_FATAL) - - endif ! calving_front_mask, thck_calving_front and which_ho_calving_front are present + endif ! calving_front_mask and which_ho_calving_front are present ! Optionally, compute the marine_cliff mask diff --git a/libglissade/glissade_velo_higher.F90 b/libglissade/glissade_velo_higher.F90 index ca35fd50..0e86bb0c 100644 --- a/libglissade/glissade_velo_higher.F90 +++ b/libglissade/glissade_velo_higher.F90 @@ -224,8 +224,8 @@ module glissade_velo_higher ! logical :: verbose_bfric = .true. logical :: verbose_trilinos = .false. ! logical :: verbose_trilinos = .true. - logical :: verbose_beta = .false. -! logical :: verbose_beta = .true. +! logical :: verbose_beta = .false. + logical :: verbose_beta = .true. logical :: verbose_efvs = .false. ! logical :: verbose_efvs = .true. logical :: verbose_tau = .false. @@ -2148,39 +2148,6 @@ subroutine glissade_velo_higher_solve(model, & endif - !------------------------------------------------------------------------------ - ! Compute powerlaw_c and coulomb_c fields by inversion, if needed - ! (part of basal_physics derived type). - ! Note: If powerlaw_c is prescribed from a previous inversion, it may need to be - ! adjusted in cells that were floating during the inversion but are now grounded, - ! or vice versa. - ! Note: dt and thck_obs are not rescaled by the scale_input subroutine, in order - ! to avoid accumulating errors by repeated multiplication and division. - !------------------------------------------------------------------------------ - - if (whichinversion == HO_INVERSION_COMPUTE) then - - call invert_basal_traction(dt*tim0, & ! s - nx, ny, & - itest, jtest, rtest, & - model%basal_physics, & - ice_mask, & - floating_mask, & - thck, & ! m - dthck_dt, & ! m/s - thck_obs*thk0) ! m - - elseif (whichinversion == HO_INVERSION_PRESCRIBED) then - - call prescribe_basal_traction(nx, ny, & - itest, jtest, rtest, & - ice_mask, & - floating_mask, & - model%basal_physics%powerlaw_c_prescribed, & - model%basal_physics%powerlaw_c_inversion) - - endif - !------------------------------------------------------------------------------ ! Main outer loop: Iterate to solve the nonlinear problem !------------------------------------------------------------------------------ @@ -2399,6 +2366,9 @@ subroutine glissade_velo_higher_solve(model, & write(6,*) ' ' enddo + !WHL - debug - Skip the next few fields for now + go to 500 + print*, ' ' print*, 'bpmp field, itest, jtest, rank =', itest, jtest, rtest !! do j = ny-1, 1, -1 @@ -2459,6 +2429,8 @@ subroutine glissade_velo_higher_solve(model, & write(6,*) ' ' enddo +500 continue + print*, ' ' print*, 'effecpress/overburden, itest, jtest, rank =', itest, jtest, rtest !! do j = ny-1, 1, -1 @@ -2514,16 +2486,15 @@ subroutine glissade_velo_higher_solve(model, & endif if (verbose_beta .and. main_task) then - print*, ' ' - print*, 'max, min beta (Pa/(m/yr)) =', maxbeta, minbeta +!! print*, 'max, min beta (Pa/(m/yr)) =', maxbeta, minbeta endif !! if (verbose_beta .and. this_rank==rtest) then - if (verbose_beta .and. this_rank==rtest .and. counter > 1 .and. mod(counter-1,30)==0) then + if (verbose_beta .and. this_rank==rtest .and. counter > 1 .and. mod(counter-1,25)==0) then print*, ' ' print*, 'log(beta), itest, jtest, rank =', itest, jtest, rtest !! do j = ny-1, 1, -1 - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j !! do i = 1, nx-1 do i = itest-3, itest+3 @@ -2541,7 +2512,7 @@ subroutine glissade_velo_higher_solve(model, & print*, ' ' print*, 'Mean uvel field, itest, jtest, rank =', itest, jtest, rtest !! do j = ny-1, 1, -1 - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j !! do i = 1, nx-1 do i = itest-3, itest+3 @@ -2552,7 +2523,7 @@ subroutine glissade_velo_higher_solve(model, & print*, ' ' print*, 'Mean vvel field, itest, jtest, rank =', itest, jtest, rtest !! do j = ny-1, 1, -1 - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j !! do i = 1, nx-1 do i = itest-3, itest+3 @@ -2566,7 +2537,7 @@ subroutine glissade_velo_higher_solve(model, & print*, ' ' print*, 'Basal uvel field, itest, jtest, rank =', itest, jtest, rtest !! do j = ny-1, 1, -1 - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j !! do i = 1, nx-1 do i = itest-3, itest+3 @@ -2578,7 +2549,7 @@ subroutine glissade_velo_higher_solve(model, & print*, ' ' print*, 'Basal vvel field, itest, jtest, rank =', itest, jtest, rtest !! do j = ny-1, 1, -1 - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j !! do i = 1, nx-1 do i = itest-3, itest+3 @@ -2590,7 +2561,7 @@ subroutine glissade_velo_higher_solve(model, & print*, ' ' print*, 'Sfc uvel field, itest, jtest, rank =', itest, jtest, rtest !! do j = ny-1, 1, -1 - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j !! do i = 1, nx-1 do i = itest-3, itest+3 @@ -2602,7 +2573,7 @@ subroutine glissade_velo_higher_solve(model, & print*, ' ' print*, 'Sfc vvel field, itest, jtest, rank =', itest, jtest, rtest !! do j = ny-1, 1, -1 - do j = jtest+4, jtest-4, -1 + do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j !! do i = 1, nx-1 do i = itest-3, itest+3 @@ -8903,7 +8874,12 @@ subroutine compute_residual_vector_2d(nx, ny, & real(dp), intent(out), optional :: & L2_norm_relative ! L2 norm of residual vector relative to rhs, |Ax - b| / |b| - integer :: i, j, iA, jA, m + real(dp), dimension(nx-1,ny-1) :: & + resid_sq ! resid_u^2 + resid_v^2 + + real(dp) :: my_max_resid, global_max_resid + + integer :: i, j, iA, jA, m, iglobal, jglobal real(dp) :: L2_norm_rhs ! L2 norm of rhs vector, |b| @@ -8950,6 +8926,7 @@ subroutine compute_residual_vector_2d(nx, ny, & ! Sum up squared L2 norm as we go L2_norm = 0.d0 + resid_sq(:,:) = 0.0d0 ! Loop over locally owned vertices @@ -8958,8 +8935,8 @@ subroutine compute_residual_vector_2d(nx, ny, & if (active_vertex(i,j)) then resid_u(i,j) = resid_u(i,j) - bu(i,j) resid_v(i,j) = resid_v(i,j) - bv(i,j) - L2_norm = L2_norm + resid_u(i,j)*resid_u(i,j) & - + resid_v(i,j)*resid_v(i,j) + resid_sq(i,j) = resid_u(i,j)*resid_u(i,j) + resid_v(i,j)*resid_v(i,j) + L2_norm = L2_norm + resid_sq(i,j) endif ! active vertex enddo ! i enddo ! j @@ -8969,17 +8946,39 @@ subroutine compute_residual_vector_2d(nx, ny, & L2_norm = parallel_reduce_sum(L2_norm) L2_norm = sqrt(L2_norm) - if (verbose_residual .and. this_rank==rtest) then - i = itest - j = jtest - print*, 'In compute_residual_vector_2d: i, j =', i, j - print*, 'u, v :', uvel(i,j), vvel(i,j) - print*, 'bu, bv:', bu(i,j), bv(i,j) - print*, 'resid_u, resid_v:', resid_u(i,j), resid_v(i,j) - print*, ' ' - print*, 'maxval/minval(resid_u) =', maxval(resid_u), minval(resid_u) - print*, 'maxval/minval(resid_v) =', maxval(resid_v), minval(resid_v) - endif + if (verbose_residual) then + + if (this_rank==rtest) then + i = itest + j = jtest +! print*, ' ' +! print*, 'In compute_residual_vector_2d: i, j =', i, j +! print*, 'u, v :', uvel(i,j), vvel(i,j) +! print*, 'bu, bv:', bu(i,j), bv(i,j) +! print*, 'resid_u, resid_v:', resid_u(i,j), resid_v(i,j) + endif + + !TODO - Add this calculation to the 3D residual subroutine + + ! Compute max value of (squared) residual on this task. + ! If this task owns the vertex with the global max residual, then print a diagnostic message. + my_max_resid = maxval(resid_sq) + global_max_resid = parallel_reduce_max(my_max_resid) + + if (abs((my_max_resid - global_max_resid)/global_max_resid) < 1.0d-6) then + do j = staggered_jlo, staggered_jhi + do i = staggered_ilo, staggered_ihi + if (abs((resid_sq(i,j) - global_max_resid)/global_max_resid) < 1.0d-6) then + print*, 'task, i, j, global_max_resid^2:', this_rank, i, j, global_max_resid + call parallel_globalindex(i, j, iglobal, jglobal) + print*, 'global i, j =', iglobal, jglobal + print*, 'residu, residv:', resid_u(i,j), resid_v(i,j) + endif + enddo + enddo + endif + + endif ! verbose_residual if (present(L2_norm_relative)) then ! compute L2_norm relative to rhs From 89ef8f93db352869593e7bed563cbea7b1309f41 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Fri, 16 Mar 2018 15:50:19 -0600 Subject: [PATCH 14/61] More changes for inversion spinup and forward runs In glissade_inversion.F90, I made the following changes: - I introduced a parameter called glissade_inversion_thck_buffer, with a default value of 3 m. At startup, ice with a thickness within 3 m of thck_flotation is thinned or thickened to be 3 m thicker or thinner than thck_flotation. The revised thickness becomes the observational target, thck_obs. The goal of this change was to make spun-up thicknesses more robust in forward runs. Results are mixed; I still see cells flipping between grounded and floating in forward runs. - I replaced topg with (topg - eus) where appropriate. This would matter in runs with eus /= 0. - I changed the rule for applying bmlt_float_inversion in forward runs. Previously, bmlt_float_inversion was applied only to cells that were floating before and/or after transport. Now, it can be applied to any marine-based cells, including those that were floating during the spin-up but have grounded during the forward run. The goal was to avoid having floating cells ground in the forward run and stay grounded. Again, results are mixed. - For forward runs, I fixed some logic for limiting thck_final, to account for acab and bmlt. - I added some diagnostics for forward runs. In glissade.F90, I modified the computation of dthck_dt to include only physical changes (i.e., changes due to transport and mass balance) and not changes due to bmlt_float_inversion. I also added some diagnostics and revised some argument lists. In glissade_grounding_line.F90, I fixed a minor bug in the logic for computing integrals at vertices with 2 grounded and 2 floating neighbors, diagonally opposite. With these changes, forward runs are a bit more robust. After starting from the output of a 20 ka spinup, thickness changes are modest over the first 100 years of the forward run. However, changes grow over time as cells flip between floating and grounded. A large transient persists for at least 2 ka. --- cism_driver/cism_front_end.F90 | 7 + libglissade/glissade.F90 | 102 +++++-- libglissade/glissade_grounding_line.F90 | 2 +- libglissade/glissade_inversion.F90 | 350 ++++++++++++++++-------- libglissade/glissade_velo_higher.F90 | 2 +- 5 files changed, 319 insertions(+), 144 deletions(-) diff --git a/cism_driver/cism_front_end.F90 b/cism_driver/cism_front_end.F90 index c32cc727..4e582ade 100644 --- a/cism_driver/cism_front_end.F90 +++ b/cism_driver/cism_front_end.F90 @@ -213,11 +213,14 @@ subroutine cism_init_dycore(model) ! Write initial diagnostic output to log file ! Note: tstep_count is set to 0 at model initialization and then is incremented in cism_run_dycore ! before each call to a dycore. + ! Note: If minthick_in = 0, then all cells with nonzero ice thickness (including very thin ice) + ! will contribute to global diagnostics. call t_startf('initial_write_diagnostics') call glide_write_diagnostics(model, time, & tstep_count = model%numerics%tstep_count, & minthick_in = model%numerics%thklim*thk0) ! m +!! minthick_in = 0.0d0) ! m call t_stopf('initial_write_diagnostics') end if ! whichdycore .ne. DYCORE_BISICLES @@ -344,10 +347,14 @@ subroutine cism_run_dycore(model) ! write ice sheet diagnostics to log file at desired interval (model%numerics%dt_diag) + ! Note: If minthick_in = 0, then all cells with nonzero ice thickness (including very thin ice) + ! will contribute to global diagnostics. + call t_startf('write_diagnostics') call glide_write_diagnostics(model, time, & tstep_count = model%numerics%tstep_count, & minthick_in = model%numerics%thklim*thk0) ! m +!! minthick_in = 0.0d0) ! m call t_stopf('write_diagnostics') ! update time from dycore advance diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index a0768876..02137532 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -1489,6 +1489,7 @@ subroutine glissade_transport_solve(model) thck_unscaled, & ! m model%geometry%thck_obs*thk0, & ! m model%geometry%topg*thk0, & ! m + model%climate%eus*thk0, & ! m model%climate%acab_corrected*thk0/tim0, & ! m/s model%basal_melt%bmlt*thk0/tim0, & ! m/s ice_mask, & @@ -1512,14 +1513,17 @@ subroutine glissade_transport_solve(model) ! Although bmlt_float is prescribed, it may need to be limited or ignored, ! for example to avoid melting beneath grounded ice. - call prescribe_bmlt_float(model%numerics%dt * tim0, & ! s - model%general%ewn, model%general%nsn, & - itest, jtest, rtest, & - model%basal_melt, & - thck_unscaled, & ! m - model%geometry%topg*thk0, & ! m - ice_mask, & - floating_mask, & + call prescribe_bmlt_float(model%numerics%dt * tim0, & ! s + model%general%ewn, model%general%nsn, & + itest, jtest, rtest, & + model%basal_melt, & + thck_unscaled, & ! m + model%geometry%topg*thk0, & ! m + model%climate%eus*thk0, & ! m + model%climate%acab_corrected*thk0/tim0, & ! m/s + model%basal_melt%bmlt*thk0/tim0, & ! m/s + ice_mask, & + floating_mask, & land_mask) !WHL - debug @@ -1596,6 +1600,8 @@ subroutine glissade_transport_solve(model) model%options%which_ho_vertical_remap) !WHL - debug + call parallel_halo(thck_unscaled) + if (verbose_inversion .and. this_rank == rtest) then i = itest j = jtest @@ -1681,17 +1687,26 @@ subroutine glissade_transport_solve(model) if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then ! Compute the thickness tendency dH/dt from one step to the next (m/s). - ! This tendency is used when inverting for powerlaw_c_inversion. + ! This tendency is used when inverting for powerlaw_c_inversion in grounded grid cells. ! Note: We set dthck_dt = 0 for inactive cells (thck <= thklim at the start of the time step). ! This helps prevent the following cycle: ! - While Cp is increasing, a cell thins to H < thklim and becomes inactive. ! - Once inactive, the cell thickens (reducing Cp) and becomes active. ! - Once active again, the cell resumes thinning, reducing Cp. And so on. + ! Note: Some cells have powerlaw_c_inversion > 0 (because they are grounded after mass balance), + ! and also have bmlt_float_inversion < 0 (because they are floating after transport + ! and need a negative melt rate to reground). + ! For these cells we remove bmlt_float_inversion from dthck_dt, because we want + ! dthck_dt to reflect how fast the ice is thinning without the inversion. + ! Since bmlt_float_inversion < 0 in this situation, adding it will make dthck_dt + ! more negative as desired. ! Note: dthck_dt is recomputed at the end of the time step for diagnostic output. + !TODO - Divide bmlt_float_inversion by effective_areafrac? Probably not needed for grounded cells. where (model%geometry%thck_old > model%numerics%thklim) model%geometry%dthck_dt = (model%geometry%thck - model%geometry%thck_old) * thk0 & - / (model%numerics%dt * tim0) + /(model%numerics%dt * tim0) & + + model%basal_melt%bmlt_float_inversion elsewhere model%geometry%dthck_dt = 0.0d0 endwhere @@ -2018,6 +2033,7 @@ subroutine glissade_diagnostic_variable_solve(model) !WHL - debug real(dp) :: my_max_diff, global_max_diff + real(dp) :: my_min_diff, global_min_diff integer :: iglobal, jglobal, ii, jj rtest = -999 @@ -2655,9 +2671,11 @@ subroutine glissade_diagnostic_variable_solve(model) model%geometry%basal_mbal_flux(:,:) = rhoi * (-model%basal_melt%bmlt_applied(:,:)) * thk0/tim0 model%geometry%calving_flux(:,:) = rhoi * (-model%calving%calving_thck(:,:)*thk0) / (model%numerics%dt*tim0) - !WHL - temporary debug - compute max diff in bmlt_applied + !WHL - inversion debug - if (model%numerics%tstep_count > 0) then + if (verbose_inversion .and. model%numerics%tstep_count > 0) then + + !WHL - temporary debug - compute max diff in bmlt_applied model%basal_melt%bmlt_applied_diff(:,:) = & abs(model%basal_melt%bmlt_applied(:,:) - model%basal_melt%bmlt_applied_old(:,:)) @@ -2673,10 +2691,9 @@ subroutine glissade_diagnostic_variable_solve(model) print*, 'task, i, j, global_max_diff (m/yr):', this_rank, i, j, global_max_diff * scyr*thk0/tim0 print*, 'bmlt_float_inversion:', model%basal_melt%bmlt_float_inversion(i,j) * scyr print*, 'bmlt_applied old, new:', model%basal_melt%bmlt_applied_old(i,j) * scyr*thk0/tim0, & - model%basal_melt%bmlt_applied(i,j) * scyr*thk0/tim0 + model%basal_melt%bmlt_applied(i,j) * scyr*thk0/tim0 call parallel_globalindex(i, j, iglobal, jglobal) print*, 'global i, j =', iglobal, jglobal - print*, ' ' print*, 'bmlt_applied:' do jj = j-3, j+3 @@ -2686,14 +2703,44 @@ subroutine glissade_diagnostic_variable_solve(model) enddo print*, ' ' enddo - endif enddo enddo endif model%basal_melt%bmlt_applied_old(:,:) = model%basal_melt%bmlt_applied(:,:) - endif + + ! repeat for dthck_dt + my_max_diff = maxval(model%geometry%dthck_dt) + my_min_diff = minval(model%geometry%dthck_dt) + global_max_diff = parallel_reduce_max(my_max_diff) + global_min_diff = parallel_reduce_min(my_min_diff) + + if (abs((my_max_diff - global_max_diff)/global_max_diff) < 1.0d-6) then + do j = nhalo+1, model%general%nsn-nhalo + do i = nhalo+1, model%general%ewn-nhalo + + if (abs((model%geometry%dthck_dt(i,j) - global_max_diff)/global_max_diff) < 1.0d-6) then + print*, ' ' + print*, 'task, i, j, global_max_diff dthck/dt (m/yr):', this_rank, i, j, global_max_diff * scyr + print*, 'thck old, new:', model%geometry%thck_old(i,j)*thk0, model%geometry%thck(i,j)*thk0 + call parallel_globalindex(i, j, iglobal, jglobal) + print*, 'global i, j =', iglobal, jglobal + endif + + if (abs((model%geometry%dthck_dt(i,j) - global_min_diff)/global_min_diff) < 1.0d-6) then + print*, ' ' + print*, 'task, i, j, global_min_diff dthck/dt (m/yr):', this_rank, i, j, global_min_diff * scyr + print*, 'thck old, new:', model%geometry%thck_old(i,j)*thk0, model%geometry%thck(i,j)*thk0 + call parallel_globalindex(i, j, iglobal, jglobal) + print*, 'global i, j =', iglobal, jglobal + endif + + enddo + enddo + endif + + endif ! verbose_inversion ! real-valued masks @@ -2703,20 +2750,23 @@ subroutine glissade_diagnostic_variable_solve(model) if (ice_mask(i,j) == 1) then model%geometry%ice_mask(i,j) = 1.0d0 if (floating_mask(i,j) == 1) then + !WHL - debug - Identify cells where floating_mask flips between time steps. +!! if (model%geometry%floating_mask(i,j) == 0) then ! grounded or ice-free at previous step +!! call parallel_globalindex(i, j, iglobal, jglobal) +!! print*, 'floating_mask flipped from 0 to 1:, rank, i, j, iglobal, jglobal, thck_old, thck =', & +!! this_rank, i, j, iglobal, jglobal, & +!! model%geometry%thck_old(i,j)*thk0, model%geometry%thck(i,j)*thk0 +!! endif model%geometry%floating_mask(i,j) = 1.0d0 model%geometry%grounded_mask(i,j) = 0.0d0 else - !WHL - debug - Identify cells where grounded_mask flips between time steps. - if (model%geometry%grounded_mask(i,j) == 0) then ! grounded at previous step - if (i == itest .and. j == jtest .and. this_rank == rtest) then - print*, 'grounded_mask flipped from 0 to 1:, rank, i, j, ice_mask, thck =', & - this_rank, i, j, ice_mask(i,j), model%geometry%thck(i,j)*thk0 - call parallel_globalindex(i, j, iglobal, jglobal) - print*, 'iglobal, jglobal =', iglobal, jglobal - endif - endif - +!! if (model%geometry%grounded_mask(i,j) == 0) then ! floating or ice-free at previous step +!! call parallel_globalindex(i, j, iglobal, jglobal) +!! print*, 'grounded_mask flipped from 0 to 1:, rank, i, j, iglobal, jglobal, thck_old, thck =', & +!! this_rank, i, j, iglobal, jglobal, & +!! model%geometry%thck_old(i,j)*thk0, model%geometry%thck(i,j)*thk0 +!! endif model%geometry%grounded_mask(i,j) = 1.0d0 model%geometry%floating_mask(i,j) = 0.0d0 endif diff --git a/libglissade/glissade_grounding_line.F90 b/libglissade/glissade_grounding_line.F90 index f35b2294..a587eabd 100644 --- a/libglissade/glissade_grounding_line.F90 +++ b/libglissade/glissade_grounding_line.F90 @@ -683,7 +683,7 @@ subroutine glissade_grounded_fraction(nx, ny, & print*, 'Pattern 3: i, j, bc - ad =', i, j, b*c - a*d endif - if (abs(-a*d/(b*c)) > eps06) then ! the usual case + if (abs(b*c - a*d) > eps06) then ! the usual case f_corner1 = ((b*c - a*d) * log(1.d0 - (a*d)/(b*c)) + a*d) / (d*d) f_corner2 = ((b*c - a*d) * log((b*c - a*d)/((b+d)*(c+d))) & + d*(a + b + c + d)) / (d*d) diff --git a/libglissade/glissade_inversion.F90 b/libglissade/glissade_inversion.F90 index 626e2a19..82be2a53 100644 --- a/libglissade/glissade_inversion.F90 +++ b/libglissade/glissade_inversion.F90 @@ -49,7 +49,7 @@ module glissade_inversion powerlaw_c_marine = 1000.d0 real(dp), parameter :: & - bmlt_inversion_thck_over_flot = 1.0d0 ! Ice restored from floating to grounded is this much thicker than thck_flotation (m) + bmlt_inversion_thck_buffer = 3.0d0 ! Ice is restored to this much above or below thck_flotation !*********************************************************************** @@ -83,6 +83,11 @@ subroutine glissade_init_inversion(model) ocean_mask, & ! = 1 where ice is absent and topg < eus, else = 0 land_mask ! = 1 where topg >= eus, else = 0 + real(dp), dimension(model%general%ewn, model%general%nsn) :: & + thck_flotation ! flotation thickness (m) + + real(dp) :: dthck + ! Set local diagnostic point rtest = -999 itest = 1 @@ -105,9 +110,50 @@ subroutine glissade_init_inversion(model) var_maxval = maxval(model%geometry%thck_obs) var_maxval = parallel_reduce_max(var_maxval) if (var_maxval > 0.0d0) then + ! do nothing; thck_obs has been read in already (e.g., after restart) + else + + ! initialize to the input thickness model%geometry%thck_obs(:,:) = model%geometry%thck(:,:) + + ! Adjust thck_obs so that the observational target is not too close to thck_flotation. + ! The reason for this is that if we restore H to values very close to thck_flotation, + ! it is easy for cells to flip between grounded and floating in the forward run, even with + ! bmlt_float_inversion and powerlaw_c_inversion equal to values from the inversion run. + + where (model%geometry%topg - model%climate%eus < 0.0d0) + thck_flotation = -(rhoo/rhoi) * (model%geometry%topg - model%climate%eus) * thk0 ! convert to m + elsewhere + thck_flotation = 0.0d0 + endwhere + + do j = 1, model%general%nsn + do i = 1, model%general%ewn + if (model%geometry%thck_obs(i,j) > 0.0d0) then + dthck = model%geometry%thck_obs(i,j)*thk0 - thck_flotation(i,j) ! difference (m) + if (abs(dthck) < bmlt_inversion_thck_buffer) then + if (dthck > 0.0d0) then + model%geometry%thck_obs(i,j) = (thck_flotation(i,j) + bmlt_inversion_thck_buffer) / thk0 + else + model%geometry%thck_obs(i,j) = (thck_flotation(i,j) - bmlt_inversion_thck_buffer) / thk0 + endif + endif + endif + model%geometry%thck_obs(i,j) = max(model%geometry%thck_obs(i,j), 0.0d0) + enddo + enddo + + ! Another adjustment: Make sure the observational target thickness is not too close to thklim. + ! If thck_obs is close to thklim, there is a greater chance that the modeled thickness will + ! flicker on either side of thklim. + + where (model%geometry%thck_obs > 0.0d0) + model%geometry%thck_obs = max(model%geometry%thck_obs, & + model%numerics%thklim + bmlt_inversion_thck_buffer/thk0) + endwhere + endif call parallel_halo(model%geometry%thck_obs) @@ -371,55 +417,59 @@ subroutine invert_basal_traction(dt, & enddo endif - ! Save the value just computed - temp_powerlaw_c(:,:) = basal_physics%powerlaw_c_inversion(:,:) - - ! Apply Laplacian smoothing. - ! Since powerlaw_c lives at cell centers but is interpolated to vertices, smoothing can damp checkerboard noise. - !TODO - Write an operator for Laplacian smoothing? - do j = 2, ny-1 - do i = 2, nx-1 - if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! cell (i,j) is grounded - - dpowerlaw_c_smooth = -4.0d0 * basal_physics%inversion_babc_smoothing_factor * temp_powerlaw_c(i,j) - do jj = j-1, j+1 - do ii = i-1, i+1 - if ((ii == i .or. jj == j) .and. (ii /= i .or. jj /= j)) then ! edge neighbor - if (ice_mask(ii,jj) == 1 .and. floating_mask(ii,jj) == 0) then ! cell (ii,jj) is grounded - dpowerlaw_c_smooth = dpowerlaw_c_smooth & - + basal_physics%inversion_babc_smoothing_factor*temp_powerlaw_c(ii,jj) - else - dpowerlaw_c_smooth = dpowerlaw_c_smooth & - + basal_physics%inversion_babc_smoothing_factor*temp_powerlaw_c(i,j) + if (basal_physics%inversion_babc_smoothing_factor > 0.0d0) then + + ! Save the value just computed + temp_powerlaw_c(:,:) = basal_physics%powerlaw_c_inversion(:,:) + + ! Apply Laplacian smoothing. + ! Since powerlaw_c lives at cell centers but is interpolated to vertices, smoothing can damp checkerboard noise. + !TODO - Write an operator for Laplacian smoothing? + do j = 2, ny-1 + do i = 2, nx-1 + if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! cell (i,j) is grounded + + dpowerlaw_c_smooth = -4.0d0 * basal_physics%inversion_babc_smoothing_factor * temp_powerlaw_c(i,j) + do jj = j-1, j+1 + do ii = i-1, i+1 + if ((ii == i .or. jj == j) .and. (ii /= i .or. jj /= j)) then ! edge neighbor + if (ice_mask(ii,jj) == 1 .and. floating_mask(ii,jj) == 0) then ! cell (ii,jj) is grounded + dpowerlaw_c_smooth = dpowerlaw_c_smooth & + + basal_physics%inversion_babc_smoothing_factor*temp_powerlaw_c(ii,jj) + else + dpowerlaw_c_smooth = dpowerlaw_c_smooth & + + basal_physics%inversion_babc_smoothing_factor*temp_powerlaw_c(i,j) + endif endif - endif + enddo enddo - enddo - ! Note: If smoothing is too strong, it can reverse the sign of the change in powerlaw_c. - ! The logic below ensures that if powerlaw_c is increasing, the smoothing can reduce - ! the change to zero, but not cause powerlaw_c to decrease relative to old_powerlaw_c - ! (and similarly if powerlaw_c is decreasing). + ! Note: If smoothing is too strong, it can reverse the sign of the change in powerlaw_c. + ! The logic below ensures that if powerlaw_c is increasing, the smoothing can reduce + ! the change to zero, but not cause powerlaw_c to decrease relative to old_powerlaw_c + ! (and similarly if powerlaw_c is decreasing). - if (dpowerlaw_c(i,j) > 0.0d0) then - if (temp_powerlaw_c(i,j) + dpowerlaw_c_smooth > old_powerlaw_c(i,j)) then - basal_physics%powerlaw_c_inversion(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth - else - ! allow the smoothing to hold Cp at its old value, but not reduce Cp - basal_physics%powerlaw_c_inversion(i,j) = old_powerlaw_c(i,j) - endif - elseif (dpowerlaw_c(i,j) < 0.0d0) then - if (temp_powerlaw_c(i,j) + dpowerlaw_c_smooth < old_powerlaw_c(i,j)) then - basal_physics%powerlaw_c_inversion(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth - else - ! allow the smoothing to hold Cp at its old value, but not increase Cp - basal_physics%powerlaw_c_inversion(i,j) = old_powerlaw_c(i,j) - endif - endif ! dpowerlaw_c > 0 + if (dpowerlaw_c(i,j) > 0.0d0) then + if (temp_powerlaw_c(i,j) + dpowerlaw_c_smooth > old_powerlaw_c(i,j)) then + basal_physics%powerlaw_c_inversion(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth + else + ! allow the smoothing to hold Cp at its old value, but not reduce Cp + basal_physics%powerlaw_c_inversion(i,j) = old_powerlaw_c(i,j) + endif + elseif (dpowerlaw_c(i,j) < 0.0d0) then + if (temp_powerlaw_c(i,j) + dpowerlaw_c_smooth < old_powerlaw_c(i,j)) then + basal_physics%powerlaw_c_inversion(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth + else + ! allow the smoothing to hold Cp at its old value, but not increase Cp + basal_physics%powerlaw_c_inversion(i,j) = old_powerlaw_c(i,j) + endif + endif ! dpowerlaw_c > 0 - endif ! cell is grounded - enddo - enddo + endif ! cell is grounded + enddo ! i + enddo ! j + + endif ! smoothing factor > 0 call parallel_halo(basal_physics%powerlaw_c_inversion) @@ -447,18 +497,20 @@ subroutine invert_basal_traction(dt, & print*, 'dthck_dt (m/yr):' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') dthck_dt(i,j)*scyr + write(6,'(f10.5)',advance='no') dthck_dt(i,j)*scyr enddo write(6,*) ' ' enddo - print*, ' ' - print*, 'After smoothing, powerlaw_c:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_inversion(i,j) + if (basal_physics%inversion_babc_smoothing_factor > 0.0d0) then + print*, ' ' + print*, 'After smoothing, powerlaw_c:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_inversion(i,j) + enddo + write(6,*) ' ' enddo - write(6,*) ' ' - enddo + endif endif end subroutine invert_basal_traction @@ -580,6 +632,7 @@ subroutine invert_bmlt_float(dt, & thck, & thck_obs, & topg, & + eus, & acab, & bmlt, & ice_mask, & @@ -610,6 +663,9 @@ subroutine invert_bmlt_float(dt, & acab, & ! surface mass balance (m/s), including runtime adjustments bmlt + real(dp), intent(in) :: & + eus ! eustatic sea level (m) + ! Note: When this subroutine is called, ice_mask = 1 where thck > 0, not thck > thklim. integer, dimension(nx,ny), intent(in) :: & ice_mask, & ! = 1 where ice is present, else = 0 @@ -647,15 +703,15 @@ subroutine invert_bmlt_float(dt, & endif ! Compute the flotation thickness - where (topg < 0.0d0) - thck_flotation = -(rhoo/rhoi)*topg + where (topg - eus < 0.0d0) + thck_flotation = -(rhoo/rhoi) *(topg - eus) elsewhere thck_flotation = 0.0d0 endwhere ! Compute the ocean cavity thickness beneath floating ice where (floating_mask == 1) - thck_cavity = -topg - (rhoi/rhoo)*thck + thck_cavity = -(topg - eus) - (rhoi/rhoo)*thck elsewhere thck_cavity = 0.0d0 endwhere @@ -667,9 +723,9 @@ subroutine invert_bmlt_float(dt, & ! This includes cells that are either floating or grounded after transport. ! (2) Any ice-filled cell that is grounded in observations but floating (or very lightly grounded) ! after transport is restored to a target grounded thickness. This grounded thickness, however, - ! is not the observed thickness, but rather Hf + thck_over_flot. - ! Here, thck_over_float is a small thickness (1 m by default), and "very lightly grounded" - ! means that Hf < H < Hf + thck_over_flot. + ! is not the observed thickness, but rather Hf + thck_buffer. + ! Here, thck_buffer is a small thickness (2 m by default), and "very lightly grounded" + ! means that Hf < H < (Hf + thck_buffer). ! The reason for not restoring grounded cells all the way to the observed value is that ! we would like the basal sliding coefficients to adjust to help ground the ice more firmly, ! rather than rely on large negative basal melt rates. @@ -699,9 +755,12 @@ subroutine invert_bmlt_float(dt, & ! floating in obs; restore to thck_obs bmlt_inversion_mask(i,j) = 1 - thck_target(i,j) = thck_obs(i,j) + + thck_target(i,j) = min(thck_obs(i,j), thck_flotation(i,j) - bmlt_inversion_thck_buffer) + thck_target(i,j) = max(thck_target(i,j), 0.0d0) ! just to be safe !TODO - Remove the error check when satisfied that things are working. + ! Note: This gives false positives on the first step. if (thck(i,j) >= thck_flotation(i,j) .and. basal_melt%grounded_mask_start(i,j) == 1) then ! This is not supposed to happen, so throw a fatal error. call parallel_globalindex(i, j, iglobal, jglobal) @@ -710,17 +769,18 @@ subroutine invert_bmlt_float(dt, & this_rank, i, j, thck_obs(i,j), thck_flotation(i,j), thck(i,j) print*, 'iglobal, jglobal =', iglobal, jglobal write(message,*) 'ERROR in invert_bmlt_float: Cell that should be floating has grounded' - call write_log(message, GM_FATAL) +!! call write_log(message, GM_FATAL) + call write_log(message) endif elseif (thck_obs(i,j) >= thck_flotation(i,j) .and. & - thck(i,j) < thck_flotation(i,j) + bmlt_inversion_thck_over_flot) then + thck(i,j) < thck_flotation(i,j) + bmlt_inversion_thck_buffer) then ! grounded in obs but currently floating; reground but do not set thck = thck_obs. ! The reason for this is that we would prefer to adjust basal sliding parameters to bring ! the thickness closer to observations, instead of relying on an artificially large bmlt_float. bmlt_inversion_mask(i,j) = 1 - thck_target(i,j) = thck_flotation(i,j) + bmlt_inversion_thck_over_flot + thck_target(i,j) = thck_flotation(i,j) + bmlt_inversion_thck_buffer endif @@ -762,8 +822,6 @@ subroutine invert_bmlt_float(dt, & basal_melt%bmlt_float_inversion(i,j) = (thck(i,j) - thck_target(i,j))/dt + acab(i,j) - bmlt(i,j) - ! Adjust to account for the surface mass balance. - !WHL - debug if (verbose_inversion .and. this_rank == rtest .and. i==itest .and. j==jtest) then print*, ' ' @@ -778,21 +836,7 @@ subroutine invert_bmlt_float(dt, & enddo ! i enddo ! j - !WHL - debug - if (verbose_inversion .and. this_rank == rtest) then - i = itest - j = jtest - print*, ' ' - print*, 'bmlt_inversion_mask:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(i10)',advance='no') bmlt_inversion_mask(i,j) - enddo - write(6,*) ' ' - enddo - endif - - !TODO - Test this code further, or delete it? So far, I haven't found a timescale to work well. + !TODO - Test the following code further, or delete it? So far, I haven't found a timescale to work well. ! If a nonzero timescale is specified, then multiply bmlt_float_inversion by a factor ! proportional to dt/timescale, in the range (0,1]. @@ -808,6 +852,14 @@ subroutine invert_bmlt_float(dt, & i = itest j = jtest print*, ' ' + print*, 'bmlt_inversion_mask:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(i10)',advance='no') bmlt_inversion_mask(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' print*, 'thck_flotation (m):' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 @@ -816,7 +868,7 @@ subroutine invert_bmlt_float(dt, & write(6,*) ' ' enddo print*, ' ' - print*, 'Before bmlt inversion, floating_mask:' + print*, 'floating_mask:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 write(6,'(i10)',advance='no') floating_mask(i,j) @@ -867,6 +919,9 @@ subroutine prescribe_bmlt_float(dt, & basal_melt, & thck, & topg, & + eus, & + acab, & + bmlt, & ice_mask, & floating_mask, & land_mask) @@ -888,7 +943,12 @@ subroutine prescribe_bmlt_float(dt, & real(dp), dimension(nx,ny), intent(in) :: & thck, & ! ice thickness (m) - topg ! bedrock elevation (m) + topg, & ! bedrock elevation (m) + acab, & ! surface mass balance (m/s), including runtime adjustments + bmlt + + real(dp), intent(in) :: & + eus ! eustatic sea level (m) ! Note: When this subroutine is called, ice_mask = 1 where thck > 0, not thck > thklim. integer, dimension(nx,ny), intent(in) :: & @@ -903,11 +963,10 @@ subroutine prescribe_bmlt_float(dt, & real(dp), dimension(nx,ny):: & thck_flotation, & ! flotation thickness (m) + thck_cavity, & ! thickness (m) of ocean cavity (diagnostic only) thck_final ! final thickness (m) if full melt rate is applied - integer :: i, j, ii, jj - - real(dp) :: dthck ! thickness change (m) + integer :: i, j ! Note: This subroutine should be called after other mass-balance terms have been applied, ! after horizontal transport, and preferably after calving. @@ -917,65 +976,84 @@ subroutine prescribe_bmlt_float(dt, & print*, 'In prescribe_bmlt_float' endif - ! Make a mask to identify cells that were floating at the start of the time step (before transport) - ! or are floating now (after transport). These are cells to which - ! Compute the flotation thickness - where (topg < 0.0d0) - thck_flotation = -(rhoo/rhoi)*topg + where (topg - eus < 0.0d0) + thck_flotation = -(rhoo/rhoi) * (topg - eus) elsewhere thck_flotation = 0.0d0 endwhere - ! Compute a mask of floating cells where bmlt_float_inversion can potentially be computed. - ! The rule is that bmlt_float_inversion can be applied to any grid cell that is afloat either - ! before or after transport, with the exception of ice-free cells (with thck = 0) and land-based cells. + ! Compute the ocean cavity thickness beneath floating ice (diagnostic only) + where (floating_mask == 1) + thck_cavity = -(topg - eus) - (rhoi/rhoo)*thck + elsewhere + thck_cavity = 0.0d0 + endwhere + + ! Compute a mask of cells where bmlt_float_inversion can potentially be applied. + ! The rule is that bmlt_float_inversion can be applied to any marine-based cell with ice. + ! This means that some marine-based grounded cells will have nonzero basal melting/freezing rates. + ! This is not physically realistic, but it helps prevent rapid, irreversible ice growth + ! in forward runs when floating cells ground. ! Note: The land mask is probably not needed, since land cells are excluded from the inversion. ! But this mask is included for generality, in case of dynamic topography. bmlt_inversion_mask(:,:) = 0.0d0 + basal_melt%bmlt_float_inversion(:,:) = 0.0d0 thck_final(:,:) = 0.0d0 - do j = 2, ny-1 - do i = 2, nx-1 + do j = 1, ny + do i = 1, nx if (land_mask(i,j) == 1) then ! do nothing; bmlt_float_inversion = 0 - elseif ( ice_mask(i,j) == 1 .and. & - (basal_melt%floating_mask_start(i,j) == 1 .or. floating_mask(i,j) == 1) ) then + elseif (ice_mask(i,j) == 1) then bmlt_inversion_mask(i,j) = 1 - dthck = -basal_melt%bmlt_float_prescribed(i,j) * dt - thck_final(i,j) = min(thck(i,j) + dthck, thck_flotation(i,j) + bmlt_inversion_thck_over_flot) + basal_melt%bmlt_float_inversion(i,j) = basal_melt%bmlt_float_prescribed(i,j) - endif - enddo - enddo + ! Make sure the final thickness meets certain conditions: + ! (1) if bmlt_float_inversion < 0, then thck_final <= thck_flotation + thck_buffer + ! (unless this would require basal melting) + ! (2) thck_final >= 0 - call parallel_halo(bmlt_inversion_mask) - call parallel_halo(thck_final) + thck_final(i,j) = thck(i,j) + (acab(i,j) - bmlt(i,j) - basal_melt%bmlt_float_inversion(i,j)) * dt - ! Now compute bmlt_float_inversion based on the final thickness. + if (basal_melt%bmlt_float_inversion(i,j) < 0.0d0) then - basal_melt%bmlt_float_inversion(:,:) = 0.0d0 + if (thck_final(i,j) > thck_flotation(i,j) + bmlt_inversion_thck_buffer) then - do j = 1, ny - do i = 1, nx - if (bmlt_inversion_mask(i,j) == 1) then + ! limit bmlt_float_inversion so the ice does not ground too strongly + thck_final(i,j) = thck_flotation(i,j) + bmlt_inversion_thck_buffer + basal_melt%bmlt_float_inversion(i,j) = (thck(i,j) - thck_final(i,j))/dt + acab(i,j) - bmlt(i,j) - basal_melt%bmlt_float_inversion(i,j) = (thck(i,j) - thck_final(i,j)) / dt + ! but do not flip the sign of bmlt_float_inversion + if (basal_melt%bmlt_float_inversion(i,j) > 0.0d0) then + basal_melt%bmlt_float_inversion(i,j) = 0.0d0 + thck_final(i,j) = thck(i,j) + acab(i,j) - bmlt(i,j) ! diagnostic only + endif + + endif + + else ! bmlt_float_inversion > 0 + + if (thck_final(i,j) < 0.0d0) then + thck_final(i,j) = 0.0d0 + basal_melt%bmlt_float_inversion(i,j) = (thck(i,j) - thck_final(i,j))/dt + acab(i,j) - bmlt(i,j) + endif + + endif !WHL - debug if (verbose_inversion .and. this_rank == rtest .and. i==itest .and. j==jtest) then print*, ' ' print*, 'Prescribe bmlt_float_inversion: rank, i, j =', rtest, itest, jtest - print*, 'thck, mask, bmlt*dt:', thck(i,j), bmlt_inversion_mask(i,j), & + print*, 'thck, thck_final, bmlt_float_inversion*dt:', thck(i,j), thck_final(i,j), & basal_melt%bmlt_float_inversion(i,j)*dt endif - endif ! bmlt_inversion_mask = 1 - + endif ! masks enddo ! i enddo ! j @@ -984,10 +1062,10 @@ subroutine prescribe_bmlt_float(dt, & i = itest j = jtest print*, ' ' - print*, 'thck_final:' + print*, 'bmlt_float_prescribed (m/yr):' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck_final(i,j) + write(6,'(f10.3)',advance='no') basal_melt%bmlt_float_prescribed(i,j)*scyr enddo write(6,*) ' ' enddo @@ -1000,7 +1078,47 @@ subroutine prescribe_bmlt_float(dt, & write(6,*) ' ' enddo print*, ' ' - print*, 'prescribed bmlt_float (m/yr):' + print*, 'thck_flotation (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck_flotation(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'floating_mask:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(i10)',advance='no') floating_mask(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'thck_cavity (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck_cavity(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'thck (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'thck_final:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck_final(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'bmlt_float_inversion (m/yr):' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 write(6,'(f10.3)',advance='no') basal_melt%bmlt_float_inversion(i,j)*scyr diff --git a/libglissade/glissade_velo_higher.F90 b/libglissade/glissade_velo_higher.F90 index 0e86bb0c..45d52d03 100644 --- a/libglissade/glissade_velo_higher.F90 +++ b/libglissade/glissade_velo_higher.F90 @@ -2501,7 +2501,7 @@ subroutine glissade_velo_higher_solve(model, & if (beta_internal(i,j) > 0.0d0) then write(6,'(f10.3)',advance='no') log10(beta_internal(i,j)) else - write(6,'(f10.3)',advance='no') 0.0d0 + write(6,'(f10.3)',advance='no') -999.0d0 endif enddo write(6,*) ' ' From 562a07b7fc3e7b8898528cdbc5f3e56e86f29e10 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Wed, 25 Apr 2018 14:43:24 -0600 Subject: [PATCH 15/61] Compute flwa for all cells, including ice-free cells. Previously, the flow factor flwa was computed only for cells with ice (ice_mask = 1). Now, flwa is computed for all cells, including ice-free cells. This ensures that flwa has physically sensible values in ice-free cells at the ice margin, in case these values are needed when interpolating flwa to the staggered grid. This assumes that ice-free cells have a sensible default temperature such as the air temperature (artm), as is currently the case. --- libglissade/glissade.F90 | 1 - libglissade/glissade_therm.F90 | 77 +++++++++++++++++----------------- 2 files changed, 38 insertions(+), 40 deletions(-) diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index 02137532..198476b3 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -2141,7 +2141,6 @@ subroutine glissade_diagnostic_variable_solve(model) model%options%whichtemp, & model%numerics%stagsigma, & model%geometry%thck * thk0, & ! scale to m - ice_mask, & model%temper%temp(1:model%general%upn-1,:,:), & model%temper%flwa, & ! Pa^{-n} s^{-1} model%paramets%default_flwa / scyr, & ! scale to Pa^{-n} s^{-1} diff --git a/libglissade/glissade_therm.F90 b/libglissade/glissade_therm.F90 index ce93bbe7..fa24d90f 100644 --- a/libglissade/glissade_therm.F90 +++ b/libglissade/glissade_therm.F90 @@ -1999,10 +1999,13 @@ end subroutine glissade_interior_dissipation_first_order !======================================================================= + !TODO - For damage-based calving, try multiplying flwa by a damage factor, (1 - damage) + subroutine glissade_flow_factor(whichflwa, whichtemp, & stagsigma, & - thck, ice_mask, & - temp, flwa, & + thck, & + temp, & + flwa, & default_flwa, & flow_enhancement_factor, & flow_enhancement_factor_ssa, & @@ -2037,15 +2040,17 @@ subroutine glissade_flow_factor(whichflwa, whichtemp, & ! Note: The flwa, temp, and stagsigma arrays should have vertical dimension 1:upn-1. ! The temperatures at the upper surface (k=1) and bed (k=upn) are not included in the input array. +! Note: A flow factor is computed for all cells, including cells of zero thickness. +! Provided zero-thickness cells have a sensible default temperature (e.g., artm), +! the resulting flwa should be physically reasonable if used in any calculations. integer, intent(in) :: whichflwa !> which method of calculating A integer, intent(in) :: whichtemp !> which method of calculating temperature; !> include waterfrac in calculation if using enthalpy method real(dp),dimension(:), intent(in) :: stagsigma !> vertical coordinate at layer midpoints real(dp),dimension(:,:), intent(in) :: thck !> ice thickness (m) - integer, dimension(:,:), intent(in) :: ice_mask !> = 1 where ice is present (thck > thklim), else = 0 real(dp),dimension(:,:,:), intent(in) :: temp !> 3D temperature field (deg C) - real(dp),dimension(:,:,:), intent(inout) :: flwa !> output $A$, in units of Pa^{-n} s^{-1}, allow input for data option + real(dp),dimension(:,:,:), intent(inout) :: flwa !> output $A$, in units of Pa^{-n} s^{-1}, allow input for data option real(dp), intent(in) :: default_flwa !> Glen's A to use in isothermal case, Pa^{-n} s^{-1} real(dp), intent(in), optional :: flow_enhancement_factor !> flow enhancement factor in Arrhenius relationship real(dp), intent(in), optional :: flow_enhancement_factor_ssa !> flow enhancement factor for floating ice @@ -2132,58 +2137,52 @@ subroutine glissade_flow_factor(whichflwa, whichtemp, & do ns = 1,nsn do ew = 1,ewn - if (ice_mask(ew,ns) == 1) then - call glissade_pressure_melting_point_column (thck(ew,ns), stagsigma, pmptemp) + call glissade_pressure_melting_point_column (thck(ew,ns), stagsigma, pmptemp) - do up = 1, nlayers ! nlayers = upn - 1 + do up = 1, nlayers ! nlayers = upn - 1 - ! Calculate the corrected temperature - tempcor = min(0.0d0, temp(up,ew,ns) - pmptemp(up)) ! pmptemp < 0 - tempcor = max(-50.0d0, tempcor) + ! Calculate the corrected temperature + tempcor = min(0.0d0, temp(up,ew,ns) - pmptemp(up)) ! pmptemp < 0 + tempcor = max(-50.0d0, tempcor) - ! Calculate Glen's A (including flow enhancement factor) + ! Calculate Glen's A (including flow enhancement factor) - if (tempcor >= -10.d0) then - flwa(up,ew,ns) = enhancement_factor(ew,ns) * arrfact(1) * exp(arrfact(3)/(tempcor + trpt)) - else - flwa(up,ew,ns) = enhancement_factor(ew,ns) * arrfact(2) * exp(arrfact(4)/(tempcor + trpt)) - endif + if (tempcor >= -10.d0) then + flwa(up,ew,ns) = enhancement_factor(ew,ns) * arrfact(1) * exp(arrfact(3)/(tempcor + trpt)) + else + flwa(up,ew,ns) = enhancement_factor(ew,ns) * arrfact(2) * exp(arrfact(4)/(tempcor + trpt)) + endif - ! BDM added correction for a liquid water fraction - ! Using Greve and Blatter (2009) formulation for Glen's A flow rate factor: - ! A = A(theta_PMP) * (1 + 181.25 * waterfrac) - if (whichtemp == TEMP_ENTHALPY .and. present(waterfrac)) then - if (waterfrac(up,ew,ns) > 0.0d0) then - flwa(up,ew,ns) = flwa(up,ew,ns) * (1.d0 + flwa_waterfrac_enhance_factor * waterfrac(up,ew,ns)) - endif + ! BDM added correction for a liquid water fraction + ! Using Greve and Blatter (2009) formulation for Glen's A flow rate factor: + ! A = A(theta_PMP) * (1 + 181.25 * waterfrac) + if (whichtemp == TEMP_ENTHALPY .and. present(waterfrac)) then + if (waterfrac(up,ew,ns) > 0.0d0) then + flwa(up,ew,ns) = flwa(up,ew,ns) * (1.d0 + flwa_waterfrac_enhance_factor * waterfrac(up,ew,ns)) endif + endif + + enddo ! up - enddo ! up - end if ! ice_mask - end do ! ew - end do ! ns + end do ! ew + end do ! ns case(FLWA_PATERSON_BUDD_CONST_TEMP) - ! This is the Paterson and Budd relationship, but with the temperature held constant at -5 deg C - !WHL - If we are assuming a constant temperature of -5 deg C, then I think we should always use - ! the Arrhenius factors appropriate for a warm temperature (T > -10). - ! I changed the code accordingly by commenting out some lines below. + ! This is the Paterson and Budd relationship, but with the temperature held to a constant parameter. do ns = 1,nsn do ew = 1,ewn - if (ice_mask(ew,ns) == 1) then - ! Calculate Glen's A with a fixed temperature (including flow enhancement factor) + ! Calculate Glen's A with a fixed temperature (including flow enhancement factor) -!! if (const_temp >= -10.d0) then - flwa(:,ew,ns) = enhancement_factor(ew,ns) * arrfact(1) * exp(arrfact(3)/(const_temp + trpt)) -!! else -!! flwa(:,ew,ns) = enhancement_factor * arrfact(2) * exp(arrfact(4)/(const_temp + trpt)) -!! endif + if (const_temp >= -10.d0) then + flwa(:,ew,ns) = enhancement_factor(ew,ns) * arrfact(1) * exp(arrfact(3)/(const_temp + trpt)) + else + flwa(:,ew,ns) = enhancement_factor(ew,ns) * arrfact(2) * exp(arrfact(4)/(const_temp + trpt)) + endif - end if end do end do From 2ff4be393df90f05067bb6d519a59f06e9a37516 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Wed, 25 Apr 2018 14:52:21 -0600 Subject: [PATCH 16/61] Changed overburden calculation for thin ice Overburden pressure is now initialized as rhoi*g*H for all cells, including cells with thck < thklim. This ensures a smooth change in effective pressure when ice grows past the thklim threshold. --- libglissade/glissade_basal_traction.F90 | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/libglissade/glissade_basal_traction.F90 b/libglissade/glissade_basal_traction.F90 index 8eaf7c30..13eacd66 100644 --- a/libglissade/glissade_basal_traction.F90 +++ b/libglissade/glissade_basal_traction.F90 @@ -743,11 +743,7 @@ subroutine calc_effective_pressure (which_effecpress, & ! Initialize the effective pressure N to the overburden pressure, rhoi*g*H - where (ice_mask == 1) ! active ice, thck > thklim - overburden = rhoi*grav*thck - elsewhere - overburden = 0.0d0 - endwhere + overburden(:,:) = rhoi*grav*thck(:,:) select case(which_effecpress) From 0cadb41b7497ee99a18fe26cdaa4081058fbd515 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Wed, 25 Apr 2018 15:01:26 -0600 Subject: [PATCH 17/61] Changed f_flotation calculation for ice-free land cells This commit changes the way f_flotation is computed and extrapolated for ice-free land, when using the linear flotation function (which_ho_flotation_function = 2) for the GLP. Recall that for the linear function, f_flotation is equal to the sub-shelf cavity depth for floating ice. With this commit, f_flotation is set to -(topg - eus) for ice-free land. (Previously it was set to a large negative value, -10000.) This gives a smooth change in f_flotation when thin ice crosses the thklim threshold and activates. It also gives a more accurate interpolation to vertices that have both ice-covered floating neighbors and ice-free land neighbors. When f_flotation is extrapolated, the ice-free land values are now treated as physically realistic, so only ice-free ocean cells require an extrapolated value. This commit is answer-changing for runs with a GLP. --- libglissade/glissade_grounding_line.F90 | 27 ++++++++++++++----------- 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/libglissade/glissade_grounding_line.F90 b/libglissade/glissade_grounding_line.F90 index a587eabd..93a6f18b 100644 --- a/libglissade/glissade_grounding_line.F90 +++ b/libglissade/glissade_grounding_line.F90 @@ -179,16 +179,17 @@ subroutine glissade_grounded_fraction(nx, ny, & !TODO - Test sensitivity to these values ! These are set to large negative values, so vertices with land-based neighbors are strongly grounded. real(dp), parameter :: f_flotation_land_pattyn = -10.d0 ! unitless - real(dp), parameter :: f_flotation_land_linear = -10000.d0 ! meters !---------------------------------------------------------------- - ! Compute ice mask at vertices (= 1 if any surrounding cells have ice) + ! Compute ice mask at vertices (= 1 if any surrounding cells have ice or are land) !---------------------------------------------------------------- do j = 1, ny-1 do i = 1, nx-1 - if (ice_mask(i,j+1)==1 .or. ice_mask(i+1,j+1)==1 .or. & - ice_mask(i,j) ==1 .or. ice_mask(i+1,j) ==1 ) then + if (ice_mask(i,j+1)==1 .or. ice_mask(i+1,j+1)==1 .or. & + ice_mask(i,j) ==1 .or. ice_mask(i+1,j) ==1 .or. & + land_mask(i,j+1)==1 .or. land_mask(i+1,j+1)==1 .or. & + land_mask(i,j) ==1 .or. land_mask(i+1,j+1)==1) then vmask(i,j) = 1 else vmask(i,j) = 0 @@ -245,7 +246,7 @@ subroutine glissade_grounded_fraction(nx, ny, & do j = 1, ny do i = 1, nx if (land_mask(i,j) == 1) then - f_flotation(i,j) = f_flotation_land_linear + f_flotation(i,j) = -(topg(i,j) - eus) elseif (ice_mask(i,j) == 1) then f_flotation(i,j) = -(topg(i,j) - eus) - (rhoi/rhoo)*thck(i,j) else ! ice-free ocean @@ -293,7 +294,7 @@ subroutine glissade_grounded_fraction(nx, ny, & case(HO_GROUND_ALL) - ! all vertices with ice-covered neighbors are assumed grounded, regardless of thck and topg + ! all vertices with ice-covered or land-based neighbors are assumed grounded, regardless of thck and topg do j = 1, ny-1 do i = 1, nx-1 @@ -305,25 +306,26 @@ subroutine glissade_grounded_fraction(nx, ny, & case(HO_GROUND_GLP) ! grounding-line parameterization - ! In ice-free cells, fill in f_flotation by extrapolation. + ! In ice-free ocean cells, fill in f_flotation by extrapolation. ! Take the minimum (i.e., most grounded) value from adjacent ice-filled neighbors, using ! edge neighbors (if possible) or corner neighbors (if there are no ice-filled edge neighbors). ! The reason for this fairly intricate calculation is to make sure that each vertex with vmask = 1 - ! (i.e., with at least one ice-filled neighbor cell) has physically sensible values + ! (i.e., with at least one ice-filled or land-based neighbor cell) has physically sensible values ! of f_flotation in all four neighbor cells, for purposes of interpolation. f_flotation_extrap(:,:) = f_flotation(:,:) do j = 2, ny-1 do i = 2, nx-1 - if (ice_mask(i,j) == 0) then + if (ice_mask(i,j) == 0 .and. land_mask(i,j) == 0) then filled = .false. ! loop over edge neighbors do jj = j-1, j+1 do ii = i-1, i+1 - if ((ii==i .or. jj==j) .and. ice_mask(ii,jj) == 1) then ! edge neighbor with ice + if ((ii == i .or. jj == j) .and. & + (ice_mask(ii,jj) == 1 .or. land_mask(ii,jj) == 1)) then ! edge neighbor with ice or land if (.not.filled) then filled = .true. f_flotation_extrap(i,j) = f_flotation(ii,jj) @@ -338,7 +340,8 @@ subroutine glissade_grounded_fraction(nx, ny, & if (.not.filled) then do jj = j-1, j+1 do ii = i-1, i+1 - if ((abs(ii-i)==1 .and. abs(jj-j)==1) .and. ice_mask(ii,jj)==1) then ! corner neighbor with ice + if ((abs(ii-i) == 1 .and. abs(jj-j) == 1) .and. & + (ice_mask(ii,jj) == 1 .or. land_mask(ii,jj) == 1)) then ! corner neighbor with ice or land if (.not.filled) then filled = .true. f_flotation_extrap(i,j) = f_flotation(ii,jj) @@ -393,7 +396,7 @@ subroutine glissade_grounded_fraction(nx, ny, & do j = 1, ny-1 do i = 1, nx-1 - if (vmask(i,j) == 1) then ! ice is present in at least one neighboring cell + if (vmask(i,j) == 1) then ! at least one neighboring cell is ice-covered or land-based ! First count the number of floating cells surrounding this vertex From d95cccb3686a804b01d547a5d47c8ea47dbb8099 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Thu, 26 Apr 2018 10:27:23 -0600 Subject: [PATCH 18/61] Require f_flotation < 0 for land cells For land cells, the flotation function is given by -(topg - eus), where usually eus = 0. This is problematic for cells with topg = 0. These are defined to be land cells, but the f_ground computation can yield NaNs when f_flotation = 0 in adjacent land cells. With this commit, the value of (topg - eus) used in evaluating f_flotation is limited to be >= 1 m. This give f_flotation < 0 for all land cells and fixes NaNs. --- libglissade/glissade_grounding_line.F90 | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/libglissade/glissade_grounding_line.F90 b/libglissade/glissade_grounding_line.F90 index 93a6f18b..9983f218 100644 --- a/libglissade/glissade_grounding_line.F90 +++ b/libglissade/glissade_grounding_line.F90 @@ -151,6 +151,7 @@ subroutine glissade_grounded_fraction(nx, ny, & real(dp) :: f1, f2, f3, f4 ! f_flotation at different cell centers real(dp) :: & + topg_eus_diff, &! topg - eus, limited to be >= f_flotation_land_topg_min var, &! combination of f_flotation terms that determines regions to be integrated f_flotation_vertex ! f_flotation interpolated to vertex @@ -171,6 +172,9 @@ subroutine glissade_grounded_fraction(nx, ny, & logical :: adjacent ! true if two grounded vertices are adjacent (rather than opposite) + real(dp), parameter :: & + f_flotation_land_topg_min = 1.0d0 ! min value of (topg - eus) in f_flotation expression for land cells (m) + real(dp), parameter :: & eps06 = 1.d-06 ! small number @@ -246,7 +250,9 @@ subroutine glissade_grounded_fraction(nx, ny, & do j = 1, ny do i = 1, nx if (land_mask(i,j) == 1) then - f_flotation(i,j) = -(topg(i,j) - eus) + ! Assign a minimum value to (topg - eus) so that f_flotation is nonzero on land + topg_eus_diff = max((topg(i,j) - eus), f_flotation_land_topg_min) + f_flotation(i,j) = -topg_eus_diff elseif (ice_mask(i,j) == 1) then f_flotation(i,j) = -(topg(i,j) - eus) - (rhoi/rhoo)*thck(i,j) else ! ice-free ocean @@ -510,9 +516,10 @@ subroutine glissade_grounded_fraction(nx, ny, & ! = a^2 / (2bc) ! ! Note: We cannot have bc = 0, because f_flotation varies in both x and y - ! The above rotations ensure that we always take the log of a positive number - - if (abs(a*d/(b*c)) > eps06) then + ! The above rotations ensure that we always take the log of a positive number. + ! Note: This expression will give a NaN if f_flotation = 0 for land cells. + ! Thus, f_flotation must be < 0 for land, even if topg - eus = 0. + if (abs((a*d)/(b*c)) > eps06) then f_corner = ((b*c - a*d) * log(abs(1.d0 - (a*d)/(b*c))) + a*d) / (d*d) else f_corner = (a*a) / (2.d0*b*c) From 89f6875145be87eaf2e7a26f202cebbc7740db33 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Wed, 25 Apr 2018 16:46:45 -0600 Subject: [PATCH 19/61] Modified hybrid gradient margin for ice-covered land over ice-free ocean This commit modifies the hybrid gradient_margin option (which_ho_gradient_margin = 1), hopefully for the last time before the CISM2.1 release. Consider an edge where an ice-covered land cell sits above an ice-free ocean cell. Previously, the gradient was set to zero at these edges; i.e., the boundary was treated as a vertical ice cliff. But it seems more realistic to treat such edges like other land margins. With this commit, edges with ice-covered land above ice-free ocean have nonzero gradients. I also added some gradient diagnostics, and made the input mask optional for subroutine glissade_vertical_average. This commit is BFB for standard LIVV tests. Note: I initially added a staggered_parallel_halo update in glissade_stagger, but this halo update breaks the gradient subroutine for problems with nonzero parallel_offset_ew (including the ISMIP-HOM and stream problems). So I took out the halo update and added a note explaining why it isn't there. This commit is answer-changing for Greenland simulations where we can have ice-covered land above ice-free ocean in fjord regions with steep topography. --- libglissade/glissade_grid_operators.F90 | 126 +++++++++++++++++------- libglissade/glissade_velo_higher.F90 | 4 +- 2 files changed, 92 insertions(+), 38 deletions(-) diff --git a/libglissade/glissade_grid_operators.F90 b/libglissade/glissade_grid_operators.F90 index 9d57fbe7..dbd441c3 100644 --- a/libglissade/glissade_grid_operators.F90 +++ b/libglissade/glissade_grid_operators.F90 @@ -61,6 +61,9 @@ subroutine glissade_stagger(nx, ny, & var, stagvar, & ice_mask, stagger_margin_in) + !TODO - Make the mask optional, and drop the stagger_margin_in argument? + ! Then the mask says where to ignore values when interpolating. + !---------------------------------------------------------------- ! Given a variable on the unstaggered grid (dimension nx, ny), interpolate ! to find values on the staggered grid (dimension nx-1, ny-1). @@ -135,6 +138,13 @@ subroutine glissade_stagger(nx, ny, & endif + ! Note: In most cases it would be safe here to do a staggered parallel halo update of stagvar. + ! However, if running a problem with nonzero periodic_offset_ew/ns (e.g., the ISMIP-HOM and stream cases), + ! a halo update would copy incorrect values to vertices on the west and south boundaries + ! of the global domain. So there is no halo update here. + ! To ensure correct halo values, the user should either pass in a 'var' field that has already + ! been updated in halo cells, or do a halo update of 'stagvar' upon return. + end subroutine glissade_stagger !---------------------------------------------------------------------------- @@ -632,6 +642,8 @@ subroutine glissade_edgemask_gradient_margin_hybrid(nx, ny, & !---------------------------------------------------------------- ! Compute edge masks required for option gradient_margin = HO_GRADIENT_MARGIN_HYBRID + ! Called from subroutine glissade_gradient_at_edges. + ! TODO: Make consistent with glissade_surface_elevation_gradient? ! ! The mask is set to true at all edges where either ! (1) Both adjacent cells are ice-covered. @@ -645,6 +657,11 @@ subroutine glissade_edgemask_gradient_margin_hybrid(nx, ny, & ! This method aims to give a reasonable gradient at both land-terminating and marine-terminating margins. ! At land-terminating margins the gradient is nonzero (except for nunataks), and at marine-terminating ! margins the gradient is zero. + ! + ! TODO: Update this subroutine to be consistent with the logic in glissade_surface_elevation_gradient. + ! I.e., add the case of ice-covered land over ice-free ocean, and incorporate thck_gradient_ramp. + ! For now, this subroutine is used only by the glissade SIA solver (which is not run with marine + ! boundaries) and the L1L2 solver (which is no longer supported), so the differences should not matter. !---------------------------------------------------------------- !---------------------------------------------------------------- @@ -719,15 +736,16 @@ end subroutine glissade_edgemask_gradient_margin_hybrid !**************************************************************************** - subroutine glissade_surface_elevation_gradient(nx, ny, & - dx, dy, & + subroutine glissade_surface_elevation_gradient(nx, ny, & + dx, dy, & + itest, jtest, rtest, & active_ice_mask, & land_mask, & - usrf, thck, & - topg, eus, & + usrf, thck, & + topg, eus, & thklim, & thck_gradient_ramp, & - ds_dx, ds_dy, & + ds_dx, ds_dy, & ho_gradient, & ho_gradient_margin, & max_slope) @@ -748,10 +766,11 @@ subroutine glissade_surface_elevation_gradient(nx, ny, & ! ! HO_GRADIENT_MARGIN_HYBRID = 1: The gradient is computed at edges where either ! (1) Both adjacent cells are ice-covered. - ! (2) One cell is ice-covered and lies above ice-free land. + ! (2) One cell is ice-covered (land or marine-based) and lies above ice-free land. + ! (3) One cell is ice-covered land and lies above ice-free ocean. ! ! This method sets the gradient to zero at edges where - ! (1) An ice-covered cell (grounded or floating) lies above ice-free ocean. + ! (1) An ice-covered marine-based cell (grounded or floating) lies above ice-free ocean. ! Note: Inactive calving-front cells are treated as ice-free ocean. ! (2) An ice-covered land cell lies below an ice-free land cell (i.e., a nunatak). ! @@ -789,6 +808,9 @@ subroutine glissade_surface_elevation_gradient(nx, ny, & real(dp), intent(in) :: & dx, dy ! horizontal grid size + integer, intent(in) :: & + itest, jtest, rtest ! coordinates of diagnostic point + integer, dimension(nx,ny), intent(in) :: & active_ice_mask, & ! = 1 where active ice is present, else = 0 land_mask ! = 1 for land cells, else = 0 @@ -834,12 +856,6 @@ subroutine glissade_surface_elevation_gradient(nx, ny, & real(dp) :: sum1, sum2 ! temporary sums - !WHL - debug - real(dp) :: alpha - - real(dp) :: ds_dx_up, ds_dy_up - real(dp) :: ds_dx_ctr, ds_dy_ctr - ! initialize ds_dx_edge(:,:) = 0.0d0 @@ -919,6 +935,11 @@ subroutine glissade_surface_elevation_gradient(nx, ny, & ! upper cell has active ice, and ice-free lower cell is land; compute the gradient ds_dx_edge(i,j) = edge_factor * sign_factor * (usrf(iu,j) - usrf(il,j)) / dx + elseif (active_ice_mask(iu,j) == 1 .and. land_mask(iu,j) == 1 .and. land_mask(il,j) == 0) then + + ! upper cell has active ice on land, and ice-free lower cell is ocean; compute the gradient + ds_dx_edge(i,j) = edge_factor * sign_factor * (usrf(iu,j) - usrf(il,j)) / dx + endif ! both cells have ice enddo ! i @@ -959,6 +980,11 @@ subroutine glissade_surface_elevation_gradient(nx, ny, & ! upper cell has active ice, and ice-free lower cell is land; compute the gradient ds_dy_edge(i,j) = edge_factor * sign_factor * (usrf(i,ju) - usrf(i,jl)) / dy + elseif (active_ice_mask(i,ju) == 1 .and. land_mask(i,ju) == 1 .and. land_mask(i,jl) == 0) then + + ! upper cell has active ice on land, and ice-free lower cell is ocean; compute the gradient + ds_dy_edge(i,j) = edge_factor * sign_factor * (usrf(i,ju) - usrf(i,jl)) / dy + endif ! both cells have ice enddo ! i @@ -1113,24 +1139,41 @@ subroutine glissade_surface_elevation_gradient(nx, ny, & call staggered_parallel_halo(ds_dx) call staggered_parallel_halo(ds_dy) - if (verbose_gradient .and. main_task) then + if (verbose_gradient .and. this_rank==rtest) then + print*, ' ' + print*, 'Hybrid gradient, i, j, task =', itest, jtest, rtest + print*, ' ' + print*, 'ds_dx_edge:' + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = itest-3, itest+3 + write(6,'(f9.6)',advance='no') ds_dx_edge(i,j) + enddo + print*, ' ' + enddo print*, ' ' - print*, 'Hybrid gradient:' + print*, 'ds_dy_edge:' + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = itest-3, itest+3 + write(6,'(f9.6)',advance='no') ds_dy_edge(i,j) + enddo + print*, ' ' + enddo print*, ' ' print*, 'ds_dx:' - do j = ny-2, 2, -1 -!! do i = 1, nx-1 - do i = 1, nx/2 + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = itest-3, itest+3 write(6,'(f9.6)',advance='no') ds_dx(i,j) enddo print*, ' ' enddo - print*, ' ' print*, 'ds_dy:' - do j = ny-2, 2, -1 -!! do i = 1, nx-1 - do i = 1, nx/2 + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = itest-3, itest+3 write(6,'(f9.6)',advance='no') ds_dy(i,j) enddo print*, ' ' @@ -1143,15 +1186,13 @@ end subroutine glissade_surface_elevation_gradient subroutine glissade_vertical_average(nx, ny, & nz, sigma, & - mask, & - var, var_2d) + var, var_2d, & + mask) !---------------------------------------------------------------- ! Compute the vertical average of a given variable. ! Note: It is assumed that the variable is defined at layer midpoints, ! and hence has vertical dimension (nz-1). - ! Note: This subroutine will work for variables on the staggered - ! horizontal grid if stagthck is passed in place of thck. !---------------------------------------------------------------- !---------------------------------------------------------------- @@ -1165,34 +1206,47 @@ subroutine glissade_vertical_average(nx, ny, & real(dp), dimension(nz), intent(in) :: & sigma ! sigma vertical coordinate - logical, dimension(nx, ny), intent(in) :: & - mask ! compute var_2d where mask = .true. - real(dp), dimension(nz-1,nx, ny), intent(in) :: & var ! 3D field to be averaged vertically real(dp), dimension(nx, ny), intent(out) :: & var_2d ! 2D vertically averaged field + logical, dimension(nx, ny), intent(in), optional :: & + mask ! compute var_2d where mask = .true. + + !-------------------------------------------------------- ! Local variables !-------------------------------------------------------- integer :: i, j, k - do j = 1, ny - do i = 1, nx + if (present(mask)) then + + do j = 1, ny + do i = 1, nx + var_2d(i,j) = 0.d0 + if (mask(i,j)) then + do k = 1, nz-1 + var_2d(i,j) = var_2d(i,j) + var(k,i,j) * (sigma(k+1) - sigma(k)) + enddo + endif + enddo + enddo - var_2d(i,j) = 0.d0 + else - if (mask(i,j)) then + do j = 1, ny + do i = 1, nx + var_2d(i,j) = 0.d0 do k = 1, nz-1 var_2d(i,j) = var_2d(i,j) + var(k,i,j) * (sigma(k+1) - sigma(k)) enddo - endif - + enddo enddo - enddo + + endif ! present(mask) end subroutine glissade_vertical_average diff --git a/libglissade/glissade_velo_higher.F90 b/libglissade/glissade_velo_higher.F90 index 45d52d03..8a17422c 100644 --- a/libglissade/glissade_velo_higher.F90 +++ b/libglissade/glissade_velo_higher.F90 @@ -1547,6 +1547,7 @@ subroutine glissade_velo_higher_solve(model, & call glissade_surface_elevation_gradient(nx, ny, & dx, dy, & + itest, jtest, rtest, & active_ice_mask, & land_mask, & usrf, thck, & @@ -5321,7 +5322,6 @@ subroutine assemble_stiffness_matrix_2d(nx, ny, & if (whichapprox == HO_APPROX_SSA) then call glissade_vertical_average(nx, ny, & nz, sigma, & - active_cell, & flwafact, flwafact_2d) endif @@ -6129,7 +6129,7 @@ subroutine compute_3d_velocity_L1L2(nx, ny, & ! are ice-covered. ! At a land margin, either 0 or 1 is appropriate, but 2 is inaccurate. ! At a shelf margin, either 1 or 2 is appropriate, but 0 is inaccurate. - ! So HO_GRADIENT_MARGIN_NYBRID = 1 is the safest value. + ! So HO_GRADIENT_MARGIN_HYBRID = 1 is the safest value. if (edge_velocity) then From 2b9a5fdd18fca898b99adba878914e4b59bfbde6 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Thu, 26 Apr 2018 10:44:53 -0600 Subject: [PATCH 20/61] Basal traction changes for inversion This commit adds the option to invert for powerlaw_c when doing powerlaw sliding (which_ho_babc = 9). Until now, basal inversion was used exclusively with Schoof sliding (which_ho_babc = 11). Also, I modified the staggering of powerlaw_c_inversion to include ice-free land cells (and not just ice-covered cells) when doing the staggering. I removed the stag_coulomb_c_inversion field, which is no longer used in Schoof sliding (since coulomb_c is taken to be a constant). --- libglissade/glissade_basal_traction.F90 | 121 ++++++++++++++++-------- 1 file changed, 83 insertions(+), 38 deletions(-) diff --git a/libglissade/glissade_basal_traction.F90 b/libglissade/glissade_basal_traction.F90 index 13eacd66..d8fdb593 100644 --- a/libglissade/glissade_basal_traction.F90 +++ b/libglissade/glissade_basal_traction.F90 @@ -75,6 +75,7 @@ subroutine calcbeta (whichbabc, & topg, eus, & ice_mask, & floating_mask, & + land_mask, & f_ground, & which_ho_inversion, & itest, jtest, rtest) @@ -117,8 +118,12 @@ subroutine calcbeta (whichbabc, & !TODO - Make these argument non-optional? Can do this after removing the call to calcbeta from Glam. real(dp), intent(in), dimension(:,:), optional :: topg ! bed topography (m) real(dp), intent(in), optional :: eus ! eustatic sea level (m) relative to z = 0 - integer, intent(in), dimension(:,:), optional :: ice_mask ! = 1 where ice is present (thck > thklim), else = 0 - integer, intent(in), dimension(:,:), optional :: floating_mask ! = 1 where ice is present and floating, else = 0 + + integer, intent(in), dimension(:,:), optional :: & + ice_mask, & ! = 1 where ice is present (thck > thklim), else = 0 + floating_mask, & ! = 1 where ice is present and floating, else = 0 + land_mask ! = 1 where topg > eus + real(dp), intent(in), dimension(:,:), optional :: f_ground ! grounded ice fraction, 0 <= f_ground <= 1 integer, intent(in), optional :: which_ho_inversion ! basal inversion option integer, intent(in), optional :: itest, jtest, rtest ! coordinates of diagnostic point @@ -144,13 +149,13 @@ subroutine calcbeta (whichbabc, & real(dp) :: m_max ! maximum bed obstacle slope (unitless) real(dp) :: m ! exponent m in power law integer, dimension(size(thck,1), size(thck,2)) :: & - imask, & ! = 1 where thck > 0, else = 1 - grounded_mask ! = 1 where ice is present (thck > thklim) and not floating + ice_or_land_mask, &! = 1 where ice_mask = 1 or land_mask = 1, else = 0 + imask ! = 1 where thck > 0, else = 1 + real(dp), dimension(size(beta,1), size(beta,2)) :: & big_lambda, & ! bedrock characteristics flwa_basal_stag, & ! basal flwa interpolated to the staggered grid (Pa^{-n} yr^{-1}) - stag_powerlaw_c_inversion, & ! powerlaw_c_inversion interpolated to the staggered grid - stag_coulomb_c_inversion ! coulomb_c_inversion interpolated to the staggered grid + stag_powerlaw_c_inversion ! powerlaw_c_inversion interpolated to the staggered grid ! variables for Tsai et al. parameterization real(dp) :: taub_powerlaw ! basal shear stress given by a power law as in Tsai et al. (2015) @@ -257,9 +262,12 @@ subroutine calcbeta (whichbabc, & beta(ew,ns) = tau_c / (u0**q * speed(ew,ns)**(1.0d0 - q)) !WHL - debug -! if (ew==itest .and. ns==jtest) then -! write(6,*) 'i, j, bed, phi, tanphi, tau_c, speed, beta:', ew, ns, bed, phi, tanphi, tau_c, speed(ew,ns), beta(ew,ns) -! endif + if (verbose_beta .and. present(rtest) .and. present(itest) .and. present(jtest)) then + if (this_rank == rtest .and. ew == itest .and. ns == jtest) then + write(6,*) 'i, j, bed, phi, tanphi, tau_c, speed, beta:', & + ew, ns, bed, phi, tanphi, tau_c, speed(ew,ns), beta(ew,ns) + endif + endif enddo enddo @@ -313,7 +321,7 @@ subroutine calcbeta (whichbabc, & Ldomain = global_ewn * dew ! size of full domain (must be square) omega = 2.d0*pi / Ldomain - beta_global(:,:) = 0.d0 + beta_global(:,:) = 0.0d0 do ns = 1, global_nsn do ew = 1, global_ewn dx = dew * ew @@ -366,7 +374,47 @@ subroutine calcbeta (whichbabc, & ! implying beta = C * ub^(1/m - 1) ! m should be a positive exponent - beta(:,:) = basal_physics%powerlaw_c * speed(:,:)**(1.0d0/basal_physics%powerlaw_m - 1.0d0) + if (which_ho_inversion == HO_INVERSION_NONE) then + + ! Set beta assuming a spatially uniform value of powerlaw_c + beta(:,:) = basal_physics%powerlaw_c * speed(:,:)**(1.0d0/basal_physics%powerlaw_m - 1.0d0) + + elseif (which_inversion == HO_INVERSION_COMPUTE .or. & + which_inversion == HO_INVERSION_PRESCRIBED) then ! use powerlaw_c from inversion + + m = basal_physics%powerlaw_m + + ! Interpolate powerlaw_c to the velocity grid. + + ! stagger_margin_in = 1: Interpolate using only the values in ice-covered cells. + + call glissade_stagger(ewn, nsn, & + basal_physics%powerlaw_c_inversion, & + stag_powerlaw_c_inversion, & + ice_mask, & + stagger_margin_in = 1) + + ! Replace zeroes with default values to avoid divzero issues + where (stag_powerlaw_c_inversion == 0.0d0) + stag_powerlaw_c_inversion = basal_physics%powerlaw_c + endwhere + + do ns = 1, nsn-1 + do ew = 1, ewn-1 + beta(ew,ns) = stag_powerlaw_c_inversion(ew,ns) & + * speed(ew,ns)**(1.0d0/basal_physics%powerlaw_m - 1.0d0) + + !WHL - debug + if (verbose_beta .and. present(rtest) .and. present(itest) .and. present(jtest)) then + if (this_rank == rtest .and. ew == itest .and. ns == jtest) then + write(6,*) 'r, i, j, Cp, speed, beta:', & + rtest, itest, jtest, stag_powerlaw_c_inversion(ew,ns), speed(ew,ns), beta(ew,ns) + endif + endif + enddo + enddo + + endif ! which_ho_inversion case(HO_BABC_POWERLAW_EFFECPRESS) ! a power law that uses effective pressure !TODO - Remove POWERLAW_EFFECPRESS option? Rarely if ever used. @@ -466,7 +514,6 @@ subroutine calcbeta (whichbabc, & denominator = ( powerlaw_c**m * speed(ew,ns) + & (coulomb_c * basal_physics%effecpress_stag(ew,ns))**m )**(1.d0/m) beta(ew,ns) = (numerator/denominator) * speed(ew,ns)**(1.d0/m - 1.d0) - enddo enddo @@ -475,54 +522,43 @@ subroutine calcbeta (whichbabc, & m = basal_physics%powerlaw_m - ! Interpolate powerlaw_c and coulomb_c to the velocity grid. - ! stagger_margin_in = 1: Interpolate using only the values in cells with grounded ice. - ! Zero values in floating and ice-free cells are ignored. + ! stagger_margin_in = 1: Interpolate using only the values in ice-covered and land-based cells. - where (ice_mask == 1 .and. floating_mask == 0) - grounded_mask = 1 + where (ice_mask == 1 .or. land_mask == 1) + ice_or_land_mask = 1 elsewhere - grounded_mask = 0 + ice_or_land_mask = 0 endwhere call glissade_stagger(ewn, nsn, & basal_physics%powerlaw_c_inversion, & stag_powerlaw_c_inversion, & - grounded_mask, & + ice_or_land_mask, & stagger_margin_in = 1) - call glissade_stagger(ewn, nsn, & - basal_physics%coulomb_c_inversion, & - stag_coulomb_c_inversion, & - grounded_mask, & - stagger_margin_in = 1) - - ! Replace zeroes with default values to avoid divzero issues + ! Replace zeroes with default values to avoid possible divzero where (stag_powerlaw_c_inversion == 0.0d0) stag_powerlaw_c_inversion = basal_physics%powerlaw_c endwhere - where (stag_coulomb_c_inversion == 0.0d0) - stag_coulomb_c_inversion = basal_physics%coulomb_c - endwhere - do ns = 1, nsn-1 do ew = 1, ewn-1 - numerator = stag_powerlaw_c_inversion(ew,ns) * stag_coulomb_c_inversion(ew,ns) & + numerator = stag_powerlaw_c_inversion(ew,ns) * basal_physics%coulomb_c & * basal_physics%effecpress_stag(ew,ns) denominator = ( stag_powerlaw_c_inversion(ew,ns)**m * speed(ew,ns) + & - (stag_coulomb_c_inversion(ew,ns) * basal_physics%effecpress_stag(ew,ns))**m )**(1.d0/m) - + (basal_physics%coulomb_c * basal_physics%effecpress_stag(ew,ns))**m )**(1.d0/m) beta(ew,ns) = (numerator/denominator) * speed(ew,ns)**(1.d0/m - 1.d0) !WHL - debug if (verbose_beta .and. present(rtest) .and. present(itest) .and. present(jtest)) then if (this_rank == rtest .and. ew == itest .and. ns == jtest) then - write(6,*) 'r, i, j, denom_u, denom_N, speed, beta, taub:', & - rtest, itest, jtest, & +!! if (this_rank == rtest .and. ew == itest-1 .and. ns == jtest) then + print*, ' ' + write(6,*) 'r, i, j, Cp, denom_u, denom_N, speed, beta, taub:', & + rtest, ew, ns, stag_powerlaw_c_inversion(ew,ns), & (stag_powerlaw_c_inversion(ew,ns)**m * speed(ew,ns))**(1.d0/m), & - stag_coulomb_c_inversion(ew,ns) * basal_physics%effecpress_stag(ew,ns), & + (basal_physics%coulomb_c * basal_physics%effecpress_stag(ew,ns)), & speed(ew,ns), beta(ew,ns), beta(ew,ns)*speed(ew,ns) endif endif @@ -637,7 +673,6 @@ subroutine calcbeta (whichbabc, & ! However, beta_grounded_min can be set to a nonzero value in the config file. if (present(f_ground)) then - do ns = 1, nsn-1 do ew = 1, ewn-1 if (f_ground(ew,ns) > 0.d0 .and. beta(ew,ns) < basal_physics%beta_grounded_min) then @@ -645,7 +680,6 @@ subroutine calcbeta (whichbabc, & endif enddo enddo - endif ! present(f_ground) ! Bug check: Make sure beta >= 0 @@ -666,6 +700,16 @@ subroutine calcbeta (whichbabc, & ! halo update call staggered_parallel_halo(beta) + !WHL - debug + if (verbose_beta .and. present(rtest) .and. present(itest) .and. present(jtest)) then + if (this_rank == rtest) then + ew = itest; ns = jtest +!! ew = itest-1; ns = jtest + write(6,*) 'End of calcbeta, r, i, j, speed, beta:', & + rtest, ew, ns, speed(ew,ns), beta(ew,ns) + endif + endif + end subroutine calcbeta !*********************************************************************** @@ -908,6 +952,7 @@ subroutine calc_effective_pressure (which_effecpress, & ! Interpolate the effective pressure to the staggered grid. ! stagger_margin_in = 0: Interpolate using values in all cells, including ice-free cells ! (to give a smooth transition in N_stag as a cell switches from ice-free to ice-covered) + !TODO - Does ice_mask need to be passed in? Modify glissade_stagger so it can be called without a mask. call glissade_stagger(ewn, nsn, & basal_physics%effecpress, basal_physics%effecpress_stag, & From 67f1e782311e73315205e3c9bf5b68e6725d5211 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Thu, 26 Apr 2018 12:20:17 -0600 Subject: [PATCH 21/61] Modified lateral shelf BC for velocity solver This commit includes two changes related to lateral shelf BC: (1) The staggered thickness used at vertices is now computed by averaging only over active marine-based cells; land-based cells are excluded. It doesn't make sense to include land-based cells when the goal is to estimate ice thickness at marine margins. (2) A lateral spreading term is no longer computed at edges with a land-based cell adjacent to ice-free ocean. At these edges it is more appropriate to compute a surface elevation gradient as at other land margins. A previous commit (da9711b) ensures that these edges have a nonzero surface elevation gradient. Also tweaked some comments and diagnostics. This commit is BFB for standard LIVV tests including the shelf tests, because the shelf margins consist exclusively of marine-based cells. However, this commit can be answer-changing for Greenland fjords where land-based and marine-based margins are adjacent. --- libglissade/glissade_velo_higher.F90 | 256 +++++++++++++++++---------- 1 file changed, 163 insertions(+), 93 deletions(-) diff --git a/libglissade/glissade_velo_higher.F90 b/libglissade/glissade_velo_higher.F90 index 8a17422c..1305b502 100644 --- a/libglissade/glissade_velo_higher.F90 +++ b/libglissade/glissade_velo_higher.F90 @@ -805,8 +805,10 @@ subroutine glissade_velo_higher_solve(model, & real(dp), dimension(nx-1,ny-1) :: & xVertex, yVertex, & ! x and y coordinates of each vertex (m) - stagusrf, & ! upper surface averaged to vertices (m) - stagthck, & ! ice thickness averaged to vertices (m) + stagusrf, & ! upper surface averaged to vertices, for active cells (m) + stagthck, & ! ice thickness averaged to vertices, for active cells (m) + stagusrf_marine, & ! upper surface averaged to vertices, for active marine cells only (m) + stagthck_marine, & ! ice thickness averaged to vertices, for active marine cells only (m) dusrf_dx, dusrf_dy, & ! gradient of upper surface elevation (m/m) ubas, vbas ! basal ice velocity (m/yr); input to calcbeta @@ -816,7 +818,9 @@ subroutine glissade_velo_higher_solve(model, & ocean_mask, & ! = 1 for cells where topography is below sea level and ice is absent land_mask, & ! = 1 for cells where topography is above sea level calving_front_mask, & ! = 1 for floating cells that border at least one ocean cell - active_ice_mask ! = 1 for active cells (ice_mask = 1, excluding inactive calving_front cells) + active_ice_mask, & ! = 1 for active cells (ice_mask = 1, excluding inactive calving_front cells) + active_marine_mask, & ! = 1 for active marine-based cells + ice_plus_land_mask ! = 1 for active ice cells plus ice-free land cells real(dp), dimension(nx,ny) :: & thck_calving_front ! effective thickness of ice at the calving front @@ -1289,6 +1293,7 @@ subroutine glissade_velo_higher_solve(model, & umask_dirichlet(:,:,:) = 0 vmask_dirichlet(:,:,:) = 0 + ! Set the Dirichlet mask at the bed for no-slip BCs. if (whichbabc == HO_BABC_NO_SLIP .and. whichapprox /= HO_APPROX_DIVA) then ! Impose zero sliding everywhere at the bed ! Note: For the DIVA case, this BC is handled by setting beta_eff = 1/omega @@ -1461,13 +1466,13 @@ subroutine glissade_velo_higher_solve(model, & endif ! verbose_dirichlet !------------------------------------------------------------------------------ - ! Compute masks: + ! Compute masks for the velocity solver: ! (1) ice mask = 1 in cells where ice is present (thck > thklim) ! (2) floating mask = 1 in cells where ice is present (thck > thklim) and floating ! (3) ocean mask = = 1 in cells where topography is below sea level and ice is absent ! (4) land mask = 1 in cells where topography is at or above sea level - ! (5) calving_front_mask = 1 for floating cells that border at least one cell with ocean_mask = 1, else = 0 - ! (6) active_ice_mask = 1 for dynamically active cells, else = 0 + ! (5) active_ice_mask = 1 for dynamically active cells, else = 0 + ! (6) calving_front_mask = 1 for floating cells that border at least one cell with ocean_mask = 1, else = 0 ! With the subgrid calving front scheme, all cells with ice_mask = 1 are active, unless they lie on the ! calving front and have thck <= thck_calving_front. Here, thck_calving_front is the effective thickness ! defined by adjacent cells not on the calving front. @@ -1491,8 +1496,8 @@ subroutine glissade_velo_higher_solve(model, & thck_calving_front = thck_calving_front) !------------------------------------------------------------------------------ - ! Compute ice thickness and upper surface on staggered grid - ! (requires that thck and usrf are up to date in halo cells). + ! Compute the ice thickness and upper surface elevation on the staggered grid. + ! (requires that thck and usrf are up to date in all cells that border locally owned vertices). ! For stagger_margin_in = 0, all cells (including ice-free) are included in interpolation. ! For stagger_margin_in = 1, only ice-covered cells are included. !------------------------------------------------------------------------------ @@ -1509,8 +1514,57 @@ subroutine glissade_velo_higher_solve(model, & stagger_margin_in = 1) !pw call t_stopf('glissade_stagger') + ! Compute a subset of active_ice_mask, consisting of marine-based cells only + where (land_mask == 0 .and. active_ice_mask == 1) + active_marine_mask = 1 + elsewhere + active_marine_mask = 0 + endwhere + + ! Compute marine version of stagthck and stagusrf, used for lateral shelf BCs + + call glissade_stagger(nx, ny, & + thck, stagthck_marine, & + active_marine_mask, & + stagger_margin_in = 1) + + call glissade_stagger(nx, ny, & + usrf, stagusrf_marine, & + active_marine_mask, & + stagger_margin_in = 1) + + if (verbose_gridop .and. this_rank == rtest) then + print*, ' ' + print*, 'thck, itest, jtest, rank =', itest, jtest, rtest + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'stagthck, itest, jtest, rank =', itest, jtest, rtest + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') stagthck(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'stagthck_marine, itest, jtest, rank =', itest, jtest, rtest + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') stagthck_marine(i,j) + enddo + write(6,*) ' ' + enddo + endif + !------------------------------------------------------------------------------ - ! Compute surface gradient on staggered grid + ! Compute the surface elevation gradient on the staggered grid ! (requires that usrf is up to date in halo cells) ! ! Possible settings for whichgradient_margin: @@ -1520,10 +1574,12 @@ subroutine glissade_velo_higher_solve(model, & ! ! gradient_margin = 0 computes gradients at all edges, even if one cell ! if ice-free. This is what Glide does, but is not appropriate if we have ice-covered - ! floating cells lying above ice-free ocean cells, because the gradient is too big. - ! gradient_margin_in = 1 computes gradients at edges with ice-covered cells - ! above ice-free land, but not above ice-free ocean. This setting is appropriate - ! for both land- and ocean-terminating boundaries. It is the default. + ! marine-based cells lying above ice-free ocean cells, because the gradient is too big. + ! gradient_margin_in = 1 computes gradients at edges with + ! (1) ice-covered cells on either side, + ! (2) ice-covered cells (land or marine-based) above ice-free land, or + ! (3) ice-covered land cells above ice-free ocean. + ! This option is designed for both land- and ocean-terminating boundaries. It is the default. ! gradient_margin_in = 2 computes gradients only at edges with ice-covered cells ! on each side. This is appropriate for problems with ice shelves, but is ! is less accurate than options 0 or 1 for land-based problems (e.g., Halfar SIA). @@ -1545,16 +1601,16 @@ subroutine glissade_velo_higher_solve(model, & !pw call t_startf('glissade_gradient') - call glissade_surface_elevation_gradient(nx, ny, & - dx, dy, & + call glissade_surface_elevation_gradient(nx, ny, & + dx, dy, & itest, jtest, rtest, & active_ice_mask, & land_mask, & - usrf, thck, & - topg, eus, & + usrf, thck, & + topg, eus, & thklim, & thck_gradient_ramp, & - dusrf_dx, dusrf_dy, & + dusrf_dx, dusrf_dy, & whichgradient, & whichgradient_margin, & max_slope = max_slope) @@ -1901,6 +1957,10 @@ subroutine glissade_velo_higher_solve(model, & flwafact(:,:,:) = 0.d0 + ! Note: flwa is available in all cells, so flwafact can be computed in all cells. + ! This includes cells with thck < thklim, in case a value of flwa is needed + ! (e.g., inactive land-margin cells adjacent to active cells). + ! Loop over all cells that border locally owned vertices. ! This includes halo rows to the north and east. ! OK to skip cells outside the global domain. @@ -1908,13 +1968,23 @@ subroutine glissade_velo_higher_solve(model, & do j = 1+nhalo, ny-nhalo+1 do i = 1+nhalo, nx-nhalo+1 - if (active_cell(i,j)) then - ! gn = exponent in Glen's flow law (= 3 by default) - flwafact(:,i,j) = 0.5d0 * flwa(:,i,j)**(-1.d0/real(gn,dp)) - endif + ! gn = exponent in Glen's flow law (= 3 by default) + flwafact(:,i,j) = 0.5d0 * flwa(:,i,j)**(-1.d0/real(gn,dp)) enddo enddo + if (verbose_efvs .and. this_rank == rtest) then + print*, ' ' + print*, 'flwafact (k=1), itest, jtest, rank =', itest, jtest, rtest + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = itest-3, itest+3 + write(6,'(f10.0)',advance='no') flwafact(1,i,j) + enddo + write(6,*) ' ' + enddo + endif + !------------------------------------------------------------------------------ ! If using SLAP solver, then allocate space for the sparse matrix (A), rhs (b), ! answer (x), and residual vector (Ax-b). @@ -2023,8 +2093,8 @@ subroutine glissade_velo_higher_solve(model, & taudx(:,:) = taudx(:,:) * vol0/(dx*dy) ! convert from model units to Pa taudy(:,:) = taudy(:,:) * vol0/(dx*dy) - if (verbose_glp .and. this_rank==rtest) then - ! Note: The first of these quantities is the load vector on the rhs of the matrix + if (verbose_load .and. this_rank==rtest) then + ! Note: The first of these quantities is the load vector on the rhs of the matrix. ! The second is the value that would go on the rhs by simply taking rho*g*H*ds/dx. ! These will not agree exactly because of the way H is handled in FE assembly, ! but they should be close if which_ho_assemble_taud = HO_ASSEMBLE_TAUD_LOCAL. @@ -2068,11 +2138,11 @@ subroutine glissade_velo_higher_solve(model, & call load_vector_lateral_bc(nx, ny, & nz, sigma, & nhalo, & - floating_mask, ocean_mask, & + land_mask, ocean_mask, & calving_front_mask, & active_cell, & xVertex, yVertex, & - stagusrf, stagthck, & + stagusrf_marine, stagthck_marine, & loadu, loadv) call t_stopf('glissade_load_vector_lateral_bc') @@ -2104,7 +2174,7 @@ subroutine glissade_velo_higher_solve(model, & if (verbose_load .and. this_rank==rtest) then print*, ' ' - print*, 'loadu_2d (taudx only), itest, jtest, rank =', itest, jtest, rtest + print*, 'loadu_2d (taudx term only), itest, jtest, rank =', itest, jtest, rtest do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 @@ -2114,7 +2184,7 @@ subroutine glissade_velo_higher_solve(model, & enddo print*, ' ' - print*, 'loadv_2d (taudv only), itest, jtest, rank =', itest, jtest, rtest + print*, 'loadv_2d (taudy term only), itest, jtest, rank =', itest, jtest, rtest do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 @@ -2475,6 +2545,7 @@ subroutine glissade_velo_higher_solve(model, & topg, eus, & ice_mask, & floating_mask, & + land_mask, & f_ground, & whichinversion, & itest, jtest, rtest) @@ -2491,7 +2562,7 @@ subroutine glissade_velo_higher_solve(model, & endif !! if (verbose_beta .and. this_rank==rtest) then - if (verbose_beta .and. this_rank==rtest .and. counter > 1 .and. mod(counter-1,25)==0) then + if (verbose_beta .and. this_rank==rtest .and. counter > 1 .and. mod(counter-1,30)==0) then print*, ' ' print*, 'log(beta), itest, jtest, rank =', itest, jtest, rtest !! do j = ny-1, 1, -1 @@ -2765,11 +2836,9 @@ subroutine glissade_velo_higher_solve(model, & print*, 'vvel, btracty:', vvel_2d(i,j), btracty(i,j) print*, ' ' print*, 'beta_eff:' -!! do j = ny-1, 1, -1 -!! do i = 1, nx-1 - do j = jtest-5, jtest+5, -1 + do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(e10.3)',advance='no') beta_eff(i,j) + write(6,'(f10.0)',advance='no') beta_eff(i,j) enddo write(6,*) ' ' enddo @@ -4245,7 +4314,7 @@ subroutine get_vertex_geometry(nx, ny, & do j = staggered_jlo, staggered_jhi ! locally owned vertices only do i = staggered_ilo, staggered_ihi - if (active_vertex(i,j)) then ! all nodes in column are active + if (active_vertex(i,j)) then ! all nodes in ice column are active nVerticesSolve = nVerticesSolve + 1 vertexID(i,j) = nVerticesSolve ! unique local index for each vertex iVertexIndex(nVerticesSolve) = i @@ -4466,11 +4535,12 @@ end subroutine load_vector_gravity subroutine load_vector_lateral_bc(nx, ny, & nz, sigma, & nhalo, & - floating_mask, ocean_mask, & + land_mask, & + ocean_mask, & calving_front_mask, & active_cell, & xVertex, yVertex, & - stagusrf, stagthck, & + stagusrf_marine, stagthck_marine, & loadu, loadv) integer, intent(in) :: & @@ -4487,16 +4557,16 @@ subroutine load_vector_lateral_bc(nx, ny, & ! and is not an inactive calving_front cell integer, dimension(nx,ny), intent(in) :: & - floating_mask, &! = 1 if ice is present and is floating - calving_front_mask, &! = 1 if ice is floating and borders the ocean - ocean_mask ! = 1 if topography is below sea level and ice is absent + land_mask, & ! = 1 if topg >= eus + ocean_mask, & ! = 1 if topography is below sea level and ice is absent + calving_front_mask ! = 1 if ice is floating and borders the ocean real(dp), dimension(nx-1,ny-1), intent(in) :: & xVertex, yVertex ! x and y coordinates of vertices real(dp), dimension(nx-1,ny-1), intent(in) :: & - stagusrf, & ! upper surface elevation on staggered grid (m) - stagthck ! ice thickness on staggered grid (m) + stagusrf_marine, & ! upper surface elevation (m) on staggered grid, for marine-based cells only + stagthck_marine ! ice thickness (m) on staggered grid, for marine-based cells only real(dp), dimension(nz,nx-1,ny-1), intent(inout) :: & loadu, loadv ! load vector, divided into u and v components @@ -4519,7 +4589,6 @@ subroutine load_vector_lateral_bc(nx, ny, & if ((verbose_shelf .or. verbose_load) .and. i==itest .and. j==jtest .and. this_rank==rtest) then print*, 'i, j =', i, j - print*, 'floating_mask =', floating_mask(i,j) print*, 'ocean_mask (i-1:i,j) =', ocean_mask(i-1:i, j) print*, 'ocean_mask (i-1:i,j-1)=', ocean_mask(i-1:i, j-1) print*, 'calving_front_mask (i-1:i,j) =', calving_front_mask(i-1:i, j) @@ -4527,56 +4596,57 @@ subroutine load_vector_lateral_bc(nx, ny, & endif !WHL - Old method is to compute the spreading term only for active floating cells. - ! New method is to compute the spreading term for any cliff; i.e., any active cell that borders the ocean. + ! New method is to compute the spreading term for all active marine-based cells that border the ocean. + !! if (active_cell(i,j) .and. floating_mask(i,j) == 1) then ! ice is active and floating - if (active_cell(i,j)) then + if (active_cell(i,j) .and. land_mask(i,j) == 0) then if ( ocean_mask(i-1,j) == 1 .or. & (calving_front_mask(i-1,j) == 1 .and. .not.active_cell(i-1,j)) ) then ! compute lateral BC for west face - call lateral_shelf_bc(nx, ny, & - nz, sigma, & - 'west', & - i, j, & - stagusrf, stagthck, & - xVertex, yVertex, & - loadu, loadv) + call lateral_shelf_bc(nx, ny, & + nz, sigma, & + 'west', & + i, j, & + stagusrf_marine, stagthck_marine, & + xVertex, yVertex, & + loadu, loadv) endif if ( ocean_mask(i+1,j) == 1 .or. & - (calving_front_mask(i+1,j) == 1 .and. .not.active_cell(i+1,j)) ) then ! compute lateral BC for west face - - call lateral_shelf_bc(nx, ny, & - nz, sigma, & - 'east', & - i, j, & - stagusrf, stagthck, & - xVertex, yVertex, & - loadu, loadv) + (calving_front_mask(i+1,j) == 1 .and. .not.active_cell(i+1,j)) ) then ! compute lateral BC for east face + + call lateral_shelf_bc(nx, ny, & + nz, sigma, & + 'east', & + i, j, & + stagusrf_marine, stagthck_marine, & + xVertex, yVertex, & + loadu, loadv) endif if ( ocean_mask(i,j-1) == 1 .or. & - (calving_front_mask(i,j-1) == 1 .and. .not.active_cell(i,j-1)) ) then ! compute lateral BC for west face - - call lateral_shelf_bc(nx, ny, & - nz, sigma, & - 'south', & - i, j, & - stagusrf, stagthck, & - xVertex, yVertex, & - loadu, loadv) + (calving_front_mask(i,j-1) == 1 .and. .not.active_cell(i,j-1)) ) then ! compute lateral BC for south face + + call lateral_shelf_bc(nx, ny, & + nz, sigma, & + 'south', & + i, j, & + stagusrf_marine, stagthck_marine, & + xVertex, yVertex, & + loadu, loadv) endif if ( ocean_mask(i,j+1) == 1 .or. & - (calving_front_mask(i,j+1) == 1 .and. .not.active_cell(i,j+1)) ) then ! compute lateral BC for west face - - call lateral_shelf_bc(nx, ny, & - nz, sigma, & - 'north', & - i, j, & - stagusrf, stagthck, & - xVertex, yVertex, & - loadu, loadv) + (calving_front_mask(i,j+1) == 1 .and. .not.active_cell(i,j+1)) ) then ! compute lateral BC for north face + + call lateral_shelf_bc(nx, ny, & + nz, sigma, & + 'north', & + i, j, & + stagusrf_marine, stagthck_marine, & + xVertex, yVertex, & + loadu, loadv) endif endif ! active_cell @@ -4588,12 +4658,12 @@ end subroutine load_vector_lateral_bc !**************************************************************************** - subroutine lateral_shelf_bc(nx, ny, & - nz, sigma, & - face, & - iCell, jCell, & - stagusrf, stagthck, & - xVertex, yVertex, & + subroutine lateral_shelf_bc(nx, ny, & + nz, sigma, & + face, & + iCell, jCell, & + stagusrf_marine, stagthck_marine, & + xVertex, yVertex, & loadu, loadv) !---------------------------------------------------------------------------------- @@ -4646,8 +4716,8 @@ subroutine lateral_shelf_bc(nx, ny, & xVertex, yVertex ! x and y coordinates of vertices real(dp), dimension(nx-1,ny-1), intent(in) :: & - stagusrf, & ! upper surface elevation on staggered grid (m) - stagthck ! ice thickness on staggered grid (m) + stagusrf_marine, & ! upper surface elevation (m) on staggered grid, for marine-based cells only + stagthck_marine ! ice thickness (m) on staggered grid (m), for marine-based cells only real(dp), dimension(nz,nx-1,ny-1), intent(inout) :: & loadu, loadv ! load vector, divided into u and v components @@ -4761,13 +4831,13 @@ subroutine lateral_shelf_bc(nx, ny, & x(3) = x(2) x(4) = x(1) - s(1) = stagusrf(iNode(1), jNode(1)) - s(2) = stagusrf(iNode(2), jNode(2)) + s(1) = stagusrf_marine(iNode(1), jNode(1)) + s(2) = stagusrf_marine(iNode(2), jNode(2)) s(3) = s(2) s(4) = s(1) - h(1) = stagthck(iNode(1), jNode(1)) - h(2) = stagthck(iNode(2), jNode(2)) + h(1) = stagthck_marine(iNode(1), jNode(1)) + h(2) = stagthck_marine(iNode(2), jNode(2)) h(3) = h(2) h(4) = h(1) @@ -4837,7 +4907,7 @@ subroutine lateral_shelf_bc(nx, ny, & ! Increment loadu for east/west faces and loadv for north/south faces. ! This formula works not just for floating ice, but for any edge between - ! an active ice-covered cell and an ocean cell. + ! an ice-covered marine-based cell and an ocean cell. p_av = 0.5d0*rhoi*grav*h_qp & ! p_out - 0.5d0*rhoo*grav*h_qp * (1.d0 - min(s_qp/h_qp,1.d0))**2 ! p_in @@ -5802,7 +5872,7 @@ subroutine compute_3d_velocity_L1L2(nx, ny, & sigma ! sigma vertical coordinate integer, dimension(nx,ny), intent(in) :: & - ice_mask, & ! = 1 for cells where ice is present (thk > thklim), else = 0 + ice_mask, & ! = 1 for cells where ice is present (thck > thklim), else = 0 land_mask ! = 1 for cells with topg >= eus, else = 0 logical, dimension(nx,ny), intent(in) :: & @@ -7805,7 +7875,7 @@ subroutine compute_element_matrix(whichapprox, nNodesPerElement, & !------------------------------------------------------------------ ! Increment the stiffness matrices Kuu, Kuv, Kvu, Kvv with the ! contribution from a particular quadrature point, - ! based on the Blatter-Pattyn first-order equations. + ! based on the chosen Stokes approximation. ! ! Note: Elements can be either 2D or 3D !------------------------------------------------------------------ From fd4782595233f6dc77c8c4ba8cf85889780280a2 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Thu, 26 Apr 2018 13:13:59 -0600 Subject: [PATCH 22/61] Include ice-free land cells in stagthck The higher-order velocity solver uses stagthck (the ice thickness interpolated to the staggered mesh) for many calculations. Previously, ice-free land cells were not included in the interpolation. With this commit, the interpolation includes ice-free land cells. That is, stagthck is the average thickness of the neighboring cells that have ice and/or are land-based. Ice-free ocean cells are still excluded from the average. This commit is answer-changing for the dome test and for most other simulations with a land margin. The changes are modest: ~1 m/yr in velocity near the dome margin, with a cumulative thickness difference of ~1 m after 10 years. Users should create a new reference directory after this commit. For now, the new staggering can be turned off by setting new_stagger = F at the top of glissade_velo_higher. I checked that answers in this case are BFB. --- libglissade/glissade_velo_higher.F90 | 105 +++++++++++++++++++++++++-- 1 file changed, 97 insertions(+), 8 deletions(-) diff --git a/libglissade/glissade_velo_higher.F90 b/libglissade/glissade_velo_higher.F90 index 1305b502..6a2a956e 100644 --- a/libglissade/glissade_velo_higher.F90 +++ b/libglissade/glissade_velo_higher.F90 @@ -261,6 +261,9 @@ module glissade_velo_higher dphi_dyr_3d_vav, &! vertical avg of dphi_dyr_3d dphi_dzr_3d_vav ! vertical avg of dphi_dzr_3d + logical, parameter :: new_stagger = .true. +!! logical, parameter :: new_stagger = .false. + contains !**************************************************************************** @@ -1499,9 +1502,40 @@ subroutine glissade_velo_higher_solve(model, & ! Compute the ice thickness and upper surface elevation on the staggered grid. ! (requires that thck and usrf are up to date in all cells that border locally owned vertices). ! For stagger_margin_in = 0, all cells (including ice-free) are included in interpolation. - ! For stagger_margin_in = 1, only ice-covered cells are included. + ! For stagger_margin_in = 1, only masked cells (*_mask = 1) are included. + ! Note: There can be cells at the land margin which are not currently active, + ! but receive ice from upstream and could activate at the next time step + ! (if the inflow exceeds the SMB loss). + ! Including their small or zero thickness (thck <= thklim) in the gradient + ! prevents abrupt changes in stagthck when these cells activate. !------------------------------------------------------------------------------ + if (new_stagger) then + + ! Compute a mask which is the union of active ice cells and land-based cells (including ice-free land). + ! This mask identifies all cells where thck and usrf should be included in staggered averages. + do j = 1, ny + do i = 1, nx + if (active_ice_mask(i,j) == 1 .or. land_mask(i,j) == 1) then + ice_plus_land_mask(i,j) = 1 + else + ice_plus_land_mask(i,j) = 0 + endif + enddo + enddo + + call glissade_stagger(nx, ny, & + thck, stagthck, & + ice_plus_land_mask, & + stagger_margin_in = 1) + + call glissade_stagger(nx, ny, & + usrf, stagusrf, & + ice_plus_land_mask, & + stagger_margin_in = 1) + + else + !pw call t_startf('glissade_stagger') call glissade_stagger(nx, ny, & thck, stagthck, & @@ -1514,6 +1548,8 @@ subroutine glissade_velo_higher_solve(model, & stagger_margin_in = 1) !pw call t_stopf('glissade_stagger') + endif ! new_stagger + ! Compute a subset of active_ice_mask, consisting of marine-based cells only where (land_mask == 0 .and. active_ice_mask == 1) active_marine_mask = 1 @@ -2783,9 +2819,21 @@ subroutine glissade_velo_higher_solve(model, & if (diva_level_index == 0) then ! solving for 2D mean velocity field ! Interpolate omega to the staggered grid - call glissade_stagger(nx, ny, & + if (new_stagger) then + + call glissade_stagger(nx, ny, & omega(:,:), stag_omega(:,:), & - ice_mask, stagger_margin_in = 1) + ice_plus_land_mask, & + stagger_margin_in = 1) + + else + + call glissade_stagger(nx, ny, & + omega(:,:), stag_omega(:,:), & + ice_mask, & + stagger_margin_in = 1) + + endif else ! solving for the velocity at level k (k = 1 at upper surface) @@ -2793,10 +2841,21 @@ subroutine glissade_velo_higher_solve(model, & call parallel_halo(omega_k(k,:,:)) - call glissade_stagger(nx, ny, & + if (new_stagger) then + + call glissade_stagger(nx, ny, & omega_k(k,:,:), stag_omega(:,:), & - ice_mask, stagger_margin_in = 1) - + ice_plus_land_mask, & + stagger_margin_in = 1) + else + + call glissade_stagger(nx, ny, & + omega_k(k,:,:), stag_omega(:,:), & + ice_mask, & + stagger_margin_in = 1) + + endif + endif !------------------------------------------------------------------- @@ -2834,6 +2893,22 @@ subroutine glissade_velo_higher_solve(model, & print*, ' ' print*, 'uvel, F2, beta_eff, btractx:', uvel_2d(i,j), stag_omega(i,j), beta_eff(i,j), btractx(i,j) print*, 'vvel, btracty:', vvel_2d(i,j), btracty(i,j) + print*, 'omega:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(e10.3)',advance='no') omega(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'stag_omega:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(e10.3)',advance='no') stag_omega(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' print*, ' ' print*, 'beta_eff:' do j = jtest+3, jtest-3, -1 @@ -3677,12 +3752,26 @@ subroutine glissade_velo_higher_solve(model, & ! Interpolate omega_k to the staggered grid + if (new_stagger) then + do k = 1, nz - call glissade_stagger(nx, ny, & + call glissade_stagger(nx, ny, & omega_k(k,:,:), stag_omega_k(k,:,:), & - ice_mask, stagger_margin_in = 1) + ice_plus_land_mask, & + stagger_margin_in = 1) enddo + else + + do k = 1, nz + call glissade_stagger(nx, ny, & + omega_k(k,:,:), stag_omega_k(k,:,:), & + ice_mask, & + stagger_margin_in = 1) + enddo + + endif + ! Compute the new 3D velocity field ! NOTE: The full velocity field is not needed to update efvs and solve ! again for uvel_2d and vvel_2D. However, the basal velocity From 939a6f9232e5efc81be94c4e6fa3cd891fbc79bb Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Thu, 26 Apr 2018 13:54:50 -0600 Subject: [PATCH 23/61] Changed local assembly of taud and beta terms Glissade has two options for assembling the taud and beta terms: standard and local. (Recall that the taud term includes surface gradients and goes on the RHS, and the beta term includes basal traction and goes into the matrix.) This commit modifies local assembly. The intent of local assembly is to make the solution at a given vertex dependent on the surface gradient and beta values at that vertex, and no other vertices. In standard FE assembly, values from other vertices arise from loops over elements (which include neighbor vertices). With local assembly, neighbor vertices are excluded. Previously, the local terms depended on the number of active cells surrounding the vertex, and could change abruptly when a cell transitioned from thck < thklim to thck > thklim. With this commit, the local terms are computed in the same way regardless of whether adjacent cells are active or inactive. This gives smoother changes in the local terms and can prevent dithering at the margin (where a cell oscillates between active and inactive as a result of oscillations in the values of local terms). The local terms are now computed in loops over vertices rather than active cells, and thus the computation is simpler. For now, the new local assembly can be turned off by setting new_assembly = F at the top of glissade_velo_higher. With new_stagger and new_assembly = F, standard LIVV tests are BFB compared to two commits ago (before the stagger and assembly changes). This commit (with new_assembly = T) is answer-changing at roundoff level for the ISMIP-HOM and stream tests, which specify local assembly for beta. (Standard assembly is still the default setting for other tests.) The roundoff-level changes result from changes in the order of operations; for these tests there are no significant changes in matrix terms. The LIVV reference directory should again be updated. --- libglissade/glissade_velo_higher.F90 | 206 ++++++++++++++++++++------- 1 file changed, 158 insertions(+), 48 deletions(-) diff --git a/libglissade/glissade_velo_higher.F90 b/libglissade/glissade_velo_higher.F90 index 6a2a956e..eecfd425 100644 --- a/libglissade/glissade_velo_higher.F90 +++ b/libglissade/glissade_velo_higher.F90 @@ -261,6 +261,10 @@ module glissade_velo_higher dphi_dyr_3d_vav, &! vertical avg of dphi_dyr_3d dphi_dzr_3d_vav ! vertical avg of dphi_dzr_3d + !WHL - debug + logical, parameter :: new_assembly = .true. +!! logical, parameter :: new_assembly = .false. + logical, parameter :: new_stagger = .true. !! logical, parameter :: new_stagger = .false. @@ -1479,7 +1483,6 @@ subroutine glissade_velo_higher_solve(model, & ! With the subgrid calving front scheme, all cells with ice_mask = 1 are active, unless they lie on the ! calving front and have thck <= thck_calving_front. Here, thck_calving_front is the effective thickness ! defined by adjacent cells not on the calving front. - ! ! Note: There is a subtle difference between the active_ice_mask and active_cell array, ! aside from the fortran type (integer v. logical). ! The condition for active_cell = .true. is (1) active_ice_mask = 1, and @@ -1547,7 +1550,6 @@ subroutine glissade_velo_higher_solve(model, & active_ice_mask, & stagger_margin_in = 1) !pw call t_stopf('glissade_stagger') - endif ! new_stagger ! Compute a subset of active_ice_mask, consisting of marine-based cells only @@ -2106,7 +2108,10 @@ subroutine glissade_velo_higher_solve(model, & call load_vector_gravity(nx, ny, & nz, sigma, & - nhalo, active_cell, & + nhalo, & + dx, dy, & + active_cell, & + active_vertex, & xVertex, yVertex, & stagusrf, stagthck, & dusrf_dx, dusrf_dy, & @@ -2792,7 +2797,8 @@ subroutine glissade_velo_higher_solve(model, & call assemble_stiffness_matrix_2d(nx, ny, & nz, & sigma, stagsigma, & - nhalo, active_cell, & + nhalo, & + active_cell, & xVertex, yVertex, & uvel_2d, vvel_2d, & stagusrf, stagthck, & @@ -2825,7 +2831,6 @@ subroutine glissade_velo_higher_solve(model, & omega(:,:), stag_omega(:,:), & ice_plus_land_mask, & stagger_margin_in = 1) - else call glissade_stagger(nx, ny, & @@ -2847,13 +2852,13 @@ subroutine glissade_velo_higher_solve(model, & omega_k(k,:,:), stag_omega(:,:), & ice_plus_land_mask, & stagger_margin_in = 1) + else call glissade_stagger(nx, ny, & omega_k(k,:,:), stag_omega(:,:), & ice_mask, & stagger_margin_in = 1) - endif endif @@ -2893,6 +2898,7 @@ subroutine glissade_velo_higher_solve(model, & print*, ' ' print*, 'uvel, F2, beta_eff, btractx:', uvel_2d(i,j), stag_omega(i,j), beta_eff(i,j), btractx(i,j) print*, 'vvel, btracty:', vvel_2d(i,j), btracty(i,j) + print*, ' ' print*, 'omega:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 @@ -2909,7 +2915,6 @@ subroutine glissade_velo_higher_solve(model, & write(6,*) ' ' enddo print*, ' ' - print*, ' ' print*, 'beta_eff:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 @@ -2923,7 +2928,9 @@ subroutine glissade_velo_higher_solve(model, & call basal_sliding_bc(nx, ny, & nNodeNeighbors_2d, nhalo, & - active_cell, beta_eff, & + dx, dy, & + active_cell, active_vertex, & + beta_eff, & xVertex, yVertex, & whichassemble_beta, & Auu_2d, Avv_2d) @@ -2934,7 +2941,9 @@ subroutine glissade_velo_higher_solve(model, & call basal_sliding_bc(nx, ny, & nNodeNeighbors_2d, nhalo, & - active_cell, beta_internal, & + dx, dy, & + active_cell, active_vertex, & + beta_internal, & xVertex, yVertex, & whichassemble_beta, & Auu_2d, Avv_2d) @@ -3095,7 +3104,8 @@ subroutine glissade_velo_higher_solve(model, & call t_startf('glissade_assemble_3d') call assemble_stiffness_matrix_3d(nx, ny, & nz, sigma, & - nhalo, active_cell, & + nhalo, & + active_cell, & xVertex, yVertex, & uvel, vvel, & stagusrf, stagthck, & @@ -3116,7 +3126,9 @@ subroutine glissade_velo_higher_solve(model, & call basal_sliding_bc(nx, ny, & nNodeNeighbors_3d, nhalo, & - active_cell, beta_internal, & + dx, dy, & + active_cell, active_vertex, & + beta_internal, & xVertex, yVertex, & whichassemble_beta, & Auu(:,nz,:,:), Avv(:,nz,:,:)) @@ -3945,7 +3957,8 @@ subroutine glissade_velo_higher_solve(model, & call compute_internal_stress(nx, ny, & nz, sigma, & - nhalo, active_cell, & + nhalo, & + active_cell, & xVertex, yVertex, & stagusrf, stagthck, & flwafact, efvs, & @@ -3962,7 +3975,8 @@ subroutine glissade_velo_higher_solve(model, & call compute_basal_friction_heatflx(nx, ny, & nhalo, & - active_cell, active_vertex, & + active_cell, & + active_vertex, & xVertex, yVertex, & uvel(nz,:,:), vvel(nz,:,:), & beta_internal, whichassemble_bfric, & @@ -4430,7 +4444,10 @@ end subroutine get_vertex_geometry subroutine load_vector_gravity(nx, ny, & nz, sigma, & - nhalo, active_cell, & + nhalo, & + dx, dy, & + active_cell, & + active_vertex, & xVertex, yVertex, & stagusrf, stagthck, & dusrf_dx, dusrf_dy, & @@ -4446,9 +4463,15 @@ subroutine load_vector_gravity(nx, ny, & real(dp), dimension(nz), intent(in) :: & sigma ! sigma vertical coordinate + real(dp), intent(in) :: & + dx, dy ! grid cell length and width + logical, dimension(nx,ny), intent(in) :: & active_cell ! true if cell contains ice and borders a locally owned vertex + logical, dimension(nx-1,ny-1), intent(in) :: & + active_vertex ! true for vertices of active cells + real(dp), dimension(nx-1,ny-1), intent(in) :: & xVertex, yVertex ! x and y coordinates of vertices @@ -4476,6 +4499,7 @@ subroutine load_vector_gravity(nx, ny, & dsdx, dsdy ! upper surface elevation gradient at nodes real(dp) :: & + dz, & ! element height detJ ! determinant of Jacobian for the transformation ! between the reference element and true element @@ -4495,6 +4519,44 @@ subroutine load_vector_gravity(nx, ny, & print*, 'In load_vector_gravity: itest, jtest, ktest, rtest =', itest, jtest, ktest, rtest endif + !TODO - Compare to older local assembly and make sure answers agree. + ! Looks OK for 2D DIVA; compare for 3D + if (new_assembly .and. whichassemble_taud == HO_ASSEMBLE_TAUD_LOCAL) then + + ! Sum over active vertices + do j = 1, ny-1 + do i = 1, nx-1 + if (active_vertex(i,j)) then + + if (verbose_load .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, 'i, j, dsdx, dsdy:', i, j, dusrf_dx(i,j), dusrf_dy(i,j) + endif + + do k = 1, nz-1 ! loop over elements in this column + ! assume k increases from upper surface to bed + + dz = stagthck(i,j) * (sigma(k+1) - sigma(k)) + + ! Add the ds/dx and ds/dy terms to the load vector for this node + loadu(k,i,j) = loadu(k,i,j) - rhoi*grav * dx*dy*dz/vol0 * dusrf_dx(i,j) + loadv(k,i,j) = loadv(k,i,j) - rhoi*grav * dx*dy*dz/vol0 * dusrf_dy(i,j) + + !TODO - Add the correct depth term + if (verbose_load .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, 'k, delta(loadu), delta(loadv):', k, -rhoi*grav*dx*dy*dz/vol0 * dusrf_dx(i,j), & + -rhoi*grav*dx*dy*dz/vol0 * dusrf_dy(i,j) + endif + + enddo ! k + + endif ! active_vertex + enddo ! i + enddo ! j + + return + + endif ! new_assembly and whichassemble_taud + ! Sum over elements in active cells ! Loop over all cells that border locally owned vertices ! This includes halo cells to the north and east @@ -4547,7 +4609,7 @@ subroutine load_vector_gravity(nx, ny, & ! The standard finite-element treatment (HO_ASSEMBLE_TAUD_STANDARD) is to take a ! phi-weighted sum over neighboring vertices. ! For local driving stress (HO_ASSEMBLE_TAUD_LOCAL), use the value at the nearest vertex. - ! (Note that vertex numbering is the same as QP numbering, CCW from 1 to 4 on bottom face and from 5 to 8 on top face.) + ! (Note: Vertex numbering is the same as QP numbering, CCW from 1 to 4 on bottom face and from 5 to 8 on top face.) if (whichassemble_taud == HO_ASSEMBLE_TAUD_LOCAL) then @@ -4612,7 +4674,7 @@ subroutine load_vector_gravity(nx, ny, & enddo ! k - endif ! active cell + endif ! active_cell enddo ! i enddo ! j @@ -4686,7 +4748,6 @@ subroutine load_vector_lateral_bc(nx, ny, & !WHL - Old method is to compute the spreading term only for active floating cells. ! New method is to compute the spreading term for all active marine-based cells that border the ocean. - !! if (active_cell(i,j) .and. floating_mask(i,j) == 1) then ! ice is active and floating if (active_cell(i,j) .and. land_mask(i,j) == 0) then @@ -5044,7 +5105,8 @@ end subroutine lateral_shelf_bc subroutine assemble_stiffness_matrix_3d(nx, ny, & nz, sigma, & - nhalo, active_cell, & + nhalo, & + active_cell, & xVertex, yVertex, & uvel, vvel, & stagusrf, stagthck, & @@ -5180,9 +5242,6 @@ subroutine assemble_stiffness_matrix_3d(nx, ny, & if (active_cell(i,j)) then - !WHL - debug -!! print*, 'i, j:', i, j - do k = 1, nz-1 ! loop over elements in this column ! assume k increases from upper surface to bed @@ -5289,7 +5348,7 @@ subroutine assemble_stiffness_matrix_3d(nx, ny, & enddo endif - endif ! active cell + endif ! active_cell enddo ! i enddo ! j @@ -5301,7 +5360,8 @@ end subroutine assemble_stiffness_matrix_3d subroutine assemble_stiffness_matrix_2d(nx, ny, & nz, & sigma, stagsigma, & - nhalo, active_cell, & + nhalo, & + active_cell, & xVertex, yVertex, & uvel_2d, vvel_2d, & stagusrf, stagthck, & @@ -5679,7 +5739,7 @@ subroutine assemble_stiffness_matrix_2d(nx, ny, & enddo endif - endif ! active cell + endif ! active_cell enddo ! i enddo ! j @@ -6846,7 +6906,8 @@ end subroutine get_basis_function_derivatives_2d subroutine compute_basal_friction_heatflx(nx, ny, & nhalo, & - active_cell, active_vertex, & + active_cell, & + active_vertex, & xVertex, yVertex, & uvel, vvel, & beta, whichassemble_bfric, & @@ -7020,7 +7081,7 @@ subroutine compute_basal_friction_heatflx(nx, ny, & stagbfricflx(i,j) = beta(i,j) * (uvel(i,j)**2 + vvel(i,j)**2) stagbfricflx(i,j) = stagbfricflx(i,j) / scyr ! convert Pa m/yr to Pa m/s = W/m^2 - endif ! active_cell + endif ! active_vertex enddo ! i enddo ! j @@ -7058,7 +7119,9 @@ end subroutine compute_basal_friction_heatflx subroutine compute_internal_stress (nx, ny, & nz, sigma, & - nhalo, active_cell, & + nhalo, & + active_cell, & + xVertex, yVertex, & stagusrf, stagthck, & flwafact, efvs, & @@ -7277,6 +7340,7 @@ subroutine compute_internal_stress (nx, ny, & endif ! verbose_tau endif ! active cell + enddo ! i enddo ! j @@ -8212,7 +8276,9 @@ end subroutine element_to_global_matrix_2d subroutine basal_sliding_bc(nx, ny, & nNeighbors, nhalo, & - active_cell, beta, & + dx, dy, & + active_cell, active_vertex, & + beta, & xVertex, yVertex, & whichassemble_beta, & Auu, Avv) @@ -8240,9 +8306,15 @@ subroutine basal_sliding_bc(nx, ny, & ! = 27 for 3D solve, = 9 for 2D solve nhalo ! number of halo layers + real(dp), intent(in) :: & + dx, dy ! grid cell length and width + logical, dimension(nx,ny), intent(in) :: & active_cell ! true if cell contains ice and borders a locally owned vertex + logical, dimension(nx-1,ny-1), intent(in) :: & + active_vertex ! true for vertices of active cells + real(dp), dimension(nx-1,ny-1), intent(in) :: & beta ! basal traction field (Pa/(m/yr)) at cell vertices ! typically = beta_internal (beta weighted by f_ground) @@ -8282,8 +8354,40 @@ subroutine basal_sliding_bc(nx, ny, & if (verbose_basal .and. this_rank==rtest) then print*, 'In basal_sliding_bc: itest, jtest, rank =', itest, jtest, rtest + print*, ' ' + print*, 'beta:' + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = itest-3, itest+3 + write(6,'(f10.0)',advance='no') beta(i,j) + enddo + write(6,*) ' ' + enddo endif + !TODO - Compare to older local assembly and make sure answers agree. + if (new_assembly .and. whichassemble_beta == HO_ASSEMBLE_BETA_LOCAL) then + + if (nNeighbors == nNodeNeighbors_3d) then ! 3D problem + m = indxA_3d(0,0,0) + else ! 2D problem + m = indxA_2d(0,0) + endif + + ! Sum over active vertices + do j = 1, ny-1 + do i = 1, nx-1 + if (active_vertex(i,j)) then + Auu(m,i,j) = Auu(m,i,j) + dx*dy/vol0 * beta(i,j) + Avv(m,i,j) = Avv(m,i,j) + dx*dy/vol0 * beta(i,j) + endif ! active_vertex + enddo ! i + enddo ! j + + return + + endif ! new_assembly and whichassemble_beta + ! Sum over elements in active cells ! Loop over all cells that contain locally owned vertices do j = nhalo+1, ny-nhalo+1 @@ -8291,7 +8395,7 @@ subroutine basal_sliding_bc(nx, ny, & !TODO - Should we exclude cells that have Dirichlet basal BCs for all vertices? - if (active_cell(i,j)) then ! ice is present + if (active_cell(i,j)) then ! Set x and y for each node @@ -8345,18 +8449,18 @@ subroutine basal_sliding_bc(nx, ny, & if (verbose_basal .and. this_rank==rtest .and. i==itest .and. j==jtest) then print*, ' ' print*, 'Increment basal traction, i, j, p =', i, j, p - print*, 'beta_qp =', beta_qp - print*, 'detJ/vol0 =', detJ/vol0 + print*, 'beta_qp, detJ/vol0 =', beta_qp, detJ/vol0 endif ! Compute the element matrix for this quadrature point ! (Note volume scaling) + !TODO - Replace detJ/vol0 with dx*dy? Kuu(:,:) = 0.d0 if (whichassemble_beta == HO_ASSEMBLE_BETA_LOCAL) then ! Use the value at the nearest vertex - ! Then Kuu is diagonal, so the traction parameter at a vertex depends only on beta at that vertex - Kuu(p,p) = beta_qp * (detJ/vol0) + ! Then Kuu is diagonal, so the traction parameter at a vertex depends only on beta at that vertex + Kuu(p,p) = beta_qp * (detJ/vol0) else @@ -8396,23 +8500,30 @@ subroutine basal_sliding_bc(nx, ny, & Auu(m,ii,jj) = Auu(m,ii,jj) + Kuu(nr,nc) Avv(m,ii,jj) = Avv(m,ii,jj) + Kvv(nr,nc) + if (verbose_basal .and. this_rank==rtest .and. ii==itest .and. jj==jtest .and. m==5) then + ! m = 5 gives the influence of beta at vertex(i,j) on velocity at vertex(ii,jj). + ! For local assembly, Auu and Avv get nonzero increments only for m = 5. + print*, 'Basal increment for Auu and Avv: source (i,j), Kuu, new Auu, ii, jj, m =', & + i, j, Kuu(nr,nc), Auu(m,ii,jj), ii, jj, m + endif + enddo ! nc enddo ! nr if (verbose_basal .and. this_rank==rtest .and. i==itest .and. j==jtest) then - print*, ' ' - print*, 'i, j =', i, j - print*, 'Kuu:' - do nr = 1, nNodesPerElement_2d - print*, nr, Kuu(nr,:) - enddo - print*, ' ' - print*, 'rowsum(Kuu):' - do nr = 1, nNodesPerElement_2d - print*, nr, sum(Kuu(nr,:)) - enddo - print*, ' ' - print*, 'sum(Kuu):', sum(Kuu(:,:)) +! print*, ' ' +! print*, 'i, j =', i, j +! print*, 'Kuu:' +! do nr = 1, nNodesPerElement_2d +! print*, nr, Kuu(nr,:) +! enddo +! print*, ' ' +! print*, 'rowsum(Kuu):' +! do nr = 1, nNodesPerElement_2d +! print*, nr, sum(Kuu(nr,:)) +! enddo +! print*, ' ' +! print*, 'sum(Kuu):', sum(Kuu(:,:)) endif enddo ! nQuadPoints_2d @@ -8427,12 +8538,11 @@ subroutine basal_sliding_bc(nx, ny, & j = jtest if (nNeighbors == nNodeNeighbors_3d) then ! 3D problem m = indxA_3d(0,0,0) - print*, 'Diagonal index =', m else m = indxA_2d(0,0) - print*, 'Diagonal index =', m endif print*, ' ' + print*, 'Basal BC: i, j, diagonal index =', i, j, m print*, 'New Auu diagonal:', Auu(m,i,j) print*, 'New Avv diagonal:', Avv(m,i,j) endif From 9970b68984fc695f756a62afe1879f7f38b20f8e Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Thu, 26 Apr 2018 14:25:07 -0600 Subject: [PATCH 24/61] Cleanup of new stagger and assembly code I removed the new_stagger and new_assembly logical variables, which gave a choice between old and new algorithms. The code now uses the new algorithms only. This commit is BFB (since the previous commits had new_stagger = new_assembly = T). --- libglissade/glissade_velo_higher.F90 | 375 ++++++++++----------------- 1 file changed, 139 insertions(+), 236 deletions(-) diff --git a/libglissade/glissade_velo_higher.F90 b/libglissade/glissade_velo_higher.F90 index eecfd425..4bc3ec3b 100644 --- a/libglissade/glissade_velo_higher.F90 +++ b/libglissade/glissade_velo_higher.F90 @@ -261,13 +261,6 @@ module glissade_velo_higher dphi_dyr_3d_vav, &! vertical avg of dphi_dyr_3d dphi_dzr_3d_vav ! vertical avg of dphi_dzr_3d - !WHL - debug - logical, parameter :: new_assembly = .true. -!! logical, parameter :: new_assembly = .false. - - logical, parameter :: new_stagger = .true. -!! logical, parameter :: new_stagger = .false. - contains !**************************************************************************** @@ -1513,8 +1506,6 @@ subroutine glissade_velo_higher_solve(model, & ! prevents abrupt changes in stagthck when these cells activate. !------------------------------------------------------------------------------ - if (new_stagger) then - ! Compute a mask which is the union of active ice cells and land-based cells (including ice-free land). ! This mask identifies all cells where thck and usrf should be included in staggered averages. do j = 1, ny @@ -1537,21 +1528,6 @@ subroutine glissade_velo_higher_solve(model, & ice_plus_land_mask, & stagger_margin_in = 1) - else - -!pw call t_startf('glissade_stagger') - call glissade_stagger(nx, ny, & - thck, stagthck, & - active_ice_mask, & - stagger_margin_in = 1) - - call glissade_stagger(nx, ny, & - usrf, stagusrf, & - active_ice_mask, & - stagger_margin_in = 1) -!pw call t_stopf('glissade_stagger') - endif ! new_stagger - ! Compute a subset of active_ice_mask, consisting of marine-based cells only where (land_mask == 0 .and. active_ice_mask == 1) active_marine_mask = 1 @@ -2825,20 +2801,10 @@ subroutine glissade_velo_higher_solve(model, & if (diva_level_index == 0) then ! solving for 2D mean velocity field ! Interpolate omega to the staggered grid - if (new_stagger) then - call glissade_stagger(nx, ny, & omega(:,:), stag_omega(:,:), & ice_plus_land_mask, & stagger_margin_in = 1) - else - - call glissade_stagger(nx, ny, & - omega(:,:), stag_omega(:,:), & - ice_mask, & - stagger_margin_in = 1) - - endif else ! solving for the velocity at level k (k = 1 at upper surface) @@ -2846,21 +2812,12 @@ subroutine glissade_velo_higher_solve(model, & call parallel_halo(omega_k(k,:,:)) - if (new_stagger) then - + ! Interpolate omega_k to the staggered grid call glissade_stagger(nx, ny, & omega_k(k,:,:), stag_omega(:,:), & ice_plus_land_mask, & stagger_margin_in = 1) - else - - call glissade_stagger(nx, ny, & - omega_k(k,:,:), stag_omega(:,:), & - ice_mask, & - stagger_margin_in = 1) - endif - endif !------------------------------------------------------------------- @@ -3764,8 +3721,6 @@ subroutine glissade_velo_higher_solve(model, & ! Interpolate omega_k to the staggered grid - if (new_stagger) then - do k = 1, nz call glissade_stagger(nx, ny, & omega_k(k,:,:), stag_omega_k(k,:,:), & @@ -3773,17 +3728,6 @@ subroutine glissade_velo_higher_solve(model, & stagger_margin_in = 1) enddo - else - - do k = 1, nz - call glissade_stagger(nx, ny, & - omega_k(k,:,:), stag_omega_k(k,:,:), & - ice_mask, & - stagger_margin_in = 1) - enddo - - endif - ! Compute the new 3D velocity field ! NOTE: The full velocity field is not needed to update efvs and solve ! again for uvel_2d and vvel_2D. However, the basal velocity @@ -4519,9 +4463,7 @@ subroutine load_vector_gravity(nx, ny, & print*, 'In load_vector_gravity: itest, jtest, ktest, rtest =', itest, jtest, ktest, rtest endif - !TODO - Compare to older local assembly and make sure answers agree. - ! Looks OK for 2D DIVA; compare for 3D - if (new_assembly .and. whichassemble_taud == HO_ASSEMBLE_TAUD_LOCAL) then + if (whichassemble_taud == HO_ASSEMBLE_TAUD_LOCAL) then ! Sum over active vertices do j = 1, ny-1 @@ -4532,7 +4474,7 @@ subroutine load_vector_gravity(nx, ny, & print*, 'i, j, dsdx, dsdy:', i, j, dusrf_dx(i,j), dusrf_dy(i,j) endif - do k = 1, nz-1 ! loop over elements in this column + do k = 1, nz-1 ! loop over elements in this column ! assume k increases from upper surface to bed dz = stagthck(i,j) * (sigma(k+1) - sigma(k)) @@ -4555,79 +4497,57 @@ subroutine load_vector_gravity(nx, ny, & return - endif ! new_assembly and whichassemble_taud + else ! standard assembly - ! Sum over elements in active cells - ! Loop over all cells that border locally owned vertices - ! This includes halo cells to the north and east + ! Sum over elements in active cells + ! Loop over all cells that border locally owned vertices + ! This includes halo cells to the north and east - do j = nhalo+1, ny-nhalo+1 - do i = nhalo+1, nx-nhalo+1 + do j = nhalo+1, ny-nhalo+1 + do i = nhalo+1, nx-nhalo+1 - if (active_cell(i,j)) then + if (active_cell(i,j)) then - do k = 1, nz-1 ! loop over elements in this column - ! assume k increases from upper surface to bed + do k = 1, nz-1 ! loop over elements in this column + ! assume k increases from upper surface to bed - ! compute spatial coordinates and upper surface elevation gradient for each node + ! compute spatial coordinates and upper surface elevation gradient for each node - do n = 1, nNodesPerElement_3d + do n = 1, nNodesPerElement_3d - ! Determine (k,i,j) for this node - ! The reason for the '7' is that node 7, in the NE corner of the upper layer, has index (k,i,j). - ! Indices for other nodes are computed relative to this node. - iNode = i + ishift(7,n) - jNode = j + jshift(7,n) - kNode = k + kshift(7,n) + ! Determine (k,i,j) for this node + ! The reason for the '7' is that node 7, in the NE corner of the upper layer, has index (k,i,j). + ! Indices for other nodes are computed relative to this node. + iNode = i + ishift(7,n) + jNode = j + jshift(7,n) + kNode = k + kshift(7,n) - x(n) = xVertex(iNode,jNode) - y(n) = yVertex(iNode,jNode) - z(n) = stagusrf(iNode,jNode) - sigma(kNode)*stagthck(iNode,jNode) - dsdx(n) = dusrf_dx(iNode,jNode) - dsdy(n) = dusrf_dy(iNode,jNode) + x(n) = xVertex(iNode,jNode) + y(n) = yVertex(iNode,jNode) + z(n) = stagusrf(iNode,jNode) - sigma(kNode)*stagthck(iNode,jNode) + dsdx(n) = dusrf_dx(iNode,jNode) + dsdy(n) = dusrf_dy(iNode,jNode) - if (verbose_load .and. this_rank==rtest .and. i==itest .and. j==jtest .and. k==ktest) then - print*, 'i, j, k, n, x, y, z, dsdx, dsdy:', i, j, k, n, x(n), y(n), z(n), dsdx(n), dsdy(n) - endif + if (verbose_load .and. this_rank==rtest .and. i==itest .and. j==jtest .and. k==ktest) then + print*, 'i, j, k, n, x, y, z, dsdx, dsdy:', i, j, k, n, x(n), y(n), z(n), dsdx(n), dsdy(n) + endif - enddo ! nodes per element + enddo ! nodes per element - ! Loop over quadrature points for this element + ! Loop over quadrature points for this element - do p = 1, nQuadPoints_3d - - ! Evaluate detJ at the quadrature point. - ! TODO: The derivatives are not used. Make these optional arguments? - !WHL - debug - Pass in i, j, k, and p for now - - call get_basis_function_derivatives_3d(x(:), y(:), z(:), & - dphi_dxr_3d(:,p), dphi_dyr_3d(:,p), dphi_dzr_3d(:,p), & - dphi_dx_3d(:), dphi_dy_3d(:), dphi_dz_3d(:), & - detJ , i, j, k, p ) - - ! Increment the load vector with the gravitational contribution from this quadrature point - ! The standard finite-element treatment (HO_ASSEMBLE_TAUD_STANDARD) is to take a - ! phi-weighted sum over neighboring vertices. - ! For local driving stress (HO_ASSEMBLE_TAUD_LOCAL), use the value at the nearest vertex. - ! (Note: Vertex numbering is the same as QP numbering, CCW from 1 to 4 on bottom face and from 5 to 8 on top face.) - - if (whichassemble_taud == HO_ASSEMBLE_TAUD_LOCAL) then + do p = 1, nQuadPoints_3d - ! Determine (k,i,j) for the node nearest to this quadrature point - iNode = i + ishift(7,p) - jNode = j + jshift(7,p) - kNode = k + kshift(7,p) - - ! Add the ds/dx and ds/dy terms to the load vector for this node - loadu(kNode,iNode,jNode) = loadu(kNode,iNode,jNode) - rhoi*grav * detJ/vol0 * dsdx(p) - loadv(kNode,iNode,jNode) = loadv(kNode,iNode,jNode) - rhoi*grav * detJ/vol0 * dsdy(p) + ! Evaluate detJ at the quadrature point. + ! TODO: The derivatives are not used. Make these optional arguments? + !WHL - debug - Pass in i, j, k, and p for now - if (verbose_load .and. this_rank==rtest .and. i==itest .and. j==jtest .and. k==ktest) then - print*, 'p, delta(loadu), delta(loadv):', p, -rhoi*grav*detJ/vol0 * dsdx(p), & - -rhoi*grav*detJ/vol0 * dsdy(p) - endif + call get_basis_function_derivatives_3d(x(:), y(:), z(:), & + dphi_dxr_3d(:,p), dphi_dyr_3d(:,p), dphi_dzr_3d(:,p), & + dphi_dx_3d(:), dphi_dy_3d(:), dphi_dz_3d(:), & + detJ , i, j, k, p ) - else ! standard FE assembly (HO_ASSEMBLE_TAUD_STANDARD) + ! Increment the load vector with the gravitational contribution from this quadrature point ! Evaluate dsdx and dsdy at this quadrature point dsdx_qp = 0.d0 @@ -4668,16 +4588,16 @@ subroutine load_vector_gravity(nx, ny, & enddo ! nNodesPerElement_3d - endif ! whichassemble_taud + enddo ! nQuadPoints_3d - enddo ! nQuadPoints_3d + enddo ! k - enddo ! k + endif ! active_cell - endif ! active_cell + enddo ! i + enddo ! j - enddo ! i - enddo ! j + endif ! whichasssemble_taud end subroutine load_vector_gravity @@ -5025,7 +4945,7 @@ subroutine lateral_shelf_bc(nx, ny, & print*, 'dphi_dyr_2d =', dphi_dyr_2d(:,p) endif - call get_basis_function_derivatives_2d(x(:), y(:), & + call get_basis_function_derivatives_2d(x(:), y(:), & dphi_dxr_2d(:,p), dphi_dyr_2d(:,p), & dphi_dx_2d(:), dphi_dy_2d(:), & detJ, iCell, jCell, p) @@ -8365,8 +8285,7 @@ subroutine basal_sliding_bc(nx, ny, & enddo endif - !TODO - Compare to older local assembly and make sure answers agree. - if (new_assembly .and. whichassemble_beta == HO_ASSEMBLE_BETA_LOCAL) then + if (whichassemble_beta == HO_ASSEMBLE_BETA_LOCAL) then if (nNeighbors == nNodeNeighbors_3d) then ! 3D problem m = indxA_3d(0,0,0) @@ -8384,85 +8303,69 @@ subroutine basal_sliding_bc(nx, ny, & enddo ! i enddo ! j - return - - endif ! new_assembly and whichassemble_beta + else ! standard assembly - ! Sum over elements in active cells - ! Loop over all cells that contain locally owned vertices - do j = nhalo+1, ny-nhalo+1 - do i = nhalo+1, nx-nhalo+1 + ! Sum over elements in active cells + ! Loop over all cells that contain locally owned vertices + do j = nhalo+1, ny-nhalo+1 + do i = nhalo+1, nx-nhalo+1 - !TODO - Should we exclude cells that have Dirichlet basal BCs for all vertices? + !TODO - Should we exclude cells that have Dirichlet basal BCs for all vertices? - if (active_cell(i,j)) then + if (active_cell(i,j)) then - ! Set x and y for each node + ! Set x and y for each node - ! 4-----3 y - ! | | ^ - ! | | | - ! 1-----2 ---> x + ! 4-----3 y + ! | | ^ + ! | | | + ! 1-----2 ---> x - x(1) = xVertex(i-1,j-1) - x(2) = xVertex(i,j-1) - x(3) = xVertex(i,j) - x(4) = xVertex(i-1,j) + x(1) = xVertex(i-1,j-1) + x(2) = xVertex(i,j-1) + x(3) = xVertex(i,j) + x(4) = xVertex(i-1,j) - y(1) = yVertex(i-1,j-1) - y(2) = yVertex(i,j-1) - y(3) = yVertex(i,j) - y(4) = yVertex(i-1,j) + y(1) = yVertex(i-1,j-1) + y(2) = yVertex(i,j-1) + y(3) = yVertex(i,j) + y(4) = yVertex(i-1,j) - b(1) = beta(i-1,j-1) - b(2) = beta(i,j-1) - b(3) = beta(i,j) - b(4) = beta(i-1,j) + b(1) = beta(i-1,j-1) + b(2) = beta(i,j-1) + b(3) = beta(i,j) + b(4) = beta(i-1,j) - ! loop over quadrature points + ! loop over quadrature points - do p = 1, nQuadPoints_2d + do p = 1, nQuadPoints_2d - ! Compute basis function derivatives and det(J) for this quadrature point - ! For now, pass in i, j, k, p for debugging - !TODO - Modify this subroutine so that the output derivatives are optional? + ! Compute basis function derivatives and det(J) for this quadrature point + ! For now, pass in i, j, k, p for debugging + !TODO - Modify this subroutine so that the output derivatives are optional? - call get_basis_function_derivatives_2d(x(:), y(:), & - dphi_dxr_2d(:,p), dphi_dyr_2d(:,p), & - dphi_dx_2d(:), dphi_dy_2d(:), & - detJ, i, j, p) + call get_basis_function_derivatives_2d(x(:), y(:), & + dphi_dxr_2d(:,p), dphi_dyr_2d(:,p), & + dphi_dx_2d(:), dphi_dy_2d(:), & + detJ, i, j, p) - ! Evaluate beta at this quadrature point - ! Standard finite-element treatment is to take a phi-weighted sum over neighboring vertices. - ! For local beta, use the value at the nearest vertex. - ! (Note that vertex numbering is the same as QP numbering, CCW from 1 to 4 starting at SW corner.) - - if (whichassemble_beta == HO_ASSEMBLE_BETA_LOCAL) then - beta_qp = b(p) - else + ! Evaluate beta at this quadrature point, taking a phi-weighted sum over neighboring vertices. beta_qp = 0.d0 do n = 1, nNodesPerElement_2d beta_qp = beta_qp + phi_2d(n,p) * b(n) enddo - endif - if (verbose_basal .and. this_rank==rtest .and. i==itest .and. j==jtest) then - print*, ' ' - print*, 'Increment basal traction, i, j, p =', i, j, p - print*, 'beta_qp, detJ/vol0 =', beta_qp, detJ/vol0 - endif - - ! Compute the element matrix for this quadrature point - ! (Note volume scaling) - !TODO - Replace detJ/vol0 with dx*dy? - - Kuu(:,:) = 0.d0 + if (verbose_basal .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, ' ' + print*, 'Increment basal traction, i, j, p =', i, j, p + print*, 'beta_qp, detJ/vol0 =', beta_qp, detJ/vol0 + endif - if (whichassemble_beta == HO_ASSEMBLE_BETA_LOCAL) then ! Use the value at the nearest vertex - ! Then Kuu is diagonal, so the traction parameter at a vertex depends only on beta at that vertex - Kuu(p,p) = beta_qp * (detJ/vol0) + ! Compute the element matrix for this quadrature point + ! (Note volume scaling) + !TODO - Replace detJ/vol0 with dx*dy? - else + Kuu(:,:) = 0.d0 do nc = 1, nNodesPerElement_2d ! columns of K do nr = 1, nNodesPerElement_2d ! rows of K @@ -8470,68 +8373,68 @@ subroutine basal_sliding_bc(nx, ny, & enddo ! m (rows) enddo ! n (columns) - endif ! local beta - - !Note: Is this true for all sliding laws? - Kvv(:,:) = Kuu(:,:) + !Note: Is this true for all sliding laws? + Kvv(:,:) = Kuu(:,:) - ! Insert terms of basal element matrices into global matrices Auu and Avv + ! Insert terms of basal element matrices into global matrices Auu and Avv - do nr = 1, nNodesPerElement_2d ! rows of K + do nr = 1, nNodesPerElement_2d ! rows of K - ! Determine (i,j) for this node - ! The reason for the '3' is that node 3, in the NE corner of the cell, has horizontal indices (i,j). - ! Indices for other nodes are computed relative to this node. + ! Determine (i,j) for this node + ! The reason for the '3' is that node 3, in the NE corner of the cell, has horizontal indices (i,j). + ! Indices for other nodes are computed relative to this node. - ii = i + ishift(3,nr) - jj = j + jshift(3,nr) + ii = i + ishift(3,nr) + jj = j + jshift(3,nr) - do nc = 1, nNodesPerElement_2d ! columns of K + do nc = 1, nNodesPerElement_2d ! columns of K - iA = ishift(nr,nc) ! iA index of A into which K(nr,nc) is summed - jA = jshift(nr,nc) ! similarly for jA + iA = ishift(nr,nc) ! iA index of A into which K(nr,nc) is summed + jA = jshift(nr,nc) ! similarly for jA - if (nNeighbors == nNodeNeighbors_3d) then ! 3D problem - m = indxA_3d(iA,jA,0) - else ! 2D problem - m = indxA_2d(iA,jA) - endif + if (nNeighbors == nNodeNeighbors_3d) then ! 3D problem + m = indxA_3d(iA,jA,0) + else ! 2D problem + m = indxA_2d(iA,jA) + endif - Auu(m,ii,jj) = Auu(m,ii,jj) + Kuu(nr,nc) - Avv(m,ii,jj) = Avv(m,ii,jj) + Kvv(nr,nc) + Auu(m,ii,jj) = Auu(m,ii,jj) + Kuu(nr,nc) + Avv(m,ii,jj) = Avv(m,ii,jj) + Kvv(nr,nc) - if (verbose_basal .and. this_rank==rtest .and. ii==itest .and. jj==jtest .and. m==5) then - ! m = 5 gives the influence of beta at vertex(i,j) on velocity at vertex(ii,jj). - ! For local assembly, Auu and Avv get nonzero increments only for m = 5. - print*, 'Basal increment for Auu and Avv: source (i,j), Kuu, new Auu, ii, jj, m =', & - i, j, Kuu(nr,nc), Auu(m,ii,jj), ii, jj, m - endif + if (verbose_basal .and. this_rank==rtest .and. ii==itest .and. jj==jtest .and. m==5) then + ! m = 5 gives the influence of beta at vertex(i,j) on velocity at vertex(ii,jj). + ! For local assembly, Auu and Avv get nonzero increments only for m = 5. + print*, 'Basal increment for Auu and Avv: source (i,j), Kuu, new Auu, ii, jj, m =', & + i, j, Kuu(nr,nc), Auu(m,ii,jj), ii, jj, m + endif - enddo ! nc - enddo ! nr - - if (verbose_basal .and. this_rank==rtest .and. i==itest .and. j==jtest) then -! print*, ' ' -! print*, 'i, j =', i, j -! print*, 'Kuu:' -! do nr = 1, nNodesPerElement_2d -! print*, nr, Kuu(nr,:) -! enddo -! print*, ' ' -! print*, 'rowsum(Kuu):' -! do nr = 1, nNodesPerElement_2d -! print*, nr, sum(Kuu(nr,:)) -! enddo -! print*, ' ' -! print*, 'sum(Kuu):', sum(Kuu(:,:)) - endif + enddo ! nc + enddo ! nr + + if (verbose_basal .and. this_rank==rtest .and. i==itest .and. j==jtest) then +! print*, ' ' +! print*, 'i, j =', i, j +! print*, 'Kuu:' +! do nr = 1, nNodesPerElement_2d +! print*, nr, Kuu(nr,:) +! enddo +! print*, ' ' +! print*, 'rowsum(Kuu):' +! do nr = 1, nNodesPerElement_2d +! print*, nr, sum(Kuu(nr,:)) +! enddo +! print*, ' ' +! print*, 'sum(Kuu):', sum(Kuu(:,:)) + endif - enddo ! nQuadPoints_2d + enddo ! nQuadPoints_2d - endif ! active_cell + endif ! active_cell - enddo ! i - enddo ! j + enddo ! i + enddo ! j + + endif ! whichassemble_beta if (verbose_basal .and. this_rank==rtest) then i = itest From 2fd7fb3e0a5b8a4750f2a191eff4a33de859da9e Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Thu, 26 Apr 2018 15:41:01 -0600 Subject: [PATCH 25/61] Reworked eigencalving and damage-based calving This commit includes major changes to eigencalving and damage-based calving (which_calving = 7 and 8, respectively). Eigencalving is modified as follows: * The lateral calving rate is now derived not from eigenvalues of the 2D strain rate tensor, but from eigenvalues of the 2D stress tensor (denoted as tau1 and tau2). * The lateral calving rate, instead of being proportional to the product of eigenvalues, is proportional to an effective stress, tau_eff_calving = (tau1^2 + w * tau2^2)^0.5. Here, w is a scalar that can give greater weight to tau2 (the second principal stress, across the flow) than to tau1 (the first principal stress, along the flow). * Where either tau1 or tau2 < 0, it is set to 0 when evaluating tau_eff_calving. This reflects the fact that calving is driven primarily by tensile rather than compressive stresses. Eigencalving uses two user-configurable constants: (1) eigencalving_constant, which gives the lateral calving rate (m/yr) per unit stress (Pa), with a default value (for now) of 0.01 (2) eigen2_weight (= w above), set to 1 by default. Damage-based calving, like eigencalving, is driven by tau_eff_calving. The differences are: * Instead of determining a lateral calving rate directly, tau_eff_calving determines the rate of increase of a damage scalar. * The lateral calving rate is proportional to the difference between the vertically integrated column damage and a damage threshold. This scheme uses two user-configurable constants (in addition to eigen2_weight): (1) damage_constant, which gives the damage rate (1/yr) per unit stress (Pa), with a default value (for now) of 1.e-7 (2) damage_threshold, with a default value of 0.75. Note that with advection, damage can get close to, but rarely exceeds, 1.0.) For both eigencalving and damage-based calving, the lateral calving rate is converted to a volume loss based on thck_calving_front, the effective ice thickness at the marine margin. This volume loss is followed by thickness-based calving to finish off thin ice as needed. This scheme is akin to that of Pollard et al. (2015, EPSL) and Morlighem et al. (2016, GRL), but differs in the details. Pollard et al. diagnose calving rates from divu rather than the stress tensor. Morlighem et al. use effective tensile stress, but they determine calving rates by taking the ratio of tensile stress to a threshold value. I tested the new eigencalving for both Greenland and Antarctica. Results are improved compared to the old eigencalving, since tau_eff_calving is smoother and steadier than the eigenproduct of the strain rate tensor. With a weighting factor w = 1 (i.e., equal weighting of tau1 and tau2), there are large, unrealistic ice tongues off the Greenland coast. Setting w > 1 helps remove these tongues without calving ice in narrow fjords where tau2 < 0. Both schemes, especially the damage-based scheme, will need some more testing and tweaking. The damage-based scheme might be expanded to include more sources and sinks of damage (e.g., basal melting). Standard LIVV tests do not have calving and are BFB. (At some point we should add a test with calving.) --- libglide/glide_setup.F90 | 36 ++- libglide/glide_types.F90 | 48 ++-- libglide/glide_vars.def | 66 ++--- libglissade/glissade.F90 | 228 +++++++++------ libglissade/glissade_calving.F90 | 477 ++++++++++++++++++------------- 5 files changed, 487 insertions(+), 368 deletions(-) diff --git a/libglide/glide_setup.F90 b/libglide/glide_setup.F90 index 45073fa9..51ffb3cf 100644 --- a/libglide/glide_setup.F90 +++ b/libglide/glide_setup.F90 @@ -1571,6 +1571,8 @@ subroutine handle_parameters(section, model) call GetValue(section,'calving_fraction', model%calving%calving_fraction) call GetValue(section,'calving_minthck', model%calving%calving_minthck) call GetValue(section,'eigencalving_constant', model%calving%eigencalving_constant) + call GetValue(section,'eigen2_weight', model%calving%eigen2_weight) + call GetValue(section,'damage_constant', model%calving%damage_constant) call GetValue(section,'taumax_cliff', model%calving%taumax_cliff) call GetValue(section,'cliff_timescale', model%calving%cliff_timescale) call GetValue(section,'ncull_calving_front', model%calving%ncull_calving_front) @@ -1732,13 +1734,19 @@ subroutine print_parameters(model) endif if (model%options%whichcalving == CALVING_THCK_THRESHOLD .or. & - model%options%whichcalving == EIGENCALVING) then + model%options%whichcalving == EIGENCALVING .or. & + model%options%whichcalving == CALVING_DAMAGE) then write(message,*) 'calving thickness limit (m) : ', model%calving%calving_minthck call write_log(message) endif if (model%options%whichcalving == EIGENCALVING) then - write(message,*) 'eigencalving constant (m*yr) : ', model%calving%eigencalving_constant + write(message,*) 'eigencalving constant (m yr^-1 Pa^-1): ', model%calving%eigencalving_constant + call write_log(message) + write(message,*) 'weight of eigenvalue 2 (unitless) : ', model%calving%eigen2_weight + call write_log(message) + elseif (model%options%whichcalving == CALVING_DAMAGE) then + write(message,*) 'damage constant (yr^-1) : ', model%calving%damage_constant call write_log(message) endif @@ -2499,8 +2507,9 @@ subroutine define_glide_restart_variables(options) ! The eigencalving calculation requires the product of eigenvalues of the horizontal strain rate tensor, ! which depends on the stress tensor, which is computed by the HO solver. ! On restart, the correct stress and strain rate tensors are not available, so we read in the eigenproduct. - if (options%whichcalving == EIGENCALVING) then - call glide_add_to_restart_variable_list('strain_rate_eigenprod') + if (options%whichcalving == EIGENCALVING .or. options%whichcalving == CALVING_DAMAGE) then + call glide_add_to_restart_variable_list('tau_eigen1') + call glide_add_to_restart_variable_list('tau_eigen2') endif ! other Glissade options @@ -2549,38 +2558,27 @@ subroutine define_glide_restart_variables(options) select case(options%which_ho_inversion) case (HO_INVERSION_COMPUTE) ! If computing powerlaw_c and bmlt_float by inversion, these fields are needed for restart. - ! Note: coulomb_c_inversion is not a restart field, since the ratio powerlaw_c/coulomb_c is fixed. call glide_add_to_restart_variable_list('powerlaw_c_inversion') call glide_add_to_restart_variable_list('bmlt_float_inversion') - ! If the restart file will be used to initialize a forward run, - ! then we also want the time-average versions of these fields, - ! which will serve as prescribed fields for the forward run. - ! (Not strictly necessary except for the final run of the inversion, - ! but included for generality) - ! Note: If these fields are written to the restart file, they should not be written - ! to any other output file; else the time average will be wrong. - !TODO - If bmlt_float_inversion is steady, do not need a tavg version? -!! call glide_add_to_restart_variable_list('powerlaw_c_inversion_tavg') - call glide_add_to_restart_variable_list('bmlt_float_inversion_tavg') case (HO_INVERSION_PRESCRIBED) ! Write powerlaw_c_inversion to the restart file, because it is ! continually adjusted at runtime as the grounding line moves. - ! Also write bmlt_float_inversion. It is not adjusted at runtime, so we need - ! either bmlt_float_inversion or bmlt_float_prescribed, but not both. + ! Also write bmlt_float_inversion, in case it is also adjusted at runtime. call glide_add_to_restart_variable_list('powerlaw_c_inversion') call glide_add_to_restart_variable_list('bmlt_float_inversion') ! If powerlaw_c is prescribed from a previous inversion, then the ! prescribed field is needed at runtime to set powerlaw_c_inversion ! when floating ice regrounds. ! Currently, the prescribed bmlt_float field is used only at initialization - ! to set bmlt_float_inversion, so it is not strictly needed for restart. - ! Might want to remove it later. + ! to set bmlt_float_inversion, so it might not be needed for restart. + ! Remove it later? call glide_add_to_restart_variable_list('powerlaw_c_prescribed') call glide_add_to_restart_variable_list('bmlt_float_prescribed') end select ! If inverting for basal parameters and/or subshelf melting based on thck_obs, ! then thck_obs needs to be in the restart file; + !TODO - Remove thck_obs, keep usrf_obs? if (options%which_ho_inversion == HO_INVERSION_COMPUTE) then call glide_add_to_restart_variable_list('thck_obs') endif diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index 1de9a817..86041835 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -1106,16 +1106,15 @@ module glide_types type glide_calving !> holds fields and parameters related to calving - !> Note: The 3D damage field is prognostic; the 2D damage_column field is diagnosed from the 3D damage field. real(dp),dimension(:,:), pointer :: calving_thck => null() !> thickness loss in grid cell due to calving !> scaled by thk0 like mass balance, thickness, etc. integer, dimension(:,:), pointer :: calving_mask => null() !> calve floating ice wherever the mask = 1 (whichcalving = CALVING_GRID_MASK) - real(dp),dimension(:,:), pointer :: thck_calving_front => null()!> effective ice thickness at calving front, divided by \texttt{thk0}. - real(dp),dimension(:,:), pointer :: strain_rate_eigenprod !> product of eigenvalues of 2D horizontal strain rate tensor (s^-2) - real(dp),dimension(:,:), pointer :: strain_rate_eigen1 !> first principal eigenvalue of 2D horizontal strain rate tensor (s^-1) - real(dp),dimension(:,:), pointer :: strain_rate_eigen2 !> second principal eigenvalue of 2D horizontal strain rate tensor (s^-1) + real(dp),dimension(:,:), pointer :: calving_lateral => null()!> lateral calving rate (m/yr, not scaled) + ! (whichcalving = EIGENCALVING, CALVING_DAMAGE) + real(dp),dimension(:,:), pointer :: tau_eigen1 !> first eigenvalue of 2D horizontal stress tensor (Pa) + real(dp),dimension(:,:), pointer :: tau_eigen2 !> second eigenvalue of 2D horizontal stress tensor (Pa) + real(dp),dimension(:,:), pointer :: tau_eff_calving !> effective stress (Pa) for calving; derived from tau_eigen1, tau_eigen2 real(dp),dimension(:,:,:),pointer :: damage => null() !> 3D damage tracer, 0 > damage < 1 (whichcalving = CALVING_DAMAGE) - real(dp),dimension(:,:), pointer :: damage_column => null() !> 2D vertically integrated damage tracer, 0 > damage_column < 1 real(dp) :: marine_limit = -200.d0 !> minimum value of topg/relx before floating ice calves !> (whichcalving = CALVING_RELX_THRESHOLD, CALVING_TOPG_THRESHOLD) @@ -1126,8 +1125,11 @@ module glide_types !> if calving_timescale = 0, then calving_thck = thck real(dp) :: calving_minthck = 100.d0 !> minimum thickness (m) of floating ice at marine edge before it calves !> (whichcalving = CALVING_THCK_THRESHOLD or EIGENCALVING) - real(dp) :: eigencalving_constant = 1.0d9 !> eigencalving constant from Levermann et al. (2012) (m*yr) - !> (whichcalving = EIGENCALVING + real(dp) :: eigencalving_constant = 0.01d0 !> eigencalving constant, lateral calving rate (m/yr) per unit stress (Pa) + !> (whichcalving = EIGENCALVING) + real(dp) :: eigen2_weight = 1.0d0 !> weight given to tau_eigen2 relative to tau_eigen1 in tau_eff_calving (unitless) + real(dp) :: damage_constant = 1.0d-7 !> damage constant; rate of change of damage (1/yr) per unit stress (Pa) + !> (whichcalving = CALVING_DAMAGE) integer :: ncull_calving_front = 0 !> number of times to cull calving_front cells at initialization !> Set to a larger value to remove thicker peninsulas real(dp) :: taumax_cliff = 1.0d6 !> yield stress (Pa) for marine-based ice cliffs @@ -1135,7 +1137,7 @@ module glide_types real(dp) :: calving_front_x = 0.d0 !> for CALVING_GRID_MASK option, calve ice wherever abs(x) > calving_front_x (m) real(dp) :: calving_front_y = 0.d0 !> for CALVING_GRID_MASK option, calve ice wherever abs(y) > calving_front_y (m) !> NOTE: This option is applied only if calving_front_x or calving_front_y > 0 - real(dp) :: damage_threshold = 1.0d0 !> threshold at which ice column is deemed sufficiently damaged to calve + real(dp) :: damage_threshold = 0.75d0 !> threshold at which ice column is deemed sufficiently damaged to calve !> assuming that 0 = no damage, 1 = total damage end type glide_calving @@ -2269,17 +2271,15 @@ subroutine glide_allocarr(model) ! calving arrays call coordsystem_allocate(model%general%ice_grid, model%calving%calving_thck) call coordsystem_allocate(model%general%ice_grid, model%calving%calving_mask) - call coordsystem_allocate(model%general%ice_grid, model%calving%thck_calving_front) - call coordsystem_allocate(model%general%ice_grid, model%calving%strain_rate_eigenprod) - call coordsystem_allocate(model%general%ice_grid, model%calving%strain_rate_eigen1) - call coordsystem_allocate(model%general%ice_grid, model%calving%strain_rate_eigen2) + call coordsystem_allocate(model%general%ice_grid, model%calving%calving_lateral) + call coordsystem_allocate(model%general%ice_grid, model%calving%tau_eigen1) + call coordsystem_allocate(model%general%ice_grid, model%calving%tau_eigen2) + call coordsystem_allocate(model%general%ice_grid, model%calving%tau_eff_calving) if (model%options%whichcalving == CALVING_DAMAGE) then call coordsystem_allocate(model%general%ice_grid, upn-1, model%calving%damage) - call coordsystem_allocate(model%general%ice_grid, model%calving%damage_column) else ! allocate with size 1, since they need to be allocated to be passed to calving subroutine allocate(model%calving%damage(1,1,1)) - allocate(model%calving%damage_column(1,1)) endif ! matrix solver arrays @@ -2760,18 +2760,16 @@ subroutine glide_deallocarr(model) deallocate(model%calving%calving_thck) if (associated(model%calving%calving_mask)) & deallocate(model%calving%calving_mask) - if (associated(model%calving%thck_calving_front)) & - deallocate(model%calving%thck_calving_front) - if (associated(model%calving%strain_rate_eigenprod)) & - deallocate(model%calving%strain_rate_eigenprod) - if (associated(model%calving%strain_rate_eigen1)) & - deallocate(model%calving%strain_rate_eigen1) - if (associated(model%calving%strain_rate_eigen2)) & - deallocate(model%calving%strain_rate_eigen2) + if (associated(model%calving%calving_lateral)) & + deallocate(model%calving%calving_lateral) + if (associated(model%calving%tau_eigen1)) & + deallocate(model%calving%tau_eigen1) + if (associated(model%calving%tau_eigen2)) & + deallocate(model%calving%tau_eigen2) + if (associated(model%calving%tau_eff_calving)) & + deallocate(model%calving%tau_eff_calving) if (associated(model%calving%damage)) & deallocate(model%calving%damage) - if (associated(model%calving%damage_column)) & - deallocate(model%calving%damage_column) ! matrix solver arrays diff --git a/libglide/glide_vars.def b/libglide/glide_vars.def index 3ae7eeb5..e732126c 100644 --- a/libglide/glide_vars.def +++ b/libglide/glide_vars.def @@ -523,6 +523,13 @@ load: 1 type: int coordinates: lon lat +[calving_lateral] +dimensions: time, y1, x1 +units: meter/year +long_name: lateral calving rate +data: data%calving%calving_lateral +coordinates: lon lat + [damage] dimensions: time, staglevel, y1, x1 units: unitless [0,1] @@ -531,13 +538,6 @@ data: data%calving%damage(up,:,:) load: 1 coordinates: lon lat -[damage_column] -dimensions: time, y1, x1 -units: unitless [0,1] -long_name: vertically integrated ice damage -data: data%calving%damage_column -coordinates: lon lat - [area_factor] dimensions: time, y1, x1 units: unitless @@ -636,16 +636,6 @@ load: 1 standard_name: bedrock_altitude coordinates: lon lat -[thck_calving_front] -dimensions: time, y1, x1 -units: meter -long_name: effective ice thickness at calving front -data: data%calving%thck_calving_front -factor: thk0 -load: 1 -standard_name: ice_thickness_at_calving_front -coordinates: lon lat - ## D. Martin added - fields that need to be passed to POP for ice-ocean coupling #[lower_cell_loc] #dimensions: time, y1, x1 @@ -1130,28 +1120,6 @@ long_name: xy component of strain rate tensor data: data%velocity%strain_rate%xy(up,:,:) factor: scyr -[strain_rate_eigenprod] -dimensions: time, y1, x1 -units: 1/(year*year) -long_name: product of eigenvalues of horizontal strain rate tensor -data: data%calving%strain_rate_eigenprod -factor: scyr*scyr -load: 1 - -[strain_rate_eigen1] -dimensions: time, y1, x1 -units: 1/year -long_name: first eigenvalue of horizontal strain rate tensor -data: data%calving%strain_rate_eigen1 -factor: scyr - -[strain_rate_eigen2] -dimensions: time, y1, x1 -units: 1/year -long_name: second eigenvalue of horizontal strain rate tensor -data: data%calving%strain_rate_eigen2 -factor: scyr - [tau_eff] dimensions: time, staglevel, y1, x1 units: Pa @@ -1194,6 +1162,26 @@ long_name: xy component of deviatoric stress tensor data: data%stress%tau%xy(up,:,:) factor: scale_tau +[tau_eigen1] +dimensions: time, y1, x1 +units: Pa +long_name: first eigenvalue of horizontal stress tensor +data: data%calving%tau_eigen1 +load: 1 + +[tau_eigen2] +dimensions: time, y1, x1 +units: Pa +long_name: second eigenvalue of horizontal stress tensor +data: data%calving%tau_eigen2 +load: 1 + +[tau_eff_calving] +dimensions: time, y1, x1 +units: Pa +long_name: effective stress for calving +data: data%calving%tau_eff_calving + [wvel] dimensions: time, level, y1, x1 units: meter/year diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index 198476b3..8455e4f1 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -559,16 +559,20 @@ subroutine glissade_initialise(model, evolve_ice) model%numerics%dt, & model%numerics%dew*len0, & ! m model%numerics%dns*len0, & ! m - model%calving%strain_rate_eigenprod, & ! s^(-2) - model%calving%eigencalving_constant, & + model%calving%eigencalving_constant, & ! m/yr/Pa + model%calving%eigen2_weight, & + model%calving%tau_eigen1, & ! Pa + model%calving%tau_eigen2, & ! Pa + model%calving%tau_eff_calving, & ! Pa model%calving%calving_minthck, & model%calving%taumax_cliff, & model%calving%cliff_timescale, & model%calving%calving_mask, & model%calving%damage, & + model%calving%damage_constant, & model%calving%damage_threshold, & - model%calving%damage_column, & model%numerics%sigma, & + model%calving%calving_lateral, & model%calving%calving_thck, & cull_calving_front_in = model%options%cull_calving_front, & ncull_calving_front_in = model%calving%ncull_calving_front) @@ -624,6 +628,9 @@ subroutine glissade_initialise(model, evolve_ice) call glide_calclsrf(model%geometry%thck, model%geometry%topg, model%climate%eus, model%geometry%lsrf) model%geometry%usrf = max(0.d0, model%geometry%thck + model%geometry%lsrf) + !WHL - debug + if (main_task) print*, 'Done in glissade_initialise' + end subroutine glissade_initialise !======================================================================= @@ -646,13 +653,21 @@ subroutine glissade_tstep(model, time) ! --- Local variables --- integer :: i, j + integer :: itest, jtest, rtest ! ======================== + ! Set debug diagnostics + rtest = model%numerics%rdiag_local + itest = model%numerics%idiag_local + jtest = model%numerics%jdiag_local + ! Update internal clock model%numerics%time = time model%numerics%tstep_count = model%numerics%tstep_count + 1 + if (main_task .and. verbose_glissade) print*, 'glissade_tstep, test_count =', model%numerics%tstep_count + ! optional transport test ! code execution will end when this is done if (test_transport) then @@ -1867,16 +1882,20 @@ subroutine glissade_calving_solve(model) model%numerics%dt, & model%numerics%dew*len0, & ! m model%numerics%dns*len0, & ! m - model%calving%strain_rate_eigenprod, & ! s^(-2) - model%calving%eigencalving_constant, & + model%calving%eigencalving_constant, & ! m/yr/Pa + model%calving%eigen2_weight, & + model%calving%tau_eigen1, & ! Pa + model%calving%tau_eigen2, & ! Pa + model%calving%tau_eff_calving, & ! Pa model%calving%calving_minthck, & model%calving%taumax_cliff, & model%calving%cliff_timescale, & model%calving%calving_mask, & model%calving%damage, & + model%calving%damage_constant, & model%calving%damage_threshold, & - model%calving%damage_column, & model%numerics%sigma, & + model%calving%calving_lateral, & model%calving%calving_thck) !TODO: Are any other halo updates needed after calving? @@ -1997,9 +2016,10 @@ subroutine glissade_diagnostic_variable_solve(model) glissade_interior_dissipation_first_order, & glissade_flow_factor, & glissade_pressure_melting_point + use glissade_calving, only: verbose_calving use glam_grid_operators, only: glam_geometry_derivs use felix_dycore_interface, only: felix_velo_driver - + !WHL - debug use glissade_bmlt_float, only: glissade_basal_melting_float @@ -2021,11 +2041,12 @@ subroutine glissade_diagnostic_variable_solve(model) active_ice_mask ! = 1 where ice is dynamically active, else = 0 real(dp), dimension(model%general%ewn, model%general%nsn) :: & - thck_calving_front ! effective thickness of ice at the calving front + thck_calving_front ! effective thickness of ice at the calving front real(dp) :: & - dsigma, & ! layer thickness in sigma coordinates - strain_rate_xx, strain_rate_yy, strain_rate_xy ! strain rate components + dsigma, & ! layer thickness in sigma coordinates + tau_xx, tau_yy, tau_xy, & ! stress tensor components + strain_rate_xx, strain_rate_yy, strain_rate_xy ! strain rate tensor components real(dp) :: & a, b, c, root, & ! terms in quadratic formula @@ -2096,7 +2117,10 @@ subroutine glissade_diagnostic_variable_solve(model) ice_mask, & floating_mask = floating_mask, & ocean_mask = ocean_mask, & - land_mask = land_mask) + land_mask = land_mask, & + which_ho_calving_front = model%options%which_ho_calving_front, & + calving_front_mask = calving_front_mask, & + thck_calving_front = thck_calving_front) ! ------------------------------------------------------------------------ ! Compute the fraction of grounded ice in each cell @@ -2440,7 +2464,103 @@ subroutine glissade_diagnostic_variable_solve(model) model%velocity%vvel_mean(:,:) = model%velocity%vvel_mean(:,:) & + (1.0d0 - model%numerics%stagsigma(k-1)) * model%velocity%vvel(k,:,:) - ! strain rate tensor (s^-1) + ! Compute the vertically integrated stress tensor (Pa) and its eigenvalues. + ! These are used for some calving schemes. + + if ( (model%options%is_restart == RESTART_TRUE) .and. & + (model%numerics%time == model%numerics%tstart) ) then + + ! do nothing, since the tau eigenvalues are read from the restart file + + else ! compute the eigenvalues given the stress just computed in the velocity solver + + model%calving%tau_eigen1(:,:) = 0.0d0 + model%calving%tau_eigen2(:,:) = 0.0d0 + + do j = 1, model%general%nsn + do i = 1, model%general%ewn + + ! compute vertically averaged stress components + tau_xx = 0.0d0 + tau_yy = 0.0d0 + tau_xy = 0.0d0 + + do k = 1, model%general%upn-1 + dsigma = model%numerics%sigma(k+1) - model%numerics%sigma(k) + tau_xx = tau_xx + tau0 * model%stress%tau%xx(k,i,j) * dsigma + tau_yy = tau_yy + tau0 * model%stress%tau%yy(k,i,j) * dsigma + tau_xy = tau_xy + tau0 * model%stress%tau%xy(k,i,j) * dsigma + enddo + + ! compute the eigenvalues of the vertically integrated stress tensor + a = 1.0d0 + b = -(tau_xx + tau_yy) + c = tau_xx*tau_yy - tau_xy*tau_xy + if (b*b - 4.0d0*a*c > 0.0d0) then ! two real eigenvalues + root = sqrt(b*b - 4.0d0*a*c) + lambda1 = (-b + root) / (2.0d0*a) + lambda2 = (-b - root) / (2.0d0*a) + if (lambda1 > lambda2) then + model%calving%tau_eigen1(i,j) = lambda1 + model%calving%tau_eigen2(i,j) = lambda2 + else + model%calving%tau_eigen1(i,j) = lambda2 + model%calving%tau_eigen2(i,j) = lambda1 + endif + endif ! b^2 - 4ac > 0 + + enddo ! i + enddo ! j + + ! Extrapolate tau eigenvalues to inactive CF cells where the stress tensor is not computed. + do j = 2, model%general%nsn-1 + do i = 2, model%general%ewn-1 + if (calving_front_mask(i,j) == 1 .and. & + model%calving%tau_eigen1(i,j) == 0.0d0 .and. model%calving%tau_eigen2(i,j) == 0.0d0) then + + ! Look for nonzero values in an upstream cell + do jj = j-1, j+1 + do ii = i-1, i+1 + if (thck_calving_front(i,j) > 0.0d0 .and. & + model%geometry%thck(ii,jj) == thck_calving_front(i,j)) then + model%calving%tau_eigen1(i,j) = model%calving%tau_eigen1(ii,jj) + model%calving%tau_eigen2(i,j) = model%calving%tau_eigen2(ii,jj) + endif + enddo + enddo + + endif ! inactive CF cell + enddo + enddo + + endif ! restart + + call parallel_halo(model%calving%tau_eigen1) + call parallel_halo(model%calving%tau_eigen2) + + !WHL - debug + if (this_rank == rtest .and. verbose_calving) then + print*, ' ' + print*, 'tau eigen1 (Pa), i, j, rtest =:', itest, jtest, rtest + do j = jtest+3, jtest-3, -1 + write(6,'(i8)',advance='no') j + do i = itest-3, itest+3 + write(6,'(e11.3)',advance='no') model%calving%tau_eigen1(i,j) + enddo + print*, ' ' + enddo + print*, ' ' + print*, 'tau eigen2 (Pa), i, j, rtest =:', itest, jtest, rtest + do j = jtest+3, jtest-3, -1 + write(6,'(i8)',advance='no') j + do i = itest-3, itest+3 + write(6,'(e11.3)',advance='no') model%calving%tau_eigen2(i,j) + enddo + print*, ' ' + enddo + endif ! this_rank = rtest + + ! Compute the 3D strain rate tensor (s^{-1}) ! Note: The stress tensor tau is derived by taking strain rates at quadrature points in the velocity solve. ! The strain rate tensor is simply diagnosed from the stress tensor. where (model%stress%efvs > 0.0d0) @@ -2459,8 +2579,10 @@ subroutine glissade_diagnostic_variable_solve(model) model%velocity%strain_rate%xy = 0.0d0 endwhere - ! vertical mean effective viscosity + ! Compute various vertical means. ! TODO - Write a utility subroutine for vertical averaging + + ! Compute the vertical mean effective viscosity model%stress%efvs_vertavg = 0.0d0 do j = 1, model%general%nsn do i = 1, model%general%ewn @@ -2472,6 +2594,7 @@ subroutine glissade_diagnostic_variable_solve(model) enddo ! Compute the vertically integrated divergence of the horizontal velocity field. + ! Note: Units of divu and strain_rate components are s^{-1}. model%velocity%divu(:,:) = 0.0d0 do j = 1, model%general%nsn @@ -2484,85 +2607,6 @@ subroutine glissade_diagnostic_variable_solve(model) enddo enddo - ! Compute the determinant (= product of eigenvalues) of horizontal strain rate tensor; used for eigencalving - ! Note: For floating ice the vertical shear should be negligible, but sum over layers for generality. - ! Note: On restart, the correct stress and strain rate tensors are not available. Instead of computing eigenprod - ! at initialization, it is read from the restart file. - - if (model%options%whichcalving == EIGENCALVING) then - - if ( (model%options%is_restart == RESTART_TRUE) .and. & - (model%numerics%time == model%numerics%tstart) ) then - - ! do nothing, since the eigenproduct is read from the restart file - - else - - model%calving%strain_rate_eigenprod(:,:) = 0.0d0 - model%calving%strain_rate_eigen1(:,:) = 0.0d0 - model%calving%strain_rate_eigen2(:,:) = 0.0d0 - - do j = 1, model%general%nsn - do i = 1, model%general%ewn - - ! compute vertically averaged strain rate components - strain_rate_xx = 0.0d0 - strain_rate_yy = 0.0d0 - strain_rate_xy = 0.0d0 - - do k = 1, model%general%upn-1 - dsigma = model%numerics%sigma(k+1) - model%numerics%sigma(k) - strain_rate_xx = strain_rate_xx + model%velocity%strain_rate%xx(k,i,j) * dsigma - strain_rate_yy = strain_rate_yy + model%velocity%strain_rate%yy(k,i,j) * dsigma - strain_rate_xy = strain_rate_xy + model%velocity%strain_rate%xy(k,i,j) * dsigma - enddo - - ! compute the eigenvalues of the vertically integrated strain rate tensor - ! If both eigenvalues are positive, set the eigenproduct to their product - a = 1.0d0 - b = -(strain_rate_xx + strain_rate_yy) - c = strain_rate_xx*strain_rate_yy - strain_rate_xy*strain_rate_xy - if (b*b - 4.0d0*a*c > 0.0d0) then ! two real eigenvalues - root = sqrt(b*b - 4.0d0*a*c) - lambda1 = (-b + root) / (2.0d0*a) - lambda2 = (-b - root) / (2.0d0*a) - if (lambda1 > 0.0d0 .and. lambda2 > 0.0d0) then - model%calving%strain_rate_eigenprod(i,j) = lambda1 * lambda2 - endif - - !Note: eigen1 and eigen2 fields are diagnostic only, at least for now - if (lambda1 > lambda2) then - model%calving%strain_rate_eigen1(i,j) = lambda1 - model%calving%strain_rate_eigen2(i,j) = lambda2 - else - model%calving%strain_rate_eigen1(i,j) = lambda2 - model%calving%strain_rate_eigen2(i,j) = lambda1 - endif - - endif ! b^2 - 4ac > 0 - - enddo ! i - enddo ! j - - call parallel_halo(model%calving%strain_rate_eigenprod) - - !WHL - debug - if (this_rank == rtest .and. verbose_glissade) then - print*, ' ' - print*, 'strain_rate_eigenprod (yr^-2), i, j, rtest =:', itest, jtest, rtest - do j = jtest+3, jtest-3, -1 - write(6,'(i8)',advance='no') j - do i = itest-3, itest+3 - write(6,'(e11.3)',advance='no') model%calving%strain_rate_eigenprod(i,j)*scyr*scyr - enddo - print*, ' ' - enddo - endif ! this_rank = rtest - - endif ! is_restart - - endif ! eigencalving - ! magnitude of basal traction model%stress%btract(:,:) = sqrt(model%stress%btractx(:,:)**2 + model%stress%btracty(:,:)**2) diff --git a/libglissade/glissade_calving.F90 b/libglissade/glissade_calving.F90 index 3929db67..de8680f4 100644 --- a/libglissade/glissade_calving.F90 +++ b/libglissade/glissade_calving.F90 @@ -44,13 +44,15 @@ module glissade_calving integer, parameter :: boundary_color = -1 ! boundary color, represented by integer !WHL - debug - logical, parameter :: verbose_calving = .false. -!! logical, parameter :: verbose_calving = .true. +!! logical, parameter :: verbose_calving = .false. + logical, parameter :: verbose_calving = .true. + !TODO - Move these constants to glide_types + real(dp), parameter :: calving_lateral_max = 3000.d0 ! max lateral calving rate (m/yr) contains -!------------------------------------------------------------------------------- +!------------------------------------------------------------------------------- subroutine glissade_calving_mask_init(dx, dy, & thck, topg, & @@ -209,16 +211,19 @@ subroutine glissade_calve_ice(which_calving, & calving_timescale, & dt, & dx, dy, & - eigenprod, & eigencalving_constant, & + eigen2_weight, & + tau_eigen1, tau_eigen2, & + tau_eff_calving, & calving_minthck, & taumax_cliff, & cliff_timescale, & calving_mask, & damage, & + damage_constant, & damage_threshold, & - damage_column, & sigma, & + calving_lateral, & calving_thck, & cull_calving_front_in, & ncull_calving_front_in) @@ -255,25 +260,28 @@ subroutine glissade_calve_ice(which_calving, & real(dp), intent(in) :: thklim !> minimum thickness for dynamically active grounded ice real(dp), intent(in) :: marine_limit !> lower limit on topography elevation at marine edge before ice calves real(dp), intent(in) :: calving_fraction !> fraction of ice lost at marine edge when calving; - !> used with which_calving = CALVING_FLOAT_FRACTION + !> used with CALVING_FLOAT_FRACTION real(dp), intent(in) :: calving_timescale !> time scale for calving; calving_thck = thck * max(dt/calving_timescale, 1) !> if calving_timescale = 0, then calving_thck = thck real(dp), intent(in) :: dt !> model timestep (used with calving_timescale) real(dp), intent(in) :: dx, dy !> grid cell size in x and y directions (m) - real(dp), dimension(:,:), intent(inout) :: eigenprod !> determinant (product of eigenvalues) of horizontal strain rate tensor (s^{-2}) - real(dp), intent(in) :: eigencalving_constant !> dimensionless constant used for eigencalving + real(dp), intent(in) :: eigencalving_constant !> eigencalving constant; m/yr (lateral calving rate) per Pa (tensile stress) + real(dp), intent(in) :: eigen2_weight !> weight given to tau_eigen2 relative to tau_eigen1 in tau_eff_calving (unitless) + real(dp), dimension(:,:), intent(in) :: tau_eigen1 !> first eigenvalue of 2D horizontal stress tensor (Pa) + real(dp), dimension(:,:), intent(in) :: tau_eigen2 !> second eigenvalue of 2D horizontal stress tensor (Pa) + real(dp), dimension(:,:), intent(inout) :: tau_eff_calving !> effective stress (Pa) for calving; derived from tau_eigen1/2 real(dp), intent(in) :: calving_minthck !> min thickness of floating ice before it calves; - !> used with CALVING_THCK_THRESHOLD and EIGENCALVING + !> used with CALVING_THCK_THRESHOLD, EIGENCALVING and CALVING_DAMAGE real(dp), intent(in) :: taumax_cliff !> yield stress (Pa) for marine-based ice cliffs !> used with limit_marine_cliffs option real(dp), intent(in) :: cliff_timescale !> time scale for limiting marine cliff thickness integer, dimension(:,:), intent(in) :: calving_mask !> integer mask: calve ice where calving_mask = 1 - real(dp), dimension(:,:,:), intent(in) :: damage !> 3D scalar damage parameter -! real(dp), dimension(:,:,:), intent(inout) :: damage !> 3D scalar damage parameter - !WHL - 'inout' if damage is updated below - real(dp), dimension(:,:), intent(out) :: damage_column !> 2D vertically integrated scalar damage parameter + real(dp), dimension(:,:,:), intent(inout) :: damage !> 3D scalar damage parameter real(dp), intent(in) :: damage_threshold !> threshold value where ice is sufficiently damaged to calve + real(dp), intent(in) :: damage_constant !> rate of change of damage (1/yr) per unit stress (Pa) real(dp), dimension(:), intent(in) :: sigma !> vertical sigma coordinate + real(dp), dimension(:,:), intent(inout) :: calving_lateral !> lateral calving rate (m/yr) at the calving front + !> used with EIGENCALVING and CALVING_DAMAGE real(dp), dimension(:,:), intent(out) :: calving_thck !> thickness lost due to calving in each grid cell logical, intent(in), optional :: & @@ -297,13 +305,15 @@ subroutine glissade_calve_ice(which_calving, & real(dp), dimension(:,:), allocatable :: & thck_calving_front, & ! effective ice thickness at the calving front - thck_init ! value of thck before calving + thck_init, & ! value of thck before calving + tau1, tau2, & ! tau_eigen1 and tau_eigen2 (Pa), modified for calving + damage_column ! 2D vertically integrated scalar damage parameter real(dp), dimension(:,:), allocatable :: & - calving_thck_init ! debug diagnostic only + calving_thck_init ! debug diagnostic integer, dimension(:,:), allocatable :: & - color ! integer 'color' for filling the calving domain (with CALVING_DOMAIN_OCEAN_CONNECT) + color ! integer 'color' for filling the calving domain (with CALVING_DOMAIN_OCEAN_CONNECT) ! basic masks integer, dimension(:,:), allocatable :: & @@ -334,11 +344,12 @@ subroutine glissade_calve_ice(which_calving, & ! = 1.0 for which_calving = CALVING_FLOAT_ZERO real(dp) :: & - calving_rate, & ! lateral calving rate (m/yr) thinning_rate, & ! vertical thinning rate (m/yr, converted to scaled model units) calving_frac, & ! fraction of potential calving that is actually applied + frac_lateral, & ! calving_lateral / calving_lateral_max areafrac, & ! fractional ice-covered area in a calving_front cell dthck, & ! thickness change (model units) + d_damage_dt, & ! rate of change of damage scalar thckmax_cliff, & ! max stable ice thickness in marine_cliff cells factor ! factor in quadratic formula @@ -351,12 +362,6 @@ subroutine glissade_calve_ice(which_calving, & !WHL - debug integer :: sum_fill_local, sum_fill_global ! number of filled cells - integer :: iplot1, iplot2 - - !default -! iplot1 = nx-20 -! iplot2 = nx-1 - ! initialize if (present(cull_calving_front_in)) then @@ -432,10 +437,6 @@ subroutine glissade_calve_ice(which_calving, & print*, 'In glissade_calve_ice' print*, 'which_calving =', which_calving print*, 'calving_domain =', calving_domain -! print*, 'i, relx, topg, thck, usfc:' -! do i = iplot1, iplot2 -! print*, i, relx(i,j)*thk0, topg(i,j)*thk0, thck(i,j)*thk0, (topg(i,j) + thck(i,j))*thk0 -! enddo endif ! Set the thickness fraction to be removed in each calving cell @@ -461,7 +462,18 @@ subroutine glissade_calve_ice(which_calving, & ! Do the calving based on the value of which_calving - if (which_calving == EIGENCALVING) then + if (which_calving == EIGENCALVING .or. which_calving == CALVING_DAMAGE) then + + ! These two methods have several features in common: + ! (1) The eigenvalues of the 2D horizontal stress tensor are key fields controlling the calving rate. + ! (2) A lateral calving rate is computed in calving-front cells, then converted to a thinning rate. + ! (3) The thinning rate is applied to CF cells and, if sufficiently large, to adjacent interior cells. + ! + ! The main difference is that for eigencalving, the lateral calving rate is based on current stresses + ! at the calving front, whereas for damage-based calving, the lateral calving rate is based on damage, + ! which accumulates in floating cells due to stresses and then is advected downstream to the calving front. + ! + ! At some point, we may want to prognose damage in a way that depends on other factors such as mass balance. ! Save the initial thickness, which is used below to identify upstream interior cells. thck_init(:,:) = thck(:,:) @@ -472,9 +484,7 @@ subroutine glissade_calve_ice(which_calving, & ! the minimum thickness of a marine-based neighbor that is not on the calving front. ! Note: Cells with calving_front_mask = 1 are dynamically inactive unless thck >= thck_calving_front. ! For calving purposes, all calving_front cells are treated identically, whether or not - ! dynamically active. Inactive cells receive an eigenproduct by extrapolation - ! from active cells. - + ! dynamically active. Inactive cells receive eigenvalues by extrapolation from active cells. call glissade_get_masks(nx, ny, & thck, topg, & @@ -482,12 +492,12 @@ subroutine glissade_calve_ice(which_calving, & ice_mask, & floating_mask = floating_mask, & ocean_mask = ocean_mask, & + which_ho_calving_front = which_ho_calving_front, & calving_front_mask = calving_front_mask, & thck_calving_front = thck_calving_front) !WHL - Debug if (verbose_calving .and. this_rank == rtest) then - print*, ' ' print*, 'floating_mask, itest, jtest, rank =', itest, jtest, rtest do j = jtest+3, jtest-3, -1 @@ -497,8 +507,6 @@ subroutine glissade_calve_ice(which_calving, & enddo write(6,*) ' ' enddo - print*, ' ' - print*, ' ' print*, 'calving_front_mask, itest, jtest, rank =', itest, jtest, rtest do j = jtest+3, jtest-3, -1 @@ -509,7 +517,6 @@ subroutine glissade_calve_ice(which_calving, & write(6,*) ' ' enddo print*, ' ' - print*, 'thck_calving_front (m), itest, jtest, rank =', itest, jtest, rtest do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j @@ -518,7 +525,6 @@ subroutine glissade_calve_ice(which_calving, & enddo write(6,*) ' ' enddo - print*, ' ' print*, 'thck (m), itest, jtest, rank =', itest, jtest, rtest do j = jtest+3, jtest-3, -1 @@ -528,139 +534,243 @@ subroutine glissade_calve_ice(which_calving, & enddo write(6,*) ' ' enddo - - endif ! verbose + endif ! verbose_calving - ! Loop over cells, computing calving for cells on the calving front. - ! The calving rate is proportional to the eigenproduct in the cell, following Levermann et al. (2012). - ! If the cell has zero eigenproduct (likely as a result of being dynamically inactive in the last velocity solve), - ! then use the eigenproduct (if positive) from the upstream cell that determines thck_calving_front for this cell. + ! For each floating cell, compute an effective stress based on eigenvalues of the stress tensor. - ! Zero out the eigenproduct in grid cells that are not floating. - ! The idea is that spreading in grounded cells is not an accurate approximation - ! of spreading in adjacent floating cells. + allocate(tau1(nx,ny)) + allocate(tau2(nx,ny)) - do j = 1, ny - do i = 1, nx - if (floating_mask(i,j) == 0) then - eigenprod(i,j) = 0.0d0 - endif - enddo - enddo + ! Ignore negative eigenvalues corresponding to compressive stresses + tau1 = max(tau_eigen1, 0.0d0) + tau2 = max(tau_eigen2, 0.0d0) + + ! Ignore values on grounded ice + where (floating_mask == 0) + tau1 = 0.0d0 + tau2 = 0.0d0 + endwhere + + call parallel_halo(tau1) + call parallel_halo(tau2) + + ! In inactive calving-front cells where both eigenvalues are zero (because a cell is dynamically inactive), + ! extrapolate nonzero values in upstream cells. + ! Note: A similar extrapolation is done in glissade_diagnostic_variable_solve, but an extra one + ! may be useful here for cells where ice was just advected from upstream. - ! Extend eigenprod from active floating cells to adjacent (usually inactive) calving_front cells. do j = 2, ny-1 do i = 2, nx-1 if (calving_front_mask(i,j) == 1) then - - ! if eigenprod = 0 here, then look for positive eigenprod upstream - if (eigenprod(i,j) == 0) then - - ! loop over edge neighbors and choose the maximum spreading rate + if (tau1(i,j) == 0.0d0 .and. tau2(i,j) == 0) then do jj = j-1, j+1 do ii = i-1, i+1 - if (ii == i .or. jj == j) then ! edge neighbors only - if (thck_init(ii,jj) > 0.0d0 .and. calving_front_mask(ii,jj) == 0) then - eigenprod(i,j) = max(eigenprod(i,j), eigenprod(ii,jj)) - endif + if (thck_calving_front(i,j) > 0.0d0 .and. thck_init(ii,jj) == thck_calving_front(i,j)) then + tau1(i,j) = tau1(ii,jj) + tau2(i,j) = tau2(ii,jj) endif - enddo ! ii - enddo !! jj + enddo + enddo + endif ! tau1 = tau2 = 0 + endif ! calving_front_mask + enddo ! i + enddo ! j + + ! Compute the effective stress. + ! Note: By setting eigen2_weight > 1, we can give greater weight to the second principle stress. + ! This may be useful in calving unbuttressed shelves that are spreading in both directions. + + tau_eff_calving(:,:) = sqrt(tau1(:,:)**2 + (eigen2_weight*tau2(:,:))**2) + + if (verbose_calving .and. this_rank == rtest) then + print*, ' ' + print*, 'tau1 (Pa), itest, jtest, rank =', itest, jtest, rtest + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = itest-3, itest+3 + write(6,'(f10.2)',advance='no') tau1(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'tau2 (Pa), itest, jtest, rank =', itest, jtest, rtest + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = itest-3, itest+3 + write(6,'(f10.2)',advance='no') tau2(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'tau_eff_calving (Pa), itest, jtest, rank =', itest, jtest, rtest + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = itest-3, itest+3 + write(6,'(f10.2)',advance='no') tau_eff_calving(i,j) + enddo + write(6,*) ' ' + enddo + endif - if (eigenprod(i,j) == 0) then + ! Use the effective stress either to directly compute a lateral calving rate (for eigencalving), + ! or to accumulate damage which is then used to derive a lateral calving rate (for damage-based calving). - ! If no edge neighors have positive spreading, then loop over corner neighbors. - ! This will put spreading values in calving_front cells at the corners of fronts. - do jj = j-1, j+1 - do ii = i-1, i+1 - if (abs(ii-i) == 1 .and. abs(jj-j) == 1) then ! corner neighbors - if (thck_init(ii,jj) > 0.0d0 .and. calving_front_mask(ii,jj) == 0) then - eigenprod(i,j) = max(eigenprod(i,j), eigenprod(ii,jj)) - endif - endif - enddo ! ii - enddo ! jj + calving_lateral(:,:) = 0.0d0 - endif ! eigenprod = 0 after looping over edge neighbors + if (which_calving == EIGENCALVING) then - endif ! eigenprod = 0 + ! Compute the lateral calving rate (m/yr) from the effective tensile stress in calving_front cells - ! Do eigencalving in this calving_front cell + do j = 2, ny-1 + do i = 2, nx-1 + if (calving_front_mask(i,j) == 1) then + calving_lateral(i,j) = eigencalving_constant * tau_eff_calving(i,j) + endif + enddo ! i + enddo ! j - if (eigenprod(i,j) > 0.0d0 .and. thck_calving_front(i,j) > 0.0d0) then + elseif (which_calving == CALVING_DAMAGE) then - ! compute the calving rate as in Levermann et al. (2012) - ! Units: The eigencalving_constant K has units of m*yr. - ! The determinant has units of s^(-2); convert to yr^(-2). - ! Thus the calving rate has units of m/yr in the lateral direction. - ! Both dx and dy have units of m. Usually dx = dy, but take sqrt(dx*dy) for generality. - calving_rate = eigencalving_constant * eigenprod(i,j)*scyr*scyr + ! Prognose changes in damage. + ! For now, this is done using a simple scheme based on the effective tensile stress, tau_eff_calving. + ! The damage is subsequently advected downstream. + ! Note: The damage is formally a 3D field, which makes it easier to advect, even though + ! (in the current scheme) the damage source term is uniform in each column. + + do j = 2, ny-1 + do i = 2, nx-1 + if (floating_mask(i,j) == 1) then + d_damage_dt = damage_constant * tau_eff_calving(i,j) ! d_damage_dt has units of yr^{-1} + damage(:,i,j) = damage(:,i,j) + d_damage_dt * (dt*tim0/scyr) ! convert dt to yr + damage(:,i,j) = min(damage(:,i,j), 1.0d0) + damage(:,i,j) = max(damage(:,i,j), 0.0d0) + else ! set damage to zero for grounded ice + damage(:,i,j) = 0.0d0 + endif + enddo + enddo - ! Convert the lateral calving rate to a vertical thinning rate, conserving volume. - ! Note: The calved volume is proportional to the effective shelf-edge thickness (thck_calving_front), - ! not the nominal ice thickness (thck). - thinning_rate = calving_rate * thck_calving_front(i,j)*thk0 / sqrt(dx*dy) ! m/yr - dthck = thinning_rate * (tim0/scyr)/thk0 * dt ! convert to model units + ! Compute the vertically integrated damage in each column. + allocate(damage_column(nx,ny)) + damage_column(:,:) = 0.0d0 - if (verbose_calving .and. i==itest .and. j==jtest .and. this_rank==rtest) then - print*, ' ' - print*, 'Eigencalving: r, i, j =', rtest, itest, jtest - print*, 'dx (m), dt (yr) =', sqrt(dx*dy), dt*tim0/scyr - print*, 'spreading rate (yr-2) =', eigenprod(i,j)*scyr*scyr - print*, 'calving rate (m/yr) =', calving_rate - print*, 'dthck (m) =', thinning_rate * dt*tim0/scyr - endif + do j = 1, ny + do i = 1, nx + do k = 1, nz-1 + damage_column(i,j) = damage_column(i,j) + damage(k,i,j) * (sigma(k+1) - sigma(k)) + enddo + enddo + enddo - ! Compute the new ice thickness - ! If the column calves completely, then determine how much potential calving still remains. - - if (dthck > thck(i,j)) then - calving_frac = thck(i,j)/dthck - calving_rate = calving_rate * (1.0d0 - calving_frac) - calving_thck(i,j) = calving_thck(i,j) + thck(i,j) - thck(i,j) = 0.0d0 - - ! Apply some calving to the upstream cell with thck_init = thck_calving_front(i,j). - ! However, do not allow the upstream cell to end up thinner than thinning_limit*thck_init, - ! where thinning_limit is a scalar slightly less than 1. - ! The thinned upstream cell will usually be inactive during the next velocity solve. - - do jj = j-1, j+1 - do ii = i-1, i+1 - if (thck_init(ii,jj) > 0.0d0 .and. thck_init(ii,jj) == thck_calving_front(i,j)) then - thinning_rate = calving_rate * thck_calving_front(i,j)*thk0 / sqrt(dx*dy) ! m/yr - dthck = thinning_rate * (tim0/scyr)/thk0 * dt ! convert to model units - dthck = min(dthck, thck(ii,jj) - thinning_limit*thck_init(ii,jj)) - thck(ii,jj) = thck(ii,jj) - dthck - calving_thck(ii,jj) = calving_thck(ii,jj) + dthck - endif - enddo ! ii - enddo ! jj + ! Convert damage in CF cells to a lateral calving rate. + ! Note: Although eigenprod = 0 in inactive calving-front cells, these cells can have significant damage + ! advected from upstream, so in general we should not have to interpolate damage from upstream. + !TODO - Verify this. + ! Note: calving_lateral_max has units of m/yr + do j = 2, ny-1 + do i = 2, nx-1 + if (calving_front_mask(i,j) == 1) then + frac_lateral = (damage_column(i,j) - damage_threshold) / (1.0d0 - damage_threshold) + frac_lateral = max(0.0d0, min(1.0d0, frac_lateral)) + calving_lateral(i,j) = calving_lateral_max * frac_lateral ! m/yr + endif + enddo + enddo - else - thck(i,j) = thck(i,j) - dthck - calving_thck(i,j) = calving_thck(i,j) + dthck - endif + if (verbose_calving .and. this_rank==rtest) then + print*, ' ' + print*, 'damage increment, itest, jtest, rank =', itest, jtest, rtest + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = itest-3, itest+3 + write(6,'(f10.6)',advance='no') damage_constant * tau_eff_calving(i,j) * (dt*tim0/scyr) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'new damage, itest, jtest, rank =', itest, jtest, rtest + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = itest-3, itest+3 + write(6,'(f10.6)',advance='no') damage_column(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + endif + + endif ! EIGENCALVING or CALVING_DAMAGE + + ! The following operations are shared by eigencalving and damage-based calving. + + call parallel_halo(calving_lateral) + + ! Convert the lateral calving rate to a vertical thinning rate, conserving volume. + ! Note: The calved volume is proportional to the effective shelf-edge thickness (thck_calving_front), + ! not the nominal ice thickness (thck). + !TODO: Change variable names? E.g., thinning_rate is really a volume loss rate. + + do j = 2, ny-1 + do i = 2, nx-1 + if (calving_lateral(i,j) > 0.0d0) then + + thinning_rate = calving_lateral(i,j) * thck_calving_front(i,j)*thk0 / sqrt(dx*dy) ! m/yr + dthck = thinning_rate * (tim0/scyr)/thk0 * dt ! convert to model units + + if (verbose_calving .and. i==itest .and. j==jtest .and. this_rank==rtest) then + print*, ' ' + print*, 'Calving: r, i, j =', rtest, itest, jtest + print*, 'dx (m), dt (yr) =', sqrt(dx*dy), dt*tim0/scyr + print*, 'calving rate (m/yr) =', calving_lateral(i,j) + print*, 'dthck (m) =', thinning_rate * dt*tim0/scyr + endif + + ! Compute the new ice thickness + ! If the column calves completely, then apply the remaining calving to the upstream cell. + + if (dthck > thck(i,j)) then + calving_frac = thck(i,j)/dthck + calving_lateral(i,j) = calving_lateral(i,j) * (1.0d0 - calving_frac) ! remaining for upstream cell + calving_thck(i,j) = calving_thck(i,j) + thck(i,j) + thck(i,j) = 0.0d0 + + ! Apply some calving to the upstream cell with thck_init = thck_calving_front(i,j). + ! The thinned upstream cell will usually be inactive during the upcoming velocity solve. + + do jj = j-1, j+1 + do ii = i-1, i+1 + if (thck_init(ii,jj) > 0.0d0 .and. thck_init(ii,jj) == thck_calving_front(i,j)) then + thinning_rate = calving_lateral(i,j) * thck_calving_front(i,j)*thk0 / sqrt(dx*dy) ! m/yr + dthck = thinning_rate * (tim0/scyr)/thk0 * dt ! convert to model units + dthck = min(dthck, thck(ii,jj)) - endif ! eigenprod > 0 and thck_calving_front > 0 + thck(ii,jj) = thck(ii,jj) - dthck + calving_thck(ii,jj) = calving_thck(ii,jj) + dthck + endif + enddo ! ii + enddo ! jj - endif ! calving_front_mask = 1 + else ! dthck <= thck + thck(i,j) = thck(i,j) - dthck + calving_thck(i,j) = calving_thck(i,j) + dthck + endif + + endif ! calving_lateral > 0 enddo ! i enddo ! j if (verbose_calving .and. this_rank == rtest) then print*, ' ' - print*, 'eigenprod (yr-2), itest, jtest, rank =', itest, jtest, rtest + print*, 'Finished eigencalving or damage-based calving, task =', this_rank + print*, ' ' + print*, 'lateral calving rate (m/yr), itest, jtest, rank =', itest, jtest, rtest do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(e10.2)',advance='no') eigenprod(i,j) * scyr*scyr + write(6,'(f10.3)',advance='no') calving_lateral(i,j) enddo write(6,*) ' ' enddo - - print*, ' ' - print*, 'Finished eigencalving, task =', this_rank print*, ' ' print*, 'calving_thck (m), itest, jtest, rank =', itest, jtest, rtest do j = jtest+3, jtest-3, -1 @@ -681,13 +791,14 @@ subroutine glissade_calve_ice(which_calving, & enddo endif - endif ! eigencalving + endif ! eigencalving or damage-based calving + - ! Note: Both the CALVING_THCK_THRESHOLD and EIGENCALVING options incorporate thickness-based calving. - ! Eigencalving can be considered a special case in which thickness-based calving is preceded by - ! thinning in cells with a positive strain rate determinant. + if (which_calving == CALVING_THCK_THRESHOLD .or. which_calving == EIGENCALVING & + .or. which_calving == CALVING_DAMAGE) then - if (which_calving == CALVING_THCK_THRESHOLD .or. which_calving == EIGENCALVING) then + ! Note: Eigencalving or damage-based calving, if done above, is followed by thickness-based calving. + ! This helps get rid of thin ice near the CF where stress eigenvalues might be small. !WHL - debug calving_thck_init(:,:) = calving_thck(:,:) @@ -704,6 +815,7 @@ subroutine glissade_calve_ice(which_calving, & ice_mask, & floating_mask = floating_mask, & ocean_mask = ocean_mask, & + which_ho_calving_front = which_ho_calving_front, & calving_front_mask = calving_front_mask, & thck_calving_front = thck_calving_front) @@ -851,7 +963,7 @@ subroutine glissade_calve_ice(which_calving, & endif ! verbose - ! Clean up the calving front following eigencalving and/or thickness-based calving. + ! Following eigencalving and/or thickness-based calving, clean up the calving front. ! Note: A cell at an advancing calving front can have thck > thck_calving_front. ! Such a cell will be active during the next velocity calculation. ! In order to prevent unrealistic thicknesses at the calving front @@ -936,10 +1048,6 @@ subroutine glissade_calve_ice(which_calving, & write(6,*) ' ' enddo print*, ' ' - endif - - if (verbose_calving .and. this_rank==rtest) then - print*, ' ' print*, 'calving_mask, itest, jtest, rank =', itest, jtest, rtest do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j @@ -962,6 +1070,15 @@ subroutine glissade_calve_ice(which_calving, & enddo if (verbose_calving .and. this_rank==rtest) then + print*, ' ' + print*, 'calving_thck, itest, jtest, rank =', itest, jtest, rtest + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') calving_thck(i,j)*thk0 + enddo + write(6,*) ' ' + enddo print*, ' ' print*, 'new thck, itest, jtest, rank =', itest, jtest, rtest do j = jtest+3, jtest-3, -1 @@ -1058,53 +1175,6 @@ subroutine glissade_calve_ice(which_calving, & end where end if - case(CALVING_DAMAGE) ! remove ice that is sufficiently damaged - !WHL - This is a rough initial implementation - - !WHL - debug - test damage field for MISMIP -! print*, 'nx, ny =', nx, ny -! print*, 'Prescribe damage:' -! damage(:,:,:) = 0.d0 -! do j = nhalo+1, ny-nhalo -! do i = nhalo+1, nx-nhalo -! if (j == 3) then -! damage(:,i,j) = damage_threshold + 0.1d0 -! endif -! enddo -! enddo - - !TODO - Define ice_mask = 1 for dynamically active ice only (thck > thklim)? - - ! Diagnose the vertically integrated damage in each column, - ! assuming the 3D damage field has been prognosed external to this subroutine. - !WHL - For now, simply compute the thickness-weighted mean damage - damage_column(:,:) = 0.0d0 - do j = 1, ny - do i = 1, nx - if (ice_mask(i,j) == 1) then - do k = 1, nz-1 - damage_column(i,j) = damage_column(i,j) + damage(k,i,j) * (sigma(k+1) - sigma(k)) - enddo - endif - enddo - enddo - - ! set calving-law mask based on the vertically integrated damage - where (damage_column > damage_threshold) !WHL - could use '>=' instead of '>' if preferred - calving_law_mask = .true. - elsewhere - calving_law_mask = .false. - endwhere - - !WHL - debug - print values of calving_law_mask -! if (main_task) then -! print*, 'i, j, damage, calving_law_mask:' -! j = 3 -! do i = 1, nx -! print*, i, j, damage_column(i,j), calving_law_mask(i,j) -! enddo -! endif - end select ! halo update (may not be necessary if thck, damage, etc. are correct in halos, but including to be safe) @@ -1291,6 +1361,24 @@ subroutine glissade_calve_ice(which_calving, & !WHL - debug if (verbose_calving .and. this_rank==rtest) then +! print*, ' ' +! print*, 'calving_law_mask: itest, jtest, rank =', itest, jtest, rtest +! do j = jtest+3, jtest-3, -1 +! write(6,'(i6)',advance='no') j +! do i = itest-3, itest+3 +! write(6,'(l10)',advance='no') calving_law_mask(i,j) +! enddo +! write(6,*) ' ' +! enddo + print*, ' ' + print*, 'calving_domain_mask: itest, jtest, rank =', itest, jtest, rtest + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = itest-3, itest+3 + write(6,'(l10)',advance='no') calving_domain_mask(i,j) + enddo + write(6,*) ' ' + enddo print*, ' ' print*, 'After calving, new thck: itest, jtest, rank =', itest, jtest, rtest do j = jtest+3, jtest-3, -1 @@ -1469,7 +1557,10 @@ subroutine glissade_calve_ice(which_calving, & deallocate (thck_init) deallocate (marine_cliff_mask) - if (allocated(thck_init)) deallocate(thck_init) + if (allocated(calving_thck_init)) deallocate(calving_thck_init) + if (allocated(damage_column)) deallocate(damage_column) + if (allocated(tau1)) deallocate(tau1) + if (allocated(tau2)) deallocate(tau2) end subroutine glissade_calve_ice From 75fa0840a2dea90100739fb41b38a61fa2b4a4b9 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Thu, 26 Apr 2018 15:52:13 -0600 Subject: [PATCH 26/61] Added an optional grounding_line_mask This commit extents subroutine glissade_get_masks to optionally return a grounding line mask. This integer mask = 1 for cells that are floating but border grounded ice, or are grounded but border floating ice. I am testing this mask with some inversion changes. --- libglissade/glissade_masks.F90 | 74 +++++++++++++++++++++++++++------- 1 file changed, 60 insertions(+), 14 deletions(-) diff --git a/libglissade/glissade_masks.F90 b/libglissade/glissade_masks.F90 index 486cd827..3de31f37 100644 --- a/libglissade/glissade_masks.F90 +++ b/libglissade/glissade_masks.F90 @@ -59,6 +59,7 @@ subroutine glissade_get_masks(nx, ny, & floating_mask, & ocean_mask, & land_mask, & + grounding_line_mask, & active_ice_mask, & which_ho_calving_front, & calving_front_mask, & @@ -81,6 +82,7 @@ subroutine glissade_get_masks(nx, ny, & ! (2) floating_mask = 1 if ice is present (thck > thklim) and floating, else = 0 ! (3) ocean_mask = 1 if the topography is below sea level (topg < eus) and thk <= thklim, else = 0 ! (4) land_mask = 1 if the topography is at or above sea level (topg >= eus), else = 0 + ! (5) grounding_line_mask = 1 if a cell is adjacent to the grounding line, else = 0 ! (5) active_ice_mask = 1 for dynamically active cells, else = 0 ! With the subgrid calving front scheme, cells that lie on the calving front and have ! thck < thck_calving_front are inactive. Otherwise, all cells with ice_mask = 1 are active. @@ -129,9 +131,10 @@ subroutine glissade_get_masks(nx, ny, & ice_mask ! = 1 if thck > thklim, else = 0 integer, dimension(nx,ny), intent(out), optional :: & - floating_mask, & ! = 1 if thck > thklim and ice is floating; else = 0 - ocean_mask, & ! = 1 if topg is below sea level and thk <= thklim; else = 0 - land_mask, & ! = 1 if topg is at or above sea level; else = 0 + floating_mask, & ! = 1 if thck > thklim and ice is floating, else = 0 + ocean_mask, & ! = 1 if topg is below sea level and thk <= thklim, else = 0 + land_mask, & ! = 1 if topg is at or above sea level, else = 0 + grounding_line_mask, & ! = 1 if a cell is adjacent to the grounding line, else = 0 active_ice_mask, & ! = 1 if dynamically active, else = 0 calving_front_mask, & ! = 1 if ice is floating and borders at least one ocean cell, else = 0 marine_cliff_mask ! = 1 if ice is grounded and marine_based and borders at least one ocean @@ -213,6 +216,55 @@ subroutine glissade_get_masks(nx, ny, & if (present(floating_mask)) call parallel_halo(floating_mask) if (present(active_ice_mask)) call parallel_halo(active_ice_mask) + ! Identify grounded cells; this mask is used in some calculations below + if (present(floating_mask)) then + where (ice_mask == 1 .and. floating_mask == 0) + grounded_mask = 1 + elsewhere + grounded_mask = 0 + endwhere + endif + + ! Optionally, compute grounding line mask using grounded_mask, floating_mask and ocean_mask + + if (present(grounding_line_mask)) then + + if (.not.present(floating_mask) .or. .not.present(ocean_mask)) then + call write_log('Need floating_mask and ocean_mask to compute grounding_line_mask', GM_FATAL) + endif + + grounding_line_mask(:,:) = 0 + + do j = 2, ny-1 + do i = 2, nx-1 + + if (grounded_mask(i,j) == 1) then + ! check whether one or more neighbors is a floating or ocean cell + do jj = j-1, j+1 + do ii = i-1, i+1 + if (floating_mask(ii,jj) == 1 .or. ocean_mask(ii,jj) == 1) then + grounding_line_mask(i,j) = 1 + endif + enddo + enddo + elseif (floating_mask(i,j) == 1) then + ! check whether one or more neighbors is a grounded cell + do jj = j-1, j+1 + do ii = i-1, i+1 + if (grounded_mask(ii,jj) == 1) then + grounding_line_mask(i,j) = 1 + endif + enddo + enddo + endif ! grounded_mask or floating_mask + + enddo ! i + enddo ! j + + call parallel_halo(grounding_line_mask) + + endif ! present(grounding_line_mask) + ! Note: Halo calls are not included for the ocean and land masks. ! Halo values will still be correct, provided that topg is correct in halo cells. ! The reason not to include these calls is that for outflow global BCs, @@ -228,7 +280,11 @@ subroutine glissade_get_masks(nx, ny, & ! Optionally, compute the calving_front mask and effective calving_front thickness - if (present(calving_front_mask) .and. present(which_ho_calving_front)) then + if (present(calving_front_mask)) then + + if (.not.present(which_ho_calving_front)) then + call write_log('Need which_ho_calving_front to compute calving_front_mask', GM_FATAL) + endif if (which_ho_calving_front == HO_CALVING_FRONT_SUBGRID) then @@ -238,16 +294,6 @@ subroutine glissade_get_masks(nx, ny, & calving_front_mask(:,:) = 0 floating_interior_mask(:,:) = 0 - grounded_mask(:,:) = 0 - - ! Identify grounded cells - do j = 1, ny - do i = 1, nx - if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then - grounded_mask(i,j) = 1 - endif - enddo - enddo ! Identify calving front cells (floating cells that border ice-free ocean) ! and floating interior cells (floating cells not at the calving front). From db614ebf0418a5d02a957508bdf1c36e203a4ac9 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Thu, 26 Apr 2018 16:51:12 -0600 Subject: [PATCH 27/61] Inversion changes, including topg inversion and moving averages * New versions of the subroutines to invert for basal traction and melting parameters. I left the old versions in place for now, in case we want to compare them later. * A new subroutine to invert for basal topography (on the assumption that there could be topography errors in the data, and we might get a better match to usrf_obs by adjusting topg than by adjusting thck). Changes in topg are limited to a prescribed upper limit, relative to observations. This subroutine is turned off by default, pending more testing. * Changes in the other new inversion subroutines to invert for basal parameters based on usrf instead of thck. Inversion based on usrf is identical to inversion based on thck if topg is fixed, but not if topg can vary. * Inversion for Cp in floating cells adjacent to the grounding line. * Inversion for bmlt_float in grounded cells adjacent to the grounding line. * Prescribed bmlt_float during the forward run is now limited to cells that are floating or GL-adjacent. If a cell regrounds and is not GL-adjacent, bmlt_float is turned off. I had relaxed this rule earlier when trying to limit GL advance in forward runs. * An option to compute moving averages (instead of snapshots) of usrf and dthck_dt, both of which are used to adjust Cp. Moving averages are a way to avoid 2-delta-t noise (i.e., a change in usrf drives a change in Cp which immediately drives usrf in the other direction, leading to oscillations). The moving average is exponential, which means that values at each time step are gradually discounted over time, and only one field must be held in memory. The amount of temporal smoothing is controlled by a new parameter, inversion_babc_time_smoothing, with a default of 0.0 (no smoothing). As this parameter approaches 1.0, there is increased weighting of old values. * Renamed inversion_babc_smoothing_factor to inversion_babc_space_smoothing (in analogy to inversion_babc_time_smoothing) * Some changes in the order of inversion operations. These changes have been tested for Antarctica and Greenland. This testing led to some of the other recent commits. Thanks to these and other recent changes, there is now less flickering in spinup inversion runs than I saw before. The number of grounded and floating cells is very consistent over time. In an Antarctic forward run, the GL still advances in several places (especially the West Shelf) in the first 200 years, but overall the forward run looks reasonable. At some point I will try to improve it, possibly by inverting for basal topography. This commit is BFB for runs without inversion. --- libglide/glide_setup.F90 | 17 +- libglide/glide_types.F90 | 40 +- libglide/glide_vars.def | 39 +- libglissade/glissade.F90 | 639 +++++++++----- libglissade/glissade_inversion.F90 | 1321 ++++++++++++++++++++++++---- 5 files changed, 1677 insertions(+), 379 deletions(-) diff --git a/libglide/glide_setup.F90 b/libglide/glide_setup.F90 index 51ffb3cf..836ecd76 100644 --- a/libglide/glide_setup.F90 +++ b/libglide/glide_setup.F90 @@ -1640,7 +1640,8 @@ subroutine handle_parameters(section, model) call GetValue(section, 'inversion_babc_timescale', model%basal_physics%inversion_babc_timescale) call GetValue(section, 'inversion_babc_thck_scale', model%basal_physics%inversion_babc_thck_scale) call GetValue(section, 'inversion_babc_dthck_dt_scale', model%basal_physics%inversion_babc_dthck_dt_scale) - call GetValue(section, 'inversion_babc_smoothing_factor', model%basal_physics%inversion_babc_smoothing_factor) + call GetValue(section, 'inversion_babc_space_smoothing', model%basal_physics%inversion_babc_space_smoothing) + call GetValue(section, 'inversion_babc_time_smoothing', model%basal_physics%inversion_babc_time_smoothing) ! ISMIP-HOM parameters call GetValue(section,'periodic_offset_ew',model%numerics%periodic_offset_ew) @@ -1954,8 +1955,11 @@ subroutine print_parameters(model) write(message,*) 'inversion dthck/dt scale (m/yr) : ', & model%basal_physics%inversion_babc_dthck_dt_scale call write_log(message) - write(message,*) 'inversion basal traction smoothing factor : ', & - model%basal_physics%inversion_babc_smoothing_factor + write(message,*) 'inversion basal traction space smoothing : ', & + model%basal_physics%inversion_babc_space_smoothing + call write_log(message) + write(message,*) 'inversion basal traction time smoothing : ', & + model%basal_physics%inversion_babc_time_smoothing call write_log(message) endif elseif (model%options%which_ho_babc == HO_BABC_COULOMB_POWERLAW_TSAI) then @@ -2558,8 +2562,11 @@ subroutine define_glide_restart_variables(options) select case(options%which_ho_inversion) case (HO_INVERSION_COMPUTE) ! If computing powerlaw_c and bmlt_float by inversion, these fields are needed for restart. + ! usrf_inversion and dthck_dt_inversion are computed as moving averages while adjusting powerlaw_c call glide_add_to_restart_variable_list('powerlaw_c_inversion') call glide_add_to_restart_variable_list('bmlt_float_inversion') + call glide_add_to_restart_variable_list('dthck_dt_inversion') + call glide_add_to_restart_variable_list('usrf_inversion') case (HO_INVERSION_PRESCRIBED) ! Write powerlaw_c_inversion to the restart file, because it is ! continually adjusted at runtime as the grounding line moves. @@ -2580,7 +2587,9 @@ subroutine define_glide_restart_variables(options) ! then thck_obs needs to be in the restart file; !TODO - Remove thck_obs, keep usrf_obs? if (options%which_ho_inversion == HO_INVERSION_COMPUTE) then - call glide_add_to_restart_variable_list('thck_obs') +!! call glide_add_to_restart_variable_list('thck_obs') + call glide_add_to_restart_variable_list('usrf_obs') + call glide_add_to_restart_variable_list('topg_obs') endif ! geothermal heat flux option diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index 86041835..22f5a678 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -833,6 +833,12 @@ module glide_types real(dp),dimension(:,:),pointer :: thck_obs => null() !> Observed ice thickness, divided by \texttt{thk0}. + real(dp),dimension(:,:),pointer :: usrf_obs => null() + !> Observed upper surface elevation, divided by \texttt{thk0}. + + real(dp),dimension(:,:),pointer :: topg_obs => null() + !> Observed basal topography, divided by \texttt{thk0}. + real(dp),dimension(:,:),pointer :: f_flotation => null() !> flotation function, (rhoi*thck) / (-rhoo*(topg-eus)) !> previously was f_pattyn = -rhoo*(topg-eus)/(rhoi*thck) @@ -847,8 +853,8 @@ module glide_types !> Used to be called 'age', but changed to 'ice_age' for easier grepping real(dp),dimension(:,:),pointer :: thck_old => null() !> old ice thickness, divided by \texttt{thk0} - real(dp),dimension(:,:),pointer :: dthck_dt => null() !> ice thickness tendency, divided by \texttt{thk0/tim0} - real(dp),dimension(:,:),pointer :: dthck_dt_tavg => null() !> ice thickness tendency, divided by \texttt{thk0/tim0} (time average) + real(dp),dimension(:,:),pointer :: dthck_dt => null() !> ice thickness tendency (m/s) + real(dp),dimension(:,:),pointer :: dthck_dt_tavg => null() !> ice thickness tendency (m/s, time average) real(dp),dimension(:,:),pointer :: cell_area => null() !> The cell area of the grid, divided by \texttt{len0*len0}. @@ -1382,7 +1388,8 @@ module glide_types real(dp), dimension(:,:), pointer :: powerlaw_c_inversion => null() !< spatially varying powerlaw_c field, Pa m^(-1/3) yr^(1/3) real(dp), dimension(:,:), pointer :: powerlaw_c_inversion_tavg => null() !< spatially varying powerlaw_c field, time average real(dp), dimension(:,:), pointer :: powerlaw_c_prescribed => null() !< powerlaw_c field, prescribed from a previous inversion - real(dp), dimension(:,:), pointer :: coulomb_c_inversion => null() !< spatially varying coulomb_c field (unitless) + real(dp), dimension(:,:), pointer :: usrf_inversion => null() !< upper surface elevation used for Cp inversion (m) + real(dp), dimension(:,:), pointer :: dthck_dt_inversion => null() !< dH/dt used for Cp inversion (m/s) ! parameters for reducing the effective pressure where the bed is warm, saturated or connected to the ocean real(dp) :: effecpress_delta = 0.02d0 !< multiplier for effective pressure N where the bed is saturated and/or thawed (unitless) @@ -1440,10 +1447,12 @@ module glide_types powerlaw_c_min = 1.0d2 !< Pa (m/yr)^(-1/3) real(dp) :: & - inversion_babc_timescale = 500.d0, & !< inversion timescale (yr); must be > 0 - inversion_babc_thck_scale = 100.d0, & !< thickness inversion scale (m); must be > 0 - inversion_babc_dthck_dt_scale = 0.10d0, & !< dthck_dt inversion scale (m/yr); must be > 0 - inversion_babc_smoothing_factor = 1.0d-2 !< factor for smoothing powerlaw_c (larger => more smoothing) + inversion_babc_timescale = 500.d0, & !< inversion timescale (yr); must be > 0 + inversion_babc_thck_scale = 100.d0, & !< thickness inversion scale (m); must be > 0 + inversion_babc_dthck_dt_scale = 0.10d0, & !< dthck_dt inversion scale (m/yr); must be > 0 + inversion_babc_space_smoothing = 1.0d-2, & !< factor for spatial smoothing of powerlaw_c; larger => more smoothing + inversion_babc_time_smoothing = 0.0d0 !< factor for exponential moving average of usrf/dthck_dt_inversion + !< range [0,1]; larger => slower discounting of old values, more smoothing ! parameter for constant basal water ! Note: This parameter applies to HO_BWAT_CONSTANT only. @@ -1931,6 +1940,8 @@ subroutine glide_allocarr(model) !> \item \texttt{lsrf(ewn,nsn))} !> \item \texttt{topg(ewn,nsn))} !> \item \texttt{thck_obs(ewn,nsn))} + !> \item \texttt{usrf_obs(ewn,nsn))} + !> \item \texttt{topg_obs(ewn,nsn))} !> \item \texttt{mask(ewn,nsn))} !> \item \texttt{age(upn-1,ewn,nsn))} !> \item \texttt{tracers(ewn,nsn,ntracers,upn-1)} @@ -2136,6 +2147,8 @@ subroutine glide_allocarr(model) call coordsystem_allocate(model%general%ice_grid, model%geometry%lsrf) call coordsystem_allocate(model%general%ice_grid, model%geometry%topg) call coordsystem_allocate(model%general%ice_grid, model%geometry%thck_obs) + call coordsystem_allocate(model%general%ice_grid, model%geometry%usrf_obs) + call coordsystem_allocate(model%general%ice_grid, model%geometry%topg_obs) call coordsystem_allocate(model%general%ice_grid, model%geometry%thkmask) call coordsystem_allocate(model%general%velo_grid, model%geometry%stagmask) call coordsystem_allocate(model%general%ice_grid, model%geometry%cell_area) @@ -2210,7 +2223,8 @@ subroutine glide_allocarr(model) call coordsystem_allocate(model%general%ice_grid, model%basal_physics%powerlaw_c_inversion) call coordsystem_allocate(model%general%ice_grid, model%basal_physics%powerlaw_c_inversion_tavg) call coordsystem_allocate(model%general%ice_grid, model%basal_physics%powerlaw_c_prescribed) - call coordsystem_allocate(model%general%ice_grid, model%basal_physics%coulomb_c_inversion) + call coordsystem_allocate(model%general%ice_grid, model%basal_physics%usrf_inversion) + call coordsystem_allocate(model%general%ice_grid, model%basal_physics%dthck_dt_inversion) endif endif ! glam/glissade @@ -2552,8 +2566,10 @@ subroutine glide_deallocarr(model) deallocate(model%basal_physics%powerlaw_c_inversion_tavg) if (associated(model%basal_physics%powerlaw_c_prescribed)) & deallocate(model%basal_physics%powerlaw_c_prescribed) - if (associated(model%basal_physics%coulomb_c_inversion)) & - deallocate(model%basal_physics%coulomb_c_inversion) + if (associated(model%basal_physics%usrf_inversion)) & + deallocate(model%basal_physics%usrf_inversion) + if (associated(model%basal_physics%dthck_dt_inversion)) & + deallocate(model%basal_physics%dthck_dt_inversion) if (associated(model%basal_physics%C_space_factor)) & deallocate(model%basal_physics%C_space_factor) if (associated(model%basal_physics%C_space_factor_stag)) & @@ -2636,6 +2652,10 @@ subroutine glide_deallocarr(model) deallocate(model%geometry%topg) if (associated(model%geometry%thck_obs)) & deallocate(model%geometry%thck_obs) + if (associated(model%geometry%usrf_obs)) & + deallocate(model%geometry%usrf_obs) + if (associated(model%geometry%topg_obs)) & + deallocate(model%geometry%topg_obs) if (associated(model%geometry%thkmask)) & deallocate(model%geometry%thkmask) if (associated(model%geometry%stagmask)) & diff --git a/libglide/glide_vars.def b/libglide/glide_vars.def index e732126c..6e48c369 100644 --- a/libglide/glide_vars.def +++ b/libglide/glide_vars.def @@ -506,6 +506,24 @@ factor: thk0 load: 1 coordinates: lon lat +[usrf_obs] +dimensions: time, y1, x1 +units: meter +long_name: observed surface elevation +data: data%geometry%usrf_obs +factor: thk0 +load: 1 +coordinates: lon lat + +[topg_obs] +dimensions: time, y1, x1 +units: meter +long_name: observed bed topography +data: data%geometry%topg_obs +factor: thk0 +load: 1 +coordinates: lon lat + [calving_thck] dimensions: time, y1, x1 units: meter @@ -852,13 +870,22 @@ data: data%basal_physics%powerlaw_c_prescribed load: 1 coordinates: lon lat -[coulomb_c_inversion] -dimensions: time, y1, x1 -units: unitless [0,1] -long_name: spatially varying C for Coulomb sliding -data: data%basal_physics%coulomb_c_inversion -load: 0 +[usrf_inversion] +dimensions: time, y1,x1 +units: meter +long_name: surface elevation used for inversion +data: data%basal_physics%usrf_inversion +coordinates: lon lat +load: 1 + +[dthck_dt_inversion] +dimensions: time, y1,x1 +units: meter/year +long_name: dH/dt used for inversion +data: data%basal_physics%dthck_dt_inversion +factor: scyr coordinates: lon lat +load: 1 [artm] dimensions: time, y1, x1 diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index 8455e4f1..11883127 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -75,9 +75,7 @@ module glissade real(dp), parameter :: thk_init = 500.d0 ! initial thickness (m) for test_transport logical, parameter :: test_halo = .false. ! if true, call test_halo subroutine -!! logical, parameter :: verbose_inversion = .false. - logical, parameter :: verbose_inversion = .true. - + logical, parameter :: new_inversion = .true. contains @@ -111,8 +109,8 @@ subroutine glissade_initialise(model, evolve_ice) use glide_diagnostics, only: glide_init_diag use glissade_calving, only: glissade_calving_mask_init, glissade_calve_ice use glissade_calving, only: glissade_find_lakes !TODO - Move this subroutine? - use glissade_inversion, only: glissade_init_inversion - use glimmer_paramets, only: thk0, len0, tim0, evs0 + use glissade_inversion, only: glissade_init_inversion, verbose_inversion + use glimmer_paramets, only: thk0, len0, tim0 use felix_dycore_interface, only: felix_velo_init implicit none @@ -616,7 +614,11 @@ subroutine glissade_initialise(model, evolve_ice) ! An update is done here regardless of code options, just to be on the safe side. call parallel_halo(model%stress%efvs) + ! recalculate the lower and upper ice surface + call glide_calclsrf(model%geometry%thck, model%geometry%topg, model%climate%eus, model%geometry%lsrf) + model%geometry%usrf = max(0.d0, model%geometry%thck + model%geometry%lsrf) + ! Optionally, do initial calculations for inversion if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then @@ -624,10 +626,6 @@ subroutine glissade_initialise(model, evolve_ice) endif ! which_ho_inversion - ! recalculate the lower and upper ice surface - call glide_calclsrf(model%geometry%thck, model%geometry%topg, model%climate%eus, model%geometry%lsrf) - model%geometry%usrf = max(0.d0, model%geometry%thck + model%geometry%lsrf) - !WHL - debug if (main_task) print*, 'Done in glissade_initialise' @@ -1158,6 +1156,9 @@ subroutine glissade_transport_solve(model) use glissade_masks, only: glissade_get_masks use glissade_inversion, only: invert_bmlt_float, prescribe_bmlt_float, & invert_basal_traction, prescribe_basal_traction + use glissade_inversion, only: invert_bmlt_float_new, prescribe_bmlt_float_new, & + invert_basal_traction_new, prescribe_basal_traction_new + use glissade_inversion, only: invert_basal_topography, verbose_inversion implicit none @@ -1170,21 +1171,27 @@ subroutine glissade_transport_solve(model) ! temporary arrays in SI units real(dp), dimension(model%general%ewn,model%general%nsn) :: & thck_unscaled, & ! ice thickness (m) + topg_unscaled, & ! bedrock topography (m) + thck_new_unscaled, & ! expected new ice thickness, after mass balance (m) + lsrf_new_unscaled, & ! expected new lower surface elevation (m) + usrf_new_unscaled, & ! expected new upper surface elevation (m) acab_unscaled, & ! surface mass balance (m/s) bmlt_unscaled ! = bmlt (m/s) if basal mass balance is included in continuity equation, else = 0 ! masks integer, dimension(model%general%ewn, model%general%nsn) :: & - ice_mask, & ! = 1 if thck > 0, else = 0 - floating_mask, & ! = 1 where ice is present and floating, else = 0 - ocean_mask, & ! = 1 if topg is below sea level and thck = 0, else = 0 - land_mask, & ! = 1 if topg is at or above sea level, else = 0 - calving_front_mask ! = 1 where ice is floating and borders an ocean cell, else = 0 + ice_mask, & ! = 1 if thck > 0, else = 0 + floating_mask, & ! = 1 where ice is present and floating, else = 0 + ocean_mask, & ! = 1 if topg is below sea level and thck = 0, else = 0 + land_mask, & ! = 1 if topg is at or above sea level, else = 0 + grounding_line_mask, & ! = 1 if a cell is adjacent to the grounding line, else = 0 + calving_front_mask ! = 1 where ice is floating and borders an ocean cell, else = 0 real(dp), dimension(model%general%ewn, model%general%nsn) :: & thck_flotation, & ! thickness at which ice is exactly floating thck_calving_front, & ! effective thickness of ice at the calving front - effective_areafrac ! effective fractional area of ice at the calving front + effective_areafrac, & ! effective fractional area of ice at the calving front + dthck_dt_inversion ! dH/dt resulting from transport and mass balance (m/s) real(dp) :: previous_time ! time (yr) at the start of this time step ! (The input time is the time at the end of the step.) @@ -1192,6 +1199,7 @@ subroutine glissade_transport_solve(model) real(dp) :: advective_cfl ! advective CFL number ! If advective_cfl > 1, the model is unstable without subcycling real(dp) :: dt_transport ! time step (s) for transport; = model%numerics%dt*tim0 by default + real(dp) :: alpha ! shorthand for inversion_babc_time_smoothing, in range [0,1] integer :: nsubcyc ! number of times to subcycle advection @@ -1204,6 +1212,9 @@ subroutine glissade_transport_solve(model) integer :: ewn, nsn, upn integer :: itest, jtest, rtest + !TODO - Make invert_topg a config option + logical :: invert_topg = .false. + rtest = -999 itest = 1 jtest = 1 @@ -1251,6 +1262,22 @@ subroutine glissade_transport_solve(model) call t_startf('glissade_transport_driver') + ! ------------------------------------------------------------------------ + ! Compute some masks prior to horizontal transport. + ! Some of these masks are used for inversion calculations. + ! ------------------------------------------------------------------------ + + call glissade_get_masks(model%general%ewn, model%general%nsn, & + model%geometry%thck*thk0, & ! m + model%geometry%topg*thk0, & ! m + model%climate%eus*thk0, & ! m + 0.0d0, & ! thklim = 0 + ice_mask, & + floating_mask = floating_mask, & + ocean_mask = ocean_mask, & + land_mask = land_mask, & + grounding_line_mask = grounding_line_mask) + ! For the enthalpy option, derive enthalpy from temperature and waterfrac. ! Must transport enthalpy rather than temperature/waterfrac to conserve energy. !TODO: Move this code to glissade_transport_setup_tracers? @@ -1269,11 +1296,13 @@ subroutine glissade_transport_solve(model) ! copy tracers (temp/enthalpy, etc.) into model%geometry%tracers call glissade_transport_setup_tracers (model) - ! temporary in/out array in SI units + ! temporary in/out arrays in SI units thck_unscaled(:,:) = model%geometry%thck(:,:) * thk0 + topg_unscaled(:,:) = model%geometry%topg(:,:) * thk0 ! pre-transport halo updates for thickness and tracers call parallel_halo(thck_unscaled) + call parallel_halo(topg_unscaled) call parallel_halo_tracers(model%geometry%tracers) call parallel_halo_tracers(model%geometry%tracers_usrf) call parallel_halo_tracers(model%geometry%tracers_lsrf) @@ -1373,13 +1402,15 @@ subroutine glissade_transport_solve(model) call parallel_halo(thck_unscaled) call parallel_halo_tracers(model%geometry%tracers) - enddo ! subcycling + enddo ! subcycling of transport !------------------------------------------------------------------------- ! Apply the surface and basal mass balances. ! Note: The basal mass balance has been computed in subroutine glissade_bmlt_float_solve. !------------------------------------------------------------------------- + !TODO - Remove the following call to glissade_get_masks + go to 800 ! ------------------------------------------------------------------------ ! Get masks used for the mass balance calculation. ! Pass thklim = 0 to identify cells with thck > 0 (not thck > thklim). @@ -1389,7 +1420,7 @@ subroutine glissade_transport_solve(model) call glissade_get_masks(model%general%ewn, model%general%nsn, & thck_unscaled, & ! m - model%geometry%topg*thk0, & ! m + topg_unscaled, & ! m model%climate%eus*thk0, & ! m 0.0d0, & ! thklim = 0 ice_mask, & @@ -1414,6 +1445,7 @@ subroutine glissade_transport_solve(model) endif enddo enddo +800 continue !------------------------------------------------------------------------- ! Adjust the surface mass balance (acab) as needed. @@ -1464,6 +1496,9 @@ subroutine glissade_transport_solve(model) model%climate%acab_corrected) endif + ! Convert acab_corrected to a temporary array in SI units (m/s) + acab_unscaled(:,:) = model%climate%acab_corrected(:,:) * thk0/tim0 + !------------------------------------------------------------------------- ! Handle the basal mass balance. !------------------------------------------------------------------------- @@ -1478,61 +1513,227 @@ subroutine glissade_transport_solve(model) bmlt_unscaled(:,:) = 0.0d0 endif - ! ------------------------------------------------------------------------ - ! If inverting for bmlt beneath floating ice, then compute bmlt_float_inversion here. - ! ------------------------------------------------------------------------ + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + print*, 'acab (m/yr), itest, jtest, rank =', itest, jtest, rtest + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') acab_unscaled(i,j)*scyr + enddo + write(6,*) ' ' + enddo + endif + + !------------------------------------------------------------------------- + ! Optionally, invert for basal fields: topography, basal traction and basal melting. + !------------------------------------------------------------------------- - ! Note: Other kinds of basal melting are handled in subroutine glissade_bmlt_float_solve. - ! Inversion is done here, after transport, when there is an updated ice thickness. - ! Then bmlt_float_inversion is added to the previously computed bmlt. - ! Note: Usually, whichbmlt_float = 0 when doing inversion. - ! However, for the HO_INVERSION_PRESCRIBED option, we may want to add a basal melting anomaly - ! as for the initMIP anomaly experiments. In that case the anomaly is already part of bmlt_float. - ! Note: If the basal melt GLP is turned on, it sets bmlt_float = 0 in partly floating cells. - ! However, it does not limit bmlt_float_inversion, which is applied to all floating cells, - ! including partly floating cells (in order to match observed thicknesses at the grounding line). - - if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then - - ! Invert for bmlt_float_inversion, adjusting the melt rate to relax toward the observed thickness. - ! Note: basal_melt%bmlt_float_inversion is passed out with units of m/s - - call invert_bmlt_float(model%numerics%dt * tim0, & ! s - model%general%ewn, model%general%nsn, & - itest, jtest, rtest, & - model%basal_melt, & - thck_unscaled, & ! m - model%geometry%thck_obs*thk0, & ! m - model%geometry%topg*thk0, & ! m - model%climate%eus*thk0, & ! m - model%climate%acab_corrected*thk0/tim0, & ! m/s - model%basal_melt%bmlt*thk0/tim0, & ! m/s - ice_mask, & - floating_mask, & - land_mask) + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & + model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then - !WHL - debug - if (verbose_inversion .and. this_rank == rtest) then - i = itest - j = jtest - print*, ' ' - print*, 'Inverting for bmlt_float: rank, i, j =', rtest, i, j - print*, 'thck (m), thck_obs (m), bmlt_float_inversion (m/yr):', thck_unscaled(i,j), & - model%geometry%thck_obs(i,j)*thk0, model%basal_melt%bmlt_float_inversion(i,j)*scyr - print*, ' ' - endif + ! Compute a temporary topg array in SI units (m) + topg_unscaled(:,:) = model%geometry%topg(:,:) * thk0 + + ! Compute the expected new ice thickness and upper surface elevation, without inversion. + thck_new_unscaled = thck_unscaled(:,:) + (acab_unscaled - bmlt_unscaled) * model%numerics%dt*tim0 + thck_new_unscaled = max(thck_new_unscaled, 0.0d0) + + ! Calculate the expected new lower and upper ice surface + ! Note: usrf_new_unscaled is used in inversion calculations, but model%geometry%usrf is not updated + ! until after the mass balance calculation. + call glide_calclsrf(thck_new_unscaled, topg_unscaled, model%climate%eus*thk0, lsrf_new_unscaled) + usrf_new_unscaled = max(0.d0, thck_new_unscaled + lsrf_new_unscaled) + + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then + + ! Invert for basal topography in cells adjacent to the grounding line. + ! The goal is to correct for observation errors which might imply a cell is grounded + ! when it is really floating, or vice versa. + ! For cells where usrf > usrf_obs, the topography is lowered (to reduce usrf and f_ground), + ! and for cells where usrf < usrf_obs, the topography is raised (to increasee usrf and f_ground). + + if (invert_topg) then + call invert_basal_topography(model%numerics%dt*tim0, & ! s + model%general%ewn, model%general%nsn, & + itest, jtest, rtest, & + ice_mask, & + grounding_line_mask, & + usrf_new_unscaled, & ! m + model%geometry%usrf_obs*thk0, & ! m + topg_unscaled, & ! m + model%geometry%topg_obs*thk0, & ! m + model%climate%eus*thk0) + + call parallel_halo(topg_unscaled) + endif + + ! Compute the thickness tendency dH/dt (m/s) resulting from transport and mass balance + ! (but not including bmlt_float_inversion). We set dthck_dt = 0 for ice-free cells. + ! This tendency is used when inverting for powerlaw_c_inversion. + + ! Note: A similar variable, geometry%dthck_dt, is computed at the end of the time step for diagnostic output. + ! This is simply the rate of change of thickness between the start and end of the time step. + +!! where (model%geometry%thck_old > model%numerics%thklim) + where (model%geometry%thck_old > 0.0d0) + dthck_dt_inversion = (thck_new_unscaled - model%geometry%thck_old*thk0) & + / (model%numerics%dt * tim0) + elsewhere + dthck_dt_inversion = 0.0d0 + endwhere + + ! Optionally, compute an exponential moving average of usrf and dthck_dt + ! The larger the factor, the more rapidly earlier values are discounted. + !WHL - debug + alpha = model%basal_physics%inversion_babc_time_smoothing + alpha = min(alpha, 1.0d0 - 1.0d0/real(model%numerics%tstep_count,dp)) ! decrease smoother for first few time steps + alpha = min(1.0d0, max(alpha,0.0d0)) ! limit to [0,1] + if (alpha < 1.0d0) then + ! take moving averages of usrf and dthck_dt with contributions from previous values + model%basal_physics%usrf_inversion(:,:) = (1.d0 - alpha) * usrf_new_unscaled(:,:) & + + alpha * model%basal_physics%usrf_inversion(:,:) + model%basal_physics%dthck_dt_inversion(:,:) = (1.d0 - alpha) * dthck_dt_inversion(:,:) & + + alpha * model%basal_physics%dthck_dt_inversion(:,:) + else + ! simply copy the latest values + model%basal_physics%usrf_inversion(:,:) = usrf_new_unscaled(:,:) + model%basal_physics%dthck_dt_inversion(:,:) = dthck_dt_inversion(:,:) + endif ! alpha < 1 + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'Computed moving averages: rank, i, j, alpha =', rtest, i, j, alpha + print*, ' ' + print*, 'current usrf (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.4)',advance='no') usrf_new_unscaled(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'moving average usrf:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.4)',advance='no') model%basal_physics%usrf_inversion(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'current dH/dt (m/yr):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.4)',advance='no') dthck_dt_inversion(i,j)*scyr + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'moving average dH/dt:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.4)',advance='no') model%basal_physics%dthck_dt_inversion(i,j)*scyr + enddo + write(6,*) ' ' + enddo + endif - elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then + if (new_inversion) then - ! Prescribe bmlt_float from a previous inversion. - ! Although bmlt_float is prescribed, it may need to be limited or ignored, - ! for example to avoid melting beneath grounded ice. + ! Determine the basal traction field, powerlaw_c_inversion, if desired. + ! Notes: (1) For inversion purposes, ice_mask = 1 where thck > 0.0 (not where thck > thklim). + ! (2) usrf_unscaled is the expected new value after applying the mass balance. + ! (3) These masks are computed before horizontal transport. So for instance, if a cell + ! is grounded before transport and floating afterward, it is treated as grounded. - call prescribe_bmlt_float(model%numerics%dt * tim0, & ! s + call invert_basal_traction_new(model%numerics%dt*tim0, & ! s + model%general%ewn, model%general%nsn, & + itest, jtest, rtest, & + model%basal_physics, & + ice_mask, & + floating_mask, & !TODO - before transport? + land_mask, & + grounding_line_mask, & +!! usrf_new_unscaled, & ! m + model%basal_physics%usrf_inversion, & ! m + model%geometry%usrf_obs*thk0, & ! m + model%basal_physics%dthck_dt_inversion) ! m/s + + ! Invert for bmlt_float_inversion, adjusting the melt rate to relax toward the observed thickness. + ! Note: basal_melt%bmlt_float_inversion is passed out with units of m/s + + ! Note: Other kinds of basal melting are handled in subroutine glissade_bmlt_float_solve. + ! Inversion is done here, after transport, when there is an updated ice thickness. + ! Then bmlt_float_inversion is added to the previously computed bmlt. + ! Note: Usually, whichbmlt_float = 0 when doing inversion. + ! However, for the HO_INVERSION_PRESCRIBED option, we may want to add a basal melting anomaly + ! as for the initMIP anomaly experiments. In that case the anomaly is already part of bmlt_float. + ! Note: If the basal melt GLP is turned on, it sets bmlt_float = 0 in partly floating cells. + ! However, it does not limit bmlt_float_inversion, which is applied to all floating cells, + ! including partly floating cells (in order to match observed thicknesses at the grounding line). + + !TODO - Are masks needed? Is it OK to have them computed pre-transport? + + call invert_bmlt_float_new(model%numerics%dt * tim0, & ! s model%general%ewn, model%general%nsn, & - itest, jtest, rtest, & + itest, jtest, rtest, & + model%basal_melt, & + thck_new_unscaled, & ! m + model%geometry%usrf_obs*thk0, & ! m + topg_unscaled, & ! m + model%climate%eus*thk0, & ! m + ice_mask, & + floating_mask, & + land_mask, & + grounding_line_mask) + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'Inverting for bmlt_float: rank, i, j =', rtest, i, j + print*, 'usrf (m), usrf_obs (m), bmlt_float_inversion (m/yr):', usrf_new_unscaled(i,j), & + model%geometry%usrf_obs(i,j)*thk0, model%basal_melt%bmlt_float_inversion(i,j)*scyr + print*, ' ' + endif + + else ! old inversion + + call invert_basal_traction(model%numerics%dt*tim0, & ! s + model%general%ewn, model%general%nsn, & + itest, jtest, rtest, & + model%basal_physics, & + ice_mask, & + floating_mask, & + land_mask, & + grounding_line_mask, & + model%geometry%thck*thk0, & ! m + model%basal_physics%dthck_dt_inversion, & ! m/s + model%geometry%thck_obs*thk0) ! m + + ! Invert for bmlt_float_inversion, adjusting the melt rate to relax toward the observed thickness. + ! Note: basal_melt%bmlt_float_inversion is passed out with units of m/s + + ! Note: Other kinds of basal melting are handled in subroutine glissade_bmlt_float_solve. + ! Inversion is done here, after transport, when there is an updated ice thickness. + ! Then bmlt_float_inversion is added to the previously computed bmlt. + ! Note: Usually, whichbmlt_float = 0 when doing inversion. + ! However, for the HO_INVERSION_PRESCRIBED option, we may want to add a basal melting anomaly + ! as for the initMIP anomaly experiments. In that case the anomaly is already part of bmlt_float. + ! Note: If the basal melt GLP is turned on, it sets bmlt_float = 0 in partly floating cells. + ! However, it does not limit bmlt_float_inversion, which is applied to all floating cells, + ! including partly floating cells (in order to match observed thicknesses at the grounding line). + + call invert_bmlt_float(model%numerics%dt * tim0, & ! s + model%general%ewn, model%general%nsn, & + itest, jtest, rtest, & model%basal_melt, & thck_unscaled, & ! m + model%geometry%thck_obs*thk0, & ! m model%geometry%topg*thk0, & ! m model%climate%eus*thk0, & ! m model%climate%acab_corrected*thk0/tim0, & ! m/s @@ -1540,20 +1741,134 @@ subroutine glissade_transport_solve(model) ice_mask, & floating_mask, & land_mask) + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'Inverting for bmlt_float: rank, i, j =', rtest, i, j + print*, 'thck (m), thck_obs (m), bmlt_float_inversion (m/yr):', thck_unscaled(i,j), & + model%geometry%thck_obs(i,j)*thk0, model%basal_melt%bmlt_float_inversion(i,j)*scyr + print*, ' ' + endif - !WHL - debug - if (verbose_inversion .and. this_rank == rtest) then - i = itest - j = jtest - print*, ' ' - print*, 'Prescribe bmlt_float: rank, i, j =', rtest, i, j - print*, 'thck (m), bmlt_float_prescribed, bmlt_float_inversion (m/yr):', thck_unscaled(i,j), & - model%basal_melt%bmlt_float_prescribed(i,j)*scyr, & - model%basal_melt%bmlt_float_inversion(i,j)*scyr - print*, ' ' - endif + endif ! new_inversion - endif ! which_ho_inversion + elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then + + if (new_inversion) then + + ! Prescribe the traction parameter powerlaw_c based on a previous inversion. + ! Although powerlaw_c is prescribed, it may need to be modified, + ! for example if a cell flips from grounded to floating or vice versa. + + call prescribe_basal_traction_new(model%general%ewn, model%general%nsn, & + itest, jtest, rtest, & + model%basal_physics, & + ice_mask, & + floating_mask, & + land_mask, & + grounding_line_mask) + + ! Prescribe bmlt_float based on a previous inversion. + ! Although bmlt_float is prescribed, it may need to be limited or ignored, + ! for example to avoid melting beneath grounded ice. + + call prescribe_bmlt_float_new(model%numerics%dt * tim0, & ! s + model%general%ewn, model%general%nsn, & + itest, jtest, rtest, & + model%basal_melt, & + thck_new_unscaled, & ! m + topg_unscaled, & ! m + model%climate%eus*thk0, & ! m + ice_mask, & + floating_mask, & + land_mask, & + grounding_line_mask) + + else ! old inversion + + ! Prescribe the traction parameter powerlaw_c based on a previous inversion. + ! Although powerlaw_c is prescribed, it may need to be modified, + ! for example if a cell flips from grounded to floating or vice versa. + + call prescribe_basal_traction(model%general%ewn, model%general%nsn, & + itest, jtest, rtest, & + model%basal_physics, & + ice_mask, & + floating_mask, & + land_mask) + + ! Prescribe bmlt_float based on a previous inversion. + ! Although bmlt_float is prescribed, it may need to be limited or ignored, + ! for example to avoid melting beneath grounded ice. + + call prescribe_bmlt_float(model%numerics%dt * tim0, & ! s + model%general%ewn, model%general%nsn, & + itest, jtest, rtest, & + model%basal_melt, & + thck_unscaled, & ! m + model%geometry%topg*thk0, & ! m + model%climate%eus*thk0, & ! m + model%climate%acab_corrected*thk0/tim0, & ! m/s + model%basal_melt%bmlt*thk0/tim0, & ! m/s + ice_mask, & + floating_mask, & + land_mask) + + endif ! new inversion + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'Prescribe bmlt_float: rank, i, j =', rtest, i, j + print*, 'thck (m), bmltd_float_prescribed, bmlt_float_inversion (m/yr):', thck_unscaled(i,j), & + model%basal_melt%bmlt_float_prescribed(i,j)*scyr, & + model%basal_melt%bmlt_float_inversion(i,j)*scyr + print*, ' ' + endif + + endif ! which_ho_inversion (compute or prescribed) + + endif ! which_ho_inversion + + ! ------------------------------------------------------------------------ + ! Get masks used for the mass balance calculation. + ! Pass thklim = 0 to identify cells with thck > 0 (not thck > thklim). + ! Use ocean_mask to identify ocean cells where positive acab should not be applied. + ! Use thck_calving_front to compute a fractional area for calving_front cells. + ! ------------------------------------------------------------------------ + + call glissade_get_masks(model%general%ewn, model%general%nsn, & + thck_unscaled, & ! m + topg_unscaled, & ! m + model%climate%eus*thk0, & ! m + 0.0d0, & ! thklim = 0 + ice_mask, & + floating_mask = floating_mask, & + land_mask = land_mask, & + ocean_mask = ocean_mask, & + which_ho_calving_front = model%options%which_ho_calving_front, & + calving_front_mask = calving_front_mask, & + thck_calving_front = thck_calving_front) + + ! Compute the effective fractional area of calving_front cells. + + do j = 1, model%general%nsn + do i = 1, model%general%ewn + if (calving_front_mask(i,j) == 1 .and. thck_calving_front(i,j) > 0.0d0) then + effective_areafrac(i,j) = thck_unscaled(i,j) / thck_calving_front(i,j) + effective_areafrac(i,j) = min(effective_areafrac(i,j), 1.0d0) + elseif (ocean_mask(i,j) == 1) then + effective_areafrac(i,j) = 0.0d0 ! acab and bmlt not applied to ice-free ocean cells + else ! non-CF ice-covered cells and/or land cells + effective_areafrac(i,j) = 1.0d0 + endif + enddo + enddo if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then @@ -1576,10 +1891,7 @@ subroutine glissade_transport_solve(model) bmlt_unscaled = bmlt_unscaled + model%basal_melt%bmlt_float_inversion/effective_areafrac endwhere - endif - - ! Convert acab_corrected to a temporary in/out array in SI units (m/s) - acab_unscaled(:,:) = model%climate%acab_corrected(:,:) * thk0/tim0 + endif ! which_ho_inversion ! Initialize the applied acab and bmlt. ! Note: These are smaller in magnitude than the input acab and bmlt for cells where either @@ -1617,35 +1929,6 @@ subroutine glissade_transport_solve(model) !WHL - debug call parallel_halo(thck_unscaled) - if (verbose_inversion .and. this_rank == rtest) then - i = itest - j = jtest -! print*, ' ' -! print*, 'bmlt to mass balance driver (m/yr, per unit ice area):' -! do j = jtest+3, jtest-3, -1 -! do i = itest-3, itest+3 -! write(6,'(f10.3)',advance='no') bmlt_unscaled(i,j)*scyr -! enddo -! write(6,*) ' ' -! enddo -! print*, ' ' -! print*, 'effective_areafrac:' -! do j = jtest+3, jtest-3, -1 -! do i = itest-3, itest+3 -! write(6,'(f10.3)',advance='no') effective_areafrac(i,j) -! enddo -! write(6,*) ' ' -! enddo - print*, ' ' - print*, 'New thck (m) after acab and bmlt:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck_unscaled(i,j) - enddo - write(6,*) ' ' - enddo - endif - !------------------------------------------------------------------------- ! Cleanup !------------------------------------------------------------------------- @@ -1661,6 +1944,10 @@ subroutine glissade_transport_solve(model) ! (acab_unscaled is intent(in) above, so no need to scale it back) model%geometry%thck(:,:) = thck_unscaled(:,:) / thk0 + ! convert topg back to scaled units, if necessary + ! Do this only if inverting for topg + if (invert_topg) model%geometry%topg(:,:) = topg_unscaled(:,:) / thk0 + ! For the enthalpy option, convert enthalpy back to temperature/waterfrac. if (model%options%whichtemp == TEMP_ENTHALPY) then @@ -1676,83 +1963,6 @@ subroutine glissade_transport_solve(model) endif ! TEMP_ENTHALPY - - !------------------------------------------------------------------------- - ! Determine the basal traction field, powerlaw_c_inversion, if desired. - ! Note: If powerlaw_c is prescribed from a previous inversion, it may need to be adjusted - ! in cells that were floating during the inversion but are now grounded, or vice versa. - !------------------------------------------------------------------------- - - if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & - model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then - - ! ------------------------------------------------------------------------ - ! Recompute ice_mask and floating_mask before the inversion calculation. - ! Pass thklim = 0 to identify cells with thck > 0 (not thck > thklim). - ! ------------------------------------------------------------------------ - - call glissade_get_masks(model%general%ewn, model%general%nsn, & - thck_unscaled, & ! m - model%geometry%topg*thk0, & ! m - model%climate%eus*thk0, & ! m - 0.0d0, & ! thklim = 0 - ice_mask, & - floating_mask = floating_mask) - - if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then - - ! Compute the thickness tendency dH/dt from one step to the next (m/s). - ! This tendency is used when inverting for powerlaw_c_inversion in grounded grid cells. - ! Note: We set dthck_dt = 0 for inactive cells (thck <= thklim at the start of the time step). - ! This helps prevent the following cycle: - ! - While Cp is increasing, a cell thins to H < thklim and becomes inactive. - ! - Once inactive, the cell thickens (reducing Cp) and becomes active. - ! - Once active again, the cell resumes thinning, reducing Cp. And so on. - ! Note: Some cells have powerlaw_c_inversion > 0 (because they are grounded after mass balance), - ! and also have bmlt_float_inversion < 0 (because they are floating after transport - ! and need a negative melt rate to reground). - ! For these cells we remove bmlt_float_inversion from dthck_dt, because we want - ! dthck_dt to reflect how fast the ice is thinning without the inversion. - ! Since bmlt_float_inversion < 0 in this situation, adding it will make dthck_dt - ! more negative as desired. - ! Note: dthck_dt is recomputed at the end of the time step for diagnostic output. - !TODO - Divide bmlt_float_inversion by effective_areafrac? Probably not needed for grounded cells. - - where (model%geometry%thck_old > model%numerics%thklim) - model%geometry%dthck_dt = (model%geometry%thck - model%geometry%thck_old) * thk0 & - /(model%numerics%dt * tim0) & - + model%basal_melt%bmlt_float_inversion - elsewhere - model%geometry%dthck_dt = 0.0d0 - endwhere - - ! Invert for the basal traction parameter, powerlaw_c_inversion. - ! Note: For inversion purposes, ice_mask = 1 where thck > 0.0 (not where thck > thklim). - - call invert_basal_traction(model%numerics%dt*tim0, & ! s - model%general%ewn, model%general%nsn, & - itest, jtest, rtest, & - model%basal_physics, & - ice_mask, & - floating_mask, & - land_mask, & - model%geometry%thck*thk0, & ! m - model%geometry%dthck_dt, & ! m/s - model%geometry%thck_obs*thk0) ! m - - elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then - - call prescribe_basal_traction(model%general%ewn, model%general%nsn, & - itest, jtest, rtest, & - model%basal_physics, & - ice_mask, & - floating_mask, & - land_mask) - - endif ! which_ho_inversion (compute or prescribed) - - endif ! which_ho_inversion - if (this_rank==rtest .and. verbose_glissade) then print*, ' ' print*, 'After glissade_transport_driver:' @@ -1824,6 +2034,36 @@ subroutine glissade_transport_solve(model) model%geometry%usrf(:,:) = max(0.d0, model%geometry%thck(:,:) + model%geometry%lsrf(:,:)) + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'After mass balance, thck (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') model%geometry%thck(i,j)*thk0 + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'usrf (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') model%geometry%usrf(i,j)*thk0 + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'usrf - usrf_obs (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') & + model%geometry%usrf(i,j)*thk0 - model%geometry%usrf_obs(i,j)*thk0 + enddo + write(6,*) ' ' + enddo + endif ! verbose_inversion + end subroutine glissade_transport_solve !======================================================================= @@ -2019,9 +2259,10 @@ subroutine glissade_diagnostic_variable_solve(model) use glissade_calving, only: verbose_calving use glam_grid_operators, only: glam_geometry_derivs use felix_dycore_interface, only: felix_velo_driver - + !WHL - debug use glissade_bmlt_float, only: glissade_basal_melting_float + use glissade_inversion, only: verbose_inversion implicit none @@ -2047,7 +2288,7 @@ subroutine glissade_diagnostic_variable_solve(model) dsigma, & ! layer thickness in sigma coordinates tau_xx, tau_yy, tau_xy, & ! stress tensor components strain_rate_xx, strain_rate_yy, strain_rate_xy ! strain rate tensor components - + real(dp) :: & a, b, c, root, & ! terms in quadratic formula lambda1, lambda2 ! eigenvalues of horizontal strain rate tensor @@ -2716,7 +2957,9 @@ subroutine glissade_diagnostic_variable_solve(model) !WHL - inversion debug - if (verbose_inversion .and. model%numerics%tstep_count > 0) then + if ( (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & + model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) & + .and. verbose_inversion .and. model%numerics%tstep_count > 0 ) then !WHL - temporary debug - compute max diff in bmlt_applied model%basal_melt%bmlt_applied_diff(:,:) = & @@ -2738,14 +2981,14 @@ subroutine glissade_diagnostic_variable_solve(model) call parallel_globalindex(i, j, iglobal, jglobal) print*, 'global i, j =', iglobal, jglobal print*, ' ' - print*, 'bmlt_applied:' - do jj = j-3, j+3 - write(6,'(i8)',advance='no') jj - do ii = i-3, i+3 - write(6,'(f10.3)',advance='no') model%basal_melt%bmlt_applied(ii,jj) * scyr*thk0/tim0 - enddo - print*, ' ' - enddo +! print*, 'bmlt_applied:' +! do jj = j-3, j+3 +! write(6,'(i8)',advance='no') jj +! do ii = i-3, i+3 +! write(6,'(f10.3)',advance='no') model%basal_melt%bmlt_applied(ii,jj) * scyr*thk0/tim0 +! enddo +! print*, ' ' +! enddo endif enddo enddo diff --git a/libglissade/glissade_inversion.F90 b/libglissade/glissade_inversion.F90 index 82be2a53..fd3c2e0e 100644 --- a/libglissade/glissade_inversion.F90 +++ b/libglissade/glissade_inversion.F90 @@ -34,6 +34,8 @@ module glissade_inversion implicit none + ! All subroutines in this module are public + !----------------------------------------------------------------------------- ! Subroutines to invert for basal fields (including basal traction beneath ! grounded ice and basal melting beneath floating ice) by relaxing toward @@ -44,12 +46,13 @@ module glissade_inversion logical, parameter :: verbose_inversion = .true. !TODO - Make these config parameters? + !TODO - Initialize to powerlaw_c_land instead of powerlaw_c_max? real(dp), parameter :: & powerlaw_c_land = 20000.d0, & powerlaw_c_marine = 1000.d0 real(dp), parameter :: & - bmlt_inversion_thck_buffer = 3.0d0 ! Ice is restored to this much above or below thck_flotation + bmlt_inversion_thck_buffer = 1.0d0 ! Ice is restored to this much above or below thck_flotation !*********************************************************************** @@ -110,53 +113,77 @@ subroutine glissade_init_inversion(model) var_maxval = maxval(model%geometry%thck_obs) var_maxval = parallel_reduce_max(var_maxval) if (var_maxval > 0.0d0) then - ! do nothing; thck_obs has been read in already (e.g., after restart) - else ! initialize to the input thickness model%geometry%thck_obs(:,:) = model%geometry%thck(:,:) + !TODO - Delete the following code if not needed? + ! If adjusting topography, then the target thck_obs is not uniquely grounded or floating. + ! Adjust thck_obs so that the observational target is not too close to thck_flotation. ! The reason for this is that if we restore H to values very close to thck_flotation, - ! it is easy for cells to flip between grounded and floating in the forward run, even with - ! bmlt_float_inversion and powerlaw_c_inversion equal to values from the inversion run. - - where (model%geometry%topg - model%climate%eus < 0.0d0) - thck_flotation = -(rhoo/rhoi) * (model%geometry%topg - model%climate%eus) * thk0 ! convert to m - elsewhere - thck_flotation = 0.0d0 - endwhere - - do j = 1, model%general%nsn - do i = 1, model%general%ewn - if (model%geometry%thck_obs(i,j) > 0.0d0) then - dthck = model%geometry%thck_obs(i,j)*thk0 - thck_flotation(i,j) ! difference (m) - if (abs(dthck) < bmlt_inversion_thck_buffer) then - if (dthck > 0.0d0) then - model%geometry%thck_obs(i,j) = (thck_flotation(i,j) + bmlt_inversion_thck_buffer) / thk0 - else - model%geometry%thck_obs(i,j) = (thck_flotation(i,j) - bmlt_inversion_thck_buffer) / thk0 - endif - endif - endif - model%geometry%thck_obs(i,j) = max(model%geometry%thck_obs(i,j), 0.0d0) - enddo - enddo + ! it is easy for cells to flip between grounded and floating in the forward run. + +! where (model%geometry%topg - model%climate%eus < 0.0d0) +! thck_flotation = -(rhoo/rhoi) * (model%geometry%topg - model%climate%eus) * thk0 ! convert to m +! elsewhere +! thck_flotation = 0.0d0 +! endwhere + +! do j = 1, model%general%nsn +! do i = 1, model%general%ewn +! if (model%geometry%thck_obs(i,j) > 0.0d0) then +! dthck = model%geometry%thck_obs(i,j)*thk0 - thck_flotation(i,j) ! difference (m) +! if (abs(dthck) < bmlt_inversion_thck_buffer) then +! if (dthck > 0.0d0) then +! model%geometry%thck_obs(i,j) = (thck_flotation(i,j) + bmlt_inversion_thck_buffer) / thk0 +! else +! model%geometry%thck_obs(i,j) = (thck_flotation(i,j) - bmlt_inversion_thck_buffer) / thk0 +! endif +! endif +! endif +! model%geometry%thck_obs(i,j) = max(model%geometry%thck_obs(i,j), 0.0d0) +! enddo +! enddo ! Another adjustment: Make sure the observational target thickness is not too close to thklim. ! If thck_obs is close to thklim, there is a greater chance that the modeled thickness will ! flicker on either side of thklim. - where (model%geometry%thck_obs > 0.0d0) - model%geometry%thck_obs = max(model%geometry%thck_obs, & - model%numerics%thklim + bmlt_inversion_thck_buffer/thk0) - endwhere +! where (model%geometry%thck_obs > 0.0d0) +! model%geometry%thck_obs = max(model%geometry%thck_obs, & +! model%numerics%thklim + bmlt_inversion_thck_buffer/thk0) +! endwhere + + endif ! var_maxval + + ! Check whether usrf_obs has been read in already. + ! If not, then set usrf_obs to the initial upper surface elevation (possibly modified by initial calving). + var_maxval = maxval(model%geometry%usrf_obs) + var_maxval = parallel_reduce_max(var_maxval) + if (var_maxval > 0.0d0) then + ! do nothing + else + ! initialize to the input upper surface elevation + model%geometry%usrf_obs(:,:) = model%geometry%usrf(:,:) + endif + ! Check whether topg_obs has been read in already. + ! If not, then set topg_obs to the initial topography. + var_maxval = maxval(model%geometry%topg_obs) + var_maxval = parallel_reduce_max(var_maxval) + if (var_maxval > 0.0d0) then + ! do nothing + else + ! initialize to the input topography + model%geometry%topg_obs(:,:) = model%geometry%topg(:,:) endif - call parallel_halo(model%geometry%thck_obs) +! call parallel_halo(model%geometry%thck_obs) + call parallel_halo(model%geometry%usrf_obs) + call parallel_halo(model%geometry%topg_obs) ! Check whether powerlaw_c_inversion has been read in already. ! If not, then set to a constant value. @@ -167,6 +194,7 @@ subroutine glissade_init_inversion(model) else ! setting to a large value so that basal flow starts slow and gradually speeds up as needed model%basal_physics%powerlaw_c_inversion(:,:) = model%basal_physics%powerlaw_c_max +!! model%basal_physics%powerlaw_c_inversion(:,:) = model%basal_physics%powerlaw_c endif call parallel_halo(model%basal_physics%powerlaw_c_inversion) @@ -248,22 +276,119 @@ end subroutine glissade_init_inversion !*********************************************************************** - subroutine invert_basal_traction(dt, & + subroutine invert_basal_topography(dt, & + nx, ny, & + itest, jtest, rtest, & + ice_mask, & + grounding_line_mask, & + usrf, & + usrf_obs, & + topg, & + topg_obs, & + eus) + + real(dp), intent(in) :: dt ! time step (s) + + integer, intent(in) :: & + nx, ny ! grid dimensions + + integer, intent(in) :: & + itest, jtest, rtest ! coordinates of diagnostic point + + integer, dimension(nx,ny), intent(in) :: & + ice_mask, & ! = 1 where ice is present (thk > 0), else = 0 + grounding_line_mask ! = 1 if a cell is adjacent to the grounding line, else = 0 + + ! Note: usrf should be the expected new value of usrf after applying the mass balance + ! (although the mass balance may not yet have been applied) + real(dp), dimension(nx,ny), intent(in) :: & + usrf, & ! upper surface elvation (m) + usrf_obs, & ! observed upper surface elvation (m) + topg_obs ! observed basal topography (m) + + real(dp), intent(in) :: & + eus ! eustatic sea level (m) + + real(dp), dimension(nx,ny), intent(inout) :: & + topg ! basal topography (m) + + ! local variables + + !TODO - Make these config parameters? + real(dp), parameter :: & +!! topg_inversion_timescale = 1000.d0*scyr, & ! timescale for topg inversion, yr converted to s + topg_inversion_timescale = 100.d0*scyr, & ! timescale for topg inversion, yr converted to s + topg_maxcorr = 100.d0 ! max allowed correction in topg, compared to obs (m) + + real(dp) :: dtopg_dt + + integer :: i, j + + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'Before topg adjustment, topg:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.2)',advance='no') topg(i,j) + enddo + write(6,*) ' ' + enddo + endif + + !TODO - Apply to grounded cells only? + ! Adjust basal topography in cells adjacent to the grounding line. + ! Raise the topg where usrf < usrf_obs, and lower topg where usrf > usrf_obs + ! Note: The grounding_line mask is computed before horizontal transport. + ! It includes grounded cells adjacent to at least one floating or ice-free ocean cell, + ! and floating cells adjacent to at least one grounded cell. + do j = 1, ny + do i = 1, nx + if (ice_mask(i,j) == 1 .and. grounding_line_mask(i,j) == 1) then + dtopg_dt = -(usrf(i,j) - usrf_obs(i,j)) / topg_inversion_timescale + topg(i,j) = topg(i,j) + dtopg_dt*dt + topg(i,j) = min(topg(i,j), topg_obs(i,j) + topg_maxcorr) + topg(i,j) = max(topg(i,j), topg_obs(i,j) - topg_maxcorr) + endif + enddo + enddo + + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'After topg adjustment, topg:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.2)',advance='no') topg(i,j) + enddo + write(6,*) ' ' + enddo + endif + + end subroutine invert_basal_topography + +!*********************************************************************** + + subroutine invert_basal_traction_new(dt, & nx, ny, & itest, jtest, rtest, & basal_physics, & ice_mask, & floating_mask, & land_mask, & - thck, & - dthck_dt, & - thck_obs) + grounding_line_mask, & + usrf, & + usrf_obs, & + dthck_dt) ! Compute a spatially varying basal traction field, powerlaw_c_inversion. ! The method is similar to that of Pollard & DeConto (TC, 2012), and is applied to all grounded ice. ! Where thck > thck_obs, powerlaw_c is reduced to increase sliding. ! Where thck < thck_obs, powerlaw_c is increased to reduce sliding. ! Note: powerlaw_c is constrained to lie within a prescribed range. + ! Note: The grounding line mask is computed before horizontal transport. real(dp), intent(in) :: dt ! time step (s) @@ -279,17 +404,21 @@ subroutine invert_basal_traction(dt, & integer, dimension(nx,ny), intent(in) :: & ice_mask, & ! = 1 where ice is present (thk > 0), else = 0 floating_mask, & ! = 1 where ice is present and floating, else = 0 - land_mask ! = 1 if topg > eus, else = 0 + land_mask, & ! = 1 if topg > eus, else = 0 + grounding_line_mask ! = 1 if a cell is adjacent to the grounding line, else = 0 real(dp), dimension(nx,ny), intent(in) :: & - thck, & ! ice thickness (m) - dthck_dt, & ! rate of change of ice thickness (m/s) - thck_obs ! observed thickness (m) + usrf, & ! ice upper surface elevation (m) + usrf_obs, & ! observed upper surface elevation (m) + dthck_dt ! rate of change of ice thickness (m/s) ! local variables + integer, dimension(nx,ny) :: & + powerlaw_c_inversion_mask ! = 1 where we invert for powerlaw_c, else = 0 + real(dp), dimension(nx,ny) :: & - dthck, & ! thck - thck_obs on ice grid + dusrf, & ! usrf - usrf_obs on ice grid old_powerlaw_c, & ! old value of powerlaw_c_inversion (start of timestep) temp_powerlaw_c, & ! temporary value of powerlaw_c_inversion (before smoothing) dpowerlaw_c ! change in powerlaw_c @@ -308,22 +437,41 @@ subroutine invert_basal_traction(dt, & ! * inversion_babc_timescale = inversion timescale (s); must be > 0 ! * inversion_babc_thck_scale = thickness inversion scale (m); must be > 0 ! * inversion_babc_dthck_dt_scale = dthck_dt inversion scale (m/s); must be > 0 - ! * inversion_babc_smoothing_factor = factor for smoothing powerlaw_c_inversion; higher => more smoothing + ! * inversion_babc_space_smoothing = factor for spatial smoothing of powerlaw_c_inversion; larger => more smoothing + ! * inversion_babc_time_smoothing = factor for exponential moving average of usrf_inversion and dthck_dt_inversion + ! (used to adjust powerlaw_c_inversion; larger => more smoothing) ! - ! Note on smoothing: A smoothing factor of 1/8 gives a 4-1-1-1-1 smoother. + ! Note on inversion_babc_space_smoothing: A smoothing factor of 1/8 gives a 4-1-1-1-1 smoother. ! This is numerically well behaved, but may oversmooth in bowl-shaped regions; ! a smaller value may be better as H converges toward H_obs. dpowerlaw_c(:,:) = 0.0d0 - ! Compute difference between current and target thickness - dthck(:,:) = thck(:,:) - thck_obs(:,:) + ! Compute difference between current and target upper surface elevation + dusrf(:,:) = usrf(:,:) - usrf_obs(:,:) + + ! Compute a mask of cells where we invert for powerlaw_c. + ! The mask includes land-based cells, as well as marine-based cells that are grounded + ! or are adjacent to the grounding line. + ! (Floating cells are GL-adjacent if they have at least one grounded neighbor.) + ! The mask should be computed before transport, so that (for instance) if a cell is grounded + ! during transport and floating afterward, powerlaw_c_inversion is computed here + ! rather than being set to zero. + + where ( land_mask == 1 .or. (ice_mask == 1 .and. floating_mask == 0) .or. grounding_line_mask == 1 ) + powerlaw_c_inversion_mask = 1 + elsewhere + powerlaw_c_inversion_mask = 0 + endwhere + + call parallel_halo(powerlaw_c_inversion_mask) ! Check for newly grounded cells that have powerlaw_c = 0 (from when they were ice-free or floating). - ! Give these cells a sensible default value by extrapolating from neighbor cells. - do j = 2, ny-1 - do i = 2, nx-1 - if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! grounded ice + ! Give these cells a sensible default value (either land or marine). + do j = 1, ny + do i = 1, nx + if (powerlaw_c_inversion_mask(i,j) == 1) then ! ice is land-based, grounded or GL-adjacent + if (basal_physics%powerlaw_c_inversion(i,j) == 0.0d0) then ! set to a sensible default ! If on land, set to a typical land value @@ -334,28 +482,37 @@ subroutine invert_basal_traction(dt, & basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_marine endif endif ! powerlaw_c_inversion = 0 - endif ! grounded ice + + endif ! powerlaw_c_inversion_mask = 1 enddo ! i enddo ! j call parallel_halo(basal_physics%powerlaw_c_inversion) ! Loop over cells - ! Note: powerlaw_c_inversion is computed at cell centers where thck is located. + ! Note: powerlaw_c_inversion is computed at cell centers where usrf and thck are located. ! Later, it is interpolated to vertices where beta and basal velocity are located. do j = 1, ny do i = 1, nx - - if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! ice is present and grounded + if (powerlaw_c_inversion_mask(i,j) == 1) then ! ice is land-based, grounded or GL-adjacent ! Save the starting value old_powerlaw_c(i,j) = basal_physics%powerlaw_c_inversion(i,j) ! Invert for powerlaw_c based on dthck and dthck_dt - term1 = -dthck(i,j) / basal_physics%inversion_babc_thck_scale + !TODO - Change to basal_physics%inversion_babc_usrf_scale? + term1 = -dusrf(i,j) / basal_physics%inversion_babc_thck_scale term2 = -dthck_dt(i,j) / basal_physics%inversion_babc_dthck_dt_scale + !WHL - debug - Trying to turn off a potential unstable feedback: + ! (1) dH/dt < 0, so Cp increases + ! (2) Increased Cp results in dH/dt > 0, so Cp decreases + ! (3) Amplify and repeat until the model crashes + !TODO - Check whether this cycle occurs with a simple power law (as opposed to Schoof law) + term2 = min(term2, 1.0d0) + term2 = max(term2, -1.0d0) + dpowerlaw_c(i,j) = (dt/basal_physics%inversion_babc_timescale) & * basal_physics%powerlaw_c_inversion(i,j) * (term1 + term2) @@ -380,15 +537,16 @@ subroutine invert_basal_traction(dt, & if (verbose_inversion .and. this_rank == rtest .and. i==itest .and. j==jtest) then print*, ' ' print*, 'Invert for powerlaw_c and coulomb_c: rank, i, j =', rtest, itest, jtest - print*, 'thck, thck_obs, dthck, dthck_dt:', thck(i,j), thck_obs(i,j), dthck(i,j), dthck_dt(i,j)*scyr - print*, '-dthck/thck_scale, -dthck_dt/dthck_dt_scale, sum =', & - -dthck(i,j)/basal_physics%inversion_babc_thck_scale, & - -dthck_dt(i,j)/basal_physics%inversion_babc_dthck_dt_scale, & + print*, 'usrf, usrf_obs, dusrf, dthck_dt:', usrf(i,j), usrf_obs(i,j), dusrf(i,j), dthck_dt(i,j)*scyr + print*, '-dusrf/usrf_scale, -dthck_dt/dthck_dt_scale, sum =', & +!! -dusrf(i,j)/basal_physics%inversion_babc_thck_scale, & +!! -dthck_dt(i,j)/basal_physics%inversion_babc_dthck_dt_scale, & + term1, term2, & term1 + term2 print*, 'dpowerlaw_c, newpowerlaw_c =', dpowerlaw_c(i,j), basal_physics%powerlaw_c_inversion(i,j) endif - else ! ice_mask = 0 or floating_mask = 1 + else ! powerlaw_c_inversion_mask = 0 ! set powerlaw_c = 0 ! Note: Zero values are ignored when interpolating powerlaw_c to vertices, @@ -399,8 +557,7 @@ subroutine invert_basal_traction(dt, & basal_physics%powerlaw_c_inversion(i,j) = 0.0d0 - endif ! grounded ice - + endif ! powerlaw_c_inversion_mask enddo ! i enddo ! j @@ -417,7 +574,7 @@ subroutine invert_basal_traction(dt, & enddo endif - if (basal_physics%inversion_babc_smoothing_factor > 0.0d0) then + if (basal_physics%inversion_babc_space_smoothing > 0.0d0) then ! Save the value just computed temp_powerlaw_c(:,:) = basal_physics%powerlaw_c_inversion(:,:) @@ -427,18 +584,18 @@ subroutine invert_basal_traction(dt, & !TODO - Write an operator for Laplacian smoothing? do j = 2, ny-1 do i = 2, nx-1 - if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! cell (i,j) is grounded + if (powerlaw_c_inversion_mask(i,j) == 1) then ! ice is grounded or GL-adjacent - dpowerlaw_c_smooth = -4.0d0 * basal_physics%inversion_babc_smoothing_factor * temp_powerlaw_c(i,j) + dpowerlaw_c_smooth = -4.0d0 * basal_physics%inversion_babc_space_smoothing * temp_powerlaw_c(i,j) do jj = j-1, j+1 do ii = i-1, i+1 if ((ii == i .or. jj == j) .and. (ii /= i .or. jj /= j)) then ! edge neighbor - if (ice_mask(ii,jj) == 1 .and. floating_mask(ii,jj) == 0) then ! cell (ii,jj) is grounded + if (powerlaw_c_inversion_mask(ii,jj) == 1) then ! neighbor is grounded or GL-adjacent dpowerlaw_c_smooth = dpowerlaw_c_smooth & - + basal_physics%inversion_babc_smoothing_factor*temp_powerlaw_c(ii,jj) + + basal_physics%inversion_babc_space_smoothing*temp_powerlaw_c(ii,jj) else dpowerlaw_c_smooth = dpowerlaw_c_smooth & - + basal_physics%inversion_babc_smoothing_factor*temp_powerlaw_c(i,j) + + basal_physics%inversion_babc_space_smoothing*temp_powerlaw_c(i,j) endif endif enddo @@ -465,7 +622,7 @@ subroutine invert_basal_traction(dt, & endif endif ! dpowerlaw_c > 0 - endif ! cell is grounded + endif ! powerlaw_c_inversion_mask = 1 enddo ! i enddo ! j @@ -473,35 +630,26 @@ subroutine invert_basal_traction(dt, & call parallel_halo(basal_physics%powerlaw_c_inversion) - ! Set coulomb_c to a constant - !TODO - Switch from array to constant field in basal traction subroutine - basal_physics%coulomb_c_inversion(:,:) = basal_physics%coulomb_c - if (verbose_inversion .and. this_rank == rtest) then i = itest j = jtest - print*, 'thck (m):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck(i,j) - enddo - write(6,*) ' ' - enddo - print*, 'thck - thck_obs:' + print*, ' ' + print*, 'usrf - usrf_obs:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') dthck(i,j) + write(6,'(f10.3)',advance='no') dusrf(i,j) enddo write(6,*) ' ' enddo + print*, ' ' print*, 'dthck_dt (m/yr):' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.5)',advance='no') dthck_dt(i,j)*scyr + write(6,'(f10.4)',advance='no') dthck_dt(i,j)*scyr enddo write(6,*) ' ' enddo - if (basal_physics%inversion_babc_smoothing_factor > 0.0d0) then + if (basal_physics%inversion_babc_space_smoothing > 0.0d0) then print*, ' ' print*, 'After smoothing, powerlaw_c:' do j = jtest+3, jtest-3, -1 @@ -513,25 +661,29 @@ subroutine invert_basal_traction(dt, & endif endif - end subroutine invert_basal_traction + end subroutine invert_basal_traction_new - !*********************************************************************** +!*********************************************************************** - subroutine prescribe_basal_traction(nx, ny, & - itest, jtest, rtest, & - basal_physics, & - ice_mask, & - floating_mask, & - land_mask) + subroutine invert_basal_traction(dt, & + nx, ny, & + itest, jtest, rtest, & + basal_physics, & + ice_mask, & + floating_mask, & + land_mask, & + grounding_line_mask, & + thck, & + dthck_dt, & + thck_obs) - ! Compute Cp = powerlaw_c when Cp is prescribed from a previous inversion run. - ! - For cells where the ice is grounded and a prescribed Cp exists, - ! we simply have Cp = Cp_prescribed. - ! - For cells where the ice is grounded and the prescribed Cp = 0 (since the cell - ! was floating or ice-free in the inversion run), we set Cp to a sensible default - ! based on whether the cell is land-based or marine-based. - ! - For cells where the ice is floating (whether or not a prescribed Cp exists), - ! we set Cp = 0. + ! Compute a spatially varying basal traction field, powerlaw_c_inversion. + ! The method is similar to that of Pollard & DeConto (TC, 2012), and is applied to all grounded ice. + ! Where thck > thck_obs, powerlaw_c is reduced to increase sliding. + ! Where thck < thck_obs, powerlaw_c is increased to reduce sliding. + ! Note: powerlaw_c is constrained to lie within a prescribed range. + + real(dp), intent(in) :: dt ! time step (s) integer, intent(in) :: & nx, ny ! grid dimensions @@ -543,91 +695,740 @@ subroutine prescribe_basal_traction(nx, ny, & basal_physics ! basal physics object integer, dimension(nx,ny), intent(in) :: & - ice_mask, & ! = 1 where ice is present (thck > 0), else = 0 + ice_mask, & ! = 1 where ice is present (thk > 0), else = 0 floating_mask, & ! = 1 where ice is present and floating, else = 0 - land_mask ! = 1 where topg >= eus, else = 0 + land_mask, & ! = 1 if topg > eus, else = 0 + grounding_line_mask ! = 1 if a cell is adjacent to the grounding line, else = 0 + + real(dp), dimension(nx,ny), intent(in) :: & + thck, & ! ice thickness (m) + dthck_dt, & ! rate of change of ice thickness (m/s) + thck_obs ! observed thickness (m) ! local variables - real(dp), dimension(nx,ny) :: & - new_powerlaw_c ! new powerlaw_c values extrapolated from existing values + integer, dimension(nx,ny) :: & + powerlaw_c_inversion_mask ! = 1 where we invert for powerlaw_c, else = 0 - integer :: i, j, ii, jj + real(dp), dimension(nx,ny) :: & + dthck, & ! thck - thck_obs on ice grid + old_powerlaw_c, & ! old value of powerlaw_c_inversion (start of timestep) + temp_powerlaw_c, & ! temporary value of powerlaw_c_inversion (before smoothing) + dpowerlaw_c ! change in powerlaw_c - integer :: count ! counter - real(dp) :: sum_powerlaw_c ! sum of powerlaw_c in neighbor cells + real(dp) :: term1, term2 + real(dp) :: factor + real(dp) :: dpowerlaw_c_smooth + real(dp) :: sum_powerlaw_c - ! Zero out powerlaw_c where ice is not present (thck > 0) and grounded - where (ice_mask == 0 .or. floating_mask == 1) - basal_physics%powerlaw_c_inversion = 0.0d0 - endwhere + integer :: i, j, ii, jj + integer :: count - ! Assign values of powerlaw_c in newly grounded cells + ! inversion parameters in basal_physics derived type: + ! * powerlaw_c_max = upper bound for powerlaw_c, Pa (m/yr)^(-1/3) + ! * powerlaw_c_min = lower bound for powerlaw_c, Pa (m/yr)^(-1/3) + ! * inversion_babc_timescale = inversion timescale (s); must be > 0 + ! * inversion_babc_thck_scale = thickness inversion scale (m); must be > 0 + ! * inversion_babc_dthck_dt_scale = dthck_dt inversion scale (m/s); must be > 0 + ! * inversion_babc_space_smoothing = factor for smoothing powerlaw_c_inversion; higher => more smoothing + ! + ! Note on smoothing: A smoothing factor of 1/8 gives a 4-1-1-1-1 smoother. + ! This is numerically well behaved, but may oversmooth in bowl-shaped regions; + ! a smaller value may be better as H converges toward H_obs. - do j = 2, ny-1 - do i = 2, nx-1 - if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! grounded ice + dpowerlaw_c(:,:) = 0.0d0 - if (basal_physics%powerlaw_c_inversion(i,j) > 0.0d0) then + ! Compute difference between current and target thickness + dthck(:,:) = thck(:,:) - thck_obs(:,:) - ! nothing to do here; cell was already grounded + ! Compute a mask of cells where we invert for powerlaw_c. + ! The mask includes cells that are grounded and/or are adjacent to the grounding line. + ! Floating cells are GL-adjacent if they have at least one grounded neighbor. - elseif (basal_physics%powerlaw_c_prescribed(i,j) > 0.0d0) then ! use the prescribed value + where ( (ice_mask == 1 .and. floating_mask == 0) .or. grounding_line_mask == 1 ) + powerlaw_c_inversion_mask = 1 + elsewhere + powerlaw_c_inversion_mask = 0 + endwhere - basal_physics%powerlaw_c_inversion(i,j) = basal_physics%powerlaw_c_prescribed(i,j) + call parallel_halo(powerlaw_c_inversion_mask) - else ! assign a sensible default + ! Check for newly grounded cells that have powerlaw_c = 0 (from when they were ice-free or floating). + ! Give these cells a sensible default value by extrapolating from neighbor cells. + do j = 1, ny + do i = 1, nx + if (powerlaw_c_inversion_mask(i,j) == 1) then ! ice is grounded or GL-adjacent + if (basal_physics%powerlaw_c_inversion(i,j) == 0.0d0) then + ! set to a sensible default + ! If on land, set to a typical land value + ! If grounded marine ice, set to a smaller value if (land_mask(i,j) == 1) then basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_land else basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_marine endif + endif ! powerlaw_c_inversion = 0 - endif ! powerlaw_c > 0 - - endif ! grounded + endif ! powerlaw_c_inversion_mask = 1 enddo ! i enddo ! j call parallel_halo(basal_physics%powerlaw_c_inversion) - if (verbose_inversion .and. this_rank == rtest) then - i = itest - j = jtest - print*, ' ' - print*, 'floating_mask:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(i10)',advance='no') floating_mask(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'powerlaw_c_prescribed:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_prescribed(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'current powerlaw_c:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_inversion(i,j) - enddo - write(6,*) ' ' - enddo - endif ! verbose + ! Loop over cells + ! Note: powerlaw_c_inversion is computed at cell centers where thck is located. + ! Later, it is interpolated to vertices where beta and basal velocity are located. - end subroutine prescribe_basal_traction + do j = 1, ny + do i = 1, nx + if (powerlaw_c_inversion_mask(i,j) == 1) then ! ice is grounded or GL-adjacent -!*********************************************************************** + ! Save the starting value + old_powerlaw_c(i,j) = basal_physics%powerlaw_c_inversion(i,j) - subroutine invert_bmlt_float(dt, & - nx, ny, & - itest, jtest, rtest, & + ! Invert for powerlaw_c based on dthck and dthck_dt + term1 = -dthck(i,j) / basal_physics%inversion_babc_thck_scale + term2 = -dthck_dt(i,j) / basal_physics%inversion_babc_dthck_dt_scale + + dpowerlaw_c(i,j) = (dt/basal_physics%inversion_babc_timescale) & + * basal_physics%powerlaw_c_inversion(i,j) * (term1 + term2) + + ! Limit to prevent huge change in one step + if (abs(dpowerlaw_c(i,j)) > 0.05 * basal_physics%powerlaw_c_inversion(i,j)) then + if (dpowerlaw_c(i,j) > 0.0d0) then + dpowerlaw_c(i,j) = 0.05d0 * basal_physics%powerlaw_c_inversion(i,j) + else + dpowerlaw_c(i,j) = -0.05d0 * basal_physics%powerlaw_c_inversion(i,j) + endif + endif + + basal_physics%powerlaw_c_inversion(i,j) = basal_physics%powerlaw_c_inversion(i,j) + dpowerlaw_c(i,j) + + ! Limit to a physically reasonable range + basal_physics%powerlaw_c_inversion(i,j) = min(basal_physics%powerlaw_c_inversion(i,j), & + basal_physics%powerlaw_c_max) + basal_physics%powerlaw_c_inversion(i,j) = max(basal_physics%powerlaw_c_inversion(i,j), & + basal_physics%powerlaw_c_min) + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest .and. i==itest .and. j==jtest) then + print*, ' ' + print*, 'Invert for powerlaw_c and coulomb_c: rank, i, j =', rtest, itest, jtest + print*, 'thck, thck_obs, dthck, dthck_dt:', thck(i,j), thck_obs(i,j), dthck(i,j), dthck_dt(i,j)*scyr + print*, '-dthck/thck_scale, -dthck_dt/dthck_dt_scale, sum =', & + -dthck(i,j)/basal_physics%inversion_babc_thck_scale, & + -dthck_dt(i,j)/basal_physics%inversion_babc_dthck_dt_scale, & + term1 + term2 + print*, 'dpowerlaw_c, newpowerlaw_c =', dpowerlaw_c(i,j), basal_physics%powerlaw_c_inversion(i,j) + endif + + else ! powerlaw_c_inversion_mask = 0 + + ! set powerlaw_c = 0 + ! Note: Zero values are ignored when interpolating powerlaw_c to vertices, + ! and in forward runs where powerlaw_c is prescribed from a previous inversion. + ! Warning: If a cell is grounded some of the time and floating the rest of the time, + ! the time-averaging routine will accumulate zero values as if they are real. + ! Time-average fields should be used with caution. + + basal_physics%powerlaw_c_inversion(i,j) = 0.0d0 + + endif ! powerlaw_c_inversion_mask + enddo ! i + enddo ! j + + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'Before smoothing, powerlaw_c:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_inversion(i,j) + enddo + write(6,*) ' ' + enddo + !WHL - debug +! print*, ' ' +! print*, 'floating mask:' +! do j = jtest+4, jtest-4, -1 +! do i = itest-3, itest+3 +! write(6,'(i10)',advance='no') floating_mask(i,j) +! enddo +! write(6,*) ' ' +! enddo +! print*, ' ' +! print*, 'grounding_line_mask:' +! do j = jtest+4, jtest-4, -1 +! do i = itest-3, itest+3 +! write(6,'(i10)',advance='no') grounding_line_mask(i,j) +! enddo +! write(6,*) ' ' +! enddo + endif + + if (basal_physics%inversion_babc_space_smoothing > 0.0d0) then + + ! Save the value just computed + temp_powerlaw_c(:,:) = basal_physics%powerlaw_c_inversion(:,:) + + ! Apply Laplacian smoothing. + ! Since powerlaw_c lives at cell centers but is interpolated to vertices, smoothing can damp checkerboard noise. + !TODO - Write an operator for Laplacian smoothing? + do j = 2, ny-1 + do i = 2, nx-1 + if (powerlaw_c_inversion_mask(i,j) == 1) then ! ice is grounded or GL-adjacent + + dpowerlaw_c_smooth = -4.0d0 * basal_physics%inversion_babc_space_smoothing * temp_powerlaw_c(i,j) + do jj = j-1, j+1 + do ii = i-1, i+1 + if ((ii == i .or. jj == j) .and. (ii /= i .or. jj /= j)) then ! edge neighbor + if (powerlaw_c_inversion_mask(ii,jj) == 1) then ! neighbor is grounded or GL-adjacent + dpowerlaw_c_smooth = dpowerlaw_c_smooth & + + basal_physics%inversion_babc_space_smoothing*temp_powerlaw_c(ii,jj) + else + dpowerlaw_c_smooth = dpowerlaw_c_smooth & + + basal_physics%inversion_babc_space_smoothing*temp_powerlaw_c(i,j) + endif + endif + enddo + enddo + + ! Note: If smoothing is too strong, it can reverse the sign of the change in powerlaw_c. + ! The logic below ensures that if powerlaw_c is increasing, the smoothing can reduce + ! the change to zero, but not cause powerlaw_c to decrease relative to old_powerlaw_c + ! (and similarly if powerlaw_c is decreasing). + + if (dpowerlaw_c(i,j) > 0.0d0) then + if (temp_powerlaw_c(i,j) + dpowerlaw_c_smooth > old_powerlaw_c(i,j)) then + basal_physics%powerlaw_c_inversion(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth + else + ! allow the smoothing to hold Cp at its old value, but not reduce Cp + basal_physics%powerlaw_c_inversion(i,j) = old_powerlaw_c(i,j) + endif + elseif (dpowerlaw_c(i,j) < 0.0d0) then + if (temp_powerlaw_c(i,j) + dpowerlaw_c_smooth < old_powerlaw_c(i,j)) then + basal_physics%powerlaw_c_inversion(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth + else + ! allow the smoothing to hold Cp at its old value, but not increase Cp + basal_physics%powerlaw_c_inversion(i,j) = old_powerlaw_c(i,j) + endif + endif ! dpowerlaw_c > 0 + + endif ! powerlaw_c_inversion_mask = 1 + enddo ! i + enddo ! j + + endif ! smoothing factor > 0 + + call parallel_halo(basal_physics%powerlaw_c_inversion) + + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, 'thck (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck(i,j) + enddo + write(6,*) ' ' + enddo + print*, 'thck - thck_obs:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') dthck(i,j) + enddo + write(6,*) ' ' + enddo + print*, 'dthck_dt (m/yr):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.4)',advance='no') dthck_dt(i,j)*scyr + enddo + write(6,*) ' ' + enddo + if (basal_physics%inversion_babc_space_smoothing > 0.0d0) then + print*, ' ' + print*, 'After smoothing, powerlaw_c:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_inversion(i,j) + enddo + write(6,*) ' ' + enddo + endif + endif + + end subroutine invert_basal_traction + + !*********************************************************************** + + subroutine prescribe_basal_traction_new(nx, ny, & + itest, jtest, rtest, & + basal_physics, & + ice_mask, & + floating_mask, & + land_mask, & + grounding_line_mask) + + ! Compute Cp = powerlaw_c when Cp is prescribed from a previous inversion run. + ! - For cells where the ice is grounded and a prescribed Cp exists, + ! we simply have Cp = Cp_prescribed. + ! - For cells where the ice is grounded and the prescribed Cp = 0 (since the cell + ! was floating or ice-free in the inversion run), we set Cp to a sensible default + ! based on whether the cell is land-based or marine-based. + ! - For cells where the ice is floating (whether or not a prescribed Cp exists), + ! we set Cp = 0. + + integer, intent(in) :: & + nx, ny ! grid dimensions + + integer, intent(in) :: & + itest, jtest, rtest ! coordinates of diagnostic point + + type(glide_basal_physics), intent(inout) :: & + basal_physics ! basal physics object + + integer, dimension(nx,ny), intent(in) :: & + ice_mask, & ! = 1 where ice is present (thck > 0), else = 0 + floating_mask, & ! = 1 where ice is present and floating, else = 0 + land_mask, & ! = 1 if topg > eus, else = 0 + grounding_line_mask ! = 1 if a cell is adjacent to the grounding line, else = 0 + + ! local variables + + integer, dimension(nx,ny) :: & + powerlaw_c_inversion_mask ! = 1 where we invert for powerlaw_c, else = 0 + + integer :: i, j, ii, jj + + ! Compute a mask of cells where powerlaw_c is nonzero. + ! The mask includes cells that are grounded and/or are adjacent to the grounding line. + ! Floating cells are GL-adjacent if they have at least one grounded neighbor. + + where ( (ice_mask == 1 .and. floating_mask == 0) .or. grounding_line_mask == 1 ) + powerlaw_c_inversion_mask = 1 + elsewhere + powerlaw_c_inversion_mask = 0 + endwhere + + call parallel_halo(powerlaw_c_inversion_mask) + + ! Assign values of powerlaw_c + + do j = 1, ny + do i = 1, nx + if (powerlaw_c_inversion_mask(i,j) == 1) then + + if (basal_physics%powerlaw_c_prescribed(i,j) > 0.0d0) then ! use the prescribed value + + basal_physics%powerlaw_c_inversion(i,j) = basal_physics%powerlaw_c_prescribed(i,j) + + else ! assign a sensible default + + if (land_mask(i,j) == 1) then + basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_land + else + basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_marine + endif + + endif ! powerlaw_c_prescribed > 0 + + endif ! powerlaw_c_inversion_mask + enddo ! i + enddo ! j + + call parallel_halo(basal_physics%powerlaw_c_inversion) + + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'floating_mask:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(i10)',advance='no') floating_mask(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'powerlaw_c_prescribed:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_prescribed(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'powerlaw_c_inversion:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_inversion(i,j) + enddo + write(6,*) ' ' + enddo + endif ! verbose + + end subroutine prescribe_basal_traction_new + + !*********************************************************************** + + subroutine prescribe_basal_traction(nx, ny, & + itest, jtest, rtest, & + basal_physics, & + ice_mask, & + floating_mask, & + land_mask) + + ! Compute Cp = powerlaw_c when Cp is prescribed from a previous inversion run. + ! - For cells where the ice is grounded and a prescribed Cp exists, + ! we simply have Cp = Cp_prescribed. + ! - For cells where the ice is grounded and the prescribed Cp = 0 (since the cell + ! was floating or ice-free in the inversion run), we set Cp to a sensible default + ! based on whether the cell is land-based or marine-based. + ! - For cells where the ice is floating (whether or not a prescribed Cp exists), + ! we set Cp = 0. + + integer, intent(in) :: & + nx, ny ! grid dimensions + + integer, intent(in) :: & + itest, jtest, rtest ! coordinates of diagnostic point + + type(glide_basal_physics), intent(inout) :: & + basal_physics ! basal physics object + + integer, dimension(nx,ny), intent(in) :: & + ice_mask, & ! = 1 where ice is present (thck > 0), else = 0 + floating_mask, & ! = 1 where ice is present and floating, else = 0 + land_mask ! = 1 where topg >= eus, else = 0 + + ! local variables + + real(dp), dimension(nx,ny) :: & + new_powerlaw_c ! new powerlaw_c values extrapolated from existing values + + integer :: i, j, ii, jj + + ! Zero out powerlaw_c where ice is not present (thck > 0) and grounded + where (ice_mask == 0 .or. floating_mask == 1) + basal_physics%powerlaw_c_inversion = 0.0d0 + endwhere + + ! Assign values of powerlaw_c in newly grounded cells + + do j = 2, ny-1 + do i = 2, nx-1 + if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! grounded ice + + if (basal_physics%powerlaw_c_inversion(i,j) > 0.0d0) then + + ! nothing to do here; cell was already grounded + + elseif (basal_physics%powerlaw_c_prescribed(i,j) > 0.0d0) then ! use the prescribed value + + basal_physics%powerlaw_c_inversion(i,j) = basal_physics%powerlaw_c_prescribed(i,j) + + else ! assign a sensible default + + if (land_mask(i,j) == 1) then + basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_land + else + basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_marine + endif + + endif ! powerlaw_c > 0 + + endif ! grounded + enddo ! i + enddo ! j + + call parallel_halo(basal_physics%powerlaw_c_inversion) + + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'floating_mask:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(i10)',advance='no') floating_mask(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'powerlaw_c_prescribed:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_prescribed(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'current powerlaw_c:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_inversion(i,j) + enddo + write(6,*) ' ' + enddo + endif ! verbose + + end subroutine prescribe_basal_traction + +!*********************************************************************** + + subroutine invert_bmlt_float_new(dt, & + nx, ny, & + itest, jtest, rtest, & + basal_melt, & + thck, & + usrf_obs, & + topg, & + eus, & + ice_mask, & + floating_mask, & + land_mask, & + grounding_line_mask) + + ! Compute spatially varying bmlt_float by inversion. + ! Apply a melt/freezing rate that will restore the ice in floating grid cells + ! (and grounding-line adjacent grid cells) to the target surface elevation. + ! Note: bmlt_float_inversion is defined as positive for melting, negative for freezing. + + real(dp), intent(in) :: dt ! time step (s) + + integer, intent(in) :: & + nx, ny ! grid dimensions + + integer, intent(in) :: & + itest, jtest, rtest ! coordinates of diagnostic point + + type(glide_basal_melt), intent(inout) :: & + basal_melt ! basal melt object + + ! Note: thck and usrf should be the expected values after applying the mass balance + ! (although the mass balance may not yet have been applied) + real(dp), dimension(nx,ny), intent(in) :: & + thck, & ! ice thickness (m) + usrf_obs, & ! observed upper surface elevation (m) + topg ! bedrock topography (m) + + real(dp), intent(in) :: & + eus ! eustatic sea level (m) + + ! Note: When this subroutine is called, ice_mask = 1 where thck > 0, not thck > thklim. + integer, dimension(nx,ny), intent(in) :: & + ice_mask, & ! = 1 where ice is present, else = 0 + floating_mask, & ! = 1 where ice is present and floating, else = 0 + land_mask, & ! = 1 where topg >= eus, else = 0 + grounding_line_mask ! = 1 if a cell is adjacent to the grounding line, else = 0 + + ! local variables + + integer, dimension(nx,ny) :: & + bmlt_inversion_mask ! = 1 for cells where bmlt_float is computed and applied, else = 0 + + real(dp), dimension(nx,ny):: & + thck_flotation, & ! thickness at which ice becomes afloat (m) + thck_cavity, & ! thickness of ocean cavity beneath floating ice (m) + thck_target ! thickness target (m); = thck_obs unless thck_obs > thck_flotation + + integer :: i, j, ii, jj, iglobal, jglobal + + character(len=100) :: message + + real(dp) :: bmlt_factor ! factor for reducing basal melting + + real(dp), parameter :: inversion_bmlt_timescale = 0.0d0*scyr ! timescale for freezing in cavities (m/s) + + ! For floating and grounding-line-adjacent cells, adjust the basal melt rate (or freezing rate, if bmlt < 0) + ! so as to restore the upper surface to a target based on observations. + + ! Compute the flotation thickness + where (topg - eus < 0.0d0) + thck_flotation = -(rhoo/rhoi) *(topg - eus) + elsewhere + thck_flotation = 0.0d0 + endwhere + + ! Compute the ocean cavity thickness beneath floating ice (diagnostic only) + where (floating_mask == 1) + thck_cavity = -(topg - eus) - (rhoi/rhoo)*thck + elsewhere + thck_cavity = 0.0d0 + endwhere + + ! For floating cells and marine-based grounding-line cells, compute a target thickness + ! based on the target surface elevation. + ! Note: The grounding_line mask is computed before horizontal transport. + ! It includes grounded cells adjacent to at least one floating or ice-free ocean cell, + ! and floating cells adjacent to at least one grounded cell. + + ! initialize + bmlt_inversion_mask(:,:) = 0 + thck_target(:,:) = 0.0d0 + basal_melt%bmlt_float_inversion(:,:) = 0.0d0 + + ! loop over cells + do j = 1, ny + do i = 1, nx + + !TODO - Another case is the cell that has a floating target, is GL-adjacent, and now is strongly grounded. + ! Instead of restoring it all the way to obs with a large bmlt_float, we could restore it + ! only to thck_flotation - bmlt_inversion_thck_buffer + if (land_mask(i,j) == 1) then + + ! do nothing; bmlt_float_inversion = 0 + + !TODO - Remove grounding_line_mask +!! elseif (floating_mask(i,j) == 1) then +!! elseif ( floating_mask(i,j) == 1 .or. & +!! (ice_mask(i,j) == 1 .and. grounding_line_mask(i,j) == 1) ) then + + elseif (usrf_obs(i,j) - (topg(i,j) - eus) > thck_flotation(i,j)) then ! grounded target + + ! If the ice is now floating or very weakly grounded (thck < thck_flotation + thck_buffer), + ! then compute bmlt_float < 0 to restore to thck_flotation + thck_buffer. + + if (thck(i,j) < thck_flotation(i,j) + bmlt_inversion_thck_buffer) then ! floating or very weakly grounded + + ! Restore to a thickness slightly greater than thck_flotation + ! (generally not all the way to the observed thickness, since we would prefer + ! for the basal traction inversion to achieve this by roughening the bed). + bmlt_inversion_mask(i,j) = 1 + thck_target(i,j) = thck_flotation(i,j) + bmlt_inversion_thck_buffer + + else ! strongly grounded + + ! do nothing; bmlt_float_inversion = 0 + + endif + + elseif (usrf_obs(i,j) > 0.0d0) then ! floating target + + ! Note: With usrf_obs > 0 requirement, we do not melt columns that are ice-free in observations. + ! This allows the calving front to advance (if not using a no-advance calving mask). + + bmlt_inversion_mask(i,j) = 1 + thck_target(i,j) = usrf_obs(i,j) * rhoo/(rhoo - rhoi) + + endif + + !WHL - debug - to prevent bmlt_float_inversion < 0 +!! if (thck_target(i,j) > thck(i,j) .and. grounding_line_mask(i,j) == 0) then +!! thck_target(i,j) = thck(i,j) +!! endif + + if (bmlt_inversion_mask(i,j) == 1) then + basal_melt%bmlt_float_inversion(i,j) = (thck(i,j) - thck_target(i,j)) / dt + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest .and. i==itest .and. j==jtest) then + print*, ' ' + print*, 'Invert for bmlt_float_inversion: rank, i, j =', rtest, itest, jtest + print*, 'topg - eus, usrf_obs:', topg(i,j) - eus, usrf_obs(i,j) + print*, 'thck, thck_target, bmlt_float:', & + thck(i,j), thck_target(i,j), basal_melt%bmlt_float_inversion(i,j)*dt + endif + + endif ! bmlt_inversion_mask = 1 + + enddo ! i + enddo ! j + + !TODO - Test the following code further, or delete it? So far, I haven't found a timescale to work well. + ! If a nonzero timescale is specified, then multiply bmlt_float_inversion by a factor + ! proportional to dt/timescale, in the range (0,1]. + + if (inversion_bmlt_timescale > 0.0d0) then + bmlt_factor = min(dt/inversion_bmlt_timescale, 1.0d0) + basal_melt%bmlt_float_inversion(:,:) = basal_melt%bmlt_float_inversion(:,:) * bmlt_factor + endif + + call parallel_halo(bmlt_inversion_mask) ! diagnostic only + call parallel_halo(thck_target) ! diagnostic only + + call parallel_halo(basal_melt%bmlt_float_inversion) + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'bmlt_inversion_mask:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(i10)',advance='no') bmlt_inversion_mask(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'grounding_line_mask:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(i10)',advance='no') grounding_line_mask(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'floating_mask:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(i10)',advance='no') floating_mask(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'thck_flotation (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck_flotation(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'thck_cavity (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck_cavity(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'thck (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'thck_target (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck_target(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'bmlt_float_inversion (m/yr):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') basal_melt%bmlt_float_inversion(i,j)*scyr + enddo + write(6,*) ' ' + enddo + endif + + end subroutine invert_bmlt_float_new + +!*********************************************************************** + + subroutine invert_bmlt_float(dt, & + nx, ny, & + itest, jtest, rtest, & basal_melt, & thck, & thck_obs, & @@ -675,9 +1476,7 @@ subroutine invert_bmlt_float(dt, & ! local variables integer, dimension(nx,ny) :: & - bmlt_inversion_mask, & ! = 1 for cells where bmlt_float is computed and applied, else = 0 - floating_mask_bmlt ! = 1 for cells that are durably floating, else = 0 - ! (where "durably floating" is defined as floating both before and after transport) + bmlt_inversion_mask ! = 1 for cells where bmlt_float is computed and applied, else = 0 real(dp), dimension(nx,ny):: & thck_flotation, & ! thickness at which ice becomes afloat (m) @@ -694,8 +1493,6 @@ subroutine invert_bmlt_float(dt, & ! Where the observed ice is floating, adjust the basal melt rate (or freezing rate, if bmlt < 0) ! so as to relax the ice thickness toward a target thickness based on observations. - ! Note: This subroutine should be called after other mass-balance terms have been applied, - ! after horizontal transport, and preferably after calving. if (verbose_inversion .and. main_task) then print*, ' ' @@ -709,7 +1506,7 @@ subroutine invert_bmlt_float(dt, & thck_flotation = 0.0d0 endwhere - ! Compute the ocean cavity thickness beneath floating ice + ! Compute the ocean cavity thickness beneath floating ice (diagnostic only) where (floating_mask == 1) thck_cavity = -(topg - eus) - (rhoi/rhoo)*thck elsewhere @@ -911,6 +1708,208 @@ subroutine invert_bmlt_float(dt, & end subroutine invert_bmlt_float +!*********************************************************************** + + subroutine prescribe_bmlt_float_new(dt, & + nx, ny, & + itest, jtest, rtest, & + basal_melt, & + thck, & + topg, & + eus, & + ice_mask, & + floating_mask, & + land_mask, & + grounding_line_mask) + + ! Prescribe bmlt_float based on the value computed from inversion. + ! Note: bmlt_float_inversion is defined as positive for melting, negative for freezing. + ! This field is applied only in floating and grounding-line adjacent cells. + + real(dp), intent(in) :: dt ! time step (s) + + integer, intent(in) :: & + nx, ny ! grid dimensions + + integer, intent(in) :: & + itest, jtest, rtest ! coordinates of diagnostic point + + type(glide_basal_melt), intent(inout) :: & + basal_melt ! basal melt object + + ! Note: thck should be the expected values after applying the mass balance + ! (although the mass balance may not yet have been applied) + real(dp), dimension(nx,ny), intent(in) :: & + thck, & ! ice thickness (m) + topg ! bedrock elevation (m) + + real(dp), intent(in) :: & + eus ! eustatic sea level (m) + + ! Note: When this subroutine is called, ice_mask = 1 where thck > 0, not thck > thklim. + integer, dimension(nx,ny), intent(in) :: & + ice_mask, & ! = 1 where ice is present, else = 0 + floating_mask, & ! = 1 where ice is present and floating, else = 0 + land_mask, & ! = 1 where topg >= eus, else = 0 + grounding_line_mask ! = 1 if a cell is adjacent to the grounding line, else = 0 + + ! local variables + + integer, dimension(nx,ny) :: & + bmlt_inversion_mask ! = 1 for cells where bmlt_float is computed and applied, else = 0 + + real(dp), dimension(nx,ny):: & + thck_flotation, & ! flotation thickness (m) + thck_cavity, & ! thickness (m) of ocean cavity (diagnostic only) + thck_final ! final thickness (m) if full melt rate is applied + + integer :: i, j + + ! Note: This subroutine should be called after other mass-balance terms have been applied, + ! after horizontal transport, and preferably after calving. + + if (verbose_inversion .and. main_task) then + print*, ' ' + print*, 'In prescribe_bmlt_float' + endif + + ! Compute the flotation thickness + where (topg - eus < 0.0d0) + thck_flotation = -(rhoo/rhoi) * (topg - eus) + elsewhere + thck_flotation = 0.0d0 + endwhere + + ! Compute the ocean cavity thickness beneath floating ice (diagnostic only) + where (floating_mask == 1) + thck_cavity = -(topg - eus) - (rhoi/rhoo)*thck + elsewhere + thck_cavity = 0.0d0 + endwhere + + ! Compute a mask of floating cells and marine-based grounding-line cells, + ! where bmlt_float_inversion can potentially be applied. + ! Where bmlt_inversion_mask = 1, apply bmlt_float_prescribed. + ! Note: The land mask may not be needed, since land cells are excluded from the inversion. + ! But this mask is included for generality, in case of dynamic topography. + + bmlt_inversion_mask(:,:) = 0 + basal_melt%bmlt_float_inversion(:,:) = 0.0d0 + thck_final(:,:) = 0.0d0 + + do j = 1, ny + do i = 1, nx + if (land_mask(i,j) == 1) then + + ! do nothing; bmlt_float_inversion = 0 + + elseif (floating_mask(i,j) == 1 .or. & + (ice_mask(i,j) == 1 .and. grounding_line_mask(i,j) == 1) ) then + + bmlt_inversion_mask(i,j) = 1 + basal_melt%bmlt_float_inversion(i,j) = basal_melt%bmlt_float_prescribed(i,j) + + ! Make sure the final thickness is non-negative. + + thck_final(i,j) = thck(i,j) - basal_melt%bmlt_float_inversion(i,j)*dt + + if (thck_final(i,j) < 0.0d0) then + thck_final(i,j) = 0.0d0 + basal_melt%bmlt_float_inversion(i,j) = (thck(i,j) - thck_final(i,j)) / dt + endif + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest .and. i==itest .and. j==jtest) then + print*, ' ' + print*, 'Prescribe bmlt_float_inversion: rank, i, j =', rtest, itest, jtest + print*, 'thck, thck_final, bmlt_float_inversion*dt:', thck(i,j), thck_final(i,j), & + basal_melt%bmlt_float_inversion(i,j)*dt + endif + + endif ! masks + enddo ! i + enddo ! j + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'bmlt_float_prescribed (m/yr):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') basal_melt%bmlt_float_prescribed(i,j)*scyr + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'bmlt_inversion_mask:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(i10)',advance='no') bmlt_inversion_mask(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'grounding_line_mask:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(i10)',advance='no') grounding_line_mask(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'floating_mask:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(i10)',advance='no') floating_mask(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'thck_flotation (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck_flotation(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'thck_cavity (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck_cavity(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'thck (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'thck_final:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') thck_final(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'bmlt_float_inversion (m/yr):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.3)',advance='no') basal_melt%bmlt_float_inversion(i,j)*scyr + enddo + write(6,*) ' ' + enddo + endif + + end subroutine prescribe_bmlt_float_new + !*********************************************************************** subroutine prescribe_bmlt_float(dt, & From fe9f6b9dcd6e63814e1b8e5f8a603468416a5c02 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Wed, 2 May 2018 14:18:13 -0600 Subject: [PATCH 28/61] Removed deprecated inversion subroutines I renamed invert_bmlt_float_new as invert_bmlt_float, and removed the old deprecated invert_bmlt_float. Similarly for invert_basal_traction, prescribe_bmlt_float and prescribe_basal_traction. --- libglissade/glissade.F90 | 103 +-- libglissade/glissade_inversion.F90 | 1084 +++------------------------- 2 files changed, 93 insertions(+), 1094 deletions(-) diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index 11883127..1e8ad371 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -75,8 +75,6 @@ module glissade real(dp), parameter :: thk_init = 500.d0 ! initial thickness (m) for test_transport logical, parameter :: test_halo = .false. ! if true, call test_halo subroutine - logical, parameter :: new_inversion = .true. - contains !======================================================================= @@ -1156,8 +1154,6 @@ subroutine glissade_transport_solve(model) use glissade_masks, only: glissade_get_masks use glissade_inversion, only: invert_bmlt_float, prescribe_bmlt_float, & invert_basal_traction, prescribe_basal_traction - use glissade_inversion, only: invert_bmlt_float_new, prescribe_bmlt_float_new, & - invert_basal_traction_new, prescribe_basal_traction_new use glissade_inversion, only: invert_basal_topography, verbose_inversion implicit none @@ -1641,15 +1637,13 @@ subroutine glissade_transport_solve(model) enddo endif - if (new_inversion) then - ! Determine the basal traction field, powerlaw_c_inversion, if desired. ! Notes: (1) For inversion purposes, ice_mask = 1 where thck > 0.0 (not where thck > thklim). ! (2) usrf_unscaled is the expected new value after applying the mass balance. ! (3) These masks are computed before horizontal transport. So for instance, if a cell ! is grounded before transport and floating afterward, it is treated as grounded. - call invert_basal_traction_new(model%numerics%dt*tim0, & ! s + call invert_basal_traction(model%numerics%dt*tim0, & ! s model%general%ewn, model%general%nsn, & itest, jtest, rtest, & model%basal_physics, & @@ -1657,7 +1651,6 @@ subroutine glissade_transport_solve(model) floating_mask, & !TODO - before transport? land_mask, & grounding_line_mask, & -!! usrf_new_unscaled, & ! m model%basal_physics%usrf_inversion, & ! m model%geometry%usrf_obs*thk0, & ! m model%basal_physics%dthck_dt_inversion) ! m/s @@ -1677,7 +1670,7 @@ subroutine glissade_transport_solve(model) !TODO - Are masks needed? Is it OK to have them computed pre-transport? - call invert_bmlt_float_new(model%numerics%dt * tim0, & ! s + call invert_bmlt_float(model%numerics%dt * tim0, & ! s model%general%ewn, model%general%nsn, & itest, jtest, rtest, & model%basal_melt, & @@ -1701,69 +1694,13 @@ subroutine glissade_transport_solve(model) print*, ' ' endif - else ! old inversion - - call invert_basal_traction(model%numerics%dt*tim0, & ! s - model%general%ewn, model%general%nsn, & - itest, jtest, rtest, & - model%basal_physics, & - ice_mask, & - floating_mask, & - land_mask, & - grounding_line_mask, & - model%geometry%thck*thk0, & ! m - model%basal_physics%dthck_dt_inversion, & ! m/s - model%geometry%thck_obs*thk0) ! m - - ! Invert for bmlt_float_inversion, adjusting the melt rate to relax toward the observed thickness. - ! Note: basal_melt%bmlt_float_inversion is passed out with units of m/s - - ! Note: Other kinds of basal melting are handled in subroutine glissade_bmlt_float_solve. - ! Inversion is done here, after transport, when there is an updated ice thickness. - ! Then bmlt_float_inversion is added to the previously computed bmlt. - ! Note: Usually, whichbmlt_float = 0 when doing inversion. - ! However, for the HO_INVERSION_PRESCRIBED option, we may want to add a basal melting anomaly - ! as for the initMIP anomaly experiments. In that case the anomaly is already part of bmlt_float. - ! Note: If the basal melt GLP is turned on, it sets bmlt_float = 0 in partly floating cells. - ! However, it does not limit bmlt_float_inversion, which is applied to all floating cells, - ! including partly floating cells (in order to match observed thicknesses at the grounding line). - - call invert_bmlt_float(model%numerics%dt * tim0, & ! s - model%general%ewn, model%general%nsn, & - itest, jtest, rtest, & - model%basal_melt, & - thck_unscaled, & ! m - model%geometry%thck_obs*thk0, & ! m - model%geometry%topg*thk0, & ! m - model%climate%eus*thk0, & ! m - model%climate%acab_corrected*thk0/tim0, & ! m/s - model%basal_melt%bmlt*thk0/tim0, & ! m/s - ice_mask, & - floating_mask, & - land_mask) - - !WHL - debug - if (verbose_inversion .and. this_rank == rtest) then - i = itest - j = jtest - print*, ' ' - print*, 'Inverting for bmlt_float: rank, i, j =', rtest, i, j - print*, 'thck (m), thck_obs (m), bmlt_float_inversion (m/yr):', thck_unscaled(i,j), & - model%geometry%thck_obs(i,j)*thk0, model%basal_melt%bmlt_float_inversion(i,j)*scyr - print*, ' ' - endif - - endif ! new_inversion - elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then - if (new_inversion) then - ! Prescribe the traction parameter powerlaw_c based on a previous inversion. ! Although powerlaw_c is prescribed, it may need to be modified, ! for example if a cell flips from grounded to floating or vice versa. - call prescribe_basal_traction_new(model%general%ewn, model%general%nsn, & + call prescribe_basal_traction(model%general%ewn, model%general%nsn, & itest, jtest, rtest, & model%basal_physics, & ice_mask, & @@ -1775,7 +1712,7 @@ subroutine glissade_transport_solve(model) ! Although bmlt_float is prescribed, it may need to be limited or ignored, ! for example to avoid melting beneath grounded ice. - call prescribe_bmlt_float_new(model%numerics%dt * tim0, & ! s + call prescribe_bmlt_float(model%numerics%dt * tim0, & ! s model%general%ewn, model%general%nsn, & itest, jtest, rtest, & model%basal_melt, & @@ -1787,38 +1724,6 @@ subroutine glissade_transport_solve(model) land_mask, & grounding_line_mask) - else ! old inversion - - ! Prescribe the traction parameter powerlaw_c based on a previous inversion. - ! Although powerlaw_c is prescribed, it may need to be modified, - ! for example if a cell flips from grounded to floating or vice versa. - - call prescribe_basal_traction(model%general%ewn, model%general%nsn, & - itest, jtest, rtest, & - model%basal_physics, & - ice_mask, & - floating_mask, & - land_mask) - - ! Prescribe bmlt_float based on a previous inversion. - ! Although bmlt_float is prescribed, it may need to be limited or ignored, - ! for example to avoid melting beneath grounded ice. - - call prescribe_bmlt_float(model%numerics%dt * tim0, & ! s - model%general%ewn, model%general%nsn, & - itest, jtest, rtest, & - model%basal_melt, & - thck_unscaled, & ! m - model%geometry%topg*thk0, & ! m - model%climate%eus*thk0, & ! m - model%climate%acab_corrected*thk0/tim0, & ! m/s - model%basal_melt%bmlt*thk0/tim0, & ! m/s - ice_mask, & - floating_mask, & - land_mask) - - endif ! new inversion - !WHL - debug if (verbose_inversion .and. this_rank == rtest) then i = itest diff --git a/libglissade/glissade_inversion.F90 b/libglissade/glissade_inversion.F90 index fd3c2e0e..6b061a73 100644 --- a/libglissade/glissade_inversion.F90 +++ b/libglissade/glissade_inversion.F90 @@ -371,7 +371,7 @@ end subroutine invert_basal_topography !*********************************************************************** - subroutine invert_basal_traction_new(dt, & + subroutine invert_basal_traction(dt, & nx, ny, & itest, jtest, rtest, & basal_physics, & @@ -661,29 +661,26 @@ subroutine invert_basal_traction_new(dt, & endif endif - end subroutine invert_basal_traction_new + end subroutine invert_basal_traction !*********************************************************************** - subroutine invert_basal_traction(dt, & - nx, ny, & - itest, jtest, rtest, & - basal_physics, & - ice_mask, & - floating_mask, & - land_mask, & - grounding_line_mask, & - thck, & - dthck_dt, & - thck_obs) - - ! Compute a spatially varying basal traction field, powerlaw_c_inversion. - ! The method is similar to that of Pollard & DeConto (TC, 2012), and is applied to all grounded ice. - ! Where thck > thck_obs, powerlaw_c is reduced to increase sliding. - ! Where thck < thck_obs, powerlaw_c is increased to reduce sliding. - ! Note: powerlaw_c is constrained to lie within a prescribed range. + subroutine prescribe_basal_traction(nx, ny, & + itest, jtest, rtest, & + basal_physics, & + ice_mask, & + floating_mask, & + land_mask, & + grounding_line_mask) - real(dp), intent(in) :: dt ! time step (s) + ! Compute Cp = powerlaw_c when Cp is prescribed from a previous inversion run. + ! - For cells where the ice is grounded and a prescribed Cp exists, + ! we simply have Cp = Cp_prescribed. + ! - For cells where the ice is grounded and the prescribed Cp = 0 (since the cell + ! was floating or ice-free in the inversion run), we set Cp to a sensible default + ! based on whether the cell is land-based or marine-based. + ! - For cells where the ice is floating (whether or not a prescribed Cp exists), + ! we set Cp = 0. integer, intent(in) :: & nx, ny ! grid dimensions @@ -695,53 +692,19 @@ subroutine invert_basal_traction(dt, & basal_physics ! basal physics object integer, dimension(nx,ny), intent(in) :: & - ice_mask, & ! = 1 where ice is present (thk > 0), else = 0 + ice_mask, & ! = 1 where ice is present (thck > 0), else = 0 floating_mask, & ! = 1 where ice is present and floating, else = 0 land_mask, & ! = 1 if topg > eus, else = 0 grounding_line_mask ! = 1 if a cell is adjacent to the grounding line, else = 0 - real(dp), dimension(nx,ny), intent(in) :: & - thck, & ! ice thickness (m) - dthck_dt, & ! rate of change of ice thickness (m/s) - thck_obs ! observed thickness (m) - ! local variables integer, dimension(nx,ny) :: & powerlaw_c_inversion_mask ! = 1 where we invert for powerlaw_c, else = 0 - real(dp), dimension(nx,ny) :: & - dthck, & ! thck - thck_obs on ice grid - old_powerlaw_c, & ! old value of powerlaw_c_inversion (start of timestep) - temp_powerlaw_c, & ! temporary value of powerlaw_c_inversion (before smoothing) - dpowerlaw_c ! change in powerlaw_c - - real(dp) :: term1, term2 - real(dp) :: factor - real(dp) :: dpowerlaw_c_smooth - real(dp) :: sum_powerlaw_c - integer :: i, j, ii, jj - integer :: count - ! inversion parameters in basal_physics derived type: - ! * powerlaw_c_max = upper bound for powerlaw_c, Pa (m/yr)^(-1/3) - ! * powerlaw_c_min = lower bound for powerlaw_c, Pa (m/yr)^(-1/3) - ! * inversion_babc_timescale = inversion timescale (s); must be > 0 - ! * inversion_babc_thck_scale = thickness inversion scale (m); must be > 0 - ! * inversion_babc_dthck_dt_scale = dthck_dt inversion scale (m/s); must be > 0 - ! * inversion_babc_space_smoothing = factor for smoothing powerlaw_c_inversion; higher => more smoothing - ! - ! Note on smoothing: A smoothing factor of 1/8 gives a 4-1-1-1-1 smoother. - ! This is numerically well behaved, but may oversmooth in bowl-shaped regions; - ! a smaller value may be better as H converges toward H_obs. - - dpowerlaw_c(:,:) = 0.0d0 - - ! Compute difference between current and target thickness - dthck(:,:) = thck(:,:) - thck_obs(:,:) - - ! Compute a mask of cells where we invert for powerlaw_c. + ! Compute a mask of cells where powerlaw_c is nonzero. ! The mask includes cells that are grounded and/or are adjacent to the grounding line. ! Floating cells are GL-adjacent if they have at least one grounded neighbor. @@ -753,444 +716,77 @@ subroutine invert_basal_traction(dt, & call parallel_halo(powerlaw_c_inversion_mask) - ! Check for newly grounded cells that have powerlaw_c = 0 (from when they were ice-free or floating). - ! Give these cells a sensible default value by extrapolating from neighbor cells. - do j = 1, ny - do i = 1, nx - if (powerlaw_c_inversion_mask(i,j) == 1) then ! ice is grounded or GL-adjacent - - if (basal_physics%powerlaw_c_inversion(i,j) == 0.0d0) then - ! set to a sensible default - ! If on land, set to a typical land value - ! If grounded marine ice, set to a smaller value - if (land_mask(i,j) == 1) then - basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_land - else - basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_marine - endif - endif ! powerlaw_c_inversion = 0 - - endif ! powerlaw_c_inversion_mask = 1 - enddo ! i - enddo ! j - - call parallel_halo(basal_physics%powerlaw_c_inversion) - - ! Loop over cells - ! Note: powerlaw_c_inversion is computed at cell centers where thck is located. - ! Later, it is interpolated to vertices where beta and basal velocity are located. + ! Assign values of powerlaw_c do j = 1, ny do i = 1, nx - if (powerlaw_c_inversion_mask(i,j) == 1) then ! ice is grounded or GL-adjacent + if (powerlaw_c_inversion_mask(i,j) == 1) then - ! Save the starting value - old_powerlaw_c(i,j) = basal_physics%powerlaw_c_inversion(i,j) + if (basal_physics%powerlaw_c_prescribed(i,j) > 0.0d0) then ! use the prescribed value - ! Invert for powerlaw_c based on dthck and dthck_dt - term1 = -dthck(i,j) / basal_physics%inversion_babc_thck_scale - term2 = -dthck_dt(i,j) / basal_physics%inversion_babc_dthck_dt_scale + basal_physics%powerlaw_c_inversion(i,j) = basal_physics%powerlaw_c_prescribed(i,j) - dpowerlaw_c(i,j) = (dt/basal_physics%inversion_babc_timescale) & - * basal_physics%powerlaw_c_inversion(i,j) * (term1 + term2) + else ! assign a sensible default - ! Limit to prevent huge change in one step - if (abs(dpowerlaw_c(i,j)) > 0.05 * basal_physics%powerlaw_c_inversion(i,j)) then - if (dpowerlaw_c(i,j) > 0.0d0) then - dpowerlaw_c(i,j) = 0.05d0 * basal_physics%powerlaw_c_inversion(i,j) + if (land_mask(i,j) == 1) then + basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_land else - dpowerlaw_c(i,j) = -0.05d0 * basal_physics%powerlaw_c_inversion(i,j) + basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_marine endif - endif - - basal_physics%powerlaw_c_inversion(i,j) = basal_physics%powerlaw_c_inversion(i,j) + dpowerlaw_c(i,j) - - ! Limit to a physically reasonable range - basal_physics%powerlaw_c_inversion(i,j) = min(basal_physics%powerlaw_c_inversion(i,j), & - basal_physics%powerlaw_c_max) - basal_physics%powerlaw_c_inversion(i,j) = max(basal_physics%powerlaw_c_inversion(i,j), & - basal_physics%powerlaw_c_min) - - !WHL - debug - if (verbose_inversion .and. this_rank == rtest .and. i==itest .and. j==jtest) then - print*, ' ' - print*, 'Invert for powerlaw_c and coulomb_c: rank, i, j =', rtest, itest, jtest - print*, 'thck, thck_obs, dthck, dthck_dt:', thck(i,j), thck_obs(i,j), dthck(i,j), dthck_dt(i,j)*scyr - print*, '-dthck/thck_scale, -dthck_dt/dthck_dt_scale, sum =', & - -dthck(i,j)/basal_physics%inversion_babc_thck_scale, & - -dthck_dt(i,j)/basal_physics%inversion_babc_dthck_dt_scale, & - term1 + term2 - print*, 'dpowerlaw_c, newpowerlaw_c =', dpowerlaw_c(i,j), basal_physics%powerlaw_c_inversion(i,j) - endif - - else ! powerlaw_c_inversion_mask = 0 - - ! set powerlaw_c = 0 - ! Note: Zero values are ignored when interpolating powerlaw_c to vertices, - ! and in forward runs where powerlaw_c is prescribed from a previous inversion. - ! Warning: If a cell is grounded some of the time and floating the rest of the time, - ! the time-averaging routine will accumulate zero values as if they are real. - ! Time-average fields should be used with caution. - basal_physics%powerlaw_c_inversion(i,j) = 0.0d0 + endif ! powerlaw_c_prescribed > 0 endif ! powerlaw_c_inversion_mask enddo ! i enddo ! j - if (verbose_inversion .and. this_rank == rtest) then - i = itest - j = jtest - print*, ' ' - print*, 'Before smoothing, powerlaw_c:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_inversion(i,j) - enddo - write(6,*) ' ' - enddo - !WHL - debug -! print*, ' ' -! print*, 'floating mask:' -! do j = jtest+4, jtest-4, -1 -! do i = itest-3, itest+3 -! write(6,'(i10)',advance='no') floating_mask(i,j) -! enddo -! write(6,*) ' ' -! enddo -! print*, ' ' -! print*, 'grounding_line_mask:' -! do j = jtest+4, jtest-4, -1 -! do i = itest-3, itest+3 -! write(6,'(i10)',advance='no') grounding_line_mask(i,j) -! enddo -! write(6,*) ' ' -! enddo - endif - - if (basal_physics%inversion_babc_space_smoothing > 0.0d0) then - - ! Save the value just computed - temp_powerlaw_c(:,:) = basal_physics%powerlaw_c_inversion(:,:) - - ! Apply Laplacian smoothing. - ! Since powerlaw_c lives at cell centers but is interpolated to vertices, smoothing can damp checkerboard noise. - !TODO - Write an operator for Laplacian smoothing? - do j = 2, ny-1 - do i = 2, nx-1 - if (powerlaw_c_inversion_mask(i,j) == 1) then ! ice is grounded or GL-adjacent - - dpowerlaw_c_smooth = -4.0d0 * basal_physics%inversion_babc_space_smoothing * temp_powerlaw_c(i,j) - do jj = j-1, j+1 - do ii = i-1, i+1 - if ((ii == i .or. jj == j) .and. (ii /= i .or. jj /= j)) then ! edge neighbor - if (powerlaw_c_inversion_mask(ii,jj) == 1) then ! neighbor is grounded or GL-adjacent - dpowerlaw_c_smooth = dpowerlaw_c_smooth & - + basal_physics%inversion_babc_space_smoothing*temp_powerlaw_c(ii,jj) - else - dpowerlaw_c_smooth = dpowerlaw_c_smooth & - + basal_physics%inversion_babc_space_smoothing*temp_powerlaw_c(i,j) - endif - endif - enddo - enddo - - ! Note: If smoothing is too strong, it can reverse the sign of the change in powerlaw_c. - ! The logic below ensures that if powerlaw_c is increasing, the smoothing can reduce - ! the change to zero, but not cause powerlaw_c to decrease relative to old_powerlaw_c - ! (and similarly if powerlaw_c is decreasing). - - if (dpowerlaw_c(i,j) > 0.0d0) then - if (temp_powerlaw_c(i,j) + dpowerlaw_c_smooth > old_powerlaw_c(i,j)) then - basal_physics%powerlaw_c_inversion(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth - else - ! allow the smoothing to hold Cp at its old value, but not reduce Cp - basal_physics%powerlaw_c_inversion(i,j) = old_powerlaw_c(i,j) - endif - elseif (dpowerlaw_c(i,j) < 0.0d0) then - if (temp_powerlaw_c(i,j) + dpowerlaw_c_smooth < old_powerlaw_c(i,j)) then - basal_physics%powerlaw_c_inversion(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth - else - ! allow the smoothing to hold Cp at its old value, but not increase Cp - basal_physics%powerlaw_c_inversion(i,j) = old_powerlaw_c(i,j) - endif - endif ! dpowerlaw_c > 0 - - endif ! powerlaw_c_inversion_mask = 1 - enddo ! i - enddo ! j - - endif ! smoothing factor > 0 - call parallel_halo(basal_physics%powerlaw_c_inversion) if (verbose_inversion .and. this_rank == rtest) then i = itest j = jtest - print*, 'thck (m):' + print*, ' ' + print*, 'floating_mask:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck(i,j) + write(6,'(i10)',advance='no') floating_mask(i,j) enddo write(6,*) ' ' enddo - print*, 'thck - thck_obs:' + print*, ' ' + print*, 'powerlaw_c_prescribed:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') dthck(i,j) + write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_prescribed(i,j) enddo write(6,*) ' ' enddo - print*, 'dthck_dt (m/yr):' + print*, ' ' + print*, 'powerlaw_c_inversion:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.4)',advance='no') dthck_dt(i,j)*scyr + write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_inversion(i,j) enddo write(6,*) ' ' enddo - if (basal_physics%inversion_babc_space_smoothing > 0.0d0) then - print*, ' ' - print*, 'After smoothing, powerlaw_c:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_inversion(i,j) - enddo - write(6,*) ' ' - enddo - endif - endif + endif ! verbose - end subroutine invert_basal_traction + end subroutine prescribe_basal_traction !*********************************************************************** - subroutine prescribe_basal_traction_new(nx, ny, & - itest, jtest, rtest, & - basal_physics, & - ice_mask, & - floating_mask, & - land_mask, & - grounding_line_mask) - - ! Compute Cp = powerlaw_c when Cp is prescribed from a previous inversion run. - ! - For cells where the ice is grounded and a prescribed Cp exists, - ! we simply have Cp = Cp_prescribed. - ! - For cells where the ice is grounded and the prescribed Cp = 0 (since the cell - ! was floating or ice-free in the inversion run), we set Cp to a sensible default - ! based on whether the cell is land-based or marine-based. - ! - For cells where the ice is floating (whether or not a prescribed Cp exists), - ! we set Cp = 0. - - integer, intent(in) :: & - nx, ny ! grid dimensions - - integer, intent(in) :: & - itest, jtest, rtest ! coordinates of diagnostic point - - type(glide_basal_physics), intent(inout) :: & - basal_physics ! basal physics object - - integer, dimension(nx,ny), intent(in) :: & - ice_mask, & ! = 1 where ice is present (thck > 0), else = 0 - floating_mask, & ! = 1 where ice is present and floating, else = 0 - land_mask, & ! = 1 if topg > eus, else = 0 - grounding_line_mask ! = 1 if a cell is adjacent to the grounding line, else = 0 - - ! local variables - - integer, dimension(nx,ny) :: & - powerlaw_c_inversion_mask ! = 1 where we invert for powerlaw_c, else = 0 - - integer :: i, j, ii, jj - - ! Compute a mask of cells where powerlaw_c is nonzero. - ! The mask includes cells that are grounded and/or are adjacent to the grounding line. - ! Floating cells are GL-adjacent if they have at least one grounded neighbor. - - where ( (ice_mask == 1 .and. floating_mask == 0) .or. grounding_line_mask == 1 ) - powerlaw_c_inversion_mask = 1 - elsewhere - powerlaw_c_inversion_mask = 0 - endwhere - - call parallel_halo(powerlaw_c_inversion_mask) - - ! Assign values of powerlaw_c - - do j = 1, ny - do i = 1, nx - if (powerlaw_c_inversion_mask(i,j) == 1) then - - if (basal_physics%powerlaw_c_prescribed(i,j) > 0.0d0) then ! use the prescribed value - - basal_physics%powerlaw_c_inversion(i,j) = basal_physics%powerlaw_c_prescribed(i,j) - - else ! assign a sensible default - - if (land_mask(i,j) == 1) then - basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_land - else - basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_marine - endif - - endif ! powerlaw_c_prescribed > 0 - - endif ! powerlaw_c_inversion_mask - enddo ! i - enddo ! j - - call parallel_halo(basal_physics%powerlaw_c_inversion) - - if (verbose_inversion .and. this_rank == rtest) then - i = itest - j = jtest - print*, ' ' - print*, 'floating_mask:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(i10)',advance='no') floating_mask(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'powerlaw_c_prescribed:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_prescribed(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'powerlaw_c_inversion:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_inversion(i,j) - enddo - write(6,*) ' ' - enddo - endif ! verbose - - end subroutine prescribe_basal_traction_new - - !*********************************************************************** - - subroutine prescribe_basal_traction(nx, ny, & - itest, jtest, rtest, & - basal_physics, & - ice_mask, & - floating_mask, & - land_mask) - - ! Compute Cp = powerlaw_c when Cp is prescribed from a previous inversion run. - ! - For cells where the ice is grounded and a prescribed Cp exists, - ! we simply have Cp = Cp_prescribed. - ! - For cells where the ice is grounded and the prescribed Cp = 0 (since the cell - ! was floating or ice-free in the inversion run), we set Cp to a sensible default - ! based on whether the cell is land-based or marine-based. - ! - For cells where the ice is floating (whether or not a prescribed Cp exists), - ! we set Cp = 0. - - integer, intent(in) :: & - nx, ny ! grid dimensions - - integer, intent(in) :: & - itest, jtest, rtest ! coordinates of diagnostic point - - type(glide_basal_physics), intent(inout) :: & - basal_physics ! basal physics object - - integer, dimension(nx,ny), intent(in) :: & - ice_mask, & ! = 1 where ice is present (thck > 0), else = 0 - floating_mask, & ! = 1 where ice is present and floating, else = 0 - land_mask ! = 1 where topg >= eus, else = 0 - - ! local variables - - real(dp), dimension(nx,ny) :: & - new_powerlaw_c ! new powerlaw_c values extrapolated from existing values - - integer :: i, j, ii, jj - - ! Zero out powerlaw_c where ice is not present (thck > 0) and grounded - where (ice_mask == 0 .or. floating_mask == 1) - basal_physics%powerlaw_c_inversion = 0.0d0 - endwhere - - ! Assign values of powerlaw_c in newly grounded cells - - do j = 2, ny-1 - do i = 2, nx-1 - if (ice_mask(i,j) == 1 .and. floating_mask(i,j) == 0) then ! grounded ice - - if (basal_physics%powerlaw_c_inversion(i,j) > 0.0d0) then - - ! nothing to do here; cell was already grounded - - elseif (basal_physics%powerlaw_c_prescribed(i,j) > 0.0d0) then ! use the prescribed value - - basal_physics%powerlaw_c_inversion(i,j) = basal_physics%powerlaw_c_prescribed(i,j) - - else ! assign a sensible default - - if (land_mask(i,j) == 1) then - basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_land - else - basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_marine - endif - - endif ! powerlaw_c > 0 - - endif ! grounded - enddo ! i - enddo ! j - - call parallel_halo(basal_physics%powerlaw_c_inversion) - - if (verbose_inversion .and. this_rank == rtest) then - i = itest - j = jtest - print*, ' ' - print*, 'floating_mask:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(i10)',advance='no') floating_mask(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'powerlaw_c_prescribed:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_prescribed(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'current powerlaw_c:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_inversion(i,j) - enddo - write(6,*) ' ' - enddo - endif ! verbose - - end subroutine prescribe_basal_traction - -!*********************************************************************** - - subroutine invert_bmlt_float_new(dt, & - nx, ny, & - itest, jtest, rtest, & - basal_melt, & - thck, & - usrf_obs, & - topg, & - eus, & - ice_mask, & - floating_mask, & - land_mask, & - grounding_line_mask) + subroutine invert_bmlt_float(dt, & + nx, ny, & + itest, jtest, rtest, & + basal_melt, & + thck, & + usrf_obs, & + topg, & + eus, & + ice_mask, & + floating_mask, & + land_mask, & + grounding_line_mask) ! Compute spatially varying bmlt_float by inversion. ! Apply a melt/freezing rate that will restore the ice in floating grid cells @@ -1422,29 +1018,25 @@ subroutine invert_bmlt_float_new(dt, & enddo endif - end subroutine invert_bmlt_float_new + end subroutine invert_bmlt_float !*********************************************************************** - subroutine invert_bmlt_float(dt, & - nx, ny, & - itest, jtest, rtest, & - basal_melt, & - thck, & - thck_obs, & - topg, & - eus, & - acab, & - bmlt, & - ice_mask, & - floating_mask, & - land_mask) + subroutine prescribe_bmlt_float(dt, & + nx, ny, & + itest, jtest, rtest, & + basal_melt, & + thck, & + topg, & + eus, & + ice_mask, & + floating_mask, & + land_mask, & + grounding_line_mask) - ! Compute spatially varying bmlt_float by inversion. - ! Apply a melt/freezing rate that will restore the ice in floating grid cells to the target thickness. - ! Cells that are floating and should be grounded are thickened enough to be lightly grounded, - ! but generally not all the way to the target thickness. + ! Prescribe bmlt_float based on the value computed from inversion. ! Note: bmlt_float_inversion is defined as positive for melting, negative for freezing. + ! This field is applied only in floating and grounding-line adjacent cells. real(dp), intent(in) :: dt ! time step (s) @@ -1457,12 +1049,11 @@ subroutine invert_bmlt_float(dt, & type(glide_basal_melt), intent(inout) :: & basal_melt ! basal melt object + ! Note: thck should be the expected values after applying the mass balance + ! (although the mass balance may not yet have been applied) real(dp), dimension(nx,ny), intent(in) :: & thck, & ! ice thickness (m) - thck_obs, & ! observed thickness (m) - topg, & ! bedrock topography (m) - acab, & ! surface mass balance (m/s), including runtime adjustments - bmlt + topg ! bedrock elevation (m) real(dp), intent(in) :: & eus ! eustatic sea level (m) @@ -1471,7 +1062,8 @@ subroutine invert_bmlt_float(dt, & integer, dimension(nx,ny), intent(in) :: & ice_mask, & ! = 1 where ice is present, else = 0 floating_mask, & ! = 1 where ice is present and floating, else = 0 - land_mask ! = 1 where topg >= eus, else = 0 + land_mask, & ! = 1 where topg >= eus, else = 0 + grounding_line_mask ! = 1 if a cell is adjacent to the grounding line, else = 0 ! local variables @@ -1479,29 +1071,23 @@ subroutine invert_bmlt_float(dt, & bmlt_inversion_mask ! = 1 for cells where bmlt_float is computed and applied, else = 0 real(dp), dimension(nx,ny):: & - thck_flotation, & ! thickness at which ice becomes afloat (m) - thck_cavity, & ! thickness of ocean cavity beneath floating ice (m) - thck_target ! thickness target (m); = thck_obs unless thck_obs > thck_flotation - - integer :: i, j, ii, jj, iglobal, jglobal - - character(len=100) :: message - - real(dp) :: bmlt_factor ! factor for reducing basal melting + thck_flotation, & ! flotation thickness (m) + thck_cavity, & ! thickness (m) of ocean cavity (diagnostic only) + thck_final ! final thickness (m) if full melt rate is applied - real(dp), parameter :: inversion_bmlt_timescale = 0.0d0*scyr ! timescale for freezing in cavities (m/s) + integer :: i, j - ! Where the observed ice is floating, adjust the basal melt rate (or freezing rate, if bmlt < 0) - ! so as to relax the ice thickness toward a target thickness based on observations. + ! Note: This subroutine should be called after other mass-balance terms have been applied, + ! after horizontal transport, and preferably after calving. if (verbose_inversion .and. main_task) then print*, ' ' - print*, 'In invert_bmlt_float' + print*, 'In prescribe_bmlt_float' endif ! Compute the flotation thickness where (topg - eus < 0.0d0) - thck_flotation = -(rhoo/rhoi) *(topg - eus) + thck_flotation = -(rhoo/rhoi) * (topg - eus) elsewhere thck_flotation = 0.0d0 endwhere @@ -1513,298 +1099,24 @@ subroutine invert_bmlt_float(dt, & thck_cavity = 0.0d0 endwhere - ! Restore selected cells to a target thickness based on observations. - ! The rules are: - ! (1) Any ice-filled cell that is floating in observations is restored after transport - ! to its target thickness. - ! This includes cells that are either floating or grounded after transport. - ! (2) Any ice-filled cell that is grounded in observations but floating (or very lightly grounded) - ! after transport is restored to a target grounded thickness. This grounded thickness, however, - ! is not the observed thickness, but rather Hf + thck_buffer. - ! Here, thck_buffer is a small thickness (2 m by default), and "very lightly grounded" - ! means that Hf < H < (Hf + thck_buffer). - ! The reason for not restoring grounded cells all the way to the observed value is that - ! we would like the basal sliding coefficients to adjust to help ground the ice more firmly, - ! rather than rely on large negative basal melt rates. - - ! Compute a mask of floating cells where bmlt_float_inversion will be computed. - ! The mask excludes land-based cells. - ! It includes cells that are - ! (1) floating in observations (even if they are grounded in the model, after transport), or - ! (2) grounded in observations but floating in the model (after transport) + ! Compute a mask of floating cells and marine-based grounding-line cells, + ! where bmlt_float_inversion can potentially be applied. + ! Where bmlt_inversion_mask = 1, apply bmlt_float_prescribed. + ! Note: The land mask may not be needed, since land cells are excluded from the inversion. + ! But this mask is included for generality, in case of dynamic topography. - ! initialize bmlt_inversion_mask(:,:) = 0 - thck_target(:,:) = 0.0d0 + basal_melt%bmlt_float_inversion(:,:) = 0.0d0 + thck_final(:,:) = 0.0d0 - ! loop over cells - do j = 2, ny-1 - do i = 2, nx-1 + do j = 1, ny + do i = 1, nx if (land_mask(i,j) == 1) then ! do nothing; bmlt_float_inversion = 0 - !TODO - Relax thck(i,j) > 0 requirement? - elseif (thck(i,j) > 0.0d0 .and. thck_obs(i,j) > 0.0d0) then ! ice-covered marine cell in obs - - if (thck_obs(i,j) < thck_flotation(i,j)) then - - ! floating in obs; restore to thck_obs - - bmlt_inversion_mask(i,j) = 1 - - thck_target(i,j) = min(thck_obs(i,j), thck_flotation(i,j) - bmlt_inversion_thck_buffer) - thck_target(i,j) = max(thck_target(i,j), 0.0d0) ! just to be safe - - !TODO - Remove the error check when satisfied that things are working. - ! Note: This gives false positives on the first step. - if (thck(i,j) >= thck_flotation(i,j) .and. basal_melt%grounded_mask_start(i,j) == 1) then - ! This is not supposed to happen, so throw a fatal error. - call parallel_globalindex(i, j, iglobal, jglobal) - - print*, 'Error, floating cell has grounded:, task, i, j, H_obs, H_f, H:', & - this_rank, i, j, thck_obs(i,j), thck_flotation(i,j), thck(i,j) - print*, 'iglobal, jglobal =', iglobal, jglobal - write(message,*) 'ERROR in invert_bmlt_float: Cell that should be floating has grounded' -!! call write_log(message, GM_FATAL) - call write_log(message) - endif - - elseif (thck_obs(i,j) >= thck_flotation(i,j) .and. & - thck(i,j) < thck_flotation(i,j) + bmlt_inversion_thck_buffer) then - - ! grounded in obs but currently floating; reground but do not set thck = thck_obs. - ! The reason for this is that we would prefer to adjust basal sliding parameters to bring - ! the thickness closer to observations, instead of relying on an artificially large bmlt_float. - bmlt_inversion_mask(i,j) = 1 - thck_target(i,j) = thck_flotation(i,j) + bmlt_inversion_thck_buffer - - endif - - endif - enddo ! i - enddo ! j - - call parallel_halo(bmlt_inversion_mask) - call parallel_halo(thck_target) - - - !WHL - debug - if (verbose_inversion .and. this_rank == rtest) then - i = itest - j = jtest - print*, ' ' - print*, 'thck_target:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck_target(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - endif - - ! Now compute bmlt_float_inversion based on the thickness target. - ! Account for the surface mass balance, recalling that acab and bmlt have opposite sign conventions. - ! (acab > 0 for positive SMB, whereas bmlt > 0 for negative BMB.) - ! Typically, the background bmlt = 0 for floating cells when computing bmlt_float_inversion, - ! but we might be computing bmlt_float_inversion for cells that were grounded at the start - ! of the time step and thus have nonzero bmlt. - - basal_melt%bmlt_float_inversion(:,:) = 0.0d0 - - do j = 1, ny - do i = 1, nx - if (bmlt_inversion_mask(i,j) == 1) then - - basal_melt%bmlt_float_inversion(i,j) = (thck(i,j) - thck_target(i,j))/dt + acab(i,j) - bmlt(i,j) - - !WHL - debug - if (verbose_inversion .and. this_rank == rtest .and. i==itest .and. j==jtest) then - print*, ' ' - print*, 'Invert for bmlt_float_inversion: rank, i, j =', rtest, itest, jtest - print*, 'thck, thck_obs, acab*dt, bmlt*dt:', & - thck(i,j), thck_obs(i,j), acab(i,j)*dt, & - basal_melt%bmlt_float_inversion(i,j)*dt - endif - - endif ! bmlt_inversion_mask = 1 - - enddo ! i - enddo ! j - - !TODO - Test the following code further, or delete it? So far, I haven't found a timescale to work well. - ! If a nonzero timescale is specified, then multiply bmlt_float_inversion by a factor - ! proportional to dt/timescale, in the range (0,1]. - - if (inversion_bmlt_timescale > 0.0d0) then - bmlt_factor = min(dt/inversion_bmlt_timescale, 1.0d0) - basal_melt%bmlt_float_inversion(:,:) = basal_melt%bmlt_float_inversion(:,:) * bmlt_factor - endif - - call parallel_halo(basal_melt%bmlt_float_inversion) - - !WHL - debug - if (verbose_inversion .and. this_rank == rtest) then - i = itest - j = jtest - print*, ' ' - print*, 'bmlt_inversion_mask:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(i10)',advance='no') bmlt_inversion_mask(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'thck_flotation (m):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck_flotation(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'floating_mask:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(i10)',advance='no') floating_mask(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'thck_cavity (m):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck_cavity(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'thck (m):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'thck_obs (m):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck_obs(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'bmlt_float_inversion (m/yr):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') basal_melt%bmlt_float_inversion(i,j)*scyr - enddo - write(6,*) ' ' - enddo - endif - - end subroutine invert_bmlt_float - -!*********************************************************************** - - subroutine prescribe_bmlt_float_new(dt, & - nx, ny, & - itest, jtest, rtest, & - basal_melt, & - thck, & - topg, & - eus, & - ice_mask, & - floating_mask, & - land_mask, & - grounding_line_mask) - - ! Prescribe bmlt_float based on the value computed from inversion. - ! Note: bmlt_float_inversion is defined as positive for melting, negative for freezing. - ! This field is applied only in floating and grounding-line adjacent cells. - - real(dp), intent(in) :: dt ! time step (s) - - integer, intent(in) :: & - nx, ny ! grid dimensions - - integer, intent(in) :: & - itest, jtest, rtest ! coordinates of diagnostic point - - type(glide_basal_melt), intent(inout) :: & - basal_melt ! basal melt object - - ! Note: thck should be the expected values after applying the mass balance - ! (although the mass balance may not yet have been applied) - real(dp), dimension(nx,ny), intent(in) :: & - thck, & ! ice thickness (m) - topg ! bedrock elevation (m) - - real(dp), intent(in) :: & - eus ! eustatic sea level (m) - - ! Note: When this subroutine is called, ice_mask = 1 where thck > 0, not thck > thklim. - integer, dimension(nx,ny), intent(in) :: & - ice_mask, & ! = 1 where ice is present, else = 0 - floating_mask, & ! = 1 where ice is present and floating, else = 0 - land_mask, & ! = 1 where topg >= eus, else = 0 - grounding_line_mask ! = 1 if a cell is adjacent to the grounding line, else = 0 - - ! local variables - - integer, dimension(nx,ny) :: & - bmlt_inversion_mask ! = 1 for cells where bmlt_float is computed and applied, else = 0 - - real(dp), dimension(nx,ny):: & - thck_flotation, & ! flotation thickness (m) - thck_cavity, & ! thickness (m) of ocean cavity (diagnostic only) - thck_final ! final thickness (m) if full melt rate is applied - - integer :: i, j - - ! Note: This subroutine should be called after other mass-balance terms have been applied, - ! after horizontal transport, and preferably after calving. - - if (verbose_inversion .and. main_task) then - print*, ' ' - print*, 'In prescribe_bmlt_float' - endif - - ! Compute the flotation thickness - where (topg - eus < 0.0d0) - thck_flotation = -(rhoo/rhoi) * (topg - eus) - elsewhere - thck_flotation = 0.0d0 - endwhere - - ! Compute the ocean cavity thickness beneath floating ice (diagnostic only) - where (floating_mask == 1) - thck_cavity = -(topg - eus) - (rhoi/rhoo)*thck - elsewhere - thck_cavity = 0.0d0 - endwhere - - ! Compute a mask of floating cells and marine-based grounding-line cells, - ! where bmlt_float_inversion can potentially be applied. - ! Where bmlt_inversion_mask = 1, apply bmlt_float_prescribed. - ! Note: The land mask may not be needed, since land cells are excluded from the inversion. - ! But this mask is included for generality, in case of dynamic topography. - - bmlt_inversion_mask(:,:) = 0 - basal_melt%bmlt_float_inversion(:,:) = 0.0d0 - thck_final(:,:) = 0.0d0 - - do j = 1, ny - do i = 1, nx - if (land_mask(i,j) == 1) then - - ! do nothing; bmlt_float_inversion = 0 - - elseif (floating_mask(i,j) == 1 .or. & - (ice_mask(i,j) == 1 .and. grounding_line_mask(i,j) == 1) ) then + elseif (floating_mask(i,j) == 1 .or. & + (ice_mask(i,j) == 1 .and. grounding_line_mask(i,j) == 1) ) then bmlt_inversion_mask(i,j) = 1 basal_melt%bmlt_float_inversion(i,j) = basal_melt%bmlt_float_prescribed(i,j) @@ -1908,224 +1220,6 @@ subroutine prescribe_bmlt_float_new(dt, & enddo endif - end subroutine prescribe_bmlt_float_new - -!*********************************************************************** - - subroutine prescribe_bmlt_float(dt, & - nx, ny, & - itest, jtest, rtest, & - basal_melt, & - thck, & - topg, & - eus, & - acab, & - bmlt, & - ice_mask, & - floating_mask, & - land_mask) - - ! Prescribe bmlt_float based on the value computed from inversion. - ! Note: bmlt_float_inversion is defined as positive for melting, negative for freezing. - ! This field is applied only beneath floating ice. - - real(dp), intent(in) :: dt ! time step (s) - - integer, intent(in) :: & - nx, ny ! grid dimensions - - integer, intent(in) :: & - itest, jtest, rtest ! coordinates of diagnostic point - - type(glide_basal_melt), intent(inout) :: & - basal_melt ! basal melt object - - real(dp), dimension(nx,ny), intent(in) :: & - thck, & ! ice thickness (m) - topg, & ! bedrock elevation (m) - acab, & ! surface mass balance (m/s), including runtime adjustments - bmlt - - real(dp), intent(in) :: & - eus ! eustatic sea level (m) - - ! Note: When this subroutine is called, ice_mask = 1 where thck > 0, not thck > thklim. - integer, dimension(nx,ny), intent(in) :: & - ice_mask, & ! = 1 where ice is present, else = 0 - floating_mask, & ! = 1 where ice is present and floating, else = 0 - land_mask ! = 1 where topg >= eus, else = 0 - - ! local variables - - integer, dimension(nx,ny) :: & - bmlt_inversion_mask ! = 1 for cells where bmlt_float is computed and applied, else = 0 - - real(dp), dimension(nx,ny):: & - thck_flotation, & ! flotation thickness (m) - thck_cavity, & ! thickness (m) of ocean cavity (diagnostic only) - thck_final ! final thickness (m) if full melt rate is applied - - integer :: i, j - - ! Note: This subroutine should be called after other mass-balance terms have been applied, - ! after horizontal transport, and preferably after calving. - - if (verbose_inversion .and. main_task) then - print*, ' ' - print*, 'In prescribe_bmlt_float' - endif - - ! Compute the flotation thickness - where (topg - eus < 0.0d0) - thck_flotation = -(rhoo/rhoi) * (topg - eus) - elsewhere - thck_flotation = 0.0d0 - endwhere - - ! Compute the ocean cavity thickness beneath floating ice (diagnostic only) - where (floating_mask == 1) - thck_cavity = -(topg - eus) - (rhoi/rhoo)*thck - elsewhere - thck_cavity = 0.0d0 - endwhere - - ! Compute a mask of cells where bmlt_float_inversion can potentially be applied. - ! The rule is that bmlt_float_inversion can be applied to any marine-based cell with ice. - ! This means that some marine-based grounded cells will have nonzero basal melting/freezing rates. - ! This is not physically realistic, but it helps prevent rapid, irreversible ice growth - ! in forward runs when floating cells ground. - ! Note: The land mask is probably not needed, since land cells are excluded from the inversion. - ! But this mask is included for generality, in case of dynamic topography. - - bmlt_inversion_mask(:,:) = 0.0d0 - basal_melt%bmlt_float_inversion(:,:) = 0.0d0 - thck_final(:,:) = 0.0d0 - - do j = 1, ny - do i = 1, nx - if (land_mask(i,j) == 1) then - - ! do nothing; bmlt_float_inversion = 0 - - elseif (ice_mask(i,j) == 1) then - - bmlt_inversion_mask(i,j) = 1 - basal_melt%bmlt_float_inversion(i,j) = basal_melt%bmlt_float_prescribed(i,j) - - ! Make sure the final thickness meets certain conditions: - ! (1) if bmlt_float_inversion < 0, then thck_final <= thck_flotation + thck_buffer - ! (unless this would require basal melting) - ! (2) thck_final >= 0 - - thck_final(i,j) = thck(i,j) + (acab(i,j) - bmlt(i,j) - basal_melt%bmlt_float_inversion(i,j)) * dt - - if (basal_melt%bmlt_float_inversion(i,j) < 0.0d0) then - - if (thck_final(i,j) > thck_flotation(i,j) + bmlt_inversion_thck_buffer) then - - ! limit bmlt_float_inversion so the ice does not ground too strongly - thck_final(i,j) = thck_flotation(i,j) + bmlt_inversion_thck_buffer - basal_melt%bmlt_float_inversion(i,j) = (thck(i,j) - thck_final(i,j))/dt + acab(i,j) - bmlt(i,j) - - ! but do not flip the sign of bmlt_float_inversion - if (basal_melt%bmlt_float_inversion(i,j) > 0.0d0) then - basal_melt%bmlt_float_inversion(i,j) = 0.0d0 - thck_final(i,j) = thck(i,j) + acab(i,j) - bmlt(i,j) ! diagnostic only - endif - - endif - - else ! bmlt_float_inversion > 0 - - if (thck_final(i,j) < 0.0d0) then - thck_final(i,j) = 0.0d0 - basal_melt%bmlt_float_inversion(i,j) = (thck(i,j) - thck_final(i,j))/dt + acab(i,j) - bmlt(i,j) - endif - - endif - - !WHL - debug - if (verbose_inversion .and. this_rank == rtest .and. i==itest .and. j==jtest) then - print*, ' ' - print*, 'Prescribe bmlt_float_inversion: rank, i, j =', rtest, itest, jtest - print*, 'thck, thck_final, bmlt_float_inversion*dt:', thck(i,j), thck_final(i,j), & - basal_melt%bmlt_float_inversion(i,j)*dt - endif - - endif ! masks - enddo ! i - enddo ! j - - !WHL - debug - if (verbose_inversion .and. this_rank == rtest) then - i = itest - j = jtest - print*, ' ' - print*, 'bmlt_float_prescribed (m/yr):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') basal_melt%bmlt_float_prescribed(i,j)*scyr - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'bmlt_inversion_mask:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(i10)',advance='no') bmlt_inversion_mask(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'thck_flotation (m):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck_flotation(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'floating_mask:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(i10)',advance='no') floating_mask(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'thck_cavity (m):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck_cavity(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'thck (m):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'thck_final:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck_final(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'bmlt_float_inversion (m/yr):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') basal_melt%bmlt_float_inversion(i,j)*scyr - enddo - write(6,*) ' ' - enddo - endif - end subroutine prescribe_bmlt_float !======================================================================= From 044d4bac5660ed3154aa1853a35d70aaf9dea3b9 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Wed, 2 May 2018 15:42:11 -0600 Subject: [PATCH 29/61] Added glissade_inversion_solve, renamed glissade_transport_solve The optional inversion calculations were previously done by calling multiple subroutines from glissade_transport solve. I bundled these calls into a new subroutine called glissade_inversion_solve, optionally called once from glissade_transport_solve. This makes the higher-level subroutine shorter and cleaner. I then renamed 'glissade_transport_solve' as 'glissade_thickness_tracer_solve' since it is responsible for several things (including SMB and BMB calculations) that are part of thickness and tracer evolution but are not transport. Also did some minor cleanup, removing some unused code and masks. This commit is BFB. --- libglide/glide_types.F90 | 12 - libglissade/glissade.F90 | 632 +++++++++++++++++++-------------------- 2 files changed, 304 insertions(+), 340 deletions(-) diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index 22f5a678..4c00b0c4 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -1288,10 +1288,6 @@ module glide_types bmlt_float_inversion_tavg => null(), & !> basal melt rate computed by inversion (time average) bmlt_float_prescribed => null() !> basal melt rate prescribed from a previous inversion - integer, dimension(:,:), pointer :: & - grounded_mask_start=> null(), & !> = 1 where ice is grounded at start of timestep, else = 0 - floating_mask_start=> null() !> = 1 where ice is floating at start of timestep, else = 0 - real(dp) :: bmlt_float_factor = 1.0d0 !> adjustment factor for external bmlt_float field ! MISMIP+ parameters for Ice1 experiments @@ -1878,8 +1874,6 @@ subroutine glide_allocarr(model) !> \item \texttt{bmlt_float_inversion(ewn,nsn)} !> \item \texttt{bmlt_float_inversion_tavg(ewn,nsn)} !> \item \texttt{bmlt_float_prescribed(ewn,nsn)} - !> \item \texttt{grounded_mask_start(ewn,nsn)} - !> \item \texttt{floating_mask_start(ewn,nsn)} !> \end{itemize} !> In \texttt{model\%plume}: @@ -2248,8 +2242,6 @@ subroutine glide_allocarr(model) call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_float_inversion) call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_float_inversion_tavg) call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_float_prescribed) - call coordsystem_allocate(model%general%ice_grid, model%basal_melt%grounded_mask_start) - call coordsystem_allocate(model%general%ice_grid, model%basal_melt%floating_mask_start) endif if (model%options%whichbmlt_float == BMLT_FLOAT_MISOMIP) then call coordsystem_allocate(model%general%ice_grid, model%plume%T_basal) @@ -2597,10 +2589,6 @@ subroutine glide_deallocarr(model) deallocate(model%basal_melt%bmlt_float_inversion_tavg) if (associated(model%basal_melt%bmlt_float_prescribed)) & deallocate(model%basal_melt%bmlt_float_prescribed) - if (associated(model%basal_melt%grounded_mask_start)) & - deallocate(model%basal_melt%grounded_mask_start) - if (associated(model%basal_melt%floating_mask_start)) & - deallocate(model%basal_melt%floating_mask_start) if (associated(model%basal_melt%bmlt_applied_old)) & deallocate(model%basal_melt%bmlt_applied_old) if (associated(model%basal_melt%bmlt_applied_diff)) & diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index 1e8ad371..bd602183 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -106,7 +106,6 @@ subroutine glissade_initialise(model, evolve_ice) use glissade_velo_higher, only: glissade_velo_higher_init use glide_diagnostics, only: glide_init_diag use glissade_calving, only: glissade_calving_mask_init, glissade_calve_ice - use glissade_calving, only: glissade_find_lakes !TODO - Move this subroutine? use glissade_inversion, only: glissade_init_inversion, verbose_inversion use glimmer_paramets, only: thk0, len0, tim0 use felix_dycore_interface, only: felix_velo_init @@ -773,7 +772,7 @@ subroutine glissade_tstep(model, time) ! The surface and basal mass balances are also applied here. ! ------------------------------------------------------------------------ - call glissade_transport_solve(model) + call glissade_thickness_tracer_solve(model) ! ------------------------------------------------------------------------ ! Calculate iceberg calving @@ -920,24 +919,6 @@ subroutine glissade_bmlt_float_solve(model) ice_mask, & floating_mask = floating_mask) - !TODO - Delete this code when satisfied the grounded_start_mask is no longer needed. - ! If inverting for basal melt, then compute masks of grounded and floating ice - ! before horizontal transport. - ! This mask are used later when computing bmlt_float_inversion. - - if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & - model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then - - where (ice_mask == 1 .and. floating_mask == 0) - model%basal_melt%grounded_mask_start = 1 - elsewhere - model%basal_melt%grounded_mask_start = 0 - endwhere - - model%basal_melt%floating_mask_start(:,:) = floating_mask(:,:) - - endif - ! Compute bmlt_float depending on the whichbmlt_float option if (model%options%whichbmlt_float == BMLT_FLOAT_NONE) then @@ -1127,15 +1108,17 @@ end subroutine glissade_thermal_solve !======================================================================= - subroutine glissade_transport_solve(model) + subroutine glissade_thickness_tracer_solve(model) ! ------------------------------------------------------------------------ - ! Calculate ice thickness and tracer evolution + ! Calculate ice thickness and tracer evolution, including horizontal transport and surface and basal mass balance. ! MJH: This subroutine uses velocity from the previous time step, which is appropriate for a Forward Euler time-stepping scheme. ! WHL: We used to have EVOL_NO_THICKNESS = -1 as a Glide option, used to hold the ice surface elevation fixed during CESM runs. ! This option has been replaced by a Glint/Glad option, evolve_ice. ! We now have EVOL_NO_THICKESS = 5 as a glissade option. It is used to hold the ice surface elevation fixed ! while allowing temperature to evolve, which can be useful for model spinup. This option might need more testing. + ! Note: This subroutine calls the inversion solver, glissade_inversion_solve, because it is convenient to do this + ! after horizontal transport and before applying the surface and basal mass balance. ! ------------------------------------------------------------------------ use parallel @@ -1152,9 +1135,7 @@ subroutine glissade_transport_solve(model) glissade_overwrite_acab, & glissade_add_mbal_anomaly use glissade_masks, only: glissade_get_masks - use glissade_inversion, only: invert_bmlt_float, prescribe_bmlt_float, & - invert_basal_traction, prescribe_basal_traction - use glissade_inversion, only: invert_basal_topography, verbose_inversion + use glissade_inversion, only: verbose_inversion implicit none @@ -1169,8 +1150,6 @@ subroutine glissade_transport_solve(model) thck_unscaled, & ! ice thickness (m) topg_unscaled, & ! bedrock topography (m) thck_new_unscaled, & ! expected new ice thickness, after mass balance (m) - lsrf_new_unscaled, & ! expected new lower surface elevation (m) - usrf_new_unscaled, & ! expected new upper surface elevation (m) acab_unscaled, & ! surface mass balance (m/s) bmlt_unscaled ! = bmlt (m/s) if basal mass balance is included in continuity equation, else = 0 @@ -1186,8 +1165,7 @@ subroutine glissade_transport_solve(model) real(dp), dimension(model%general%ewn, model%general%nsn) :: & thck_flotation, & ! thickness at which ice is exactly floating thck_calving_front, & ! effective thickness of ice at the calving front - effective_areafrac, & ! effective fractional area of ice at the calving front - dthck_dt_inversion ! dH/dt resulting from transport and mass balance (m/s) + effective_areafrac ! effective fractional area of ice at the calving front real(dp) :: previous_time ! time (yr) at the start of this time step ! (The input time is the time at the end of the step.) @@ -1195,7 +1173,6 @@ subroutine glissade_transport_solve(model) real(dp) :: advective_cfl ! advective CFL number ! If advective_cfl > 1, the model is unstable without subcycling real(dp) :: dt_transport ! time step (s) for transport; = model%numerics%dt*tim0 by default - real(dp) :: alpha ! shorthand for inversion_babc_time_smoothing, in range [0,1] integer :: nsubcyc ! number of times to subcycle advection @@ -1208,9 +1185,6 @@ subroutine glissade_transport_solve(model) integer :: ewn, nsn, upn integer :: itest, jtest, rtest - !TODO - Make invert_topg a config option - logical :: invert_topg = .false. - rtest = -999 itest = 1 jtest = 1 @@ -1220,7 +1194,7 @@ subroutine glissade_transport_solve(model) jtest = model%numerics%jdiag_local endif - ewn = model%general%ewn !TODO - Use these below in place of model%general*ewn/upn? + ewn = model%general%ewn nsn = model%general%nsn upn = model%general%upn @@ -1263,7 +1237,7 @@ subroutine glissade_transport_solve(model) ! Some of these masks are used for inversion calculations. ! ------------------------------------------------------------------------ - call glissade_get_masks(model%general%ewn, model%general%nsn, & + call glissade_get_masks(ewn, nsn, & model%geometry%thck*thk0, & ! m model%geometry%topg*thk0, & ! m model%climate%eus*thk0, & ! m @@ -1280,8 +1254,8 @@ subroutine glissade_transport_solve(model) if (model%options%whichtemp == TEMP_ENTHALPY) then ! Use IR to transport enthalpy ! Note: glissade_temp2enth expects SI units - do j = 1, model%general%nsn - do i = 1, model%general%ewn + do j = 1, nsn + do i = 1, ewn call glissade_temp2enth (model%numerics%stagsigma(1:upn-1), & model%temper%temp(0:upn,i,j), model%temper%waterfrac(1:upn-1,i,j), & model%geometry%thck(i,j)*thk0, model%temper%enthalpy(0:upn,i,j)) @@ -1318,7 +1292,7 @@ subroutine glissade_transport_solve(model) ! be equal to dt (which is the case by default). !TODO - Remove the dt_transport option and simply rely on adaptive subcycling as needed? - call glissade_check_cfl(model%general%ewn, model%general%nsn, model%general%upn-1, & + call glissade_check_cfl(ewn, nsn, upn-1, & model%numerics%dew * len0, model%numerics%dns * len0, model%numerics%sigma, & model%geomderv%stagthck * thk0, & model%geomderv%dusrfdew*thk0/len0, model%geomderv%dusrfdns*thk0/len0, & @@ -1382,8 +1356,8 @@ subroutine glissade_transport_solve(model) call glissade_transport_driver(dt_transport, & ! s model%numerics%dew * len0, model%numerics%dns * len0, & - model%general%ewn, model%general%nsn, & - model%general%upn-1, model%numerics%sigma, & + ewn, nsn, upn-1, & + model%numerics%sigma, & model%velocity%uvel(:,:,:) * vel0, & ! m/s model%velocity%vvel(:,:,:) * vel0, & ! m/s thck_unscaled(:,:), & ! m @@ -1401,59 +1375,14 @@ subroutine glissade_transport_solve(model) enddo ! subcycling of transport !------------------------------------------------------------------------- - ! Apply the surface and basal mass balances. + ! Prepare the surface and basal mass balance terms. ! Note: The basal mass balance has been computed in subroutine glissade_bmlt_float_solve. !------------------------------------------------------------------------- - !TODO - Remove the following call to glissade_get_masks - go to 800 - ! ------------------------------------------------------------------------ - ! Get masks used for the mass balance calculation. - ! Pass thklim = 0 to identify cells with thck > 0 (not thck > thklim). - ! Use ocean_mask to identify ocean cells where positive acab should not be applied. - ! Use thck_calving_front to compute a fractional area for calving_front cells. - ! ------------------------------------------------------------------------ - - call glissade_get_masks(model%general%ewn, model%general%nsn, & - thck_unscaled, & ! m - topg_unscaled, & ! m - model%climate%eus*thk0, & ! m - 0.0d0, & ! thklim = 0 - ice_mask, & - floating_mask = floating_mask, & - land_mask = land_mask, & - ocean_mask = ocean_mask, & - which_ho_calving_front = model%options%which_ho_calving_front, & - calving_front_mask = calving_front_mask, & - thck_calving_front = thck_calving_front) - - ! Compute the effective fractional area of calving_front cells. - - do j = 1, model%general%nsn - do i = 1, model%general%ewn - if (calving_front_mask(i,j) == 1 .and. thck_calving_front(i,j) > 0.0d0) then - effective_areafrac(i,j) = thck_unscaled(i,j) / thck_calving_front(i,j) - effective_areafrac(i,j) = min(effective_areafrac(i,j), 1.0d0) - elseif (ocean_mask(i,j) == 1) then - effective_areafrac(i,j) = 0.0d0 ! acab and bmlt not applied to ice-free ocean cells - else ! non-CF ice-covered cells and/or land cells - effective_areafrac(i,j) = 1.0d0 - endif - enddo - enddo -800 continue - - !------------------------------------------------------------------------- - ! Adjust the surface mass balance (acab) as needed. - !------------------------------------------------------------------------- - ! Compute a corrected acab field that includes any prescribed anomalies. ! Typically, acab_corrected = acab, but sometimes (e.g., for initMIP) it includes a time-dependent anomaly. ! Note that acab itself does not change in time. -!! print*, 'maxval(acab_anomaly):', maxval(model%climate%acab_anomaly) -!! print*, 'minval(acab_anomaly):', minval(model%climate%acab_anomaly) - ! initialize model%climate%acab_corrected(:,:) = model%climate%acab(:,:) @@ -1495,13 +1424,11 @@ subroutine glissade_transport_solve(model) ! Convert acab_corrected to a temporary array in SI units (m/s) acab_unscaled(:,:) = model%climate%acab_corrected(:,:) * thk0/tim0 - !------------------------------------------------------------------------- - ! Handle the basal mass balance. - !------------------------------------------------------------------------- - ! Add bmlt to the continuity equation in SI units (m/s) + ! Convert bmlt in SI units (m/s) ! Note: bmlt is the sum of bmlt_ground (computed in glissade_thermal_solve) and bmlt_float ! (computed in glissade_bmlt_float_solve). + ! Note: bmlt can be turned off by setting options%basal_mbal = BASAL_MBAL_NO_CONTINUITY if (model%options%basal_mbal == BASAL_MBAL_CONTINUITY) then ! include bmlt in continuity equation bmlt_unscaled(:,:) = model%basal_melt%bmlt(:,:) * thk0/tim0 @@ -1509,18 +1436,6 @@ subroutine glissade_transport_solve(model) bmlt_unscaled(:,:) = 0.0d0 endif - !WHL - debug - if (verbose_inversion .and. this_rank == rtest) then - print*, 'acab (m/yr), itest, jtest, rank =', itest, jtest, rtest - do j = jtest+3, jtest-3, -1 - write(6,'(i6)',advance='no') j - do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') acab_unscaled(i,j)*scyr - enddo - write(6,*) ' ' - enddo - endif - !------------------------------------------------------------------------- ! Optionally, invert for basal fields: topography, basal traction and basal melting. !------------------------------------------------------------------------- @@ -1528,217 +1443,18 @@ subroutine glissade_transport_solve(model) if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then - ! Compute a temporary topg array in SI units (m) - topg_unscaled(:,:) = model%geometry%topg(:,:) * thk0 - - ! Compute the expected new ice thickness and upper surface elevation, without inversion. + ! Compute the new ice thickness that would be computed after applying the SMB and BMB, without inversion. thck_new_unscaled = thck_unscaled(:,:) + (acab_unscaled - bmlt_unscaled) * model%numerics%dt*tim0 thck_new_unscaled = max(thck_new_unscaled, 0.0d0) - ! Calculate the expected new lower and upper ice surface - ! Note: usrf_new_unscaled is used in inversion calculations, but model%geometry%usrf is not updated - ! until after the mass balance calculation. - call glide_calclsrf(thck_new_unscaled, topg_unscaled, model%climate%eus*thk0, lsrf_new_unscaled) - usrf_new_unscaled = max(0.d0, thck_new_unscaled + lsrf_new_unscaled) - - if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then - - ! Invert for basal topography in cells adjacent to the grounding line. - ! The goal is to correct for observation errors which might imply a cell is grounded - ! when it is really floating, or vice versa. - ! For cells where usrf > usrf_obs, the topography is lowered (to reduce usrf and f_ground), - ! and for cells where usrf < usrf_obs, the topography is raised (to increasee usrf and f_ground). - - if (invert_topg) then - call invert_basal_topography(model%numerics%dt*tim0, & ! s - model%general%ewn, model%general%nsn, & - itest, jtest, rtest, & - ice_mask, & - grounding_line_mask, & - usrf_new_unscaled, & ! m - model%geometry%usrf_obs*thk0, & ! m - topg_unscaled, & ! m - model%geometry%topg_obs*thk0, & ! m - model%climate%eus*thk0) - - call parallel_halo(topg_unscaled) - endif + call glissade_inversion_solve(model, & + thck_new_unscaled, & + ice_mask, & + floating_mask, & + land_mask, & + grounding_line_mask) - ! Compute the thickness tendency dH/dt (m/s) resulting from transport and mass balance - ! (but not including bmlt_float_inversion). We set dthck_dt = 0 for ice-free cells. - ! This tendency is used when inverting for powerlaw_c_inversion. - - ! Note: A similar variable, geometry%dthck_dt, is computed at the end of the time step for diagnostic output. - ! This is simply the rate of change of thickness between the start and end of the time step. - -!! where (model%geometry%thck_old > model%numerics%thklim) - where (model%geometry%thck_old > 0.0d0) - dthck_dt_inversion = (thck_new_unscaled - model%geometry%thck_old*thk0) & - / (model%numerics%dt * tim0) - elsewhere - dthck_dt_inversion = 0.0d0 - endwhere - - ! Optionally, compute an exponential moving average of usrf and dthck_dt - ! The larger the factor, the more rapidly earlier values are discounted. - !WHL - debug - alpha = model%basal_physics%inversion_babc_time_smoothing - alpha = min(alpha, 1.0d0 - 1.0d0/real(model%numerics%tstep_count,dp)) ! decrease smoother for first few time steps - alpha = min(1.0d0, max(alpha,0.0d0)) ! limit to [0,1] - if (alpha < 1.0d0) then - ! take moving averages of usrf and dthck_dt with contributions from previous values - model%basal_physics%usrf_inversion(:,:) = (1.d0 - alpha) * usrf_new_unscaled(:,:) & - + alpha * model%basal_physics%usrf_inversion(:,:) - model%basal_physics%dthck_dt_inversion(:,:) = (1.d0 - alpha) * dthck_dt_inversion(:,:) & - + alpha * model%basal_physics%dthck_dt_inversion(:,:) - else - ! simply copy the latest values - model%basal_physics%usrf_inversion(:,:) = usrf_new_unscaled(:,:) - model%basal_physics%dthck_dt_inversion(:,:) = dthck_dt_inversion(:,:) - endif ! alpha < 1 - - !WHL - debug - if (verbose_inversion .and. this_rank == rtest) then - i = itest - j = jtest - print*, ' ' - print*, 'Computed moving averages: rank, i, j, alpha =', rtest, i, j, alpha - print*, ' ' - print*, 'current usrf (m):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.4)',advance='no') usrf_new_unscaled(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'moving average usrf:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.4)',advance='no') model%basal_physics%usrf_inversion(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'current dH/dt (m/yr):' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.4)',advance='no') dthck_dt_inversion(i,j)*scyr - enddo - write(6,*) ' ' - enddo - print*, ' ' - print*, 'moving average dH/dt:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(f10.4)',advance='no') model%basal_physics%dthck_dt_inversion(i,j)*scyr - enddo - write(6,*) ' ' - enddo - endif - - ! Determine the basal traction field, powerlaw_c_inversion, if desired. - ! Notes: (1) For inversion purposes, ice_mask = 1 where thck > 0.0 (not where thck > thklim). - ! (2) usrf_unscaled is the expected new value after applying the mass balance. - ! (3) These masks are computed before horizontal transport. So for instance, if a cell - ! is grounded before transport and floating afterward, it is treated as grounded. - - call invert_basal_traction(model%numerics%dt*tim0, & ! s - model%general%ewn, model%general%nsn, & - itest, jtest, rtest, & - model%basal_physics, & - ice_mask, & - floating_mask, & !TODO - before transport? - land_mask, & - grounding_line_mask, & - model%basal_physics%usrf_inversion, & ! m - model%geometry%usrf_obs*thk0, & ! m - model%basal_physics%dthck_dt_inversion) ! m/s - - ! Invert for bmlt_float_inversion, adjusting the melt rate to relax toward the observed thickness. - ! Note: basal_melt%bmlt_float_inversion is passed out with units of m/s - - ! Note: Other kinds of basal melting are handled in subroutine glissade_bmlt_float_solve. - ! Inversion is done here, after transport, when there is an updated ice thickness. - ! Then bmlt_float_inversion is added to the previously computed bmlt. - ! Note: Usually, whichbmlt_float = 0 when doing inversion. - ! However, for the HO_INVERSION_PRESCRIBED option, we may want to add a basal melting anomaly - ! as for the initMIP anomaly experiments. In that case the anomaly is already part of bmlt_float. - ! Note: If the basal melt GLP is turned on, it sets bmlt_float = 0 in partly floating cells. - ! However, it does not limit bmlt_float_inversion, which is applied to all floating cells, - ! including partly floating cells (in order to match observed thicknesses at the grounding line). - - !TODO - Are masks needed? Is it OK to have them computed pre-transport? - - call invert_bmlt_float(model%numerics%dt * tim0, & ! s - model%general%ewn, model%general%nsn, & - itest, jtest, rtest, & - model%basal_melt, & - thck_new_unscaled, & ! m - model%geometry%usrf_obs*thk0, & ! m - topg_unscaled, & ! m - model%climate%eus*thk0, & ! m - ice_mask, & - floating_mask, & - land_mask, & - grounding_line_mask) - - !WHL - debug - if (verbose_inversion .and. this_rank == rtest) then - i = itest - j = jtest - print*, ' ' - print*, 'Inverting for bmlt_float: rank, i, j =', rtest, i, j - print*, 'usrf (m), usrf_obs (m), bmlt_float_inversion (m/yr):', usrf_new_unscaled(i,j), & - model%geometry%usrf_obs(i,j)*thk0, model%basal_melt%bmlt_float_inversion(i,j)*scyr - print*, ' ' - endif - - elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then - - ! Prescribe the traction parameter powerlaw_c based on a previous inversion. - ! Although powerlaw_c is prescribed, it may need to be modified, - ! for example if a cell flips from grounded to floating or vice versa. - - call prescribe_basal_traction(model%general%ewn, model%general%nsn, & - itest, jtest, rtest, & - model%basal_physics, & - ice_mask, & - floating_mask, & - land_mask, & - grounding_line_mask) - - ! Prescribe bmlt_float based on a previous inversion. - ! Although bmlt_float is prescribed, it may need to be limited or ignored, - ! for example to avoid melting beneath grounded ice. - - call prescribe_bmlt_float(model%numerics%dt * tim0, & ! s - model%general%ewn, model%general%nsn, & - itest, jtest, rtest, & - model%basal_melt, & - thck_new_unscaled, & ! m - topg_unscaled, & ! m - model%climate%eus*thk0, & ! m - ice_mask, & - floating_mask, & - land_mask, & - grounding_line_mask) - - !WHL - debug - if (verbose_inversion .and. this_rank == rtest) then - i = itest - j = jtest - print*, ' ' - print*, 'Prescribe bmlt_float: rank, i, j =', rtest, i, j - print*, 'thck (m), bmltd_float_prescribed, bmlt_float_inversion (m/yr):', thck_unscaled(i,j), & - model%basal_melt%bmlt_float_prescribed(i,j)*scyr, & - model%basal_melt%bmlt_float_inversion(i,j)*scyr - print*, ' ' - endif - - endif ! which_ho_inversion (compute or prescribed) - - endif ! which_ho_inversion + endif ! which_ho_inversion ! ------------------------------------------------------------------------ ! Get masks used for the mass balance calculation. @@ -1747,7 +1463,7 @@ subroutine glissade_transport_solve(model) ! Use thck_calving_front to compute a fractional area for calving_front cells. ! ------------------------------------------------------------------------ - call glissade_get_masks(model%general%ewn, model%general%nsn, & + call glissade_get_masks(ewn, nsn, & thck_unscaled, & ! m topg_unscaled, & ! m model%climate%eus*thk0, & ! m @@ -1762,8 +1478,8 @@ subroutine glissade_transport_solve(model) ! Compute the effective fractional area of calving_front cells. - do j = 1, model%general%nsn - do i = 1, model%general%ewn + do j = 1, nsn + do i = 1, ewn if (calving_front_mask(i,j) == 1 .and. thck_calving_front(i,j) > 0.0d0) then effective_areafrac(i,j) = thck_unscaled(i,j) / thck_calving_front(i,j) effective_areafrac(i,j) = min(effective_areafrac(i,j), 1.0d0) @@ -1816,8 +1532,8 @@ subroutine glissade_transport_solve(model) call glissade_mass_balance_driver(model%numerics%dt * tim0, & model%numerics%dew * len0, model%numerics%dns * len0, & - model%general%ewn, model%general%nsn, & - model%general%upn-1, model%numerics%sigma, & + ewn, nsn, upn-1, & + model%numerics%sigma, & thck_unscaled(:,:), & ! m acab_unscaled(:,:), & ! m/s bmlt_unscaled(:,:), & ! m/s @@ -1849,17 +1565,13 @@ subroutine glissade_transport_solve(model) ! (acab_unscaled is intent(in) above, so no need to scale it back) model%geometry%thck(:,:) = thck_unscaled(:,:) / thk0 - ! convert topg back to scaled units, if necessary - ! Do this only if inverting for topg - if (invert_topg) model%geometry%topg(:,:) = topg_unscaled(:,:) / thk0 - ! For the enthalpy option, convert enthalpy back to temperature/waterfrac. if (model%options%whichtemp == TEMP_ENTHALPY) then ! Note: glissade_enth2temp expects SI units - do j = 1, model%general%nsn - do i = 1, model%general%ewn + do j = 1, nsn + do i = 1, ewn call glissade_enth2temp(model%numerics%stagsigma(1:upn-1), & model%geometry%thck(i,j)*thk0, model%temper%enthalpy(0:upn,i,j), & model%temper%temp(0:upn,i,j), model%temper%waterfrac(1:upn-1,i,j)) @@ -1881,33 +1593,27 @@ subroutine glissade_transport_solve(model) print*, ' ' print*, 'thck:' write(6,'(a6)',advance='no') ' ' -!! do i = 1, model%general%ewn do i = itest-5, itest+5 write(6,'(i14)',advance='no') i enddo write(6,*) ' ' -!! do j = model%general%nsn, 1, -1 do j = jtest+2, jtest-2, -1 write(6,'(i6)',advance='no') j -!! do i = 1, model%general%ewn do i = itest-5, itest+5 write(6,'(f14.7)',advance='no') model%geometry%thck(i,j) * thk0 enddo write(6,*) ' ' enddo print*, ' ' - k = model%general%upn + k = upn print*, 'temp, k =', k write(6,'(a6)',advance='no') ' ' -!! do i = 1, model%general%ewn do i = itest-5, itest+5 write(6,'(i14)',advance='no') i enddo write(6,*) ' ' -!! do j = model%general%nsn, 1, -1 do j = jtest+2, jtest-2, -1 write(6,'(i6)',advance='no') j -!! do i = 1, model%general%ewn do i = itest-5, itest+5 write(6,'(f14.7)',advance='no') model%temper%temp(k,i,j) enddo @@ -1926,6 +1632,8 @@ subroutine glissade_transport_solve(model) end select + print*, 'Here 5' + !------------------------------------------------------------------------ ! Update the upper and lower ice surface ! Note that glide_calclsrf loops over all cells, including halos, @@ -1969,7 +1677,275 @@ subroutine glissade_transport_solve(model) enddo endif ! verbose_inversion - end subroutine glissade_transport_solve + end subroutine glissade_thickness_tracer_solve + +!======================================================================= + + subroutine glissade_inversion_solve(model, & + thck_new_unscaled, & + ice_mask, & + floating_mask, & + land_mask, & + grounding_line_mask) + + use parallel + + use glimmer_paramets, only: tim0, thk0 + use glimmer_physcon, only: scyr + use glissade_inversion, only: invert_bmlt_float, prescribe_bmlt_float, & + invert_basal_traction, prescribe_basal_traction, & + invert_basal_topography, verbose_inversion + implicit none + + type(glide_global_type), intent(inout) :: model ! model instance + + real(dp), dimension(model%general%ewn, model%general%nsn), intent(in) :: & + thck_new_unscaled ! ice thickness expected after mass balance, without inversion (m) + + !Note: These masks are not part of the model derived type, and they are computed before transport + ! based on the old ice thickness, so they cannot be computed here. + !TODO - Make these masks part of the model derived type, so they do not need to be passed in? + + integer, dimension(model%general%ewn, model%general%nsn), intent(in) :: & + ice_mask, & ! = 1 if thck > 0, else = 0 + floating_mask, & ! = 1 where ice is present and floating, else = 0 + land_mask, & ! = 1 if topg is at or above sea level, else = 0 + grounding_line_mask ! = 1 if a cell is adjacent to the grounding line, else = 0 + + ! --- Local variables --- + + real(dp), dimension(model%general%ewn,model%general%nsn) :: & + thck_unscaled, & ! ice thickness (m) + topg_unscaled, & ! bedrock topography (m) + lsrf_new_unscaled, & ! expected new lower surface elevation (m) + usrf_new_unscaled, & ! expected new upper surface elevation (m) + dthck_dt_inversion ! dH/dt resulting from transport and mass balance (m/s) + + real(dp) :: alpha ! shorthand for inversion_babc_time_smoothing, in range [0,1] + + !TODO - Make invert_topg a config option + logical, parameter :: invert_topg = .false. + + integer :: i, j + integer :: ewn, nsn + integer :: itest, jtest, rtest + + rtest = -999 + itest = 1 + jtest = 1 + if (this_rank == model%numerics%rdiag_local) then + rtest = model%numerics%rdiag_local + itest = model%numerics%idiag_local + jtest = model%numerics%jdiag_local + endif + + ewn = model%general%ewn + nsn = model%general%nsn + + ! Compute a temporary topg array in SI units (m) + topg_unscaled(:,:) = model%geometry%topg(:,:) * thk0 + + ! Calculate the expected new lower and upper ice surface + ! Note: usrf_new_unscaled is used in inversion calculations, but model%geometry%usrf is not updated + ! until after the mass balance calculation. + call glide_calclsrf(thck_new_unscaled, topg_unscaled, model%climate%eus*thk0, lsrf_new_unscaled) + usrf_new_unscaled = max(0.d0, thck_new_unscaled + lsrf_new_unscaled) + + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then + + ! Invert for basal topography in cells adjacent to the grounding line. + ! The goal is to correct for observation errors which might imply a cell is grounded + ! when it is really floating, or vice versa. + ! For cells where usrf > usrf_obs, the topography is lowered (to reduce usrf and f_ground), + ! and for cells where usrf < usrf_obs, the topography is raised (to increasee usrf and f_ground). + + if (invert_topg) then + call invert_basal_topography(model%numerics%dt*tim0, & ! s + ewn, nsn, & + itest, jtest, rtest, & + ice_mask, & + grounding_line_mask, & + usrf_new_unscaled, & ! m + model%geometry%usrf_obs*thk0, & ! m + topg_unscaled, & ! m + model%geometry%topg_obs*thk0, & ! m + model%climate%eus*thk0) + + call parallel_halo(topg_unscaled) + endif + + ! Compute the thickness tendency dH/dt (m/s) resulting from transport and mass balance + ! (but not including bmlt_float_inversion). We set dthck_dt = 0 for ice-free cells. + ! This tendency is used when inverting for powerlaw_c_inversion. + + ! Note: A similar variable, geometry%dthck_dt, is computed at the end of the time step for diagnostic output. + ! This is simply the rate of change of thickness between the start and end of the time step. + + where (model%geometry%thck_old > 0.0d0) + dthck_dt_inversion = (thck_new_unscaled - model%geometry%thck_old*thk0) & + / (model%numerics%dt * tim0) + elsewhere + dthck_dt_inversion = 0.0d0 + endwhere + + ! Optionally, compute an exponential moving average of usrf and dthck_dt + ! The larger the factor, the more rapidly earlier values are discounted. + alpha = model%basal_physics%inversion_babc_time_smoothing + alpha = min(alpha, 1.0d0 - 1.0d0/real(model%numerics%tstep_count,dp)) ! decrease smoother for first few time steps + alpha = min(1.0d0, max(alpha,0.0d0)) ! limit to [0,1] + if (alpha < 1.0d0) then + ! take moving averages of usrf and dthck_dt with contributions from previous values + model%basal_physics%usrf_inversion(:,:) = (1.d0 - alpha) * usrf_new_unscaled(:,:) & + + alpha * model%basal_physics%usrf_inversion(:,:) + model%basal_physics%dthck_dt_inversion(:,:) = (1.d0 - alpha) * dthck_dt_inversion(:,:) & + + alpha * model%basal_physics%dthck_dt_inversion(:,:) + else + ! simply copy the latest values + model%basal_physics%usrf_inversion(:,:) = usrf_new_unscaled(:,:) + model%basal_physics%dthck_dt_inversion(:,:) = dthck_dt_inversion(:,:) + endif ! alpha < 1 + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'Computed moving averages: rank, i, j, alpha =', rtest, i, j, alpha + print*, ' ' + print*, 'current usrf (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.4)',advance='no') usrf_new_unscaled(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'moving average usrf:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.4)',advance='no') model%basal_physics%usrf_inversion(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'current dH/dt (m/yr):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.4)',advance='no') dthck_dt_inversion(i,j)*scyr + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'moving average dH/dt:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f10.4)',advance='no') model%basal_physics%dthck_dt_inversion(i,j)*scyr + enddo + write(6,*) ' ' + enddo + endif + + ! Determine the basal traction field, powerlaw_c_inversion, if desired. + ! Notes: (1) For inversion purposes, ice_mask = 1 where thck > 0.0 (not where thck > thklim). + ! (2) usrf_unscaled is the expected new value after applying the mass balance. + ! (3) These masks are computed before horizontal transport. So for instance, if a cell + ! is grounded before transport and floating afterward, it is treated as grounded. + + call invert_basal_traction(model%numerics%dt*tim0, & ! s + ewn, nsn, & + itest, jtest, rtest, & + model%basal_physics, & + ice_mask, & + floating_mask, & !TODO - before transport? + land_mask, & + grounding_line_mask, & + model%basal_physics%usrf_inversion, & ! m + model%geometry%usrf_obs*thk0, & ! m + model%basal_physics%dthck_dt_inversion) ! m/s + + + ! Invert for bmlt_float_inversion, adjusting the melt rate to relax toward the observed thickness. + ! Note: basal_melt%bmlt_float_inversion is passed out with units of m/s + + ! Note: Other kinds of basal melting are handled in subroutine glissade_bmlt_float_solve. + ! Inversion is done here, after transport, when there is an updated ice thickness. + ! Then bmlt_float_inversion is added to the previously computed bmlt. + ! Note: Usually, whichbmlt_float = 0 when doing inversion. + ! However, for the HO_INVERSION_PRESCRIBED option, we may want to add a basal melting anomaly + ! as for the initMIP anomaly experiments. In that case the anomaly is already part of bmlt_float. + ! Note: If the basal melt GLP is turned on, it sets bmlt_float = 0 in partly floating cells. + ! However, it does not limit bmlt_float_inversion, which is applied to all floating cells, + ! including partly floating cells (in order to match observed thicknesses at the grounding line). + + call invert_bmlt_float(model%numerics%dt * tim0, & ! s + ewn, nsn, & + itest, jtest, rtest, & + model%basal_melt, & + thck_new_unscaled, & ! m + model%geometry%usrf_obs*thk0, & ! m + topg_unscaled, & ! m + model%climate%eus*thk0, & ! m + ice_mask, & + floating_mask, & + land_mask, & + grounding_line_mask) + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'Inverting for bmlt_float: rank, i, j =', rtest, i, j + print*, 'usrf (m), usrf_obs (m), bmlt_float_inversion (m/yr):', usrf_new_unscaled(i,j), & + model%geometry%usrf_obs(i,j)*thk0, model%basal_melt%bmlt_float_inversion(i,j)*scyr + print*, ' ' + endif + + elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then + + ! Prescribe the traction parameter powerlaw_c based on a previous inversion. + ! Although powerlaw_c is prescribed, it may need to be modified, + ! for example if a cell flips from grounded to floating or vice versa. + + call prescribe_basal_traction(ewn, nsn, & + itest, jtest, rtest, & + model%basal_physics, & + ice_mask, & + floating_mask, & + land_mask, & + grounding_line_mask) + + ! Prescribe bmlt_float based on a previous inversion. + ! Although bmlt_float is prescribed, it may need to be limited or ignored, + ! for example to avoid melting beneath grounded ice. + + call prescribe_bmlt_float(model%numerics%dt * tim0, & ! s + ewn, nsn, & + itest, jtest, rtest, & + model%basal_melt, & + thck_new_unscaled, & ! m + topg_unscaled, & ! m + model%climate%eus*thk0, & ! m + ice_mask, & + floating_mask, & + land_mask, & + grounding_line_mask) + + !WHL - debug + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'Prescribe bmlt_float: rank, i, j =', rtest, i, j + print*, 'thck (m), bmltd_float_prescribed, bmlt_float_inversion (m/yr):', thck_unscaled(i,j), & + model%basal_melt%bmlt_float_prescribed(i,j)*scyr, & + model%basal_melt%bmlt_float_inversion(i,j)*scyr + print*, ' ' + endif + + endif ! which_ho_inversion (compute or prescribed) + + end subroutine glissade_inversion_solve !======================================================================= From 69d268d87b01c56b033daea6615b285f7d83fab8 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Wed, 2 May 2018 17:21:58 -0600 Subject: [PATCH 30/61] Created an inversion derived type There are enough inversion-related fields and parameters now to bundle into their own derived type. I removed them from the glide_basal_physics and glide_basal_melt types and put them in a new glide_inversion type. Also added powerlaw_c_land, powerlaw_c_marine and bmlt_thck_buffer as user-configurable inversion parameters in the derived type. This commit is BFB. --- libglide/glide_setup.F90 | 90 +++++---- libglide/glide_types.F90 | 140 +++++++------- libglide/glide_vars.def | 14 +- libglissade/glissade.F90 | 57 +++--- libglissade/glissade_basal_traction.F90 | 10 +- libglissade/glissade_inversion.F90 | 241 ++++++++++-------------- libglissade/glissade_velo_higher.F90 | 6 + 7 files changed, 280 insertions(+), 278 deletions(-) diff --git a/libglide/glide_setup.F90 b/libglide/glide_setup.F90 index 836ecd76..62eaa845 100644 --- a/libglide/glide_setup.F90 +++ b/libglide/glide_setup.F90 @@ -208,8 +208,8 @@ subroutine glide_scale_params(model) model%basal_melt%bmlt_float_const = model%basal_melt%bmlt_float_const / scyr ! scale basal inversion parameters - model%basal_physics%inversion_babc_timescale = model%basal_physics%inversion_babc_timescale * scyr - model%basal_physics%inversion_babc_dthck_dt_scale = model%basal_physics%inversion_babc_dthck_dt_scale / scyr + model%inversion%babc_timescale = model%inversion%babc_timescale * scyr + model%inversion%babc_dthck_dt_scale = model%inversion%babc_dthck_dt_scale / scyr ! scale SMB/acab parameters model%climate%overwrite_acab_value = model%climate%overwrite_acab_value*tim0/(scyr*thk0) @@ -1627,6 +1627,7 @@ subroutine handle_parameters(section, model) call GetValue(section, 'c_drainage', model%basal_physics%c_drainage) ! pseudo-plastic parameters + !TODO - Put pseudo-plastic and other basal sliding parameters in a separate section call GetValue(section, 'pseudo_plastic_q', model%basal_physics%pseudo_plastic_q) call GetValue(section, 'pseudo_plastic_u0', model%basal_physics%pseudo_plastic_u0) call GetValue(section, 'pseudo_plastic_phimin', model%basal_physics%pseudo_plastic_phimin) @@ -1635,13 +1636,18 @@ subroutine handle_parameters(section, model) call GetValue(section, 'pseudo_plastic_bedmax', model%basal_physics%pseudo_plastic_bedmax) ! basal inversion parameters - call GetValue(section, 'powerlaw_c_max', model%basal_physics%powerlaw_c_max) - call GetValue(section, 'powerlaw_c_min', model%basal_physics%powerlaw_c_min) - call GetValue(section, 'inversion_babc_timescale', model%basal_physics%inversion_babc_timescale) - call GetValue(section, 'inversion_babc_thck_scale', model%basal_physics%inversion_babc_thck_scale) - call GetValue(section, 'inversion_babc_dthck_dt_scale', model%basal_physics%inversion_babc_dthck_dt_scale) - call GetValue(section, 'inversion_babc_space_smoothing', model%basal_physics%inversion_babc_space_smoothing) - call GetValue(section, 'inversion_babc_time_smoothing', model%basal_physics%inversion_babc_time_smoothing) + !TODO - Put inversion parameters in a separate section + call GetValue(section, 'powerlaw_c_max', model%inversion%powerlaw_c_max) + call GetValue(section, 'powerlaw_c_min', model%inversion%powerlaw_c_min) + call GetValue(section, 'powerlaw_c_land', model%inversion%powerlaw_c_land) + call GetValue(section, 'powerlaw_c_marine', model%inversion%powerlaw_c_marine) + call GetValue(section, 'inversion_babc_timescale', model%inversion%babc_timescale) + call GetValue(section, 'inversion_babc_thck_scale', model%inversion%babc_thck_scale) + call GetValue(section, 'inversion_babc_dthck_dt_scale', model%inversion%babc_dthck_dt_scale) + call GetValue(section, 'inversion_babc_space_smoothing', model%inversion%babc_space_smoothing) + call GetValue(section, 'inversion_babc_time_smoothing', model%inversion%babc_time_smoothing) + call GetValue(section, 'inversion_bmlt_thck_buffer', model%inversion%bmlt_thck_buffer) + ! ISMIP-HOM parameters call GetValue(section,'periodic_offset_ew',model%numerics%periodic_offset_ew) @@ -1938,30 +1944,6 @@ subroutine print_parameters(model) call write_log(message) write(message,*) 'm exponent for power law : ', model%basal_physics%powerlaw_m call write_log(message) - if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then - call write_log(' NOTE: powerlaw_c and coulomb_c will be modified by inversion') - write(message,*) 'powerlaw_c max, Pa (m/yr)^(-1/3) : ', & - model%basal_physics%powerlaw_c_max - call write_log(message) - write(message,*) 'powerlaw_c min, Pa (m/yr)^(-1/3) : ', & - model%basal_physics%powerlaw_c_min - call write_log(message) - write(message,*) 'inversion basal traction timescale (yr) : ', & - model%basal_physics%inversion_babc_timescale - call write_log(message) - write(message,*) 'inversion thickness scale (m) : ', & - model%basal_physics%inversion_babc_thck_scale - call write_log(message) - write(message,*) 'inversion dthck/dt scale (m/yr) : ', & - model%basal_physics%inversion_babc_dthck_dt_scale - call write_log(message) - write(message,*) 'inversion basal traction space smoothing : ', & - model%basal_physics%inversion_babc_space_smoothing - call write_log(message) - write(message,*) 'inversion basal traction time smoothing : ', & - model%basal_physics%inversion_babc_time_smoothing - call write_log(message) - endif elseif (model%options%which_ho_babc == HO_BABC_COULOMB_POWERLAW_TSAI) then write(message,*) 'C coefficient for Coulomb friction law : ', model%basal_physics%coulomb_c call write_log(message) @@ -1975,6 +1957,46 @@ subroutine print_parameters(model) call write_log(message) endif + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE) then + write(message,*) 'powerlaw_c max, Pa (m/yr)^(-1/3) : ', & + model%inversion%powerlaw_c_max + call write_log(message) + write(message,*) 'powerlaw_c min, Pa (m/yr)^(-1/3) : ', & + model%inversion%powerlaw_c_min + call write_log(message) + write(message,*) 'powerlaw_c land, Pa (m/yr)^(-1/3) : ', & + model%inversion%powerlaw_c_land + call write_log(message) + write(message,*) 'powerlaw_c marine, Pa (m/yr)^(-1/3) : ', & + model%inversion%powerlaw_c_marine + call write_log(message) + write(message,*) 'inversion basal traction timescale (yr) : ', & + model%inversion%babc_timescale + call write_log(message) + write(message,*) 'inversion thickness scale (m) : ', & + model%inversion%babc_thck_scale + call write_log(message) + write(message,*) 'inversion dthck/dt scale (m/yr) : ', & + model%inversion%babc_dthck_dt_scale + call write_log(message) + write(message,*) 'inversion basal traction space smoothing : ', & + model%inversion%babc_space_smoothing + call write_log(message) + write(message,*) 'inversion basal traction time smoothing : ', & + model%inversion%babc_time_smoothing + call write_log(message) + write(message,*) 'inversion bmlt_float thickness buffer : ', & + model%inversion%bmlt_thck_buffer + call write_log(message) + elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBE) then + write(message,*) 'powerlaw_c land, Pa (m/yr)^(-1/3) : ', & + model%inversion%powerlaw_c_land + call write_log(message) + write(message,*) 'powerlaw_c marine, Pa (m/yr)^(-1/3) : ', & + model%inversion%powerlaw_c_marine + call write_log(message) + endif + if (model%basal_physics%beta_powerlaw_umax > 0.0d0) then write(message,*) 'max ice speed (m/yr) when evaluating beta(u) : ', model%basal_physics%beta_powerlaw_umax call write_log(message) @@ -2567,7 +2589,7 @@ subroutine define_glide_restart_variables(options) call glide_add_to_restart_variable_list('bmlt_float_inversion') call glide_add_to_restart_variable_list('dthck_dt_inversion') call glide_add_to_restart_variable_list('usrf_inversion') - case (HO_INVERSION_PRESCRIBED) + case (HO_INVERSION_PRESCRIBE) ! Write powerlaw_c_inversion to the restart file, because it is ! continually adjusted at runtime as the grounding line moves. ! Also write bmlt_float_inversion, in case it is also adjusted at runtime. diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index 4c00b0c4..b3e50951 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -223,7 +223,7 @@ module glide_types integer, parameter :: HO_INVERSION_NONE = 0 integer, parameter :: HO_INVERSION_COMPUTE = 1 - integer, parameter :: HO_INVERSION_PRESCRIBED = 2 + integer, parameter :: HO_INVERSION_PRESCRIBE = 2 integer, parameter :: HO_BWAT_NONE = 0 integer, parameter :: HO_BWAT_CONSTANT = 1 @@ -1251,6 +1251,47 @@ module glide_types end type glide_temper + type glide_inversion + + ! Notes on inversion fields: + ! With which_ho_inversion = HO_INVERSION_COMPUTE, bmlt_float_inversion is computed and applied during each step. + ! For which_ho_inversion = HO_INVERSION_PRESCRIBE, bmlt_float_prescribed (as computed in a + ! previous inversion run) is read from the input file. + + real(dp), dimension(:,:), pointer :: & + bmlt_float_inversion => null(), & !> basal melt rate computed by inversion; + !> used to relax thickness of floating ice toward observed target + bmlt_float_prescribed => null() !> basal melt rate prescribed from a previous inversion + + real(dp), dimension(:,:), pointer :: & + powerlaw_c_inversion => null(), & !> spatially varying powerlaw_c field, Pa (m/yr)^(-1/3) + powerlaw_c_prescribed => null(), & !> powerlaw_c field, prescribed from a previous inversion + usrf_inversion => null(), & !> upper surface elevation, used for Cp inversion (m) + dthck_dt_inversion => null() !> rate of thickness change, used for Cp inversion (m/s) + + ! parameters for inversion of basal friction coefficients + ! Note: These values work well for MISMIP+, but may not be optimal for whole ice sheets. + ! Note: inversion_babc_timescale and inversion_babc_dthck_dt_scale are later rescaled to SI units (s and m/s). + + real(dp) :: & + powerlaw_c_max = 1.0d5, & !> max value of powerlaw_c, Pa (m/yr)^(-1/3) + powerlaw_c_min = 1.0d2, & !> min value of powerlaw_c, Pa (m/yr)^(-1/3) + powerlaw_c_land = 2.0d-4, & !> default value of powerlaw_c on land (topg >= eus) + powerlaw_c_marine = 1.0d-3 !> default value of powerlaw_c below sea level + + real(dp) :: & + babc_timescale = 500.d0, & !> inversion timescale (yr); must be > 0 + babc_thck_scale = 100.d0, & !> thickness inversion scale (m); must be > 0 + babc_dthck_dt_scale = 0.10d0, & !> dthck_dt inversion scale (m/yr); must be > 0 + babc_space_smoothing = 1.0d-2, & !> factor for spatial smoothing of powerlaw_c; larger => more smoothing + babc_time_smoothing = 0.0d0 !> factor for exponential moving average of usrf/dthck_dt_inversion + !> range [0,1]; larger => slower discounting of old values, more smoothing + + real(dp) :: & + bmlt_thck_buffer = 1.0d0 !> cells with a grounded target are restored to thck_flotation + bmlt_thck_buffer (m) + + end type glide_inversion + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ type glide_basal_melt @@ -1277,17 +1318,6 @@ module glide_types bmlt_float_external => null(), & !> external basal melt rate field bmlt_float_anomaly => null() !> basal melt rate anomaly field - ! Notes on inversion fields: - ! With which_ho_inversion = HO_INVERSION_COMPUTE, bmlt_float_inversion is computed and applied during each step. - ! For which_ho_inversion = HO_INVERSION_PRESCRIBED, bmlt_float_prescribed (as computed in a - ! previous inversion run) is read from the input file. - - real(dp), dimension(:,:), pointer :: & - bmlt_float_inversion => null(), & !> basal melt rate computed by inversion; - !> relaxes thickness of floating ice toward observed target - bmlt_float_inversion_tavg => null(), & !> basal melt rate computed by inversion (time average) - bmlt_float_prescribed => null() !> basal melt rate prescribed from a previous inversion - real(dp) :: bmlt_float_factor = 1.0d0 !> adjustment factor for external bmlt_float field ! MISMIP+ parameters for Ice1 experiments @@ -1381,11 +1411,6 @@ module glide_types real(dp), dimension(:,:), pointer :: C_space_factor => null() !< spatial factor for basal shear stress (no dimension) real(dp), dimension(:,:), pointer :: C_space_factor_stag => null() !< spatial factor for basal shear stress on staggered grid (no dimension) real(dp), dimension(:,:), pointer :: tau_c => null() !< yield stress for plastic sliding (Pa) - real(dp), dimension(:,:), pointer :: powerlaw_c_inversion => null() !< spatially varying powerlaw_c field, Pa m^(-1/3) yr^(1/3) - real(dp), dimension(:,:), pointer :: powerlaw_c_inversion_tavg => null() !< spatially varying powerlaw_c field, time average - real(dp), dimension(:,:), pointer :: powerlaw_c_prescribed => null() !< powerlaw_c field, prescribed from a previous inversion - real(dp), dimension(:,:), pointer :: usrf_inversion => null() !< upper surface elevation used for Cp inversion (m) - real(dp), dimension(:,:), pointer :: dthck_dt_inversion => null() !< dH/dt used for Cp inversion (m/s) ! parameters for reducing the effective pressure where the bed is warm, saturated or connected to the ocean real(dp) :: effecpress_delta = 0.02d0 !< multiplier for effective pressure N where the bed is saturated and/or thawed (unitless) @@ -1434,22 +1459,6 @@ module glide_types real(dp) :: beta_powerlaw_umax = 0.0d0 !< upper limit of ice speed (m/yr) when evaluating powerlaw beta !< Where u > umax, let u = umax when evaluating beta(u) - ! parameters for inversion of basal friction coefficients - ! Note: These values work well for MISMIP+, but may not be optimal for whole ice sheets. - ! Note: inversion_babc_timescale and inversion_babc_dthck_dt_scale are later rescaled to SI units (s and m/s). - - real(dp) :: & - powerlaw_c_max = 1.0d5, & !< Pa (m/yr)^(-1/3) - powerlaw_c_min = 1.0d2 !< Pa (m/yr)^(-1/3) - - real(dp) :: & - inversion_babc_timescale = 500.d0, & !< inversion timescale (yr); must be > 0 - inversion_babc_thck_scale = 100.d0, & !< thickness inversion scale (m); must be > 0 - inversion_babc_dthck_dt_scale = 0.10d0, & !< dthck_dt inversion scale (m/yr); must be > 0 - inversion_babc_space_smoothing = 1.0d-2, & !< factor for spatial smoothing of powerlaw_c; larger => more smoothing - inversion_babc_time_smoothing = 0.0d0 !< factor for exponential moving average of usrf/dthck_dt_inversion - !< range [0,1]; larger => slower discounting of old values, more smoothing - ! parameter for constant basal water ! Note: This parameter applies to HO_BWAT_CONSTANT only. ! For Glide's BWATER_CONST, the constant value is hardwired in subroutine calcbwat. @@ -1821,6 +1830,7 @@ module glide_types type(glide_temper) :: temper type(glide_basal_physics):: basal_physics type(glide_basal_melt) :: basal_melt + type(glide_inversion):: inversion type(glide_plume) :: plume type(glide_lithot_type) :: lithot type(glide_funits) :: funits @@ -1871,10 +1881,15 @@ subroutine glide_allocarr(model) !> \item \texttt{bmlt_float(ewn,nsn)} !> \item \texttt{bmlt_float_external(ewn,nsn)} !> \item \texttt{bmlt_float_anomaly(ewn,nsn)} + !> \end{itemize} + + !> In \texttt{model\%inversion}: !> \item \texttt{bmlt_float_inversion(ewn,nsn)} - !> \item \texttt{bmlt_float_inversion_tavg(ewn,nsn)} !> \item \texttt{bmlt_float_prescribed(ewn,nsn)} - !> \end{itemize} + !> \item \texttt{powerlaw_c_inversion(ewn,nsn)} + !> \item \texttt{powerlaw_c_prescribed(ewn,nsn)} + !> \item \texttt{usrf_inversion(ewn,nsn)} + !> \item \texttt{dthck_dt_inversion(ewn,nsn)} !> In \texttt{model\%plume}: !> \begin{itemize} @@ -2212,14 +2227,6 @@ subroutine glide_allocarr(model) call coordsystem_allocate(model%general%velo_grid, model%basal_physics%C_space_factor_stag) call coordsystem_allocate(model%general%velo_grid, model%basal_physics%mintauf) !! endif - if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & - model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then - call coordsystem_allocate(model%general%ice_grid, model%basal_physics%powerlaw_c_inversion) - call coordsystem_allocate(model%general%ice_grid, model%basal_physics%powerlaw_c_inversion_tavg) - call coordsystem_allocate(model%general%ice_grid, model%basal_physics%powerlaw_c_prescribed) - call coordsystem_allocate(model%general%ice_grid, model%basal_physics%usrf_inversion) - call coordsystem_allocate(model%general%ice_grid, model%basal_physics%dthck_dt_inversion) - endif endif ! glam/glissade ! bmlt arrays @@ -2237,12 +2244,6 @@ subroutine glide_allocarr(model) if (model%options%whichbmlt_float == BMLT_FLOAT_EXTERNAL) then call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_float_external) endif - if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & - model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then - call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_float_inversion) - call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_float_inversion_tavg) - call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_float_prescribed) - endif if (model%options%whichbmlt_float == BMLT_FLOAT_MISOMIP) then call coordsystem_allocate(model%general%ice_grid, model%plume%T_basal) call coordsystem_allocate(model%general%ice_grid, model%plume%S_basal) @@ -2263,6 +2264,17 @@ subroutine glide_allocarr(model) endif endif ! Glissade + ! inversion arrays (Glissade only) + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & + model%options%which_ho_inversion == HO_INVERSION_PRESCRIBE) then + call coordsystem_allocate(model%general%ice_grid, model%inversion%bmlt_float_inversion) + call coordsystem_allocate(model%general%ice_grid, model%inversion%bmlt_float_prescribed) + call coordsystem_allocate(model%general%ice_grid, model%inversion%powerlaw_c_inversion) + call coordsystem_allocate(model%general%ice_grid, model%inversion%powerlaw_c_prescribed) + call coordsystem_allocate(model%general%ice_grid, model%inversion%usrf_inversion) + call coordsystem_allocate(model%general%ice_grid, model%inversion%dthck_dt_inversion) + endif + ! climate arrays call coordsystem_allocate(model%general%ice_grid, model%climate%acab) call coordsystem_allocate(model%general%ice_grid, model%climate%acab_tavg) @@ -2552,16 +2564,6 @@ subroutine glide_deallocarr(model) deallocate(model%basal_physics%effecpress_stag) if (associated(model%basal_physics%tau_c)) & deallocate(model%basal_physics%tau_c) - if (associated(model%basal_physics%powerlaw_c_inversion)) & - deallocate(model%basal_physics%powerlaw_c_inversion) - if (associated(model%basal_physics%powerlaw_c_inversion_tavg)) & - deallocate(model%basal_physics%powerlaw_c_inversion_tavg) - if (associated(model%basal_physics%powerlaw_c_prescribed)) & - deallocate(model%basal_physics%powerlaw_c_prescribed) - if (associated(model%basal_physics%usrf_inversion)) & - deallocate(model%basal_physics%usrf_inversion) - if (associated(model%basal_physics%dthck_dt_inversion)) & - deallocate(model%basal_physics%dthck_dt_inversion) if (associated(model%basal_physics%C_space_factor)) & deallocate(model%basal_physics%C_space_factor) if (associated(model%basal_physics%C_space_factor_stag)) & @@ -2583,17 +2585,25 @@ subroutine glide_deallocarr(model) deallocate(model%basal_melt%bmlt_float_external) if (associated(model%basal_melt%bmlt_float_anomaly)) & deallocate(model%basal_melt%bmlt_float_anomaly) - if (associated(model%basal_melt%bmlt_float_inversion)) & - deallocate(model%basal_melt%bmlt_float_inversion) - if (associated(model%basal_melt%bmlt_float_inversion_tavg)) & - deallocate(model%basal_melt%bmlt_float_inversion_tavg) - if (associated(model%basal_melt%bmlt_float_prescribed)) & - deallocate(model%basal_melt%bmlt_float_prescribed) if (associated(model%basal_melt%bmlt_applied_old)) & deallocate(model%basal_melt%bmlt_applied_old) if (associated(model%basal_melt%bmlt_applied_diff)) & deallocate(model%basal_melt%bmlt_applied_diff) + ! inversion arrays + if (associated(model%inversion%bmlt_float_inversion)) & + deallocate(model%inversion%bmlt_float_inversion) + if (associated(model%inversion%bmlt_float_prescribed)) & + deallocate(model%inversion%bmlt_float_prescribed) + if (associated(model%inversion%powerlaw_c_inversion)) & + deallocate(model%inversion%powerlaw_c_inversion) + if (associated(model%inversion%powerlaw_c_prescribed)) & + deallocate(model%inversion%powerlaw_c_prescribed) + if (associated(model%inversion%usrf_inversion)) & + deallocate(model%inversion%usrf_inversion) + if (associated(model%inversion%dthck_dt_inversion)) & + deallocate(model%inversion%dthck_dt_inversion) + ! plume arrays if (associated(model%plume%T_basal)) & deallocate(model%plume%T_basal) diff --git a/libglide/glide_vars.def b/libglide/glide_vars.def index 6e48c369..29326528 100644 --- a/libglide/glide_vars.def +++ b/libglide/glide_vars.def @@ -304,17 +304,16 @@ load: 1 dimensions: time, y1, x1 units: meter/year long_name: basal melt rate for floating ice from inversion -data: data%basal_melt%bmlt_float_inversion +data: data%inversion%bmlt_float_inversion factor: scyr load: 1 coordinates: lon lat -average: 1 [bmlt_float_prescribed] dimensions: time, y1, x1 units: meter/year long_name: prescribed basal melt rate for floating ice -data: data%basal_melt%bmlt_float_prescribed +data: data%inversion%bmlt_float_prescribed factor: scyr load: 1 coordinates: lon lat @@ -857,16 +856,15 @@ coordinates: lon lat dimensions: time, y1, x1 units: Pa (m/yr)**(-1/3) long_name: spatially varying C for powerlaw sliding -data: data%basal_physics%powerlaw_c_inversion +data: data%inversion%powerlaw_c_inversion load: 1 coordinates: lon lat -average: 1 [powerlaw_c_prescribed] dimensions: time, y1, x1 units: Pa (m/yr)**(-1/3) long_name: prescribed spatially varying C for powerlaw sliding -data: data%basal_physics%powerlaw_c_prescribed +data: data%inversion%powerlaw_c_prescribed load: 1 coordinates: lon lat @@ -874,7 +872,7 @@ coordinates: lon lat dimensions: time, y1,x1 units: meter long_name: surface elevation used for inversion -data: data%basal_physics%usrf_inversion +data: data%inversion%usrf_inversion coordinates: lon lat load: 1 @@ -882,7 +880,7 @@ load: 1 dimensions: time, y1,x1 units: meter/year long_name: dH/dt used for inversion -data: data%basal_physics%dthck_dt_inversion +data: data%inversion%dthck_dt_inversion factor: scyr coordinates: lon lat load: 1 diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index bd602183..f78da6c3 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -617,7 +617,7 @@ subroutine glissade_initialise(model, evolve_ice) ! Optionally, do initial calculations for inversion if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & - model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then + model%options%which_ho_inversion == HO_INVERSION_PRESCRIBE) then call glissade_init_inversion(model) @@ -1441,7 +1441,7 @@ subroutine glissade_thickness_tracer_solve(model) !------------------------------------------------------------------------- if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & - model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then + model%options%which_ho_inversion == HO_INVERSION_PRESCRIBE) then ! Compute the new ice thickness that would be computed after applying the SMB and BMB, without inversion. thck_new_unscaled = thck_unscaled(:,:) + (acab_unscaled - bmlt_unscaled) * model%numerics%dt*tim0 @@ -1492,7 +1492,7 @@ subroutine glissade_thickness_tracer_solve(model) enddo if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & - model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then + model%options%which_ho_inversion == HO_INVERSION_PRESCRIBE) then ! Add bmlt_float_inversion to bmlt_unscaled, the melt rate passed to the mass balance driver. ! Both fields have units of m/s. @@ -1509,7 +1509,7 @@ subroutine glissade_thickness_tracer_solve(model) ! in glissade_mass_balance_driver. where (effective_areafrac > 0.0d0) - bmlt_unscaled = bmlt_unscaled + model%basal_melt%bmlt_float_inversion/effective_areafrac + bmlt_unscaled = bmlt_unscaled + model%inversion%bmlt_float_inversion/effective_areafrac endwhere endif ! which_ho_inversion @@ -1721,7 +1721,7 @@ subroutine glissade_inversion_solve(model, & usrf_new_unscaled, & ! expected new upper surface elevation (m) dthck_dt_inversion ! dH/dt resulting from transport and mass balance (m/s) - real(dp) :: alpha ! shorthand for inversion_babc_time_smoothing, in range [0,1] + real(dp) :: alpha ! shorthand for inversion%babc_time_smoothing, in range [0,1] !TODO - Make invert_topg a config option logical, parameter :: invert_topg = .false. @@ -1790,19 +1790,19 @@ subroutine glissade_inversion_solve(model, & ! Optionally, compute an exponential moving average of usrf and dthck_dt ! The larger the factor, the more rapidly earlier values are discounted. - alpha = model%basal_physics%inversion_babc_time_smoothing + alpha = model%inversion%babc_time_smoothing alpha = min(alpha, 1.0d0 - 1.0d0/real(model%numerics%tstep_count,dp)) ! decrease smoother for first few time steps alpha = min(1.0d0, max(alpha,0.0d0)) ! limit to [0,1] if (alpha < 1.0d0) then ! take moving averages of usrf and dthck_dt with contributions from previous values - model%basal_physics%usrf_inversion(:,:) = (1.d0 - alpha) * usrf_new_unscaled(:,:) & - + alpha * model%basal_physics%usrf_inversion(:,:) - model%basal_physics%dthck_dt_inversion(:,:) = (1.d0 - alpha) * dthck_dt_inversion(:,:) & - + alpha * model%basal_physics%dthck_dt_inversion(:,:) + model%inversion%usrf_inversion(:,:) = (1.d0 - alpha) * usrf_new_unscaled(:,:) & + + alpha * model%inversion%usrf_inversion(:,:) + model%inversion%dthck_dt_inversion(:,:) = (1.d0 - alpha) * dthck_dt_inversion(:,:) & + + alpha * model%inversion%dthck_dt_inversion(:,:) else ! simply copy the latest values - model%basal_physics%usrf_inversion(:,:) = usrf_new_unscaled(:,:) - model%basal_physics%dthck_dt_inversion(:,:) = dthck_dt_inversion(:,:) + model%inversion%usrf_inversion(:,:) = usrf_new_unscaled(:,:) + model%inversion%dthck_dt_inversion(:,:) = dthck_dt_inversion(:,:) endif ! alpha < 1 !WHL - debug @@ -1823,7 +1823,7 @@ subroutine glissade_inversion_solve(model, & print*, 'moving average usrf:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.4)',advance='no') model%basal_physics%usrf_inversion(i,j) + write(6,'(f10.4)',advance='no') model%inversion%usrf_inversion(i,j) enddo write(6,*) ' ' enddo @@ -1839,7 +1839,7 @@ subroutine glissade_inversion_solve(model, & print*, 'moving average dH/dt:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.4)',advance='no') model%basal_physics%dthck_dt_inversion(i,j)*scyr + write(6,'(f10.4)',advance='no') model%inversion%dthck_dt_inversion(i,j)*scyr enddo write(6,*) ' ' enddo @@ -1854,14 +1854,14 @@ subroutine glissade_inversion_solve(model, & call invert_basal_traction(model%numerics%dt*tim0, & ! s ewn, nsn, & itest, jtest, rtest, & - model%basal_physics, & + model%inversion, & ice_mask, & floating_mask, & !TODO - before transport? land_mask, & grounding_line_mask, & - model%basal_physics%usrf_inversion, & ! m + model%inversion%usrf_inversion, & ! m model%geometry%usrf_obs*thk0, & ! m - model%basal_physics%dthck_dt_inversion) ! m/s + model%inversion%dthck_dt_inversion) ! m/s ! Invert for bmlt_float_inversion, adjusting the melt rate to relax toward the observed thickness. @@ -1871,7 +1871,7 @@ subroutine glissade_inversion_solve(model, & ! Inversion is done here, after transport, when there is an updated ice thickness. ! Then bmlt_float_inversion is added to the previously computed bmlt. ! Note: Usually, whichbmlt_float = 0 when doing inversion. - ! However, for the HO_INVERSION_PRESCRIBED option, we may want to add a basal melting anomaly + ! However, for the HO_INVERSION_PRESCRIBE option, we may want to add a basal melting anomaly ! as for the initMIP anomaly experiments. In that case the anomaly is already part of bmlt_float. ! Note: If the basal melt GLP is turned on, it sets bmlt_float = 0 in partly floating cells. ! However, it does not limit bmlt_float_inversion, which is applied to all floating cells, @@ -1880,15 +1880,14 @@ subroutine glissade_inversion_solve(model, & call invert_bmlt_float(model%numerics%dt * tim0, & ! s ewn, nsn, & itest, jtest, rtest, & - model%basal_melt, & + model%inversion, & thck_new_unscaled, & ! m model%geometry%usrf_obs*thk0, & ! m topg_unscaled, & ! m model%climate%eus*thk0, & ! m ice_mask, & floating_mask, & - land_mask, & - grounding_line_mask) + land_mask) !WHL - debug if (verbose_inversion .and. this_rank == rtest) then @@ -1897,11 +1896,11 @@ subroutine glissade_inversion_solve(model, & print*, ' ' print*, 'Inverting for bmlt_float: rank, i, j =', rtest, i, j print*, 'usrf (m), usrf_obs (m), bmlt_float_inversion (m/yr):', usrf_new_unscaled(i,j), & - model%geometry%usrf_obs(i,j)*thk0, model%basal_melt%bmlt_float_inversion(i,j)*scyr + model%geometry%usrf_obs(i,j)*thk0, model%inversion%bmlt_float_inversion(i,j)*scyr print*, ' ' endif - elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then + elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBE) then ! Prescribe the traction parameter powerlaw_c based on a previous inversion. ! Although powerlaw_c is prescribed, it may need to be modified, @@ -1909,7 +1908,7 @@ subroutine glissade_inversion_solve(model, & call prescribe_basal_traction(ewn, nsn, & itest, jtest, rtest, & - model%basal_physics, & + model%inversion, & ice_mask, & floating_mask, & land_mask, & @@ -1922,7 +1921,7 @@ subroutine glissade_inversion_solve(model, & call prescribe_bmlt_float(model%numerics%dt * tim0, & ! s ewn, nsn, & itest, jtest, rtest, & - model%basal_melt, & + model%inversion, & thck_new_unscaled, & ! m topg_unscaled, & ! m model%climate%eus*thk0, & ! m @@ -1938,8 +1937,8 @@ subroutine glissade_inversion_solve(model, & print*, ' ' print*, 'Prescribe bmlt_float: rank, i, j =', rtest, i, j print*, 'thck (m), bmltd_float_prescribed, bmlt_float_inversion (m/yr):', thck_unscaled(i,j), & - model%basal_melt%bmlt_float_prescribed(i,j)*scyr, & - model%basal_melt%bmlt_float_inversion(i,j)*scyr + model%inversion%bmlt_float_prescribed(i,j)*scyr, & + model%inversion%bmlt_float_inversion(i,j)*scyr print*, ' ' endif @@ -2839,7 +2838,7 @@ subroutine glissade_diagnostic_variable_solve(model) !WHL - inversion debug if ( (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & - model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) & + model%options%which_ho_inversion == HO_INVERSION_PRESCRIBE) & .and. verbose_inversion .and. model%numerics%tstep_count > 0 ) then !WHL - temporary debug - compute max diff in bmlt_applied @@ -2856,7 +2855,7 @@ subroutine glissade_diagnostic_variable_solve(model) ii = i; jj = j print*, ' ' print*, 'task, i, j, global_max_diff (m/yr):', this_rank, i, j, global_max_diff * scyr*thk0/tim0 - print*, 'bmlt_float_inversion:', model%basal_melt%bmlt_float_inversion(i,j) * scyr + print*, 'bmlt_float_inversion:', model%inversion%bmlt_float_inversion(i,j) * scyr print*, 'bmlt_applied old, new:', model%basal_melt%bmlt_applied_old(i,j) * scyr*thk0/tim0, & model%basal_melt%bmlt_applied(i,j) * scyr*thk0/tim0 call parallel_globalindex(i, j, iglobal, jglobal) diff --git a/libglissade/glissade_basal_traction.F90 b/libglissade/glissade_basal_traction.F90 index d8fdb593..c31c26b5 100644 --- a/libglissade/glissade_basal_traction.F90 +++ b/libglissade/glissade_basal_traction.F90 @@ -78,6 +78,7 @@ subroutine calcbeta (whichbabc, & land_mask, & f_ground, & which_ho_inversion, & + powerlaw_c_inversion, & itest, jtest, rtest) ! subroutine to calculate map of beta sliding parameter, based on @@ -126,6 +127,7 @@ subroutine calcbeta (whichbabc, & real(dp), intent(in), dimension(:,:), optional :: f_ground ! grounded ice fraction, 0 <= f_ground <= 1 integer, intent(in), optional :: which_ho_inversion ! basal inversion option + real(dp), intent(in), dimension(:,:), optional :: powerlaw_c_inversion ! Cp from inversion integer, intent(in), optional :: itest, jtest, rtest ! coordinates of diagnostic point ! Local variables @@ -380,7 +382,7 @@ subroutine calcbeta (whichbabc, & beta(:,:) = basal_physics%powerlaw_c * speed(:,:)**(1.0d0/basal_physics%powerlaw_m - 1.0d0) elseif (which_inversion == HO_INVERSION_COMPUTE .or. & - which_inversion == HO_INVERSION_PRESCRIBED) then ! use powerlaw_c from inversion + which_inversion == HO_INVERSION_PRESCRIBE) then ! use powerlaw_c from inversion m = basal_physics%powerlaw_m @@ -389,7 +391,7 @@ subroutine calcbeta (whichbabc, & ! stagger_margin_in = 1: Interpolate using only the values in ice-covered cells. call glissade_stagger(ewn, nsn, & - basal_physics%powerlaw_c_inversion, & + powerlaw_c_inversion, & stag_powerlaw_c_inversion, & ice_mask, & stagger_margin_in = 1) @@ -518,7 +520,7 @@ subroutine calcbeta (whichbabc, & enddo elseif (which_inversion == HO_INVERSION_COMPUTE .or. & - which_inversion == HO_INVERSION_PRESCRIBED) then ! use powerlaw_c and coulomb_c from inversion + which_inversion == HO_INVERSION_PRESCRIBE) then ! use powerlaw_c and coulomb_c from inversion m = basal_physics%powerlaw_m @@ -531,7 +533,7 @@ subroutine calcbeta (whichbabc, & endwhere call glissade_stagger(ewn, nsn, & - basal_physics%powerlaw_c_inversion, & + powerlaw_c_inversion, & stag_powerlaw_c_inversion, & ice_or_land_mask, & stagger_margin_in = 1) diff --git a/libglissade/glissade_inversion.F90 b/libglissade/glissade_inversion.F90 index 6b061a73..03360759 100644 --- a/libglissade/glissade_inversion.F90 +++ b/libglissade/glissade_inversion.F90 @@ -45,15 +45,6 @@ module glissade_inversion !! logical, parameter :: verbose_inversion = .false. logical, parameter :: verbose_inversion = .true. - !TODO - Make these config parameters? - !TODO - Initialize to powerlaw_c_land instead of powerlaw_c_max? - real(dp), parameter :: & - powerlaw_c_land = 20000.d0, & - powerlaw_c_marine = 1000.d0 - - real(dp), parameter :: & - bmlt_inversion_thck_buffer = 1.0d0 ! Ice is restored to this much above or below thck_flotation - !*********************************************************************** contains @@ -136,11 +127,11 @@ subroutine glissade_init_inversion(model) ! do i = 1, model%general%ewn ! if (model%geometry%thck_obs(i,j) > 0.0d0) then ! dthck = model%geometry%thck_obs(i,j)*thk0 - thck_flotation(i,j) ! difference (m) -! if (abs(dthck) < bmlt_inversion_thck_buffer) then +! if (abs(dthck) < inversion%bmlt_thck_buffer) then ! if (dthck > 0.0d0) then -! model%geometry%thck_obs(i,j) = (thck_flotation(i,j) + bmlt_inversion_thck_buffer) / thk0 +! model%geometry%thck_obs(i,j) = (thck_flotation(i,j) + inversion%bmlt_thck_buffer) / thk0 ! else -! model%geometry%thck_obs(i,j) = (thck_flotation(i,j) - bmlt_inversion_thck_buffer) / thk0 +! model%geometry%thck_obs(i,j) = (thck_flotation(i,j) - inversion%bmlt_thck_buffer) / thk0 ! endif ! endif ! endif @@ -154,7 +145,7 @@ subroutine glissade_init_inversion(model) ! where (model%geometry%thck_obs > 0.0d0) ! model%geometry%thck_obs = max(model%geometry%thck_obs, & -! model%numerics%thklim + bmlt_inversion_thck_buffer/thk0) +! model%numerics%thklim + inversion%bmlt_thck_buffer/thk0) ! endwhere endif ! var_maxval @@ -187,19 +178,19 @@ subroutine glissade_init_inversion(model) ! Check whether powerlaw_c_inversion has been read in already. ! If not, then set to a constant value. - var_maxval = maxval(model%basal_physics%powerlaw_c_inversion) + var_maxval = maxval(model%inversion%powerlaw_c_inversion) var_maxval = parallel_reduce_max(var_maxval) if (var_maxval > 0.0d0) then ! do nothing; powerlaw_c_inversion has been read in already (e.g., after restart) else ! setting to a large value so that basal flow starts slow and gradually speeds up as needed - model%basal_physics%powerlaw_c_inversion(:,:) = model%basal_physics%powerlaw_c_max -!! model%basal_physics%powerlaw_c_inversion(:,:) = model%basal_physics%powerlaw_c + model%inversion%powerlaw_c_inversion(:,:) = model%inversion%powerlaw_c_max +!! model%inversion%powerlaw_c_inversion(:,:) = model%inversion%powerlaw_c endif - call parallel_halo(model%basal_physics%powerlaw_c_inversion) + call parallel_halo(model%inversion%powerlaw_c_inversion) - elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBED) then + elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBE) then ! prescribing basal friction coefficient and basal melting from previous inversion @@ -211,7 +202,7 @@ subroutine glissade_init_inversion(model) ! copy it to the input file for the prescribed run. ! And similarly for bmlt_float_inversion and bmlt_float_prescribed - var_maxval = maxval(model%basal_physics%powerlaw_c_prescribed) + var_maxval = maxval(model%inversion%powerlaw_c_prescribed) var_maxval = parallel_reduce_max(var_maxval) if (var_maxval > 0.0d0) then ! powerlaw_c_prescribed has been read in as required @@ -222,9 +213,9 @@ subroutine glissade_init_inversion(model) call write_log(trim(message), GM_FATAL) endif - call parallel_halo(model%basal_physics%powerlaw_c_prescribed) + call parallel_halo(model%inversion%powerlaw_c_prescribed) - var_maxval = maxval(abs(model%basal_melt%bmlt_float_prescribed)) + var_maxval = maxval(abs(model%inversion%bmlt_float_prescribed)) var_maxval = parallel_reduce_max(var_maxval) if (var_maxval > 0.0d0) then ! bmlt_float_prescribed has been read in as required @@ -235,7 +226,7 @@ subroutine glissade_init_inversion(model) call write_log(trim(message), GM_FATAL) endif - call parallel_halo(model%basal_melt%bmlt_float_prescribed) + call parallel_halo(model%inversion%bmlt_float_prescribed) ! If not a restart, then initialize powerlaw_c_inversion and bmlt_float_inversion to presribed values. ! If a restart run, both fields typically are read from the restart file. @@ -248,27 +239,27 @@ subroutine glissade_init_inversion(model) ! (1) Ice is grounded in the forward run but powerlaw_c was not computed in the inversion run, or ! (2) Ice is floating in the forward run - var_maxval = maxval(abs(model%basal_physics%powerlaw_c_inversion)) + var_maxval = maxval(abs(model%inversion%powerlaw_c_inversion)) var_maxval = parallel_reduce_max(var_maxval) if (var_maxval > 0.0d0) then ! powerlaw_c_inversion has been read from a restart file; nothing to do here else ! initialize powerlaw_c_inversion - model%basal_physics%powerlaw_c_inversion(:,:) = model%basal_physics%powerlaw_c_prescribed(:,:) + model%inversion%powerlaw_c_inversion(:,:) = model%inversion%powerlaw_c_prescribed(:,:) endif - call parallel_halo(model%basal_physics%powerlaw_c_inversion) + call parallel_halo(model%inversion%powerlaw_c_inversion) - var_maxval = maxval(abs(model%basal_melt%bmlt_float_inversion)) + var_maxval = maxval(abs(model%inversion%bmlt_float_inversion)) var_maxval = parallel_reduce_max(var_maxval) if (var_maxval > 0.0d0) then ! bmlt_float_inversion has been read from a restart file; nothing to do here else ! initialize bmlt_float_inversion - model%basal_melt%bmlt_float_inversion(:,:) = model%basal_melt%bmlt_float_prescribed(:,:) + model%inversion%bmlt_float_inversion(:,:) = model%inversion%bmlt_float_prescribed(:,:) endif - call parallel_halo(model%basal_melt%bmlt_float_inversion) + call parallel_halo(model%inversion%bmlt_float_inversion) endif ! which_ho_inversion @@ -374,7 +365,7 @@ end subroutine invert_basal_topography subroutine invert_basal_traction(dt, & nx, ny, & itest, jtest, rtest, & - basal_physics, & + inversion, & ice_mask, & floating_mask, & land_mask, & @@ -398,8 +389,8 @@ subroutine invert_basal_traction(dt, & integer, intent(in) :: & itest, jtest, rtest ! coordinates of diagnostic point - type(glide_basal_physics), intent(inout) :: & - basal_physics ! basal physics object + type(glide_inversion), intent(inout) :: & + inversion ! inversion object integer, dimension(nx,ny), intent(in) :: & ice_mask, & ! = 1 where ice is present (thk > 0), else = 0 @@ -431,17 +422,17 @@ subroutine invert_basal_traction(dt, & integer :: i, j, ii, jj integer :: count - ! inversion parameters in basal_physics derived type: - ! * powerlaw_c_max = upper bound for powerlaw_c, Pa (m/yr)^(-1/3) - ! * powerlaw_c_min = lower bound for powerlaw_c, Pa (m/yr)^(-1/3) - ! * inversion_babc_timescale = inversion timescale (s); must be > 0 - ! * inversion_babc_thck_scale = thickness inversion scale (m); must be > 0 - ! * inversion_babc_dthck_dt_scale = dthck_dt inversion scale (m/s); must be > 0 - ! * inversion_babc_space_smoothing = factor for spatial smoothing of powerlaw_c_inversion; larger => more smoothing - ! * inversion_babc_time_smoothing = factor for exponential moving average of usrf_inversion and dthck_dt_inversion + ! parameters in inversion derived type: + ! * powerlaw_c_max = upper bound for powerlaw_c, Pa (m/yr)^(-1/3) + ! * powerlaw_c_min = lower bound for powerlaw_c, Pa (m/yr)^(-1/3) + ! * babc_timescale = inversion timescale (s); must be > 0 + ! * babc_thck_scale = thickness inversion scale (m); must be > 0 + ! * babc_dthck_dt_scale = dthck_dt inversion scale (m/s); must be > 0 + ! * babc_space_smoothing = factor for spatial smoothing of powerlaw_c_inversion; larger => more smoothing + ! * babc_time_smoothing = factor for exponential moving average of usrf_inversion and dthck_dt_inversion ! (used to adjust powerlaw_c_inversion; larger => more smoothing) ! - ! Note on inversion_babc_space_smoothing: A smoothing factor of 1/8 gives a 4-1-1-1-1 smoother. + ! Note on babc_space_smoothing: A smoothing factor of 1/8 gives a 4-1-1-1-1 smoother. ! This is numerically well behaved, but may oversmooth in bowl-shaped regions; ! a smaller value may be better as H converges toward H_obs. @@ -472,14 +463,14 @@ subroutine invert_basal_traction(dt, & do i = 1, nx if (powerlaw_c_inversion_mask(i,j) == 1) then ! ice is land-based, grounded or GL-adjacent - if (basal_physics%powerlaw_c_inversion(i,j) == 0.0d0) then + if (inversion%powerlaw_c_inversion(i,j) == 0.0d0) then ! set to a sensible default ! If on land, set to a typical land value ! If grounded marine ice, set to a smaller value if (land_mask(i,j) == 1) then - basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_land + inversion%powerlaw_c_inversion(i,j) = inversion%powerlaw_c_land else - basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_marine + inversion%powerlaw_c_inversion(i,j) = inversion%powerlaw_c_marine endif endif ! powerlaw_c_inversion = 0 @@ -487,7 +478,7 @@ subroutine invert_basal_traction(dt, & enddo ! i enddo ! j - call parallel_halo(basal_physics%powerlaw_c_inversion) + call parallel_halo(inversion%powerlaw_c_inversion) ! Loop over cells ! Note: powerlaw_c_inversion is computed at cell centers where usrf and thck are located. @@ -498,12 +489,11 @@ subroutine invert_basal_traction(dt, & if (powerlaw_c_inversion_mask(i,j) == 1) then ! ice is land-based, grounded or GL-adjacent ! Save the starting value - old_powerlaw_c(i,j) = basal_physics%powerlaw_c_inversion(i,j) + old_powerlaw_c(i,j) = inversion%powerlaw_c_inversion(i,j) ! Invert for powerlaw_c based on dthck and dthck_dt - !TODO - Change to basal_physics%inversion_babc_usrf_scale? - term1 = -dusrf(i,j) / basal_physics%inversion_babc_thck_scale - term2 = -dthck_dt(i,j) / basal_physics%inversion_babc_dthck_dt_scale + term1 = -dusrf(i,j) / inversion%babc_thck_scale + term2 = -dthck_dt(i,j) / inversion%babc_dthck_dt_scale !WHL - debug - Trying to turn off a potential unstable feedback: ! (1) dH/dt < 0, so Cp increases @@ -513,25 +503,25 @@ subroutine invert_basal_traction(dt, & term2 = min(term2, 1.0d0) term2 = max(term2, -1.0d0) - dpowerlaw_c(i,j) = (dt/basal_physics%inversion_babc_timescale) & - * basal_physics%powerlaw_c_inversion(i,j) * (term1 + term2) + dpowerlaw_c(i,j) = (dt/inversion%babc_timescale) & + * inversion%powerlaw_c_inversion(i,j) * (term1 + term2) ! Limit to prevent huge change in one step - if (abs(dpowerlaw_c(i,j)) > 0.05 * basal_physics%powerlaw_c_inversion(i,j)) then + if (abs(dpowerlaw_c(i,j)) > 0.05 * inversion%powerlaw_c_inversion(i,j)) then if (dpowerlaw_c(i,j) > 0.0d0) then - dpowerlaw_c(i,j) = 0.05d0 * basal_physics%powerlaw_c_inversion(i,j) + dpowerlaw_c(i,j) = 0.05d0 * inversion%powerlaw_c_inversion(i,j) else - dpowerlaw_c(i,j) = -0.05d0 * basal_physics%powerlaw_c_inversion(i,j) + dpowerlaw_c(i,j) = -0.05d0 * inversion%powerlaw_c_inversion(i,j) endif endif - basal_physics%powerlaw_c_inversion(i,j) = basal_physics%powerlaw_c_inversion(i,j) + dpowerlaw_c(i,j) + inversion%powerlaw_c_inversion(i,j) = inversion%powerlaw_c_inversion(i,j) + dpowerlaw_c(i,j) ! Limit to a physically reasonable range - basal_physics%powerlaw_c_inversion(i,j) = min(basal_physics%powerlaw_c_inversion(i,j), & - basal_physics%powerlaw_c_max) - basal_physics%powerlaw_c_inversion(i,j) = max(basal_physics%powerlaw_c_inversion(i,j), & - basal_physics%powerlaw_c_min) + inversion%powerlaw_c_inversion(i,j) = min(inversion%powerlaw_c_inversion(i,j), & + inversion%powerlaw_c_max) + inversion%powerlaw_c_inversion(i,j) = max(inversion%powerlaw_c_inversion(i,j), & + inversion%powerlaw_c_min) !WHL - debug if (verbose_inversion .and. this_rank == rtest .and. i==itest .and. j==jtest) then @@ -539,11 +529,9 @@ subroutine invert_basal_traction(dt, & print*, 'Invert for powerlaw_c and coulomb_c: rank, i, j =', rtest, itest, jtest print*, 'usrf, usrf_obs, dusrf, dthck_dt:', usrf(i,j), usrf_obs(i,j), dusrf(i,j), dthck_dt(i,j)*scyr print*, '-dusrf/usrf_scale, -dthck_dt/dthck_dt_scale, sum =', & -!! -dusrf(i,j)/basal_physics%inversion_babc_thck_scale, & -!! -dthck_dt(i,j)/basal_physics%inversion_babc_dthck_dt_scale, & term1, term2, & term1 + term2 - print*, 'dpowerlaw_c, newpowerlaw_c =', dpowerlaw_c(i,j), basal_physics%powerlaw_c_inversion(i,j) + print*, 'dpowerlaw_c, newpowerlaw_c =', dpowerlaw_c(i,j), inversion%powerlaw_c_inversion(i,j) endif else ! powerlaw_c_inversion_mask = 0 @@ -555,7 +543,7 @@ subroutine invert_basal_traction(dt, & ! the time-averaging routine will accumulate zero values as if they are real. ! Time-average fields should be used with caution. - basal_physics%powerlaw_c_inversion(i,j) = 0.0d0 + inversion%powerlaw_c_inversion(i,j) = 0.0d0 endif ! powerlaw_c_inversion_mask enddo ! i @@ -568,16 +556,16 @@ subroutine invert_basal_traction(dt, & print*, 'Before smoothing, powerlaw_c:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_inversion(i,j) + write(6,'(f10.2)',advance='no') inversion%powerlaw_c_inversion(i,j) enddo write(6,*) ' ' enddo endif - if (basal_physics%inversion_babc_space_smoothing > 0.0d0) then + if (inversion%babc_space_smoothing > 0.0d0) then ! Save the value just computed - temp_powerlaw_c(:,:) = basal_physics%powerlaw_c_inversion(:,:) + temp_powerlaw_c(:,:) = inversion%powerlaw_c_inversion(:,:) ! Apply Laplacian smoothing. ! Since powerlaw_c lives at cell centers but is interpolated to vertices, smoothing can damp checkerboard noise. @@ -586,16 +574,16 @@ subroutine invert_basal_traction(dt, & do i = 2, nx-1 if (powerlaw_c_inversion_mask(i,j) == 1) then ! ice is grounded or GL-adjacent - dpowerlaw_c_smooth = -4.0d0 * basal_physics%inversion_babc_space_smoothing * temp_powerlaw_c(i,j) + dpowerlaw_c_smooth = -4.0d0 * inversion%babc_space_smoothing * temp_powerlaw_c(i,j) do jj = j-1, j+1 do ii = i-1, i+1 if ((ii == i .or. jj == j) .and. (ii /= i .or. jj /= j)) then ! edge neighbor if (powerlaw_c_inversion_mask(ii,jj) == 1) then ! neighbor is grounded or GL-adjacent dpowerlaw_c_smooth = dpowerlaw_c_smooth & - + basal_physics%inversion_babc_space_smoothing*temp_powerlaw_c(ii,jj) + + inversion%babc_space_smoothing*temp_powerlaw_c(ii,jj) else dpowerlaw_c_smooth = dpowerlaw_c_smooth & - + basal_physics%inversion_babc_space_smoothing*temp_powerlaw_c(i,j) + + inversion%babc_space_smoothing*temp_powerlaw_c(i,j) endif endif enddo @@ -608,17 +596,17 @@ subroutine invert_basal_traction(dt, & if (dpowerlaw_c(i,j) > 0.0d0) then if (temp_powerlaw_c(i,j) + dpowerlaw_c_smooth > old_powerlaw_c(i,j)) then - basal_physics%powerlaw_c_inversion(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth + inversion%powerlaw_c_inversion(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth else ! allow the smoothing to hold Cp at its old value, but not reduce Cp - basal_physics%powerlaw_c_inversion(i,j) = old_powerlaw_c(i,j) + inversion%powerlaw_c_inversion(i,j) = old_powerlaw_c(i,j) endif elseif (dpowerlaw_c(i,j) < 0.0d0) then if (temp_powerlaw_c(i,j) + dpowerlaw_c_smooth < old_powerlaw_c(i,j)) then - basal_physics%powerlaw_c_inversion(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth + inversion%powerlaw_c_inversion(i,j) = temp_powerlaw_c(i,j) + dpowerlaw_c_smooth else ! allow the smoothing to hold Cp at its old value, but not increase Cp - basal_physics%powerlaw_c_inversion(i,j) = old_powerlaw_c(i,j) + inversion%powerlaw_c_inversion(i,j) = old_powerlaw_c(i,j) endif endif ! dpowerlaw_c > 0 @@ -628,7 +616,7 @@ subroutine invert_basal_traction(dt, & endif ! smoothing factor > 0 - call parallel_halo(basal_physics%powerlaw_c_inversion) + call parallel_halo(inversion%powerlaw_c_inversion) if (verbose_inversion .and. this_rank == rtest) then i = itest @@ -649,12 +637,12 @@ subroutine invert_basal_traction(dt, & enddo write(6,*) ' ' enddo - if (basal_physics%inversion_babc_space_smoothing > 0.0d0) then + if (inversion%babc_space_smoothing > 0.0d0) then print*, ' ' print*, 'After smoothing, powerlaw_c:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_inversion(i,j) + write(6,'(f10.2)',advance='no') inversion%powerlaw_c_inversion(i,j) enddo write(6,*) ' ' enddo @@ -667,7 +655,7 @@ end subroutine invert_basal_traction subroutine prescribe_basal_traction(nx, ny, & itest, jtest, rtest, & - basal_physics, & + inversion, & ice_mask, & floating_mask, & land_mask, & @@ -688,8 +676,8 @@ subroutine prescribe_basal_traction(nx, ny, & integer, intent(in) :: & itest, jtest, rtest ! coordinates of diagnostic point - type(glide_basal_physics), intent(inout) :: & - basal_physics ! basal physics object + type(glide_inversion), intent(inout) :: & + inversion ! inversion object integer, dimension(nx,ny), intent(in) :: & ice_mask, & ! = 1 where ice is present (thck > 0), else = 0 @@ -722,16 +710,16 @@ subroutine prescribe_basal_traction(nx, ny, & do i = 1, nx if (powerlaw_c_inversion_mask(i,j) == 1) then - if (basal_physics%powerlaw_c_prescribed(i,j) > 0.0d0) then ! use the prescribed value + if (inversion%powerlaw_c_prescribed(i,j) > 0.0d0) then ! use the prescribed value - basal_physics%powerlaw_c_inversion(i,j) = basal_physics%powerlaw_c_prescribed(i,j) + inversion%powerlaw_c_inversion(i,j) = inversion%powerlaw_c_prescribed(i,j) else ! assign a sensible default if (land_mask(i,j) == 1) then - basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_land + inversion%powerlaw_c_inversion(i,j) = inversion%powerlaw_c_land else - basal_physics%powerlaw_c_inversion(i,j) = powerlaw_c_marine + inversion%powerlaw_c_inversion(i,j) = inversion%powerlaw_c_marine endif endif ! powerlaw_c_prescribed > 0 @@ -740,7 +728,7 @@ subroutine prescribe_basal_traction(nx, ny, & enddo ! i enddo ! j - call parallel_halo(basal_physics%powerlaw_c_inversion) + call parallel_halo(inversion%powerlaw_c_inversion) if (verbose_inversion .and. this_rank == rtest) then i = itest @@ -757,7 +745,7 @@ subroutine prescribe_basal_traction(nx, ny, & print*, 'powerlaw_c_prescribed:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_prescribed(i,j) + write(6,'(f10.2)',advance='no') inversion%powerlaw_c_prescribed(i,j) enddo write(6,*) ' ' enddo @@ -765,7 +753,7 @@ subroutine prescribe_basal_traction(nx, ny, & print*, 'powerlaw_c_inversion:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.2)',advance='no') basal_physics%powerlaw_c_inversion(i,j) + write(6,'(f10.2)',advance='no') inversion%powerlaw_c_inversion(i,j) enddo write(6,*) ' ' enddo @@ -778,15 +766,14 @@ end subroutine prescribe_basal_traction subroutine invert_bmlt_float(dt, & nx, ny, & itest, jtest, rtest, & - basal_melt, & + inversion, & thck, & usrf_obs, & topg, & eus, & ice_mask, & floating_mask, & - land_mask, & - grounding_line_mask) + land_mask) ! Compute spatially varying bmlt_float by inversion. ! Apply a melt/freezing rate that will restore the ice in floating grid cells @@ -801,8 +788,8 @@ subroutine invert_bmlt_float(dt, & integer, intent(in) :: & itest, jtest, rtest ! coordinates of diagnostic point - type(glide_basal_melt), intent(inout) :: & - basal_melt ! basal melt object + type(glide_inversion), intent(inout) :: & + inversion ! inversion object ! Note: thck and usrf should be the expected values after applying the mass balance ! (although the mass balance may not yet have been applied) @@ -818,8 +805,7 @@ subroutine invert_bmlt_float(dt, & integer, dimension(nx,ny), intent(in) :: & ice_mask, & ! = 1 where ice is present, else = 0 floating_mask, & ! = 1 where ice is present and floating, else = 0 - land_mask, & ! = 1 where topg >= eus, else = 0 - grounding_line_mask ! = 1 if a cell is adjacent to the grounding line, else = 0 + land_mask ! = 1 where topg >= eus, else = 0 ! local variables @@ -839,7 +825,7 @@ subroutine invert_bmlt_float(dt, & real(dp), parameter :: inversion_bmlt_timescale = 0.0d0*scyr ! timescale for freezing in cavities (m/s) - ! For floating and grounding-line-adjacent cells, adjust the basal melt rate (or freezing rate, if bmlt < 0) + ! For floating cells, adjust the basal melt rate (or freezing rate, if bmlt < 0) ! so as to restore the upper surface to a target based on observations. ! Compute the flotation thickness @@ -856,45 +842,37 @@ subroutine invert_bmlt_float(dt, & thck_cavity = 0.0d0 endwhere - ! For floating cells and marine-based grounding-line cells, compute a target thickness - ! based on the target surface elevation. - ! Note: The grounding_line mask is computed before horizontal transport. - ! It includes grounded cells adjacent to at least one floating or ice-free ocean cell, - ! and floating cells adjacent to at least one grounded cell. + ! For floating and weakly grounded cells, compute a target thickness based on the target surface elevation. + ! Note: Cells with a floating target are always restored to that target. + ! Cells with a grounded target are restored to a thickness slightly greater than thck_flotation, + ! provided they are currently floating or weakly grounded. + ! These cells are not restored all the way to the grounded target. ! initialize bmlt_inversion_mask(:,:) = 0 thck_target(:,:) = 0.0d0 - basal_melt%bmlt_float_inversion(:,:) = 0.0d0 + inversion%bmlt_float_inversion(:,:) = 0.0d0 ! loop over cells do j = 1, ny do i = 1, nx - !TODO - Another case is the cell that has a floating target, is GL-adjacent, and now is strongly grounded. - ! Instead of restoring it all the way to obs with a large bmlt_float, we could restore it - ! only to thck_flotation - bmlt_inversion_thck_buffer if (land_mask(i,j) == 1) then ! do nothing; bmlt_float_inversion = 0 - !TODO - Remove grounding_line_mask -!! elseif (floating_mask(i,j) == 1) then -!! elseif ( floating_mask(i,j) == 1 .or. & -!! (ice_mask(i,j) == 1 .and. grounding_line_mask(i,j) == 1) ) then - elseif (usrf_obs(i,j) - (topg(i,j) - eus) > thck_flotation(i,j)) then ! grounded target ! If the ice is now floating or very weakly grounded (thck < thck_flotation + thck_buffer), ! then compute bmlt_float < 0 to restore to thck_flotation + thck_buffer. - if (thck(i,j) < thck_flotation(i,j) + bmlt_inversion_thck_buffer) then ! floating or very weakly grounded + if (thck(i,j) < thck_flotation(i,j) + inversion%bmlt_thck_buffer) then ! floating or very weakly grounded ! Restore to a thickness slightly greater than thck_flotation ! (generally not all the way to the observed thickness, since we would prefer ! for the basal traction inversion to achieve this by roughening the bed). bmlt_inversion_mask(i,j) = 1 - thck_target(i,j) = thck_flotation(i,j) + bmlt_inversion_thck_buffer + thck_target(i,j) = thck_flotation(i,j) + inversion%bmlt_thck_buffer else ! strongly grounded @@ -902,7 +880,7 @@ subroutine invert_bmlt_float(dt, & endif - elseif (usrf_obs(i,j) > 0.0d0) then ! floating target + elseif (usrf_obs(i,j) > 0.0d0) then ! floating target ! Note: With usrf_obs > 0 requirement, we do not melt columns that are ice-free in observations. ! This allows the calving front to advance (if not using a no-advance calving mask). @@ -912,13 +890,8 @@ subroutine invert_bmlt_float(dt, & endif - !WHL - debug - to prevent bmlt_float_inversion < 0 -!! if (thck_target(i,j) > thck(i,j) .and. grounding_line_mask(i,j) == 0) then -!! thck_target(i,j) = thck(i,j) -!! endif - if (bmlt_inversion_mask(i,j) == 1) then - basal_melt%bmlt_float_inversion(i,j) = (thck(i,j) - thck_target(i,j)) / dt + inversion%bmlt_float_inversion(i,j) = (thck(i,j) - thck_target(i,j)) / dt !WHL - debug if (verbose_inversion .and. this_rank == rtest .and. i==itest .and. j==jtest) then @@ -926,7 +899,7 @@ subroutine invert_bmlt_float(dt, & print*, 'Invert for bmlt_float_inversion: rank, i, j =', rtest, itest, jtest print*, 'topg - eus, usrf_obs:', topg(i,j) - eus, usrf_obs(i,j) print*, 'thck, thck_target, bmlt_float:', & - thck(i,j), thck_target(i,j), basal_melt%bmlt_float_inversion(i,j)*dt + thck(i,j), thck_target(i,j), inversion%bmlt_float_inversion(i,j)*dt endif endif ! bmlt_inversion_mask = 1 @@ -940,13 +913,13 @@ subroutine invert_bmlt_float(dt, & if (inversion_bmlt_timescale > 0.0d0) then bmlt_factor = min(dt/inversion_bmlt_timescale, 1.0d0) - basal_melt%bmlt_float_inversion(:,:) = basal_melt%bmlt_float_inversion(:,:) * bmlt_factor + inversion%bmlt_float_inversion(:,:) = inversion%bmlt_float_inversion(:,:) * bmlt_factor endif call parallel_halo(bmlt_inversion_mask) ! diagnostic only call parallel_halo(thck_target) ! diagnostic only - call parallel_halo(basal_melt%bmlt_float_inversion) + call parallel_halo(inversion%bmlt_float_inversion) !WHL - debug if (verbose_inversion .and. this_rank == rtest) then @@ -961,14 +934,6 @@ subroutine invert_bmlt_float(dt, & write(6,*) ' ' enddo print*, ' ' - print*, 'grounding_line_mask:' - do j = jtest+3, jtest-3, -1 - do i = itest-3, itest+3 - write(6,'(i10)',advance='no') grounding_line_mask(i,j) - enddo - write(6,*) ' ' - enddo - print*, ' ' print*, 'floating_mask:' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 @@ -1012,7 +977,7 @@ subroutine invert_bmlt_float(dt, & print*, 'bmlt_float_inversion (m/yr):' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') basal_melt%bmlt_float_inversion(i,j)*scyr + write(6,'(f10.3)',advance='no') inversion%bmlt_float_inversion(i,j)*scyr enddo write(6,*) ' ' enddo @@ -1025,7 +990,7 @@ end subroutine invert_bmlt_float subroutine prescribe_bmlt_float(dt, & nx, ny, & itest, jtest, rtest, & - basal_melt, & + inversion, & thck, & topg, & eus, & @@ -1046,8 +1011,8 @@ subroutine prescribe_bmlt_float(dt, & integer, intent(in) :: & itest, jtest, rtest ! coordinates of diagnostic point - type(glide_basal_melt), intent(inout) :: & - basal_melt ! basal melt object + type(glide_inversion), intent(inout) :: & + inversion ! inversion object ! Note: thck should be the expected values after applying the mass balance ! (although the mass balance may not yet have been applied) @@ -1106,7 +1071,7 @@ subroutine prescribe_bmlt_float(dt, & ! But this mask is included for generality, in case of dynamic topography. bmlt_inversion_mask(:,:) = 0 - basal_melt%bmlt_float_inversion(:,:) = 0.0d0 + inversion%bmlt_float_inversion(:,:) = 0.0d0 thck_final(:,:) = 0.0d0 do j = 1, ny @@ -1119,15 +1084,15 @@ subroutine prescribe_bmlt_float(dt, & (ice_mask(i,j) == 1 .and. grounding_line_mask(i,j) == 1) ) then bmlt_inversion_mask(i,j) = 1 - basal_melt%bmlt_float_inversion(i,j) = basal_melt%bmlt_float_prescribed(i,j) + inversion%bmlt_float_inversion(i,j) = inversion%bmlt_float_prescribed(i,j) ! Make sure the final thickness is non-negative. - thck_final(i,j) = thck(i,j) - basal_melt%bmlt_float_inversion(i,j)*dt + thck_final(i,j) = thck(i,j) - inversion%bmlt_float_inversion(i,j)*dt if (thck_final(i,j) < 0.0d0) then thck_final(i,j) = 0.0d0 - basal_melt%bmlt_float_inversion(i,j) = (thck(i,j) - thck_final(i,j)) / dt + inversion%bmlt_float_inversion(i,j) = (thck(i,j) - thck_final(i,j)) / dt endif !WHL - debug @@ -1135,7 +1100,7 @@ subroutine prescribe_bmlt_float(dt, & print*, ' ' print*, 'Prescribe bmlt_float_inversion: rank, i, j =', rtest, itest, jtest print*, 'thck, thck_final, bmlt_float_inversion*dt:', thck(i,j), thck_final(i,j), & - basal_melt%bmlt_float_inversion(i,j)*dt + inversion%bmlt_float_inversion(i,j)*dt endif endif ! masks @@ -1150,7 +1115,7 @@ subroutine prescribe_bmlt_float(dt, & print*, 'bmlt_float_prescribed (m/yr):' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') basal_melt%bmlt_float_prescribed(i,j)*scyr + write(6,'(f10.3)',advance='no') inversion%bmlt_float_prescribed(i,j)*scyr enddo write(6,*) ' ' enddo @@ -1214,7 +1179,7 @@ subroutine prescribe_bmlt_float(dt, & print*, 'bmlt_float_inversion (m/yr):' do j = jtest+3, jtest-3, -1 do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') basal_melt%bmlt_float_inversion(i,j)*scyr + write(6,'(f10.3)',advance='no') inversion%bmlt_float_inversion(i,j)*scyr enddo write(6,*) ' ' enddo diff --git a/libglissade/glissade_velo_higher.F90 b/libglissade/glissade_velo_higher.F90 index 4bc3ec3b..8b6a482b 100644 --- a/libglissade/glissade_velo_higher.F90 +++ b/libglissade/glissade_velo_higher.F90 @@ -755,6 +755,9 @@ subroutine glissade_velo_higher_solve(model, & tau_xx, tau_yy, tau_xy, &! horizontal components of stress tensor (Pa) tau_eff ! effective stress (Pa) + real(dp), dimension(:,:), pointer :: & + powerlaw_c_inversion ! Cp (for basal traction) computed from inversion + integer, dimension(:,:), pointer :: & kinbcmask, &! = 1 at vertices where u and v are prescribed from input data (Dirichlet BC), = 0 elsewhere umask_no_penetration, &! = 1 at vertices along east/west global boundary where uvel = 0, = 0 elsewhere @@ -1067,6 +1070,8 @@ subroutine glissade_velo_higher_solve(model, & tau_xy => model%stress%tau%xy(:,:,:) tau_eff => model%stress%tau%scalar(:,:,:) + powerlaw_c_inversion => model%inversion%powerlaw_c_inversion(:,:) + kinbcmask => model%velocity%kinbcmask(:,:) umask_no_penetration => model%velocity%umask_no_penetration(:,:) vmask_no_penetration => model%velocity%vmask_no_penetration(:,:) @@ -2565,6 +2570,7 @@ subroutine glissade_velo_higher_solve(model, & land_mask, & f_ground, & whichinversion, & + powerlaw_c_inversion, & itest, jtest, rtest) if (verbose_beta) then From 8f5a8cb3df44af57759d4537c80ad131e32f152c Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Fri, 4 May 2018 10:55:10 -0600 Subject: [PATCH 31/61] Simplified the calving interfaces The interface for subroutine glissade_calve_ice now includes the object model%calving, which reduces the number of arguments that need to be passed in and out. Also, I removed the direct call to glissade_calve_ice at initialization. Instead, there is a call to glissade_calving_solve (with an init_calving flag to handle calculations that differ at initialization), which calls glissade_calve_ice. Some variables in the calving derived type have been renamed to avoid redundant 'calving' in the name. This commit is BFB. A new configure is required because of changes in glide_vars.def. --- libglide/glide_setup.F90 | 28 +-- libglide/glide_types.F90 | 65 +++--- libglide/glide_vars.def | 4 +- libglissade/glissade.F90 | 111 +++------- libglissade/glissade_calving.F90 | 335 +++++++++++++------------------ 5 files changed, 219 insertions(+), 324 deletions(-) diff --git a/libglide/glide_setup.F90 b/libglide/glide_setup.F90 index 62eaa845..c169e6e9 100644 --- a/libglide/glide_setup.F90 +++ b/libglide/glide_setup.F90 @@ -189,8 +189,8 @@ subroutine glide_scale_params(model) ! scale calving parameters model%calving%marine_limit = model%calving%marine_limit / thk0 - model%calving%calving_minthck = model%calving%calving_minthck / thk0 - model%calving%calving_timescale = model%calving%calving_timescale * scyr / tim0 + model%calving%minthck = model%calving%minthck / thk0 + model%calving%timescale = model%calving%timescale * scyr / tim0 model%calving%cliff_timescale = model%calving%cliff_timescale * scyr / tim0 ! scale periodic offsets for ISMIP-HOM @@ -1155,7 +1155,7 @@ subroutine print_options(model) write(message,*) 'WARNING: calving domain can be selected for Glissade dycore only; user selection ignored' call write_log(message, GM_WARNING) endif - if (model%calving%calving_timescale > 0.0d0) then + if (model%calving%timescale > 0.0d0) then write(message,*) 'WARNING: calving timescale option suppored for Glissade dycore only; user selection ignored' call write_log(message, GM_WARNING) endif @@ -1569,14 +1569,15 @@ subroutine handle_parameters(section, model) ! calving parameters call GetValue(section,'marine_limit', model%calving%marine_limit) call GetValue(section,'calving_fraction', model%calving%calving_fraction) - call GetValue(section,'calving_minthck', model%calving%calving_minthck) + call GetValue(section,'calving_minthck', model%calving%minthck) + call GetValue(section,'lateral_rate_max', model%calving%lateral_rate_max) call GetValue(section,'eigencalving_constant', model%calving%eigencalving_constant) call GetValue(section,'eigen2_weight', model%calving%eigen2_weight) call GetValue(section,'damage_constant', model%calving%damage_constant) call GetValue(section,'taumax_cliff', model%calving%taumax_cliff) call GetValue(section,'cliff_timescale', model%calving%cliff_timescale) call GetValue(section,'ncull_calving_front', model%calving%ncull_calving_front) - call GetValue(section,'calving_timescale', model%calving%calving_timescale) + call GetValue(section,'calving_timescale', model%calving%timescale) call GetValue(section,'calving_front_x', model%calving%calving_front_x) call GetValue(section,'calving_front_y', model%calving%calving_front_y) call GetValue(section,'damage_threshold', model%calving%damage_threshold) @@ -1743,7 +1744,7 @@ subroutine print_parameters(model) if (model%options%whichcalving == CALVING_THCK_THRESHOLD .or. & model%options%whichcalving == EIGENCALVING .or. & model%options%whichcalving == CALVING_DAMAGE) then - write(message,*) 'calving thickness limit (m) : ', model%calving%calving_minthck + write(message,*) 'calving thickness limit (m) : ', model%calving%minthck call write_log(message) endif @@ -1755,6 +1756,10 @@ subroutine print_parameters(model) elseif (model%options%whichcalving == CALVING_DAMAGE) then write(message,*) 'damage constant (yr^-1) : ', model%calving%damage_constant call write_log(message) + write(message,*) 'damage threshold : ', model%calving%damage_threshold + call write_log(message) + write(message,*) 'max lateral calving rate (m/yr) : ', model%calving%lateral_rate_max + call write_log(message) endif if (model%options%whichcalving == CALVING_THCK_THRESHOLD .or. & @@ -1768,7 +1773,7 @@ subroutine print_parameters(model) call write_log(message) endif - if (model%calving%calving_timescale <= 0.0d0) then + if (model%calving%timescale <= 0.0d0) then write(message,*) 'Must set calving_timescale to a positive nonzero value for this calving option' call write_log(message, GM_FATAL) endif @@ -1801,13 +1806,8 @@ subroutine print_parameters(model) endif endif - if (model%options%whichcalving == CALVING_DAMAGE) then - write(message,*) 'calving damage threshold : ', model%calving%damage_threshold - call write_log(message) - end if - - if (model%calving%calving_timescale > 0.0d0) then - write(message,*) 'calving time scale (yr) : ', model%calving%calving_timescale + if (model%calving%timescale > 0.0d0) then + write(message,*) 'calving time scale (yr) : ', model%calving%timescale call write_log(message) endif diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index b3e50951..6886ba68 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -1115,36 +1115,37 @@ module glide_types real(dp),dimension(:,:), pointer :: calving_thck => null() !> thickness loss in grid cell due to calving !> scaled by thk0 like mass balance, thickness, etc. integer, dimension(:,:), pointer :: calving_mask => null() !> calve floating ice wherever the mask = 1 (whichcalving = CALVING_GRID_MASK) - real(dp),dimension(:,:), pointer :: calving_lateral => null()!> lateral calving rate (m/yr, not scaled) - ! (whichcalving = EIGENCALVING, CALVING_DAMAGE) - real(dp),dimension(:,:), pointer :: tau_eigen1 !> first eigenvalue of 2D horizontal stress tensor (Pa) - real(dp),dimension(:,:), pointer :: tau_eigen2 !> second eigenvalue of 2D horizontal stress tensor (Pa) - real(dp),dimension(:,:), pointer :: tau_eff_calving !> effective stress (Pa) for calving; derived from tau_eigen1, tau_eigen2 + real(dp),dimension(:,:), pointer :: lateral_rate => null() !> lateral calving rate (m/yr, not scaled) + !> (whichcalving = EIGENCALVING, CALVING_DAMAGE) + real(dp),dimension(:,:), pointer :: tau_eigen1 => null() !> first eigenvalue of 2D horizontal stress tensor (Pa) + real(dp),dimension(:,:), pointer :: tau_eigen2 => null() !> second eigenvalue of 2D horizontal stress tensor (Pa) + real(dp),dimension(:,:), pointer :: tau_eff => null() !> effective stress (Pa) for calving; derived from tau_eigen1, tau_eigen2 real(dp),dimension(:,:,:),pointer :: damage => null() !> 3D damage tracer, 0 > damage < 1 (whichcalving = CALVING_DAMAGE) - real(dp) :: marine_limit = -200.d0 !> minimum value of topg/relx before floating ice calves - !> (whichcalving = CALVING_RELX_THRESHOLD, CALVING_TOPG_THRESHOLD) - real(dp) :: calving_fraction = 0.2d0 !> fractional thickness of floating ice that calves - !> (whichcalving = CALVING_FLOAT_FRACTION) - !> WHL - previously defined as the fraction of floating ice that does not calve - real(dp) :: calving_timescale = 0.0d0 !> time scale (yr) for calving (Glissade only); calving_thck = thck * max(dt/calving_timescale, 1) - !> if calving_timescale = 0, then calving_thck = thck - real(dp) :: calving_minthck = 100.d0 !> minimum thickness (m) of floating ice at marine edge before it calves - !> (whichcalving = CALVING_THCK_THRESHOLD or EIGENCALVING) + real(dp) :: marine_limit = -200.d0 !> minimum value of topg/relx before floating ice calves + !> (whichcalving = CALVING_RELX_THRESHOLD, CALVING_TOPG_THRESHOLD) + real(dp) :: calving_fraction = 0.2d0 !> fractional thickness of floating ice that calves + !> (whichcalving = CALVING_FLOAT_FRACTION) + !> WHL - previously defined as the fraction of floating ice that does not calve + real(dp) :: timescale = 0.0d0 !> timescale (yr) for calving (Glissade only); calving_thck = thck*max(dt/calving_timescale,1) + !> if calving_timescale = 0, then the full column calves at once + real(dp) :: minthck = 100.d0 !> minimum thickness (m) of floating ice at marine edge before it calves + !> (whichcalving = CALVING_THCK_THRESHOLD or EIGENCALVING) real(dp) :: eigencalving_constant = 0.01d0 !> eigencalving constant, lateral calving rate (m/yr) per unit stress (Pa) !> (whichcalving = EIGENCALVING) - real(dp) :: eigen2_weight = 1.0d0 !> weight given to tau_eigen2 relative to tau_eigen1 in tau_eff_calving (unitless) - real(dp) :: damage_constant = 1.0d-7 !> damage constant; rate of change of damage (1/yr) per unit stress (Pa) - !> (whichcalving = CALVING_DAMAGE) - integer :: ncull_calving_front = 0 !> number of times to cull calving_front cells at initialization - !> Set to a larger value to remove thicker peninsulas - real(dp) :: taumax_cliff = 1.0d6 !> yield stress (Pa) for marine-based ice cliffs - real(dp) :: cliff_timescale = 0.0d0 !> time scale (yr) for limiting marine cliffs (yr) (Glissade only) - real(dp) :: calving_front_x = 0.d0 !> for CALVING_GRID_MASK option, calve ice wherever abs(x) > calving_front_x (m) - real(dp) :: calving_front_y = 0.d0 !> for CALVING_GRID_MASK option, calve ice wherever abs(y) > calving_front_y (m) - !> NOTE: This option is applied only if calving_front_x or calving_front_y > 0 - real(dp) :: damage_threshold = 0.75d0 !> threshold at which ice column is deemed sufficiently damaged to calve - !> assuming that 0 = no damage, 1 = total damage + real(dp) :: eigen2_weight = 1.0d0 !> weight given to tau_eigen2 relative to tau_eigen1 in tau_eff (unitless) + real(dp) :: damage_constant = 1.0d-7 !> damage constant; rate of change of damage (1/yr) per unit stress (Pa) + !> (whichcalving = CALVING_DAMAGE) + real(dp) :: damage_threshold = 0.75d0 !> threshold at which ice column is deemed sufficiently damaged to calve + !> assuming that 0 = no damage, 1 = total damage (whichcalving = CALVING_DAMAGE) + real(dp) :: lateral_rate_max = 3000.d0 !> max lateral calving rate (m/yr) for damaged ice (whichcalving = CALVING_DAMAGE) + integer :: ncull_calving_front = 0 !> number of times to cull calving_front cells at initialization, if cull_calving_front = T + !> Set to a larger value to remove wider peninsulas + real(dp) :: taumax_cliff = 1.0d6 !> yield stress (Pa) for marine-based ice cliffs + real(dp) :: cliff_timescale = 0.0d0 !> time scale (yr) for limiting marine cliffs (yr) + real(dp) :: calving_front_x = 0.0d0 !> for CALVING_GRID_MASK option, calve ice wherever abs(x) > calving_front_x (m) + real(dp) :: calving_front_y = 0.0d0 !> for CALVING_GRID_MASK option, calve ice wherever abs(y) > calving_front_y (m) + !> NOTE: This option is applied only if calving_front_x or calving_front_y > 0 end type glide_calving @@ -2289,10 +2290,10 @@ subroutine glide_allocarr(model) ! calving arrays call coordsystem_allocate(model%general%ice_grid, model%calving%calving_thck) call coordsystem_allocate(model%general%ice_grid, model%calving%calving_mask) - call coordsystem_allocate(model%general%ice_grid, model%calving%calving_lateral) + call coordsystem_allocate(model%general%ice_grid, model%calving%lateral_rate) call coordsystem_allocate(model%general%ice_grid, model%calving%tau_eigen1) call coordsystem_allocate(model%general%ice_grid, model%calving%tau_eigen2) - call coordsystem_allocate(model%general%ice_grid, model%calving%tau_eff_calving) + call coordsystem_allocate(model%general%ice_grid, model%calving%tau_eff) if (model%options%whichcalving == CALVING_DAMAGE) then call coordsystem_allocate(model%general%ice_grid, upn-1, model%calving%damage) else @@ -2778,14 +2779,14 @@ subroutine glide_deallocarr(model) deallocate(model%calving%calving_thck) if (associated(model%calving%calving_mask)) & deallocate(model%calving%calving_mask) - if (associated(model%calving%calving_lateral)) & - deallocate(model%calving%calving_lateral) + if (associated(model%calving%lateral_rate)) & + deallocate(model%calving%lateral_rate) if (associated(model%calving%tau_eigen1)) & deallocate(model%calving%tau_eigen1) if (associated(model%calving%tau_eigen2)) & deallocate(model%calving%tau_eigen2) - if (associated(model%calving%tau_eff_calving)) & - deallocate(model%calving%tau_eff_calving) + if (associated(model%calving%tau_eff)) & + deallocate(model%calving%tau_eff) if (associated(model%calving%damage)) & deallocate(model%calving%damage) diff --git a/libglide/glide_vars.def b/libglide/glide_vars.def index 29326528..f9780f58 100644 --- a/libglide/glide_vars.def +++ b/libglide/glide_vars.def @@ -544,7 +544,7 @@ coordinates: lon lat dimensions: time, y1, x1 units: meter/year long_name: lateral calving rate -data: data%calving%calving_lateral +data: data%calving%lateral_rate coordinates: lon lat [damage] @@ -1205,7 +1205,7 @@ load: 1 dimensions: time, y1, x1 units: Pa long_name: effective stress for calving -data: data%calving%tau_eff_calving +data: data%calving%tau_eff [wvel] dimensions: time, level, y1, x1 diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index f78da6c3..74d2f60c 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -525,61 +525,18 @@ subroutine glissade_initialise(model, evolve_ice) model%options%is_restart == RESTART_FALSE) then ! ------------------------------------------------------------------------ - ! Remove ice that should calve, depending on the value of whichcalving. - !TODO - Make sure we have done the necessary halo updates before calving - ! Note: This initial call includes the optional cull_calving_front argument, - ! which if true can remove floating peninsulas in the input data by - ! preceding the call to remove_icebergs with removal of one or more - ! layers of calving_front cells. + ! Note: The initial calving solve is treated differently from the runtime calving solve. + ! In particular, calving-front culling is done at initialization only. ! Culling may also be used to remove a row of thin cells (~1 m) ! at the calving front, as present in some input data sets. - ! The call to calving during glissade_tstep does not include this argument, - ! since we do not want to remove calving_front cells every timestep. - ! ------------------------------------------------------------------------ - - call glissade_calve_ice(model%options%whichcalving, & - model%options%calving_domain, & - model%options%which_ho_calving_front, & - model%options%remove_icebergs, & - model%options%limit_marine_cliffs, & - itest, jtest, rtest, & - model%geometry%thck, & - model%isostasy%relx, & - model%geometry%topg, & - model%climate%eus, & - model%numerics%thklim, & - model%calving%marine_limit, & - model%calving%calving_fraction, & - model%calving%calving_timescale, & - model%numerics%dt, & - model%numerics%dew*len0, & ! m - model%numerics%dns*len0, & ! m - model%calving%eigencalving_constant, & ! m/yr/Pa - model%calving%eigen2_weight, & - model%calving%tau_eigen1, & ! Pa - model%calving%tau_eigen2, & ! Pa - model%calving%tau_eff_calving, & ! Pa - model%calving%calving_minthck, & - model%calving%taumax_cliff, & - model%calving%cliff_timescale, & - model%calving%calving_mask, & - model%calving%damage, & - model%calving%damage_constant, & - model%calving%damage_threshold, & - model%numerics%sigma, & - model%calving%calving_lateral, & - model%calving%calving_thck, & - cull_calving_front_in = model%options%cull_calving_front, & - ncull_calving_front_in = model%calving%ncull_calving_front) - - !TODO: Think about what halo updates are needed after calving. Just thck and thkmask? - - ! halo updates - call parallel_halo(model%geometry%thck) ! Updated halo values of thck are needed below in calclsrf + ! But we do not want to remove calving_front cells every timestep. + ! ------------------------------------------------------------------------ + + call glissade_calving_solve(model, .true.) ! init_calving = .true. ! The mask needs to be recalculated after calving. ! Note: glide_set_mask includes a halo update for thkmask. - !TODO - Delete this call? Replace with glissade masks? + !TODO - Delete this call? Glissade dycore does not use thkmask. call glide_set_mask(model%numerics, & model%geometry%thck, model%geometry%topg, & model%general%ewn, model%general%nsn, & @@ -589,7 +546,7 @@ subroutine glissade_initialise(model, evolve_ice) endif ! initial calving ! Initialize the no-advance calving_mask, if desired - ! Note: This is done after initial calving, which may include iceberg removal or front culling. + ! Note: This is done after initial calving, which may include iceberg removal or calving-front culling. ! The calving front that exists after initial culling is the one that is held fixed during the simulation. ! Note: calving_front_x and calving_front_y already have units of m, so do not require multiplying by len0. @@ -778,7 +735,7 @@ subroutine glissade_tstep(model, time) ! Calculate iceberg calving ! ------------------------------------------------------------------------ - call glissade_calving_solve(model) + call glissade_calving_solve(model, .false.) ! init_calving = .false. ! ------------------------------------------------------------------------ ! Clean up variables in ice-free columns. @@ -1948,7 +1905,7 @@ end subroutine glissade_inversion_solve !======================================================================= - subroutine glissade_calving_solve(model) + subroutine glissade_calving_solve(model, init_calving) ! ------------------------------------------------------------------------ ! Calculate iceberg calving @@ -1964,19 +1921,22 @@ subroutine glissade_calving_solve(model) type(glide_global_type), intent(inout) :: model ! model instance + logical, intent(in) :: init_calving ! true when this subroutine is called at initialization + ! --- Local variables --- + logical :: cull_calving_front ! true iff init_calving = T and options%cull_calving_front = T + integer :: i, j - ! --- Calculate updated mask because calving calculation needs a mask. - !TODO - Remove this call when using glissade_calve_ice, which does not use the Glide mask? + !TODO - Make sure no additional halo updates are needed before glissade_calve_ice - call glide_set_mask(model%numerics, & - model%geometry%thck, model%geometry%topg, & - model%general%ewn, model%general%nsn, & - model%climate%eus, model%geometry%thkmask) - - !TODO - Make sure no more halo updates are needed before glissade_calve_ice + ! Determine whether the calving front should be culled + if (init_calving .and. model%options%cull_calving_front) then + cull_calving_front = .true. + else + cull_calving_front = .false. + endif ! ------------------------------------------------------------------------ ! Calve ice, based on the value of whichcalving @@ -1989,34 +1949,19 @@ subroutine glissade_calving_solve(model) model%options%which_ho_calving_front, & model%options%remove_icebergs, & model%options%limit_marine_cliffs, & + cull_calving_front, & + model%calving, & model%numerics%idiag_local, model%numerics%jdiag_local, & model%numerics%rdiag_local, & - model%geometry%thck, & - model%isostasy%relx, & - model%geometry%topg, & - model%climate%eus, & - model%numerics%thklim, & - model%calving%marine_limit, & - model%calving%calving_fraction, & - model%calving%calving_timescale, & model%numerics%dt, & model%numerics%dew*len0, & ! m model%numerics%dns*len0, & ! m - model%calving%eigencalving_constant, & ! m/yr/Pa - model%calving%eigen2_weight, & - model%calving%tau_eigen1, & ! Pa - model%calving%tau_eigen2, & ! Pa - model%calving%tau_eff_calving, & ! Pa - model%calving%calving_minthck, & - model%calving%taumax_cliff, & - model%calving%cliff_timescale, & - model%calving%calving_mask, & - model%calving%damage, & - model%calving%damage_constant, & - model%calving%damage_threshold, & model%numerics%sigma, & - model%calving%calving_lateral, & - model%calving%calving_thck) + model%numerics%thklim, & + model%geometry%thck, & + model%isostasy%relx, & + model%geometry%topg, & + model%climate%eus) !TODO: Are any other halo updates needed after calving? ! halo updates diff --git a/libglissade/glissade_calving.F90 b/libglissade/glissade_calving.F90 index de8680f4..e0a5a039 100644 --- a/libglissade/glissade_calving.F90 +++ b/libglissade/glissade_calving.F90 @@ -47,9 +47,6 @@ module glissade_calving !! logical, parameter :: verbose_calving = .false. logical, parameter :: verbose_calving = .true. - !TODO - Move these constants to glide_types - real(dp), parameter :: calving_lateral_max = 3000.d0 ! max lateral calving rate (m/yr) - contains !------------------------------------------------------------------------------- @@ -202,31 +199,15 @@ subroutine glissade_calve_ice(which_calving, & which_ho_calving_front, & remove_icebergs, & limit_marine_cliffs, & + cull_calving_front, & + calving, & ! calving derived type itest, jtest, rtest, & - thck, relx, & - topg, eus, & - thklim, & - marine_limit, & - calving_fraction, & - calving_timescale, & dt, & dx, dy, & - eigencalving_constant, & - eigen2_weight, & - tau_eigen1, tau_eigen2, & - tau_eff_calving, & - calving_minthck, & - taumax_cliff, & - cliff_timescale, & - calving_mask, & - damage, & - damage_constant, & - damage_threshold, & sigma, & - calving_lateral, & - calving_thck, & - cull_calving_front_in, & - ncull_calving_front_in) + thklim, & + thck, relx, & + topg, eus) ! Calve ice according to one of several methods @@ -235,67 +216,66 @@ subroutine glissade_calve_ice(which_calving, & implicit none !TODO - Convert input/output arguments to SI units - !TODO - Shorten the argument list by passing in a calving derived type + ! TODO - Remove thickness scaling from this subroutine. Would need to multiply several input arguments by thk0. + !--------------------------------------------------------------------- ! Subroutine arguments - ! Currently, thck, relx, topg, eus, marine_limit, calving_minthck and calving_thck are scaled by thk0 - ! TODO - Remove thickness scaling from this subroutine. Would need to multiply several input arguments by thk0. + ! Currently, thck, relx, topg, eus, marine_limit, calving%minthck and calving_thck are scaled by thk0 !--------------------------------------------------------------------- - integer, intent(in) :: which_calving !> option for calving law - integer, intent(in) :: calving_domain !> option for where calving can occur - !> = 0 if calving occurs at the ocean edge only - !> = 1 if calving occurs everywhere the calving criterion is met - !> = 2 if calving occurs where criterion is met and there is a connected path - !> to the ocean through other cells where the criterion is met - integer, intent(in) :: which_ho_calving_front !> = 1 for subgrid calving-front scheme, else = 0 - logical, intent(in) :: remove_icebergs !> if true, then remove icebergs after calving - logical, intent(in) :: limit_marine_cliffs !> if true, then limit the thickness of marine-based ice cliffs - integer, intent(in) :: itest, jtest, rtest !> coordinates of diagnostic point - + integer, intent(in) :: which_calving !> option for calving law + integer, intent(in) :: calving_domain !> option for where calving can occur + !> = 0 if calving occurs at the ocean edge only + !> = 1 if calving occurs everywhere the calving criterion is met + !> = 2 if calving occurs where criterion is met and there is a connected path + !> to the ocean through other cells where the criterion is met + integer, intent(in) :: which_ho_calving_front !> = 1 for subgrid calving-front scheme, else = 0 + logical, intent(in) :: remove_icebergs !> if true, then remove icebergs after calving + logical, intent(in) :: limit_marine_cliffs !> if true, then limit the thickness of marine-based ice cliffs + logical, intent(in) :: cull_calving_front !> if true, then cull calving_front cells to improve model stability; + !> generally applied only at initialization + + type(glide_calving), intent(inout) :: calving !> calving object + +! Note: The calving object includes the following fields and parameters used in this subroutine: +! real(dp), intent(in) :: marine_limit !> lower limit on topography elevation at marine edge before ice calves +! real(dp), intent(in) :: calving_fraction !> fraction of ice lost at marine edge when calving; + !> used with CALVING_FLOAT_FRACTION +! real(dp), intent(in) :: timescale !> time scale for calving; calving_thck = thck * max(dt/timescale, 1) + !> if timescale = 0, then calving_thck = thck +! real(dp), intent(in) :: minthck !> min thickness of floating ice before it calves; + !> used with CALVING_THCK_THRESHOLD, EIGENCALVING and CALVING_DAMAGE +! real(dp), intent(in) :: eigencalving_constant !> eigencalving constant; m/yr (lateral calving rate) per Pa (tensile stress) +! real(dp), intent(in) :: eigen2_weight !> weight given to tau_eigen2 relative to tau_eigen1 in tau_eff (unitless) +! real(dp), dimension(:,:), intent(in) :: tau_eigen1 !> first eigenvalue of 2D horizontal stress tensor (Pa) +! real(dp), dimension(:,:), intent(in) :: tau_eigen2 !> second eigenvalue of 2D horizontal stress tensor (Pa) +! real(dp), dimension(:,:), intent(inout) :: tau_eff !> effective stress (Pa) for calving; derived from tau_eigen1/2 + +! integer, intent(in) :: ncull_calving_front !> number of times to cull calving_front cells at initialization +! real(dp), intent(in) :: taumax_cliff !> yield stress (Pa) for marine-based ice cliffs + !> used with limit_marine_cliffs option +! real(dp), intent(in) :: cliff_timescale !> time scale for limiting marine cliff thickness +! real(dp), dimension(:,:,:), intent(inout):: damage !> 3D scalar damage parameter +! real(dp), intent(in) :: damage_threshold !> threshold value where ice is sufficiently damaged to calve +! real(dp), intent(in) :: damage_constant !> rate of change of damage (1/yr) per unit stress (Pa) +! real(dp) :: intent(in) :: lateral_rate_max !> max lateral calving rate (m/yr) for damaged ice +! real(dp), dimension(:,:), intent(inout) :: lateral_rate !> lateral calving rate (m/yr) at the calving front + !> used with EIGENCALVING and CALVING_DAMAGE +! integer, dimension(:,:), intent(in) :: calving_mask !> integer mask: calve ice where calving_mask = 1 +! real(dp), dimension(:,:), intent(out) :: calving_thck !> thickness lost due to calving in each grid cell + + integer, intent(in) :: itest, jtest, rtest !> coordinates of diagnostic point + real(dp), intent(in) :: dt !> model timestep (used with calving%timescale) + real(dp), intent(in) :: dx, dy !> grid cell size in x and y directions (m) + real(dp), dimension(:), intent(in) :: sigma !> vertical sigma coordinate + real(dp), intent(in) :: thklim !> minimum thickness for dynamically active grounded ice real(dp), dimension(:,:), intent(inout) :: thck !> ice thickness real(dp), dimension(:,:), intent(in) :: relx !> relaxed bedrock topography real(dp), dimension(:,:), intent(in) :: topg !> present bedrock topography real(dp), intent(in) :: eus !> eustatic sea level - real(dp), intent(in) :: thklim !> minimum thickness for dynamically active grounded ice - real(dp), intent(in) :: marine_limit !> lower limit on topography elevation at marine edge before ice calves - real(dp), intent(in) :: calving_fraction !> fraction of ice lost at marine edge when calving; - !> used with CALVING_FLOAT_FRACTION - real(dp), intent(in) :: calving_timescale !> time scale for calving; calving_thck = thck * max(dt/calving_timescale, 1) - !> if calving_timescale = 0, then calving_thck = thck - real(dp), intent(in) :: dt !> model timestep (used with calving_timescale) - real(dp), intent(in) :: dx, dy !> grid cell size in x and y directions (m) - real(dp), intent(in) :: eigencalving_constant !> eigencalving constant; m/yr (lateral calving rate) per Pa (tensile stress) - real(dp), intent(in) :: eigen2_weight !> weight given to tau_eigen2 relative to tau_eigen1 in tau_eff_calving (unitless) - real(dp), dimension(:,:), intent(in) :: tau_eigen1 !> first eigenvalue of 2D horizontal stress tensor (Pa) - real(dp), dimension(:,:), intent(in) :: tau_eigen2 !> second eigenvalue of 2D horizontal stress tensor (Pa) - real(dp), dimension(:,:), intent(inout) :: tau_eff_calving !> effective stress (Pa) for calving; derived from tau_eigen1/2 - real(dp), intent(in) :: calving_minthck !> min thickness of floating ice before it calves; - !> used with CALVING_THCK_THRESHOLD, EIGENCALVING and CALVING_DAMAGE - real(dp), intent(in) :: taumax_cliff !> yield stress (Pa) for marine-based ice cliffs - !> used with limit_marine_cliffs option - real(dp), intent(in) :: cliff_timescale !> time scale for limiting marine cliff thickness - integer, dimension(:,:), intent(in) :: calving_mask !> integer mask: calve ice where calving_mask = 1 - real(dp), dimension(:,:,:), intent(inout) :: damage !> 3D scalar damage parameter - real(dp), intent(in) :: damage_threshold !> threshold value where ice is sufficiently damaged to calve - real(dp), intent(in) :: damage_constant !> rate of change of damage (1/yr) per unit stress (Pa) - real(dp), dimension(:), intent(in) :: sigma !> vertical sigma coordinate - real(dp), dimension(:,:), intent(inout) :: calving_lateral !> lateral calving rate (m/yr) at the calving front - !> used with EIGENCALVING and CALVING_DAMAGE - real(dp), dimension(:,:), intent(out) :: calving_thck !> thickness lost due to calving in each grid cell - - logical, intent(in), optional :: & - cull_calving_front_in !> if true, then cull calving_front cells to improve model stability - !> generally should be called only at model initialization - - integer, intent(in), optional :: & - ncull_calving_front_in !> number of times to cull calving_front cells at initialization ! local variables - logical :: cull_calving_front ! local version of cull_calving_front_in - integer :: ncull_calving_front ! local version of ncull_calving_front_in - integer :: nx, ny ! horizontal grid dimensions integer :: nz ! number of vertical levels ! Note: number of ice layers = nz-1 @@ -340,18 +320,17 @@ subroutine glissade_calve_ice(which_calving, & calving_domain_mask ! = T in the domain where calving is allowed to occur (e.g., at ocean edge), else = F real(dp) :: & - float_fraction_calve ! = calving_fraction for which_calving = CALVING_FLOAT_FRACTION - ! = 1.0 for which_calving = CALVING_FLOAT_ZERO - - real(dp) :: & - thinning_rate, & ! vertical thinning rate (m/yr, converted to scaled model units) - calving_frac, & ! fraction of potential calving that is actually applied - frac_lateral, & ! calving_lateral / calving_lateral_max - areafrac, & ! fractional ice-covered area in a calving_front cell - dthck, & ! thickness change (model units) - d_damage_dt, & ! rate of change of damage scalar - thckmax_cliff, & ! max stable ice thickness in marine_cliff cells - factor ! factor in quadratic formula + float_fraction_calve, & ! = calving_fraction for which_calving = CALVING_FLOAT_FRACTION + ! = 1.0 for which_calving = CALVING_FLOAT_ZERO + thinning_rate, & ! vertical thinning rate (m/yr, converted to scaled model units) + calving_frac, & ! fraction of potential calving that is actually applied + upstream_lateral_rate,& ! lateral calving rate (m/yr) applied to upstream cell + frac_lateral, & ! lateral_rate / lateral_rate_max + areafrac, & ! fractional ice-covered area in a calving_front cell + dthck, & ! thickness change (model units) + d_damage_dt, & ! rate of change of damage scalar + thckmax_cliff, & ! max stable ice thickness in marine_cliff cells + factor ! factor in quadratic formula real(dp), parameter :: & thinning_limit = 0.99d0 ! When ice not originally on the calving front is allowed to thin, @@ -364,19 +343,7 @@ subroutine glissade_calve_ice(which_calving, & ! initialize - if (present(cull_calving_front_in)) then - cull_calving_front = cull_calving_front_in - else - cull_calving_front = .false. - endif - - if (present(ncull_calving_front_in)) then - ncull_calving_front = ncull_calving_front_in - else - ncull_calving_front = 1 ! only used if cull_calving_front = T - endif - - calving_thck(:,:) = 0.d0 + calving%calving_thck(:,:) = 0.d0 nx = size(thck,1) ny = size(thck,2) @@ -403,9 +370,9 @@ subroutine glissade_calve_ice(which_calving, & topg, eus, & thklim, & which_ho_calving_front, & - calving_thck, & + calving%calving_thck, & cull_calving_front, & - ncull_calving_front) + calving%ncull_calving_front) endif @@ -440,7 +407,7 @@ subroutine glissade_calve_ice(which_calving, & endif ! Set the thickness fraction to be removed in each calving cell - ! Note: The CALVING_FLOAT_FRACTION option has been superseded by the calving_timescale variable, + ! Note: The CALVING_FLOAT_FRACTION option has been superseded by the calving%timescale variable, ! but is included here for consistency with Glide. ! TODO: Remove CALVING_FLOAT_FRACTION option? @@ -448,14 +415,14 @@ subroutine glissade_calve_ice(which_calving, & !WHL - Changed definition of calving fraction; now it is the fraction lost ! rather than the fraction remaining - float_fraction_calve = calving_fraction + float_fraction_calve = calving%calving_fraction else ! other calving options - if (calving_timescale == 0.0d0) then ! calve the entire column for eligible columns (this is the default) + if (calving%timescale == 0.0d0) then ! calve the entire column for eligible columns (this is the default) float_fraction_calve = 1.0d0 else ! calve a fraction of the column based on the calving time scale - float_fraction_calve = min(dt/calving_timescale, 1.0d0) + float_fraction_calve = min(dt/calving%timescale, 1.0d0) endif endif @@ -542,8 +509,8 @@ subroutine glissade_calve_ice(which_calving, & allocate(tau2(nx,ny)) ! Ignore negative eigenvalues corresponding to compressive stresses - tau1 = max(tau_eigen1, 0.0d0) - tau2 = max(tau_eigen2, 0.0d0) + tau1 = max(calving%tau_eigen1, 0.0d0) + tau2 = max(calving%tau_eigen2, 0.0d0) ! Ignore values on grounded ice where (floating_mask == 0) @@ -580,7 +547,7 @@ subroutine glissade_calve_ice(which_calving, & ! Note: By setting eigen2_weight > 1, we can give greater weight to the second principle stress. ! This may be useful in calving unbuttressed shelves that are spreading in both directions. - tau_eff_calving(:,:) = sqrt(tau1(:,:)**2 + (eigen2_weight*tau2(:,:))**2) + calving%tau_eff(:,:) = sqrt(tau1(:,:)**2 + (calving%eigen2_weight * tau2(:,:))**2) if (verbose_calving .and. this_rank == rtest) then print*, ' ' @@ -602,11 +569,11 @@ subroutine glissade_calve_ice(which_calving, & write(6,*) ' ' enddo print*, ' ' - print*, 'tau_eff_calving (Pa), itest, jtest, rank =', itest, jtest, rtest + print*, 'tau_eff (Pa), itest, jtest, rank =', itest, jtest, rtest do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.2)',advance='no') tau_eff_calving(i,j) + write(6,'(f10.2)',advance='no') calving%tau_eff(i,j) enddo write(6,*) ' ' enddo @@ -615,7 +582,7 @@ subroutine glissade_calve_ice(which_calving, & ! Use the effective stress either to directly compute a lateral calving rate (for eigencalving), ! or to accumulate damage which is then used to derive a lateral calving rate (for damage-based calving). - calving_lateral(:,:) = 0.0d0 + calving%lateral_rate(:,:) = 0.0d0 if (which_calving == EIGENCALVING) then @@ -624,7 +591,7 @@ subroutine glissade_calve_ice(which_calving, & do j = 2, ny-1 do i = 2, nx-1 if (calving_front_mask(i,j) == 1) then - calving_lateral(i,j) = eigencalving_constant * tau_eff_calving(i,j) + calving%lateral_rate(i,j) = calving%eigencalving_constant * calving%tau_eff(i,j) endif enddo ! i enddo ! j @@ -632,7 +599,7 @@ subroutine glissade_calve_ice(which_calving, & elseif (which_calving == CALVING_DAMAGE) then ! Prognose changes in damage. - ! For now, this is done using a simple scheme based on the effective tensile stress, tau_eff_calving. + ! For now, this is done using a simple scheme based on the effective tensile stress, calving%tau_eff ! The damage is subsequently advected downstream. ! Note: The damage is formally a 3D field, which makes it easier to advect, even though ! (in the current scheme) the damage source term is uniform in each column. @@ -640,12 +607,12 @@ subroutine glissade_calve_ice(which_calving, & do j = 2, ny-1 do i = 2, nx-1 if (floating_mask(i,j) == 1) then - d_damage_dt = damage_constant * tau_eff_calving(i,j) ! d_damage_dt has units of yr^{-1} - damage(:,i,j) = damage(:,i,j) + d_damage_dt * (dt*tim0/scyr) ! convert dt to yr - damage(:,i,j) = min(damage(:,i,j), 1.0d0) - damage(:,i,j) = max(damage(:,i,j), 0.0d0) + d_damage_dt = calving%damage_constant * calving%tau_eff(i,j) ! d_damage_dt has units of yr^{-1} + calving%damage(:,i,j) = calving%damage(:,i,j) + d_damage_dt * (dt*tim0/scyr) ! convert dt to yr + calving%damage(:,i,j) = min(calving%damage(:,i,j), 1.0d0) + calving%damage(:,i,j) = max(calving%damage(:,i,j), 0.0d0) else ! set damage to zero for grounded ice - damage(:,i,j) = 0.0d0 + calving%damage(:,i,j) = 0.0d0 endif enddo enddo @@ -657,7 +624,7 @@ subroutine glissade_calve_ice(which_calving, & do j = 1, ny do i = 1, nx do k = 1, nz-1 - damage_column(i,j) = damage_column(i,j) + damage(k,i,j) * (sigma(k+1) - sigma(k)) + damage_column(i,j) = damage_column(i,j) + calving%damage(k,i,j) * (sigma(k+1) - sigma(k)) enddo enddo enddo @@ -666,13 +633,13 @@ subroutine glissade_calve_ice(which_calving, & ! Note: Although eigenprod = 0 in inactive calving-front cells, these cells can have significant damage ! advected from upstream, so in general we should not have to interpolate damage from upstream. !TODO - Verify this. - ! Note: calving_lateral_max has units of m/yr + ! Note: calving%lateral_rate_max has units of m/yr do j = 2, ny-1 do i = 2, nx-1 if (calving_front_mask(i,j) == 1) then - frac_lateral = (damage_column(i,j) - damage_threshold) / (1.0d0 - damage_threshold) + frac_lateral = (damage_column(i,j) - calving%damage_threshold) / (1.0d0 - calving%damage_threshold) frac_lateral = max(0.0d0, min(1.0d0, frac_lateral)) - calving_lateral(i,j) = calving_lateral_max * frac_lateral ! m/yr + calving%lateral_rate(i,j) = calving%lateral_rate_max * frac_lateral ! m/yr endif enddo enddo @@ -683,7 +650,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.6)',advance='no') damage_constant * tau_eff_calving(i,j) * (dt*tim0/scyr) + write(6,'(f10.6)',advance='no') calving%damage_constant * calving%tau_eff(i,j) * (dt*tim0/scyr) enddo write(6,*) ' ' enddo @@ -703,7 +670,7 @@ subroutine glissade_calve_ice(which_calving, & ! The following operations are shared by eigencalving and damage-based calving. - call parallel_halo(calving_lateral) + call parallel_halo(calving%lateral_rate) ! Convert the lateral calving rate to a vertical thinning rate, conserving volume. ! Note: The calved volume is proportional to the effective shelf-edge thickness (thck_calving_front), @@ -712,16 +679,16 @@ subroutine glissade_calve_ice(which_calving, & do j = 2, ny-1 do i = 2, nx-1 - if (calving_lateral(i,j) > 0.0d0) then + if (calving%lateral_rate(i,j) > 0.0d0) then - thinning_rate = calving_lateral(i,j) * thck_calving_front(i,j)*thk0 / sqrt(dx*dy) ! m/yr + thinning_rate = calving%lateral_rate(i,j) * thck_calving_front(i,j)*thk0 / sqrt(dx*dy) ! m/yr dthck = thinning_rate * (tim0/scyr)/thk0 * dt ! convert to model units if (verbose_calving .and. i==itest .and. j==jtest .and. this_rank==rtest) then print*, ' ' print*, 'Calving: r, i, j =', rtest, itest, jtest print*, 'dx (m), dt (yr) =', sqrt(dx*dy), dt*tim0/scyr - print*, 'calving rate (m/yr) =', calving_lateral(i,j) + print*, 'lateral calving rate (m/yr) =', calving%lateral_rate(i,j) print*, 'dthck (m) =', thinning_rate * dt*tim0/scyr endif @@ -730,8 +697,8 @@ subroutine glissade_calve_ice(which_calving, & if (dthck > thck(i,j)) then calving_frac = thck(i,j)/dthck - calving_lateral(i,j) = calving_lateral(i,j) * (1.0d0 - calving_frac) ! remaining for upstream cell - calving_thck(i,j) = calving_thck(i,j) + thck(i,j) + upstream_lateral_rate = calving%lateral_rate(i,j) * (1.0d0 - calving_frac) ! remaining for upstream cell + calving%calving_thck(i,j) = calving%calving_thck(i,j) + thck(i,j) thck(i,j) = 0.0d0 ! Apply some calving to the upstream cell with thck_init = thck_calving_front(i,j). @@ -740,22 +707,22 @@ subroutine glissade_calve_ice(which_calving, & do jj = j-1, j+1 do ii = i-1, i+1 if (thck_init(ii,jj) > 0.0d0 .and. thck_init(ii,jj) == thck_calving_front(i,j)) then - thinning_rate = calving_lateral(i,j) * thck_calving_front(i,j)*thk0 / sqrt(dx*dy) ! m/yr + thinning_rate = upstream_lateral_rate * thck_calving_front(i,j)*thk0 / sqrt(dx*dy) ! m/yr dthck = thinning_rate * (tim0/scyr)/thk0 * dt ! convert to model units dthck = min(dthck, thck(ii,jj)) thck(ii,jj) = thck(ii,jj) - dthck - calving_thck(ii,jj) = calving_thck(ii,jj) + dthck + calving%calving_thck(ii,jj) = calving%calving_thck(ii,jj) + dthck endif enddo ! ii enddo ! jj else ! dthck <= thck thck(i,j) = thck(i,j) - dthck - calving_thck(i,j) = calving_thck(i,j) + dthck + calving%calving_thck(i,j) = calving%calving_thck(i,j) + dthck endif - endif ! calving_lateral > 0 + endif ! calving%lateral_rate > 0 enddo ! i enddo ! j @@ -767,7 +734,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') calving_lateral(i,j) + write(6,'(f10.3)',advance='no') calving%lateral_rate(i,j) enddo write(6,*) ' ' enddo @@ -776,7 +743,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') calving_thck(i,j)*thk0 + write(6,'(f10.3)',advance='no') calving%calving_thck(i,j)*thk0 enddo write(6,*) ' ' enddo @@ -801,7 +768,7 @@ subroutine glissade_calve_ice(which_calving, & ! This helps get rid of thin ice near the CF where stress eigenvalues might be small. !WHL - debug - calving_thck_init(:,:) = calving_thck(:,:) + calving_thck_init(:,:) = calving%calving_thck(:,:) ! Save the initial thickness, which is used below to identify upstream interior cells. thck_init(:,:) = thck(:,:) @@ -858,14 +825,14 @@ subroutine glissade_calve_ice(which_calving, & endif ! Apply thinning in calving-front cells whose effective thickness H_e (thck_calving_front) is less than - ! a prescribed minimum value Hc_min (calving_minthck). + ! a prescribed minimum value Hc_min (calving%minthck). ! ! The effective thinning rate is given by ! ! dH_e/dt = -(Hc_min - H_e) / tau_c where Hc_min > H_e ! dH_e/dt = 0 elsewhere ! - ! where tau_c = calving_timescale. + ! where tau_c = calving%timescale. ! ! The thinning rate applied to the mean cell thickness (thck) is given by ! @@ -873,21 +840,21 @@ subroutine glissade_calve_ice(which_calving, & ! ! Thus, any ice with H_e < Hc_min is removed on a time scale given by tau_c. - if (calving_timescale <= 0.0d0) then - write(message,*) 'Must set calving_timescale to a positive nonzero value for this calving option' + if (calving%timescale <= 0.0d0) then + write(message,*) 'Must set calving timescale to a positive nonzero value for this calving option' call write_log(message, GM_FATAL) endif do j = 2, ny-1 do i = 2, nx-1 if (calving_front_mask(i,j) == 1 .and. & - thck_calving_front(i,j) > 0.0d0 .and. thck_calving_front(i,j) <= calving_minthck) then + thck_calving_front(i,j) > 0.0d0 .and. thck_calving_front(i,j) <= calving%minthck) then !! if (verbose_calving .and. thck(i,j) > 0.0d0) & !! print*, 'Calve thin floating ice: task, i, j, thck =', this_rank, i, j, thck(i,j)*thk0 - ! Note: calving_minthck, thck_calving_front and calving_timescale have scaled model units - thinning_rate = (calving_minthck - thck_calving_front(i,j)) / calving_timescale + ! Note: calving%minthck, thck_calving_front and calving%timescale have scaled model units + thinning_rate = (calving%minthck - thck_calving_front(i,j)) / calving%timescale areafrac = min(thck(i,j)/thck_calving_front(i,j), 1.0d0) dthck = areafrac*thinning_rate*dt @@ -897,7 +864,7 @@ subroutine glissade_calve_ice(which_calving, & print*, 'Thinning: r, i, j =', rtest, itest, jtest print*, 'thck:', thck(i,j)*thk0 print*, 'thck_calving_front (m) =', thck_calving_front(i,j)*thk0 - print*, 'calving_minthck (m) =', calving_minthck*thk0 + print*, 'calving_minthck (m) =', calving%minthck*thk0 print*, 'areafrac =', areafrac print*, 'thinning rate (m/yr) =', thinning_rate * thk0*scyr/tim0 print*, 'dt (yr) ', dt * tim0/scyr @@ -905,7 +872,7 @@ subroutine glissade_calve_ice(which_calving, & endif if (dthck > thck(i,j)) then - calving_thck(i,j) = calving_thck(i,j) + thck(i,j) + calving%calving_thck(i,j) = calving%calving_thck(i,j) + thck(i,j) thck(i,j) = 0.0d0 ! Apply a little bit of thinning to the upstream cell with thck_init = thck_calving_front(i,j) @@ -918,21 +885,21 @@ subroutine glissade_calve_ice(which_calving, & do ii = i-1, i+1 if (thck_init(ii,jj) > 0.0d0 .and. thck_init(ii,jj) == thck_calving_front(i,j) & .and. floating_mask(ii,jj) == 1) then - thinning_rate = (calving_minthck - thck_calving_front(i,j)) / calving_timescale + thinning_rate = (calving%minthck - thck_calving_front(i,j)) / calving%timescale dthck = max(thinning_rate*dt, 0.0d0) dthck = min(dthck, thck(ii,jj) - thinning_limit*thck_init(ii,jj)) thck(ii,jj) = thck(ii,jj) - dthck - calving_thck(ii,jj) = calving_thck(ii,jj) + dthck + calving%calving_thck(ii,jj) = calving%calving_thck(ii,jj) + dthck endif enddo ! ii enddo ! jj else thck(i,j) = thck(i,j) - dthck - calving_thck(i,j) = calving_thck(i,j) + dthck + calving%calving_thck(i,j) = calving%calving_thck(i,j) + dthck endif - endif ! thck_calving_front < calving_minthck in calving_front cell + endif ! thck_calving_front < calving%minthck in calving_front cell enddo ! i enddo ! j @@ -946,8 +913,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 -! write(6,'(f10.3)',advance='no') calving_thck(i,j)*thk0 - write(6,'(f10.3)',advance='no') (calving_thck(i,j) - calving_thck_init(i,j))*thk0 + write(6,'(f10.3)',advance='no') (calving%calving_thck(i,j) - calving_thck_init(i,j))*thk0 enddo write(6,*) ' ' enddo @@ -971,14 +937,14 @@ subroutine glissade_calve_ice(which_calving, & ! the thickness to thck_calving_front (just enough to make the cell active) ! and add the excess ice to the calving_thck field. - calving_thck_init(:,:) = calving_thck(:,:) + calving_thck_init(:,:) = calving%calving_thck(:,:) do j = 2, ny-1 do i = 2, nx-1 if (calving_front_mask(i,j) == 1 .and. & thck_calving_front(i,j) > 0.0d0 .and. thck(i,j) > thck_calving_front(i,j)) then dthck = thck(i,j) - thck_calving_front(i,j) - calving_thck(i,j) = calving_thck(i,j) + dthck + calving%calving_thck(i,j) = calving%calving_thck(i,j) + dthck thck(i,j) = thck_calving_front(i,j) endif enddo ! j @@ -1015,7 +981,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') (calving_thck(i,j) - calving_thck_init(i,j))*thk0 + write(6,'(f10.3)',advance='no') (calving%calving_thck(i,j) - calving_thck_init(i,j))*thk0 enddo write(6,*) ' ' enddo @@ -1052,7 +1018,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(i10)',advance='no') calving_mask(i,j) + write(6,'(i10)',advance='no') calving%calving_mask(i,j) enddo write(6,*) ' ' enddo @@ -1061,8 +1027,8 @@ subroutine glissade_calve_ice(which_calving, & do j = 1, ny do i = 1, nx - if (thck(i,j) > 0.0d0 .and. calving_mask(i,j) == 1) then - calving_thck(i,j) = calving_thck(i,j) + thck(i,j) + if (thck(i,j) > 0.0d0 .and. calving%calving_mask(i,j) == 1) then + calving%calving_thck(i,j) = calving%calving_thck(i,j) + thck(i,j) thck(i,j) = 0.0d0 !TODO - Reset temperature and other tracers? endif @@ -1075,7 +1041,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') calving_thck(i,j)*thk0 + write(6,'(f10.3)',advance='no') calving%calving_thck(i,j)*thk0 enddo write(6,*) ' ' enddo @@ -1132,7 +1098,7 @@ subroutine glissade_calve_ice(which_calving, & !WHL - The Glide version of CALVING_RELX_THRESHOLD calves ice wherever the relaxed bedrock criterion is met. ! Must set calving_domain = CALVING_DOMAIN_EVERYWHERE to match the Glide behavior. - where (relx <= marine_limit + eus) + where (relx <= calving%marine_limit + eus) calving_law_mask = .true. elsewhere calving_law_mask = .false. @@ -1140,7 +1106,7 @@ subroutine glissade_calve_ice(which_calving, & case(CALVING_TOPG_THRESHOLD) ! set thickness to zero if present bedrock is below a given level - where (topg < marine_limit + eus) + where (topg < calving%marine_limit + eus) calving_law_mask = .true. elsewhere calving_law_mask = .false. @@ -1353,7 +1319,7 @@ subroutine glissade_calve_ice(which_calving, & !! print*, 'Calve ice: task, i, j, calving_thck =', this_rank, i, j, float_fraction_calve * thck(i,j)*thk0 endif - calving_thck(i,j) = calving_thck(i,j) + float_fraction_calve * thck(i,j) + calving%calving_thck(i,j) = calving%calving_thck(i,j) + float_fraction_calve * thck(i,j) thck(i,j) = thck(i,j) - float_fraction_calve * thck(i,j) endif enddo @@ -1432,7 +1398,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - factor = taumax_cliff / (rhoi*grav) ! units are Pa for taumax, m for factor + factor = calving%taumax_cliff / (rhoi*grav) ! units are Pa for taumax, m for factor thckmax_cliff = factor + sqrt(factor**2 + (rhoo/rhoi)*(topg(i,j)*thk0)**2) ! m write(6,'(f10.3)',advance='no') thckmax_cliff enddo @@ -1447,7 +1413,7 @@ subroutine glissade_calve_ice(which_calving, & ! Compute the max stable ice thickness in the cliff cell. ! This is eq. 2.10 in Bassis & Walker (2012) - factor = taumax_cliff / (rhoi*grav) ! units are Pa for taumax, m for factor + factor = calving%taumax_cliff / (rhoi*grav) ! units are Pa for taumax, m for factor thckmax_cliff = factor + sqrt(factor**2 + (rhoo/rhoi)*(topg(i,j)*thk0)**2) ! m thckmax_cliff = thckmax_cliff / thk0 ! convert to model units @@ -1463,8 +1429,8 @@ subroutine glissade_calve_ice(which_calving, & ! Might want to try other values when looking at marine ice cliff instability. if (thck(i,j) > thckmax_cliff) then - if (cliff_timescale > 0.0d0) then - thinning_rate = (thck(i,j) - thckmax_cliff) / cliff_timescale + if (calving%cliff_timescale > 0.0d0) then + thinning_rate = (thck(i,j) - thckmax_cliff) / calving%cliff_timescale dthck = min(thck(i,j) - thckmax_cliff, thinning_rate*dt) else dthck = thck(i,j) - thckmax_cliff @@ -1481,7 +1447,7 @@ subroutine glissade_calve_ice(which_calving, & endif thck(i,j) = thck(i,j) - dthck - calving_thck(i,j) = calving_thck(i,j) + dthck + calving%calving_thck(i,j) = calving%calving_thck(i,j) + dthck endif ! thck > thckmax_cliff @@ -1514,9 +1480,9 @@ subroutine glissade_calve_ice(which_calving, & topg, eus, & thklim, & which_ho_calving_front, & - calving_thck, & + calving%calving_thck, & cull_calving_front, & - ncull_calving_front) + calving%ncull_calving_front) endif @@ -1527,7 +1493,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') calving_thck(i,j)*thk0 + write(6,'(f10.3)',advance='no') calving%calving_thck(i,j)*thk0 enddo write(6,*) ' ' enddo @@ -1573,8 +1539,8 @@ subroutine glissade_remove_icebergs(& thklim, & which_ho_calving_front, & calving_thck, & - cull_calving_front_in, & - ncull_calving_front_in) + cull_calving_front, & + ncull_calving_front) ! Remove any icebergs. @@ -1608,18 +1574,13 @@ subroutine glissade_remove_icebergs(& integer, intent(in) :: which_ho_calving_front !> = 1 for subgrid calving-front scheme, else = 0 real(dp), dimension(:,:), intent(inout) :: calving_thck !> thickness lost due to calving in each grid cell; !> on output, includes ice in icebergs - - logical, intent(in), optional :: & - cull_calving_front_in !> if true, remove peninsulas by first removing a layer of calving_front cells - - integer, intent(in), optional :: & - ncull_calving_front_in !> number of times to cull calving_front cells at initialization + logical, intent(in) :: & + cull_calving_front !> if true, remove peninsulas by first removing a layer of calving_front cells + integer, intent(in) :: & + ncull_calving_front !> number of times to cull calving_front cells at initialization ! local variables - logical :: cull_calving_front ! local version of cull_calving_front_in - integer :: ncull_calving_front ! local version of ncull_calving_front_in - integer :: nx, ny ! horizontal grid dimensions integer :: i, j, n @@ -1640,18 +1601,6 @@ subroutine glissade_remove_icebergs(& !WHL - debug real(dp) :: sum_fill_local, sum_fill_global - if (present(cull_calving_front_in)) then - cull_calving_front = cull_calving_front_in - else - cull_calving_front = .false. - endif - - if (present(ncull_calving_front_in)) then - ncull_calving_front = ncull_calving_front_in - else - ncull_calving_front = 1 - endif - nx = size(thck,1) ny = size(thck,2) @@ -1995,7 +1944,7 @@ subroutine glissade_find_lakes(nx, ny, & ! Identify cells with basal lakes: i.e., cells that are floating but have ! no connection through other floating cells to the ocean. - !TODO - Move this subroutine elsewhere (e.g., glissade_basal_traction) + !TODO - Move this subroutine elsewhere? Connection to calving is only the use of glissade_fill. integer, intent(in) :: nx, ny !> horizontal grid dimensions From 5fbce5cf8f0da4900762e9e88b50995619e52890 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Fri, 4 May 2018 12:23:27 -0600 Subject: [PATCH 32/61] Converted to SI units for calving The main calving subroutine, glissade_calve_ice, previously used scaled model units for time and thickness, and thus was prone to scaling errors. Now, glissade_calve_ice uses strictly SI units. This means that some scaled quantities like dt and thck have to be converted to SI units on input, and (for thck and calving_thck) back to scaled model units after output. Several user-configurable calving parameters have user-friendly units of yr or yr{-1} instead of s or s^{-1}. These parameters are converted to SI units in glide_scale_params, so that they are already SI when glissade_calve_ice is called. This follows the general approach I am taking to the gradual removal of scaling from the code. Working subroutines are being converted to SI; config parameters are converted to SI as needed at initialization (e.g., yr -> s); and scaling will later be removed at higher code levels. This commit leads to roundoff-level changes for simulations with active calving. Standard LIVV tests, which do not have calving, are BFB. --- libglide/glide_setup.F90 | 8 +- libglide/glide_vars.def | 1 + libglissade/glissade.F90 | 41 ++++--- libglissade/glissade_calving.F90 | 196 ++++++++++++++----------------- 4 files changed, 121 insertions(+), 125 deletions(-) diff --git a/libglide/glide_setup.F90 b/libglide/glide_setup.F90 index c169e6e9..9ea844fc 100644 --- a/libglide/glide_setup.F90 +++ b/libglide/glide_setup.F90 @@ -189,9 +189,11 @@ subroutine glide_scale_params(model) ! scale calving parameters model%calving%marine_limit = model%calving%marine_limit / thk0 - model%calving%minthck = model%calving%minthck / thk0 - model%calving%timescale = model%calving%timescale * scyr / tim0 - model%calving%cliff_timescale = model%calving%cliff_timescale * scyr / tim0 + model%calving%timescale = model%calving%timescale * scyr ! convert from yr to s + model%calving%cliff_timescale = model%calving%cliff_timescale * scyr ! convert from yr to s + model%calving%eigencalving_constant = model%calving%eigencalving_constant / scyr ! convert from m/yr/Pa to m/s/Pa + model%calving%damage_constant = model%calving%damage_constant / scyr ! convert from yr^{-1} to s^{-1} + model%calving%lateral_rate_max = model%calving%lateral_rate_max / scyr ! convert from m/yr to m/s ! scale periodic offsets for ISMIP-HOM model%numerics%periodic_offset_ew = model%numerics%periodic_offset_ew / thk0 diff --git a/libglide/glide_vars.def b/libglide/glide_vars.def index f9780f58..d0975a2e 100644 --- a/libglide/glide_vars.def +++ b/libglide/glide_vars.def @@ -545,6 +545,7 @@ dimensions: time, y1, x1 units: meter/year long_name: lateral calving rate data: data%calving%lateral_rate +factor: scyr coordinates: lon lat [damage] diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index 74d2f60c..b3193371 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -1925,6 +1925,9 @@ subroutine glissade_calving_solve(model, init_calving) ! --- Local variables --- + real(dp), dimension(model%general%ewn, model%general%nsn) :: & + thck_unscaled ! model%geometry%thck converted to m + logical :: cull_calving_front ! true iff init_calving = T and options%cull_calving_front = T integer :: i, j @@ -1940,29 +1943,35 @@ subroutine glissade_calving_solve(model, init_calving) ! ------------------------------------------------------------------------ ! Calve ice, based on the value of whichcalving - !TODO - Pass in model%calving (or model) instead of a long argument list? ! Pass in thck, topg, etc. with units of meters. ! ------------------------------------------------------------------------ - call glissade_calve_ice(model%options%whichcalving, & - model%options%calving_domain, & + thck_unscaled(:,:) = model%geometry%thck(:,:)*thk0 + + call glissade_calve_ice(model%options%whichcalving, & + model%options%calving_domain, & model%options%which_ho_calving_front, & model%options%remove_icebergs, & model%options%limit_marine_cliffs, & - cull_calving_front, & - model%calving, & - model%numerics%idiag_local, model%numerics%jdiag_local, & - model%numerics%rdiag_local, & - model%numerics%dt, & - model%numerics%dew*len0, & ! m - model%numerics%dns*len0, & ! m - model%numerics%sigma, & - model%numerics%thklim, & - model%geometry%thck, & - model%isostasy%relx, & - model%geometry%topg, & - model%climate%eus) + cull_calving_front, & + model%calving, & ! calving object; includes calving_thck (m) + model%numerics%idiag_local, & + model%numerics%jdiag_local, & + model%numerics%rdiag_local, & + model%numerics%dt*tim0, & ! s + model%numerics%dew*len0, & ! m + model%numerics%dns*len0, & ! m + model%numerics%sigma, & + model%numerics%thklim*thk0, & ! m + thck_unscaled, & ! m + model%isostasy%relx*thk0, & ! m + model%geometry%topg*thk0, & ! m + model%climate%eus*thk0) ! m + ! Convert geometry%thck and calving%calving_thck to scaled model units + model%geometry%thck(:,:) = thck_unscaled(:,:)/thk0 + model%calving%calving_thck(:,:) = model%calving%calving_thck(:,:)/thk0 + !TODO: Are any other halo updates needed after calving? ! halo updates call parallel_halo(model%geometry%thck) ! Updated halo values of thck are needed below in calclsrf diff --git a/libglissade/glissade_calving.F90 b/libglissade/glissade_calving.F90 index e0a5a039..8ab4e860 100644 --- a/libglissade/glissade_calving.F90 +++ b/libglissade/glissade_calving.F90 @@ -34,7 +34,7 @@ module glissade_calving use glimmer_log use parallel - use glimmer_paramets, only: thk0, tim0 + use glimmer_paramets, only: thk0 implicit none @@ -202,25 +202,22 @@ subroutine glissade_calve_ice(which_calving, & cull_calving_front, & calving, & ! calving derived type itest, jtest, rtest, & - dt, & - dx, dy, & + dt, & ! s + dx, dy, & ! m sigma, & - thklim, & - thck, relx, & - topg, eus) + thklim, & ! m + thck, relx, & ! m + topg, eus) ! m - ! Calve ice according to one of several methods + ! Calve ice according to one of several methods. + ! Note: This subroutine uses SI units. use glissade_masks implicit none - !TODO - Convert input/output arguments to SI units - ! TODO - Remove thickness scaling from this subroutine. Would need to multiply several input arguments by thk0. - !--------------------------------------------------------------------- ! Subroutine arguments - ! Currently, thck, relx, topg, eus, marine_limit, calving%minthck and calving_thck are scaled by thk0 !--------------------------------------------------------------------- integer, intent(in) :: which_calving !> option for calving law @@ -239,13 +236,14 @@ subroutine glissade_calve_ice(which_calving, & ! Note: The calving object includes the following fields and parameters used in this subroutine: ! real(dp), intent(in) :: marine_limit !> lower limit on topography elevation at marine edge before ice calves + !> Note: marine_limit (shared by Glide) has scaled model units ! real(dp), intent(in) :: calving_fraction !> fraction of ice lost at marine edge when calving; !> used with CALVING_FLOAT_FRACTION -! real(dp), intent(in) :: timescale !> time scale for calving; calving_thck = thck * max(dt/timescale, 1) +! real(dp), intent(in) :: timescale !> timescale (s) for calving; calving_thck = thck * max(dt/timescale, 1) !> if timescale = 0, then calving_thck = thck -! real(dp), intent(in) :: minthck !> min thickness of floating ice before it calves; +! real(dp), intent(in) :: minthck !> min thickness (m) of floating ice before it calves; !> used with CALVING_THCK_THRESHOLD, EIGENCALVING and CALVING_DAMAGE -! real(dp), intent(in) :: eigencalving_constant !> eigencalving constant; m/yr (lateral calving rate) per Pa (tensile stress) +! real(dp), intent(in) :: eigencalving_constant !> eigencalving constant; m/s (lateral calving rate) per Pa (tensile stress) ! real(dp), intent(in) :: eigen2_weight !> weight given to tau_eigen2 relative to tau_eigen1 in tau_eff (unitless) ! real(dp), dimension(:,:), intent(in) :: tau_eigen1 !> first eigenvalue of 2D horizontal stress tensor (Pa) ! real(dp), dimension(:,:), intent(in) :: tau_eigen2 !> second eigenvalue of 2D horizontal stress tensor (Pa) @@ -254,25 +252,25 @@ subroutine glissade_calve_ice(which_calving, & ! integer, intent(in) :: ncull_calving_front !> number of times to cull calving_front cells at initialization ! real(dp), intent(in) :: taumax_cliff !> yield stress (Pa) for marine-based ice cliffs !> used with limit_marine_cliffs option -! real(dp), intent(in) :: cliff_timescale !> time scale for limiting marine cliff thickness +! real(dp), intent(in) :: cliff_timescale !> timescale (s) for limiting marine cliff thickness ! real(dp), dimension(:,:,:), intent(inout):: damage !> 3D scalar damage parameter ! real(dp), intent(in) :: damage_threshold !> threshold value where ice is sufficiently damaged to calve -! real(dp), intent(in) :: damage_constant !> rate of change of damage (1/yr) per unit stress (Pa) -! real(dp) :: intent(in) :: lateral_rate_max !> max lateral calving rate (m/yr) for damaged ice -! real(dp), dimension(:,:), intent(inout) :: lateral_rate !> lateral calving rate (m/yr) at the calving front +! real(dp), intent(in) :: damage_constant !> rate of change of damage (1/s) per unit stress (Pa) +! real(dp) :: intent(in) :: lateral_rate_max !> max lateral calving rate (m/s) for damaged ice +! real(dp), dimension(:,:), intent(inout) :: lateral_rate !> lateral calving rate (m/s) at the calving front !> used with EIGENCALVING and CALVING_DAMAGE ! integer, dimension(:,:), intent(in) :: calving_mask !> integer mask: calve ice where calving_mask = 1 -! real(dp), dimension(:,:), intent(out) :: calving_thck !> thickness lost due to calving in each grid cell +! real(dp), dimension(:,:), intent(out) :: calving_thck !> thickness lost due to calving in each grid cell (m) integer, intent(in) :: itest, jtest, rtest !> coordinates of diagnostic point - real(dp), intent(in) :: dt !> model timestep (used with calving%timescale) + real(dp), intent(in) :: dt !> model timestep (s) real(dp), intent(in) :: dx, dy !> grid cell size in x and y directions (m) real(dp), dimension(:), intent(in) :: sigma !> vertical sigma coordinate - real(dp), intent(in) :: thklim !> minimum thickness for dynamically active grounded ice - real(dp), dimension(:,:), intent(inout) :: thck !> ice thickness - real(dp), dimension(:,:), intent(in) :: relx !> relaxed bedrock topography - real(dp), dimension(:,:), intent(in) :: topg !> present bedrock topography - real(dp), intent(in) :: eus !> eustatic sea level + real(dp), intent(in) :: thklim !> minimum thickness for dynamically active grounded ice (m) + real(dp), dimension(:,:), intent(inout) :: thck !> ice thickness (m) + real(dp), dimension(:,:), intent(in) :: relx !> relaxed bedrock topography (m) + real(dp), dimension(:,:), intent(in) :: topg !> present bedrock topography (m) + real(dp), intent(in) :: eus !> eustatic sea level (m) ! local variables @@ -322,13 +320,13 @@ subroutine glissade_calve_ice(which_calving, & real(dp) :: & float_fraction_calve, & ! = calving_fraction for which_calving = CALVING_FLOAT_FRACTION ! = 1.0 for which_calving = CALVING_FLOAT_ZERO - thinning_rate, & ! vertical thinning rate (m/yr, converted to scaled model units) + thinning_rate, & ! vertical thinning rate (m/s) calving_frac, & ! fraction of potential calving that is actually applied - upstream_lateral_rate,& ! lateral calving rate (m/yr) applied to upstream cell + upstream_lateral_rate,& ! lateral calving rate (m/s) applied to upstream cell frac_lateral, & ! lateral_rate / lateral_rate_max areafrac, & ! fractional ice-covered area in a calving_front cell - dthck, & ! thickness change (model units) - d_damage_dt, & ! rate of change of damage scalar + dthck, & ! thickness change (m) + d_damage_dt, & ! rate of change of damage scalar (1/s) thckmax_cliff, & ! max stable ice thickness in marine_cliff cells factor ! factor in quadratic formula @@ -488,7 +486,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck_calving_front(i,j)*thk0 + write(6,'(f10.3)',advance='no') thck_calving_front(i,j) enddo write(6,*) ' ' enddo @@ -497,7 +495,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck(i,j)*thk0 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' enddo @@ -586,7 +584,7 @@ subroutine glissade_calve_ice(which_calving, & if (which_calving == EIGENCALVING) then - ! Compute the lateral calving rate (m/yr) from the effective tensile stress in calving_front cells + ! Compute the lateral calving rate (m/s) from the effective tensile stress in calving_front cells do j = 2, ny-1 do i = 2, nx-1 @@ -607,8 +605,8 @@ subroutine glissade_calve_ice(which_calving, & do j = 2, ny-1 do i = 2, nx-1 if (floating_mask(i,j) == 1) then - d_damage_dt = calving%damage_constant * calving%tau_eff(i,j) ! d_damage_dt has units of yr^{-1} - calving%damage(:,i,j) = calving%damage(:,i,j) + d_damage_dt * (dt*tim0/scyr) ! convert dt to yr + d_damage_dt = calving%damage_constant * calving%tau_eff(i,j) ! damage_constant has units of s^{-1}/(Pa) + calving%damage(:,i,j) = calving%damage(:,i,j) + d_damage_dt * dt calving%damage(:,i,j) = min(calving%damage(:,i,j), 1.0d0) calving%damage(:,i,j) = max(calving%damage(:,i,j), 0.0d0) else ! set damage to zero for grounded ice @@ -629,17 +627,16 @@ subroutine glissade_calve_ice(which_calving, & enddo enddo - ! Convert damage in CF cells to a lateral calving rate. + ! Convert damage in CF cells to a lateral calving rate (m/s). ! Note: Although eigenprod = 0 in inactive calving-front cells, these cells can have significant damage ! advected from upstream, so in general we should not have to interpolate damage from upstream. !TODO - Verify this. - ! Note: calving%lateral_rate_max has units of m/yr do j = 2, ny-1 do i = 2, nx-1 if (calving_front_mask(i,j) == 1) then frac_lateral = (damage_column(i,j) - calving%damage_threshold) / (1.0d0 - calving%damage_threshold) frac_lateral = max(0.0d0, min(1.0d0, frac_lateral)) - calving%lateral_rate(i,j) = calving%lateral_rate_max * frac_lateral ! m/yr + calving%lateral_rate(i,j) = calving%lateral_rate_max * frac_lateral ! m/s endif enddo enddo @@ -650,7 +647,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.6)',advance='no') calving%damage_constant * calving%tau_eff(i,j) * (dt*tim0/scyr) + write(6,'(f10.6)',advance='no') calving%damage_constant * calving%tau_eff(i,j) * dt enddo write(6,*) ' ' enddo @@ -681,15 +678,17 @@ subroutine glissade_calve_ice(which_calving, & do i = 2, nx-1 if (calving%lateral_rate(i,j) > 0.0d0) then - thinning_rate = calving%lateral_rate(i,j) * thck_calving_front(i,j)*thk0 / sqrt(dx*dy) ! m/yr - dthck = thinning_rate * (tim0/scyr)/thk0 * dt ! convert to model units +!! thinning_rate = calving%lateral_rate(i,j) * thck_calving_front(i,j)*thk0 / sqrt(dx*dy) ! m/yr +!! dthck = thinning_rate * (tim0/scyr)/thk0 * dt ! convert to model units + thinning_rate = calving%lateral_rate(i,j) * thck_calving_front(i,j) / sqrt(dx*dy) ! m/s + dthck = thinning_rate * dt ! m if (verbose_calving .and. i==itest .and. j==jtest .and. this_rank==rtest) then print*, ' ' print*, 'Calving: r, i, j =', rtest, itest, jtest - print*, 'dx (m), dt (yr) =', sqrt(dx*dy), dt*tim0/scyr - print*, 'lateral calving rate (m/yr) =', calving%lateral_rate(i,j) - print*, 'dthck (m) =', thinning_rate * dt*tim0/scyr + print*, 'dx (m), dt (yr) =', sqrt(dx*dy), dt/scyr + print*, 'lateral calving rate (m/yr) =', calving%lateral_rate(i,j)*scyr + print*, 'dthck (m) =', dthck endif ! Compute the new ice thickness @@ -707,8 +706,10 @@ subroutine glissade_calve_ice(which_calving, & do jj = j-1, j+1 do ii = i-1, i+1 if (thck_init(ii,jj) > 0.0d0 .and. thck_init(ii,jj) == thck_calving_front(i,j)) then - thinning_rate = upstream_lateral_rate * thck_calving_front(i,j)*thk0 / sqrt(dx*dy) ! m/yr - dthck = thinning_rate * (tim0/scyr)/thk0 * dt ! convert to model units +!! thinning_rate = upstream_lateral_rate * thck_calving_front(i,j)*thk0 / sqrt(dx*dy) ! m/yr +!! dthck = thinning_rate * (tim0/scyr)/thk0 * dt ! convert to model units + thinning_rate = upstream_lateral_rate * thck_calving_front(i,j) / sqrt(dx*dy) ! m/s + dthck = thinning_rate * dt dthck = min(dthck, thck(ii,jj)) thck(ii,jj) = thck(ii,jj) - dthck @@ -734,7 +735,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') calving%lateral_rate(i,j) + write(6,'(f10.3)',advance='no') calving%lateral_rate(i,j) * scyr enddo write(6,*) ' ' enddo @@ -743,7 +744,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') calving%calving_thck(i,j)*thk0 + write(6,'(f10.3)',advance='no') calving%calving_thck(i,j) enddo write(6,*) ' ' enddo @@ -752,7 +753,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck(i,j)*thk0 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' enddo @@ -807,7 +808,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck_calving_front(i,j)*thk0 + write(6,'(f10.3)',advance='no') thck_calving_front(i,j) enddo write(6,*) ' ' enddo @@ -817,7 +818,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck(i,j)*thk0 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' enddo @@ -851,24 +852,23 @@ subroutine glissade_calve_ice(which_calving, & thck_calving_front(i,j) > 0.0d0 .and. thck_calving_front(i,j) <= calving%minthck) then !! if (verbose_calving .and. thck(i,j) > 0.0d0) & -!! print*, 'Calve thin floating ice: task, i, j, thck =', this_rank, i, j, thck(i,j)*thk0 +!! print*, 'Calve thin floating ice: task, i, j, thck =', this_rank, i, j, thck(i,j) - ! Note: calving%minthck, thck_calving_front and calving%timescale have scaled model units + ! calving%timescale has units of s thinning_rate = (calving%minthck - thck_calving_front(i,j)) / calving%timescale areafrac = min(thck(i,j)/thck_calving_front(i,j), 1.0d0) - dthck = areafrac*thinning_rate*dt + dthck = areafrac*thinning_rate * dt !WHL - debug if (verbose_calving .and. i==itest .and. j==jtest .and. this_rank==rtest) then print*, ' ' print*, 'Thinning: r, i, j =', rtest, itest, jtest - print*, 'thck:', thck(i,j)*thk0 - print*, 'thck_calving_front (m) =', thck_calving_front(i,j)*thk0 - print*, 'calving_minthck (m) =', calving%minthck*thk0 + print*, 'thck:', thck(i,j) + print*, 'thck_calving_front (m) =', thck_calving_front(i,j) + print*, 'calving%minthck (m) =', calving%minthck print*, 'areafrac =', areafrac - print*, 'thinning rate (m/yr) =', thinning_rate * thk0*scyr/tim0 - print*, 'dt (yr) ', dt * tim0/scyr - print*, 'dthck (m) =', dthck * thk0 + print*, 'thinning rate (m/yr) =', thinning_rate * scyr + print*, 'dthck (m) =', dthck endif if (dthck > thck(i,j)) then @@ -913,7 +913,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') (calving%calving_thck(i,j) - calving_thck_init(i,j))*thk0 + write(6,'(f10.3)',advance='no') (calving%calving_thck(i,j) - calving_thck_init(i,j)) enddo write(6,*) ' ' enddo @@ -922,7 +922,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck(i,j)*thk0 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' enddo @@ -971,7 +971,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck_calving_front(i,j)*thk0 + write(6,'(f10.3)',advance='no') thck_calving_front(i,j) enddo write(6,*) ' ' enddo @@ -981,7 +981,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') (calving%calving_thck(i,j) - calving_thck_init(i,j))*thk0 + write(6,'(f10.3)',advance='no') (calving%calving_thck(i,j) - calving_thck_init(i,j)) enddo write(6,*) ' ' enddo @@ -990,7 +990,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck(i,j)*thk0 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' enddo @@ -1009,7 +1009,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck(i,j)*thk0 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' enddo @@ -1041,7 +1041,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') calving%calving_thck(i,j)*thk0 + write(6,'(f10.3)',advance='no') calving%calving_thck(i,j) enddo write(6,*) ' ' enddo @@ -1050,7 +1050,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck(i,j)*thk0 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' enddo @@ -1097,8 +1097,8 @@ subroutine glissade_calve_ice(which_calving, & !WHL - The Glide version of CALVING_RELX_THRESHOLD calves ice wherever the relaxed bedrock criterion is met. ! Must set calving_domain = CALVING_DOMAIN_EVERYWHERE to match the Glide behavior. - - where (relx <= calving%marine_limit + eus) + ! Note: calving%marine_limit (a holdover from Glide) has scaled model units + where (relx <= calving%marine_limit*thk0 + eus) ! convert marine_limit from scaled units to m calving_law_mask = .true. elsewhere calving_law_mask = .false. @@ -1106,7 +1106,7 @@ subroutine glissade_calve_ice(which_calving, & case(CALVING_TOPG_THRESHOLD) ! set thickness to zero if present bedrock is below a given level - where (topg < calving%marine_limit + eus) + where (topg < calving%marine_limit*thk0 + eus) ! convert marine_limit from scaled units to m calving_law_mask = .true. elsewhere calving_law_mask = .false. @@ -1114,27 +1114,14 @@ subroutine glissade_calve_ice(which_calving, & case(CALVING_HUYBRECHTS) ! Huybrechts grounding line scheme for Greenland initialization - !WHL - Previously, this code assumed that eus and relx have units of meters. - ! Changed to be consistent with dimensionless thickness units. -! if (eus > -80.d0) then -! where (relx <= 2.d0*eus) -! calving_thck = thck -! thck = 0.0d0 -! end where -! elseif (eus <= -80.d0) then -! where (relx <= (2.d0*eus - 0.25d0*(eus + 80.d0)**2.d0)) -! calving_thck = thck -! thck = 0.0d0 -! end where -! end if - if (eus*thk0 > -80.d0) then - where (relx*thk0 <= 2.d0*eus*thk0) + if (eus > -80.d0) then + where (relx <= 2.d0*eus) calving_law_mask = .true. elsewhere calving_law_mask = .false. end where - elseif (eus*thk0 <= -80.d0) then - where (relx*thk0 <= (2.d0*eus*thk0 - 0.25d0*(eus*thk0 + 80.d0)**2.d0)) + elseif (eus <= -80.d0) then + where (relx <= (2.d0*eus - 0.25d0*(eus + 80.d0)**2.d0)) calving_law_mask = .true. elsewhere calving_law_mask = .false. @@ -1316,7 +1303,7 @@ subroutine glissade_calve_ice(which_calving, & if (calving_law_mask(i,j) .and. calving_domain_mask(i,j)) then if (verbose_calving .and. this_rank==rtest .and. thck(i,j) > 0.0d0) then -!! print*, 'Calve ice: task, i, j, calving_thck =', this_rank, i, j, float_fraction_calve * thck(i,j)*thk0 +!! print*, 'Calve ice: task, i, j, calving_thck =', this_rank, i, j, float_fraction_calve * thck(i,j) endif calving%calving_thck(i,j) = calving%calving_thck(i,j) + float_fraction_calve * thck(i,j) @@ -1350,7 +1337,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck(i,j)*thk0 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' enddo @@ -1399,7 +1386,7 @@ subroutine glissade_calve_ice(which_calving, & write(6,'(i6)',advance='no') j do i = itest-3, itest+3 factor = calving%taumax_cliff / (rhoi*grav) ! units are Pa for taumax, m for factor - thckmax_cliff = factor + sqrt(factor**2 + (rhoo/rhoi)*(topg(i,j)*thk0)**2) ! m + thckmax_cliff = factor + sqrt(factor**2 + (rhoo/rhoi)*(topg(i,j))**2) ! m write(6,'(f10.3)',advance='no') thckmax_cliff enddo write(6,*) ' ' @@ -1414,14 +1401,13 @@ subroutine glissade_calve_ice(which_calving, & ! Compute the max stable ice thickness in the cliff cell. ! This is eq. 2.10 in Bassis & Walker (2012) factor = calving%taumax_cliff / (rhoi*grav) ! units are Pa for taumax, m for factor - thckmax_cliff = factor + sqrt(factor**2 + (rhoo/rhoi)*(topg(i,j)*thk0)**2) ! m - thckmax_cliff = thckmax_cliff / thk0 ! convert to model units + thckmax_cliff = factor + sqrt(factor**2 + (rhoo/rhoi)*(topg(i,j))**2) ! m !WHL - debug if (verbose_calving .and. i==itest .and. j==jtest .and. this_rank==rtest) then print*, ' ' print*, 'Cliff thinning: r, i, j =', rtest, itest, jtest - print*, 'thck, thckmax_cliff (m) =', thck(i,j)*thk0, thckmax_cliff*thk0 + print*, 'thck, thckmax_cliff (m) =', thck(i,j), thckmax_cliff endif ! If thicker than the max stable thickness, then remove some ice and add it to the calving field @@ -1440,10 +1426,9 @@ subroutine glissade_calve_ice(which_calving, & if (verbose_calving .and. i==itest .and. j==jtest .and. this_rank==rtest) then !! print*, ' ' !! print*, 'r, i, j, thck, thckmax_cliff:', & -!! this_rank, i, j, thck(i,j)*thk0, thckmax_cliff*thk0 -!! print*, 'thinning rate (model units) =', thinning_rate - print*, 'thinning rate (m/yr) =', thinning_rate * thk0*scyr/tim0 - print*, 'dthck (m) =', dthck * thk0 +!! this_rank, i, j, thck(i,j), thckmax_cliff + print*, 'thinning rate (m/yr) =', thinning_rate * scyr + print*, 'dthck (m) =', dthck endif thck(i,j) = thck(i,j) - dthck @@ -1493,7 +1478,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') calving%calving_thck(i,j)*thk0 + write(6,'(f10.3)',advance='no') calving%calving_thck(i,j) enddo write(6,*) ' ' enddo @@ -1503,7 +1488,7 @@ subroutine glissade_calve_ice(which_calving, & do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck(i,j)*thk0 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' enddo @@ -1563,7 +1548,6 @@ subroutine glissade_remove_icebergs(& ! They are considered harmless. use glissade_masks - use glimmer_paramets, only: thk0 integer, intent(in) :: itest, jtest, rtest !> coordinates of diagnostic point @@ -1639,7 +1623,7 @@ subroutine glissade_remove_icebergs(& do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck(i,j)*thk0 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' enddo @@ -1657,7 +1641,7 @@ subroutine glissade_remove_icebergs(& do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck_calving_front(i,j)*thk0 + write(6,'(f10.3)',advance='no') thck_calving_front(i,j) enddo write(6,*) ' ' enddo @@ -1727,7 +1711,7 @@ subroutine glissade_remove_icebergs(& do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck(i,j)*thk0 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' enddo @@ -1745,7 +1729,7 @@ subroutine glissade_remove_icebergs(& do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck_calving_front(i,j)*thk0 + write(6,'(f10.3)',advance='no') thck_calving_front(i,j) enddo write(6,*) ' ' enddo @@ -1898,7 +1882,7 @@ subroutine glissade_remove_icebergs(& else ! not part of the inactive calving front; calve as an iceberg !WHL - debug !! if (verbose_calving .and. thck(i,j) > 0.0 .and. this_rank == rtest) then -!! print*, 'Remove iceberg: task, i, j, thck =', this_rank, i, j, thck(i,j)*thk0 +!! print*, 'Remove iceberg: task, i, j, thck =', this_rank, i, j, thck(i,j) !! endif calving_thck(i,j) = calving_thck(i,j) + thck(i,j) thck(i,j) = 0.0d0 @@ -1926,7 +1910,7 @@ subroutine glissade_remove_icebergs(& do j = jtest+3, jtest-3, -1 write(6,'(i6)',advance='no') j do i = itest-3, itest+3 - write(6,'(f10.3)',advance='no') thck(i,j)*thk0 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' enddo From c60152db0090a5bd075d0141b1b0160c329b2d68 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 7 May 2018 10:20:45 -0600 Subject: [PATCH 33/61] Removed CALVING_DOMAIN_OCEAN_CONNECT option For some of the calving options, the user can choose whether to calve ice only at the ocean edge, or in all cells where the calving criterion is met (e.g., all floating ice or all ice where topg lies below a threshold). A while back, I added a third option, CALVING_DOMAIN_OCEAN_CONNECT, to calve ice in all cells connected to the ocean through other cells in which the criterion is met. This option is complex and hasn't turned out to be useful, so I removed it. This commit is BFB except for runs using the now-defunct option. --- libglide/glide_setup.F90 | 5 +- libglide/glide_types.F90 | 5 -- libglissade/glissade_calving.F90 | 132 +------------------------------ 3 files changed, 3 insertions(+), 139 deletions(-) diff --git a/libglide/glide_setup.F90 b/libglide/glide_setup.F90 index 9ea844fc..94633fcd 100644 --- a/libglide/glide_setup.F90 +++ b/libglide/glide_setup.F90 @@ -782,10 +782,9 @@ subroutine print_options(model) 'no calving at initialization ', & 'ice calves at initialization ' /) - character(len=*), dimension(0:2), parameter :: domain_calving = (/ & + character(len=*), dimension(0:1), parameter :: domain_calving = (/ & 'calving only at the ocean edge ', & - 'calving in all cells where criterion is met', & - 'calving in cells connected to ocean edge '/) + 'calving in all cells where criterion is met'/) character(len=*), dimension(0:1), parameter :: vertical_integration = (/ & 'standard ', & diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index 6886ba68..7897832d 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -164,11 +164,8 @@ module glide_types integer, parameter :: CALVING_INIT_OFF = 0 integer, parameter :: CALVING_INIT_ON = 1 - !WHL - added an option to determine whether calving can occur everywhere the calving - ! criterion is met, or only at the ocean edge integer, parameter :: CALVING_DOMAIN_OCEAN_EDGE = 0 integer, parameter :: CALVING_DOMAIN_EVERYWHERE = 1 - integer, parameter :: CALVING_DOMAIN_OCEAN_CONNECT = 2 integer, parameter :: VERTINT_STANDARD = 0 integer, parameter :: VERTINT_KINEMATIC_BC = 1 @@ -499,8 +496,6 @@ module glide_types !> \begin{description} !> \item[0] Calve only at ocean edge !> \item[1] Calve wherever the calving criterion is met - !> \item[2] Calve where the calving criterion is met, and there is a connected path - !> to the ocean through other cells where the criterion is met. !> \end{description} logical :: remove_icebergs = .true. diff --git a/libglissade/glissade_calving.F90 b/libglissade/glissade_calving.F90 index 8ab4e860..2bd2720c 100644 --- a/libglissade/glissade_calving.F90 +++ b/libglissade/glissade_calving.F90 @@ -279,7 +279,6 @@ subroutine glissade_calve_ice(which_calving, & ! Note: number of ice layers = nz-1 integer :: i, j, k, n integer :: ii, jj - integer :: count, maxcount_fill ! loop counters real(dp), dimension(:,:), allocatable :: & thck_calving_front, & ! effective ice thickness at the calving front @@ -290,9 +289,6 @@ subroutine glissade_calve_ice(which_calving, & real(dp), dimension(:,:), allocatable :: & calving_thck_init ! debug diagnostic - integer, dimension(:,:), allocatable :: & - color ! integer 'color' for filling the calving domain (with CALVING_DOMAIN_OCEAN_CONNECT) - ! basic masks integer, dimension(:,:), allocatable :: & ice_mask, & ! = 1 where ice is present (thck > thklim), else = 0 @@ -307,9 +303,7 @@ subroutine glissade_calve_ice(which_calving, & ! Note: Calving occurs in a cell if and only if (1) the calving law permits calving, ! and (2) the cell is in the calving domain, as specified by the calving_domain option. ! The calving domain by default is limited to the ocean edge (CALVING_DOMAIN_OCEAN_EDGE), - ! but can be extended to include all ice-covered cells (CALVING_DOMAIN_EVERYWHERE), or - ! cells connected to the ocean through other cells that meet the calving criterion - ! (CALVING_DOMAIN_OCEAN_CONNECT). + ! but can be extended to include all ice-covered cells (CALVING_DOMAIN_EVERYWHERE). ! TODO: Change the default to calving_domain_everywhere? !TODO - Make these integer masks like the ones above? @@ -336,9 +330,6 @@ subroutine glissade_calve_ice(which_calving, & character(len=100) :: message - !WHL - debug - integer :: sum_fill_local, sum_fill_global ! number of filled cells - ! initialize calving%calving_thck(:,:) = 0.d0 @@ -1174,127 +1165,6 @@ subroutine glissade_calve_ice(which_calving, & calving_domain_mask(:,:) = .true. - elseif (calving_domain == CALVING_DOMAIN_OCEAN_CONNECT) then - - calving_domain_mask(:,:) = .false. - - ! initialize - ! Assign the initial color to cells that meet the calving-law criteria and thus could calve, - ! but only if they are connected to the ocean through other cells that meet the criteria. - ! Assign the boundary color to cells that do not meet the calving-law criteria. - - allocate (color(nx,ny)) - do j = 1, ny - do i = 1, nx - if (calving_law_mask(i,j)) then - color(i,j) = initial_color - else - color(i,j) = boundary_color - endif - enddo - enddo - - ! Loop through cells, identifying cells that lie on the ocean margin. - ! Fill each such cell with calving_law_mask = T, and recursively fill neighbor cells with calving_law_mask = T. - ! We may have to do this several times to incorporate connections between neighboring processors. - ! Alternatively, we could use a smaller value of maxcount_fill and allow calving to occur over multiple time steps, - ! but this could make the calving evolution more dependent on ntasks than desired. - -! maxcount_fill = 1 ! setting maxcount_fill = 1 will ignore connections between neighboring processors. - maxcount_fill = max(ewtasks,nstasks) - - do count = 1, maxcount_fill - - if (count == 1) then ! identify margin cells that can seed the fill - - do j = 1, ny - do i = 1, nx - if ( floating_mask(i,j) == 1 .and. calving_law_mask(i,j) .and. & - (ocean_mask(i-1,j)==1 .or. ocean_mask(i+1,j)==1 .or. & - ocean_mask(i,j-1)==1 .or. ocean_mask(i,j+1)==1) ) then - if (color(i,j) /= boundary_color .and. color(i,j) /= fill_color) then - ! assign the fill color to this cell, and recursively fill neighbor cells - call glissade_fill(nx, ny, & - i, j, & - color, ice_mask) - endif - endif - enddo - enddo - - else ! count > 1; check for halo cells that were just filled on neighbor processors - - call parallel_halo(color) - - ! west halo layer - i = nhalo - do j = 1, ny - if (color(i,j) == fill_color) call glissade_fill(nx, ny, & - i+1, j, & - color, ice_mask) - enddo - - ! east halo layer - i = nx - nhalo + 1 - do j = 1, ny - if (color(i,j) == fill_color) call glissade_fill(nx, ny, & - i-1, j, & - color, ice_mask) - enddo - - ! south halo layer - j = nhalo - do i = nhalo+1, nx-nhalo ! already checked halo corners above - if (color(i,j) == fill_color) call glissade_fill(nx, ny, & - i, j+1, & - color, ice_mask) - enddo - - ! north halo layer - j = ny-nhalo+1 - do i = nhalo+1, nx-nhalo ! already checked halo corners above - if (color(i,j) == fill_color) call glissade_fill(nx, ny, & - i, j-1, & - color, ice_mask) - enddo - - endif ! count = 1 - - sum_fill_local = 0 - do j = nhalo+1, ny-nhalo - do i = nhalo+1, nx-nhalo - if (color(i,j) == fill_color) sum_fill_local = sum_fill_local + 1 - enddo - enddo - - !WHL - If running a large problem, may want to reduce the frequency of this global sum - sum_fill_global = parallel_reduce_sum(sum_fill_local) - - if (verbose_calving) then -!! print*, 'this_rank, sum_fill_local, sum_fill_global:', this_rank, sum_fill_local, sum_fill_global - endif - - enddo ! count - - ! At this point, all cells with calving_law_mask = T should have the fill color if they - ! are connected to the margin through other cells with calving_law_mask = T. - ! These cells are now assigned to the calving domain. - - do j = 1, ny - do i = 1, nx - if (color(i,j) == fill_color) then - calving_domain_mask(i,j) = .true. - else - calving_domain_mask(i,j) = .false. - endif - enddo - enddo - - deallocate(color) - - ! Note: For this option, all cells in the calving domain have calving_law = T, so the logic below - ! (calving_law_mask = T .and. calving_domain_mask = T) is redundant, but it does no harm. - endif ! calving_domain ! Calve ice where calving_law_mask = T and calving_domain_mask = T From 5bea28828c7b25c83c0bf74085ac849f6ab14a42 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 7 May 2018 10:41:07 -0600 Subject: [PATCH 34/61] Removed requirement for all config files to have a test-name section Going back to Glimmer days, subroutine eismint_readconfig has looked for a section called '[EISMINT-2]' (or something similar) to set appropriate climate forcing for EISMINT test cases. For non-EISMINT tests, the code has looked for names of other supported tests, e.g. '[DOME-TEST]', and has aborted if such a section was not found. This has meant that unrelated problems, like Greenland simulations, have had '[DOME-TEST]' or similar text near the top, even though nothing was done with this information. With this commit, the code will return gracefully from eismint_readconfig if it has no eismint-related work to do. Greenland and Antarctic config files do not need the '[DOME-TEST]' header. I alse removed unneeded MISMIP references from eismint_forcing.F90. Note to Bill S.: This header can be omitted from CESM's Greenland config files. --- cism_driver/eismint_forcing.F90 | 86 ++------------------------------- 1 file changed, 4 insertions(+), 82 deletions(-) diff --git a/cism_driver/eismint_forcing.F90 b/cism_driver/eismint_forcing.F90 index 8dbd55a5..aab0dcf9 100644 --- a/cism_driver/eismint_forcing.F90 +++ b/cism_driver/eismint_forcing.F90 @@ -99,9 +99,6 @@ subroutine eismint_initialise(eismint_climate,config) eismint_climate%nmsb(1) = eismint_climate%nmsb(1) / acab_scale eismint_climate%nmsb(2) = eismint_climate%nmsb(2) / acab_scale - case(4) ! MISMIP-1 - eismint_climate%nmsb(1) = eismint_climate%nmsb(1) / acab_scale - end select end subroutine eismint_initialise @@ -188,35 +185,12 @@ subroutine eismint_readconfig(eismint_climate, config) return end if - !mismip tests - - !TODO - Assign reasonable default values if not present in config file - - call GetSection(config,section,'MISMIP-1') - if (associated(section)) then - eismint_climate%eismint_type = 4 - dummy=>NULL() - call GetValue(section,'temperature',dummy,2) - if (associated(dummy)) then - eismint_climate%airt = dummy - deallocate(dummy) - dummy=>NULL() - end if - call GetValue(section,'massbalance',dummy,3) - if (associated(dummy)) then - eismint_climate%nmsb = dummy - deallocate(dummy) - dummy=>NULL() - end if - return - end if - !exact verification - !TODO - Is this test currently supported? + !TODO - Is this test still supported? call GetSection(config,section,'EXACT') if (associated(section)) then - eismint_climate%eismint_type = 5 + eismint_climate%eismint_type = 4 dummy=>NULL() call GetValue(section,'temperature',dummy,2) if (associated(dummy)) then @@ -227,53 +201,8 @@ subroutine eismint_readconfig(eismint_climate, config) return end if - ! Standard higher-order tests - ! These do not require EISMINT-type input parameters. - - call GetSection(config,section,'DOME-TEST') - if (associated(section)) then - return - end if - - call GetSection(config,section,'ISMIP-HOM-TEST') - if (associated(section)) then - return - end if - - call GetSection(config,section,'SHELF-TEST') - if (associated(section)) then - return - end if - - call GetSection(config,section,'STREAM-TEST') - if (associated(section)) then - return - end if - - call GetSection(config,section,'ROSS-TEST') - if (associated(section)) then - return - end if - - call GetSection(config,section,'GIS-TEST') - if (associated(section)) then - return - end if - - call GetSection(config,section,'MISMIP+') - if (associated(section)) then - return - end if - - call GetSection(config,section,'MISMIP') - if (associated(section)) then - return - end if - - !TODO - Any other allowed tests to add here? - - ! Abort if one of the above cases has not been specified. - call write_log('No EISMINT forcing selected',GM_FATAL) + ! Other tests (DOME-TEST, ISMIP-HOM-TEST, etc.) do not require + ! EISMINT-type input parameters. end subroutine eismint_readconfig @@ -422,10 +351,6 @@ subroutine eismint_massbalance(eismint_climate,model,time) end do case(4) - !mismip 1 - model%climate%acab = eismint_climate%nmsb(1) - - case(5) !verification call exact_surfmass(eismint_climate,model,time,1.d0,eismint_climate%airt(2)) @@ -493,9 +418,6 @@ subroutine eismint_surftemp(eismint_climate,model,time) end do case(4) - model%climate%artm = eismint_climate%airt(1) - - case(5) !call both massbalance and surftemp at the same time to save computing time. call exact_surfmass(eismint_climate,model,time,0.d0,eismint_climate%airt(2)) end select From 534f1e899f51a6d47d3254e9bc016ae9e9364489 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 7 May 2018 12:16:20 -0600 Subject: [PATCH 35/61] Removed '[DOME-TEST]' and similar headers from config files I removed the headers [DOME-TEST], [SHELF-TEST], [ISMIP-HOM-TEST], etc. from the various test config files. These headers do not serve any purpose when parsing config files. After the recent changes in eismint_forcing.F90, unread sections in config files have generated a warning message. With this commit, the warning message goes away. This commit is BFB. LIVV configuration matches fail because the config files have changed, so reg_ref needs to be regenerated. --- tests/MISMIP/mismip.code/mismip.config.template | 2 -- tests/MISMIP3d/mismip3d.code/mismip3d.config.template | 2 -- tests/MISOMIP/mismip+/mismip+.config.template | 2 -- tests/dome/dome-forcing.config | 2 -- tests/dome/dome.config | 2 -- tests/halfar/halfar-HO.config | 2 -- tests/halfar/halfar.config | 2 -- tests/ismip-hom/ismip-hom.config | 1 - tests/new/test-forcing.config | 2 -- tests/new/test.config | 2 -- tests/ross/ross.config | 2 -- tests/shelf/shelf-circular.config | 2 -- tests/shelf/shelf-confined.config | 2 -- tests/slab/slab.config | 2 -- tests/stream/stream.config | 2 -- 15 files changed, 29 deletions(-) diff --git a/tests/MISMIP/mismip.code/mismip.config.template b/tests/MISMIP/mismip.code/mismip.config.template index c37dfbf6..9a6c95e3 100755 --- a/tests/MISMIP/mismip.code/mismip.config.template +++ b/tests/MISMIP/mismip.code/mismip.config.template @@ -1,5 +1,3 @@ -[MISMIP] - [grid] upn = 3 ewn = 1000 diff --git a/tests/MISMIP3d/mismip3d.code/mismip3d.config.template b/tests/MISMIP3d/mismip3d.code/mismip3d.config.template index ce8e0607..32e3b225 100755 --- a/tests/MISMIP3d/mismip3d.code/mismip3d.config.template +++ b/tests/MISMIP3d/mismip3d.code/mismip3d.config.template @@ -1,5 +1,3 @@ -[MISMIP] - [grid] upn = 3 ewn = 324 diff --git a/tests/MISOMIP/mismip+/mismip+.config.template b/tests/MISOMIP/mismip+/mismip+.config.template index 60678747..5389b7a2 100755 --- a/tests/MISOMIP/mismip+/mismip+.config.template +++ b/tests/MISOMIP/mismip+/mismip+.config.template @@ -1,5 +1,3 @@ -[MISMIP+] - [grid] upn = 3 ewn = 324 diff --git a/tests/dome/dome-forcing.config b/tests/dome/dome-forcing.config index 889e4c0c..5aa837f7 100644 --- a/tests/dome/dome-forcing.config +++ b/tests/dome/dome-forcing.config @@ -1,5 +1,3 @@ -[DOME-TEST] - [grid] upn = 10 ewn = 31 diff --git a/tests/dome/dome.config b/tests/dome/dome.config index 4885b075..d2202b94 100644 --- a/tests/dome/dome.config +++ b/tests/dome/dome.config @@ -1,5 +1,3 @@ -[DOME-TEST] - [grid] upn = 10 ewn = 31 diff --git a/tests/halfar/halfar-HO.config b/tests/halfar/halfar-HO.config index 88f053cc..5d52ec5b 100644 --- a/tests/halfar/halfar-HO.config +++ b/tests/halfar/halfar-HO.config @@ -1,5 +1,3 @@ -[DOME-TEST] - [grid] upn = 10 ewn = 31 diff --git a/tests/halfar/halfar.config b/tests/halfar/halfar.config index df8de519..95dcfa89 100644 --- a/tests/halfar/halfar.config +++ b/tests/halfar/halfar.config @@ -1,5 +1,3 @@ -[DOME-TEST] - [grid] upn = 10 ewn = 31 diff --git a/tests/ismip-hom/ismip-hom.config b/tests/ismip-hom/ismip-hom.config index c24ab2fe..b5db055f 100644 --- a/tests/ismip-hom/ismip-hom.config +++ b/tests/ismip-hom/ismip-hom.config @@ -1,4 +1,3 @@ -[ISMIP-HOM-TEST] # Test from ISMIP-HOM higher-order test suite # see: Pattyn et al., The Cryosphere, 2, 95–108, 2008. # www.the-cryosphere.net/2/95/2008 diff --git a/tests/new/test-forcing.config b/tests/new/test-forcing.config index fefc425c..afcdd78a 100644 --- a/tests/new/test-forcing.config +++ b/tests/new/test-forcing.config @@ -1,5 +1,3 @@ -[TEST-TEST] - [grid] upn = 10 ewn = 31 diff --git a/tests/new/test.config b/tests/new/test.config index 4e01669c..81cbea4a 100644 --- a/tests/new/test.config +++ b/tests/new/test.config @@ -1,5 +1,3 @@ -[DOME-TEST] - [grid] upn = 10 ewn = 31 diff --git a/tests/ross/ross.config b/tests/ross/ross.config index e388d909..0b5963cc 100644 --- a/tests/ross/ross.config +++ b/tests/ross/ross.config @@ -1,5 +1,3 @@ -[ROSS-TEST] - [grid] upn = 11 # x and y dimensions are one more than the raw data, diff --git a/tests/shelf/shelf-circular.config b/tests/shelf/shelf-circular.config index 82437727..8d666d84 100644 --- a/tests/shelf/shelf-circular.config +++ b/tests/shelf/shelf-circular.config @@ -1,5 +1,3 @@ -[SHELF-TEST] - [grid] upn = 5 ewn = 41 diff --git a/tests/shelf/shelf-confined.config b/tests/shelf/shelf-confined.config index d08fe821..0fe8c29c 100644 --- a/tests/shelf/shelf-confined.config +++ b/tests/shelf/shelf-confined.config @@ -1,5 +1,3 @@ -[SHELF-TEST] - [grid] upn = 5 ewn = 43 diff --git a/tests/slab/slab.config b/tests/slab/slab.config index 044998a2..d53f9d28 100644 --- a/tests/slab/slab.config +++ b/tests/slab/slab.config @@ -1,5 +1,3 @@ -[DOME-TEST] - [grid] upn = 50 ewn = 30 diff --git a/tests/stream/stream.config b/tests/stream/stream.config index 9f744236..1196a280 100644 --- a/tests/stream/stream.config +++ b/tests/stream/stream.config @@ -1,5 +1,3 @@ -[STREAM-TEST ] - [grid] upn = 2 ewn = 15 From 776395bc7cbc6546bc715c6f4196d741775e121d Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 7 May 2018 11:15:40 -0600 Subject: [PATCH 36/61] Simplified requirement for 'restart' string in restart filename. Previously, the restart filename needed to contain the string '.restart.' Requiring the periods was unnecessary and could be confusing. Going forward, the required string is 'restart', with periods optional. --- libglimmer/glimmer_ncparams.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/libglimmer/glimmer_ncparams.F90 b/libglimmer/glimmer_ncparams.F90 index 20708df7..0048043f 100644 --- a/libglimmer/glimmer_ncparams.F90 +++ b/libglimmer/glimmer_ncparams.F90 @@ -82,7 +82,7 @@ subroutine glimmer_nc_readparams(model,config) ! The latest time slice will be read in. ! Thus when restarting the model, it is only necessary to set restart = RESTART_TRUE (i.e, restart = 1) ! in the config file; it is not necesssary to change filenames in 'CF input' or 'CF restart'. - ! At most one file should be listed in the 'CF restart' section, and it should contain the string '.restart.' + ! At most one file should be listed in the 'CF restart' section, and it should contain the string 'restart' ! If model%options%is_restart = RESTART_TRUE and there is no 'CF restart' section, then the model will restart ! from the file and time slice specified in the 'CF input' section. (This is the old Glimmer behavior.) @@ -116,10 +116,10 @@ subroutine glimmer_nc_readparams(model,config) model%funits%out_first => output end if - ! Make sure the filename contains '.restart.' - pos = index(output%nc%filename,'.restart.') + ! Make sure the filename contains 'restart' + pos = index(output%nc%filename,'restart') if (pos == 0) then - call write_log ('Error, filename in CF restart section should include ".restart."', GM_FATAL) + call write_log ('Error, filename in CF restart section should include "restart"', GM_FATAL) endif ! Make sure there is only one 'CF restart' section @@ -165,10 +165,10 @@ subroutine glimmer_nc_readparams(model,config) input => handle_input(section,input) model%funits%in_first => input - ! Make sure the filename contains '.restart.' - pos = index(input%nc%filename,'.restart.') + ! Make sure the filename contains 'restart' + pos = index(input%nc%filename,'restart') if (pos == 0) then - call write_log ('Error, filename in CF restart section should include ".restart."', GM_FATAL) + call write_log ('Error, filename in CF restart section should include "restart"', GM_FATAL) endif ! Make sure there is only one 'CF restart' section From e7ea622d878ecea316cd9b53c64c8f17c93f10a2 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 7 May 2018 11:52:32 -0600 Subject: [PATCH 37/61] Cleaned up some initial diagnostic log messages I changed the 'slip_coeff' diagnostic to be written only when using the Glide dycore or the Glissade local-SIA solver. Otherwise, slip_coeff is not relevant. Similarly for the hydro_time diagnostic. Also made some other minor changes in diagnostics. --- libglide/glide_setup.F90 | 47 +++++++++++++++++++++++----------------- libglissade/glissade.F90 | 2 -- 2 files changed, 27 insertions(+), 22 deletions(-) diff --git a/libglide/glide_setup.F90 b/libglide/glide_setup.F90 index 94633fcd..0aee1684 100644 --- a/libglide/glide_setup.F90 +++ b/libglide/glide_setup.F90 @@ -532,8 +532,11 @@ subroutine print_time(model) (floor(model%numerics%ntem) /= model%numerics%ntem) ) then call write_log('ntem is a multiplier on the basic time step. It should be a positive integer. Aborting.',GM_FATAL) endif - write(message,*) 'profile frequency : ',model%numerics%profile_period - call write_log(message) + + if (model%options%whichdycore == DYCORE_GLIDE) then ! Glide option only + write(message,*) 'profile frequency : ',model%numerics%profile_period + call write_log(message) + endif if (model%numerics%dt_diag > 0.d0) then write(message,*) 'diagnostic interval (years):',model%numerics%dt_diag @@ -921,7 +924,7 @@ subroutine print_options(model) 'ice age computation off', & 'ice age computation on ' /) - call write_log('GLIDE options') + call write_log('Dycore options') call write_log('-------------') write(message,*) 'I/O parameter file : ',trim(model%funits%ncfile) @@ -946,7 +949,6 @@ subroutine print_options(model) ! Forbidden options associated with the Glide dycore if (model%options%whichdycore == DYCORE_GLIDE) then - if (model%options%whichevol == EVOL_INC_REMAP .or. & model%options%whichevol == EVOL_UPWIND .or. & model%options%whichevol == EVOL_NO_THICKNESS) then @@ -1115,23 +1117,23 @@ subroutine print_options(model) if (model%options%whichdycore == DYCORE_GLISSADE) then if (model%options%remove_icebergs) then - call write_log('Icebergs will be removed') + call write_log(' Icebergs will be removed') else - call write_log('Icebergs will not be removed') + call write_log(' Icebergs will not be removed') endif if (model%options%limit_marine_cliffs) then - call write_log('The thickness of marine ice cliffs will be limited') + call write_log(' The thickness of marine ice cliffs will be limited') call write_log(message) else - call write_log('The thickness of marine ice cliffs will not be limited') + call write_log(' The thickness of marine ice cliffs will not be limited') endif if (model%options%cull_calving_front) then - write(message,*) 'Calving-front cells will be culled', model%calving%ncull_calving_front, 'times at initialization' + write(message,*) ' Calving-front cells will be culled', model%calving%ncull_calving_front, 'times at initialization' call write_log(message) else - call write_log('Calving-front cells will not be culled at initialization') + call write_log(' Calving-front cells will not be culled at initialization') endif if (model%options%whichcalving == CALVING_FLOAT_FRACTION) then @@ -1166,15 +1168,18 @@ subroutine print_options(model) call write_log('Error, slip_coeff out of range',GM_FATAL) end if - !WHL - Currently, not all basal traction options are supported for the Glissade SIA solver - if (model%options%whichdycore == DYCORE_GLISSADE .and. model%options%which_ho_approx == HO_APPROX_LOCAL_SIA) then - if (model%options%whichbtrc > BTRC_CONSTANT_BPMP) then - call write_log('Error, slip_coeff out of range for Glissade dycore',GM_FATAL) - end if - endif + if (model%options%whichdycore == DYCORE_GLIDE .or. & + (model%options%whichdycore == DYCORE_GLISSADE .and. model%options%which_ho_approx == HO_APPROX_LOCAL_SIA) ) then + write(message,*) 'slip_coeff : ', model%options%whichbtrc, slip_coeff(model%options%whichbtrc) + call write_log(message) - write(message,*) 'slip_coeff : ', model%options%whichbtrc, slip_coeff(model%options%whichbtrc) - call write_log(message) + !Note: Not all basal traction options are supported for the Glissade SIA solver + if (model%options%whichdycore == DYCORE_GLISSADE .and. model%options%which_ho_approx == HO_APPROX_LOCAL_SIA) then + if (model%options%whichbtrc > BTRC_CONSTANT_BPMP) then + call write_log('Error, slip_coeff out of range for Glissade dycore',GM_FATAL) + end if + endif + endif if (model%options%whichevol < 0 .or. model%options%whichevol >= size(evolution)) then call write_log('Error, evolution out of range',GM_FATAL) @@ -1839,8 +1844,10 @@ subroutine print_parameters(model) write(message,*) 'flow enhancement factor (SSA) : ', model%paramets%flow_enhancement_factor_ssa call write_log(message) - write(message,*) 'basal hydro time constant (yr): ', model%paramets%hydtim - call write_log(message) + if (model%options%whichdycore == DYCORE_GLIDE) then + write(message,*) 'basal hydro time constant (yr): ', model%paramets%hydtim + call write_log(message) + endif if (model%options%whichdycore == DYCORE_GLISSADE) then write(message,*) 'max surface slope : ', model%paramets%max_slope diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index b3193371..34ed8537 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -1589,8 +1589,6 @@ subroutine glissade_thickness_tracer_solve(model) end select - print*, 'Here 5' - !------------------------------------------------------------------------ ! Update the upper and lower ice surface ! Note that glide_calclsrf loops over all cells, including halos, From 2abff7b9b6d35041974913d0a25cbdf5f9bd197f Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 7 May 2018 12:34:18 -0600 Subject: [PATCH 38/61] Added a Chronopoulos reference in PCG code --- libglissade/glissade_velo_higher_pcg.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/libglissade/glissade_velo_higher_pcg.F90 b/libglissade/glissade_velo_higher_pcg.F90 index 2ec9489e..c5ac102c 100644 --- a/libglissade/glissade_velo_higher_pcg.F90 +++ b/libglissade/glissade_velo_higher_pcg.F90 @@ -986,6 +986,10 @@ subroutine pcg_solver_chrongear_3d(nx, ny, & ! ! References are: ! + ! Chronopoulos, A.T., A Class of Parallel Iterative Methods Implemented on Multiprocessors, + ! Ph.D. thesis, Technical Report UIUCDCS-R-86-1267, Department of Computer Science, + ! University of Illinois, Urbana, Illinois, pp. 1-116, 1986. + ! ! Chronopoulos, A.T., and C.W. Gear. S-step iterative methods ! for symmetric linear systems. J. Comput. Appl. Math., 25(2), ! 153-168, 1989. @@ -1621,7 +1625,7 @@ subroutine pcg_solver_chrongear_2d(nx, ny, & !--------------------------------------------------------------- ! This subroutine uses a Chronopoulos-Gear preconditioned conjugate-gradient - ! algorithm to solve the equation $Ax=b$. + ! algorithm to solve the equation $Ax=b$. (See references in subroutine above.) ! ! It is similar to subroutine pcg_solver_chrongear_3d, but modified ! to solve for x and y at a single horizontal level, as in the From ed1d99cc17337b3270bea40fd33de4d4e33926d5 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 7 May 2018 13:05:56 -0600 Subject: [PATCH 39/61] Modified energy conservation error message The code aborts with a fatal error message in glissade_therm.F90 when energy is not conserved in an ice column. In practice, this is usually a secondary effect of a CFL error (i.e., very large ice speeds). The fatal error message now states that the energy error could be caused by a CFL violation. --- libglissade/glissade_therm.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/libglissade/glissade_therm.F90 b/libglissade/glissade_therm.F90 index fa24d90f..0a039034 100644 --- a/libglissade/glissade_therm.F90 +++ b/libglissade/glissade_therm.F90 @@ -621,7 +621,7 @@ subroutine glissade_therm_driver(whichtemp, & ! Internal variables !------------------------------------------------------------------------------------ - character(len=100) :: message + character(len=150) :: message real(dp), dimension(0:upn,ewn,nsn) :: & enthalpy ! specific enthalpy (J m-3) @@ -1004,7 +1004,8 @@ subroutine glissade_therm_driver(whichtemp, & call broadcast(istop_global, proc=this_rank) print*, 'ERROR: Energy not conserved in glissade_therm, rank, i, j =', this_rank, istop, jstop print*, 'Global i, j:', istop_global, jstop_global - write(message,*) 'ERROR: Energy not conserved in glissade_therm, global i, j =', istop_global, jstop_global + write(message,*) 'ERROR: Energy not conserved in glissade_therm' // & + ' (could be caused by a CFL violation), global i, j =', istop_global, jstop_global call write_log(message,GM_FATAL) endif From d76b5c620fd4bb873fddf227c3293d06217e36f9 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 7 May 2018 13:13:00 -0600 Subject: [PATCH 40/61] Fixed an isostasy comment --- libglide/isostasy.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/libglide/isostasy.F90 b/libglide/isostasy.F90 index c5efe30c..a867a845 100644 --- a/libglide/isostasy.F90 +++ b/libglide/isostasy.F90 @@ -54,9 +54,10 @@ module isostasy ! (4) The flexural rigidity of the elastic lithosphere is controlled by the parameter 'flexural_rigidity', ! which can be set in the [isostasy] section. The default is 0.24e25 N m. ! (5) The period for recomputing the load in the elastic lithosphere calculation is controlled - ! by the parameter 'update', which can be set in the [isostasy] section. - ! The default is 500 yr. As long as the update is not too frequent, the isostasy - ! calculation should have minimal cost compared to the whole simulation. + ! by the parameter 'lithosphere_period', which can be set in the [isostasy] section. + ! The default is 500 yr. As long as the load is not recomputed too often, the isostasy + ! calculation should have minimal cost compared to the whole simulation + ! (at least on grids of moderate resolution, ~4 km). ! (6) The adjustment time scale in the relaxing asthenosphere calculation is controlled ! by the parameter relaxed_tau, which can be set in the [isostasy] section. ! The default is 4000 yr. From 028ea911fe5cf7ce1d87db9a1ea61b0e124401b0 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 7 May 2018 13:31:03 -0600 Subject: [PATCH 41/61] Converted some ice masks from real to integer The geometry derived type includes several 2D masks: ice_mask, ice_mask_stag, grounded_mask and floating_mask. These masks (especially grounded_mask and floating_mask) are often written to output files. With this commit, these masks are integers rather than real-valued, consistent with most CISM masks. They were originally added by Dan Martin and were give real values to facilitate coupling with the POP interface. However, we have not been maintaining this interface. This commit is BFB, since the real-valued masks were not used in any computations. (Generally, each Glissade subroutine computes its required masks locally, without pointing to the geometry derived type.) --- libglide/glide_types.F90 | 17 +++++++++-------- libglide/glide_vars.def | 26 ++++++++++---------------- libglissade/glissade.F90 | 38 ++++++++++++-------------------------- 3 files changed, 31 insertions(+), 50 deletions(-) diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index 7897832d..c0e72787 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -887,14 +887,15 @@ module glide_types real(dp),dimension(:,:), pointer :: gl_flux =>null() !> mass flux at grounding line, cell-based (kg m^-1 s^-1) real(dp),dimension(:,:), pointer :: gl_flux_tavg =>null() !> mass flux at grounding line, cell-based (kg m^-1 s^-1, time average) - !* (DFM ----------------- The following 4 fields were added for BISICLES interface --------------) + !* (DFM ----------------- The following fields were added for BISICLES interface --------------) !*SFP: These fields need to be passed to POP for ice ocean coupling + ! WHL: When Dan added the masks, he made them real-valued. They are now integers, which might break the POP coupling. real(dp),dimension(:,:),pointer :: lower_cell_loc => null() !> z-location of the center of the lowest ice cell center real(dp),dimension(:,:),pointer :: lower_cell_temp => null() !> temperature in the cell located at lower_cell_loc - real(dp),dimension(:,:),pointer :: ice_mask => null() !> = 1.0 where ice is present, else = 0.0 - real(dp),dimension(:,:),pointer :: floating_mask => null() !> = 1.0 where ice is present and floating, else = 0.0 - real(dp),dimension(:,:),pointer :: grounded_mask => null() !> = 1.0 where ice is present and grounded, else = 0.0 - real(dp),dimension(:,:),pointer :: ice_mask_stag => null() !> = 1.0 where ice is present on staggered grid, else = 0.0 + integer, dimension(:,:),pointer :: ice_mask => null() !> = 1 where ice is present, else = 0.0 + integer, dimension(:,:),pointer :: ice_mask_stag => null() !> = 1 where ice is present on staggered grid, else = 0.0 + integer, dimension(:,:),pointer :: floating_mask => null() !> = 1 where ice is present and floating, else = 0.0 + integer, dimension(:,:),pointer :: grounded_mask => null() !> = 1 where ice is present and grounded, else = 0.0 integer, dimension(:,:),pointer :: thck_index => null() ! Set to nonzero integer for ice-covered cells (thck > 0), cells adjacent to ice-covered cells, @@ -2176,9 +2177,9 @@ subroutine glide_allocarr(model) call coordsystem_allocate(model%general%ice_grid, model%geometry%gl_flux_tavg) call coordsystem_allocate(model%general%ice_grid, model%geometry%ice_mask) + call coordsystem_allocate(model%general%velo_grid, model%geometry%ice_mask_stag) call coordsystem_allocate(model%general%ice_grid, model%geometry%floating_mask) call coordsystem_allocate(model%general%ice_grid, model%geometry%grounded_mask) - call coordsystem_allocate(model%general%velo_grid, model%geometry%ice_mask_stag) call coordsystem_allocate(model%general%ice_grid, model%geometry%lower_cell_loc) call coordsystem_allocate(model%general%ice_grid, model%geometry%lower_cell_temp) @@ -2691,12 +2692,12 @@ subroutine glide_deallocarr(model) if (associated(model%geometry%ice_mask)) & deallocate(model%geometry%ice_mask) + if (associated(model%geometry%ice_mask_stag)) & + deallocate(model%geometry%ice_mask_stag) if (associated(model%geometry%floating_mask)) & deallocate(model%geometry%floating_mask) if (associated(model%geometry%grounded_mask)) & deallocate(model%geometry%grounded_mask) - if (associated(model%geometry%ice_mask_stag)) & - deallocate(model%geometry%ice_mask_stag) if (associated(model%geometry%lower_cell_loc)) & deallocate(model%geometry%lower_cell_loc) if (associated(model%geometry%lower_cell_temp)) & diff --git a/libglide/glide_vars.def b/libglide/glide_vars.def index d0975a2e..8de1eefe 100644 --- a/libglide/glide_vars.def +++ b/libglide/glide_vars.def @@ -672,38 +672,32 @@ coordinates: lon lat #factor: 1.0 #coordinates: lon lat -# D. Martin added - fields that need to be passed to POP for ice-ocean coupling [ice_mask] dimensions: time, y1, x1 units: 1 -long_name: real-valued mask for ice (1) or no ice (0) +long_name: mask for ice (1) or no ice (0) data: data%geometry%ice_mask -factor: 1.0 coordinates: lon lat -## D. Martin added - fields that need to be passed to POP for ice-ocean coupling +[ice_mask_stag] +dimensions: time, y0, x0 +units: 1 +long_name: mask on staggered grid for ice (1) or no ice (0) +data: data%geometry%ice_mask_stag +coordinates: lon lat + [floating_mask] dimensions: time, y1, x1 units: 1 -long_name: real-valued mask for floating ice +long_name: mask for floating ice data: data%geometry%floating_mask -factor: 1.0 coordinates: lon lat [grounded_mask] dimensions: time, y1, x1 units: 1 -long_name: real-valued mask for grounded ice +long_name: mask for grounded ice data: data%geometry%grounded_mask -factor: 1.0 -coordinates: lon lat - -[ice_mask_stag] -dimensions: time, y0, x0 -units: 1 -long_name: real-valued mask on staggered grid for ice (1) or no ice (0) -data: data%geometry%ice_mask_stag -factor: 1.0 coordinates: lon lat [smb] diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index 34ed8537..6d5faa05 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -2860,51 +2860,37 @@ subroutine glissade_diagnostic_variable_solve(model) endif ! verbose_inversion - ! real-valued masks + ! set integer masks in the geometry derived type ! unstaggered grid do j = 1, model%general%nsn do i = 1, model%general%ewn if (ice_mask(i,j) == 1) then - model%geometry%ice_mask(i,j) = 1.0d0 + model%geometry%ice_mask(i,j) = 1 if (floating_mask(i,j) == 1) then - !WHL - debug - Identify cells where floating_mask flips between time steps. -!! if (model%geometry%floating_mask(i,j) == 0) then ! grounded or ice-free at previous step -!! call parallel_globalindex(i, j, iglobal, jglobal) -!! print*, 'floating_mask flipped from 0 to 1:, rank, i, j, iglobal, jglobal, thck_old, thck =', & -!! this_rank, i, j, iglobal, jglobal, & -!! model%geometry%thck_old(i,j)*thk0, model%geometry%thck(i,j)*thk0 -!! endif - model%geometry%floating_mask(i,j) = 1.0d0 - model%geometry%grounded_mask(i,j) = 0.0d0 + model%geometry%grounded_mask(i,j) = 0 + model%geometry%floating_mask(i,j) = 1 else - !WHL - debug - Identify cells where grounded_mask flips between time steps. -!! if (model%geometry%grounded_mask(i,j) == 0) then ! floating or ice-free at previous step -!! call parallel_globalindex(i, j, iglobal, jglobal) -!! print*, 'grounded_mask flipped from 0 to 1:, rank, i, j, iglobal, jglobal, thck_old, thck =', & -!! this_rank, i, j, iglobal, jglobal, & -!! model%geometry%thck_old(i,j)*thk0, model%geometry%thck(i,j)*thk0 -!! endif - model%geometry%grounded_mask(i,j) = 1.0d0 - model%geometry%floating_mask(i,j) = 0.0d0 + model%geometry%grounded_mask(i,j) = 1 + model%geometry%floating_mask(i,j) = 0 endif else ! ice_mask = 0 - model%geometry%ice_mask(i,j) = 0.0d0 - model%geometry%grounded_mask(i,j) = 0.0d0 - model%geometry%floating_mask(i,j) = 0.0d0 + model%geometry%ice_mask(i,j) = 0 + model%geometry%grounded_mask(i,j) = 0 + model%geometry%floating_mask(i,j) = 0 endif enddo enddo ! staggered grid - ! set ice_mask_stag = 1.0 at vertices with ice_mask = 1 in any neighbor cell + ! set ice_mask_stag = 1 at vertices with ice_mask = 1 in any neighbor cell do j = 1, model%general%nsn - 1 do i = 1, model%general%ewn - 1 if (ice_mask(i,j+1)==1 .or. ice_mask(i+1,j+1)==1 .or. & ice_mask(i,j) ==1 .or. ice_mask(i+1,j) ==1) then - model%geometry%ice_mask_stag(i,j) = 1.0d0 + model%geometry%ice_mask_stag(i,j) = 1 else - model%geometry%ice_mask_stag(i,j) = 0.0d0 + model%geometry%ice_mask_stag(i,j) = 0 endif enddo enddo From d76baca77bb8dd967de6912c1962bda67556f031 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 7 May 2018 14:01:45 -0600 Subject: [PATCH 42/61] Added a calving_rate field Added a 2D calving_rate field with units m/yr ice. This field is positive wherever there is calving. It is computed by dividing calving_thck (the calving ice thickness in a given time step) by the time step, with appropriate scale factors. The calving rate can be compared to acab_applied and bmlt_applied to compute the mass balance of each grid cell at a given time. The sum acab_applied - bmlt_applied - calving_rate should vanish when integrated over the entire domain, provided there is no inflow or outflow at the lateral boundaries. I verified that calving_rate is written correctly to output files and is proportional to calving_thck. This commit is BFB. --- libglide/glide_diagnostics.F90 | 11 ++++------- libglide/glide_types.F90 | 4 ++++ libglide/glide_vars.def | 7 +++++++ libglissade/glissade.F90 | 3 +++ 4 files changed, 18 insertions(+), 7 deletions(-) diff --git a/libglide/glide_diagnostics.F90 b/libglide/glide_diagnostics.F90 index c03e79b4..a3c05b1e 100644 --- a/libglide/glide_diagnostics.F90 +++ b/libglide/glide_diagnostics.F90 @@ -469,7 +469,7 @@ subroutine glide_write_diag (model, time, & if (model%options%whichdycore == DYCORE_GLISSADE) then - ! total surface accumulation/ablation rate (m^3/yr) + ! total surface accumulation/ablation rate (m^3/yr ice) tot_acab = 0.d0 do j = lhalo+1, nsn-uhalo @@ -514,18 +514,15 @@ subroutine glide_write_diag (model, time, & mean_bmlt = 0.d0 endif - ! total calving rate - ! Recall that calving_thck is the scaled thickness of ice calving in one time step; - ! divide by dt to convert to a rate + ! total calving rate (m^3/yr ice) + ! Note: calving%calving_rate has units of m/yr ice tot_calving = 0.d0 do j = lhalo+1, nsn-uhalo do i = lhalo+1, ewn-uhalo - tot_calving = tot_calving + model%calving%calving_thck(i,j)/model%numerics%dt * cell_area(i,j) + tot_calving = tot_calving + model%calving%calving_rate(i,j) * (cell_area(i,j)*len0**2) ! m^3/yr ice enddo enddo - - tot_calving = tot_calving * scyr * thk0/tim0 * len0**2 ! convert to m^3/yr tot_calving = parallel_reduce_sum(tot_calving) ! total calving mass balance flux (kg/s, negative for ice loss by calving) diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index c0e72787..8af521b3 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -1110,6 +1110,7 @@ module glide_types !> holds fields and parameters related to calving real(dp),dimension(:,:), pointer :: calving_thck => null() !> thickness loss in grid cell due to calving !> scaled by thk0 like mass balance, thickness, etc. + real(dp),dimension(:,:), pointer :: calving_rate => null() !> rate of ice loss (m/yr ice) due to calving integer, dimension(:,:), pointer :: calving_mask => null() !> calve floating ice wherever the mask = 1 (whichcalving = CALVING_GRID_MASK) real(dp),dimension(:,:), pointer :: lateral_rate => null() !> lateral calving rate (m/yr, not scaled) !> (whichcalving = EIGENCALVING, CALVING_DAMAGE) @@ -2285,6 +2286,7 @@ subroutine glide_allocarr(model) ! calving arrays call coordsystem_allocate(model%general%ice_grid, model%calving%calving_thck) + call coordsystem_allocate(model%general%ice_grid, model%calving%calving_rate) call coordsystem_allocate(model%general%ice_grid, model%calving%calving_mask) call coordsystem_allocate(model%general%ice_grid, model%calving%lateral_rate) call coordsystem_allocate(model%general%ice_grid, model%calving%tau_eigen1) @@ -2773,6 +2775,8 @@ subroutine glide_deallocarr(model) ! calving arrays if (associated(model%calving%calving_thck)) & deallocate(model%calving%calving_thck) + if (associated(model%calving%calving_rate)) & + deallocate(model%calving%calving_rate) if (associated(model%calving%calving_mask)) & deallocate(model%calving%calving_mask) if (associated(model%calving%lateral_rate)) & diff --git a/libglide/glide_vars.def b/libglide/glide_vars.def index 8de1eefe..6696154b 100644 --- a/libglide/glide_vars.def +++ b/libglide/glide_vars.def @@ -531,6 +531,13 @@ data: data%calving%calving_thck factor: thk0 coordinates: lon lat +[calving_rate] +dimensions: time, y1, x1 +units: meter/year +long_name: rate of mass loss by calving +data: data%calving%calving_rate +coordinates: lon lat + [calving_mask] dimensions: time, y1, x1 units: 1 diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index 6d5faa05..4020501e 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -2787,6 +2787,9 @@ subroutine glissade_diagnostic_variable_solve(model) model%geometry%basal_mbal_flux(:,:) = rhoi * (-model%basal_melt%bmlt_applied(:,:)) * thk0/tim0 model%geometry%calving_flux(:,:) = rhoi * (-model%calving%calving_thck(:,:)*thk0) / (model%numerics%dt*tim0) + ! calving rate (m/yr ice; positive for calving) + model%calving%calving_rate(:,:) = (model%calving%calving_thck(:,:)*thk0) / (model%numerics%dt*tim0/scyr) + !WHL - inversion debug if ( (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & From 4edd50bec17d03e6493e9430644eb2408ad32cc8 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 7 May 2018 14:41:33 -0600 Subject: [PATCH 43/61] Added tavg fields for acab_applied, bmlt_applied, calving_rate I added the option to output acab_applied, bmlt_applied and calving_rate as tavg fields rather than snapshots. Since these fields are rates of ice gain or loss with units of m/yr of ice, the time-average values (e.g., average calving rate over a year) are usually of greater interest than snapshots. To write these fields, simply add 'acab_applied_tavg', 'bmlt_applied_tavg' and 'calving_rate_tavg' to the output file list in the config file. Note to Bill S.: The standard CISM output file should be modified to include the 'tavg' suffix on each of these fields. --- libglide/glide_types.F90 | 33 +++++++++++++++++++++++---------- libglide/glide_vars.def | 3 +++ 2 files changed, 26 insertions(+), 10 deletions(-) diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index 8af521b3..1ffcd278 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -1073,6 +1073,7 @@ module glide_types ! Note on acab_tavg: This is the average value of acab over an output interval. ! If 'average = 1' in the acab entry of glide_vars.def, then acab_tavg is automatically ! accumulated and averaged during runtime, without any additional code needed. + ! Other variables with a '_tavg' suffix are handled similarly. ! ! Note on acab_corrected: Optionally, acab can be supplemented with a flux correction or an anomaly. ! The background field, acab, does not include the corrections. @@ -1080,13 +1081,14 @@ module glide_types type glide_climate !> Holds fields used to drive the model - real(dp),dimension(:,:),pointer :: acab => null() !> Annual mass balance (m/y ice) - real(dp),dimension(:,:),pointer :: acab_tavg => null() !> Annual mass balance (time average). - real(dp),dimension(:,:),pointer :: acab_anomaly => null() !> Annual mass balance anomaly (m/y ice) - real(dp),dimension(:,:),pointer :: acab_corrected => null() !> Annual mass balance with flux or anomaly corrections (m/y ice) - real(dp),dimension(:,:),pointer :: acab_applied => null() !> Annual mass balance applied to ice (m/y ice) - !> = 0 for ice-free cells with acab < 0 - real(dp),dimension(:,:),pointer :: smb => null() !> Annual mass balance (mm/y water equivalent) + real(dp),dimension(:,:),pointer :: acab => null() !> Surface mass balance (m/yr ice) + real(dp),dimension(:,:),pointer :: acab_tavg => null() !> Surface mass balance (time average). + real(dp),dimension(:,:),pointer :: acab_anomaly => null() !> Surface mass balance anomaly (m/yr ice) + real(dp),dimension(:,:),pointer :: acab_corrected => null() !> Surface mass balance with flux or anomaly corrections (m/yr ice) + real(dp),dimension(:,:),pointer :: acab_applied => null() !> Surface mass balance applied to ice (m/yr ice) + !> = 0 for ice-free cells with acab < 0 + real(dp),dimension(:,:),pointer :: acab_applied_tavg => null() !> Surface mass balance applied to ice (m/yr ice, time average) + real(dp),dimension(:,:),pointer :: smb => null() !> Surface mass balance (mm/yr water equivalent) !> Note: acab (m/y ice) is used internally by dycore, !> but can use smb (mm/yr w.e.) for I/O real(dp),dimension(:,:),pointer :: artm => null() !> Annual mean air temperature (degC) @@ -1110,7 +1112,8 @@ module glide_types !> holds fields and parameters related to calving real(dp),dimension(:,:), pointer :: calving_thck => null() !> thickness loss in grid cell due to calving !> scaled by thk0 like mass balance, thickness, etc. - real(dp),dimension(:,:), pointer :: calving_rate => null() !> rate of ice loss (m/yr ice) due to calving + real(dp),dimension(:,:), pointer :: calving_rate => null() !> rate of ice loss due to calving (m/yr ice) + real(dp),dimension(:,:), pointer :: calving_rate_tavg => null() !> rate of ice loss due to calving (m/yr ice, time average) integer, dimension(:,:), pointer :: calving_mask => null() !> calve floating ice wherever the mask = 1 (whichcalving = CALVING_GRID_MASK) real(dp),dimension(:,:), pointer :: lateral_rate => null() !> lateral calving rate (m/yr, not scaled) !> (whichcalving = EIGENCALVING, CALVING_DAMAGE) @@ -1309,8 +1312,9 @@ module glide_types real(dp), dimension(:,:), pointer :: & bmlt => null(), & !> basal melt rate (> 0 for melt, < 0 for freeze-on) !> bmlt = bmlt_ground + bmlt_float - bmlt_applied => null(), & !> basal melt rate applied to ice - !> = 0 for ice-free cells with bmlt > 0 + bmlt_applied => null(), & !> basal melt rate applied to ice (m/yr) + !> = 0 for ice-free cells with bmlt > 0 + bmlt_applied_tavg => null(), & !> basal melt rate applied to ice (m/yr, time average) bmlt_ground => null(), & !> basal melt rate for grounded ice bmlt_float => null(), & !> basal melt rate for floating ice bmlt_float_external => null(), & !> external basal melt rate field @@ -2230,6 +2234,7 @@ subroutine glide_allocarr(model) ! bmlt arrays call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt) call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_applied) + call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_applied_tavg) !WHL - debug call coordsystem_allocate(model%general%ice_grid, model%basal_melt%bmlt_applied_old) @@ -2279,6 +2284,7 @@ subroutine glide_allocarr(model) call coordsystem_allocate(model%general%ice_grid, model%climate%acab_anomaly) call coordsystem_allocate(model%general%ice_grid, model%climate%acab_corrected) call coordsystem_allocate(model%general%ice_grid, model%climate%acab_applied) + call coordsystem_allocate(model%general%ice_grid, model%climate%acab_applied_tavg) call coordsystem_allocate(model%general%ice_grid, model%climate%artm) call coordsystem_allocate(model%general%ice_grid, model%climate%smb) call coordsystem_allocate(model%general%ice_grid, model%climate%no_advance_mask) @@ -2287,6 +2293,7 @@ subroutine glide_allocarr(model) ! calving arrays call coordsystem_allocate(model%general%ice_grid, model%calving%calving_thck) call coordsystem_allocate(model%general%ice_grid, model%calving%calving_rate) + call coordsystem_allocate(model%general%ice_grid, model%calving%calving_rate_tavg) call coordsystem_allocate(model%general%ice_grid, model%calving%calving_mask) call coordsystem_allocate(model%general%ice_grid, model%calving%lateral_rate) call coordsystem_allocate(model%general%ice_grid, model%calving%tau_eigen1) @@ -2576,6 +2583,8 @@ subroutine glide_deallocarr(model) deallocate(model%basal_melt%bmlt) if (associated(model%basal_melt%bmlt_applied)) & deallocate(model%basal_melt%bmlt_applied) + if (associated(model%basal_melt%bmlt_applied_tavg)) & + deallocate(model%basal_melt%bmlt_applied_tavg) if (associated(model%basal_melt%bmlt_ground)) & deallocate(model%basal_melt%bmlt_ground) if (associated(model%basal_melt%bmlt_float)) & @@ -2763,6 +2772,8 @@ subroutine glide_deallocarr(model) deallocate(model%climate%acab_corrected) if (associated(model%climate%acab_applied)) & deallocate(model%climate%acab_applied) + if (associated(model%climate%acab_applied_tavg)) & + deallocate(model%climate%acab_applied_tavg) if (associated(model%climate%smb)) & deallocate(model%climate%smb) if (associated(model%climate%artm)) & @@ -2777,6 +2788,8 @@ subroutine glide_deallocarr(model) deallocate(model%calving%calving_thck) if (associated(model%calving%calving_rate)) & deallocate(model%calving%calving_rate) + if (associated(model%calving%calving_rate_tavg)) & + deallocate(model%calving%calving_rate_tavg) if (associated(model%calving%calving_mask)) & deallocate(model%calving%calving_mask) if (associated(model%calving%lateral_rate)) & diff --git a/libglide/glide_vars.def b/libglide/glide_vars.def index 6696154b..a9c6575f 100644 --- a/libglide/glide_vars.def +++ b/libglide/glide_vars.def @@ -537,6 +537,7 @@ units: meter/year long_name: rate of mass loss by calving data: data%calving%calving_rate coordinates: lon lat +average: 1 [calving_mask] dimensions: time, y1, x1 @@ -744,6 +745,7 @@ data: data%climate%acab_applied factor: scale_acab standard_name: land_ice_surface_specific_mass_balance_applied coordinates: lon lat +average: 1 [acab_anomaly] dimensions: time, y1, x1 @@ -811,6 +813,7 @@ data: data%basal_melt%bmlt_applied factor: scale_acab standard_name: land_ice_basal_melt_rate_applied coordinates: lon lat +average: 1 [bfricflx] dimensions: time, y1, x1 From 6edd866c6be60f0dc8b0864eced99e753b14d443 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 7 May 2018 15:19:00 -0600 Subject: [PATCH 44/61] Added an option to output global mass diagnostics in Gt/yr The global diagnostics in the log file include SMB, BMB and calving flux integrated over the full domain. These fluxes have been output in units of kg/s. For whole ice sheets, units of Gt/yr are more user-friendly. To support units of Gt/yr, I added a new config option, dm_dt_diag. If dm_dt_diag = 1 in the [options] section of the config file, the global mass fluxes will have units of Gt/yr. If dm_dt_diag = 0 (the default), then the units are kg/s as before. Note to Bill S.: For CESM runs, we will want to set dm_dt_diag = 1. That is, units of Gt/yr should be the CESM default, but not the standalone CISM default. This commit is BFB. --- libglide/glide_diagnostics.F90 | 53 +++++++++++++++++++++++++--------- libglide/glide_setup.F90 | 10 +++++++ libglide/glide_types.F90 | 9 ++++++ 3 files changed, 59 insertions(+), 13 deletions(-) diff --git a/libglide/glide_diagnostics.F90 b/libglide/glide_diagnostics.F90 index a3c05b1e..7b23a623 100644 --- a/libglide/glide_diagnostics.F90 +++ b/libglide/glide_diagnostics.F90 @@ -229,7 +229,8 @@ subroutine glide_write_diag (model, time, & load_diag, & artm_diag, acab_diag, & bmlt_diag, bwat_diag, & - bheatflx_diag, level + bheatflx_diag, level, & + factor ! unit conversion factor integer, dimension(model%general%ewn,model%general%nsn) :: & ice_mask, &! = 1 where ice is present with thck > minthick, else = 0 @@ -613,23 +614,49 @@ subroutine glide_write_diag (model, time, & if (model%options%whichdycore == DYCORE_GLISSADE) then - write(message,'(a25,e24.16)') 'Total SMB flux (kg/s) ', tot_smb_flux - call write_log(trim(message), type = GM_DIAGNOSTIC) + if (model%options%dm_dt_diag == DM_DT_DIAG_KG_S) then - write(message,'(a25,e24.16)') 'Total BMB flux (kg/s) ', tot_bmb_flux - call write_log(trim(message), type = GM_DIAGNOSTIC) + write(message,'(a25,e24.16)') 'Total SMB flux (kg/s) ', tot_smb_flux + call write_log(trim(message), type = GM_DIAGNOSTIC) - write(message,'(a25,e24.16)') 'Total calving flux (kg/s)', tot_calving_flux - call write_log(trim(message), type = GM_DIAGNOSTIC) + write(message,'(a25,e24.16)') 'Total BMB flux (kg/s) ', tot_bmb_flux + call write_log(trim(message), type = GM_DIAGNOSTIC) - write(message,'(a25,e24.16)') 'Total dmass/dt (kg/s) ', tot_dmass_dt - call write_log(trim(message), type = GM_DIAGNOSTIC) + write(message,'(a25,e24.16)') 'Total calving flux (kg/s)', tot_calving_flux + call write_log(trim(message), type = GM_DIAGNOSTIC) - write(message,'(a25,e24.16)') 'dmass/dt error (kg/s) ', err_dmass_dt - call write_log(trim(message), type = GM_DIAGNOSTIC) + write(message,'(a25,e24.16)') 'Total dmass/dt (kg/s) ', tot_dmass_dt + call write_log(trim(message), type = GM_DIAGNOSTIC) - write(message,'(a25,e24.16)') 'Total gr line flux (kg/s)', tot_gl_flux - call write_log(trim(message), type = GM_DIAGNOSTIC) + write(message,'(a25,e24.16)') 'dmass/dt error (kg/s) ', err_dmass_dt + call write_log(trim(message), type = GM_DIAGNOSTIC) + + write(message,'(a25,e24.16)') 'Total gr line flux (kg/s)', tot_gl_flux + call write_log(trim(message), type = GM_DIAGNOSTIC) + + elseif (model%options%dm_dt_diag == DM_DT_DIAG_GT_Y) then + + factor = scyr / 1.0d12 + + write(message,'(a25,e24.16)') 'Total SMB flux (Gt/y) ', tot_smb_flux * factor + call write_log(trim(message), type = GM_DIAGNOSTIC) + + write(message,'(a25,e24.16)') 'Total BMB flux (Gt/y) ', tot_bmb_flux * factor + call write_log(trim(message), type = GM_DIAGNOSTIC) + + write(message,'(a25,e24.16)') 'Total calving flux (Gt/y)', tot_calving_flux * factor + call write_log(trim(message), type = GM_DIAGNOSTIC) + + write(message,'(a25,e24.16)') 'Total dmass/dt (Gt/y) ', tot_dmass_dt * factor + call write_log(trim(message), type = GM_DIAGNOSTIC) + + write(message,'(a25,e24.16)') 'dmass/dt error (Gt/y) ', err_dmass_dt * factor + call write_log(trim(message), type = GM_DIAGNOSTIC) + + write(message,'(a25,e24.16)') 'Total gr line flux (Gt/y)', tot_gl_flux * factor + call write_log(trim(message), type = GM_DIAGNOSTIC) + + endif ! write(message,'(a25,e24.16)') 'Mean accum/ablat (m/yr) ', mean_acab ! call write_log(trim(message), type = GM_DIAGNOSTIC) diff --git a/libglide/glide_setup.F90 b/libglide/glide_setup.F90 index 0aee1684..0a984c86 100644 --- a/libglide/glide_setup.F90 +++ b/libglide/glide_setup.F90 @@ -589,6 +589,7 @@ subroutine handle_options(section, model) call GetValue(section,'remove_icebergs', model%options%remove_icebergs) call GetValue(section,'limit_marine_cliffs', model%options%limit_marine_cliffs) call GetValue(section,'cull_calving_front', model%options%cull_calving_front) + call GetValue(section,'dm_dt_diag',model%options%dm_dt_diag) call GetValue(section,'vertical_integration',model%options%whichwvel) call GetValue(section,'periodic_ew',model%options%periodic_ew) call GetValue(section,'sigma',model%options%which_sigma) @@ -789,6 +790,10 @@ subroutine print_options(model) 'calving only at the ocean edge ', & 'calving in all cells where criterion is met'/) + character(len=*), dimension(0:1), parameter :: dm_dt_diag = (/ & + 'write dmass/dt diagnostic in units of kg/s ', & + 'write dmass/dt diagnostic in units of Gt/yr'/) + character(len=*), dimension(0:1), parameter :: vertical_integration = (/ & 'standard ', & 'obey upper BC' /) @@ -1142,6 +1147,7 @@ subroutine print_options(model) endif else ! not Glissade + if (model%options%whichcalving == CALVING_THCK_THRESHOLD) then call write_log('Error, calving thickness threshold option is supported for Glissade dycore only', GM_FATAL) endif @@ -1188,6 +1194,10 @@ subroutine print_options(model) write(message,*) 'evolution : ', model%options%whichevol, evolution(model%options%whichevol) call write_log(message) + if (model%options%dm_dt_diag < 0 .or. model%options%dm_dt_diag >= size(dm_dt_diag)) then + call write_log('Error, dm_dt_diag out of range',GM_FATAL) + end if + if (model%options%whichwvel < 0 .or. model%options%whichwvel >= size(vertical_integration)) then call write_log('Error, vertical_integration out of range',GM_FATAL) end if diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index 1ffcd278..a3b20ef1 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -170,6 +170,9 @@ module glide_types integer, parameter :: VERTINT_STANDARD = 0 integer, parameter :: VERTINT_KINEMATIC_BC = 1 + integer, parameter :: DM_DT_DIAG_KG_S = 0 + integer, parameter :: DM_DT_DIAG_GT_Y = 1 + integer, parameter :: SIGMA_COMPUTE_GLIDE = 0 integer, parameter :: SIGMA_EXTERNAL = 1 integer, parameter :: SIGMA_CONFIG = 2 @@ -510,6 +513,12 @@ module glide_types !> if true, then cull calving_front cells at initialization !> This can make the run more stable by removing long, thin peninsulas + integer :: dm_dt_diag = 0 + !> \begin{description} + !> \item[0] Write dmass/dt diagnostic in units of kg/s + !> \item[0] Write dmass/dt diagnostic in units of Gt/yr + !> \end{description} + integer :: whichwvel = 0 !> Vertical velocities: From 5a70293ab9640cca07d1aa9171677ac8ca7ec9e0 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 7 May 2018 16:17:11 -0600 Subject: [PATCH 45/61] New option to prescribe a minimum thickness for diagnostics Global diagnostics are computed by integrating over all cells with ice. Here, 'with ice' could mean either 'with ice of nonzero thickness' or 'with ice thicker than some threshold thickness'. Until now, CISM has used a threshold of thklim (aka ice_limit, typically = 1 m). For some applications, however, we may prefer to sum over all cells with H > 0. To support this choice, I added an option 'diag_minthck': * If diag_minthck = 0, the global diagnostics will include all cells with H > 0 (actually eps = 1.d-11, to avoid roundoff issues). * If diag_minthck = 1 (the default), the global diagnostics will include all cells with H > thklim. With this new option, it is no longer necessary to pass a min_thick argument to glide_write_diagnostics from the cism_front_end module and other high-level modules. Note: It might be better to make diag_minthick a real-valued parameter that could have any value >= 0. For now I've made it a binary option, so as not to have to add this parameter to all the test config files. This commit is BFB. Diagnostics are unchanged unless the user sets diag_minthck = 0 in the config file. --- cism_driver/cism_front_end.F90 | 13 ++-------- libglad/glad_initialise.F90 | 3 +-- libglad/glad_timestep.F90 | 3 +-- libglide/glide_diagnostics.F90 | 47 ++++++++++++---------------------- libglide/glide_setup.F90 | 13 ++++++++++ libglide/glide_types.F90 | 11 +++++++- libglint/glint_initialise.F90 | 6 ++--- libglint/glint_timestep.F90 | 6 ++--- 8 files changed, 48 insertions(+), 54 deletions(-) diff --git a/cism_driver/cism_front_end.F90 b/cism_driver/cism_front_end.F90 index 4e582ade..c7f87849 100644 --- a/cism_driver/cism_front_end.F90 +++ b/cism_driver/cism_front_end.F90 @@ -213,14 +213,10 @@ subroutine cism_init_dycore(model) ! Write initial diagnostic output to log file ! Note: tstep_count is set to 0 at model initialization and then is incremented in cism_run_dycore ! before each call to a dycore. - ! Note: If minthick_in = 0, then all cells with nonzero ice thickness (including very thin ice) - ! will contribute to global diagnostics. call t_startf('initial_write_diagnostics') call glide_write_diagnostics(model, time, & - tstep_count = model%numerics%tstep_count, & - minthick_in = model%numerics%thklim*thk0) ! m -!! minthick_in = 0.0d0) ! m + tstep_count = model%numerics%tstep_count) call t_stopf('initial_write_diagnostics') end if ! whichdycore .ne. DYCORE_BISICLES @@ -347,14 +343,9 @@ subroutine cism_run_dycore(model) ! write ice sheet diagnostics to log file at desired interval (model%numerics%dt_diag) - ! Note: If minthick_in = 0, then all cells with nonzero ice thickness (including very thin ice) - ! will contribute to global diagnostics. - call t_startf('write_diagnostics') call glide_write_diagnostics(model, time, & - tstep_count = model%numerics%tstep_count, & - minthick_in = model%numerics%thklim*thk0) ! m -!! minthick_in = 0.0d0) ! m + tstep_count = model%numerics%tstep_count) call t_stopf('write_diagnostics') ! update time from dycore advance diff --git a/libglad/glad_initialise.F90 b/libglad/glad_initialise.F90 index 9764051c..5799d8d1 100644 --- a/libglad/glad_initialise.F90 +++ b/libglad/glad_initialise.F90 @@ -263,8 +263,7 @@ subroutine glad_i_initialise_gcm(config, instance, & call glide_write_diagnostics(instance%model, & instance%model%numerics%time, & - tstep_count = instance%model%numerics%tstep_count, & - minthick_in = instance%model%numerics%thklim*thk0) ! m + tstep_count = instance%model%numerics%tstep_count) ! Write netCDF output for this instance diff --git a/libglad/glad_timestep.F90 b/libglad/glad_timestep.F90 index 2942d4fa..b3e5acc9 100644 --- a/libglad/glad_timestep.F90 +++ b/libglad/glad_timestep.F90 @@ -255,8 +255,7 @@ subroutine glad_i_tstep_gcm(time, instance, & call glide_write_diagnostics(instance%model, & instance%model%numerics%time, & - tstep_count = instance%model%numerics%tstep_count, & - minthick_in = instance%model%numerics%thklim*thk0) ! m + tstep_count = instance%model%numerics%tstep_count) ! write netCDF output diff --git a/libglide/glide_diagnostics.F90 b/libglide/glide_diagnostics.F90 index 7b23a623..f29ac388 100644 --- a/libglide/glide_diagnostics.F90 +++ b/libglide/glide_diagnostics.F90 @@ -42,8 +42,7 @@ module glide_diagnostics contains subroutine glide_write_diagnostics (model, time, & - tstep_count, & - minthick_in) + tstep_count) ! Short driver subroutine to decide whether it's time to write diagnostics. ! If so, it calls glide_write_diag. @@ -57,25 +56,10 @@ subroutine glide_write_diagnostics (model, time, & integer, intent(in) :: tstep_count ! current timestep - real(dp), intent(in), optional :: & - minthick_in ! ice thickness threshold (m) for including in diagnostics - ! local arguments - real(dp) :: minthick ! ice thickness threshold (m) for including in diagnostics - ! defaults to eps (a small number) if not passed in - - real(dp), parameter :: & - eps = 1.0d-11 - logical, parameter :: verbose_diagnostics = .false. - if (present(minthick_in)) then - minthick = minthick_in - else - minthick = eps - endif - ! debug if (main_task .and. verbose_diagnostics) then print*, ' ' @@ -89,10 +73,7 @@ subroutine glide_write_diagnostics (model, time, & if (model%numerics%ndiag > 0) then if (mod(tstep_count, model%numerics%ndiag) == 0) then ! time to write - - call glide_write_diag(model, & - time, & - minthick) + call glide_write_diag(model, time) endif endif ! ndiag > 0 @@ -168,8 +149,7 @@ end subroutine glide_init_diag !-------------------------------------------------------------------------- - subroutine glide_write_diag (model, time, & - minthick) + subroutine glide_write_diag (model, time) ! Write global diagnostics ! Also write local diagnostics for a selected grid cell @@ -187,12 +167,11 @@ subroutine glide_write_diag (model, time, & type(glide_global_type), intent(inout) :: model ! model instance real(dp), intent(in) :: time ! current time in years - real(dp), intent(in) :: & - minthick ! ice thickness threshold (m) for including in diagnostics ! local variables real(dp) :: & + minthck, & ! ice thickness threshold (m) for global diagnostics tot_area, & ! total ice area (m^2) tot_area_ground, & ! total area of grounded ice (m^2) tot_area_float, & ! total area of floating ice (m^2) @@ -233,7 +212,7 @@ subroutine glide_write_diag (model, time, & factor ! unit conversion factor integer, dimension(model%general%ewn,model%general%nsn) :: & - ice_mask, &! = 1 where ice is present with thck > minthick, else = 0 + ice_mask, &! = 1 where ice is present with thck > minthck, else = 0 floating_mask ! = 1 where ice is present and floating, else = 0 real(dp), dimension(model%general%upn) :: & @@ -263,7 +242,8 @@ subroutine glide_write_diag (model, time, & ! optionally, divide by scale factor^2 to account for grid distortion real(dp), parameter :: & - eps = 1.0d-11 ! small number + eps = 1.0d-11, & ! small number + eps_thck = 1.0d-11 ! threshold thickness (m) for writing diagnostics ewn = model%general%ewn nsn = model%general%nsn @@ -301,13 +281,20 @@ subroutine glide_write_diag (model, time, & velo_ew_ubound = ewn-uhalo-1 end if + ! Set the minimum ice thickness for including cells in diagnostics + if (model%options%diag_minthck == DIAG_MINTHCK_ZERO) then + minthck = eps_thck ! slightly > 0 + elseif (model%options%diag_minthck == DIAG_MINTHCK_THKLIM) then + minthck = model%numerics%thklim*thk0 + endif + !----------------------------------------------------------------- ! Compute some masks that are useful for diagnostics !----------------------------------------------------------------- do j = 1, nsn do i = 1, ewn - if (model%geometry%thck(i,j)*thk0 > minthick) then + if (model%geometry%thck(i,j)*thk0 > minthck) then ice_mask(i,j) = 1 if (model%geometry%topg(i,j) - model%climate%eus < (-rhoi/rhoo)*model%geometry%thck(i,j)) then floating_mask(i,j) = 1 @@ -782,7 +769,7 @@ subroutine glide_write_diag (model, time, & do i = lhalo+1, velo_ew_ubound spd = sqrt(model%velocity%uvel(1,i,j)**2 & + model%velocity%vvel(1,i,j)**2) - if (model%geomderv%stagthck(i,j)*thk0 > minthick .and. spd > max_spd_sfc) then + if (model%geomderv%stagthck(i,j)*thk0 > minthck .and. spd > max_spd_sfc) then max_spd_sfc = spd imax = i jmax = j @@ -808,7 +795,7 @@ subroutine glide_write_diag (model, time, & do i = lhalo+1, velo_ew_ubound spd = sqrt(model%velocity%uvel(upn,i,j)**2 & + model%velocity%vvel(upn,i,j)**2) - if (model%geomderv%stagthck(i,j)*thk0 > minthick .and. spd > max_spd_bas) then + if (model%geomderv%stagthck(i,j)*thk0 > minthck .and. spd > max_spd_bas) then max_spd_bas = spd imax = i jmax = j diff --git a/libglide/glide_setup.F90 b/libglide/glide_setup.F90 index 0a984c86..76f1fb3f 100644 --- a/libglide/glide_setup.F90 +++ b/libglide/glide_setup.F90 @@ -590,6 +590,7 @@ subroutine handle_options(section, model) call GetValue(section,'limit_marine_cliffs', model%options%limit_marine_cliffs) call GetValue(section,'cull_calving_front', model%options%cull_calving_front) call GetValue(section,'dm_dt_diag',model%options%dm_dt_diag) + call GetValue(section,'diag_minthck',model%options%diag_minthck) call GetValue(section,'vertical_integration',model%options%whichwvel) call GetValue(section,'periodic_ew',model%options%periodic_ew) call GetValue(section,'sigma',model%options%which_sigma) @@ -794,6 +795,10 @@ subroutine print_options(model) 'write dmass/dt diagnostic in units of kg/s ', & 'write dmass/dt diagnostic in units of Gt/yr'/) + character(len=*), dimension(0:1), parameter :: diag_minthck = (/ & + 'include cells with H > 0 in global diagnostics ', & + 'include cells with H > thklim in global diagnostics'/) + character(len=*), dimension(0:1), parameter :: vertical_integration = (/ & 'standard ', & 'obey upper BC' /) @@ -1198,6 +1203,14 @@ subroutine print_options(model) call write_log('Error, dm_dt_diag out of range',GM_FATAL) end if + if (model%options%diag_minthck < 0 .or. model%options%diag_minthck >= size(diag_minthck)) then + call write_log('Error, diag_minthck out of range',GM_FATAL) + end if + + write(message,*) 'minthck for diagnostics : ',model%options%diag_minthck, & + diag_minthck(model%options%diag_minthck) + call write_log(message) + if (model%options%whichwvel < 0 .or. model%options%whichwvel >= size(vertical_integration)) then call write_log('Error, vertical_integration out of range',GM_FATAL) end if diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index a3b20ef1..1d50f10c 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -173,6 +173,9 @@ module glide_types integer, parameter :: DM_DT_DIAG_KG_S = 0 integer, parameter :: DM_DT_DIAG_GT_Y = 1 + integer, parameter :: DIAG_MINTHCK_ZERO = 0 + integer, parameter :: DIAG_MINTHCK_THKLIM = 1 + integer, parameter :: SIGMA_COMPUTE_GLIDE = 0 integer, parameter :: SIGMA_EXTERNAL = 1 integer, parameter :: SIGMA_CONFIG = 2 @@ -516,7 +519,13 @@ module glide_types integer :: dm_dt_diag = 0 !> \begin{description} !> \item[0] Write dmass/dt diagnostic in units of kg/s - !> \item[0] Write dmass/dt diagnostic in units of Gt/yr + !> \item[1] Write dmass/dt diagnostic in units of Gt/yr + !> \end{description} + + integer :: diag_minthck = 1 + !> \begin{description} + !> \item[0] Include cells with H > 0 in global diagnostics + !> \item[1] Include cells with H > thklim in global diagnostics !> \end{description} integer :: whichwvel = 0 diff --git a/libglint/glint_initialise.F90 b/libglint/glint_initialise.F90 index 9c7d5fab..0d75228b 100644 --- a/libglint/glint_initialise.F90 +++ b/libglint/glint_initialise.F90 @@ -292,8 +292,7 @@ subroutine glint_i_initialise(config, instance, & call glide_write_diagnostics(instance%model, & instance%model%numerics%time, & - tstep_count = instance%model%numerics%tstep_count, & - minthick_in = instance%model%numerics%thklim*thk0) ! m + tstep_count = instance%model%numerics%tstep_count) ! Write netCDF output for this instance @@ -537,8 +536,7 @@ subroutine glint_i_initialise_gcm(config, instance, & call glide_write_diagnostics(instance%model, & instance%model%numerics%time, & - tstep_count = instance%model%numerics%tstep_count, & - minthick_in = instance%model%numerics%thklim*thk0) ! m + tstep_count = instance%model%numerics%tstep_count) ! Write netCDF output for this instance diff --git a/libglint/glint_timestep.F90 b/libglint/glint_timestep.F90 index 7f54df1f..1611b7e1 100644 --- a/libglint/glint_timestep.F90 +++ b/libglint/glint_timestep.F90 @@ -309,8 +309,7 @@ subroutine glint_i_tstep(time, instance, & call glide_write_diagnostics(instance%model, & instance%model%numerics%time, & - tstep_count = instance%model%numerics%tstep_count, & - minthick_in = instance%model%numerics%thklim*thk0) ! m + tstep_count = instance%model%numerics%tstep_count) ! write netCDf output @@ -674,8 +673,7 @@ subroutine glint_i_tstep_gcm(time, instance, & call glide_write_diagnostics(instance%model, & instance%model%numerics%time, & - tstep_count = instance%model%numerics%tstep_count, & - minthick_in = instance%model%numerics%thklim*thk0) ! m + tstep_count = instance%model%numerics%tstep_count) ! write netCDF output From 7215935ffb87bf16cf18de4dbf5b7297e9817ca1 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Mon, 7 May 2018 17:34:02 -0600 Subject: [PATCH 46/61] Changed the Halfar higher-order config file I changed halfar-HO.config as follows: (1) Set dt = 1 yr instead of dt = 5 yr, since a shorter time step is more stable for HO runs. (2) Set which_ho_gradient = 2, since 2nd order upstream is more accurate than 1st order for Halfar. For standard FE assembly of beta and taud, the rms thickness error after 200 years is 13.63 m. For local assembly (not the current default, but likely to be the default soon), the rms thickness error is moderately reduced to 11.82 m. Also considered switching from BP to DIVA, but with otherwise identical settings, the rms errors with DIVA are 17.56 m with local assembly and 34.75 m with standard assembly. Later, we should look into why BP outperforms DIVA for Halfar. I also got rid of a stray .DS_Store file in the ismip-hom directory. This commit is BFB except for Halfar HO. --- libglide/glide_types.F90 | 1 - tests/halfar/halfar-HO.config | 10 ++++++---- tests/ismip-hom/.DS_Store | Bin 8196 -> 0 bytes 3 files changed, 6 insertions(+), 5 deletions(-) delete mode 100644 tests/ismip-hom/.DS_Store diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index 1d50f10c..e87767f2 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -766,7 +766,6 @@ module glide_types !> \item[0] standard finite-element calculation (which effectively smooths beta at discontinuities) !> \item[1] apply local value of beta at each vertex - !TODO - Change default method to (1), which is more stable. This will give BFB changes. integer :: which_ho_assemble_bfric = 0 !> Flag that describes how the basal friction heat flux is computed in the glissade finite-element calculation diff --git a/tests/halfar/halfar-HO.config b/tests/halfar/halfar-HO.config index 5d52ec5b..6c8740ed 100644 --- a/tests/halfar/halfar-HO.config +++ b/tests/halfar/halfar-HO.config @@ -8,8 +8,8 @@ dns = 2000 [time] tstart = 0. tend = 200. -dt = 5.0 -dt_diag = 5. +dt = 1. +dt_diag = 1. idiag = 10 jdiag = 10 @@ -18,14 +18,16 @@ dycore = 2 ;# 0 = glide, 1 = glam, 2 = glissade flow_law = 0 ;# 0 = flow_law option needs to be 0 for the test case to work properly. evolution = 3 ;# 2 = iterated diffusion, 3 = IR temperature = 0 ;# 0 = isothermal temp evolution, if turned on, will not affect flwa because default_flwa is specified below. +marine_margin = 0 ;# 0 = no calving [ho_options] which_ho_babc = 4 ;# 4 = no-slip at bed which_ho_efvs = 2 ;# 0 = constant, 2 = nonlinear eff. visc. w/ n=3 which_ho_sparse = 3 ;# 1 = SLAP GMRES, 3 = glissade parallel PCG, 4 = Trilinos for linear solver which_ho_nonlinear = 0 ;# 0 = Picard, 1 = JFNK -which_ho_approx = 2 ;# 1 = SSA, 2 = Blatter-Pattyn, 3 = L1L2 -which_ho_gradient = 1 ;# 0 = centered, 1 = upstream +which_ho_approx = 2 ;# 1 = SSA, 2 = Blatter-Pattyn, 4 = DIVA +which_ho_precond = 2 ;# 1 = diagonal, 2 = physics-based SIA +which_ho_gradient = 2 ;# 0 = centered, 1 = 1st order upstream, 2 = 2nd order upstream [parameters] ice_limit = 1. ;# min thickness (m) for dynamics diff --git a/tests/ismip-hom/.DS_Store b/tests/ismip-hom/.DS_Store deleted file mode 100644 index 2ecc83d8675da761d786cdda9ec68c0cf94a24dd..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 8196 zcmeHMUu+ab82`SbExUA~3sx!Y6|NS-pH%1{pb)KI|A71{X~VVj3dpf{yU^9W-EzBk zEiKiC#3w=H8==t{^+g-s6!cMjG3bMlCIk}H=!4M*eZWLXjPaY9y$fxjPsX6`Bs0I+ z`R1FM@7v$Z>~{wM*pWAy0BQh0qRddOq~acl$yuJ4B0)e znJ21K9KdyA0mcKI6v$O+Oc6a`po&3=fkK_+G1i?h9^j-vp$;h20fU(_h)|HvPI@uk z9WX91EJF{39+>X|7Q4$}fd^SC?~31Zj_o?9NXj-`1-Ot0pX5}gN4(**?WU>yYI@kV zJioE=Iz|?il~*j5WLc7zO3x&Q+>wN@`+2WJ&mHAYmSLuYdY|jsrMjLzY?&h|wYt-F zeBE-)++E#|4Oouhj&!(r$ME<#y}Ca{x_qLPx@vs9sbza}Lu|*+=81;bcx!88L#(xF z`^1DKtz6&Kw(mst%-HzZiRUlTYAIoGd_a|WE|pVMn`Nc#6*`5Lk(r{EH%nG7sZ^F~ z`ww&FI%~G-Nwh7Tc3#Uo~crouXw0hQI61iaD3~eW#;-vEW;lf)V+-97?yKtpkR4c z+BW+fJ!>w<23ek|S+%-Ki)w3%qPZ%PS}!H@Y3p>}^3U)&Vs)Bw%%G(lbPYC(p?)CA zT(Z7S(~dGpXU?S3kR;x`X|tyEd2Gdc&~eLFMd^EvUcBnj64=69wkcY_t*1>}HDsZ- zbC;qG6oj|c13_b3wW1|6ZZ=CMdO=%zho&88({}5g-!p7Fw4~2yZf;tgwpWq{nY7(7 zXi4?)bKi1K)W#4$-{1JYFpA(I5;LU)ZMcQ`HrY(Lym$rq( ztcz-P_wZ>!4=fVW8g^FfzW?w43yu*ALl1-=_;-5%%eoR>9b`lC)SYV%i?w5vPf%uw z^_vvPRjAwNrBWt=^y_gfPVpo_y0nlui^dAsrjES{sN%s BM;HJA From 794aad58c2785c35b7c3871373a2b926a975b458 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Tue, 8 May 2018 09:51:06 -0600 Subject: [PATCH 47/61] Fixed a bug in local assembly of taud I found and fixed a bug in the local assembly of the taud (surface elevation) term. The bug was discovered when comparing ISMIP-HOM results with BP for standard versus local assembly. The problem was an element-based assembly in the vertical, using layer thicknesses to compute the 3D load vector, instead of a vertex-based assembly, using staggered layer thicknesses. The bug was mostly inconsequential for DIVA runs, but caused large errors for BP runs. With the bug, ISMIP-HOM A speeds were too high by up to 20%. With the fix, ISMIP-HOM A results for local assembly are very similar to those for standard assembly, with differences < 1%. This commit changes results for runs with local assembly of taud, and otherwise is BFB. It is BFB for standard LIVV tests. --- libglissade/glissade_velo_higher.F90 | 40 +++++++++++++++++++--------- 1 file changed, 28 insertions(+), 12 deletions(-) diff --git a/libglissade/glissade_velo_higher.F90 b/libglissade/glissade_velo_higher.F90 index 8b6a482b..2bd72fd4 100644 --- a/libglissade/glissade_velo_higher.F90 +++ b/libglissade/glissade_velo_higher.F90 @@ -2088,10 +2088,10 @@ subroutine glissade_velo_higher_solve(model, & call t_startf('glissade_load_vector_gravity') call load_vector_gravity(nx, ny, & - nz, sigma, & - nhalo, & + nz, nhalo, & + sigma, stagwbndsigma, & dx, dy, & - active_cell, & + active_cell, & active_vertex, & xVertex, yVertex, & stagusrf, stagthck, & @@ -2237,9 +2237,23 @@ subroutine glissade_velo_higher_solve(model, & write(6,*) ' ' enddo - endif + else ! 3D solve + + do k = 1, nz + print*, ' ' + print*, 'loadu_3d, itest, jtest, rank, k =', itest, jtest, rtest, k + do j = jtest+3, jtest-3, -1 + write(6,'(i6)',advance='no') j + do i = itest-3, itest+3 + write(6,'(f10.2)',advance='no') loadu(k,i,j) + enddo + write(6,*) ' ' + enddo + enddo + + endif ! solve_2D - endif + endif ! verbose !------------------------------------------------------------------------------ ! Main outer loop: Iterate to solve the nonlinear problem @@ -4393,8 +4407,8 @@ end subroutine get_vertex_geometry !**************************************************************************** subroutine load_vector_gravity(nx, ny, & - nz, sigma, & - nhalo, & + nz, nhalo, & + sigma, stagwbndsigma, & dx, dy, & active_cell, & active_vertex, & @@ -4413,6 +4427,9 @@ subroutine load_vector_gravity(nx, ny, & real(dp), dimension(nz), intent(in) :: & sigma ! sigma vertical coordinate + real(dp), dimension(0:nz), intent(in) :: & + stagwbndsigma ! stagsigma augmented by sigma = 0 and 1 at upper and lower surfaces + real(dp), intent(in) :: & dx, dy ! grid cell length and width @@ -4480,19 +4497,18 @@ subroutine load_vector_gravity(nx, ny, & print*, 'i, j, dsdx, dsdy:', i, j, dusrf_dx(i,j), dusrf_dy(i,j) endif - do k = 1, nz-1 ! loop over elements in this column + do k = 1, nz ! loop over vertices in this column ! assume k increases from upper surface to bed - dz = stagthck(i,j) * (sigma(k+1) - sigma(k)) + dz = stagthck(i,j) * (stagwbndsigma(k) - stagwbndsigma(k-1)) ! Add the ds/dx and ds/dy terms to the load vector for this node loadu(k,i,j) = loadu(k,i,j) - rhoi*grav * dx*dy*dz/vol0 * dusrf_dx(i,j) loadv(k,i,j) = loadv(k,i,j) - rhoi*grav * dx*dy*dz/vol0 * dusrf_dy(i,j) - !TODO - Add the correct depth term if (verbose_load .and. this_rank==rtest .and. i==itest .and. j==jtest) then - print*, 'k, delta(loadu), delta(loadv):', k, -rhoi*grav*dx*dy*dz/vol0 * dusrf_dx(i,j), & - -rhoi*grav*dx*dy*dz/vol0 * dusrf_dy(i,j) + print*, 'k, dz, delta(loadu), delta(loadv):', k, dz, -rhoi*grav*dx*dy*dz/vol0 * dusrf_dx(i,j), & + -rhoi*grav*dx*dy*dz/vol0 * dusrf_dy(i,j) endif enddo ! k From 9b2e02b98ef8008569e7c96d389b4bb3984f6368 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Tue, 8 May 2018 10:29:53 -0600 Subject: [PATCH 48/61] Changed default assembly from standard to local Glissade has both standard and local options for assembling the taud (driving stress), beta (basal tractions) and bfric (basal friction) terms in the velocity solver: * The standard options use standard finite-element methods, summing over quadrature points in each element. This introduces some smoothing from adjacent vertices. * The local options use values of taud, beta, uvel and vvel at the local vertex, without including contributions from neighboring vertices. With this commit, the local assembly options for taud, beta and bfric become the default. On theoretical grounds, standard assembly should be slightly more accurate than local if there are smooth variations in surface elevation and basal traction, and no sharp boundaries. For the ISMIP-HOM tests, which are smooth in this sense, the differences between local and standard assembly of taud are very small--above roundoff level, but not enough to significantly change test results. By default, the ISMIP-HOM tests were already using local assembly for beta, so answer changes are due to local assembly of taud. Local assembly, however, is more robust for simulations of Greenland and Antarctica. Also, grounding-line calculations are more accurate at given resolution with local assembly, since there is no smearing of beta near the GL. This commit is answer-changing for any simulation that wasn't already using local assembly. In particular, results change for all standard LIVV tests: * Dome: Ice speeds can change locally by a few m/yr near the margin, leading to modest thickness changes of up to 4 m near the margin after 10 years. * ISMIP-HOM A and F: Small ice speed changes of ~0.1 m/yr, because of local taud assembly. * ISMIP-HOM C: Changes are near roundoff level. (Was already doing local assembly of beta, and local assembly of taud makes little difference for this problem.) * ISMIP-HOM F: Small ice speed changes of ~0.1 m/yr. * Circular shelf: Large differences in ice speed (~100 m/yr) near the pinning point, otherwise small changes. * Confined shelf: Small differences in ice speed (~1 m/yr) along the confined edges. * Stream: Roundoff-level changes. (Same comment as for ISMIP-HOM C.) So the LIVV tests require a new reference benchmark. Note to Bill S.: The new standalone CISM defaults are the same as the defaults we were already using in CESM. --- libglide/glide_types.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index e87767f2..07fa3906 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -752,21 +752,21 @@ module glide_types !> \item[0] first-order accurate in the vertical direction !> \item[1] second-order accurate in the vertical direction - integer :: which_ho_assemble_taud = 0 + integer :: which_ho_assemble_taud = 1 !> Flag that describes how driving-stress terms are assembled in the glissade finite-element calculation !> \begin{description} !> \item[0] standard finite-element calculation (which effectively smooths the driving stress) !> \item[1] apply local value of driving stress at each vertex - integer :: which_ho_assemble_beta = 0 + integer :: which_ho_assemble_beta = 1 !> Flag that describes how beta terms are assembled in the glissade finite-element calculation !> \begin{description} !> \item[0] standard finite-element calculation (which effectively smooths beta at discontinuities) !> \item[1] apply local value of beta at each vertex - integer :: which_ho_assemble_bfric = 0 + integer :: which_ho_assemble_bfric = 1 !> Flag that describes how the basal friction heat flux is computed in the glissade finite-element calculation !> \begin{description} From ff28953dff72b40e7bfa7bb1a734298bfcfdffda Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Tue, 8 May 2018 13:51:52 -0600 Subject: [PATCH 49/61] Changed default basal_mbal from 0 to 1 Since Glide days, the default value of basal_mbal has been 0, meaning that basal melt is not included in the continuity equation. This setting is appropriate for idealized tests like EISMINT-2, but not for realistic prognostic simulations. More than once, users have forgetten to override the default in the config file, with undesirable results. I changed the default value to 1, meaning that basal melt *is* included in the continuity equation. I inserted 'basal_mass_balance = 0' in EISMINT-1, EISMINT-2 and related config files, so that answers for these tests would not change. I verified BFB for eismint test A. Also, I changed the restart logic and file names for the EISMINT tests, to be consistent with the way CISM now handles restart files. This change is BFB for the standard LIVV tests, which have no basal melting. It is answer-changing for simulations that have basal melting without explicitly setting basal_mbal. --- libglide/glide_types.F90 | 22 ++++++++++------------ tests/EISMINT/EISMINT-1/e1-fm.1.config | 1 + tests/EISMINT/EISMINT-1/e1-fm.2.config | 1 + tests/EISMINT/EISMINT-1/e1-fm.3.config | 1 + tests/EISMINT/EISMINT-1/e1-mm.1.config | 1 + tests/EISMINT/EISMINT-1/e1-mm.2.config | 1 + tests/EISMINT/EISMINT-1/e1-mm.3.config | 1 + tests/EISMINT/EISMINT-2/e2.a.config | 9 ++++++--- tests/EISMINT/EISMINT-2/e2.b.config | 5 +++-- tests/EISMINT/EISMINT-2/e2.c.config | 5 +++-- tests/EISMINT/EISMINT-2/e2.d.config | 5 +++-- tests/EISMINT/EISMINT-2/e2.f.config | 8 +++++--- tests/EISMINT/EISMINT-2/e2.g.config | 1 + tests/EISMINT/EISMINT-2/e2.h.config | 1 + tests/EISMINT/EISMINT-2/e2.i.config | 8 +++++--- tests/EISMINT/EISMINT-2/e2.j.config | 5 +++-- tests/EISMINT/EISMINT-2/e2.k.config | 8 +++++--- tests/EISMINT/EISMINT-2/e2.l.config | 5 +++-- tests/EISMINT/isos/isos.elfa.config | 1 + tests/EISMINT/isos/isos.elra.config | 1 + tests/EISMINT/isos/isos.llfa.config | 1 + tests/EISMINT/isos/isos.llra.config | 1 + tests/halfar/halfar-HO.config | 1 + tests/halfar/halfar.config | 1 + 24 files changed, 60 insertions(+), 34 deletions(-) diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index 07fa3906..180f3184 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -348,6 +348,7 @@ module glide_types integer :: whichevol = 0 + !TODO: Break into two options: one set (0, 1, 2) for Glide and one set (3, 4, 5) for Glissade !> Thickness evolution method: !> \begin{description} !> \item[0] Pseudo-diffusion @@ -393,7 +394,7 @@ module glide_types integer :: whichbtrc = 0 - !> Basal slip coefficient: + !> Basal slip coefficient (used for glide and for glissade local SIA; not glissade HO): !> \begin{description} !> \item[0] Set equal to zero everywhere !> \item[1] Set to (non--zero) constant @@ -427,8 +428,7 @@ module glide_types logical :: enable_bmlt_anomaly = .false. !> if true, then apply a prescribed anomaly to bmlt_float - !TODO - Change default basal_mbal to 1 - integer :: basal_mbal = 0 + integer :: basal_mbal = 1 !> basal mass balance: !> \begin{description} @@ -504,7 +504,7 @@ module glide_types !> \item[1] Calve wherever the calving criterion is met !> \end{description} - logical :: remove_icebergs = .true. + logical :: remove_icebergs = .true. !> if true, then identify and remove icebergs after calving !> These are connected regions with zero basal traction and no connection to grounded ice. !> Safer to make it true, but not necessary for all applications @@ -533,8 +533,7 @@ module glide_types !> Vertical velocities: !> \begin{description} !> \item[0] Usual vertical integration - !> \item[1] Vertical integration constrained so that - !> upper kinematic B.C. obeyed + !> \item[1] Vertical integration constrained to obey upper kinematic BC !> \end{description} integer :: which_sigma = 0 @@ -548,7 +547,6 @@ module glide_types !> \end{description} !TODO - Make is_restart a logical variable? - integer :: is_restart = 0 !> if the run is a restart of a previous run !> \begin{description} @@ -574,8 +572,8 @@ module glide_types !> \end{description} !----------------------------------------------------------------------- - ! Higher-order options - ! Associated with Payne-Price dycore (glam) and newer glissade dycore + ! Higher-order options associated with the glissade dycore + ! Most options also work with Payne-Price dycore (glam) !----------------------------------------------------------------------- integer :: which_ho_efvs = 2 @@ -624,7 +622,7 @@ module glide_types !> \item[14] simple hard-coded pattern (useful for debugging) !> \end{description} - integer :: which_ho_inversion + integer :: which_ho_inversion = 0 !> Flag for basal traction inversion options !> Note: Inversion is currently supported for which_ho_babc = 11 only !> \begin{description} @@ -788,7 +786,7 @@ module glide_types !> \item[2] fground = 1 in all cells integer :: which_ho_ground_bmlt = 0 - !> Flag that indicates how to compute bmlt_float in partly grouned cells + !> Flag that indicates how to compute bmlt_float in partly grounded cells !> \begin{description} !> \item[0] Apply bmlt_float in all floating cells, including partly grounded cells !> \item[1] Do not apply bmlt_float in partly grounded cells @@ -802,7 +800,7 @@ module glide_types !> \item[1] f_flotation = (rhoi*H)/(-rhow*b) = 1/f_pattyn; >=1 for grounded, < 1 for floating !> \item[2] f_flotation = -rhow*b - rhoi*H = ocean cavity thickness; <=0 for grounded, > 0 for floating - integer :: which_ho_ice_age = 1 + integer :: which_ho_ice_age = 1 !> Flag that indicates whether to compute a 3d ice age tracer !> \item[0] ice age computation off !> \item[1] ice age computation on diff --git a/tests/EISMINT/EISMINT-1/e1-fm.1.config b/tests/EISMINT/EISMINT-1/e1-fm.1.config index c8f9ee0e..46f353ed 100644 --- a/tests/EISMINT/EISMINT-1/e1-fm.1.config +++ b/tests/EISMINT/EISMINT-1/e1-fm.1.config @@ -19,6 +19,7 @@ marine_margin = 3 evolution = 0 basal_water = 0 vertical_integration = 1 +basal_mass_balance = 0 [time] tend = 200000. diff --git a/tests/EISMINT/EISMINT-1/e1-fm.2.config b/tests/EISMINT/EISMINT-1/e1-fm.2.config index f1a2e229..c244d46d 100644 --- a/tests/EISMINT/EISMINT-1/e1-fm.2.config +++ b/tests/EISMINT/EISMINT-1/e1-fm.2.config @@ -20,6 +20,7 @@ marine_margin = 3 evolution = 0 basal_water = 0 vertical_integration = 1 +basal_mass_balance = 0 [time] tend = 200000. diff --git a/tests/EISMINT/EISMINT-1/e1-fm.3.config b/tests/EISMINT/EISMINT-1/e1-fm.3.config index 892049d8..5cdca7cf 100644 --- a/tests/EISMINT/EISMINT-1/e1-fm.3.config +++ b/tests/EISMINT/EISMINT-1/e1-fm.3.config @@ -20,6 +20,7 @@ marine_margin = 3 evolution = 0 basal_water = 0 vertical_integration = 1 +basal_mass_balance = 0 [time] tend = 200000. diff --git a/tests/EISMINT/EISMINT-1/e1-mm.1.config b/tests/EISMINT/EISMINT-1/e1-mm.1.config index 4528ad87..72f8c441 100644 --- a/tests/EISMINT/EISMINT-1/e1-mm.1.config +++ b/tests/EISMINT/EISMINT-1/e1-mm.1.config @@ -21,6 +21,7 @@ marine_margin = 3 evolution = 0 basal_water = 0 vertical_integration = 1 +basal_mass_balance = 0 [time] tend = 200000. diff --git a/tests/EISMINT/EISMINT-1/e1-mm.2.config b/tests/EISMINT/EISMINT-1/e1-mm.2.config index d83ec041..5f9cf983 100644 --- a/tests/EISMINT/EISMINT-1/e1-mm.2.config +++ b/tests/EISMINT/EISMINT-1/e1-mm.2.config @@ -22,6 +22,7 @@ marine_margin = 3 evolution = 0 basal_water = 0 vertical_integration = 1 +basal_mass_balance = 0 [time] tend = 200000. diff --git a/tests/EISMINT/EISMINT-1/e1-mm.3.config b/tests/EISMINT/EISMINT-1/e1-mm.3.config index 0a5267db..b77056d4 100644 --- a/tests/EISMINT/EISMINT-1/e1-mm.3.config +++ b/tests/EISMINT/EISMINT-1/e1-mm.3.config @@ -22,6 +22,7 @@ marine_margin = 3 evolution = 0 basal_water = 0 vertical_integration = 1 +basal_mass_balance = 0 [time] tend = 200000. diff --git a/tests/EISMINT/EISMINT-2/e2.a.config b/tests/EISMINT/EISMINT-2/e2.a.config index fe28d608..58638007 100644 --- a/tests/EISMINT/EISMINT-2/e2.a.config +++ b/tests/EISMINT/EISMINT-2/e2.a.config @@ -20,6 +20,7 @@ marine_margin = 3 evolution = 0 basal_water = 1 vertical_integration = 1 +basal_mass_balance = 0 [time] tend = 200000. @@ -38,8 +39,10 @@ name: e2.a.nc frequency: 1000 variables: thk bmlt_ground btemp temp uvel vvel wvel wgrd acab diffu -[CF output] -name: e2.a.hot.nc +[CF restart] +name: e2.a.restart.nc xtype: double frequency: 100000 -variables: hot +variables: restart +write_init: F + diff --git a/tests/EISMINT/EISMINT-2/e2.b.config b/tests/EISMINT/EISMINT-2/e2.b.config index e1d5a6a9..44b56d63 100644 --- a/tests/EISMINT/EISMINT-2/e2.b.config +++ b/tests/EISMINT/EISMINT-2/e2.b.config @@ -20,8 +20,9 @@ slip_coeff = 0 marine_margin = 3 evolution = 0 basal_water = 1 -hotstart = 1 vertical_integration = 1 +basal_mass_balance = 0 +restart = 1 [time] tstart = 200000. @@ -42,5 +43,5 @@ frequency: 1000 variables: thk bmlt_ground btemp temp uvel vvel wvel wgrd acab diffu [CF input] -name: e2.a.hot.nc +name: e2.a.restart.nc time: 2 diff --git a/tests/EISMINT/EISMINT-2/e2.c.config b/tests/EISMINT/EISMINT-2/e2.c.config index 9c2eb4bd..789691ef 100644 --- a/tests/EISMINT/EISMINT-2/e2.c.config +++ b/tests/EISMINT/EISMINT-2/e2.c.config @@ -20,8 +20,9 @@ slip_coeff = 0 marine_margin = 3 evolution = 0 basal_water = 1 -hotstart = 1 vertical_integration = 1 +basal_mass_balance = 0 +restart = 1 [time] tstart = 200000. @@ -42,5 +43,5 @@ frequency: 1000 variables: thk bmlt_ground btemp temp uvel vvel wvel wgrd acab diffu [CF input] -name: e2.a.hot.nc +name: e2.a.restart.nc time: 2 diff --git a/tests/EISMINT/EISMINT-2/e2.d.config b/tests/EISMINT/EISMINT-2/e2.d.config index 12bcb195..f5f150fd 100644 --- a/tests/EISMINT/EISMINT-2/e2.d.config +++ b/tests/EISMINT/EISMINT-2/e2.d.config @@ -20,8 +20,9 @@ slip_coeff = 0 marine_margin = 3 evolution = 0 basal_water = 1 -hotstart = 1 vertical_integration = 1 +basal_mass_balance = 0 +restart = 1 [time] tstart = 200000. @@ -42,5 +43,5 @@ frequency: 1000 variables: thk bmlt_ground btemp temp uvel vvel wvel wgrd acab diffu [CF input] -name: e2.a.hot.nc +name: e2.a.restart.nc time: 2 diff --git a/tests/EISMINT/EISMINT-2/e2.f.config b/tests/EISMINT/EISMINT-2/e2.f.config index 0235d6b4..19dd33d3 100644 --- a/tests/EISMINT/EISMINT-2/e2.f.config +++ b/tests/EISMINT/EISMINT-2/e2.f.config @@ -21,6 +21,7 @@ marine_margin = 3 evolution = 2 basal_water = 1 vertical_integration = 1 +basal_mass_balance = 0 [time] tend = 200000. @@ -39,9 +40,10 @@ name: e2.f.nc frequency: 1000 variables: thk bmlt_ground btemp temp uvel vvel wvel wgrd acab diffu -[CF output] -name: e2.f.hot.nc +[CF restart] +name: e2.f.restart.nc frequency: 100000 xtype: double -variables: hot +variables: restart +write_init: F diff --git a/tests/EISMINT/EISMINT-2/e2.g.config b/tests/EISMINT/EISMINT-2/e2.g.config index de8b579c..9e8a0a67 100644 --- a/tests/EISMINT/EISMINT-2/e2.g.config +++ b/tests/EISMINT/EISMINT-2/e2.g.config @@ -20,6 +20,7 @@ evolution = 0 basal_water = 1 slip_coeff = 1 vertical_integration = 1 +basal_mass_balance = 0 [time] tend = 200000. diff --git a/tests/EISMINT/EISMINT-2/e2.h.config b/tests/EISMINT/EISMINT-2/e2.h.config index 753a38f5..c09bee0a 100644 --- a/tests/EISMINT/EISMINT-2/e2.h.config +++ b/tests/EISMINT/EISMINT-2/e2.h.config @@ -20,6 +20,7 @@ evolution = 0 basal_water = 1 slip_coeff = 2 # could also set slip_coeff = 3 (constant where T = Tpmp) vertical_integration = 1 +basal_mass_balance = 0 [time] tend = 200000. diff --git a/tests/EISMINT/EISMINT-2/e2.i.config b/tests/EISMINT/EISMINT-2/e2.i.config index cf35c140..954235e9 100644 --- a/tests/EISMINT/EISMINT-2/e2.i.config +++ b/tests/EISMINT/EISMINT-2/e2.i.config @@ -20,6 +20,7 @@ marine_margin = 3 evolution = 0 basal_water = 1 vertical_integration = 1 +basal_mass_balance = 0 [time] tend = 200000. @@ -41,8 +42,9 @@ name: e2.i.nc frequency: 1000 variables: topg thk bmlt_ground btemp temp uvel vvel wvel wgrd acab diffu -[CF output] -name: e2.i.hot.nc +[CF restart] +name: e2.i.restart.nc frequency: 100000 xtype: double -variables: hot +variables: restart +write_init: F \ No newline at end of file diff --git a/tests/EISMINT/EISMINT-2/e2.j.config b/tests/EISMINT/EISMINT-2/e2.j.config index bf149f55..d38fd9ec 100644 --- a/tests/EISMINT/EISMINT-2/e2.j.config +++ b/tests/EISMINT/EISMINT-2/e2.j.config @@ -20,8 +20,9 @@ isostasy = 0 marine_margin = 3 evolution = 0 basal_water = 1 -hotstart = 1 vertical_integration = 1 +basal_mass_balance = 0 +restart = 1 [time] tstart = 200000. @@ -42,5 +43,5 @@ frequency: 1000 variables: topg thk bmlt_ground btemp temp uvel vvel wvel wgrd acab diffu [CF input] -name: e2.i.hot.nc +name: e2.i.restart.nc time: 2 diff --git a/tests/EISMINT/EISMINT-2/e2.k.config b/tests/EISMINT/EISMINT-2/e2.k.config index 329c38fd..dc5318f1 100644 --- a/tests/EISMINT/EISMINT-2/e2.k.config +++ b/tests/EISMINT/EISMINT-2/e2.k.config @@ -20,6 +20,7 @@ marine_margin = 3 evolution = 0 basal_water = 1 vertical_integration = 1 +basal_mass_balance = 0 [time] tend = 200000. @@ -41,8 +42,9 @@ name: e2.k.nc frequency: 1000 variables: topg thk bmlt_ground btemp temp uvel vvel wvel wgrd acab diffu -[CF output] -name: e2.k.hot.nc +[CF restart] +name: e2.k.restart.nc frequency: 100000 xtype: double -variables: hot +variables: restart +write_init: F diff --git a/tests/EISMINT/EISMINT-2/e2.l.config b/tests/EISMINT/EISMINT-2/e2.l.config index 234bdddc..1ffae6fe 100644 --- a/tests/EISMINT/EISMINT-2/e2.l.config +++ b/tests/EISMINT/EISMINT-2/e2.l.config @@ -20,8 +20,9 @@ isostasy = 0 marine_margin = 3 evolution = 0 basal_water = 1 -hotstart = 1 vertical_integration = 1 +basal_mass_balance = 0 +restart = 1 [time] tstart = 200000. @@ -42,5 +43,5 @@ frequency: 1000 variables: topg thk bmlt_ground btemp temp uvel vvel wvel wgrd acab diffu [CF input] -name: e2.k.hot.nc +name: e2.k.restart.nc time: 2 diff --git a/tests/EISMINT/isos/isos.elfa.config b/tests/EISMINT/isos/isos.elfa.config index 13be518f..495b0e5a 100644 --- a/tests/EISMINT/isos/isos.elfa.config +++ b/tests/EISMINT/isos/isos.elfa.config @@ -25,6 +25,7 @@ evolution = 2 basal_water = 0 vertical_integration = 0 isostasy = 1 +basal_mass_balance = 0 [time] tend = 50000. diff --git a/tests/EISMINT/isos/isos.elra.config b/tests/EISMINT/isos/isos.elra.config index c457e50d..b68c4733 100644 --- a/tests/EISMINT/isos/isos.elra.config +++ b/tests/EISMINT/isos/isos.elra.config @@ -25,6 +25,7 @@ evolution = 2 basal_water = 0 vertical_integration = 0 isostasy = 1 +basal_mass_balance = 0 [time] tend = 50000. diff --git a/tests/EISMINT/isos/isos.llfa.config b/tests/EISMINT/isos/isos.llfa.config index 252bc3a3..5b6c4677 100644 --- a/tests/EISMINT/isos/isos.llfa.config +++ b/tests/EISMINT/isos/isos.llfa.config @@ -25,6 +25,7 @@ evolution = 2 basal_water = 0 vertical_integration = 0 isostasy = 1 +basal_mass_balance = 0 [time] tend = 50000. diff --git a/tests/EISMINT/isos/isos.llra.config b/tests/EISMINT/isos/isos.llra.config index 54ac82e0..cef28aca 100644 --- a/tests/EISMINT/isos/isos.llra.config +++ b/tests/EISMINT/isos/isos.llra.config @@ -25,6 +25,7 @@ evolution = 2 basal_water = 0 vertical_integration = 0 isostasy = 1 +basal_mass_balance = 0 [time] tend = 50000. diff --git a/tests/halfar/halfar-HO.config b/tests/halfar/halfar-HO.config index 6c8740ed..030f4d4c 100644 --- a/tests/halfar/halfar-HO.config +++ b/tests/halfar/halfar-HO.config @@ -19,6 +19,7 @@ flow_law = 0 ;# 0 = flow_law option needs to be 0 for the test case t evolution = 3 ;# 2 = iterated diffusion, 3 = IR temperature = 0 ;# 0 = isothermal temp evolution, if turned on, will not affect flwa because default_flwa is specified below. marine_margin = 0 ;# 0 = no calving +basal_mass_balance = 0 ;# 0 = bmlt not in continuity equation [ho_options] which_ho_babc = 4 ;# 4 = no-slip at bed diff --git a/tests/halfar/halfar.config b/tests/halfar/halfar.config index 95dcfa89..65055563 100644 --- a/tests/halfar/halfar.config +++ b/tests/halfar/halfar.config @@ -18,6 +18,7 @@ dycore = 0 ;# 0 = glide, 1 = glam flow_law = 0 ;# 0 = NOTE: flow_law option needs to be 0 for the test case to work properly. evolution = 2 ;# 2 = iterated diffusion temperature = 0 ;# 0 = isothermal temp. If temp is turned on, will not affect flwa because flow_law=0. +basal_mass_balance = 0 ;# 0 = bmlt not in continuity equation [ho_options] # Note: these are ignored for SIA (glide dycore) From 050bb1e969968d85432d35189cf222dc234199e6 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Tue, 8 May 2018 14:05:13 -0600 Subject: [PATCH 50/61] Changed default which_ho_flotation_function from 1 to 2 There are three options for setting the flotation function when running with a GLP: (0) Pattyn, (1) inverse-Pattyn, and (2) linear. (The flotation function is computed at cell centers, then bilinearly interpolated to determine the grounded fraction at the vertex.) Recent runs have used which_ho_flotation_function = 2, which is linear in both thck and topg. This function has a simple physical interpretation; for floating ice, the flotation function is equal to the depth of the sub-shelf cavity. It seems to be robust. With this commit, it is the default. Answers change only for runs that use a GLP without explicitly overriding the default. --- libglide/glide_setup.F90 | 14 ++++++++------ libglide/glide_types.F90 | 3 +-- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/libglide/glide_setup.F90 b/libglide/glide_setup.F90 index 76f1fb3f..403f8e24 100644 --- a/libglide/glide_setup.F90 +++ b/libglide/glide_setup.F90 @@ -1498,12 +1498,14 @@ subroutine print_options(model) call write_log('Error, ho_ground_bmlt option out of range for glissade dycore', GM_FATAL) end if - write(message,*) 'ho_whichflotation_function:',model%options%which_ho_flotation_function, & - ho_whichflotation_function(model%options%which_ho_flotation_function) - call write_log(message) - if (model%options%which_ho_flotation_function < 0 .or. & - model%options%which_ho_flotation_function >= size(ho_whichflotation_function)) then - call write_log('Error, flotation_function option out of range for glissade dycore', GM_FATAL) + if (model%options%which_ho_ground == HO_GROUND_GLP) then + write(message,*) 'ho_whichflotation_function:',model%options%which_ho_flotation_function, & + ho_whichflotation_function(model%options%which_ho_flotation_function) + call write_log(message) + if (model%options%which_ho_flotation_function < 0 .or. & + model%options%which_ho_flotation_function >= size(ho_whichflotation_function)) then + call write_log('Error, flotation_function option out of range for glissade dycore', GM_FATAL) + endif end if write(message,*) 'ho_whichice_age : ',model%options%which_ho_ice_age, & diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index 180f3184..f2a8eead 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -791,8 +791,7 @@ module glide_types !> \item[0] Apply bmlt_float in all floating cells, including partly grounded cells !> \item[1] Do not apply bmlt_float in partly grounded cells - !TODO - Change default to linear function 2? - integer :: which_ho_flotation_function = 1 + integer :: which_ho_flotation_function = 2 !> Flag that indicates how to compute the flotation function at and near vertices in the glissade dycore !> Not valid for other dycores !> \begin{description} From 746977864ee9c7ae1701a95b698d2f524cf5e83e Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Tue, 8 May 2018 16:24:09 -0600 Subject: [PATCH 51/61] Changed default beta_grounded_min from 0 to 1 Pa/(m/yr) It makes physical sense to have beta > 0 for grounded ice. With this commit, the minimum beta for grounded ice is 1 Pa/(m/yr), if not specified in the config file. This value is answer-changing for ISMIP-HOM C (which has prescribed beta = 0 at some points) and both shelf tests. Changes are very small (< 1 m/yr) for ISMIP-HOM C and the circular shelf, and slightly larger (~5 m/yr) for the confined shelf. To avoid changing answers in LIVV, I inserted 'beta_grounded_min = 0.' in the default config files for these tests. I also specified beta_grounded_min = 0 for the stream test, although in practice the minimum beta is ~5 Pa/(m/yr) for this test. In realistic simulations, I have found Antarctic runs to be marginally stable for beta ~1 Pa/(m/yr). Greenland runs typically require a larger value for stability, in the range ~10-100 Pa/(m/yr). The CESM default for Greenland is currently 100. --- libglide/glide_types.F90 | 12 +++++------- tests/ismip-hom/ismip-hom.config | 1 + tests/shelf/shelf-circular.config | 1 + tests/shelf/shelf-confined.config | 1 + tests/stream/stream.config | 1 + 5 files changed, 9 insertions(+), 7 deletions(-) diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index f2a8eead..ea8d8aee 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -487,7 +487,7 @@ module glide_types !> \item[5] Set thickness to zero based on grid location (field 'calving_mask') !> \item[6] Set thickness to zero if ice at marine margin is thinner than !> a certain value (variable 'calving_minthck' in glide_types) - !> \item[7] Set thickness to zero based on strain rate (eigencalving) criterion + !> \item[7] Set thickness to zero based on stress (eigencalving) criterion !> \item[8] Calve ice that is sufficiently damaged !> \item[9] Huybrechts grounding line scheme for Greenland initialization !> \end{description} @@ -1136,7 +1136,7 @@ module glide_types real(dp),dimension(:,:), pointer :: tau_eff => null() !> effective stress (Pa) for calving; derived from tau_eigen1, tau_eigen2 real(dp),dimension(:,:,:),pointer :: damage => null() !> 3D damage tracer, 0 > damage < 1 (whichcalving = CALVING_DAMAGE) - real(dp) :: marine_limit = -200.d0 !> minimum value of topg/relx before floating ice calves + real(dp) :: marine_limit = -200.d0 !> value of topg/relx at which floating ice calves (m) !> (whichcalving = CALVING_RELX_THRESHOLD, CALVING_TOPG_THRESHOLD) real(dp) :: calving_fraction = 0.2d0 !> fractional thickness of floating ice that calves !> (whichcalving = CALVING_FLOAT_FRACTION) @@ -1408,11 +1408,9 @@ module glide_types !< Holds variables related to basal physics associated with ice dynamics !< See glissade_basal_traction.F90 for usage details - !WHL - A reasonable value of beta_grounded_min might be 100 Pa yr/m. - ! However, this choice is not BFB for the confined-shelf test case, so I am choosing a default value of 0 for now. - ! The default can be overridden in the config file. - !TODO: Set beta_grounded_min = 100 Pa yr/m - real(dp) :: beta_grounded_min = 0.d0 !> minimum value of beta for grounded ice, Pa yr/m (glissade only; scaled during init) + !Note: By default, beta_grounded_min is set to a small nonzero value. + ! Larger values (~10 to 100 Pa yr/m) might be needed for stability in realistic simulations. + real(dp) :: beta_grounded_min = 1.0d0 !> minimum value of beta for grounded ice, Pa yr/m (glissade only; scaled during init) real(dp) :: ho_beta_const = 1000.d0 !> spatially uniform beta for HO dycores, Pa yr/m (scaled during init) real(dp) :: ho_beta_small = 1000.d0 !> small beta for sliding over a thawed bed, Pa yr/m (scaled during init) diff --git a/tests/ismip-hom/ismip-hom.config b/tests/ismip-hom/ismip-hom.config index b5db055f..dde5efca 100644 --- a/tests/ismip-hom/ismip-hom.config +++ b/tests/ismip-hom/ismip-hom.config @@ -32,6 +32,7 @@ which_ho_nonlinear = 0 # 0 = Picard, 1 = JFNK which_ho_assemble_beta = 1 # 0=smoothed by FEM assembly, 1 = local approx. [parameters] +beta_grounded_min = 0. [CF default] comment = generated by runISMIPHOM.py diff --git a/tests/shelf/shelf-circular.config b/tests/shelf/shelf-circular.config index 8d666d84..537b6539 100644 --- a/tests/shelf/shelf-circular.config +++ b/tests/shelf/shelf-circular.config @@ -30,6 +30,7 @@ which_ho_precond = 2 # 0 = none, 1 = diagonal, 2 = SIA based (ONLY use for wh [parameters] default_flwa = 5.7e-18 +beta_grounded_min = 0. [CF default] comment = created by runShelfCircular.py diff --git a/tests/shelf/shelf-confined.config b/tests/shelf/shelf-confined.config index 0fe8c29c..aaa34a88 100644 --- a/tests/shelf/shelf-confined.config +++ b/tests/shelf/shelf-confined.config @@ -31,6 +31,7 @@ which_ho_gradient_margin = 2 # 0 = land BC, 1 = hybrid BC, 2 = shelf BC [parameters] default_flwa = 5.7e-18 +beta_grounded_min = 0. [CF default] comment = Same as experiment 3 from EISMINT-shelf diff --git a/tests/stream/stream.config b/tests/stream/stream.config index 1196a280..75f49b58 100644 --- a/tests/stream/stream.config +++ b/tests/stream/stream.config @@ -27,6 +27,7 @@ glissade_maxiter = 300 # max. no. of nonlinear (Picard) iterations for Glis [parameters] periodic_offset_ew = 30.0 +beta_grounded_min = 0. [CF default] comment = none From d52aa5909b51ad8a9ed1af3090b558d2fd57838e Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Tue, 8 May 2018 16:32:42 -0600 Subject: [PATCH 52/61] Changed default upn from 1 to 3 The number of velocity levels is upn, which usually is specified in the config file. But the model will not run with upn = 1, which was the old default. With upn = 3, the velocity solvers will work and the model will run. So with this change, it is not required to set upn in the config file. Answers with upn = 3 should be sensible, though perhaps not very accurate. Note: ewn and nsn = 0 by default, and still must be specified in the config file. --- libglide/glide_types.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index ea8d8aee..9c35531d 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -311,7 +311,7 @@ module glide_types integer :: ewn = 0 !> The number of grid-points in the E-W direction. integer :: nsn = 0 !> The number of grid-points in the N-S direction. - integer :: upn = 1 !> The number of vertical levels in the model. + integer :: upn = 3 !> The number of vertical levels in the model. type(coordsystem_type) :: ice_grid !> coordinate system of the ice grid type(coordsystem_type) :: velo_grid !> coordinate system of the velocity grid From 6dd603a7e17a17f4fa7183e313bbeae404697a5f Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Tue, 8 May 2018 17:02:37 -0600 Subject: [PATCH 53/61] Changed flow_factor_ssa to flow_factor_float A few months ago, I introduced a flow enhancement factor for floating ice, independent of the factor for grounded ice. Since it applies to all floating ice regardless of the Stokes approximation, I am changing the name. Note: Config files that have been explicitly setting this factor to a value other than the default of 1.0 will need to be modified. I also inlined a melt factor in glissade_therm.F90. This might change answers at roundoff level for problems with basal melting. But LIVV tests are BFB. --- libglide/glide_setup.F90 | 7 +++---- libglide/glide_types.F90 | 4 ++-- libglissade/glissade.F90 | 4 ++-- libglissade/glissade_therm.F90 | 13 ++++++------- 4 files changed, 13 insertions(+), 15 deletions(-) diff --git a/libglide/glide_setup.F90 b/libglide/glide_setup.F90 index 403f8e24..72180e6c 100644 --- a/libglide/glide_setup.F90 +++ b/libglide/glide_setup.F90 @@ -1585,9 +1585,8 @@ subroutine handle_parameters(section, model) call GetValue(section,'pmp_threshold', model%temper%pmp_threshold) call GetValue(section,'geothermal', model%paramets%geot) !TODO - Change default_flwa to flwa_constant? Would have to change config files. - ! Change flow_factor to flow_enhancement_factor? Would have to change many SIA config files call GetValue(section,'flow_factor', model%paramets%flow_enhancement_factor) - call GetValue(section,'flow_factor_ssa', model%paramets%flow_enhancement_factor_ssa) + call GetValue(section,'flow_factor_float', model%paramets%flow_enhancement_factor_float) call GetValue(section,'default_flwa', model%paramets%default_flwa) call GetValue(section,'efvs_constant', model%paramets%efvs_constant) call GetValue(section,'hydro_time', model%paramets%hydtim) @@ -1863,10 +1862,10 @@ subroutine print_parameters(model) write(message,*) 'geothermal flux (W/m^2) : ', model%paramets%geot call write_log(message) - write(message,*) 'flow enhancement factor (SIA) : ', model%paramets%flow_enhancement_factor + write(message,*) 'flow factor (grounded ice) : ', model%paramets%flow_enhancement_factor call write_log(message) - write(message,*) 'flow enhancement factor (SSA) : ', model%paramets%flow_enhancement_factor_ssa + write(message,*) 'flow factor (floating ice) : ', model%paramets%flow_enhancement_factor_float call write_log(message) if (model%options%whichdycore == DYCORE_GLIDE) then diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index 9c35531d..0c776404 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -1733,9 +1733,9 @@ module glide_types real(dp) :: btrac_max = 0.d0 ! m yr^{-1} Pa^{-1} (gets scaled during init) real(dp) :: geot = -5.0d-2 ! W m^{-2}, positive down real(dp) :: flow_enhancement_factor = 1.0d0 ! flow enhancement parameter for the Arrhenius relationship; - ! typically used in SIA model to speed up the ice + ! typically > 1 for SIA models to speed up the ice ! (Note the change relative to prev. versions of code - used to be 3.0) - real(dp) :: flow_enhancement_factor_ssa = 1.0d0 ! flow enhancement parameter for floating ice + real(dp) :: flow_enhancement_factor_float = 1.0d0 ! flow enhancement parameter for floating ice ! Default is 1.0, but for marine simulations a smaller value ! may be needed to match observed shelf speeds real(dp) :: slip_ratio = 1.0d0 ! Slip ratio, used only in higher order code when the slip ratio beta computation is requested diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index 4020501e..a35231c9 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -2241,8 +2241,8 @@ subroutine glissade_diagnostic_variable_solve(model) model%temper%temp(1:model%general%upn-1,:,:), & model%temper%flwa, & ! Pa^{-n} s^{-1} model%paramets%default_flwa / scyr, & ! scale to Pa^{-n} s^{-1} - model%paramets%flow_enhancement_factor, & - model%paramets%flow_enhancement_factor_ssa, & + model%paramets%flow_enhancement_factor, & + model%paramets%flow_enhancement_factor_float, & floating_mask, & model%temper%waterfrac(:,:,:)) diff --git a/libglissade/glissade_therm.F90 b/libglissade/glissade_therm.F90 index 0a039034..971d0446 100644 --- a/libglissade/glissade_therm.F90 +++ b/libglissade/glissade_therm.F90 @@ -1605,7 +1605,6 @@ subroutine glissade_basal_melting_ground(whichtemp, & real(dp), parameter :: eps11 = 1.d-11 ! small number bmlt_ground(:,:) = 0.0d0 - melt_fact = 1.0d0 / (lhci * rhoi) !TODO - Inline melt_fact (might not be BFB) ! Compute the heat flux available to melt grounded ice ! The basal friction term is computed above in subroutine glissade_calcbfric, @@ -1677,7 +1676,7 @@ subroutine glissade_basal_melting_ground(whichtemp, & do ew = 1, ewn if (ice_mask(ew,ns) == 1 .and. floating_mask(ew,ns) == 0) then ! ice is present and grounded - bmlt_ground(ew,ns) = bflx_mlt(ew,ns) * melt_fact ! m/s + bmlt_ground(ew,ns) = bflx_mlt(ew,ns) / (lhci*rhoi) ! m/s endif ! Add internal melting associated with T > Tpmp @@ -2009,7 +2008,7 @@ subroutine glissade_flow_factor(whichflwa, whichtemp, & flwa, & default_flwa, & flow_enhancement_factor, & - flow_enhancement_factor_ssa, & + flow_enhancement_factor_float, & floating_mask, & waterfrac) @@ -2053,8 +2052,8 @@ subroutine glissade_flow_factor(whichflwa, whichtemp, & real(dp),dimension(:,:,:), intent(in) :: temp !> 3D temperature field (deg C) real(dp),dimension(:,:,:), intent(inout) :: flwa !> output $A$, in units of Pa^{-n} s^{-1}, allow input for data option real(dp), intent(in) :: default_flwa !> Glen's A to use in isothermal case, Pa^{-n} s^{-1} - real(dp), intent(in), optional :: flow_enhancement_factor !> flow enhancement factor in Arrhenius relationship - real(dp), intent(in), optional :: flow_enhancement_factor_ssa !> flow enhancement factor for floating ice + real(dp), intent(in), optional :: flow_enhancement_factor !> flow enhancement factor in Arrhenius relationship + real(dp), intent(in), optional :: flow_enhancement_factor_float !> flow enhancement factor for floating ice integer, dimension(:,:), intent(in), optional :: floating_mask !> = 1 where ice is present and floating, else = 0 real(dp),dimension(:,:,:), intent(in), optional :: waterfrac !> internal water content fraction, 0 to 1 @@ -2094,11 +2093,11 @@ subroutine glissade_flow_factor(whichflwa, whichtemp, & allocate(enhancement_factor(ewn,nsn)) if (present(flow_enhancement_factor)) then - if (present(flow_enhancement_factor_ssa) .and. present(floating_mask)) then + if (present(flow_enhancement_factor_float) .and. present(floating_mask)) then do ns = 1, nsn do ew = 1, ewn if (floating_mask(ew,ns) == 1) then - enhancement_factor(ew,ns) = flow_enhancement_factor_ssa + enhancement_factor(ew,ns) = flow_enhancement_factor_float else enhancement_factor(ew,ns) = flow_enhancement_factor endif From 1e6a27471999b3cccc9cb43ca6b11dedbfe00806 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Tue, 8 May 2018 17:28:09 -0600 Subject: [PATCH 54/61] Removed scaling of mintauf in the velocity solver Instead of multiplying and dividing mintauf by tau0 in the scaling subroutine of the velocity solver, the scaling adjustment is now done in subroutine calcbeta. I thought this change would be answer-changing for the stream test, which has which_ho_babc = 2 and thus uses mintauf. But it turns out that the stream test (like the other LIVV tests) is BFB. --- libglissade/glissade_basal_traction.F90 | 2 +- libglissade/glissade_velo_higher.F90 | 23 +---------------------- 2 files changed, 2 insertions(+), 23 deletions(-) diff --git a/libglissade/glissade_basal_traction.F90 b/libglissade/glissade_basal_traction.F90 index c31c26b5..2642f5dd 100644 --- a/libglissade/glissade_basal_traction.F90 +++ b/libglissade/glissade_basal_traction.F90 @@ -287,7 +287,7 @@ subroutine calcbeta (whichbabc, & !!! Currently, to enable sliding over plastic till, simply specify the value of "beta" as !!! if it were the till yield stress (in units of Pascals). - beta(:,:) = basal_physics%mintauf(:,:) & ! plastic yield stress (Pa) + beta(:,:) = basal_physics%mintauf(:,:)*tau0 & ! plastic yield stress (converted to Pa) / dsqrt( thisvel(:,:)**2 + othervel(:,:)**2 + (smallnum)**2 ) ! velocity components (m/yr) !!! since beta is updated here, communicate that info to halos diff --git a/libglissade/glissade_velo_higher.F90 b/libglissade/glissade_velo_higher.F90 index 2bd72fd4..29d84ce3 100644 --- a/libglissade/glissade_velo_higher.F90 +++ b/libglissade/glissade_velo_higher.F90 @@ -1109,7 +1109,6 @@ subroutine glissade_velo_higher_solve(model, & !-------------------------------------------------------- !pw call t_startf('glissade_velo_higher_scale_input') - !TODO - Remove mintauf from argument list when BFB requirement is relaxed call glissade_velo_higher_scale_input(dx, dy, & thck, usrf, & topg, eus, & @@ -1118,7 +1117,6 @@ subroutine glissade_velo_higher_solve(model, & bwat, bmlt, & flwa, efvs, & btractx, btracty, & - model%basal_physics%mintauf, & uvel, vvel, & uvel_2d, vvel_2d) !pw call t_stopf('glissade_velo_higher_scale_input') @@ -2755,7 +2753,7 @@ subroutine glissade_velo_higher_solve(model, & do j = ny-1, 1, -1 write(6,'(i6)',advance='no') j do i = 1, nx-1 - write(6,'(e10.3)',advance='no') model%basal_physics%mintauf(i,j) + write(6,'(e10.3)',advance='no') model%basal_physics%mintauf(i,j) * tau0 enddo write(6,*) ' ' enddo @@ -3269,7 +3267,6 @@ subroutine glissade_velo_higher_solve(model, & vvel(:,:,:) = 0.d0 call t_startf('glissade_velo_higher_scale_outp') - !TODO - Remove mintauf from argument list when BFB requirement is relaxed call glissade_velo_higher_scale_output(thck, usrf, & topg, & bwat, bmlt, & @@ -3280,7 +3277,6 @@ subroutine glissade_velo_higher_solve(model, & uvel, vvel, & uvel_2d, vvel_2d, & btractx, btracty, & - model%basal_physics%mintauf, & taudx, taudy, & tau_xz, tau_yz, & tau_xx, tau_yy, & @@ -4051,7 +4047,6 @@ subroutine glissade_velo_higher_solve(model, & uvel, vvel, & uvel_2d, vvel_2d, & btractx, btracty, & - model%basal_physics%mintauf, & taudx, taudy, & tau_xz, tau_yz, & tau_xx, tau_yy, & @@ -4071,7 +4066,6 @@ subroutine glissade_velo_higher_scale_input(dx, dy, & bwat, bmlt, & flwa, efvs, & btractx, btracty, & - mintauf, & uvel, vvel, & uvel_2d, vvel_2d) @@ -4103,10 +4097,6 @@ subroutine glissade_velo_higher_scale_input(dx, dy, & btractx, btracty, & ! components of basal traction (Pa) uvel_2d, vvel_2d ! components of 2D velocity (m/yr) - !TODO - Remove mintauf from the argument list when BFB restriction is relaxed - real(dp), dimension(:,:), intent(inout) :: & - mintauf - real(dp), dimension(:,:,:), intent(inout) :: & uvel, vvel ! components of 3D velocity (m/yr) @@ -4136,9 +4126,6 @@ subroutine glissade_velo_higher_scale_input(dx, dy, & btractx = btractx * tau0 btracty = btracty * tau0 - ! yield stress: rescale from dimensionless to Pa - mintauf = mintauf * tau0 - ! ice velocity: rescale from dimensionless to m/yr uvel = uvel * (vel0*scyr) vvel = vvel * (vel0*scyr) @@ -4159,7 +4146,6 @@ subroutine glissade_velo_higher_scale_output(thck, usrf, & uvel, vvel, & uvel_2d, vvel_2d, & btractx, btracty, & - mintauf, & taudx, taudy, & tau_xz, tau_yz, & tau_xx, tau_yy, & @@ -4194,10 +4180,6 @@ subroutine glissade_velo_higher_scale_output(thck, usrf, & btractx, btracty, &! components of basal traction (Pa) taudx, taudy ! components of driving stress (Pa) - !TODO - Remove mintauf from the argument list when BFB restriction is relaxed - real(dp), dimension(:,:), intent(inout) :: & - mintauf - real(dp), dimension(:,:,:), intent(inout) :: & tau_xz, tau_yz, &! vertical components of stress tensor (Pa) tau_xx, tau_yy, tau_xy, &! horizontal components of stress tensor (Pa) @@ -4245,9 +4227,6 @@ subroutine glissade_velo_higher_scale_output(thck, usrf, & tau_xy = tau_xy/tau0 tau_eff = tau_eff/tau0 - ! yield stress: rescale from Pa to dimensionless units - mintauf = mintauf / tau0 - end subroutine glissade_velo_higher_scale_output !**************************************************************************** From b040b77bdaa534f30c8dfb4bd08ba04dc10b5591 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Tue, 8 May 2018 17:36:39 -0600 Subject: [PATCH 55/61] Updated the CISM author list Added Gunter to the author list, and updated some affiliations Note to Bill S. and Gunter: Please let me know if you notice someone is missing. --- AUTHORS | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/AUTHORS b/AUTHORS index 7735c2b6..fa22c2d7 100644 --- a/AUTHORS +++ b/AUTHORS @@ -1,11 +1,11 @@ -The following authors (listed alphabetically) have contributed to this version of Glimmer-CISM. +The following authors (listed alphabetically) have contributed to this version of CISM. Affiliations shown with an asterisk (*) are no longer current. Erin Barker Los Alamos National Laboratory (*) Tim Bocek University of Montana, Missoula (*) -Josh Campbell University of Montana, Missoula +Josh Campbell University of Montana, Missoula (*) Katherine J. Evans Oak Ridge National Laboratory -Jeremy Fyke Los Alamos National Laboratory +Jeremy Fyke Los Alamos National Laboratory (*) Glen Granzow University of Montana, Missoula Magnus Hagdorn School of GeoSciences, University of Edinburgh Brian Hand University of Montana, Missoula (*) @@ -13,8 +13,9 @@ Felix Hebeler University of Zurich(*) Matthew Hoffman Los Alamos National Laboratory Jesse Johnson University of Montana, Missoula Irina Kalashnikova Sandia National Laboratories +Gunter Leguy Los Alamos National Laboratory (*), National Center for Atmospheric Research Jean-Francois Lemieux New York University (*) -William Lipscomb Los Alamos National Laboratory +William Lipscomb Los Alamos National Laboratory (*), National Center for Atmospheric Research Daniel Martin Lawrence Berkeley National Laboratory Jeffrey A. Nichols Oak Ridge National Laboratory Ryan Nong Sandia National Laboratories (*) @@ -26,6 +27,6 @@ Ian Rutt Dept. of Geography, Swansea University William Sacks National Center for Atmospheric Research Andrew Salinger Sandia National Laboratories James B. White III Oak Ridge National Laboratory (*) -Jon Wolfe National Center for Atmospheric Research (*) +Jon Wolfe National Center for Atmospheric Research (*) Patrick Worley Oak Ridge National Laboratory Timothy Wylie University of Montana, Missoula (*) From c50f5ac6d231d6feaa310c2b1edaa3d7f96a9787 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Wed, 9 May 2018 10:31:08 -0600 Subject: [PATCH 56/61] Added a bmlt_float option based on cavity thickness Added a new option, whichbmlt_float = BMLT_FLOAT_CAVITY_THCK = 3. With this option, melt rates are computed based on sub-shelf cavity thickness, with larger melt rates for thinner cavities. Cavity thickness is taken as a rough proxy for distance from the grounding line; the goal is to focus the melting near the GL. The melt rate is set to a maximum value where h_cavity < cavity_hmeltmax, then decreases linearly to 0 as h_cavity increases from cavity_hmeltmax to cavity_hmelt0. In addition, the melt rate can be tapered for very thin cavities, as with the depth-dependent MISMIP scheme. This scheme includes three user-configurable parameters: a max melt rate and the two cavity thicknesses that define the linear ramp. It is available for testing and tuning, but has not been scientifically validated. Also moved the MISOMIP/plume option (to be redacted for the release) to whichbmlt_float = 5. This commit is BFB except when the new option is applied. --- libglide/glide_setup.F90 | 19 ++++--- libglide/glide_types.F90 | 17 +++++-- libglissade/glissade.F90 | 6 +-- libglissade/glissade_bmlt_float.F90 | 78 ++++++++++++++++++++++++++--- 4 files changed, 97 insertions(+), 23 deletions(-) diff --git a/libglide/glide_setup.F90 b/libglide/glide_setup.F90 index 72180e6c..296a7ad0 100644 --- a/libglide/glide_setup.F90 +++ b/libglide/glide_setup.F90 @@ -205,9 +205,10 @@ subroutine glide_scale_params(model) model%velowk%btrac_max = model%paramets%btrac_max / model%velowk%trc0/scyr model%velowk%btrac_slope = model%paramets%btrac_slope*acc0/model%velowk%trc0 - ! scale basal melting parameters (yr^{-1} -> s^{-1}) + ! scale basal melting parameters (1/yr -> 1/s, or m/yr -> m/s) model%basal_melt%bmlt_float_omega = model%basal_melt%bmlt_float_omega / scyr model%basal_melt%bmlt_float_const = model%basal_melt%bmlt_float_const / scyr + model%basal_melt%bmlt_float_cavity_meltmax = model%basal_melt%bmlt_float_cavity_meltmax / scyr ! scale basal inversion parameters model%inversion%babc_timescale = model%inversion%babc_timescale * scyr @@ -741,12 +742,13 @@ subroutine print_options(model) 'not in continuity eqn', & 'in continuity eqn ' /) - character(len=*), dimension(0:4), parameter :: which_bmlt_float = (/ & - 'none ', & - 'MISMIP+ melt rate profile ', & - 'constant melt rate ', & - 'Melt rate from MISOMIP T/S profile', & - 'Melt rate from external file ' /) + character(len=*), dimension(0:5), parameter :: which_bmlt_float = (/ & + 'none ', & + 'MISMIP+ melt rate profile ', & + 'constant melt rate ', & + 'melt rate from ocean cavity thickness', & + 'melt rate from external file ', & + 'melt rate from MISOMIP T/S profile ' /) character(len=*), dimension(0:1), parameter :: smb_input = (/ & 'SMB input in units of m/yr ice ', & @@ -1696,6 +1698,9 @@ subroutine handle_parameters(section, model) call GetValue(section,'bmlt_float_z0', model%basal_melt%bmlt_float_z0) call GetValue(section,'bmlt_float_const', model%basal_melt%bmlt_float_const) call GetValue(section,'bmlt_float_xlim', model%basal_melt%bmlt_float_xlim) + call GetValue(section,'bmlt_float_cavity_meltmax', model%basal_melt%bmlt_float_cavity_meltmax) + call GetValue(section,'bmlt_float_cavity_hmelt0', model%basal_melt%bmlt_float_cavity_hmelt0) + call GetValue(section,'bmlt_float_cavity_hmeltmax', model%basal_melt%bmlt_float_cavity_hmeltmax) ! MISOMIP plume parameters !TODO - Put MISMIP+ and MISOMIP parameters in their own section? diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index 0c776404..dad0bec9 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -119,8 +119,9 @@ module glide_types integer, parameter :: BMLT_FLOAT_NONE = 0 integer, parameter :: BMLT_FLOAT_MISMIP = 1 integer, parameter :: BMLT_FLOAT_CONSTANT = 2 - integer, parameter :: BMLT_FLOAT_MISOMIP = 3 + integer, parameter :: BMLT_FLOAT_CAVITY_THCK = 3 integer, parameter :: BMLT_FLOAT_EXTERNAL = 4 + integer, parameter :: BMLT_FLOAT_MISOMIP = 5 integer, parameter :: BASAL_MBAL_NO_CONTINUITY = 0 integer, parameter :: BASAL_MBAL_CONTINUITY = 1 @@ -419,10 +420,11 @@ module glide_types !> basal melt rate for floating ice: !> \begin{description} !> \item[0] Basal melt rate = 0 for floating ice - !> \item[1] Basal melt rate for floating ice as prescribed for MISMIP+ + !> \item[1] Depth-dependent basal melt rate for floating ice as specified for MISMIP+ !> \item[2] Basal melt rate = constant for floating ice (with option to selectively mask out melting) - !> \item[3] Basal melt rate for floating ice from MISOMIP ocean forcing with plume model + !> \item[3] Basal melt rate based on thickness of sub-shelf cavity !> \item[4] External basal melt rate field (from input file or coupler) + !> \item[5] Basal melt rate for floating ice from MISOMIP ocean forcing with plume model !> \end{description} logical :: enable_bmlt_anomaly = .false. @@ -1336,7 +1338,7 @@ module glide_types real(dp) :: bmlt_float_factor = 1.0d0 !> adjustment factor for external bmlt_float field - ! MISMIP+ parameters for Ice1 experiments + ! MISMIP+ parameters for Ice1 experiments (BMLT_FLOAT_MISMIP) ! Note: Parameters with units yr^{-1} are scaled to s^{-1} in subroutine glide_scale_params real(dp) :: bmlt_float_omega = 0.2d0 !> time scale for basal melting (yr-1) !> default value = 0.2 yr^{-1} for MISMIP+ Ice1r @@ -1345,12 +1347,17 @@ module glide_types real(dp) :: bmlt_float_z0 = -100.d0 !> scale for ice draft, relative to sea level (m) !> default value = -100 m for MISMIP+ Ice1r - ! MISMIP+ parameters for Ice2 experiments + ! MISMIP+ parameters for Ice2 experiments (BMLT_FLOAT_CONSTANT) real(dp) :: bmlt_float_const = 0.d0 !> constant melt rate (m/yr) !> set to 100 m/yr for MISMIP+ Ice2r real(dp) :: bmlt_float_xlim = 0.d0 !> melting is allowed only for abs(x1) > bmlt_float_xlim !> set to 480 km for MISMIP+ Ice2r + ! parameters for BMLT_FLOAT_CAVITY_THCK + real(dp) :: bmlt_float_cavity_meltmax = 20.d0 !> max melt rate in cavity (m/yr) + real(dp) :: bmlt_float_cavity_hmeltmax = 100.d0 !> cavity thickness (m) below which bmlt_float = meltmax + real(dp) :: bmlt_float_cavity_hmelt0 = 300.d0 !> cavity thickness (m) above which bmlt_float = 0 + ! initMIP-Antarctica parameters real(dp) :: bmlt_anomaly_timescale = 0.0d0 !> number of years over which the bmlt_float anomaly is phased in linearly !> If set to zero, then the anomaly is applied immediately. diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index a35231c9..61f82d4a 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -893,7 +893,7 @@ subroutine glissade_bmlt_float_solve(model) model%basal_melt%bmlt_float(:,:) = model%basal_melt%bmlt_float(:,:) * model%basal_melt%bmlt_float_factor endif - else ! other options include BMLT_FLOAT_CONSTANT, BMLT_FLOAT_MISMIP AND BMLT_FLOAT_MISOMIP + else ! other options include BMLT_FLOAT_CONSTANT, BMLT_FLOAT_MISMIP, BMLT_FLOAT_CAVITY_THCK AND BMLT_FLOAT_MISOMIP !TODO - Call separate subroutines for each of these three options? !WHL - May want to comment out temporarily, if doing basal melting in the diagnostic solve for testing @@ -1183,9 +1183,7 @@ subroutine glissade_thickness_tracer_solve(model) call t_startf('inc_remap_driver') - if (main_task) then - print *, 'Compute dH/dt' - endif + if (verbose_glissade .and. main_task) print *, 'Compute dH/dt' call t_startf('glissade_transport_driver') diff --git a/libglissade/glissade_bmlt_float.F90 b/libglissade/glissade_bmlt_float.F90 index cca4d427..0d0bb3f5 100644 --- a/libglissade/glissade_bmlt_float.F90 +++ b/libglissade/glissade_bmlt_float.F90 @@ -124,9 +124,6 @@ subroutine glissade_basal_melting_float(whichbmlt_float, & x1 ! x1 grid coordinates (m), ice grid ! used with bmlt_float_xlim for MISMIP+ Ice2r - !WHL - Change to inout to permit calving - !TODO - Let the ice sheet model handle calving -!! real(dp), dimension(:,:), intent(inout) :: & real(dp), dimension(:,:), intent(in) :: & lsrf, & ! elevation of lower ice surface (m) thck ! ice thickness (m) @@ -219,8 +216,8 @@ subroutine glissade_basal_melting_float(whichbmlt_float, & real(dp) :: h_cavity ! depth of ice cavity beneath floating ice (m) real(dp) :: z_draft ! draft of floating ice (m below sea level) - logical, parameter :: verbose_bmlt = .false. -!! logical, parameter :: verbose_bmlt = .true. +!! logical, parameter :: verbose_bmlt = .false. + logical, parameter :: verbose_bmlt = .true. !TODO - Make first_call depend on whether we are restarting !! logical :: first_call = .false. @@ -293,7 +290,7 @@ subroutine glissade_basal_melting_float(whichbmlt_float, & do j = 1, nsn do i = 1, ewn - ! allow basal melt in ice-free ocean cells, in case ice is advected to those cells by the transport scheme + ! compute basal melt in ice-free ocean cells, in case ice is advected to those cells by the transport scheme if (floating_mask(i,j) == 1 .or. ocean_mask(i,j) == 1) then ! ice is present and floating, or ice-free ocean @@ -334,6 +331,73 @@ subroutine glissade_basal_melting_float(whichbmlt_float, & enddo endif + elseif (whichbmlt_float == BMLT_FLOAT_CAVITY_THCK) then + + ! Compute melt rates based on the cavity thickness, with larger melt rates for thinner cavities. + ! Cavity thickness is taken as a rough proxy for distance from the grounding line; + ! the goal is to focus the melting near the GL. + ! The melt rate is set to a maximum value where h_cavity < cavity_hmeltmax, + ! then decreases linearly to 0 as h_cavity increases from cavity_hmeltmax to cavity_hmelt0. + ! In addition, if bmlt_float_h0 > 0 (see the MISMIP scheme above), the melt rate can be tapered + ! for very thin cavities. Typically, cavity_hmeltmax > bmlt_float_h0. + ! This scheme is available for testing and tuning, but has not been scientifically validated. + + do j = 1, nsn + do i = 1, ewn + + ! compute basal melt in ice-free ocean cells, in case ice is advected to those cells by the transport scheme + if (floating_mask(i,j) == 1 .or. ocean_mask(i,j) == 1) then ! ice is present and floating, or ice-free ocean + + h_cavity = max(lsrf(i,j) - topg(i,j), 0.0d0) + + if (h_cavity > basal_melt%bmlt_float_cavity_hmelt0) then + ! do nothing; bmlt_float = 0 + elseif (h_cavity < basal_melt%bmlt_float_cavity_hmeltmax) then + bmlt_float(i,j) = basal_melt%bmlt_float_cavity_meltmax + else + bmlt_float(i,j) = basal_melt%bmlt_float_cavity_meltmax * & + (basal_melt%bmlt_float_cavity_hmelt0 - h_cavity) / & + (basal_melt%bmlt_float_cavity_hmelt0 - basal_melt%bmlt_float_cavity_hmeltmax) + endif + + ! Following the MISMIP+ scheme, reduce the melting as the cavity thickness approaches zero. + ! A small value of bmlt_float_h0 allows more melting in very thin cavities. + bmlt_float(i,j) = bmlt_float(i,j) * tanh(h_cavity/basal_melt%bmlt_float_h0) + + endif ! ice is present and floating + + enddo + enddo + + !debug + if (verbose_bmlt .and. this_rank == rtest) then + print*, 'itest, jtest, rtest =', itest, jtest, rtest + print*, ' ' + print*, 'topg (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f12.5)',advance='no') topg(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'h_cavity (m):' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f12.5)',advance='no') max(lsrf(i,j) - topg(i,j), 0.0d0) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'bmlt_float (m/yr), rank =', rtest + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + write(6,'(f12.5)',advance='no') bmlt_float(i,j)*scyr + enddo + write(6,*) ' ' + enddo + endif + elseif (whichbmlt_float == BMLT_FLOAT_MISOMIP) then ! Compute melt rates using a plume model, given vertical profiles of T and S in the ambient ocean @@ -795,7 +859,7 @@ subroutine glissade_plume_melt_rate(& velo_mask_work(:,:) = 1 !WHL - debug - ! Calve thin floating ice. Later, this should be done by CISM's calving solver. + ! Calve thin floating ice if necessary. Generally, this should be done by CISM's calving solver. !TODO - If uncommenting these lines, then thck and lsrf must be intent(inout) !! do j = 1, ny !! do i = 1, nx From 11f4f1f7afb13e9cceb7a67fe93839b80d3e4a55 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Wed, 9 May 2018 11:10:50 -0600 Subject: [PATCH 57/61] Cleaned up the glint_example test I modified the greenland config files to use the new CISM restart procedure with a [CF restart] section. While doing so, I found a bug in glimmer_ncparams.F90: The code erroneously aborted when there was any input or output section (e.g., [CF input]) listed after the [CF restart] section. I modified the code so that only one [CF restart] section is read, and any additional sections are ignored. At some point, we could add a check that aborts the run if there are multiple restart sections, but this isn't a high priority at the moment. Also added some Glint diagnostics: Write the total Glint time and climate timestep to the log file, noting that Glint time overrides the end time in the dycore. This commit is BFB. - --- libglimmer/glimmer_ncparams.F90 | 12 +++--------- libglint/glint_example_clim.F90 | 6 ++++++ tests/glint-example/greenland_20km.config.pdd | 18 ++++++++++-------- tests/glint-example/greenland_20km.config.smb | 18 ++++++++++-------- tests/glint-example/greenland_5km.config.pdd | 19 ++++++++++--------- 5 files changed, 39 insertions(+), 34 deletions(-) diff --git a/libglimmer/glimmer_ncparams.F90 b/libglimmer/glimmer_ncparams.F90 index 0048043f..747f86d5 100644 --- a/libglimmer/glimmer_ncparams.F90 +++ b/libglimmer/glimmer_ncparams.F90 @@ -107,10 +107,10 @@ subroutine glimmer_nc_readparams(model,config) ! set up restart output ! If there is a 'CF restart' section, the file listed there is added to the output list. + ! Note: There should be only one 'CF restart' section. Duplicate sections will be ignored. + !TODO: Check that there is only one 'CF restart' section, and abort if there are more than one. call GetSection(config,section,'CF restart') - if (associated(section)) then - output => handle_output(section,output,configstring) if (.not.associated(model%funits%out_first)) then model%funits%out_first => output @@ -121,13 +121,7 @@ subroutine glimmer_nc_readparams(model,config) if (pos == 0) then call write_log ('Error, filename in CF restart section should include "restart"', GM_FATAL) endif - - ! Make sure there is only one 'CF restart' section - if (associated(section%next)) then - call write_log ('Error, there should not be more than one CF restart section', GM_FATAL) - endif - - end if + endif ! set up inputs call GetSection(config,section,'CF input') diff --git a/libglint/glint_example_clim.F90 b/libglint/glint_example_clim.F90 index c9f03044..5187de4d 100644 --- a/libglint/glint_example_clim.F90 +++ b/libglint/glint_example_clim.F90 @@ -235,6 +235,12 @@ subroutine glex_clim_printconfig(params) if (params%gcm_smb) then call write_log ('Will pass surface mass balance (not PDD info) to Glint') endif + + write(message,*)'Total years :', params%total_years + call write_log(message) + call write_log(' NOTE: GLINT total years will override the end time in the ice sheet dycore') + write(message,*)'Climate tstep (hr):', params%climate_tstep + call write_log(message) call write_log('') diff --git a/tests/glint-example/greenland_20km.config.pdd b/tests/glint-example/greenland_20km.config.pdd index 74a4e61a..4b59c75c 100644 --- a/tests/glint-example/greenland_20km.config.pdd +++ b/tests/glint-example/greenland_20km.config.pdd @@ -18,7 +18,7 @@ false_northing = 3400000.0 standard_parallel = 71.0 [options] -dycore = 0 # 0 = glide, 1 = glam +dycore = 0 # 0 = glide, 2 = glissade evolution = 0 # 0 = pseudo diffusion, 2 = iterated diffusion, 3 = remap temperature = 1 # 0 = sfc air, 1 = prognostic temp_init = 2 # 1 = sfc air, 2 = linear profile @@ -56,6 +56,9 @@ title: GLINT example test run #institution: My Institution comment: results from a Greenland 20-km test run with PDD forcing +[CF input] +name: gland20.input.nc + [CF output] name: greenland_20km.pdd.nc frequency: 10 @@ -66,10 +69,9 @@ name: greenland_20km.pdd.glint.nc frequency: 10 variables: instant_prcp instant_acab instant_ablt instant_artm -[CF output] -name: greenland_20km.pdd.hot.nc -frequency: 1000 -variables: hot - -[CF input] -name: gland20.input.nc +[CF restart] +name: greenland_20km.pdd.restart.nc +frequency: 1000 +variables: restart +xtype: double +write_init: F diff --git a/tests/glint-example/greenland_20km.config.smb b/tests/glint-example/greenland_20km.config.smb index e7240bfa..98933434 100644 --- a/tests/glint-example/greenland_20km.config.smb +++ b/tests/glint-example/greenland_20km.config.smb @@ -18,7 +18,7 @@ false_northing = 3400000.0 standard_parallel = 71.0 [options] -dycore = 0 # 0 = glide, 1 = glam +dycore = 0 # 0 = glide, 2 = glissade evolution = 0 # 0 = pseudo diffusion, 2 = iterated diffusion, 3 = remap temperature = 1 # 0 = sfc air, 1 = prognostic temp_init = 2 # 1 = sfc air, 2 = linear profile @@ -56,15 +56,17 @@ title: GLINT example test run #institution: My Institution comment: results from a Greenland 20-km test run with SMB forcing +[CF input] +name: gland20.input.nc + [CF output] name: greenland_20km.smb.nc frequency: 10 variables: thk usurf topg temp uvel vvel velnorm acab artm bmlt bwat -[CF output] -name: greenland_20km.smb.hot.nc -frequency: 1000 -variables: hot - -[CF input] -name: gland20.input.nc +[CF restart] +name: greenland_20km.smb.restart.nc +frequency: 1000 +variables: restart +xtype: double +write_init: F diff --git a/tests/glint-example/greenland_5km.config.pdd b/tests/glint-example/greenland_5km.config.pdd index d0ca2566..d39e613c 100644 --- a/tests/glint-example/greenland_5km.config.pdd +++ b/tests/glint-example/greenland_5km.config.pdd @@ -18,7 +18,7 @@ false_northing = 3400000.0 standard_parallel = 71.0 [options] -dycore = 0 # 0 = glide, 1 = glam +dycore = 0 # 0 = glide, 2 = glissade evolution = 0 # 0 = pseudo diffusion, 2 = iterated diffusion, 3 = remap temperature = 1 # 0 = sfc air, 1 = prognostic temp_init = 2 # 1 = sfc air, 2 = linear profile @@ -56,6 +56,9 @@ title: GLINT example test run #institution: My Institution comment: results from a Greenland 5-km test run with PDD forcing +[CF input] +name: Greenland_5km_v1.1.nc + [CF output] name: greenland_5km.pdd.nc frequency: 10 @@ -66,11 +69,9 @@ name: greenland_5km.pdd.glint.nc frequency: 10 variables: instant_prcp instant_acab instant_ablt instant_artm -[CF output] -name: greenland_5km.pdd.hot.nc -frequency: 1000 -variables: hot - -[CF input] -name: Greenland_5km_v1.1.nc - +[CF restart] +name: greenland_5km.pdd.restart.nc +frequency: 1000 +variables: restart +xtype: double +write_init: F From 7030ba9c9b64e5c4e63af6c3956da302090c2a31 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Wed, 9 May 2018 12:49:59 -0600 Subject: [PATCH 58/61] Cleaned up some comments Did a quick search for TODO comments in the code. Edited a few comments, and confirmed that the suggested tasks can (or must) wait for a future release. --- libglide/glide_setup.F90 | 18 ++---- libglide/glide_types.F90 | 84 ++++++++++++------------- libglissade/glissade.F90 | 4 +- libglissade/glissade_basal_traction.F90 | 4 +- libglissade/glissade_calving.F90 | 1 - libglissade/glissade_grid_operators.F90 | 3 +- libglissade/glissade_transport.F90 | 1 - libglissade/glissade_velo_higher.F90 | 2 +- 8 files changed, 53 insertions(+), 64 deletions(-) diff --git a/libglide/glide_setup.F90 b/libglide/glide_setup.F90 index 296a7ad0..cf89fdc2 100644 --- a/libglide/glide_setup.F90 +++ b/libglide/glide_setup.F90 @@ -183,10 +183,6 @@ subroutine glide_scale_params(model) model%numerics%dew = model%numerics%dew / len0 model%numerics%dns = model%numerics%dns / len0 - !TODO - Scale eus for calving? - ! Currently the scaling for eus (like relx and topg) is handled automatically in glide_io.F90. - ! Would need to handle eus scaling separately if reading from config file. - ! scale calving parameters model%calving%marine_limit = model%calving%marine_limit / thk0 model%calving%timescale = model%calving%timescale * scyr ! convert from yr to s @@ -715,7 +711,7 @@ subroutine print_options(model) 'Paterson and Budd ', & 'read flwa/flwastag from file' /) - !TODO - Rename slip_coeff to something like which_btrc? + !TODO - Rename slip_coeff to which_btrc? character(len=*), dimension(0:5), parameter :: slip_coeff = (/ & 'no basal sliding ', & 'constant basal traction', & @@ -772,7 +768,7 @@ subroutine print_options(model) 'no isostasy calculation ', & 'compute isostasy with model ' /) - !TODO - Change 'marine_margin' to 'calving'? Would have to modify standard config files + !TODO - Change 'marine_margin' to 'calving'? Would have to modify many config files character(len=*), dimension(0:9), parameter :: marine_margin = (/ & 'do nothing at marine margin ', & 'remove all floating ice ', & @@ -1358,7 +1354,6 @@ subroutine print_options(model) endif ! unsupported ho-babc options - !TODO - Decide if some of these are now supported? if (model%options%which_ho_babc == HO_BABC_YIELD_NEWTON) then call write_log('Yield stress higher-order basal boundary condition is not currently scientifically supported. & &USE AT YOUR OWN RISK.', GM_WARNING) @@ -1703,7 +1698,7 @@ subroutine handle_parameters(section, model) call GetValue(section,'bmlt_float_cavity_hmeltmax', model%basal_melt%bmlt_float_cavity_hmeltmax) ! MISOMIP plume parameters - !TODO - Put MISMIP+ and MISOMIP parameters in their own section? + !TODO - Put MISMIP+ and MISOMIP parameters in their own section call GetValue(section,'T0', model%plume%T0) call GetValue(section,'Tbot', model%plume%Tbot) call GetValue(section,'S0', model%plume%S0) @@ -2642,11 +2637,10 @@ subroutine define_glide_restart_variables(options) call glide_add_to_restart_variable_list('bmlt_float_prescribed') end select - ! If inverting for basal parameters and/or subshelf melting based on thck_obs, - ! then thck_obs needs to be in the restart file; - !TODO - Remove thck_obs, keep usrf_obs? + ! If inverting for basal parameters and/or subshelf melting based on ursf_obs, + ! then usrf_obs needs to be in the restart file. + ! TODO: Inversion for topg_obs still needs to be tested. if (options%which_ho_inversion == HO_INVERSION_COMPUTE) then -!! call glide_add_to_restart_variable_list('thck_obs') call glide_add_to_restart_variable_list('usrf_obs') call glide_add_to_restart_variable_list('topg_obs') endif diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index dad0bec9..f3e695fc 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -745,7 +745,7 @@ module glide_types !> \item[2] Compute edge gradient only when both cells have ice !TODO: Change the default to 2nd order vertical remapping - ! WHL: Keeping 1st order vertical remapping for now so that standard tests are BFB + ! WHL: Keeping 1st order vertical remapping for now, pending more testing integer :: which_ho_vertical_remap = 0 !> Flag that indicates the order of accuracy for vertical remapping !> \begin{description} @@ -1083,7 +1083,7 @@ module glide_types !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !TODO - Make eus a config file parameter. -!TODO - Rename acab in glide_climate type to avoid confusion over units? (e.g., acab_ice?) +!TODO - Rename acab in glide_climate type to avoid confusion over units? ! Here, acab has units of m/y ice, whereas in Glint, acab has units of m/y water equiv. ! Note on acab_tavg: This is the average value of acab over an output interval. @@ -1410,10 +1410,10 @@ module glide_types end type glide_plume !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !TODO - Change '!<' to '!>' + type glide_basal_physics - !< Holds variables related to basal physics associated with ice dynamics - !< See glissade_basal_traction.F90 for usage details + !> Holds variables related to basal physics associated with ice dynamics + !> See glissade_basal_traction.F90 for usage details !Note: By default, beta_grounded_min is set to a small nonzero value. ! Larger values (~10 to 100 Pa yr/m) might be needed for stability in realistic simulations. @@ -1423,48 +1423,48 @@ module glide_types real(dp) :: ho_beta_small = 1000.d0 !> small beta for sliding over a thawed bed, Pa yr/m (scaled during init) real(dp) :: ho_beta_large = 1.0d10 !> large beta to enforce (virtually) no slip, Pa yr/m (scaled during init) - integer, dimension(:,:), pointer :: bpmp_mask => null() !< basal pressure melting point mask; = 1 where Tbed = bpmp, elsewhere = 0 - !< Note: Defined on velocity grid, whereas temp and bpmp are on ice grid + integer, dimension(:,:), pointer :: bpmp_mask => null() !> basal pressure melting point mask; = 1 where Tbed = bpmp, elsewhere = 0 + !> Note: Defined on velocity grid, whereas temp and bpmp are on ice grid ! Note: It may make sense to move effecpress to a hydrology model when one is available. - real(dp), dimension(:,:), pointer :: effecpress => null() !< effective pressure (Pa) - real(dp), dimension(:,:), pointer :: effecpress_stag => null() !< effective pressure on staggered grid (Pa) - real(dp), dimension(:,:), pointer :: C_space_factor => null() !< spatial factor for basal shear stress (no dimension) - real(dp), dimension(:,:), pointer :: C_space_factor_stag => null() !< spatial factor for basal shear stress on staggered grid (no dimension) - real(dp), dimension(:,:), pointer :: tau_c => null() !< yield stress for plastic sliding (Pa) + real(dp), dimension(:,:), pointer :: effecpress => null() !> effective pressure (Pa) + real(dp), dimension(:,:), pointer :: effecpress_stag => null() !> effective pressure on staggered grid (Pa) + real(dp), dimension(:,:), pointer :: C_space_factor => null() !> spatial factor for basal shear stress (no dimension) + real(dp), dimension(:,:), pointer :: C_space_factor_stag => null() !> spatial factor for basal shear stress on staggered grid (no dimension) + real(dp), dimension(:,:), pointer :: tau_c => null() !> yield stress for plastic sliding (Pa) ! parameters for reducing the effective pressure where the bed is warm, saturated or connected to the ocean - real(dp) :: effecpress_delta = 0.02d0 !< multiplier for effective pressure N where the bed is saturated and/or thawed (unitless) - real(dp) :: effecpress_bpmp_threshold = 0.1d0 !< temperature range over which N ramps from a small value to full overburden (deg C) - real(dp) :: effecpress_bmlt_threshold = 1.0d-3 !< basal melting range over which N ramps from a small value to full overburden (m/yr) - real(dp) :: p_ocean_penetration = 0.0d0 !< p-exponent parameter for ocean penetration parameterization (unitless, 0 <= p <= 1) + real(dp) :: effecpress_delta = 0.02d0 !> multiplier for effective pressure N where the bed is saturated and/or thawed (unitless) + real(dp) :: effecpress_bpmp_threshold = 0.1d0 !> temperature range over which N ramps from a small value to full overburden (deg C) + real(dp) :: effecpress_bmlt_threshold = 1.0d-3 !> basal melting range over which N ramps from a small value to full overburden (m/yr) + real(dp) :: p_ocean_penetration = 0.0d0 !> p-exponent parameter for ocean penetration parameterization (unitless, 0 <= p <= 1) ! parameters for pseudo-plastic sliding law (based on PISM) ! (tau_bx,tau_by) = -tau_c * (u,v) / (u_0^q * |u|^(1-q)) ! where the yield stress tau_c = tan(phi) * N ! N = effective pressure - real(dp) :: pseudo_plastic_q = 0.5d0 !< exponent for pseudo-plastic law (unitless), 0 <= q <= 1 - !< q = 1 => linear sliding law; q = 0 => plastic; intermediate values => power law - real(dp) :: pseudo_plastic_u0 = 100.d0 !< threshold velocity for pseudo-plastic law (m/yr) + real(dp) :: pseudo_plastic_q = 0.5d0 !> exponent for pseudo-plastic law (unitless), 0 <= q <= 1 + !> q = 1 => linear sliding law; q = 0 => plastic; intermediate values => power law + real(dp) :: pseudo_plastic_u0 = 100.d0 !> threshold velocity for pseudo-plastic law (m/yr) ! The following 4 parameters give a linear increase in phi between elevations bedmin and bedmax - real(dp) :: pseudo_plastic_phimin = 5.d0 !< min(phi) in pseudo-plastic law, for topg <= bedmin (degrees, 0 < phi < 90) - real(dp) :: pseudo_plastic_phimax = 40.d0 !< max(phi) in pseudo-plastic law, for topg >= bedmax (degrees, 0 < phi < 90) - real(dp) :: pseudo_plastic_bedmin = -700.d0 !< bed elevation (m) below which phi = phimin - real(dp) :: pseudo_plastic_bedmax = 700.d0 !< bed elevation (m) above which phi = phimax + real(dp) :: pseudo_plastic_phimin = 5.d0 !> min(phi) in pseudo-plastic law, for topg <= bedmin (degrees, 0 < phi < 90) + real(dp) :: pseudo_plastic_phimax = 40.d0 !> max(phi) in pseudo-plastic law, for topg >= bedmax (degrees, 0 < phi < 90) + real(dp) :: pseudo_plastic_bedmin = -700.d0 !> bed elevation (m) below which phi = phimin + real(dp) :: pseudo_plastic_bedmax = 700.d0 !> bed elevation (m) above which phi = phimax ! parameters for friction powerlaw - real(dp) :: friction_powerlaw_k = 8.4d-9 !< coefficient (m y^-1 Pa^-2) for the friction power law based on effective pressure - !< The default value is from Bindschadler (1983) based on fits to observations, converted to CISM units. + real(dp) :: friction_powerlaw_k = 8.4d-9 !> coefficient (m y^-1 Pa^-2) for the friction power law based on effective pressure + !> The default value is from Bindschadler (1983) based on fits to observations, converted to CISM units. ! parameters for Coulomb friction sliding law (default values from Pimentel et al. 2010) - real(dp) :: coulomb_c = 0.42d0 !< basal stress constant (no dimension) - !< Pimentel et al. have coulomb_c = 0.84*m_max, where m_max = coulomb_bump_max_slope - real(dp) :: coulomb_bump_wavelength = 2.0d0 !< bedrock wavelength at subgrid scale precision (m) - real(dp) :: coulomb_bump_max_slope = 0.5d0 !< maximum bed bump slope at subgrid scale precision (no dimension) - real(dp) :: flwa_basal = 1.0d-16 !< Glen's A at the bed for Schoof (2005) Coulomb friction law (Pa^{-n} yr^{-1}) - !< = 3.1688d-24 Pa{-n} s{-1}, the value used by Leguy et al. (2014) + real(dp) :: coulomb_c = 0.42d0 !> basal stress constant (no dimension) + !> Pimentel et al. have coulomb_c = 0.84*m_max, where m_max = coulomb_bump_max_slope + real(dp) :: coulomb_bump_wavelength = 2.0d0 !> bedrock wavelength at subgrid scale precision (m) + real(dp) :: coulomb_bump_max_slope = 0.5d0 !> maximum bed bump slope at subgrid scale precision (no dimension) + real(dp) :: flwa_basal = 1.0d-16 !> Glen's A at the bed for Schoof (2005) Coulomb friction law (Pa^{-n} yr^{-1}) + !> = 3.1688d-24 Pa{-n} s{-1}, the value used by Leguy et al. (2014) ! parameters for power law, taub_b = C * u_b^(1/m); used for HO_BABC_COULOMB_POWERLAW_TSAI/SCHOOF ! The default values are from Asay-Davis et al. (2016). @@ -1473,26 +1473,26 @@ module glide_types ! Note: The Tsai et al. Coulomb friction law uses coulomb_c above, with ! effective pressure N as in Leguy et al. (2014) with p_ocean_penetration = 1. - real(dp) :: powerlaw_c = 1.0d4 !< friction coefficient in power law, units of Pa m^(-1/3) yr^(1/3) - real(dp) :: powerlaw_m = 3.d0 !< exponent in power law (unitless) + real(dp) :: powerlaw_c = 1.0d4 !> friction coefficient in power law, units of Pa m^(-1/3) yr^(1/3) + real(dp) :: powerlaw_m = 3.d0 !> exponent in power law (unitless) ! parameter to limit the min value of beta for various power laws - real(dp) :: beta_powerlaw_umax = 0.0d0 !< upper limit of ice speed (m/yr) when evaluating powerlaw beta - !< Where u > umax, let u = umax when evaluating beta(u) + real(dp) :: beta_powerlaw_umax = 0.0d0 !> upper limit of ice speed (m/yr) when evaluating powerlaw beta + !> Where u > umax, let u = umax when evaluating beta(u) ! parameter for constant basal water ! Note: This parameter applies to HO_BWAT_CONSTANT only. ! For Glide's BWATER_CONST, the constant value is hardwired in subroutine calcbwat. - real(dp) :: const_bwat = 10.d0 !< constant basal water depth (m) + real(dp) :: const_bwat = 10.d0 !> constant basal water depth (m) ! parameters for local till model ! The default values are from Aschwanden et al. (2016) and Bueler and van Pelt (2015). - real(dp) :: bwat_till_max = 2.0d0 !< maximum water depth in till (m) - real(dp) :: c_drainage = 1.0d-3 !< uniform drainage rate (m/yr) - real(dp) :: N_0 = 1000.d0 !< reference effective pressure (Pa) - real(dp) :: e_0 = 0.69d0 !< reference void ratio (dimensionless) - real(dp) :: C_c = 0.12d0 !< till compressibility (dimensionless) - !< Note: The ratio (e_0/C_c) is the key parameter + real(dp) :: bwat_till_max = 2.0d0 !> maximum water depth in till (m) + real(dp) :: c_drainage = 1.0d-3 !> uniform drainage rate (m/yr) + real(dp) :: N_0 = 1000.d0 !> reference effective pressure (Pa) + real(dp) :: e_0 = 0.69d0 !> reference void ratio (dimensionless) + real(dp) :: C_c = 0.12d0 !> till compressibility (dimensionless) + !> Note: The ratio (e_0/C_c) is the key parameter ! Note: A basal process model is not currently supported, but a specified mintauf can be passed to subroutine calcbeta ! to simulate a plastic bed.. diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index 61f82d4a..2c4e72a3 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -1169,11 +1169,9 @@ subroutine glissade_thickness_tracer_solve(model) ! First transport ice thickness and temperature, given the horizontal velocity (u,v). ! Then apply the surface and basal mass balance in each grid cell. ! Note: The main reason to do both transport and mass balance in one subroutine is - ! that both operations require tracer array setup and cleanup (e.g., copying the + ! that both operations require tracer array setup and cleanup (e.g., copying the ! various tracer fields into generic tracer arrays). With this arrangement, ! the tracer operations need to be done only once. - ! TODO: It might be cleaner to do horizontal transport and mass balance in - ! separate subroutines, at the cost of added tracer operations. !------------------------------------------------------------------------- ! MJH: I put the no thickness evolution option here so that it is still possible ! (but not required) to use IR to advect temperature when thickness evolution is turned off. diff --git a/libglissade/glissade_basal_traction.F90 b/libglissade/glissade_basal_traction.F90 index 2642f5dd..e3115ef4 100644 --- a/libglissade/glissade_basal_traction.F90 +++ b/libglissade/glissade_basal_traction.F90 @@ -186,7 +186,7 @@ subroutine calcbeta (whichbabc, & logical, parameter :: verbose_beta = .false. !! integer :: istop, jstop - !TODO - Can remove the extra variable when which_ho_inversion is a non-optional argument + !TODO - Make which_ho_inversion a non-optional argument? if (present(which_ho_inversion)) then which_inversion = which_ho_inversion else @@ -602,7 +602,7 @@ subroutine calcbeta (whichbabc, & ! basal_physics%powerlaw_c, basal_physics%powerlaw_m, basal_physics%coulomb_c ! write(6,*) 'Apply Tsai parameterization: i, j, speed, beta, taub, taub_powerlaw, taub_coulomb, effecpress:' - !TODO - Add basal inversion option for Tsai, if it works for Schoof + !TODO - Add basal inversion option for Tsai, in addition to Schoof do ns = 1, nsn-1 do ew = 1, ewn-1 diff --git a/libglissade/glissade_calving.F90 b/libglissade/glissade_calving.F90 index 2bd2720c..4e0283c2 100644 --- a/libglissade/glissade_calving.F90 +++ b/libglissade/glissade_calving.F90 @@ -1898,7 +1898,6 @@ subroutine glissade_find_lakes(nx, ny, & ! Check for halo cells that were just filled on neighbor processors ! Note: In order for a halo cell to seed the fill on this processor, it must not only have the fill color, ! but also must be an active cell. - !TODO - Only need to check whether color = fill_color? call parallel_halo(color) diff --git a/libglissade/glissade_grid_operators.F90 b/libglissade/glissade_grid_operators.F90 index dbd441c3..d27ebb23 100644 --- a/libglissade/glissade_grid_operators.F90 +++ b/libglissade/glissade_grid_operators.F90 @@ -62,7 +62,7 @@ subroutine glissade_stagger(nx, ny, & ice_mask, stagger_margin_in) !TODO - Make the mask optional, and drop the stagger_margin_in argument? - ! Then the mask says where to ignore values when interpolating. + ! Then the mask determines where to ignore values when interpolating. !---------------------------------------------------------------- ! Given a variable on the unstaggered grid (dimension nx, ny), interpolate @@ -643,7 +643,6 @@ subroutine glissade_edgemask_gradient_margin_hybrid(nx, ny, & !---------------------------------------------------------------- ! Compute edge masks required for option gradient_margin = HO_GRADIENT_MARGIN_HYBRID ! Called from subroutine glissade_gradient_at_edges. - ! TODO: Make consistent with glissade_surface_elevation_gradient? ! ! The mask is set to true at all edges where either ! (1) Both adjacent cells are ice-covered. diff --git a/libglissade/glissade_transport.F90 b/libglissade/glissade_transport.F90 index 0182d41f..91c8e295 100644 --- a/libglissade/glissade_transport.F90 +++ b/libglissade/glissade_transport.F90 @@ -306,7 +306,6 @@ subroutine glissade_mass_balance_driver(dt, & ! ! input/output arguments - !TODO - Is dt needed? real(dp), intent(in) :: & dt, &! time step (s) dx, dy ! gridcell dimensions (m) diff --git a/libglissade/glissade_velo_higher.F90 b/libglissade/glissade_velo_higher.F90 index 29d84ce3..caf454c9 100644 --- a/libglissade/glissade_velo_higher.F90 +++ b/libglissade/glissade_velo_higher.F90 @@ -5335,7 +5335,7 @@ subroutine assemble_stiffness_matrix_2d(nx, ny, & stagusrf, & ! upper surface elevation on staggered grid (m) stagthck ! ice thickness on staggered grid (m) - !TODO - Pass in flwa and compute flwafact here? + !TODO - Pass in flwa only, and compute flwafact here? real(dp), dimension(nz-1,nx,ny), intent(in) :: & flwa, &! temperature-based flow factor A, Pa^{-n} yr^{-1} flwafact ! temperature-based flow factor, 0.5 * A^(-1/n), Pa yr^(1/n) From 9e0d41c55b7921382f35099a0d64b0c8ffed293d Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Wed, 9 May 2018 12:54:37 -0600 Subject: [PATCH 59/61] Changed default cliff_timescale from 0 to 10 yr This parameter sets the timescale for cliff limiting. I've found that cliff_timescale = 0, which limits cliffs abruptly, can give numerical noise. The code is more robust with gradual limiting, at least for Greenland. --- libglide/glide_types.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index f3e695fc..ec47a7d1 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -1158,7 +1158,7 @@ module glide_types integer :: ncull_calving_front = 0 !> number of times to cull calving_front cells at initialization, if cull_calving_front = T !> Set to a larger value to remove wider peninsulas real(dp) :: taumax_cliff = 1.0d6 !> yield stress (Pa) for marine-based ice cliffs - real(dp) :: cliff_timescale = 0.0d0 !> time scale (yr) for limiting marine cliffs (yr) + real(dp) :: cliff_timescale = 10.0d0 !> time scale (yr) for limiting marine cliffs (yr) real(dp) :: calving_front_x = 0.0d0 !> for CALVING_GRID_MASK option, calve ice wherever abs(x) > calving_front_x (m) real(dp) :: calving_front_y = 0.0d0 !> for CALVING_GRID_MASK option, calve ice wherever abs(y) > calving_front_y (m) !> NOTE: This option is applied only if calving_front_x or calving_front_y > 0 From fd8c41b22534b4e007aa849ebb669641ecdb3653 Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Wed, 9 May 2018 12:58:24 -0600 Subject: [PATCH 60/61] Changed default pmp_offset from 2 deg to 5 deg The pmp_offset parameter determines the initial temperature at the bed, relative to the pressure melting point, for temp_init = 2 and 3 (linear and advective-diffusive). For Greenland runs, an offset of 5 deg leads to more gradual bed thawing and is more stable. CESM already has a default of 5 deg. With this commit, standalone CISM and CESM are consistent. This commit is answer-changing only for runs with temp_init = 2 or 3, where pmp_offset is not specified in the config file. --- libglide/glide_types.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/libglide/glide_types.F90 b/libglide/glide_types.F90 index ec47a7d1..2c4e1d7f 100644 --- a/libglide/glide_types.F90 +++ b/libglide/glide_types.F90 @@ -1253,9 +1253,7 @@ module glide_types real(dp),dimension(:,:), pointer :: bwatflx => null() !> Basal water flux real(dp),dimension(:,:), pointer :: stagbwat => null() !> Basal water depth on velo grid - !TODO - Change default value to 5.0? This is the value used for long Greenland initMIP spin-ups. - real(dp) :: pmp_offset = 2.0d0 ! offset of initial Tbed from pressure melting point temperature (deg C) - + real(dp) :: pmp_offset = 5.0d0 ! offset of initial Tbed from pressure melting point temperature (deg C) real(dp) :: pmp_threshold = 1.0d-3 ! bed is assumed thawed where Tbed >= pmptemp - pmp_threshold (deg C) !TODO - Remove some of the following from the derived type From 359cb64da959b6006d32f2b6b4fab80b669d23de Mon Sep 17 00:00:00 2001 From: William Lipscomb Date: Wed, 9 May 2018 13:31:12 -0600 Subject: [PATCH 61/61] Removed some verbose output I set some logical verbose parameters to false, to reduce diagnostic prints to stdout. Notably, I introduced a logical variable called 'verbose_solver' in glissade_velo_higher_solve: * If verbose_solver = T, the code will print out the number of linear (inner) iterations and final error associated with each iteration of the nonlinear solver. * If verbose_solver = F, the code will print out only a message that the Glissade nonlinear solver has converged (or not), with the number of outer (nonlinear) iterations and final error. For a long time, CISM has printed all this information by default. Since verbose_solver = F by default, the prints to stdout are now much reduced. This commit is BFB. --- libglissade/glissade_basal_traction.F90 | 2 -- libglissade/glissade_bmlt_float.F90 | 3 +- libglissade/glissade_calving.F90 | 4 +-- libglissade/glissade_inversion.F90 | 3 +- libglissade/glissade_velo_higher.F90 | 40 +++++++++---------------- 5 files changed, 17 insertions(+), 35 deletions(-) diff --git a/libglissade/glissade_basal_traction.F90 b/libglissade/glissade_basal_traction.F90 index e3115ef4..712dce2c 100644 --- a/libglissade/glissade_basal_traction.F90 +++ b/libglissade/glissade_basal_traction.F90 @@ -182,9 +182,7 @@ subroutine calcbeta (whichbabc, & integer :: iglobal, jglobal - !WHL - debug logical, parameter :: verbose_beta = .false. -!! integer :: istop, jstop !TODO - Make which_ho_inversion a non-optional argument? if (present(which_ho_inversion)) then diff --git a/libglissade/glissade_bmlt_float.F90 b/libglissade/glissade_bmlt_float.F90 index 0d0bb3f5..c1d77cab 100644 --- a/libglissade/glissade_bmlt_float.F90 +++ b/libglissade/glissade_bmlt_float.F90 @@ -216,8 +216,7 @@ subroutine glissade_basal_melting_float(whichbmlt_float, & real(dp) :: h_cavity ! depth of ice cavity beneath floating ice (m) real(dp) :: z_draft ! draft of floating ice (m below sea level) -!! logical, parameter :: verbose_bmlt = .false. - logical, parameter :: verbose_bmlt = .true. + logical, parameter :: verbose_bmlt = .false. !TODO - Make first_call depend on whether we are restarting !! logical :: first_call = .false. diff --git a/libglissade/glissade_calving.F90 b/libglissade/glissade_calving.F90 index 4e0283c2..36c279d2 100644 --- a/libglissade/glissade_calving.F90 +++ b/libglissade/glissade_calving.F90 @@ -43,9 +43,7 @@ module glissade_calving integer, parameter :: fill_color = 1 ! fill color, represented by integer integer, parameter :: boundary_color = -1 ! boundary color, represented by integer - !WHL - debug -!! logical, parameter :: verbose_calving = .false. - logical, parameter :: verbose_calving = .true. + logical, parameter :: verbose_calving = .false. contains diff --git a/libglissade/glissade_inversion.F90 b/libglissade/glissade_inversion.F90 index 03360759..b146712c 100644 --- a/libglissade/glissade_inversion.F90 +++ b/libglissade/glissade_inversion.F90 @@ -42,8 +42,7 @@ module glissade_inversion ! a target ice thickness field. !----------------------------------------------------------------------------- -!! logical, parameter :: verbose_inversion = .false. - logical, parameter :: verbose_inversion = .true. + logical, parameter :: verbose_inversion = .false. !*********************************************************************** diff --git a/libglissade/glissade_velo_higher.F90 b/libglissade/glissade_velo_higher.F90 index caf454c9..0a926d38 100644 --- a/libglissade/glissade_velo_higher.F90 +++ b/libglissade/glissade_velo_higher.F90 @@ -202,6 +202,8 @@ module glissade_velo_higher ! logical :: verbose = .true. logical :: verbose_init = .false. ! logical :: verbose_init = .true. + logical :: verbose_solver = .false. +! logical :: verbose_solver = .true. logical :: verbose_Jac = .false. ! logical :: verbose_Jac = .true. logical :: verbose_residual = .false. @@ -224,8 +226,8 @@ module glissade_velo_higher ! logical :: verbose_bfric = .true. logical :: verbose_trilinos = .false. ! logical :: verbose_trilinos = .true. -! logical :: verbose_beta = .false. - logical :: verbose_beta = .true. + logical :: verbose_beta = .false. +! logical :: verbose_beta = .true. logical :: verbose_efvs = .false. ! logical :: verbose_efvs = .true. logical :: verbose_tau = .false. @@ -1128,24 +1130,15 @@ subroutine glissade_velo_higher_solve(model, & vol0 = 1.0d9 ! volume scale (m^3) if (whichapprox == HO_APPROX_SIA) then ! SIA -!! if (verbose .and. main_task) print*, 'Solving shallow-ice approximation' - if (main_task) print*, 'Solving shallow-ice approximation' - + if (verbose_solver .and. main_task) print*, 'Solving shallow-ice approximation' elseif (whichapprox == HO_APPROX_SSA) then ! SSA -!! if (verbose .and. main_task) print*, 'Solving shallow-shelf approximation' - if (main_task) print*, 'Solving shallow-shelf approximation' - + if (verbose_solver .and. main_task) print*, 'Solving shallow-shelf approximation' elseif (whichapprox == HO_APPROX_L1L2) then ! L1L2 -!! if (verbose .and. main_task) print*, 'Solving depth-integrated L1L2 approximation' - if (main_task) print*, 'Solving depth-integrated L1L2 approximation' - + if (verbose_solver .and. main_task) print*, 'Solving depth-integrated L1L2 approximation' elseif (whichapprox == HO_APPROX_DIVA) then ! DIVA, based on Goldberg (2011) -!! if (verbose .and. main_task) print*, 'Solving depth-integrated viscosity approximation' - if (main_task) print*, 'Solving depth-integrated viscosity approximation' - + if (verbose_solver .and. main_task) print*, 'Solving depth-integrated viscosity approximation' else ! Blatter-Pattyn higher-order -!! if (verbose .and. main_task) print*, 'Solving Blatter-Pattyn higher-order approximation' - if (main_task) print*, 'Solving Blatter-Pattyn higher-order approximation' + if (verbose_solver .and. main_task) print*, 'Solving Blatter-Pattyn higher-order approximation' endif if (whichapprox==HO_APPROX_SSA .or. whichapprox==HO_APPROX_L1L2 .or. whichapprox==HO_APPROX_DIVA) then @@ -2037,9 +2030,7 @@ subroutine glissade_velo_higher_solve(model, & ! Print some diagnostic info !--------------------------------------------------------------- - if (main_task) then - print *, ' ' - print *, 'Running Glissade higher-order dynamics solver' + if (main_task .and. verbose_solver) then print *, ' ' if (whichresid == HO_RESID_L2NORM) then ! use L2 norm of residual print *, 'iter # resid (L2 norm) target resid' @@ -2048,7 +2039,6 @@ subroutine glissade_velo_higher_solve(model, & else ! residual based on velocity print *, 'iter # velo resid target resid' end if - print *, ' ' endif !------------------------------------------------------------------------------ @@ -3652,7 +3642,7 @@ subroutine glissade_velo_higher_solve(model, & if (whichsparse /= HO_SPARSE_TRILINOS) then ! niters isn't set when using the trilinos solver - if (main_task) then + if (main_task .and. verbose_solver) then print*, 'Solved the linear system, niters, err =', niters, err endif end if @@ -3768,7 +3758,7 @@ subroutine glissade_velo_higher_solve(model, & ! Write diagnostics (iteration number, max residual, and residual target !--------------------------------------------------------------------------- - if (main_task) then + if (main_task .and. verbose_solver) then if (whichresid == HO_RESID_L2NORM) then print '(i4,2g20.6)', counter, L2_norm, L2_target elseif (whichresid == HO_RESID_L2NORM_RELATIVE) then @@ -3801,15 +3791,13 @@ subroutine glissade_velo_higher_solve(model, & converged_soln = .true. !! if (verbose .and. main_task) then if (main_task) then - print*, ' ' - print*, 'GLISSADE SOLUTION HAS CONVERGED, outer counter =', counter + print*, 'Glissade solution has converged, outer counter, err =', counter, L2_norm endif else converged_soln = .false. !! if (verbose .and. main_task) then if (main_task) then - print*, ' ' - print*, 'GLISSADE SOLUTION HAS NOT CONVERGED: counter, err =', counter, L2_norm + print*, 'Glissade solution has NOT converged: counter, err =', counter, L2_norm !WHL - debug !! stop endif