diff --git a/columnphysics/icepack_fsd.F90 b/columnphysics/icepack_fsd.F90 index 37878e935..63929ba93 100644 --- a/columnphysics/icepack_fsd.F90 +++ b/columnphysics/icepack_fsd.F90 @@ -71,24 +71,25 @@ module icepack_fsd contains !======================================================================= -! -! Initialize ice fsd bounds (call whether or not restarting) -! Define the bounds, midpoints and widths of floe size -! categories in area and radius -! ! Note that radius widths cannot be larger than twice previous ! category width or floe welding will not have an effect ! ! Note also that the bound of the lowest floe size category is used ! to define the lead region width and the domain spacing for wave fracture ! -! authors: Lettie Roach, NIWA/VUW and C. M. Bitz, UW +!autodocument_start icepack_init_fsd_bounds +! Initialize ice fsd bounds (call whether or not restarting) +! Define the bounds, midpoints and widths of floe size +! categories in area and radius ! +! authors: Lettie Roach, NIWA/VUW and C. M. Bitz, UW + subroutine icepack_init_fsd_bounds(nfsd, & floe_rad_l, & ! fsd size lower bound in m (radius) floe_rad_c, & ! fsd size bin centre in m (radius) floe_binwidth, & ! fsd size bin width in m (radius) - c_fsd_range) ! string for history output + c_fsd_range, & ! string for history output + write_diags ) ! flag for writing diagnostics integer (kind=int_kind), intent(in) :: & nfsd ! number of floe size categories @@ -99,7 +100,12 @@ subroutine icepack_init_fsd_bounds(nfsd, & floe_binwidth ! fsd size bin width in m (radius) character (len=35), intent(out) :: & - c_fsd_range(nfsd) ! string for history output + c_fsd_range(nfsd) ! string for history output + + logical (kind=log_kind), intent(in), optional :: & + write_diags ! write diags flag + +!autodocument_end ! local variables @@ -117,9 +123,17 @@ subroutine icepack_init_fsd_bounds(nfsd, & real (kind=dbl_kind), dimension(:), allocatable :: & lims + logical (kind=log_kind) :: & + l_write_diags ! local write diags + character(len=8) :: c_fsd1,c_fsd2 character(len=2) :: c_nf - character(len=*), parameter :: subname='(init_fsd_bounds)' + character(len=*), parameter :: subname='(icepack_init_fsd_bounds)' + + l_write_diags = .true. + if (present(write_diags)) then + l_write_diags = write_diags + endif if (nfsd.eq.24) then @@ -212,8 +226,14 @@ subroutine icepack_init_fsd_bounds(nfsd, & floe_rad(0) = floe_rad_l(1) do n = 1, nfsd floe_rad(n) = floe_rad_h(n) + ! Save character string to write to history file + write (c_nf, '(i2)') n + write (c_fsd1, '(f6.3)') floe_rad(n-1) + write (c_fsd2, '(f6.3)') floe_rad(n) + c_fsd_range(n)=c_fsd1//'m < fsd Cat '//c_nf//' < '//c_fsd2//'m' enddo + if (l_write_diags) then write(warnstr,*) ' ' call icepack_warnings_add(warnstr) write(warnstr,*) subname @@ -223,26 +243,14 @@ subroutine icepack_init_fsd_bounds(nfsd, & do n = 1, nfsd write(warnstr,*) floe_rad(n-1),' < fsd Cat ',n, ' < ',floe_rad(n) call icepack_warnings_add(warnstr) - ! Write integer n to character string - write (c_nf, '(i2)') n - - ! Write floe_rad to character string - write (c_fsd1, '(f6.3)') floe_rad(n-1) - write (c_fsd2, '(f6.3)') floe_rad(n) - - ! Save character string to write to history file - c_fsd_range(n)=c_fsd1//'m < fsd Cat '//c_nf//' < '//c_fsd2//'m' enddo - write(warnstr,*) ' ' call icepack_warnings_add(warnstr) + endif end subroutine icepack_init_fsd_bounds !======================================================================= -! -! Initialize the FSD -! ! When growing from no-ice conditions, initialize to zero. ! This allows the FSD to emerge, as described in Roach, Horvat et al. (2018) ! @@ -254,6 +262,10 @@ end subroutine icepack_init_fsd_bounds ! sea ice floe size distribution. Journal of Geophysical Research: Oceans, ! 119(12), 8767–8777. doi:10.1002/2014JC010136 ! +!autodocument_start icepack_init_fsd +! +! Initialize the FSD +! ! authors: Lettie Roach, NIWA/VUW subroutine icepack_init_fsd(nfsd, ice_ic, & @@ -274,6 +286,8 @@ subroutine icepack_init_fsd(nfsd, ice_ic, & real (kind=dbl_kind), dimension (:), intent(inout) :: & afsd ! floe size tracer: fraction distribution of floes +!autodocument_end + ! local variables real (kind=dbl_kind) :: alpha, totfrac @@ -305,6 +319,7 @@ subroutine icepack_init_fsd(nfsd, ice_ic, & end subroutine icepack_init_fsd !======================================================================= +!autodocument_start icepack_cleanup_fsd ! ! Clean up small values and renormalize ! @@ -319,6 +334,7 @@ subroutine icepack_cleanup_fsd (ncat, nfsd, afsdn) real (kind=dbl_kind), dimension(:,:), intent(inout) :: & afsdn ! floe size distribution tracer +!autodocument_end ! local variables integer (kind=int_kind) :: & diff --git a/columnphysics/icepack_wavefracspec.F90 b/columnphysics/icepack_wavefracspec.F90 index 086053201..eb6f4b6a3 100644 --- a/columnphysics/icepack_wavefracspec.F90 +++ b/columnphysics/icepack_wavefracspec.F90 @@ -64,7 +64,7 @@ module icepack_wavefracspec contains !======================================================================= -! +!autodocument_start icepack_init_wave ! Initialize the wave spectrum and frequencies for the FSD ! ! authors: 2018 Lettie Roach, NIWA/VUW @@ -82,6 +82,7 @@ subroutine icepack_init_wave(nfreq, & wavefreq, & ! wave frequencies (s^-1) dwavefreq ! wave frequency bin widths (s^-1) +!autodocument_end ! local variables integer (kind=int_kind) :: k @@ -174,6 +175,7 @@ function get_dafsd_wave(nfsd, afsd_init, fracture_hist, frac) & end function get_dafsd_wave !======================================================================= +!autodocument_start icepack_step_wavefracture ! ! Given fracture histogram computed from local wave spectrum, evolve ! the floe size distribution @@ -226,6 +228,7 @@ subroutine icepack_step_wavefracture(wave_spec_type, & real (kind=dbl_kind), dimension(nfsd,ncat) :: & d_afsdn_wave ! change in fsd due to waves, per category +!autodocument_end ! local variables integer (kind=int_kind) :: & n, k, t, & @@ -319,9 +322,8 @@ subroutine icepack_step_wavefracture(wave_spec_type, & write(warnstr,*) subname, & 'warning: step_wavefracture struggling to converge' call icepack_warnings_add(warnstr) - endif + endif - ! required timestep subdt = get_subdt_fsd(nfsd, afsd_tmp, d_afsd_tmp) subdt = MIN(subdt, dt) @@ -444,9 +446,6 @@ subroutine wave_frac(nfsd, nfreq, wave_spec_type, & real (kind=dbl_kind), dimension(nx) :: & fraclengths - real (kind=dbl_kind), dimension(max_no_iter*nx) :: & - allfraclengths - real (kind=dbl_kind), dimension(nx) :: & X, & ! spatial domain (m) eta ! sea surface height field (m) @@ -480,19 +479,22 @@ subroutine wave_frac(nfsd, nfreq, wave_spec_type, & ! initialize frac lengths fraclengths(:) = c0 prev_frac_local(:) = c0 + frachistogram(:) = c0 fracerror = bignum ! loop while fracerror greater than error tolerance - DO iter = 1, loop_max_iter + iter = 0 + do while (iter < loop_max_iter .and. fracerror > errortol) + iter = iter + 1 ! Phase for each Fourier component may be constant or ! a random phase that varies in each i loop ! See documentation for discussion if (trim(wave_spec_type).eq.'random') then - call RANDOM_NUMBER(rand_array) - if (icepack_warnings_aborted(subname)) return + call RANDOM_NUMBER(rand_array) + if (icepack_warnings_aborted(subname)) return else - rand_array(:) = p5 + rand_array(:) = p5 endif phi = c2*pi*rand_array @@ -510,29 +512,26 @@ subroutine wave_frac(nfsd, nfreq, wave_spec_type, & ! convert from diameter to radii fraclengths(:) = fraclengths(:)/c2 - if (ALL(fraclengths.lt.floe_rad_l(1))) then - frac_local(:) = c0 + frac_local(:) = c0 else - frachistogram(:) = c0 - allfraclengths((iter-1)*nx+1:(iter)*nx) = fraclengths(1:nx) - ! bin into FS cats + ! accumulate the frac histogram each iteration do j = 1, size(fraclengths) - if (allfraclengths(j).gt.floe_rad_l(1)) then - do k = 1, nfsd-1 - if ((allfraclengths(j) >= floe_rad_l(k)) .and. & - (allfraclengths(j) < floe_rad_l(k+1))) then - frachistogram(k) = frachistogram(k) + 1 + if (fraclengths(j).gt.floe_rad_l(1)) then + do k = 1, nfsd-1 + if ((fraclengths(j) >= floe_rad_l(k)) .and. & + (fraclengths(j) < floe_rad_l(k+1))) then + frachistogram(k) = frachistogram(k) + 1 + end if + end do + if (fraclengths(j)>floe_rad_l(nfsd)) frachistogram(nfsd) = frachistogram(nfsd) + 1 end if end do - if (allfraclengths(j)>floe_rad_l(nfsd)) frachistogram(nfsd) = frachistogram(nfsd) + 1 - end if - end do do k = 1, nfsd - frac_local(k) = floe_rad_c(k)*frachistogram(k) + frac_local(k) = floe_rad_c(k)*frachistogram(k) end do ! normalize @@ -546,22 +545,18 @@ subroutine wave_frac(nfsd, nfreq, wave_spec_type, & ! check avg frac local against previous iteration fracerror = SUM(ABS(frac_local - prev_frac_local))/nfsd - if (fracerror.lt.errortol) EXIT - - if (iter.gt.100) then - write(warnstr,*) subname, & - 'warning: wave_frac struggling to converge' - call icepack_warnings_add(warnstr) - endif - ! save histogram for next iteration prev_frac_local = frac_local - end if END DO + if (iter >= max_no_iter) then + write(warnstr,*) subname,'warning: wave_frac struggling to converge' + call icepack_warnings_add(warnstr) + endif + end subroutine wave_frac !=========================================================================== @@ -577,7 +572,7 @@ end subroutine wave_frac ! subroutine get_fraclengths(X, eta, fraclengths, hbar) - real (kind=dbl_kind) :: & + real (kind=dbl_kind), intent(in) :: & hbar ! mean thickness (m) real (kind=dbl_kind), intent(in), dimension (nx) :: & @@ -686,7 +681,6 @@ subroutine get_fraclengths(X, eta, fraclengths, hbar) delta_pos = X(j_pos) - X(j ) delta = X(j ) - X(j_neg) - ! This equation differs from HT2015 by a factor 2 in numerator ! and eta(j_pos). This is the correct form of the equation. diff --git a/configuration/driver/icedrv_InitMod.F90 b/configuration/driver/icedrv_InitMod.F90 index 70d9c50b6..4660a54f7 100644 --- a/configuration/driver/icedrv_InitMod.F90 +++ b/configuration/driver/icedrv_InitMod.F90 @@ -93,18 +93,19 @@ subroutine icedrv_initialize call icedrv_system_abort(file=__FILE__,line=__LINE__) endif - if (tr_fsd) call icepack_init_fsd_bounds( & - nfsd=nfsd, & ! floe size distribution - floe_rad_l=floe_rad_l, & ! fsd size lower bound in m (radius) - floe_rad_c=floe_rad_c, & ! fsd size bin centre in m (radius) - floe_binwidth=floe_binwidth, & ! fsd size bin width in m (radius) - c_fsd_range=c_fsd_range) ! string for history output - call init_fsd - - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted(subname)) then - call icedrv_system_abort(file=__FILE__,line=__LINE__) + if (tr_fsd) then + call icepack_init_fsd_bounds( & + nfsd=nfsd, & ! floe size distribution + floe_rad_l=floe_rad_l, & ! fsd size lower bound in m (radius) + floe_rad_c=floe_rad_c, & ! fsd size bin centre in m (radius) + floe_binwidth=floe_binwidth, & ! fsd size bin width in m (radius) + c_fsd_range=c_fsd_range) ! string for history output + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted(subname)) then + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif endif + call init_fsd call calendar(time) ! determine the initial date diff --git a/doc/generate_interfaces.sh b/doc/generate_interfaces.sh index f74ca40d6..9152bdd51 100755 --- a/doc/generate_interfaces.sh +++ b/doc/generate_interfaces.sh @@ -44,6 +44,7 @@ mv ${rstfile} ${rstfile}.orig for file in ${inpfiles}; do filename=`basename $file` +firstfileintfc=0 while IFS= read -r line; do if [[ $line =~ .*$endline.* ]]; then @@ -68,11 +69,17 @@ filename=`basename $file` exit -9 fi echo "$filename $title" + if [ $firstfileintfc = 0 ]; then + firstfileintfc=1 + echo "" >> $rstfile + echo "${filename}" >> $rstfile + echo "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" >> $rstfile + fi echo "" >> $rstfile echo ".. _${title}:" >> $rstfile echo "" >> $rstfile echo "${title}" >> $rstfile - echo "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" >> $rstfile + echo "^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^" >> $rstfile echo ".. code-block:: fortran" >> $rstfile echo "" >> $rstfile fi diff --git a/doc/source/developer_guide/dg_col_phys.rst b/doc/source/developer_guide/dg_col_phys.rst index fcdc9d2b1..375f55b75 100755 --- a/doc/source/developer_guide/dg_col_phys.rst +++ b/doc/source/developer_guide/dg_col_phys.rst @@ -74,6 +74,113 @@ write interfaces that provides access to internal column physics settings. The should not have to use "use" statements to access any of the column physics data outside of what is provided through the icepack_intfc module. The public column physics interfaces use optional arguments where it makes sense and -there is an ongoing effort to make more of the interfaces support keyword=value arguments -for clarity and backwards compatibility. +there is an ongoing effort to extend the optional arguments supported. It's strongly recommended +that calls to the icepack interfaces be done with keyword=value arguments. All icepack arguments +support this method. + +Overall, columnphysics changes in the Icepack model should include the following + + * All modules should have the following set at the top + + .. code-block:: fortran + + implicit none + private + + * Any public module interfaces or data should be explicitly specified + + * All subroutines and functions should define the subname character parameter statement to match the interface name like + + .. code-block:: fortran + + character(len=*),parameter :: subname='(lateral_melt_bgc)' + + * All interfaces that are public outside the Icepack columnphysics should include autodocument_start and autodocument_end comment lines with appropriate syntax and location. If any interfaces are added or updated, then the internal documentation should be updated via + + .. code-block:: bash + + ./icepack.setup --docintfc + + See also :ref:`docintfc` for more information about the docintfc option. + + * The icepack_warnings package should be used to cache log messages and set the abort flag. To add a log message, use icepack_warnings_add like + + .. code-block:: fortran + + call icepack_warnings_add(subname//' algorithm did not converge') + + To formally set the abort flag, use + + .. code-block:: fortran + + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + + See also :ref:`aborts` for more information about how the external calling program will write those message and check whether Icepack aborted. + + * Every interface call within the columnphysics should be followed by + + .. code-block:: fortran + + if (icepack_warnings_aborted(subname)) return + + to support errors backing up the call tree to the external program + + * Variables defined in icepack_kinds, icepack_tracers, icepack_parameters, and icepack_orbital should be accessed within Icepack by Fortran use statements. It's also possible to access some of those variables thru methods that query for the value, but this tends to be a little more cumbersome, so Fortran use statements are recommended within columnphysics. From the icepack driver or other external programs, the columnphysics variables should ALWAYS be access thru the interface methods and icepack_intfc (see also :ref:`calling`). + + * Optional arguments are encouraged in the public Icepack interfaces but should generally be avoided in interfaces within the columnphysics. There are several reasons for taking this approach. There is a desire to support backwards compatible Icepack public interfaces as much as possible, so optional arguments will be used for some future extensions. There is also a desire to allow users to pass only the data thru the Icepack interfaces that is needed. To support optional tracers and features, optional arguments are needed. Within the internal columnphysics calling tree, optional arguments are discouraged because they tend to add complexity to deep calling trees and often lead to implementations with many calls to the same interface that only vary by which arguments are passed. In the long term, that approach is not sustainable. As a result, a scheme has been developed to support optional arguments in the public interfaces while minimizing optional arguments within the columphysics. Within the columnphysics, we suggest optional arguments available thru the public interfaces should generally be treated as follows + + * Check whether optional arguments are passed and create temporary data to store the values + + * The temporary data should be locally name l_${argument_name} + + * The temporary data should be allocated at runtime if it's not a scalar based on the size of the incoming argument + + * The optional argument values should be copied into the temporary data + + * The temporary data should be passed thru other columnphysics subroutines + + * The temporary data should be deallocated at the end of the method if it was allocated + + * The temporary data should be copied back to the argument if the argument intent is out or inout + + * If optional arguments are not passed, temporary data should be created of size 1 with values of c0, and they should be passed thru other columnphysics subroutines + + * A logical can be instantiated and passed down the columnphysics interface to manage any logic related to whether valid or fake data is being passed down the calling tree. See **closing_flag** and **iso_flag** within the columnphysics as examples. There may also be externally set logicals that can be used to control how the optional features are handles. See **tr_iso** within the columnphysics as an example. + + * An example of how this might look is + + .. code-block:: fortran + + subroutine icepack_example_interface(arg1, arg2, ...) + real (kind=dbl_kind), intent(inout) :: arg1 + real (kind=dbl_kind), optional, dimension(:), intent(inout) :: arg2 + ! + real (kind=dbl_kind), allocatable, dimension(:) :: l_arg2 + logical :: arg2_flag + + character(len=*), parameter :: subname = '(icepack_example_interface)' + + if (present(arg2)) then + arg2_flag = .true. + allocate(l_arg2(size(arg2))) + l_arg2 = arg2 + else + arg2_flag = .false. + allocate(l_arg2(1)) + l_arg2 = c0 + endif + + ... + + call some_columnphysics_subroutine(arg1, l_arg2, arg2_flag, ...) + + ... + + if (present(arg2)) then + arg2 = l_arg2 + endif + deallocate(l_arg2) + + return + end subroutine diff --git a/doc/source/user_guide/interfaces.include b/doc/source/user_guide/interfaces.include index 1fb2412f9..149fdb63b 100644 --- a/doc/source/user_guide/interfaces.include +++ b/doc/source/user_guide/interfaces.include @@ -1,8 +1,11 @@ +icepack_atmo.F90 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + .. _icepack_atm_boundary: icepack_atm_boundary -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! @@ -60,10 +63,13 @@ icepack_atm_boundary +icepack_brine.F90 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + .. _icepack_init_hbrine: icepack_init_hbrine -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! Initialize brine height tracer @@ -94,7 +100,7 @@ icepack_init_hbrine .. _icepack_init_zsalinity: icepack_init_zsalinity -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! Initialize zSalinity @@ -122,10 +128,104 @@ icepack_init_zsalinity -.. _icepack_intfc.F90: +icepack_fsd.F90 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +.. _icepack_init_fsd_bounds: + +icepack_init_fsd_bounds +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +.. code-block:: fortran + + ! Initialize ice fsd bounds (call whether or not restarting) + ! Define the bounds, midpoints and widths of floe size + ! categories in area and radius + ! + ! authors: Lettie Roach, NIWA/VUW and C. M. Bitz, UW + + subroutine icepack_init_fsd_bounds(nfsd, & + floe_rad_l, & ! fsd size lower bound in m (radius) + floe_rad_c, & ! fsd size bin centre in m (radius) + floe_binwidth, & ! fsd size bin width in m (radius) + c_fsd_range, & ! string for history output + write_diags ) ! flag for writing diagnostics + + integer (kind=int_kind), intent(in) :: & + nfsd ! number of floe size categories + + real(kind=dbl_kind), dimension(:), intent(inout) :: & + floe_rad_l, & ! fsd size lower bound in m (radius) + floe_rad_c, & ! fsd size bin centre in m (radius) + floe_binwidth ! fsd size bin width in m (radius) + + character (len=35), intent(out) :: & + c_fsd_range(nfsd) ! string for history output + + logical (kind=log_kind), intent(in), optional :: & + write_diags ! write diags flag + + + +.. _icepack_init_fsd: + +icepack_init_fsd +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +.. code-block:: fortran + + ! + ! Initialize the FSD + ! + ! authors: Lettie Roach, NIWA/VUW + + subroutine icepack_init_fsd(nfsd, ice_ic, & + floe_rad_c, & ! fsd size bin centre in m (radius) + floe_binwidth, & ! fsd size bin width in m (radius) + afsd) ! floe size distribution tracer + + integer(kind=int_kind), intent(in) :: & + nfsd + + character(len=char_len_long), intent(in) :: & + ice_ic ! method of ice cover initialization + + real(kind=dbl_kind), dimension(:), intent(inout) :: & + floe_rad_c, & ! fsd size bin centre in m (radius) + floe_binwidth ! fsd size bin width in m (radius) + + real (kind=dbl_kind), dimension (:), intent(inout) :: & + afsd ! floe size tracer: fraction distribution of floes + + + +.. _icepack_cleanup_fsd: + +icepack_cleanup_fsd +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +.. code-block:: fortran + + ! + ! Clean up small values and renormalize + ! + ! authors: Elizabeth Hunke, LANL + ! + subroutine icepack_cleanup_fsd (ncat, nfsd, afsdn) + + integer (kind=int_kind), intent(in) :: & + ncat , & ! number of thickness categories + nfsd ! number of floe size categories + + real (kind=dbl_kind), dimension(:,:), intent(inout) :: & + afsdn ! floe size distribution tracer + + icepack_intfc.F90 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +.. _icepack_intfc.F90: + +icepack_intfc.F90 +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! public parameters and interface routines for the icepack columnpackage code @@ -226,10 +326,13 @@ icepack_intfc.F90 +icepack_itd.F90 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + .. _icepack_init_itd: icepack_init_itd -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! Initialize area fraction and thickness boundaries for the itd model @@ -250,7 +353,7 @@ icepack_init_itd .. _icepack_init_itd_hist: icepack_init_itd_hist -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! Initialize area fraction and thickness boundaries for the itd model @@ -274,7 +377,7 @@ icepack_init_itd_hist .. _icepack_aggregate: icepack_aggregate -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! Aggregate ice state variables over thickness categories. @@ -328,10 +431,13 @@ icepack_aggregate +icepack_mechred.F90 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + .. _icepack_ice_strength: icepack_ice_strength -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! Compute the strength of the ice pack, defined as the energy (J m-2) @@ -374,7 +480,7 @@ icepack_ice_strength .. _icepack_step_ridge: icepack_step_ridge -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! Computes sea ice mechanical deformation @@ -481,10 +587,13 @@ icepack_step_ridge +icepack_ocean.F90 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + .. _icepack_ocn_mixed_layer: icepack_ocn_mixed_layer -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! Compute the mixed layer heat balance and update the SST. @@ -538,10 +647,13 @@ icepack_ocn_mixed_layer +icepack_orbital.F90 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + .. _icepack_init_orbit: icepack_init_orbit -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! Compute orbital parameters for the specified date. @@ -568,7 +680,7 @@ icepack_init_orbit .. _icepack_query_orbit: icepack_query_orbit -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! Compute orbital parameters for the specified date. @@ -592,10 +704,13 @@ icepack_query_orbit +icepack_parameters.F90 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + .. _icepack_init_parameters: icepack_init_parameters -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! subroutine to set the column package internal parameters @@ -923,7 +1038,7 @@ icepack_init_parameters .. _icepack_query_parameters: icepack_query_parameters -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! subroutine to query the column package internal parameters @@ -1265,7 +1380,7 @@ icepack_query_parameters .. _icepack_write_parameters: icepack_write_parameters -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! subroutine to write the column package internal parameters @@ -1280,7 +1395,7 @@ icepack_write_parameters .. _icepack_recompute_constants: icepack_recompute_constants -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! subroutine to reinitialize some derived constants @@ -1289,10 +1404,13 @@ icepack_recompute_constants +icepack_shortwave.F90 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + .. _icepack_prep_radiation: icepack_prep_radiation -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! Scales radiation fields computed on the previous time step. @@ -1348,7 +1466,7 @@ icepack_prep_radiation .. _icepack_step_radiation: icepack_step_radiation -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! Computes radiation fields @@ -1496,10 +1614,13 @@ icepack_step_radiation +icepack_therm_itd.F90 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + .. _icepack_step_therm2: icepack_step_therm2 -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! Driver for thermodynamic changes not needed for coupling: @@ -1642,10 +1763,13 @@ icepack_step_therm2 +icepack_therm_shared.F90 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + .. _icepack_init_thermo: icepack_init_thermo -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! Initialize the vertical profile of ice salinity and melting temperature. @@ -1666,7 +1790,7 @@ icepack_init_thermo .. _icepack_init_trcr: icepack_init_trcr -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! @@ -1700,7 +1824,7 @@ icepack_init_trcr .. _icepack_liquidus_temperature: icepack_liquidus_temperature -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! compute liquidus temperature @@ -1715,7 +1839,7 @@ icepack_liquidus_temperature .. _icepack_sea_freezing_temperature: icepack_sea_freezing_temperature -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! compute ocean freezing temperature @@ -1730,7 +1854,7 @@ icepack_sea_freezing_temperature .. _icepack_ice_temperature: icepack_ice_temperature -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! compute ice temperature @@ -1745,7 +1869,7 @@ icepack_ice_temperature .. _icepack_snow_temperature: icepack_snow_temperature -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! compute snow temperature @@ -1760,7 +1884,7 @@ icepack_snow_temperature .. _icepack_enthalpy_snow: icepack_enthalpy_snow -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! compute snow enthalpy @@ -1772,10 +1896,13 @@ icepack_enthalpy_snow +icepack_therm_vertical.F90 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + .. _icepack_step_therm1: icepack_step_therm1 -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! Driver for thermodynamic changes not needed for coupling: @@ -1995,10 +2122,13 @@ icepack_step_therm1 +icepack_tracers.F90 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + .. _icepack_init_tracer_flags: icepack_init_tracer_flags -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! set tracer active flags @@ -2040,7 +2170,7 @@ icepack_init_tracer_flags .. _icepack_query_tracer_flags: icepack_query_tracer_flags -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! query tracer active flags @@ -2082,7 +2212,7 @@ icepack_query_tracer_flags .. _icepack_write_tracer_flags: icepack_write_tracer_flags -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! write tracer active flags @@ -2096,7 +2226,7 @@ icepack_write_tracer_flags .. _icepack_init_tracer_indices: icepack_init_tracer_indices -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! set the number of column tracer indices @@ -2192,7 +2322,7 @@ icepack_init_tracer_indices .. _icepack_query_tracer_indices: icepack_query_tracer_indices -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! query the number of column tracer indices @@ -2288,7 +2418,7 @@ icepack_query_tracer_indices .. _icepack_write_tracer_indices: icepack_write_tracer_indices -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! write the number of column tracer indices @@ -2302,7 +2432,7 @@ icepack_write_tracer_indices .. _icepack_init_tracer_sizes: icepack_init_tracer_sizes -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! set the number of column tracers @@ -2337,7 +2467,7 @@ icepack_init_tracer_sizes .. _icepack_query_tracer_sizes: icepack_query_tracer_sizes -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! query the number of column tracers @@ -2386,7 +2516,7 @@ icepack_query_tracer_sizes .. _icepack_write_tracer_sizes: icepack_write_tracer_sizes -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! write the number of column tracers @@ -2400,7 +2530,7 @@ icepack_write_tracer_sizes .. _icepack_compute_tracers: icepack_compute_tracers -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! Compute tracer fields. @@ -2439,10 +2569,13 @@ icepack_compute_tracers +icepack_warnings.F90 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + .. _icepack_warnings_aborted: icepack_warnings_aborted -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! turn on the abort flag in the icepack warnings package @@ -2457,7 +2590,7 @@ icepack_warnings_aborted .. _icepack_warnings_clear: icepack_warnings_clear -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! clear all warning messages from the icepack warning buffer @@ -2469,7 +2602,7 @@ icepack_warnings_clear .. _icepack_warnings_print: icepack_warnings_print -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! print all warning messages from the icepack warning buffer @@ -2483,7 +2616,7 @@ icepack_warnings_print .. _icepack_warnings_flush: icepack_warnings_flush -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! print and clear all warning messages from the icepack warning buffer @@ -2494,10 +2627,101 @@ icepack_warnings_flush +icepack_wavefracspec.F90 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +.. _icepack_init_wave: + +icepack_init_wave +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +.. code-block:: fortran + + ! Initialize the wave spectrum and frequencies for the FSD + ! + ! authors: 2018 Lettie Roach, NIWA/VUW + + subroutine icepack_init_wave(nfreq, & + wave_spectrum_profile, & + wavefreq, dwavefreq) + + integer(kind=int_kind), intent(in) :: & + nfreq ! number of wave frequencies + + real(kind=dbl_kind), dimension(:), intent(out) :: & + wave_spectrum_profile, & ! ocean surface wave spectrum as a function of frequency + ! power spectral density of surface elevation, E(f) (units m^2 s) + wavefreq, & ! wave frequencies (s^-1) + dwavefreq ! wave frequency bin widths (s^-1) + + + +.. _icepack_step_wavefracture: + +icepack_step_wavefracture +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +.. code-block:: fortran + + ! + ! Given fracture histogram computed from local wave spectrum, evolve + ! the floe size distribution + ! + ! authors: 2018 Lettie Roach, NIWA/VUW + ! + subroutine icepack_step_wavefracture(wave_spec_type, & + dt, ncat, nfsd, & + nfreq, & + aice, vice, aicen, & + floe_rad_l, floe_rad_c, & + wave_spectrum, wavefreq, dwavefreq, & + trcrn, d_afsd_wave) + + + character (len=char_len), intent(in) :: & + wave_spec_type ! type of wave spectrum forcing + + integer (kind=int_kind), intent(in) :: & + nfreq, & ! number of wave frequency categories + ncat, & ! number of thickness categories + nfsd ! number of floe size categories + + real (kind=dbl_kind), intent(in) :: & + dt, & ! time step + aice, & ! ice area fraction + vice ! ice volume per unit area + + real (kind=dbl_kind), dimension(ncat), intent(in) :: & + aicen ! ice area fraction (categories) + + real(kind=dbl_kind), dimension(:), intent(in) :: & + floe_rad_l, & ! fsd size lower bound in m (radius) + floe_rad_c ! fsd size bin centre in m (radius) + + real (kind=dbl_kind), dimension (:), intent(in) :: & + wavefreq, & ! wave frequencies (s^-1) + dwavefreq ! wave frequency bin widths (s^-1) + + real (kind=dbl_kind), dimension(:), intent(in) :: & + wave_spectrum ! ocean surface wave spectrum as a function of frequency + ! power spectral density of surface elevation, E(f) (units m^2 s) + + real (kind=dbl_kind), dimension(:,:), intent(inout) :: & + trcrn ! tracer array + + real (kind=dbl_kind), dimension(:), intent(out) :: & + d_afsd_wave ! change in fsd due to waves + + real (kind=dbl_kind), dimension(nfsd,ncat) :: & + d_afsdn_wave ! change in fsd due to waves, per category + + + +icepack_zbgc.F90 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + .. _icepack_init_bgc: icepack_init_bgc -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! @@ -2537,7 +2761,7 @@ icepack_init_bgc .. _icepack_init_zbgc: icepack_init_zbgc -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! @@ -2618,7 +2842,7 @@ icepack_init_zbgc .. _icepack_biogeochemistry: icepack_biogeochemistry -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! @@ -2732,7 +2956,7 @@ icepack_biogeochemistry .. _icepack_load_ocean_bio_array: icepack_load_ocean_bio_array -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! basic initialization for ocean_bio_all @@ -2785,7 +3009,7 @@ icepack_load_ocean_bio_array .. _icepack_init_ocean_bio: icepack_init_ocean_bio -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran ! Initialize ocean concentration diff --git a/doc/source/user_guide/lg_interfaces.rst b/doc/source/user_guide/lg_interfaces.rst index 2ec2bd858..4836711b7 100755 --- a/doc/source/user_guide/lg_interfaces.rst +++ b/doc/source/user_guide/lg_interfaces.rst @@ -7,19 +7,21 @@ Public Interfaces Below are a list of public icepack interfaces. -These interfaces are extracted directly from the icepack source code using the script -``doc/generate_interfaces.sh``. That script updates rst files in the -doc directory tree which are then incorporated into the sphinx documentation. +The documentation for these interfaces is extracted directly from the icepack source code using the script +``doc/generate_interfaces.sh``. That script updates the rst file ``interfaces.include`` in +the ``doc/source/user_guide directory``. That file is part of the internal documentation. There is information about how ``generate_interfaces.sh`` parses -the source code in a comment section in that script. In addition, -executing ``icepack.setup --docintfc`` will also run the generate_interfaces -script as noted in :ref:`case_options`. +the source code in a comment section in that script. Executing ``icepack.setup --docintfc`` will +run the generate_interfaces script as noted in :ref:`case_options`. Once ``generate_interfaces`` is executed, the user -still has to add and commit the changes to the documentation manually. A typical workflow +still has to git add, commit, and push the changes to the documentation manually. A typical workflow would be:: + # verify all public interfaces in the columnphysics have appropriate autodocument comment line + # there should be a "!autodocument_start ${interface_name}" at the begining of the interface + # there should be a "!autodocument_end" at the end of the declaration of the interface arguments ./icepack.setup --docintfc - git add doc/source/user_guide/interfaces.rst + git add doc/source/user_guide/interfaces.include git commit -m "update public interface documentation" .. include:: interfaces.include diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 90b895aa0..e45c23928 100755 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -229,6 +229,7 @@ column physics. "``l_mpond_fresh``", "true", "retain (topo) pond water until ponds drain", "" "", "false", "release (topo) pond water immediately to ocean", "" "``oceanmixed_ice``", "true/false", "active ocean mixed layer calculation", "``.true.`` (if uncoupled)" + "``wave_spec_file``", "filename", "file containing wave spectrum data for interaction with fsd","" "``wave_spec_type``", "``none``", "no ocean wave spectrum data - no wave-ice interactions (not recommended with tr_fsd=.true.","" "", "``constant``", "ocean wave spectrum data present*, sea surface height field generated using constant phase, fracture code not run to convergence, for testing FSD", "" "", "``random``", "ocean wave spectrum data present*, sea surface height field generated using random phase, fracture code is run to convergence", ""