diff --git a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 index c500e1631..82e04dc71 100644 --- a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 +++ b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 @@ -1,6 +1,7 @@ !======================================================================= ! -! Drivers for remapping and upwind ice transport +!deprecate upwind Drivers for remapping and upwind ice transport +! Drivers for incremental remapping ice transport ! ! authors: Elizabeth C. Hunke and William H. Lipscomb, LANL ! @@ -9,6 +10,7 @@ ! 2006: Incorporated remap transport driver and renamed from ! ice_transport_upwind. ! 2011: ECH moved edgearea arrays into ice_transport_remap.F90 +! 2020: deprecated upwind transport module ice_transport_driver @@ -28,12 +30,13 @@ module ice_transport_driver implicit none private - public :: init_transport, transport_remap, transport_upwind + public :: init_transport, transport_remap!deprecate upwind:, transport_upwind character (len=char_len), public :: & advection ! type of advection scheme used - ! 'upwind' => 1st order donor cell scheme +!deprecate upwind ! 'upwind' => 1st order donor cell scheme ! 'remap' => remapping scheme + ! 'none' => advection off (ktransport = -1 also turns it off) logical, parameter :: & ! if true, prescribe area flux across each edge l_fixed_area = .false. @@ -69,8 +72,9 @@ module ice_transport_driver !======================================================================= ! ! This subroutine is a wrapper for init_remap, which initializes the -! remapping transport scheme. If the model is run with upwind -! transport, no initializations are necessary. +! remapping transport scheme. +!deprecate upwind If the model is run with upwind +!deprecate upwind! transport, no initializations are necessary. ! ! authors William H. Lipscomb, LANL @@ -680,11 +684,12 @@ subroutine transport_remap (dt) end subroutine transport_remap !======================================================================= -! +!deprecate upwind! ! Computes the transport equations for one timestep using upwind. Sets ! several fields into a work array and passes it to upwind routine. - subroutine transport_upwind (dt) +!deprecate upwind + subroutine transport_upwind_deprecated (dt) use ice_boundary, only: ice_HaloUpdate use ice_blocks, only: nx_block, ny_block, block, get_block, nx_block, ny_block @@ -769,52 +774,52 @@ subroutine transport_upwind (dt) field_loc_Nface, field_type_vector) call ice_timer_stop(timer_bound) - !$OMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block) - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - +!deprecate upwind !$OMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block) +!deprecate upwind do iblk = 1, nblocks +!deprecate upwind this_block = get_block(blocks_ice(iblk),iblk) +!deprecate upwind ilo = this_block%ilo +!deprecate upwind ihi = this_block%ihi +!deprecate upwind jlo = this_block%jlo +!deprecate upwind jhi = this_block%jhi !----------------------------------------------------------------- ! fill work arrays with fields to be advected !----------------------------------------------------------------- - call state_to_work (nx_block, ny_block, & - ntrcr, & - narr, trcr_depend, & - aicen (:,:, :,iblk), trcrn (:,:,:,:,iblk), & - vicen (:,:, :,iblk), vsnon (:,:, :,iblk), & - aice0 (:,:, iblk), works (:,:, :,iblk)) +!deprecate upwind +!deprecate upwind call state_to_work (nx_block, ny_block, & +!deprecate upwind ntrcr, & +!deprecate upwind narr, trcr_depend, & +!deprecate upwind aicen (:,:, :,iblk), trcrn (:,:,:,:,iblk), & +!deprecate upwind vicen (:,:, :,iblk), vsnon (:,:, :,iblk), & +!deprecate upwind aice0 (:,:, iblk), works (:,:, :,iblk)) !----------------------------------------------------------------- ! advect !----------------------------------------------------------------- - call upwind_field (nx_block, ny_block, & - ilo, ihi, jlo, jhi, & - dt, & - narr, works(:,:,:,iblk), & - uee(:,:,iblk), vnn (:,:,iblk), & - HTE(:,:,iblk), HTN (:,:,iblk), & - tarea(:,:,iblk)) +!deprecate upwind call upwind_field (nx_block, ny_block, & +!deprecate upwind ilo, ihi, jlo, jhi, & +!deprecate upwind dt, & +!deprecate upwind narr, works(:,:,:,iblk), & +!deprecate upwind uee(:,:,iblk), vnn (:,:,iblk), & +!deprecate upwind HTE(:,:,iblk), HTN (:,:,iblk), & +!deprecate upwind tarea(:,:,iblk)) !----------------------------------------------------------------- ! convert work arrays back to state variables !----------------------------------------------------------------- - call work_to_state (nx_block, ny_block, & - ntrcr, narr, & - trcr_depend(:), trcr_base(:,:), & - n_trcr_strata(:), nt_strata(:,:), & - aicen(:,:, :,iblk), trcrn (:,:,:,:,iblk), & - vicen(:,:, :,iblk), vsnon (:,:, :,iblk), & - aice0(:,:, iblk), works (:,:, :,iblk)) +!deprecate upwind call work_to_state (nx_block, ny_block, & +!deprecate upwind ntrcr, narr, & +!deprecate upwind trcr_depend(:), trcr_base(:,:), & +!deprecate upwind n_trcr_strata(:), nt_strata(:,:), & +!deprecate upwind aicen(:,:, :,iblk), trcrn (:,:,:,:,iblk), & +!deprecate upwind vicen(:,:, :,iblk), vsnon (:,:, :,iblk), & +!deprecate upwind aice0(:,:, iblk), works (:,:, :,iblk)) - enddo ! iblk - !$OMP END PARALLEL DO +!deprecate upwind enddo ! iblk +!deprecate upwind !$OMP END PARALLEL DO deallocate (works) @@ -832,7 +837,8 @@ subroutine transport_upwind (dt) call ice_timer_stop(timer_advect) ! advection - end subroutine transport_upwind + end subroutine transport_upwind_deprecated +!deprecate upwind !======================================================================= ! The next few subroutines (through check_monotonicity) are called @@ -1455,12 +1461,12 @@ subroutine check_monotonicity (nx_block, ny_block, & end subroutine check_monotonicity !======================================================================= -! The remaining subroutines are called by transport_upwind. +!deprecate upwind! The remaining subroutines are called by transport_upwind. !======================================================================= ! ! Fill work array with state variables in preparation for upwind transport - - subroutine state_to_work (nx_block, ny_block, & +!deprecate upwind + subroutine state_to_work_deprecated (nx_block, ny_block, & ntrcr, & narr, trcr_depend, & aicen, trcrn, & @@ -1601,13 +1607,13 @@ subroutine state_to_work (nx_block, ny_block, & if (narr /= narrays) write(nu_diag,*) & "Wrong number of arrays in transport bound call" - end subroutine state_to_work + end subroutine state_to_work_deprecated !======================================================================= ! ! Convert work array back to state variables - - subroutine work_to_state (nx_block, ny_block, & +!deprecate upwind + subroutine work_to_state_deprecated (nx_block, ny_block, & ntrcr, narr, & trcr_depend, & trcr_base, & @@ -1715,13 +1721,13 @@ subroutine work_to_state (nx_block, ny_block, & if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - end subroutine work_to_state + end subroutine work_to_state_deprecated !======================================================================= ! ! upwind transport algorithm - - subroutine upwind_field (nx_block, ny_block, & +!deprecate upwind + subroutine upwind_field_deprecated (nx_block, ny_block, & ilo, ihi, jlo, jhi, & dt, & narrays, phi, & @@ -1764,26 +1770,26 @@ subroutine upwind_field (nx_block, ny_block, & do n = 1, narrays - do j = 1, jhi - do i = 1, ihi - worka(i,j)= & - upwind(phi(i,j,n),phi(i+1,j,n),uee(i,j),HTE(i,j),dt) - workb(i,j)= & - upwind(phi(i,j,n),phi(i,j+1,n),vnn(i,j),HTN(i,j),dt) - enddo - enddo - - do j = jlo, jhi - do i = ilo, ihi - phi(i,j,n) = phi(i,j,n) - ( worka(i,j)-worka(i-1,j) & - + workb(i,j)-workb(i,j-1) ) & - / tarea(i,j) - enddo - enddo +!deprecate upwind do j = 1, jhi +!deprecate upwind do i = 1, ihi +!deprecate upwind worka(i,j)= & +!deprecate upwind upwind(phi(i,j,n),phi(i+1,j,n),uee(i,j),HTE(i,j),dt) +!deprecate upwind workb(i,j)= & +!deprecate upwind upwind(phi(i,j,n),phi(i,j+1,n),vnn(i,j),HTN(i,j),dt) +!deprecate upwind enddo +!deprecate upwind enddo + +!deprecate upwind do j = jlo, jhi +!deprecate upwind do i = ilo, ihi +!deprecate upwind phi(i,j,n) = phi(i,j,n) - ( worka(i,j)-worka(i-1,j) & +!deprecate upwind + workb(i,j)-workb(i,j-1) ) & +!deprecate upwind / tarea(i,j) +!deprecate upwind enddo +!deprecate upwind enddo enddo ! narrays - end subroutine upwind_field + end subroutine upwind_field_deprecated !======================================================================= @@ -1791,13 +1797,13 @@ end subroutine upwind_field ! Define upwind function !------------------------------------------------------------------- - real(kind=dbl_kind) function upwind(y1,y2,a,h,dt) +!deprecate upwind real(kind=dbl_kind) function upwind(y1,y2,a,h,dt) - real(kind=dbl_kind), intent(in) :: y1,y2,a,h,dt +!deprecate upwind real(kind=dbl_kind), intent(in) :: y1,y2,a,h,dt - upwind = p5*dt*h*((a+abs(a))*y1+(a-abs(a))*y2) +!deprecate upwind upwind = p5*dt*h*((a+abs(a))*y1+(a-abs(a))*y2) - end function upwind +!deprecate upwind end function upwind !======================================================================= diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index d3b096eb3..f2eaae17d 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -795,7 +795,11 @@ subroutine input_data abort_list = trim(abort_list)//":1" endif - if (advection /= 'remap' .and. advection /= 'upwind' .and. advection /= 'none') then +!deprecate upwind if (advection /= 'remap' .and. advection /= 'upwind' .and. advection /= 'none') then + if (advection /= 'remap' .and. advection /= 'none') then + if (trim(advection) == 'upwind') then + if (my_task == master_task) write(nu_diag,*) subname//' ERROR: upwind advection has been deprecated' + endif if (my_task == master_task) write(nu_diag,*) subname//' ERROR: invalid advection=',trim(advection) abort_list = trim(abort_list)//":3" endif @@ -1178,8 +1182,10 @@ subroutine input_data tmpstr2 = ' transport enabled' if (trim(advection) == 'remap') then tmpstr2 = ': linear remapping advection' - elseif (trim(advection) == 'upwind') then - tmpstr2 = ': donor cell (upwind) advection' +!deprecate upwind elseif (trim(advection) == 'upwind') then +!deprecate upwind tmpstr2 = ': donor cell (upwind) advection' + elseif (trim(advection) == 'none') then + tmpstr2 = ': advection off' endif write(nu_diag,*) 'advection = ', trim(advection),trim(tmpstr2) else diff --git a/cicecore/cicedynB/general/ice_step_mod.F90 b/cicecore/cicedynB/general/ice_step_mod.F90 index 7a2493d58..77d0ad492 100644 --- a/cicecore/cicedynB/general/ice_step_mod.F90 +++ b/cicecore/cicedynB/general/ice_step_mod.F90 @@ -852,7 +852,8 @@ subroutine step_dyn_horiz (dt) use ice_dyn_eap, only: eap use ice_dyn_shared, only: kdyn, ktransport use ice_flux, only: init_history_dyn - use ice_transport_driver, only: advection, transport_upwind, transport_remap +!deprecate upwind use ice_transport_driver, only: advection, transport_upwind, transport_remap + use ice_transport_driver, only: advection, transport_remap real (kind=dbl_kind), intent(in) :: & dt ! dynamics time step @@ -872,12 +873,13 @@ subroutine step_dyn_horiz (dt) ! Horizontal ice transport !----------------------------------------------------------------- - if (ktransport > 0) then - if (advection == 'upwind') then - call transport_upwind (dt) ! upwind - else +!deprecate upwind if (ktransport > 0) then + if (ktransport > 0 .and. advection == 'remap') then +!deprecate upwind if (advection == 'upwind') then +!deprecate upwind call transport_upwind (dt) ! upwind +!deprecate upwind else call transport_remap (dt) ! incremental remapping - endif +!deprecate upwind endif endif end subroutine step_dyn_horiz diff --git a/configuration/scripts/options/set_nml.alt04 b/configuration/scripts/options/set_nml.alt04 index 937704294..e3689fe82 100644 --- a/configuration/scripts/options/set_nml.alt04 +++ b/configuration/scripts/options/set_nml.alt04 @@ -22,7 +22,7 @@ kevp_kernel = 102 fbot_xfer_type = 'Cdn_ocn' shortwave = 'dEdd' formdrag = .true. -advection = 'upwind' +advection = 'remap' kstrength = 0 krdg_partic = 0 krdg_redist = 0 diff --git a/doc/source/developer_guide/dg_dynamics.rst b/doc/source/developer_guide/dg_dynamics.rst index 0a48513dc..3551763b5 100644 --- a/doc/source/developer_guide/dg_dynamics.rst +++ b/doc/source/developer_guide/dg_dynamics.rst @@ -50,8 +50,9 @@ abort if set. To override the abort, use value 102 for testing. Transport ----------------- -The transport (advection) methods are found in **cicecore/cicedynB/dynamics/**. Two methods are supported, -upwind and remap. These are set in namelist via the advection variable. +The transport (advection) methods are found in **cicecore/cicedynB/dynamics/**. Only the incremental +remapping method is supported at this time, and is set in namelist via the ``advection`` variable. +Transport can be turned off by setting ``advection = none`` or ``ktransport = -1``. Infrastructure diff --git a/doc/source/science_guide/sg_horiztrans.rst b/doc/source/science_guide/sg_horiztrans.rst index bafb4c72f..33b37564e 100644 --- a/doc/source/science_guide/sg_horiztrans.rst +++ b/doc/source/science_guide/sg_horiztrans.rst @@ -33,7 +33,7 @@ introductory comments in **ice\_transport\_remap.F90**. Prognostic equations for ice and/or snow density may be included in future model versions but have not yet been implemented. -Two transport schemes are available: upwind and the incremental +One transport scheme is available, the incremental remapping scheme of :cite:`Dukowicz00` as modified for sea ice by :cite:`Lipscomb04`. The remapping scheme has several desirable features: diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 550162515..411f7604f 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -358,7 +358,7 @@ dynamics_nml "", "", "", "" "``advection``", "``remap``", "linear remapping advection scheme", "``remap``" - "", "``upwind``", "donor cell advection", "" + "", "``none``", "advection off", "" "``alphab``", "real", ":math:`\alpha_{b}` factor in :cite:`Lemieux16`", "20.0" "``arlx``", "real", "revised_evp value", "300.0" "``brlx``", "real", "revised_evp value", "300.0"