diff --git a/src/SIS_dyn_bgrid.F90 b/src/SIS_dyn_bgrid.F90 index 72575822..28a56828 100644 --- a/src/SIS_dyn_bgrid.F90 +++ b/src/SIS_dyn_bgrid.F90 @@ -70,9 +70,9 @@ module SIS_dyn_bgrid ! for each slow time step. real :: dt_Rheo ! The maximum sub-cycling time step for the rheology ! and momentum equations. - type(time_type), pointer :: Time ! A pointer to the ice model's clock. - type(SIS_diag_ctrl), pointer :: diag ! A structure that is used to regulate the - ! timing of diagnostic output. + type(time_type), pointer :: Time !< A pointer to the ice model's clock. + type(SIS_diag_ctrl), pointer :: diag !< A structure that is used to regulate the + !! timing of diagnostic output. integer :: id_fix = -1, id_fiy = -1, id_fcx = -1, id_fcy = -1 integer :: id_fwx = -1, id_fwy = -1, id_sigi = -1, id_sigii = -1 integer :: id_stren = -1, id_ui = -1, id_vi = -1 @@ -81,21 +81,14 @@ module SIS_dyn_bgrid contains !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! SIS_B_dyn_init - initialize the ice dynamics and set parameters. ! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> SIS_B_dyn_init initializes the ice dynamics and sets parameters. subroutine SIS_B_dyn_init(Time, G, param_file, diag, CS) - type(time_type), target, intent(in) :: Time - type(SIS_hor_grid_type), intent(in) :: G - type(param_file_type), intent(in) :: param_file - type(SIS_diag_ctrl), target, intent(inout) :: diag - type(SIS_B_dyn_CS), pointer :: CS -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module. + type(time_type), target, intent(in) :: Time !< The sea-ice model's clock, + !! set with the current model time. + type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(SIS_diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic output + type(SIS_B_dyn_CS), pointer :: CS !< The control structure for this module ! This subroutine sets the parameters and registers the diagnostics associated ! with the ice dynamics. @@ -216,18 +209,20 @@ end subroutine SIS_B_dyn_init !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! find_ice_strength - magnitude of force on ice in plastic deformation ! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> find_ice_strength determines the magnitude of force on ice in plastic deformation subroutine find_ice_strength(mi, ci, ice_strength, G, CS) !, nCat) - type(SIS_hor_grid_type), intent(in) :: G - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mi, ci - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: ice_strength - type(SIS_B_dyn_CS), pointer :: CS - ! integer, intent(in) :: nCat + type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mi !< Mass per unit ocean area of sea ice (kg m-2) + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ci !< Sea ice concentration (nondim) + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: ice_strength !< The ice strength in N m-1 + type(SIS_B_dyn_CS), pointer :: CS !< The control structure for this module + ! integer, intent(in) :: nCat !< The number of sea ice categories. + + ! Local variables + logical :: prs_rothrock = .false. !Niki: TOM has a new option for calculating ice strength. If you want to use it set ! prs_rothrock=.true. In that case we need to review and fix the new code ! inside if (prs_rothrock), particularly work on getting hi3,ci3,hi3v,Cp & Cf. - logical :: prs_rothrock = .false. logical :: rdg_lipscomb = .true. !Niki: What are ci3,hi3,Cp, Cf? ! real, dimension(SZI_(G),SZJ_(G),nCat) :: hi3,ci3 @@ -283,38 +278,32 @@ subroutine find_ice_strength(mi, ci, ice_strength, G, CS) !, nCat) end subroutine find_ice_strength !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! SIS_B_dynamics - take a single dynamics timestep with EVP subcycles ! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> SIS_B_dynamics takes a single dynamics timestep with EVP subcycles subroutine SIS_B_dynamics(ci, msnow, mice, ui, vi, uo, vo, & fxat, fyat, sea_lev, fxoc, fyoc, do_ridging, rdg_rate, dt_slow, G, CS) - type(SIS_hor_grid_type), intent(inout) :: G - real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: ci, msnow, mice ! ice properties - real, dimension(SZIB_(G),SZJB_(G)), intent(inout) :: ui, vi ! ice velocity - real, dimension(SZIB_(G),SZJB_(G)), intent(in ) :: uo, vo ! ocean velocity - real, dimension(SZIB_(G),SZJB_(G)), intent(in ) :: fxat, fyat ! air stress on ice - real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: sea_lev ! sea level - real, dimension(SZIB_(G),SZJB_(G)), intent( out) :: fxoc, fyoc ! ice stress on ocean - logical, intent(in ) :: do_ridging - real, dimension(SZIB_(G),SZJB_(G)), intent( out) :: rdg_rate ! ridging rate from drift state - real, intent(in ) :: dt_slow - type(SIS_B_dyn_CS), pointer :: CS -! Arguments: ci - The sea ice concentration, nondim. -! (in) msnow - The mass per unit total area (ice covered and ice free) -! of the snow, in kg m-2. -! (in) mice - The mass per unit total area (ice covered and ice free) -! of the ice, in kg m-2. -! (inout) ui - The zonal ice velocity, in m s-1. -! (inout) vi - The meridional ice velocity, in m s-1. -! (in) uo - The zonal ocean velocity, in m s-1. -! (in) vo - The meridional ocean velocity, in m s-1. -! (in) sea_lev - The height of the sea level, including contributions -! from non-levitating ice from an earlier time step, in m. -! (in) dt_slow - The amount of time over which the ice dynamics are to be -! advanced, in s. -! (in) G - The ocean's grid structure. -! (in/out) CS - A pointer to the control structure for this module. - + type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: ci !< Sea ice concentration (nondim) + real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: msnow !< Mass per unit ocean area of snow (kg m-2) + real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: mice !< Mass per unit ocean area of sea ice (kg m-2) + real, dimension(SZIB_(G),SZJB_(G)), intent(inout) :: ui !< Zonal ice velocity in m s-1 + real, dimension(SZIB_(G),SZJB_(G)), intent(inout) :: vi !< Meridional ice velocity in m s-1 + real, dimension(SZIB_(G),SZJB_(G)), intent(in ) :: uo !< Zonal ocean velocity in m s-1 + real, dimension(SZIB_(G),SZJB_(G)), intent(in ) :: vo !< Meridional ocean velocity in m s-1 + real, dimension(SZIB_(G),SZJB_(G)), intent(in ) :: fxat !< Zonal air stress on ice in Pa + real, dimension(SZIB_(G),SZJB_(G)), intent(in ) :: fyat !< Meridional air stress on ice in Pa + real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: sea_lev !< The height of the sea level, including + !! contributions from non-levitating ice from + !! an earlier time step, in m. + real, dimension(SZIB_(G),SZJB_(G)), intent( out) :: fxoc !< Zonal ice stress on ocean in Pa + real, dimension(SZIB_(G),SZJB_(G)), intent( out) :: fyoc !< Meridional ice stress on ocean in Pa + logical, intent(in ) :: do_ridging !< If true, the ice can ridge + real, dimension(SZIB_(G),SZJB_(G)), intent( out) :: rdg_rate !< ridging rate from drift state in UNITS? + real, intent(in ) :: dt_slow !< The amount of time over which the ice + !! dynamics are to be advanced, in s. + type(SIS_B_dyn_CS), pointer :: CS !< The control structure for this module + + ! Local variables real, dimension(SZIB_(G),SZJB_(G)) :: fxic, fyic ! ice int. stress real, dimension(SZIB_(G),SZJB_(G)) :: fxco, fyco ! coriolis force @@ -695,13 +684,16 @@ subroutine SIS_B_dynamics(ci, msnow, mice, ui, vi, uo, vo, & end subroutine SIS_B_dynamics !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! sigI - first stress invariant ! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> sigI evaluates the first stress invariant function sigI(mi, ci, sig11, sig22, sig12, G, CS) - type(SIS_hor_grid_type), intent(in) :: G - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mi, ci, sig11, sig22, sig12 - real, dimension(SZI_(G),SZJ_(G)) :: sigI - type(SIS_B_dyn_CS), pointer :: CS + type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mi !< Mass per unit ocean area of sea ice (kg m-2) + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ci !< Sea ice concentration (nondim) + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: sig11 !< The xx component of the stress tensor, in N m-1 + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: sig22 !< The yy component of the stress tensor, in N m-1 + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: sig12 !< The xy & yx component of the stress tensor, in N m-1 + real, dimension(SZI_(G),SZJ_(G)) :: sigI !< The first stress invariant, nondim + type(SIS_B_dyn_CS), pointer :: CS !< The control structure for this module integer :: i, j, isc, iec, jsc, jec isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec @@ -715,13 +707,16 @@ function sigI(mi, ci, sig11, sig22, sig12, G, CS) end function sigI !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! sigII - second stress invariant ! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> sigII evaluates the second stress invariant function sigII(mi, ci, sig11, sig22, sig12, G, CS) - type(SIS_hor_grid_type), intent(in) :: G - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mi, ci, sig11, sig22, sig12 - real, dimension(SZI_(G),SZJ_(G)) :: sigII - type(SIS_B_dyn_CS), pointer :: CS + type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mi !< Mass per unit ocean area of sea ice (kg m-2) + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ci !< Sea ice concentration (nondim) + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: sig11 !< The xx component of the stress tensor, in N m-1 + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: sig22 !< The yy component of the stress tensor, in N m-1 + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: sig12 !< The xy & yx component of the stress tensor, in N m-1 + real, dimension(SZI_(G),SZJ_(G)) :: sigII !< The second stress invariant, nondim + type(SIS_B_dyn_CS), pointer :: CS !< The control structure for this module integer :: i, j, isc, iec, jsc, jec isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec @@ -735,23 +730,16 @@ function sigII(mi, ci, sig11, sig22, sig12, G, CS) end function sigII !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! SIS_B_dyn_register_restarts - allocate and register any variables for this ! -! module that need to be included in the restart files. ! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> SIS_B_dyn_register_restarts allocates and registers any variables for this +!! module that need to be included in the restart files. subroutine SIS_B_dyn_register_restarts(mpp_domain, HI, param_file, CS, Ice_restart, restart_file) - type(domain2d), intent(in) :: mpp_domain - type(hor_index_type), intent(in) :: HI - type(param_file_type), intent(in) :: param_file - type(SIS_B_dyn_CS), pointer :: CS - type(restart_file_type), pointer :: Ice_restart - character(len=*), intent(in) :: restart_file - -! Arguments: G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module. -! + type(domain2d), intent(in) :: mpp_domain !< The ice models' FMS domain type + type(hor_index_type), intent(in) :: HI !< The horizontal index type describing the domain + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(SIS_B_dyn_CS), pointer :: CS !< The control structure for this module that + !! will be allocated here + type(restart_file_type), pointer :: Ice_restart !< The sea ice restart control structure + character(len=*), intent(in) :: restart_file !< The ice restart file name ! This subroutine registers the restart variables associated with the ! the ice dynamics. @@ -780,10 +768,10 @@ subroutine SIS_B_dyn_register_restarts(mpp_domain, HI, param_file, CS, Ice_resta end subroutine SIS_B_dyn_register_restarts !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! SIS_B_dyn_end - deallocate the memory associated with this module. ! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> SIS_B_dyn_end - deallocates the memory associated with this module. subroutine SIS_B_dyn_end(CS) - type(SIS_B_dyn_CS), pointer :: CS + type(SIS_B_dyn_CS), pointer :: CS !< The control structure for this module + !! that will be deallocated here. deallocate(CS%sig11) ; deallocate(CS%sig12) ; deallocate(CS%sig22) @@ -791,20 +779,25 @@ subroutine SIS_B_dyn_end(CS) end subroutine SIS_B_dyn_end !TOM>~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! ice_stress_old - deriving ice stress as in SIS of CM2.1 ! -! (after Hunke and Dukowicz, 1997) ! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> ice_stress_old derives the ice stress as in SIS of CM2.1 (after Hunke and Dukowicz, 1997) subroutine ice_stress_old(isc,iec,jsc,jec,prs,strn11,strn22,strn12,edt,EC, & sig11,sig22,sig12,del2,ice_present) - ! - integer, intent(in) :: isc,iec,jsc,jec - real, intent(in ), dimension(isc:iec,jsc:jec) :: prs ! ice pressure - real, intent(in ), dimension(isc:iec,jsc:jec) :: strn11, strn12, strn22 ! strain tensor - real, intent(in ), dimension(isc:iec,jsc:jec) :: edt - real, intent(in ) :: EC - real, intent(inout), dimension(isc:iec,jsc:jec) :: sig11, sig22, sig12 ! stress tensor - real, intent( out), dimension(isc:iec,jsc:jec) :: del2 - logical, intent(in ), dimension(isc:iec,jsc:jec) :: ice_present + integer, intent(in ) :: isc !< The starting i-index to work on + integer, intent(in ) :: iec !< The ending i-index to work on + integer, intent(in ) :: jsc !< The starting i-index to work on + integer, intent(in ) :: jec !< The ending j-index to work on + real, dimension(isc:iec,jsc:jec), intent(in ) :: prs !< The internal ice pressure in Pa m. + real, dimension(isc:iec,jsc:jec), intent(in ) :: strn11 !< The xx component of the strain rate, in s-1 + real, dimension(isc:iec,jsc:jec), intent(in ) :: strn22 !< The yy component of the strain rate, in s-1 + real, dimension(isc:iec,jsc:jec), intent(in ) :: strn12 !< The xy & yx component of the strain rate, in s-1 + real, dimension(isc:iec,jsc:jec), intent(in ) :: edt !< The ice elasticity times a time-step, in Pa m s. + real, intent(in ) :: EC !< The yeild curve axis ratio + real, dimension(isc:iec,jsc:jec), intent(inout) :: sig11 !< The xx component of the stress tensor, in N m-1 + real, dimension(isc:iec,jsc:jec), intent(inout) :: sig22 !< The yy component of the stress tensor, in N m-1 + real, dimension(isc:iec,jsc:jec), intent(inout) :: sig12 !< The xy & yx component of the stress tensor, in N m-1 + real, dimension(isc:iec,jsc:jec), intent( out) :: del2 !< An elipticity modulated estimate of + !! the squared strain rate, in s-2. + logical, dimension(isc:iec,jsc:jec), intent(in) :: ice_present !< True where there is any ice present in a cell ! integer :: i, j real, dimension(isc:iec,jsc:jec) :: mp4z, t0, t1, t2 @@ -859,18 +852,25 @@ subroutine ice_stress_old(isc,iec,jsc,jec,prs,strn11,strn22,strn12,edt,EC, & end subroutine ice_stress_old !TOM>~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! ice_stress_new - deriving ice stress as in CICE 4.0 ! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> ice_stress_new derives the ice stress as in CICE 4.0 subroutine ice_stress_new(isc,iec,jsc,jec,prs,strn11,strn22,strn12,edt, EC, & sig11,sig22,sig12,del2,ice_present) - integer, intent(in) :: isc,iec,jsc,jec - ! - real, intent(in ), dimension(isc:iec,jsc:jec) :: prs ! ice pressure - real, intent(in ), dimension(isc:iec,jsc:jec) :: strn11, strn12, strn22 ! strain tensor - real, intent(in ) :: edt, EC - real, intent(inout), dimension(isc:iec,jsc:jec) :: sig11, sig22, sig12 ! stress tensor - real, intent( out), dimension(isc:iec,jsc:jec) :: del2 - logical, intent(in ), dimension(isc:iec,jsc:jec) :: ice_present + integer, intent(in ) :: isc !< The starting i-index to work on + integer, intent(in ) :: iec !< The ending i-index to work on + integer, intent(in ) :: jsc !< The starting i-index to work on + integer, intent(in ) :: jec !< The ending j-index to work on + real, dimension(isc:iec,jsc:jec), intent(in ) :: prs !< The internal ice pressure in Pa m. + real, dimension(isc:iec,jsc:jec), intent(in ) :: strn11 !< The xx component of the strain rate + real, dimension(isc:iec,jsc:jec), intent(in ) :: strn22 !< The yy component of the strain rate + real, dimension(isc:iec,jsc:jec), intent(in ) :: strn12 !< The xy & yx component of the strain rate + real, intent(in ) :: edt !< The ice elasticity times a time-step, in Pa m s. + real, intent(in ) :: EC !< The yeild curve axis ratio + real, dimension(isc:iec,jsc:jec), intent(inout) :: sig11 !< The xx component of the stress tensor + real, dimension(isc:iec,jsc:jec), intent(inout) :: sig22 !< The yy component of the stress tensor + real, dimension(isc:iec,jsc:jec), intent(inout) :: sig12 !< The xy & yx component of the stress tensor + real, dimension(isc:iec,jsc:jec), intent( out) :: del2 !< An elipticity modulated estimate of + !! the squared strain rate, in s-2. + logical, dimension(isc:iec,jsc:jec), intent(in) :: ice_present !< True where there is any ice present in a cell ! integer :: i, j real :: zeta, eta ! bulk/shear viscosities diff --git a/src/SIS_dyn_cgrid.F90 b/src/SIS_dyn_cgrid.F90 index a25efaec..077e4d23 100644 --- a/src/SIS_dyn_cgrid.F90 +++ b/src/SIS_dyn_cgrid.F90 @@ -62,7 +62,7 @@ module SIS_dyn_cgrid str_s ! The shearing stress tensor component (cross term), in Pa m. ! parameters for calculating water drag and internal ice stresses - logical :: SLAB_ICE = .false. ! should we do old style GFDL slab ice? + logical :: SLAB_ICE = .false. ! Indicate whether to do old style GFDL slab ice real :: p0 = 2.75e4 ! pressure constant (Pa) real :: p0_rho ! The pressure constant divided by ice density, N m kg-1. real :: c0 = 20.0 ! another pressure constant @@ -105,9 +105,9 @@ module SIS_dyn_cgrid integer :: evp_sub_steps ! The number of iterations in the EVP dynamics ! for each slow time step. real :: dt_Rheo ! The maximum sub-cycling time step for the EVP dynamics. - type(time_type), pointer :: Time ! A pointer to the ice model's clock. - type(SIS_diag_ctrl), pointer :: diag ! A structure that is used to regulate the - ! timing of diagnostic output. + type(time_type), pointer :: Time !< A pointer to the ice model's clock. + type(SIS_diag_ctrl), pointer :: diag !< A structure that is used to regulate the + !! timing of diagnostic output. integer, pointer :: ntrunc ! The number of times the velocity has been truncated ! since the last call to write_ice_statistics. character(len = 200) :: u_trunc_file ! The complete path to files in which a @@ -143,15 +143,17 @@ module SIS_dyn_cgrid contains !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! SIS_C_dyn_init - initialize the ice dynamics and set parameters. ! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> SIS_C_dyn_init initializes the ice dynamics, sets parameters, and registers diagnostics subroutine SIS_C_dyn_init(Time, G, param_file, diag, CS, ntrunc) - type(time_type), target, intent(in) :: Time - type(SIS_hor_grid_type), intent(in) :: G - type(param_file_type), intent(in) :: param_file - type(SIS_diag_ctrl), target, intent(inout) :: diag - type(SIS_C_dyn_CS), pointer :: CS - integer, target, optional, intent(inout) :: ntrunc + type(time_type), target, intent(in) :: Time !< The sea-ice model's clock, + !! set with the current model time. + type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(SIS_diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic output + type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module + integer, target, optional, intent(inout) :: ntrunc !< The integer that stores the number of times + !! the velocity has been truncated since the + !! last call to write_ice_statistics. ! Arguments: Time - The current model time. ! (in) G - The ocean's grid structure. ! (in) param_file - A structure indicating the open file to parse for @@ -451,14 +453,14 @@ end subroutine SIS_C_dyn_init !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! find_ice_strength - magnitude of force on ice in plastic deformation ! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> find_ice_strength returns the magnitude of force on ice in plastic deformation subroutine find_ice_strength(mi, ci, ice_strength, G, CS, halo_sz) ! ??? may change to do loop - type(SIS_hor_grid_type), intent(in) :: G - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mi, ci - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: ice_strength - type(SIS_C_dyn_CS), pointer :: CS - integer, optional, intent(in) :: halo_sz + type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mi !< Mass per unit ocean area of sea ice (kg m-2) + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ci !< Sea ice concentration (nondim) + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: ice_strength !< The ice strength in N m-1. + type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module + integer, optional, intent(in) :: halo_sz !< The halo size to work on integer :: i, j, isc, iec, jsc, jec, halo halo = 0 ; if (present(halo_sz)) halo = halo_sz isc = G%isc-halo ; iec = G%iec+halo ; jsc = G%jsc-halo ; jec = G%jec+halo @@ -470,24 +472,28 @@ subroutine find_ice_strength(mi, ci, ice_strength, G, CS, halo_sz) ! ??? may cha end subroutine find_ice_strength !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! SIS_C_dynamics - take a single dynamics timestep with EVP subcycles ! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> SIS_C_dynamics takes a single dynamics timestep with EVP subcycles subroutine SIS_C_dynamics(ci, msnow, mice, ui, vi, uo, vo, & fxat, fyat, sea_lev, fxoc, fyoc, dt_slow, G, CS) - type(SIS_hor_grid_type), intent(inout) :: G - real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: ci, msnow, mice ! ice properties - real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ui ! ice velocity - real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vi ! ice velocity - real, dimension(SZIB_(G),SZJ_(G)), intent(in ) :: uo ! ocean velocity - real, dimension(SZI_(G),SZJB_(G)), intent(in ) :: vo ! ocean velocity - real, dimension(SZIB_(G),SZJ_(G)), intent(in ) :: fxat ! air stress on ice - real, dimension(SZI_(G),SZJB_(G)), intent(in ) :: fyat ! air stress on ice - real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: sea_lev ! sea level - real, dimension(SZIB_(G),SZJ_(G)), intent( out) :: fxoc ! ice stress on ocean - real, dimension(SZI_(G),SZJB_(G)), intent( out) :: fyoc ! ice stress on ocean - real, intent(in ) :: dt_slow - type(SIS_C_dyn_CS), pointer :: CS + type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: ci !< Sea ice concentration (nondim) + real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: msnow !< Mass per unit ocean area of snow (kg m-2) + real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: mice !< Mass per unit ocean area of sea ice (kg m-2) + real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ui !< Zonal ice velocity in m s-1 + real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vi !< Meridional ice velocity in m s-1 + real, dimension(SZIB_(G),SZJ_(G)), intent(in ) :: uo !< Zonal ocean velocity in m s-1 + real, dimension(SZI_(G),SZJB_(G)), intent(in ) :: vo !< Meridional ocean velocity in m s-1 + real, dimension(SZIB_(G),SZJ_(G)), intent(in ) :: fxat !< Zonal air stress on ice in Pa + real, dimension(SZI_(G),SZJB_(G)), intent(in ) :: fyat !< Meridional air stress on ice in Pa + real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: sea_lev !< The height of the sea level, including + !! contributions from non-levitating ice from + !! an earlier time step, in m. + real, dimension(SZIB_(G),SZJ_(G)), intent( out) :: fxoc !< Zonal ice stress on ocean in Pa + real, dimension(SZI_(G),SZJB_(G)), intent( out) :: fyoc !< Meridional ice stress on ocean in Pa + real, intent(in ) :: dt_slow !< The amount of time over which the ice + !! dynamics are to be advanced, in s. + type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module ! Arguments: ci - The sea ice concentration, nondim. ! (in) msnow - The mass per unit total area (ice covered and ice free) ! of the snow, in kg m-2. @@ -1405,13 +1411,20 @@ subroutine SIS_C_dynamics(ci, msnow, mice, ui, vi, uo, vo, & end subroutine SIS_C_dynamics +!> This subroutine ensures that the input stresses are not larger than could be justified by the ice +!! pressure now, as the ice might have melted or been advected away during the thermodynamic and +!! transport phases, or the ice flow convergence or divergence may have altered the ice concentration. subroutine limit_stresses(pres_mice, mice, str_d, str_t, str_s, G, CS, limit) - type(SIS_hor_grid_type), intent(in) :: G - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: pres_mice, mice - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: str_d, str_t - real, dimension(SZIB_(G),SZJB_(G)), intent(inout) :: str_s - type(SIS_C_dyn_CS), pointer :: CS - real, optional, intent(in) :: limit + type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: pres_mice !< The ice internal pressure per + !! unit column mass, in N m / kg. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mice !< The mass per unit total area (ice + !! covered and ice free) of the ice, in kg m-2. + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: str_d !< The divergence stress tensor component, in Pa m. + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: str_t !< The tension stress tensor component, in Pa m. + real, dimension(SZIB_(G),SZJB_(G)), intent(inout) :: str_s !< The shearing stress tensor component, in Pa m. + type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module + real, optional, intent(in) :: limit !< A factor by which the strength limits are changed. ! Arguments: pres_mice - The ice internal pressure per unit column mass, in N m / kg. ! (in) mice - The mass per unit total area (ice covered and ice free) ! of the ice, in kg m-2. @@ -1531,13 +1544,15 @@ end subroutine limit_stresses !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> find_sigI finds the first stress invariant subroutine find_sigI(mi, ci, str_d, sigI, G, CS) - type(SIS_hor_grid_type), intent(in) :: G - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mi, ci, str_d - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: sigI - type(SIS_C_dyn_CS), pointer :: CS + type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mi !< Mass per unit ocean area of sea ice (kg m-2) + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ci !< Sea ice concentration (nondim) + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: str_d !< The divergence stress tensor component, in Pa m. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: sigI !< The first stress invariant, nondim + type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G)) :: & - strength ! The ice strength, in Pa. + strength ! The ice strength, in Pa m. integer :: i, j, isc, iec, jsc, jec isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec @@ -1553,17 +1568,19 @@ end subroutine find_sigI !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> find_sigII finds the second stress invariant subroutine find_sigII(mi, ci, str_t, str_s, sigII, G, CS) - type(SIS_hor_grid_type), intent(in) :: G - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mi, ci, str_t - real, dimension(SZIB_(G),SZJB_(G)), intent(in) :: str_s - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: sigII - type(SIS_C_dyn_CS), pointer :: CS + type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mi !< Mass per unit ocean area of sea ice (kg m-2) + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ci !< Sea ice concentration (nondim) + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: str_t !< The tension stress tensor component, in Pa m + real, dimension(SZIB_(G),SZJB_(G)), intent(in) :: str_s !< The shearing stress tensor component, in Pa m. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: sigII !< The second stress invariant, nondim. + type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G)) :: & - strength ! The ice strength, in Pa. + strength ! The ice strength, in Pa m. real, dimension(SZIB_(G),SZJB_(G)) :: & str_s_ss ! Str_s divided by the sum of the neighboring ice strengths. - real :: strength_sum ! The sum of the 4 neighboring strengths, in Pa. + real :: strength_sum ! The sum of the 4 neighboring strengths, in Pa m. real :: sum_area ! The sum of ocean areas around a vorticity point, in m2. integer :: i, j, isc, iec, jsc, jec isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec @@ -1600,12 +1617,12 @@ end subroutine find_sigII !! SIS C-grid dynamics module that need to be included in the restart files. subroutine SIS_C_dyn_register_restarts(mpp_domain, HI, param_file, CS, & Ice_restart, restart_file) - type(domain2d), intent(in) :: mpp_domain - type(hor_index_type), intent(in) :: HI - type(param_file_type), intent(in) :: param_file - type(SIS_C_dyn_CS), pointer :: CS - type(restart_file_type), pointer :: Ice_restart - character(len=*), intent(in) :: restart_file + type(domain2d), intent(in) :: mpp_domain !< The ice models' FMS domain type + type(hor_index_type), intent(in) :: HI !< The horizontal index type describing the domain + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module + type(restart_file_type), pointer :: Ice_restart !< The sea ice restart control structure + character(len=*), intent(in) :: restart_file !< The ice restart file name ! Arguments: G - The ocean's grid structure. ! (in) param_file - A structure indicating the open file to parse for @@ -1651,11 +1668,11 @@ end subroutine SIS_C_dyn_register_restarts !! specifically dealing with changing between symmetric and non-symmetric !! memory restart files. subroutine SIS_C_dyn_read_alt_restarts(CS, G, Ice_restart, restart_file, restart_dir) - type(SIS_C_dyn_CS), pointer :: CS - type(SIS_hor_grid_type), intent(in) :: G - type(restart_file_type), pointer :: Ice_restart - character(len=*), intent(in) :: restart_file - character(len=*), intent(in) :: restart_dir + type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module + type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + type(restart_file_type), pointer :: Ice_restart !< The sea ice restart control structure + character(len=*), intent(in) :: restart_file !< The ice restart file name + character(len=*), intent(in) :: restart_dir !< The directory in which to find the restart files ! These are temporary variables that will be used only here for reading and ! then discarded. @@ -1712,13 +1729,20 @@ end subroutine SIS_C_dyn_read_alt_restarts !! truncations and related fields. subroutine write_u_trunc(I, j, ui, u_IC, uo, mis, fxoc, fxic, Cor_u, PFu, fxat, & dt_slow, G, CS) - integer, intent(in) :: I, j - type(SIS_hor_grid_type), intent(in) :: G - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: ui, u_IC, uo - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mis - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: fxoc, fxic, Cor_u, PFu, fxat - real, intent(in) :: dt_slow - type(SIS_C_dyn_CS), pointer :: CS + integer, intent(in) :: I !< The i-index of the column to report on + integer, intent(in) :: j !< The j-index of the column to report on + type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: ui !< The zonal ice velicity in m s-1. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: u_IC !< The initial zonal ice velicity in m s-1. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: uo !< The zonal ocean velicity in m s-1. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mis !< The mass of ice an snow per unit ocean area, in kg m-2 + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: fxoc !< The zonal ocean-to-ice force, in Pa. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: fxic !< The ice internal force, in Pa. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Cor_u !< The zonal Coriolis acceleration, in m s-2. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: PFu !< The zonal Pressure force accleration, in m s-2. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: fxat !< The zonal wind stress, in Pa. + real, intent(in) :: dt_slow !< The slow ice dynamics timestep, in s. + type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module real :: dt_mi, CFL real, parameter :: H_subroundoff = 1e-30 ! A negligible thickness, in m, that @@ -1775,13 +1799,20 @@ end subroutine write_u_trunc !! truncations and related fields. subroutine write_v_trunc(i, J, vi, v_IC, vo, mis, fyoc, fyic, Cor_v, PFv, fyat, & dt_slow, G, CS) - integer, intent(in) :: i, j - type(SIS_hor_grid_type), intent(in) :: G - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: vi, v_IC, vo - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mis - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: fyoc, fyic, Cor_v, PFv, fyat - real, intent(in) :: dt_slow - type(SIS_C_dyn_CS), pointer :: CS + integer, intent(in) :: i !< The i-index of the column to report on + integer, intent(in) :: J !< The j-index of the column to report on + type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: vi !< The meridional ice velicity in m s-1. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: v_IC !< The initial meridional ice velicity in m s-1. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: vo !< The meridional ocean velicity in m s-1. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mis !< The mass of ice an snow per unit ocean area, in kg m-2 + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: fyoc !< The meridional ocean-to-ice force, in Pa. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: fyic !< The ice internal force, in Pa. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Cor_v !< The meridional Coriolis acceleration, in m s-2. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: PFv !< The meridional pressure force accleration, in m s-2. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: fyat !< The meridional wind stress, in Pa. + real, intent(in) :: dt_slow !< The slow ice dynamics timestep, in s. + type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module real :: dt_mi, CFL real, parameter :: H_subroundoff = 1e-30 ! A negligible thickness, in m, that @@ -1836,7 +1867,7 @@ end subroutine write_v_trunc !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> SIS_C_dyn_end deallocates the memory associated with this module. subroutine SIS_C_dyn_end(CS) - type(SIS_C_dyn_CS), pointer :: CS + type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module deallocate(CS%str_d) ; deallocate(CS%str_t) ; deallocate(CS%str_s) diff --git a/src/SIS_dyn_trans.F90 b/src/SIS_dyn_trans.F90 index 30a31dcf..7d61c8c8 100644 --- a/src/SIS_dyn_trans.F90 +++ b/src/SIS_dyn_trans.F90 @@ -154,16 +154,22 @@ module SIS_dyn_trans contains +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> update_icebergs calls icebergs_run and offers diagnostics of some of the +!! iceberg fields that might drive the sea ice or ocean subroutine update_icebergs(IST, OSS, IOF, FIA, icebergs_CS, dt_slow, G, IG, CS) - type(ice_state_type), intent(inout) :: IST - type(ocean_sfc_state_type), intent(in) :: OSS - type(fast_ice_avg_type), intent(inout) :: FIA - type(ice_ocean_flux_type), intent(inout) :: IOF - real, intent(in) :: dt_slow - type(icebergs), pointer :: icebergs_CS - type(SIS_hor_grid_type), intent(inout) :: G - type(ice_grid_type), intent(inout) :: IG - type(dyn_trans_CS), pointer :: CS + type(ice_state_type), intent(inout) :: IST !< A type describing the state of the sea ice + type(ocean_sfc_state_type), intent(in) :: OSS !< A structure containing the arrays that describe + !! the ocean's surface state for the ice model. + type(fast_ice_avg_type), intent(inout) :: FIA !< A type containing averages of fields + !! (mostly fluxes) over the fast updates + type(ice_ocean_flux_type), intent(inout) :: IOF !< A structure containing fluxes from the ice to + !! the ocean that are calculated by the ice model. + real, intent(in) :: dt_slow !< The slow ice dynamics timestep, in s. + type(icebergs), pointer :: icebergs_CS !< A control structure for the iceberg model. + type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type + type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module real, dimension(SZI_(G),SZJ_(G)) :: & hi_avg ! The area-weighted average ice thickness, in m. @@ -240,20 +246,23 @@ subroutine update_icebergs(IST, OSS, IOF, FIA, icebergs_CS, dt_slow, G, IG, CS) end subroutine update_icebergs !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! SIS_dynamics_trans - do ice dynamics and mass and tracer transport ! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> SIS_dynamics_trans makes the calls to do ice dynamics and mass and tracer transport subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, IG, tracer_CSp) - type(ice_state_type), intent(inout) :: IST - type(ocean_sfc_state_type), intent(in) :: OSS - type(fast_ice_avg_type), intent(inout) :: FIA - type(ice_ocean_flux_type), intent(inout) :: IOF - real, intent(in) :: dt_slow - type(SIS_hor_grid_type), intent(inout) :: G - type(ice_grid_type), intent(inout) :: IG - type(dyn_trans_CS), pointer :: CS - type(icebergs), pointer :: icebergs_CS - type(SIS_tracer_flow_control_CS), pointer :: tracer_CSp + type(ice_state_type), intent(inout) :: IST !< A type describing the state of the sea ice + type(ocean_sfc_state_type), intent(in) :: OSS !< A structure containing the arrays that describe + !! the ocean's surface state for the ice model. + type(fast_ice_avg_type), intent(inout) :: FIA !< A type containing averages of fields + !! (mostly fluxes) over the fast updates + type(ice_ocean_flux_type), intent(inout) :: IOF !< A structure containing fluxes from the ice to + !! the ocean that are calculated by the ice model. + real, intent(in) :: dt_slow !< The slow ice dynamics timestep, in s. + type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type + type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module + type(icebergs), pointer :: icebergs_CS !< A control structure for the iceberg model. + type(SIS_tracer_flow_control_CS), pointer :: tracer_CSp !< The structure for controlling calls to + !! auxiliary ice tracer packages real, dimension(G%isc:G%iec,G%jsc:G%jec) :: h2o_chg_xprt, mass, mass_ice, mass_snow, tmp2d real, dimension(SZI_(G),SZJ_(G),IG%CatIce,IG%NkIce) :: & @@ -708,21 +717,30 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, I end subroutine SIS_dynamics_trans +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> Offer diagnostics of the slowly evolving sea ice state. subroutine post_ice_state_diagnostics(CS, IST, OSS, IOF, dt_slow, Time, G, IG, diag, & h2o_chg_xprt, rdg_rate) - type(ice_state_type), intent(inout) :: IST - type(ocean_sfc_state_type), intent(in) :: OSS -! type(fast_ice_avg_type), intent(inout) :: FIA - type(ice_ocean_flux_type), intent(in) :: IOF + type(ice_state_type), intent(inout) :: IST !< A type describing the state of the sea ice + type(ocean_sfc_state_type), intent(in) :: OSS !< A structure containing the arrays that describe + !! the ocean's surface state for the ice model. +! type(fast_ice_avg_type), intent (inout) :: FIA ! A type containing averages of fields + ! (mostly fluxes) over the fast updates + type(ice_ocean_flux_type), intent(in) :: IOF !< A structure containing fluxes from the ice to + !! the ocean that are calculated by the ice model. real, intent(in) :: dt_slow !< The time interval of these diagnostics type(time_type), intent(in) :: Time !< The ending time of these diagnostics - type(SIS_hor_grid_type), intent(inout) :: G - type(ice_grid_type), intent(inout) :: IG - type(dyn_trans_CS), pointer :: CS - type(SIS_diag_ctrl), pointer :: diag - real, dimension(G%isc:G%iec,G%jsc:G%jec), optional, intent(in) :: h2o_chg_xprt - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: rdg_rate - + type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type + type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module + type(SIS_diag_ctrl), pointer :: diag !< A structure that is used to regulate diagnostic output + real, dimension(G%isc:G%iec,G%jsc:G%jec), & + optional, intent(in) :: h2o_chg_xprt !< The total ice and snow mass change due to + !! transport within a dynamics timestep, in kg m-2 + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: rdg_rate !< The ice ridging rate in s-1. + + ! Local variables real, dimension(G%isc:G%iec,G%jsc:G%jec) :: mass, mass_ice, mass_snow, tmp2d real, dimension(SZI_(G),SZJ_(G),IG%CatIce,IG%NkIce) :: & temp_ice ! A diagnostic array with the ice temperature in degC. @@ -923,12 +941,15 @@ subroutine post_ice_state_diagnostics(CS, IST, OSS, IOF, dt_slow, Time, G, IG, d end subroutine post_ice_state_diagnostics +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> Offer diagnostics of the ocean surface field, as seen by the sea ice. subroutine post_ocean_sfc_diagnostics(OSS, dt_slow, Time, G, diag) - type(ocean_sfc_state_type), intent(in) :: OSS + type(ocean_sfc_state_type), intent(in) :: OSS !< A structure containing the arrays that describe + !! the ocean's surface state for the ice model. real, intent(in) :: dt_slow !< The time interval of these diagnostics type(time_type), intent(in) :: Time !< The ending time of these diagnostics - type(SIS_hor_grid_type), intent(inout) :: G - type(SIS_diag_ctrl), pointer :: diag + type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(SIS_diag_ctrl), pointer :: diag !< A structure that is used to regulate diagnostic output real :: Idt_slow ! The inverse of the thermodynamic step, in s-1. Idt_slow = 0.0 ; if (dt_slow > 0.0) Idt_slow = 1.0/dt_slow @@ -954,12 +975,12 @@ subroutine post_ocean_sfc_diagnostics(OSS, dt_slow, Time, G, diag) end subroutine post_ocean_sfc_diagnostics !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! finish_ocean_top_stresses - Finish setting the ice-ocean stresses by dividing! -! them through the stresses by the number of times they have been augmented. ! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> Finish setting the ice-ocean stresses by dividing the running sums of the +!! stresses by the number of times they have been augmented. subroutine finish_ocean_top_stresses(IOF, HI) - type(hor_index_type), intent(in) :: HI - type(ice_ocean_flux_type), intent(inout) :: IOF + type(hor_index_type), intent(in) :: HI !< The horizontal index type describing the domain + type(ice_ocean_flux_type), intent(inout) :: IOF !< A structure containing fluxes from the ice to + !! the ocean that are calculated by the ice model. real :: I_count integer :: i, j, isc, iec, jsc, jec @@ -976,19 +997,26 @@ subroutine finish_ocean_top_stresses(IOF, HI) end subroutine finish_ocean_top_stresses !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! set_ocean_top_stress_Bgrid - Calculate the stresses on the ocean integrated ! -! across all the thickness categories with the appropriate staggering, and ! -! store them in the public ice data type for use by the ocean model. This ! -! version of the routine uses wind and ice-ocean stresses on a B-grid. ! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> Calculate the stresses on the ocean integrated across all the thickness categories with +!! the appropriate staggering, and store them in the public ice data type for use by the +!! ocean model. This version of the routine uses wind and ice-ocean stresses on a B-grid. subroutine set_ocean_top_stress_Bgrid(IOF, windstr_x_water, windstr_y_water, & str_ice_oce_x, str_ice_oce_y, part_size, G, IG) - type(ice_ocean_flux_type), intent(inout) :: IOF - type(SIS_hor_grid_type), intent(inout) :: G - type(ice_grid_type), intent(inout) :: IG - real, dimension(SZIB_(G),SZJB_(G)), intent(in) :: windstr_x_water, str_ice_oce_x - real, dimension(SZIB_(G),SZJB_(G)), intent(in) :: windstr_y_water, str_ice_oce_y - real, dimension (SZI_(G),SZJ_(G),0:IG%CatIce), intent(in) :: part_size + type(ice_ocean_flux_type), intent(inout) :: IOF !< A structure containing fluxes from the ice to + !! the ocean that are calculated by the ice model. + type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type + real, dimension(SZIB_(G),SZJB_(G)), & + intent(in) :: windstr_x_water !< The x-direction wind stress over open water, in Pa. + real, dimension(SZIB_(G),SZJB_(G)), & + intent(in) :: windstr_y_water !< The y-direction wind stress over open water, in Pa. + real, dimension(SZIB_(G),SZJB_(G)), & + intent(in) :: str_ice_oce_x !< The x-direction ice to ocean stress, in Pa. + real, dimension(SZIB_(G),SZJB_(G)), & + intent(in) :: str_ice_oce_y !< The y-direction ice to ocean stress, in Pa. + real, dimension(SZI_(G),SZJ_(G),0:IG%CatIce), & + intent(in) :: part_size !< The fractional area coverage of the ice + !! thickness categories, nondim, 0-1 real :: ps_vel ! part_size interpolated to a velocity point, nondim. integer :: i, j, k, isc, iec, jsc, jec, ncat @@ -1080,19 +1108,26 @@ subroutine set_ocean_top_stress_Bgrid(IOF, windstr_x_water, windstr_y_water, & end subroutine set_ocean_top_stress_Bgrid !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! set_ocean_top_stress_Cgrid - Calculate the stresses on the ocean integrated ! -! across all the thickness categories with the appropriate staggering, and ! -! store them in the public ice data type for use by the ocean model. This ! -! version of the routine uses wind and ice-ocean stresses on a C-grid. ! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> Calculate the stresses on the ocean integrated across all the thickness categories with the +!! appropriate staggering, and store them in the public ice data type for use by the ocean +!! model. This version of the routine uses wind and ice-ocean stresses on a C-grid. subroutine set_ocean_top_stress_Cgrid(IOF, windstr_x_water, windstr_y_water, & str_ice_oce_x, str_ice_oce_y, part_size, G, IG) - type(ice_ocean_flux_type), intent(inout) :: IOF - type(SIS_hor_grid_type), intent(inout) :: G - type(ice_grid_type), intent(inout) :: IG - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: windstr_x_water, str_ice_oce_x - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: windstr_y_water, str_ice_oce_y - real, dimension (SZI_(G),SZJ_(G),0:IG%CatIce), intent(in) :: part_size + type(ice_ocean_flux_type), intent(inout) :: IOF !< A structure containing fluxes from the ice to + !! the ocean that are calculated by the ice model. + type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type + real, dimension(SZIB_(G),SZJ_(G)), & + intent(in) :: windstr_x_water !< The x-direction wind stress over open water, in Pa. + real, dimension(SZI_(G),SZJB_(G)), & + intent(in) :: windstr_y_water !< The y-direction wind stress over open water, in Pa. + real, dimension(SZIB_(G),SZJ_(G)), & + intent(in) :: str_ice_oce_x !< The x-direction ice to ocean stress, in Pa. + real, dimension(SZI_(G),SZJB_(G)), & + intent(in) :: str_ice_oce_y !< The y-direction ice to ocean stress, in Pa. + real, dimension(SZI_(G),SZJ_(G),0:IG%CatIce), & + intent(in) :: part_size !< The fractional area coverage of the ice + !! thickness categories, nondim, 0-1 real :: ps_vel ! part_size interpolated to a velocity point, nondim. integer :: i, j, k, isc, iec, jsc, jec, ncat @@ -1185,20 +1220,13 @@ end subroutine set_ocean_top_stress_Cgrid !! slow ice dynamics and transport that need to be included in the restart files. subroutine SIS_dyn_trans_register_restarts(mpp_domain, HI, IG, param_file, CS, & Ice_restart, restart_file) - type(domain2d), intent(in) :: mpp_domain - type(hor_index_type), intent(in) :: HI - type(ice_grid_type), intent(in) :: IG ! The sea-ice grid type - type(param_file_type), intent(in) :: param_file - type(dyn_trans_CS), pointer :: CS - type(restart_file_type), pointer :: Ice_restart - character(len=*), intent(in) :: restart_file - -! Arguments: G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module. -! + type(domain2d), intent(in) :: mpp_domain !< The ice models' FMS domain type + type(hor_index_type), intent(in) :: HI !< The horizontal index type describing the domain + type(ice_grid_type), intent(in) :: IG !< The sea-ice grid type + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module + type(restart_file_type), pointer :: Ice_restart !< The sea ice restart control structure + character(len=*), intent(in) :: restart_file !< The ice restart file name ! This subroutine registers the restart variables associated with the ! the slow ice dynamics and thermodynamics. @@ -1229,11 +1257,11 @@ end subroutine SIS_dyn_trans_register_restarts !! slow ice dynamics and transport that need to be included in the restart files. subroutine SIS_dyn_trans_read_alt_restarts(CS, G, Ice_restart, & restart_file, restart_dir) - type(dyn_trans_CS), pointer :: CS - type(SIS_hor_grid_type), intent(in) :: G - type(restart_file_type), pointer :: Ice_restart - character(len=*), intent(in) :: restart_file - character(len=*), intent(in) :: restart_dir + type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module + type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + type(restart_file_type), pointer :: Ice_restart !< The sea ice restart control structure + character(len=*), intent(in) :: restart_file !< The ice restart file name + character(len=*), intent(in) :: restart_dir !< The directory in which to find the restart files if (CS%Cgrid_dyn) then call SIS_C_dyn_read_alt_restarts(CS%SIS_C_dyn_CSp, G, Ice_restart, & @@ -1246,14 +1274,15 @@ end subroutine SIS_dyn_trans_read_alt_restarts !> SIS_dyn_trans_init initializes ice model data, parameters and diagnostics !! associated with the SIS2 dynamics and transport modules. subroutine SIS_dyn_trans_init(Time, G, IG, param_file, diag, CS, output_dir, Time_init) - type(time_type), target, intent(in) :: Time ! current time - type(SIS_hor_grid_type), intent(in) :: G ! The horizontal grid structure - type(ice_grid_type), intent(in) :: IG ! The sea-ice grid type - type(param_file_type), intent(in) :: param_file - type(SIS_diag_ctrl), target, intent(inout) :: diag - type(dyn_trans_CS), pointer :: CS - character(len=*), intent(in) :: output_dir - type(time_type), intent(in) :: Time_Init ! starting time of model integration + type(time_type), target, intent(in) :: Time !< The sea-ice model's clock, + !! set with the current model. + type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid structure + type(ice_grid_type), intent(in) :: IG !< The sea-ice grid type + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(SIS_diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic output + type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module + character(len=*), intent(in) :: output_dir !< The directory to use for writing output + type(time_type), intent(in) :: Time_Init !< Starting time of the model integration ! This include declares and sets the variable "version". #include "version_variable.h" @@ -1447,31 +1476,33 @@ subroutine SIS_dyn_trans_init(Time, G, IG, param_file, diag, CS, output_dir, Tim end subroutine SIS_dyn_trans_init +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> Allocate an array of integer diagnostic arrays and set them to -1, if they are not already allocated subroutine safe_alloc_ids_1d(ids, nids) - integer, allocatable :: ids(:) - integer, intent(in) :: nids + integer, allocatable, intent(inout) :: ids(:) !< An array of diagnostic IDs to allocate + integer, intent(in) :: nids !< The number of IDs to allocate if (.not.ALLOCATED(ids)) then allocate(ids(nids)) ; ids(:) = -1 - endif + endif; end subroutine safe_alloc_ids_1d !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> SIS_dyn_trans_transport_CS returns a pointer to the SIS_transport_CS type that !! the dyn_trans_CS points to. function SIS_dyn_trans_transport_CS(CS) result(transport_CSp) - type(dyn_trans_CS), pointer :: CS - type(SIS_transport_CS), pointer :: transport_CSp + type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module + type(SIS_transport_CS), pointer :: transport_CSp !< The SIS_transport_CS type used by SIS_dyn_trans transport_CSp => CS%SIS_transport_CSp end function SIS_dyn_trans_transport_CS !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> SIS_dyn_trans_transport_CS returns a pointer to the sum_out_CS type that -!! the dyn_trans_CS points to. +!! the dyn_trans_CS points to. function SIS_dyn_trans_sum_output_CS(CS) result(sum_out_CSp) - type(dyn_trans_CS), pointer :: CS - type(SIS_sum_out_CS), pointer :: sum_out_CSp + type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module + type(SIS_sum_out_CS), pointer :: sum_out_CSp !< The SIS_sum_out_CS type used by SIS_dyn_trans sum_out_CSp => CS%sum_output_CSp end function SIS_dyn_trans_sum_output_CS @@ -1480,7 +1511,8 @@ end function SIS_dyn_trans_sum_output_CS !> SIS_dyn_trans_end deallocates memory associated with the dyn_trans_CS type !! and calls similar routines for subsidiary modules. subroutine SIS_dyn_trans_end(CS) - type(dyn_trans_CS), pointer :: CS + type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module that + !! is dellocated here if (CS%Cgrid_dyn) then call SIS_C_dyn_end(CS%SIS_C_dyn_CSp)