! ! transverse_coefficients.F90 ! This file is part of ISOFT. ! ! Copyright 2018 Chris MacMackin <cmacmackin@gmail.com> ! ! This program is free software; you can redistribute it and/or modify ! it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2 of the License, or ! (at your option) any later version. ! ! This program is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! along with this program; if not, write to the Free Software ! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, ! MA 02110-1301, USA. ! module transverse_coefficients_mod !* Author: Chris MacMackin ! Date: July 2018 ! License: GPLv3 ! ! Provides functions to calculate the coefficients for the ! horizontally-integrated [asymmetric_plume] from the basal slope of ! the ice shelf. This module just provides the interface. The ! implmentation is automatically generated by the Python script ! XXXXXXXX based on various parameter choices, approximating the ! coefficients using interpolation. ! use iso_fortran_env, only: r8 => real64 use factual_mod, only: scalar_field implicit none interface module function alpha_du(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $$ \alpha_{DU} = \frac{1}{\Delta ! y}\int^{y_2}_{y_1}f_D(y)f_U(y)dy $$ for the given shelf ! slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: alpha_du end function alpha_du module function alpha_du2(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $$ \alpha_{DU^2} = \frac{1}{\Delta ! y}\int^{y_2}_{y_1}f_D(y)f_U(y)^2dy $$ for the given shelf ! slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: alpha_du2 end function alpha_du2 module function alpha_d2(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $$ \alpha_{D^2} = \frac{1}{\Delta ! y}\int^{y_2}_{y_1}f_D(y)^2dy $$ for the given shelf ! slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: alpha_d2 end function alpha_d2 module function alpha_dv(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $$ \alpha_{DV} = \frac{1}{\Delta ! y}\int^{y_2}_{y_1}f_D(y)f_V(y)dy $$ for the given shelf ! slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: alpha_dv end function alpha_dv module function alpha_duv(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $$ \alpha_{DUV} = \frac{1}{\Delta ! y}\int^{y_2}_{y_1}f_D(y)f_U(y)f_V(y)dy $$ for the given shelf ! slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: alpha_duv end function alpha_duv module function alpha_uvecu(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $$ \alpha_{|\vec{U}|U} = \frac{1}{\Delta ! y}\int^{y_2}_{y_1}f_{|\vec{U}|}(y)f_U(y)dy $$ for the given ! shelf slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: alpha_uvecu end function alpha_uvecu module function alpha_uvecv(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $$ \alpha_{|\vec{U}|V} = \frac{1}{\Delta ! y}\int^{y_2}_{y_1}f_{|\vec{U}|}(y)f_V(y)dy $$ for the given ! shelf slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: alpha_uvecv end function alpha_uvecv module function alpha_dus(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $$ \alpha_{DUS} = \frac{1}{\Delta ! y}\int^{y_2}_{y_1}f_D(y)f_U(y)f_S(y)dy $$ for the given shelf ! slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: alpha_dus end function alpha_dus module function alpha_dut(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $$ \alpha_{DUT} = \frac{1}{\Delta ! y}\int^{y_2}_{y_1}f_D(y)f_U(y)f_T(y)dy $$ for the given shelf ! slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: alpha_dut end function alpha_dut module function alpha_uvect(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $$ \alpha_{|\vec{U}|T} = \frac{1}{\Delta ! y}\int^{y_2}_{y_1}f_{|\vec{U}|}(y)f_{T}(y)dy $$ for the given shelf ! slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: alpha_uvect end function alpha_uvect module function alpha_ds(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $$ \alpha_{DS} = \frac{1}{\Delta ! y}\int^{y_2}_{y_1}f_D(y)f_S(y)dy $$ for the given shelf ! slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: alpha_ds end function alpha_ds module function alpha_dt(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $$ \alpha_{DT} = \frac{1}{\Delta ! y}\int^{y_2}_{y_1}f_D(y)f_T(y)dy $$ for the given shelf ! slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: alpha_dt end function alpha_dt module function alpha_ds_t(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $$ \tilde{\alpha}_{DS} = \frac{1}{\Delta ! y\alpha_{D^2}}\int^{y_2}_{y_1}f_D(y)^2f_S(y)dy $$ for the ! given shelf slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: alpha_ds end function alpha_ds_t module function alpha_dt_t(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $$ \tilde{\alpha}_{DT} = \frac{1}{\Delta ! y\alpha_{D^2}}\int^{y_2}_{y_1}f_D(y)^2f_T(y)dy $$ for the ! given shelf slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: alpha_dt_t end function alpha_dt_t module function f_d(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $f_D(y_2)$ for the given shelf ! slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: f_d end function f_d module function f_u(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $f_U(y_2)$ for the given shelf ! slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: f_u end function f_u module function f_v(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $f_V(y_2)$ for the given shelf ! slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: f_v end function f_v module function f_s(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $f_S(y_2)$ for the given shelf ! slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: f_s end function f_s module function f_t(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $f_T(y_2)$ for the given shelf ! slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: f_t end function f_t module function f_u_p(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $f'_U(y_2)$ for the given shelf ! slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: f_u_p end function f_u_p module function f_v_p(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $f'_V(y_2)$ for the given shelf ! slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: f_v_p end function f_v_p module function f_s_p(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $f'_S(y_2)$ for the given shelf ! slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: f_s_p end function f_s_p module function f_t_p(b_x) !* Author: Chris MacMackin ! Date: July 2018 ! ! Interpolates the value of $f'_T(y_2)$ for the given shelf ! slope. ! class(scalar_field), intent(in) :: b_x class(scalar_field), pointer :: f_t_p end function f_t_p end interface interface subroutine splev(t, n, c, k, x, y, m, e, ier) !* Author: P. Dierck ! ! Subroutine splev evaluates in a number of points x(i),i=1,2,...,m ! a spline s(x) of degree k, given in its b-spline representation. import :: r8 real(r8), dimension(*), intent(in) :: t !! Array, length n, which contains the position of the knots. integer, intent(in) :: n !! Integer, giving the total number of knots of s(x). real(r8), dimension(*), intent(in) :: c !! Array, length n, which contains the b-spline coefficients. integer, intent(in) :: k !! Integer, giving the degree of s(x). real(r8), dimension(*), intent(in) :: x !! Array, length m, which contains the points where s(x) must !! be evaluated. real(r8), dimension(*), intent(out) :: y !! Array, length m, giving the value of s(x) at the different !! points. integer, intent(in) :: m !! Integer, giving the number of points where s(x) must be !! evaluated. integer, intent(in) :: e !! integer, if 0 the spline is extrapolated from the end !! spans for points not in the support, if 1 the spline !! evaluates to zero for those points, if 2 ier is set to !! 1 and the subroutine returns, and if 3 the spline evaluates !! to the value of the nearest boundary point. integer, intent(out) :: ier !! Error flag: !! !! - ier = 0: normal return !! - ier = 1: argument out of bounds and e == 2 !! - ier =10: invalid input data (see restrictions) end subroutine splev end interface private :: splev end module transverse_coefficients_mod