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 (*) diff --git a/cism_driver/cism_front_end.F90 b/cism_driver/cism_front_end.F90 index c32cc727..c7f87849 100644 --- a/cism_driver/cism_front_end.F90 +++ b/cism_driver/cism_front_end.F90 @@ -216,8 +216,7 @@ subroutine cism_init_dycore(model) 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 + tstep_count = model%numerics%tstep_count) call t_stopf('initial_write_diagnostics') end if ! whichdycore .ne. DYCORE_BISICLES @@ -346,8 +345,7 @@ subroutine cism_run_dycore(model) call t_startf('write_diagnostics') call glide_write_diagnostics(model, time, & - tstep_count = model%numerics%tstep_count, & - minthick_in = model%numerics%thklim*thk0) ! m + tstep_count = model%numerics%tstep_count) call t_stopf('write_diagnostics') ! update time from dycore advance 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 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/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_diagnostics.F90 b/libglide/glide_diagnostics.F90 index c03e79b4..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) @@ -229,10 +208,11 @@ 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 + 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) :: & @@ -262,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 @@ -300,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 @@ -469,7 +457,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 +502,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) @@ -616,23 +601,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) @@ -758,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 @@ -784,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 164848a7..cf89fdc2 100644 --- a/libglide/glide_setup.F90 +++ b/libglide/glide_setup.F90 @@ -183,15 +183,13 @@ 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%calving_minthck = model%calving%calving_minthck / thk0 - model%calving%calving_timescale = model%calving%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 @@ -203,9 +201,14 @@ 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 + 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) @@ -526,8 +529,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 @@ -580,6 +586,8 @@ 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,'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) @@ -610,6 +618,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) @@ -702,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', & @@ -729,12 +738,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 ', & @@ -758,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 ', & @@ -775,10 +785,17 @@ 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 :: 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 :: 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 ', & @@ -818,6 +835,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 ', & @@ -910,7 +932,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) @@ -935,7 +957,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 @@ -1104,23 +1125,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 @@ -1129,6 +1150,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 @@ -1145,7 +1167,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 @@ -1155,15 +1177,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) @@ -1172,6 +1197,18 @@ 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%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 @@ -1292,8 +1329,31 @@ 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 call write_log('Yield stress higher-order basal boundary condition is not currently scientifically supported. & &USE AT YOUR OWN RISK.', GM_WARNING) @@ -1302,11 +1362,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) @@ -1440,12 +1495,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, & @@ -1525,9 +1582,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) @@ -1540,12 +1596,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) @@ -1574,21 +1633,29 @@ 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) + 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) 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 + !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) @@ -1596,6 +1663,20 @@ 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 + !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) call GetValue(section,'periodic_offset_ns',model%numerics%periodic_offset_ns) @@ -1612,9 +1693,12 @@ 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? + !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) @@ -1688,13 +1772,23 @@ subroutine print_parameters(model) endif if (model%options%whichcalving == CALVING_THCK_THRESHOLD .or. & - model%options%whichcalving == EIGENCALVING) then - write(message,*) 'calving thickness limit (m) : ', model%calving%calving_minthck + model%options%whichcalving == EIGENCALVING .or. & + model%options%whichcalving == CALVING_DAMAGE) then + write(message,*) 'calving thickness limit (m) : ', model%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) + 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 @@ -1709,7 +1803,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 @@ -1742,13 +1836,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 @@ -1773,14 +1862,16 @@ 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) - 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 @@ -1867,35 +1958,87 @@ 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 + 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 wavelength for Coulomb friction law : ', model%basal_physics%Coulomb_bump_wavelength + write(message,*) 'bed bump wavelength for Coulomb friction law : ', model%basal_physics%coulomb_bump_wavelength + call write_log(message) + 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) + 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_babc == HO_BABC_COULOMB_CONST_BASAL_FLWA) then - write(message,*) 'constant basal flwa for Coulomb friction law : ', model%basal_physics%flwa_basal - 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 + 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) + 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) @@ -1924,11 +2067,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 @@ -2299,9 +2437,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') @@ -2427,8 +2565,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 @@ -2456,15 +2595,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_CONST_BASAL_FLWA) - ! 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, @@ -2472,6 +2612,39 @@ 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) + ! 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_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. + 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 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 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('usrf_obs') + call glide_add_to_restart_variable_list('topg_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..2c4e1d7f 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 @@ -164,15 +165,18 @@ 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 + 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 @@ -216,11 +220,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_PRESCRIBE = 2 + integer, parameter :: HO_BWAT_NONE = 0 integer, parameter :: HO_BWAT_CONSTANT = 1 integer, parameter :: HO_BWAT_LOCAL_TILL = 2 @@ -304,7 +312,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 @@ -341,6 +349,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 @@ -386,7 +395,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 @@ -411,17 +420,17 @@ 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. !> 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} @@ -480,7 +489,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} @@ -495,11 +504,9 @@ 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. + 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 @@ -511,13 +518,24 @@ 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[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 !> 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 @@ -531,7 +549,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} @@ -557,8 +574,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 @@ -607,6 +624,15 @@ module glide_types !> \item[14] simple hard-coded pattern (useful for debugging) !> \end{description} + integer :: which_ho_inversion = 0 + !> 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} @@ -719,29 +745,28 @@ 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} !> \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 - !TODO - Change default method to (1), which is more stable. This will give BFB changes. - 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} @@ -763,13 +788,12 @@ 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 - !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} @@ -777,7 +801,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 @@ -817,6 +841,15 @@ 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 :: 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) @@ -831,8 +864,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}. @@ -870,14 +903,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, @@ -1049,12 +1083,13 @@ 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. ! 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. @@ -1062,13 +1097,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) @@ -1090,37 +1126,42 @@ 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. + !> scaled by thk0 like mass balance, thickness, etc. + 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 :: 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 :: 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),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) - 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) :: eigencalving_constant = 1.0d9 !> eigencalving constant from Levermann et al. (2012) (m*yr) - !> (whichcalving = EIGENCALVING - 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 = 1.0d0 !> threshold at which ice column is deemed sufficiently damaged to calve - !> assuming that 0 = no damage, 1 = total damage + 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) + !> 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 (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 = 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 end type glide_calving @@ -1212,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 @@ -1227,6 +1266,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 @@ -1236,19 +1316,27 @@ 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 - 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 (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 + bmlt_float_anomaly => null() !> basal melt rate anomaly field 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 @@ -1257,15 +1345,20 @@ 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. + 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 @@ -1317,85 +1410,87 @@ module glide_types !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ type glide_basal_physics - !< 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) + !> 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. + 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) 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 !< 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} - !< = 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 + 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). - ! 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_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) + ! 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.. @@ -1643,9 +1738,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 @@ -1754,6 +1849,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 @@ -1806,6 +1902,14 @@ subroutine glide_allocarr(model) !> \item \texttt{bmlt_float_anomaly(ewn,nsn)} !> \end{itemize} + !> In \texttt{model\%inversion}: + !> \item \texttt{bmlt_float_inversion(ewn,nsn)} + !> \item \texttt{bmlt_float_prescribed(ewn,nsn)} + !> \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} !> \item \texttt{T_basal(ewn,nsn)} @@ -1863,6 +1967,9 @@ 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{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)} @@ -2067,6 +2174,9 @@ 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%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) @@ -2089,9 +2199,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) @@ -2126,7 +2236,7 @@ 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) @@ -2136,12 +2246,17 @@ 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 - endif ! glam/glissade ! 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) + 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) @@ -2169,12 +2284,24 @@ 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) 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) @@ -2182,18 +2309,18 @@ 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%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%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) 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 @@ -2473,6 +2600,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)) & @@ -2481,6 +2610,24 @@ 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_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)) & @@ -2526,6 +2673,12 @@ 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%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)) & @@ -2567,12 +2720,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)) & @@ -2636,6 +2789,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)) & @@ -2648,20 +2803,22 @@ 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_rate_tavg)) & + deallocate(model%calving%calving_rate_tavg) 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%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)) & + deallocate(model%calving%tau_eff) 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 e295161a..a9c6575f 100644 --- a/libglide/glide_vars.def +++ b/libglide/glide_vars.def @@ -300,6 +300,24 @@ 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%inversion%bmlt_float_inversion +factor: scyr +load: 1 +coordinates: lon lat + +[bmlt_float_prescribed] +dimensions: time, y1, x1 +units: meter/year +long_name: prescribed basal melt rate for floating ice +data: data%inversion%bmlt_float_prescribed +factor: scyr +load: 1 +coordinates: lon lat + #WHL - A number of plume-related fields follow. [T_ambient] @@ -478,6 +496,33 @@ 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 + +[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 @@ -486,6 +531,14 @@ 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 +average: 1 + [calving_mask] dimensions: time, y1, x1 units: 1 @@ -495,6 +548,14 @@ load: 1 type: int coordinates: lon lat +[calving_lateral] +dimensions: time, y1, x1 +units: meter/year +long_name: lateral calving rate +data: data%calving%lateral_rate +factor: scyr +coordinates: lon lat + [damage] dimensions: time, staglevel, y1, x1 units: unitless [0,1] @@ -503,13 +564,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 @@ -608,16 +662,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 @@ -636,38 +680,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] @@ -707,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 @@ -774,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 @@ -817,6 +857,39 @@ data: data%basal_physics%C_space_factor load: 1 coordinates: lon lat +[powerlaw_c_inversion] +dimensions: time, y1, x1 +units: Pa (m/yr)**(-1/3) +long_name: spatially varying C for powerlaw sliding +data: data%inversion%powerlaw_c_inversion +load: 1 +coordinates: lon lat + +[powerlaw_c_prescribed] +dimensions: time, y1, x1 +units: Pa (m/yr)**(-1/3) +long_name: prescribed spatially varying C for powerlaw sliding +data: data%inversion%powerlaw_c_prescribed +load: 1 +coordinates: lon lat + +[usrf_inversion] +dimensions: time, y1,x1 +units: meter +long_name: surface elevation used for inversion +data: data%inversion%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%inversion%dthck_dt_inversion +factor: scyr +coordinates: lon lat +load: 1 + [artm] dimensions: time, y1, x1 units: degree_Celsius @@ -1077,28 +1150,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 @@ -1141,6 +1192,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 + [wvel] dimensions: time, level, y1, x1 units: meter/year 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. 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/glimmer_ncparams.F90 b/libglimmer/glimmer_ncparams.F90 index 20708df7..747f86d5 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.) @@ -107,27 +107,21 @@ 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 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) - 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) + call write_log ('Error, filename in CF restart section should include "restart"', GM_FATAL) endif - - end if + endif ! set up inputs call GetSection(config,section,'CF input') @@ -165,10 +159,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 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/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/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 diff --git a/libglissade/glissade.F90 b/libglissade/glissade.F90 index 13471ba2..2c4e72a3 100644 --- a/libglissade/glissade.F90 +++ b/libglissade/glissade.F90 @@ -62,13 +62,13 @@ 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 @@ -95,18 +95,19 @@ 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 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 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 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 @@ -119,9 +120,16 @@ 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, & ! = 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 + + integer :: itest, jtest, rtest if (present(evolve_ice)) then l_evolve_ice = evolve_ice @@ -218,9 +226,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 @@ -505,19 +513,10 @@ subroutine glissade_initialise(model, evolve_ice) endwhere endif - ! 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 + ! Set debug diagnostics + rtest = model%numerics%rdiag_local + itest = model%numerics%idiag_local + jtest = model%numerics%jdiag_local ! initial calving, if desired ! Note: Do this only for a cold start with evolving ice, not for a restart @@ -526,56 +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. - ! 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, & - 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%strain_rate_eigenprod, & ! s^(-2) - model%calving%eigencalving_constant, & - model%calving%calving_minthck, & - model%calving%taumax_cliff, & - model%calving%cliff_timescale, & - model%calving%calving_mask, & - model%calving%damage, & - model%calving%damage_threshold, & - model%calving%damage_column, & - model%numerics%sigma, & - 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 calc_lsrf + ! 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. + ! 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, & @@ -584,6 +545,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 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. + + 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 @@ -596,6 +572,17 @@ 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) + ! Optionally, do initial calculations for inversion + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & + model%options%which_ho_inversion == HO_INVERSION_PRESCRIBE) then + + call glissade_init_inversion(model) + + endif ! which_ho_inversion + + !WHL - debug + if (main_task) print*, 'Done in glissade_initialise' + end subroutine glissade_initialise !======================================================================= @@ -618,13 +605,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 @@ -714,9 +709,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. @@ -732,13 +729,13 @@ 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 ! ------------------------------------------------------------------------ - call glissade_calving_solve(model) + call glissade_calving_solve(model, .false.) ! init_calving = .false. ! ------------------------------------------------------------------------ ! Clean up variables in ice-free columns. @@ -850,6 +847,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 @@ -872,6 +876,8 @@ subroutine glissade_bmlt_float_solve(model) ice_mask, & floating_mask = floating_mask) + ! 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 @@ -887,32 +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 - ! 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 - - !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 + 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 @@ -934,9 +915,28 @@ 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 + ! 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). + where (floating_mask == 0) model%basal_melt%bmlt_float = 0.0d0 endwhere @@ -1065,15 +1065,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 @@ -1090,13 +1092,12 @@ subroutine glissade_transport_solve(model) glissade_overwrite_acab, & glissade_add_mbal_anomaly use glissade_masks, only: glissade_get_masks - use glide_thck, only: glide_calclsrf ! TODO - Make this a glissade subroutine, or inline + use glissade_inversion, only: verbose_inversion implicit none type(glide_global_type), intent(inout) :: model ! model instance - ! --- Local variables --- integer :: sc ! subcycling index @@ -1104,17 +1105,22 @@ 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) 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 - 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 @@ -1130,12 +1136,10 @@ 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 integer :: i, j, k integer :: ewn, nsn, upn - - !WHL - debug integer :: itest, jtest, rtest rtest = -999 @@ -1147,7 +1151,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 @@ -1162,8 +1166,12 @@ 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. !------------------------------------------------------------------------- ! 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. @@ -1173,118 +1181,34 @@ subroutine glissade_transport_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') - ! 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. + ! 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, & - thck_unscaled, & ! m + call glissade_get_masks(ewn, nsn, & + model%geometry%thck*thk0, & ! m model%geometry%topg*thk0, & ! m model%climate%eus*thk0, & ! m - 0.0d0, & ! thklim = 0 + 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 + 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? 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)) @@ -1293,46 +1217,21 @@ 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 on output; m/s below - model%basal_melt%bmlt_applied(:,:), & ! m on output; m/s below - ocean_mask(:,:), & - effective_areafrac(:,:), & - model%geometry%ntracers, & - model%geometry%tracers(:,:,:,:), & - model%geometry%tracers_usrf(:,:,:), & - 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 + ! temporary in/out arrays in SI units + thck_unscaled(:,:) = model%geometry%thck(:,:) * thk0 + topg_unscaled(:,:) = model%geometry%topg(:,:) * 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(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) ! 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) @@ -1346,7 +1245,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, & @@ -1410,8 +1309,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 @@ -1426,11 +1325,195 @@ subroutine glissade_transport_solve(model) call parallel_halo(thck_unscaled) call parallel_halo_tracers(model%geometry%tracers) - enddo ! subcycling + enddo ! subcycling of transport + + !------------------------------------------------------------------------- + ! Prepare the surface and basal mass balance terms. + ! Note: The basal mass balance has been computed in subroutine glissade_bmlt_float_solve. + !------------------------------------------------------------------------- + + ! 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. + + ! 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 + + ! Convert acab_corrected to a temporary array in SI units (m/s) + acab_unscaled(:,:) = model%climate%acab_corrected(:,:) * thk0/tim0 + + + ! 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 + else ! do not include bmlt in continuity equation + bmlt_unscaled(:,:) = 0.0d0 + endif + + !------------------------------------------------------------------------- + ! Optionally, invert for basal fields: topography, basal traction and basal melting. + !------------------------------------------------------------------------- + + if (model%options%which_ho_inversion == HO_INVERSION_COMPUTE .or. & + 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 + thck_new_unscaled = max(thck_new_unscaled, 0.0d0) + + call glissade_inversion_solve(model, & + thck_new_unscaled, & + ice_mask, & + floating_mask, & + land_mask, & + grounding_line_mask) + + 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(ewn, 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, 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) + 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_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. + + ! 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%inversion%bmlt_float_inversion/effective_areafrac + endwhere + + 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 + ! (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, & + ewn, nsn, 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 + call parallel_halo(thck_unscaled) + + !------------------------------------------------------------------------- + ! Cleanup + !------------------------------------------------------------------------- ! 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 @@ -1440,8 +1523,8 @@ subroutine glissade_transport_solve(model) 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)) @@ -1455,42 +1538,36 @@ subroutine glissade_transport_solve(model) 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 = 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 + do i = itest-5, itest+5 write(6,'(f14.7)',advance='no') model%temper%temp(k,i,j) enddo write(6,*) ' ' @@ -1505,7 +1582,7 @@ subroutine glissade_transport_solve(model) ! restore old thickness model%geometry%thck(:,:) = model%geometry%thck_old(:,:) endif - + end select !------------------------------------------------------------------------ @@ -1513,7 +1590,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, & @@ -1521,11 +1598,308 @@ subroutine glissade_transport_solve(model) model%geometry%usrf(:,:) = max(0.d0, model%geometry%thck(:,:) + model%geometry%lsrf(:,:)) - end subroutine glissade_transport_solve + 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_thickness_tracer_solve !======================================================================= - subroutine glissade_calving_solve(model) + 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%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%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%inversion%usrf_inversion(:,:) = usrf_new_unscaled(:,:) + model%inversion%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%inversion%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%inversion%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%inversion, & + ice_mask, & + floating_mask, & !TODO - before transport? + land_mask, & + grounding_line_mask, & + model%inversion%usrf_inversion, & ! m + model%geometry%usrf_obs*thk0, & ! m + model%inversion%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_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, + ! 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%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) + + !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%inversion%bmlt_float_inversion(i,j)*scyr + print*, ' ' + endif + + 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, + ! for example if a cell flips from grounded to floating or vice versa. + + call prescribe_basal_traction(ewn, nsn, & + itest, jtest, rtest, & + model%inversion, & + 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%inversion, & + 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%inversion%bmlt_float_prescribed(i,j)*scyr, & + model%inversion%bmlt_float_inversion(i,j)*scyr + print*, ' ' + endif + + endif ! which_ho_inversion (compute or prescribed) + + end subroutine glissade_inversion_solve + +!======================================================================= + + subroutine glissade_calving_solve(model, init_calving) ! ------------------------------------------------------------------------ ! Calculate iceberg calving @@ -1541,59 +1915,60 @@ 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 --- - integer :: i, j + real(dp), dimension(model%general%ewn, model%general%nsn) :: & + thck_unscaled ! model%geometry%thck converted to m - ! --- 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? + logical :: cull_calving_front ! true iff init_calving = T and options%cull_calving_front = T - call glide_set_mask(model%numerics, & - model%geometry%thck, model%geometry%topg, & - model%general%ewn, model%general%nsn, & - model%climate%eus, model%geometry%thkmask) + integer :: i, j - !TODO - Make sure no more halo updates are needed before glissade_calve_ice + !TODO - Make sure no additional 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 - !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, & - 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%strain_rate_eigenprod, & ! s^(-2) - model%calving%eigencalving_constant, & - model%calving%calving_minthck, & - model%calving%taumax_cliff, & - model%calving%cliff_timescale, & - model%calving%calving_mask, & - model%calving%damage, & - model%calving%damage_threshold, & - model%calving%damage_column, & - model%numerics%sigma, & - model%calving%calving_thck) + 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 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. @@ -1609,6 +1984,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 !======================================================================= @@ -1703,11 +2084,13 @@ 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 + use glissade_inversion, only: verbose_inversion implicit none @@ -1727,16 +2110,22 @@ 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 lambda1, lambda2 ! eigenvalues of horizontal strain rate tensor + !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 itest = 1 jtest = 1 @@ -1797,7 +2186,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 @@ -1842,12 +2234,11 @@ 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} - 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(:,:,:)) @@ -2142,7 +2533,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) @@ -2161,8 +2648,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 @@ -2174,6 +2663,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 @@ -2186,85 +2676,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) @@ -2349,6 +2760,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,47 +2783,113 @@ 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 + ! 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. & + 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 + 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%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) + 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 - 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 + model%basal_melt%bmlt_applied_old(:,:) = model%basal_melt%bmlt_applied(:,:) + + ! 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 + ! 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 - 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 - 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 diff --git a/libglissade/glissade_basal_traction.F90 b/libglissade/glissade_basal_traction.F90 index 394b79b0..712dce2c 100644 --- a/libglissade/glissade_basal_traction.F90 +++ b/libglissade/glissade_basal_traction.F90 @@ -73,7 +73,13 @@ subroutine calcbeta (whichbabc, & mask, beta_external, & beta, & topg, eus, & - f_ground) + ice_mask, & + floating_mask, & + land_mask, & + f_ground, & + which_ho_inversion, & + powerlaw_c_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 +105,30 @@ 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 + 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 + 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 @@ -123,24 +139,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)) :: & + 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 + ! 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,12 +175,35 @@ 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 -!! integer :: istop, jstop + logical, parameter :: verbose_beta = .false. + + !TODO - Make which_ho_inversion a non-optional argument? + if (present(which_ho_inversion)) then + which_inversion = which_ho_inversion + else + 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) @@ -197,7 +241,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 @@ -216,13 +259,15 @@ 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 -! 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 @@ -240,14 +285,12 @@ 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 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 @@ -278,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 @@ -331,8 +374,47 @@ 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) + 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_PRESCRIBE) 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, & + 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. @@ -349,7 +431,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) @@ -360,14 +441,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 +461,13 @@ 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 +477,96 @@ 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 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. - 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 - 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) + enddo + enddo + + elseif (which_inversion == HO_INVERSION_COMPUTE .or. & + which_inversion == HO_INVERSION_PRESCRIBE) then ! use powerlaw_c and coulomb_c from inversion + + m = basal_physics%powerlaw_m - beta(ew,ns) = (numerator/denominator) * speed(ew,ns)**(1.d0/m - 1.d0) + ! stagger_margin_in = 1: Interpolate using only the values in ice-covered and land-based cells. + + where (ice_mask == 1 .or. land_mask == 1) + ice_or_land_mask = 1 + elsewhere + ice_or_land_mask = 0 + endwhere + call glissade_stagger(ewn, nsn, & + powerlaw_c_inversion, & + stag_powerlaw_c_inversion, & + ice_or_land_mask, & + stagger_margin_in = 1) + + ! 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 + + do ns = 1, nsn-1 + do ew = 1, ewn-1 + + 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) + & + (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 +!! 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), & + (basal_physics%coulomb_c * basal_physics%effecpress_stag(ew,ns)), & + speed(ew,ns), beta(ew,ns), beta(ew,ns)*speed(ew,ns) + endif + endif + + enddo enddo - enddo - !TODO - Verify that the results are similar to Tsai + endif ! which_inversion ! Limit for numerical stability !TODO - Is limiting needed? @@ -452,36 +586,38 @@ 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, in addition to 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 +648,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 @@ -536,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 @@ -544,7 +680,6 @@ subroutine calcbeta (whichbabc, & endif enddo enddo - endif ! present(f_ground) ! Bug check: Make sure beta >= 0 @@ -565,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 !*********************************************************************** @@ -642,11 +787,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) @@ -711,6 +852,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 +866,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 +879,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 +888,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 @@ -808,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, & @@ -815,8 +960,9 @@ subroutine calc_effective_pressure (which_effecpress, & end subroutine calc_effective_pressure -!*********************************************************************** +!======================================================================= end module glissade_basal_traction -!*********************************************************************** +!======================================================================= + diff --git a/libglissade/glissade_bmlt_float.F90 b/libglissade/glissade_bmlt_float.F90 index cca4d427..c1d77cab 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) @@ -220,7 +217,6 @@ subroutine glissade_basal_melting_float(whichbmlt_float, & real(dp) :: z_draft ! draft of floating ice (m below sea level) 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 +289,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 +330,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 +858,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 diff --git a/libglissade/glissade_calving.F90 b/libglissade/glissade_calving.F90 index 96efc560..36c279d2 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 @@ -43,14 +43,11 @@ 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 -!------------------------------------------------------------------------------- +!------------------------------------------------------------------------------- subroutine glissade_calving_mask_init(dx, dy, & thck, topg, & @@ -99,7 +96,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 @@ -200,110 +197,95 @@ 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, & - eigenprod, & - eigencalving_constant, & - calving_minthck, & - taumax_cliff, & - cliff_timescale, & - calving_mask, & - damage, & - damage_threshold, & - damage_column, & + dt, & ! s + dx, dy, & ! m sigma, & - calving_thck, & - cull_calving_front_in, & - ncull_calving_front_in) + 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 - Shorten the argument list by passing in a calving derived type !--------------------------------------------------------------------- ! 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. !--------------------------------------------------------------------- - 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 - - 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 which_calving = 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) + 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 + !> 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 !> 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 (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/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) +! 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 !> 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/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 (m) + + integer, intent(in) :: itest, jtest, rtest !> coordinates of diagnostic point + 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(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) :: calving_minthck !> min thickness of floating ice before it calves; - !> used with CALVING_THCK_THRESHOLD and EIGENCALVING - 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), intent(in) :: damage_threshold !> threshold value where ice is sufficiently damaged to calve real(dp), dimension(:), intent(in) :: sigma !> vertical sigma coordinate - 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 + 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 - 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 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 - 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 - - integer, dimension(:,:), allocatable :: & - color ! integer 'color' for filling the calving domain (with CALVING_DOMAIN_OCEAN_CONNECT) + calving_thck_init ! debug diagnostic ! basic masks integer, dimension(:,:), allocatable :: & @@ -319,9 +301,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? @@ -330,17 +310,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) :: & - 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 - areafrac, & ! fractional ice-covered area in a calving_front cell - dthck, & ! thickness change (model units) - 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/s) + calving_frac, & ! fraction of potential calving that is actually applied + 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 (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 real(dp), parameter :: & thinning_limit = 0.99d0 ! When ice not originally on the calving front is allowed to thin, @@ -348,30 +328,9 @@ subroutine glissade_calve_ice(which_calving, & character(len=100) :: message - !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 - 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) @@ -398,9 +357,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 @@ -432,14 +391,10 @@ 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 - ! 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? @@ -447,21 +402,32 @@ 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 ! 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 +438,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,26 +446,24 @@ 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+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) enddo write(6,*) ' ' enddo - print*, ' ' - 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) @@ -509,188 +471,294 @@ subroutine glissade_calve_ice(which_calving, & write(6,*) ' ' enddo 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 + write(6,'(f10.3)',advance='no') thck_calving_front(i,j) enddo write(6,*) ' ' enddo - 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 + write(6,'(f10.3)',advance='no') thck(i,j) 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(calving%tau_eigen1, 0.0d0) + tau2 = max(calving%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 - if (eigenprod(i,j) == 0) then + ! 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. - ! 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%tau_eff(:,:) = sqrt(tau1(:,:)**2 + (calving%eigen2_weight * tau2(:,:))**2) - endif ! eigenprod = 0 after looping over edge neighbors + 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 (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') calving%tau_eff(i,j) + enddo + write(6,*) ' ' + enddo + endif - endif ! eigenprod = 0 + ! 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). - ! Do eigencalving in this calving_front cell + calving%lateral_rate(:,:) = 0.0d0 - if (eigenprod(i,j) > 0.0d0 .and. thck_calving_front(i,j) > 0.0d0) then + if (which_calving == EIGENCALVING) 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 + ! Compute the lateral calving rate (m/s) from the effective tensile stress in calving_front cells - ! 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 + do j = 2, ny-1 + do i = 2, nx-1 + if (calving_front_mask(i,j) == 1) then + calving%lateral_rate(i,j) = calving%eigencalving_constant * calving%tau_eff(i,j) + endif + enddo ! i + enddo ! j - 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 + elseif (which_calving == CALVING_DAMAGE) then - ! 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 + ! Prognose changes in damage. + ! 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. - else - thck(i,j) = thck(i,j) - dthck - calving_thck(i,j) = calving_thck(i,j) + dthck - endif + 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) ! 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 + calving%damage(:,i,j) = 0.0d0 + endif + enddo + enddo + + ! Compute the vertically integrated damage in each column. + allocate(damage_column(nx,ny)) + damage_column(:,:) = 0.0d0 + + do j = 1, ny + do i = 1, nx + do k = 1, nz-1 + damage_column(i,j) = damage_column(i,j) + calving%damage(k,i,j) * (sigma(k+1) - sigma(k)) + enddo + enddo + enddo + + ! 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. + 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/s + endif + enddo + enddo + + 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') calving%damage_constant * calving%tau_eff(i,j) * dt + 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_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), + ! 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_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) / 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/scyr + print*, 'lateral calving rate (m/yr) =', calving%lateral_rate(i,j)*scyr + print*, 'dthck (m) =', dthck + endif - endif ! eigenprod > 0 and thck_calving_front > 0 + ! Compute the new ice thickness + ! If the column calves completely, then apply the remaining calving to the upstream cell. - endif ! calving_front_mask = 1 + if (dthck > thck(i,j)) then + calving_frac = thck(i,j)/dthck + 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). + ! 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 = 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 + 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%calving_thck(i,j) = calving%calving_thck(i,j) + dthck + endif + + endif ! calving%lateral_rate > 0 enddo ! i enddo ! j 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 + 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_rate(i,j) * scyr 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+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 + write(6,'(f10.3)',advance='no') calving%calving_thck(i,j) enddo write(6,*) ' ' 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 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' 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) then + if (which_calving == CALVING_THCK_THRESHOLD .or. which_calving == EIGENCALVING & + .or. which_calving == CALVING_DAMAGE) 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(:,:) + calving_thck_init(:,:) = calving%calving_thck(:,:) ! Save the initial thickness, which is used below to identify upstream interior cells. thck_init(:,:) = thck(:,:) @@ -704,6 +772,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) @@ -715,7 +784,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,20 +794,20 @@ 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 + write(6,'(f10.3)',advance='no') thck_calving_front(i,j) enddo write(6,*) ' ' enddo 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 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' enddo @@ -746,14 +815,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 ! @@ -761,39 +830,38 @@ 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 +!! 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 - thinning_rate = (calving_minthck - thck_calving_front(i,j)) / calving_timescale + ! 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 - 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) @@ -806,21 +874,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 @@ -831,27 +899,26 @@ 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 - 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)) enddo write(6,*) ' ' 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 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' enddo 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 @@ -859,14 +926,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 @@ -879,7 +946,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,29 +957,29 @@ 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 + write(6,'(f10.3)',advance='no') thck_calving_front(i,j) enddo write(6,*) ' ' enddo 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 + write(6,'(f10.3)',advance='no') (calving%calving_thck(i,j) - calving_thck_init(i,j)) enddo write(6,*) ' ' 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 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' enddo @@ -928,23 +995,19 @@ 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 + write(6,'(f10.3)',advance='no') thck(i,j) enddo 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+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) + write(6,'(i10)',advance='no') calving%calving_mask(i,j) enddo write(6,*) ' ' enddo @@ -953,8 +1016,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 @@ -962,12 +1025,21 @@ 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%calving_thck(i,j) + enddo + write(6,*) ' ' + enddo 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 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' enddo @@ -1014,8 +1086,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 <= 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. @@ -1023,7 +1095,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*thk0 + eus) ! convert marine_limit from scaled units to m calving_law_mask = .true. elsewhere calving_law_mask = .false. @@ -1031,80 +1103,20 @@ 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. 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) @@ -1137,7 +1149,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) @@ -1151,127 +1163,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 @@ -1280,10 +1171,10 @@ 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_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 @@ -1291,12 +1182,30 @@ 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+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 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' enddo @@ -1328,7 +1237,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,11 +1250,11 @@ 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 - thckmax_cliff = factor + sqrt(factor**2 + (rhoo/rhoi)*(topg(i,j)*thk0)**2) ! m + 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))**2) ! m write(6,'(f10.3)',advance='no') thckmax_cliff enddo write(6,*) ' ' @@ -1359,15 +1268,14 @@ 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 - thckmax_cliff = factor + sqrt(factor**2 + (rhoo/rhoi)*(topg(i,j)*thk0)**2) ! m - thckmax_cliff = thckmax_cliff / thk0 ! convert to model units + 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))**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 @@ -1375,8 +1283,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 @@ -1386,14 +1294,13 @@ 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 - calving_thck(i,j) = calving_thck(i,j) + dthck + calving%calving_thck(i,j) = calving%calving_thck(i,j) + dthck endif ! thck > thckmax_cliff @@ -1426,9 +1333,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 @@ -1436,20 +1343,20 @@ 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 + write(6,'(f10.3)',advance='no') calving%calving_thck(i,j) enddo write(6,*) ' ' enddo 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 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' enddo @@ -1469,7 +1376,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 @@ -1482,8 +1392,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. @@ -1506,7 +1416,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 @@ -1517,18 +1426,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 @@ -1549,18 +1453,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) @@ -1596,16 +1488,16 @@ 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 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' 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,16 +1506,16 @@ 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 + write(6,'(f10.3)',advance='no') thck_calving_front(i,j) enddo write(6,*) ' ' 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,16 +1576,16 @@ 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 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' 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,16 +1594,16 @@ 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 + write(6,'(f10.3)',advance='no') thck_calving_front(i,j) enddo write(6,*) ' ' 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) @@ -1836,16 +1728,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) +!! 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 @@ -1864,10 +1775,10 @@ 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 + write(6,'(f10.3)',advance='no') thck(i,j) enddo write(6,*) ' ' enddo @@ -1875,6 +1786,229 @@ 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? Connection to calving is only the use of glissade_fill. + + 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. + + 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 = itest-3, itest+3 + 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 = itest-3, itest+3 + 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 = itest-3, itest+3 + 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, & diff --git a/libglissade/glissade_grid_operators.F90 b/libglissade/glissade_grid_operators.F90 index 9d57fbe7..d27ebb23 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 determines 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,7 @@ 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. ! ! The mask is set to true at all edges where either ! (1) Both adjacent cells are ice-covered. @@ -645,6 +656,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 +735,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 +765,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 +807,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 +855,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 +934,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 +979,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 +1138,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 +1185,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 +1205,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_grounding_line.F90 b/libglissade/glissade_grounding_line.F90 index f35b2294..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 @@ -179,16 +183,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 +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) = f_flotation_land_linear + ! 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 @@ -293,7 +300,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 +312,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 +346,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 +402,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 @@ -507,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) @@ -683,7 +693,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 new file mode 100644 index 00000000..b146712c --- /dev/null +++ b/libglissade/glissade_inversion.F90 @@ -0,0 +1,1193 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! 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 + + ! 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 + ! a target ice thickness field. + !----------------------------------------------------------------------------- + + logical, parameter :: verbose_inversion = .false. + +!*********************************************************************** + +contains + +!*********************************************************************** + + 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 + + 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 + + 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 + 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. + ! 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 + + ! 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. + +! 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) < inversion%bmlt_thck_buffer) then +! if (dthck > 0.0d0) then +! 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) - inversion%bmlt_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 + inversion%bmlt_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%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. + 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%inversion%powerlaw_c_inversion(:,:) = model%inversion%powerlaw_c_max +!! model%inversion%powerlaw_c_inversion(:,:) = model%inversion%powerlaw_c + endif + + call parallel_halo(model%inversion%powerlaw_c_inversion) + + elseif (model%options%which_ho_inversion == HO_INVERSION_PRESCRIBE) then + + ! prescribing basal friction coefficient and basal melting from previous 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_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 and bmlt_float_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 + write(message,*) 'powerlaw_c_prescribed has been read from input file' + call write_log(trim(message)) + else + 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%inversion%powerlaw_c_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 + write(message,*) 'bmlt_float_prescribed has been read from input file' + call write_log(trim(message)) + else + 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%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. + ! 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 + + 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%inversion%powerlaw_c_inversion(:,:) = model%inversion%powerlaw_c_prescribed(:,:) + endif + + call parallel_halo(model%inversion%powerlaw_c_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%inversion%bmlt_float_inversion(:,:) = model%inversion%bmlt_float_prescribed(:,:) + endif + + call parallel_halo(model%inversion%bmlt_float_inversion) + + endif ! which_ho_inversion + + end subroutine glissade_init_inversion + +!*********************************************************************** + + 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(dt, & + nx, ny, & + itest, jtest, rtest, & + inversion, & + ice_mask, & + floating_mask, & + land_mask, & + 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) + + integer, intent(in) :: & + nx, ny ! grid dimensions + + integer, intent(in) :: & + itest, jtest, rtest ! coordinates of diagnostic point + + 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 + 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) :: & + 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) :: & + 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 + + real(dp) :: term1, term2 + real(dp) :: factor + real(dp) :: dpowerlaw_c_smooth + real(dp) :: sum_powerlaw_c + + integer :: i, j, ii, jj + integer :: count + + ! 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 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 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 (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 (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 + inversion%powerlaw_c_inversion(i,j) = inversion%powerlaw_c_land + else + inversion%powerlaw_c_inversion(i,j) = inversion%powerlaw_c_marine + endif + endif ! powerlaw_c_inversion = 0 + + endif ! powerlaw_c_inversion_mask = 1 + enddo ! i + enddo ! j + + 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. + ! Later, it is interpolated to vertices where beta and basal velocity are located. + + 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 + + ! Save the starting value + old_powerlaw_c(i,j) = inversion%powerlaw_c_inversion(i,j) + + ! Invert for powerlaw_c based on dthck and dthck_dt + 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 + ! (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/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 * inversion%powerlaw_c_inversion(i,j)) then + if (dpowerlaw_c(i,j) > 0.0d0) then + dpowerlaw_c(i,j) = 0.05d0 * inversion%powerlaw_c_inversion(i,j) + else + dpowerlaw_c(i,j) = -0.05d0 * inversion%powerlaw_c_inversion(i,j) + endif + endif + + inversion%powerlaw_c_inversion(i,j) = inversion%powerlaw_c_inversion(i,j) + dpowerlaw_c(i,j) + + ! Limit to a physically reasonable range + 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 + print*, ' ' + 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 =', & + term1, term2, & + term1 + term2 + print*, 'dpowerlaw_c, newpowerlaw_c =', dpowerlaw_c(i,j), inversion%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. + + inversion%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') inversion%powerlaw_c_inversion(i,j) + enddo + write(6,*) ' ' + enddo + endif + + if (inversion%babc_space_smoothing > 0.0d0) then + + ! Save the value just computed + 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. + !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 * 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 & + + inversion%babc_space_smoothing*temp_powerlaw_c(ii,jj) + else + dpowerlaw_c_smooth = dpowerlaw_c_smooth & + + 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 + 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 + 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 + 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 + inversion%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(inversion%powerlaw_c_inversion) + + if (verbose_inversion .and. this_rank == rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'usrf - usrf_obs:' + do j = jtest+3, jtest-3, -1 + do i = itest-3, itest+3 + 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.4)',advance='no') dthck_dt(i,j)*scyr + enddo + write(6,*) ' ' + enddo + 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') inversion%powerlaw_c_inversion(i,j) + enddo + write(6,*) ' ' + enddo + endif + endif + + end subroutine invert_basal_traction + +!*********************************************************************** + + subroutine prescribe_basal_traction(nx, ny, & + itest, jtest, rtest, & + inversion, & + 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_inversion), intent(inout) :: & + inversion ! inversion 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 (inversion%powerlaw_c_prescribed(i,j) > 0.0d0) then ! use the prescribed value + + inversion%powerlaw_c_inversion(i,j) = inversion%powerlaw_c_prescribed(i,j) + + else ! assign a sensible default + + if (land_mask(i,j) == 1) then + inversion%powerlaw_c_inversion(i,j) = inversion%powerlaw_c_land + else + inversion%powerlaw_c_inversion(i,j) = inversion%powerlaw_c_marine + endif + + endif ! powerlaw_c_prescribed > 0 + + endif ! powerlaw_c_inversion_mask + enddo ! i + enddo ! j + + call parallel_halo(inversion%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') inversion%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') inversion%powerlaw_c_inversion(i,j) + enddo + write(6,*) ' ' + enddo + endif ! verbose + + end subroutine prescribe_basal_traction + + !*********************************************************************** + + subroutine invert_bmlt_float(dt, & + nx, ny, & + itest, jtest, rtest, & + inversion, & + thck, & + usrf_obs, & + topg, & + eus, & + ice_mask, & + floating_mask, & + land_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_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) + 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 + + ! 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 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 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 + inversion%bmlt_float_inversion(:,:) = 0.0d0 + + ! loop over cells + do j = 1, ny + do i = 1, nx + + if (land_mask(i,j) == 1) then + + ! do nothing; bmlt_float_inversion = 0 + + 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) + 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) + inversion%bmlt_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 + + if (bmlt_inversion_mask(i,j) == 1) then + 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 + 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), inversion%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) + 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(inversion%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*, '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') inversion%bmlt_float_inversion(i,j)*scyr + enddo + write(6,*) ' ' + enddo + endif + + end subroutine invert_bmlt_float + +!*********************************************************************** + + subroutine prescribe_bmlt_float(dt, & + nx, ny, & + itest, jtest, rtest, & + inversion, & + 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_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) + 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 + inversion%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 + 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) - inversion%bmlt_float_inversion(i,j)*dt + + if (thck_final(i,j) < 0.0d0) then + thck_final(i,j) = 0.0d0 + inversion%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), & + inversion%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') inversion%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') inversion%bmlt_float_inversion(i,j)*scyr + enddo + write(6,*) ' ' + enddo + endif + + end subroutine prescribe_bmlt_float + +!======================================================================= + +end module glissade_inversion + +!======================================================================= diff --git a/libglissade/glissade_masks.F90 b/libglissade/glissade_masks.F90 index 9457496d..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 @@ -143,6 +146,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 !---------------------------------------------------------------- @@ -210,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, @@ -225,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(thck_calving_front) .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 @@ -235,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). @@ -264,12 +313,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 @@ -277,7 +328,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 @@ -312,49 +363,67 @@ 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(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 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 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 .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 + !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 (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 endif ! ice_mask enddo enddo + call parallel_halo(active_ice_mask) + endif ! active_ice_mask is present 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_therm.F90 b/libglissade/glissade_therm.F90 index ce93bbe7..971d0446 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 @@ -1604,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, @@ -1676,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 @@ -1999,13 +1999,16 @@ 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, & + flow_enhancement_factor_float, & floating_mask, & waterfrac) @@ -2037,18 +2040,20 @@ 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 + 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 @@ -2088,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 @@ -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 diff --git a/libglissade/glissade_transport.F90 b/libglissade/glissade_transport.F90 index 7e4f55f3..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) @@ -534,10 +533,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 +1306,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 @@ -1417,7 +1414,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. @@ -1455,8 +1457,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 @@ -1515,29 +1516,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 - ! adjust mass-tracer product for the bottom layer + ! do nothing - do nt = 1, ntracer !TODO - Put this loop on the outside for speedup? + else ! not ocean; accumulate ice - thck_tracer(i,j,nt,nlyr) = thck_layer(i,j,nlyr) * tracer(i,j,nt,nlyr) & - + bed_accum * tracer_lsrf(i,j,nt) + bmlt_applied(i,j) = bmlt_applied(i,j) - bed_accum*effective_areafrac(i,j) ! bmlt_applied < 0 for freeze-on - enddo ! ntracer + ! adjust mass-tracer product for the bottom layer - ! new bottom layer thickess - thck_layer(i,j,nlyr) = thck_layer(i,j,nlyr) + bed_accum + do nt = 1, ntracer !TODO - Put this loop on the outside for speedup? - ! new tracer values in bottom layer - tracer(i,j,:,nlyr) = thck_tracer(i,j,:,nlyr) / thck_layer(i,j,nlyr) + 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 + + ! 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) + + endif ! ocean_mask = 1 elseif (bmlt(i,j) > 0.d0) then ! basal melting in one or more layers @@ -1563,7 +1579,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 @@ -1602,7 +1619,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..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. @@ -667,6 +669,7 @@ subroutine glissade_velo_higher_solve(model, & !---------------------------------------------------------------- use glissade_basal_traction, only: calcbeta, calc_effective_pressure + use glissade_inversion, only: invert_basal_traction, prescribe_basal_traction use glissade_therm, only: glissade_pressure_melting_point !---------------------------------------------------------------- @@ -708,6 +711,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 +723,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) @@ -751,6 +757,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 @@ -758,6 +767,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) @@ -800,8 +810,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 @@ -811,7 +823,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 @@ -1022,6 +1036,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(:,:) @@ -1056,10 +1072,13 @@ 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(:,:) + dt = model%numerics%dt thklim = model%numerics%thklim thck_gradient_ramp = model%numerics%thck_gradient_ramp max_slope = model%paramets%max_slope @@ -1068,6 +1087,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 @@ -1091,7 +1111,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, & @@ -1100,7 +1119,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') @@ -1112,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 @@ -1280,6 +1289,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 @@ -1452,17 +1462,16 @@ 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. - ! ! 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 @@ -1482,26 +1491,90 @@ 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. + ! 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. !------------------------------------------------------------------------------ -!pw call t_startf('glissade_stagger') + ! 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, & - active_ice_mask, & + ice_plus_land_mask, & stagger_margin_in = 1) call glissade_stagger(nx, ny, & usrf, stagusrf, & - active_ice_mask, & + ice_plus_land_mask, & + stagger_margin_in = 1) + + ! 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) -!pw call t_stopf('glissade_stagger') + + 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: @@ -1511,10 +1584,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). @@ -1536,15 +1611,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) @@ -1891,6 +1967,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. @@ -1898,13 +1978,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). @@ -1940,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' @@ -1951,7 +2039,6 @@ subroutine glissade_velo_higher_solve(model, & else ! residual based on velocity print *, 'iter # velo resid target resid' end if - print *, ' ' endif !------------------------------------------------------------------------------ @@ -1989,8 +2076,11 @@ subroutine glissade_velo_higher_solve(model, & call t_startf('glissade_load_vector_gravity') call load_vector_gravity(nx, ny, & - nz, sigma, & - nhalo, active_cell, & + nz, nhalo, & + sigma, stagwbndsigma, & + dx, dy, & + active_cell, & + active_vertex, & xVertex, yVertex, & stagusrf, stagthck, & dusrf_dx, dusrf_dy, & @@ -2013,8 +2103,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. @@ -2058,11 +2148,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') @@ -2094,7 +2184,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 @@ -2104,7 +2194,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 @@ -2135,9 +2225,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 @@ -2304,7 +2408,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 @@ -2357,6 +2461,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 @@ -2417,6 +2524,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 @@ -2458,7 +2567,13 @@ 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, & + land_mask, & + f_ground, & + whichinversion, & + powerlaw_c_inversion, & + itest, jtest, rtest) if (verbose_beta) then maxbeta = maxval(beta_internal(:,:)) @@ -2468,8 +2583,7 @@ 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 @@ -2477,14 +2591,14 @@ subroutine glissade_velo_higher_solve(model, & 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 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,*) ' ' @@ -2495,7 +2609,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 @@ -2506,7 +2620,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 @@ -2520,7 +2634,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 @@ -2532,7 +2646,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 @@ -2544,7 +2658,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 @@ -2556,7 +2670,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 @@ -2629,21 +2743,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) - enddo - write(6,*) ' ' - enddo - endif - - if (whichbabc == HO_BABC_COULOMB_FRICTION .or. & - whichbabc == HO_BABC_COULOMB_CONST_BASAL_FLWA) 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) + write(6,'(e10.3)',advance='no') model%basal_physics%mintauf(i,j) * tau0 enddo write(6,*) ' ' enddo @@ -2681,7 +2781,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, & @@ -2708,9 +2809,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 - call glissade_stagger(nx, ny, & + call glissade_stagger(nx, ny, & omega(:,:), stag_omega(:,:), & - ice_mask, stagger_margin_in = 1) + ice_plus_land_mask, & + stagger_margin_in = 1) else ! solving for the velocity at level k (k = 1 at upper surface) @@ -2718,10 +2820,12 @@ subroutine glissade_velo_higher_solve(model, & call parallel_halo(omega_k(k,:,:)) - call glissade_stagger(nx, ny, & + ! Interpolate omega_k to the staggered grid + call glissade_stagger(nx, ny, & omega_k(k,:,:), stag_omega(:,:), & - ice_mask, stagger_margin_in = 1) - + ice_plus_land_mask, & + stagger_margin_in = 1) + endif !------------------------------------------------------------------- @@ -2760,12 +2864,26 @@ subroutine glissade_velo_higher_solve(model, & 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 + 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*, '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 @@ -2775,7 +2893,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) @@ -2786,7 +2906,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) @@ -2947,7 +3069,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, & @@ -2968,7 +3091,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,:,:)) @@ -3132,7 +3257,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, & @@ -3143,7 +3267,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, & @@ -3519,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 @@ -3605,9 +3728,10 @@ subroutine glissade_velo_higher_solve(model, & ! Interpolate omega_k to the staggered grid 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 ! Compute the new 3D velocity field @@ -3634,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 @@ -3667,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 @@ -3783,7 +3905,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, & @@ -3800,7 +3923,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, & @@ -3911,7 +4035,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, & @@ -3931,7 +4054,6 @@ subroutine glissade_velo_higher_scale_input(dx, dy, & bwat, bmlt, & flwa, efvs, & btractx, btracty, & - mintauf, & uvel, vvel, & uvel_2d, vvel_2d) @@ -3963,10 +4085,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) @@ -3996,9 +4114,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) @@ -4019,7 +4134,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, & @@ -4054,10 +4168,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) @@ -4105,9 +4215,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 !**************************************************************************** @@ -4241,7 +4348,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 @@ -4267,8 +4374,11 @@ end subroutine get_vertex_geometry !**************************************************************************** subroutine load_vector_gravity(nx, ny, & - nz, sigma, & - nhalo, active_cell, & + nz, nhalo, & + sigma, stagwbndsigma, & + dx, dy, & + active_cell, & + active_vertex, & xVertex, yVertex, & stagusrf, stagthck, & dusrf_dx, dusrf_dy, & @@ -4284,9 +4394,18 @@ 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 + 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 @@ -4314,6 +4433,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 @@ -4333,77 +4453,90 @@ subroutine load_vector_gravity(nx, ny, & print*, 'In load_vector_gravity: itest, jtest, ktest, rtest =', itest, jtest, ktest, rtest endif - ! Sum over elements in active cells - ! Loop over all cells that border locally owned vertices - ! This includes halo cells to the north and east + if (whichassemble_taud == HO_ASSEMBLE_TAUD_LOCAL) then - do j = nhalo+1, ny-nhalo+1 - do i = nhalo+1, nx-nhalo+1 - - if (active_cell(i,j)) then + ! Sum over active vertices + do j = 1, ny-1 + do i = 1, nx-1 + if (active_vertex(i,j)) then - do k = 1, nz-1 ! loop over elements in this column - ! assume k increases from upper surface to bed + 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 - ! compute spatial coordinates and upper surface elevation gradient for each node + do k = 1, nz ! loop over vertices in this column + ! assume k increases from upper surface to bed - do n = 1, nNodesPerElement_3d + dz = stagthck(i,j) * (stagwbndsigma(k) - stagwbndsigma(k-1)) - ! 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) + ! 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) - 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) then + 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 - 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 ! k - enddo ! nodes per element + endif ! active_vertex + enddo ! i + enddo ! j - ! Loop over quadrature points for this element - - do p = 1, nQuadPoints_3d + return - ! 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 + else ! standard assembly - 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 ) + ! 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 + + if (active_cell(i,j)) then - ! 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 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.) + do k = 1, nz-1 ! loop over elements in this column + ! assume k increases from upper surface to bed - if (whichassemble_taud == HO_ASSEMBLE_TAUD_LOCAL) then + ! compute spatial coordinates and upper surface elevation gradient for each node - ! 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) + 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) + + 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*, 'p, delta(loadu), delta(loadv):', p, -rhoi*grav*detJ/vol0 * dsdx(p), & - -rhoi*grav*detJ/vol0 * dsdy(p) + 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 - else ! standard FE assembly (HO_ASSEMBLE_TAUD_STANDARD) + enddo ! nodes per 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 ! Evaluate dsdx and dsdy at this quadrature point dsdx_qp = 0.d0 @@ -4444,16 +4577,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 @@ -4462,11 +4595,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) :: & @@ -4483,16 +4617,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 @@ -4515,7 +4649,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) @@ -4523,56 +4656,56 @@ 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 @@ -4584,12 +4717,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) !---------------------------------------------------------------------------------- @@ -4642,8 +4775,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 @@ -4757,13 +4890,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) @@ -4801,7 +4934,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) @@ -4833,7 +4966,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 @@ -4881,7 +5014,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, & @@ -5017,9 +5151,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 @@ -5126,7 +5257,7 @@ subroutine assemble_stiffness_matrix_3d(nx, ny, & enddo endif - endif ! active cell + endif ! active_cell enddo ! i enddo ! j @@ -5138,7 +5269,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, & @@ -5191,7 +5323,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) @@ -5318,7 +5450,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 @@ -5517,7 +5648,7 @@ subroutine assemble_stiffness_matrix_2d(nx, ny, & enddo endif - endif ! active cell + endif ! active_cell enddo ! i enddo ! j @@ -5799,7 +5930,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) :: & @@ -6126,7 +6257,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 @@ -6684,7 +6815,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, & @@ -6858,7 +6990,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 @@ -6896,7 +7028,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, & @@ -7115,6 +7249,7 @@ subroutine compute_internal_stress (nx, ny, & endif ! verbose_tau endif ! active cell + enddo ! i enddo ! j @@ -7802,7 +7937,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 !------------------------------------------------------------------ @@ -8050,7 +8185,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) @@ -8078,9 +8215,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) @@ -8120,83 +8263,98 @@ 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 - ! 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 + if (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 - !TODO - Should we exclude cells that have Dirichlet basal BCs for all vertices? + ! 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 - if (active_cell(i,j)) then ! ice is present + else ! standard assembly - ! Set x and y for each node + ! 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? + + if (active_cell(i,j)) then - ! 4-----3 y - ! | | ^ - ! | | | - ! 1-----2 ---> x + ! Set x and y for each node - x(1) = xVertex(i-1,j-1) - x(2) = xVertex(i,j-1) - x(3) = xVertex(i,j) - x(4) = xVertex(i-1,j) + ! 4-----3 y + ! | | ^ + ! | | | + ! 1-----2 ---> x - y(1) = yVertex(i-1,j-1) - y(2) = yVertex(i,j-1) - y(3) = yVertex(i,j) - y(4) = yVertex(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) - b(1) = beta(i-1,j-1) - b(2) = beta(i,j-1) - b(3) = beta(i,j) - b(4) = beta(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) - ! loop over quadrature points + b(1) = beta(i-1,j-1) + b(2) = beta(i,j-1) + b(3) = beta(i,j) + b(4) = beta(i-1,j) - do p = 1, nQuadPoints_2d + ! loop over quadrature points - ! 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? + do p = 1, nQuadPoints_2d - 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) + ! 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) - ! 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 =', beta_qp - print*, 'detJ/vol0 =', detJ/vol0 - endif - - ! Compute the element matrix for this quadrature point - ! (Note volume scaling) - - 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 @@ -8204,73 +8362,79 @@ 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) - enddo ! nc - enddo ! nr + 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. 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 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 @@ -8871,7 +9035,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| @@ -8918,6 +9087,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 @@ -8926,8 +9096,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 @@ -8937,17 +9107,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 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 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/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/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 diff --git a/tests/halfar/halfar-HO.config b/tests/halfar/halfar-HO.config index 88f053cc..030f4d4c 100644 --- a/tests/halfar/halfar-HO.config +++ b/tests/halfar/halfar-HO.config @@ -1,5 +1,3 @@ -[DOME-TEST] - [grid] upn = 10 ewn = 31 @@ -10,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 @@ -20,14 +18,17 @@ 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 +basal_mass_balance = 0 ;# 0 = bmlt not in continuity equation [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/halfar/halfar.config b/tests/halfar/halfar.config index df8de519..65055563 100644 --- a/tests/halfar/halfar.config +++ b/tests/halfar/halfar.config @@ -1,5 +1,3 @@ -[DOME-TEST] - [grid] upn = 10 ewn = 31 @@ -20,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) diff --git a/tests/ismip-hom/.DS_Store b/tests/ismip-hom/.DS_Store deleted file mode 100644 index 2ecc83d8..00000000 Binary files a/tests/ismip-hom/.DS_Store and /dev/null differ diff --git a/tests/ismip-hom/ismip-hom.config b/tests/ismip-hom/ismip-hom.config index c24ab2fe..dde5efca 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 @@ -33,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/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..537b6539 100644 --- a/tests/shelf/shelf-circular.config +++ b/tests/shelf/shelf-circular.config @@ -1,5 +1,3 @@ -[SHELF-TEST] - [grid] upn = 5 ewn = 41 @@ -32,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 d08fe821..aaa34a88 100644 --- a/tests/shelf/shelf-confined.config +++ b/tests/shelf/shelf-confined.config @@ -1,5 +1,3 @@ -[SHELF-TEST] - [grid] upn = 5 ewn = 43 @@ -33,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/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..75f49b58 100644 --- a/tests/stream/stream.config +++ b/tests/stream/stream.config @@ -1,5 +1,3 @@ -[STREAM-TEST ] - [grid] upn = 2 ewn = 15 @@ -29,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