MOM6
P1M_functions.F90
1 !> Linear interpolation functions
3 
4 ! This file is part of MOM6. See LICENSE.md for the license.
5 
6 use regrid_edge_values, only : bound_edge_values, average_discontinuous_edge_values
7 
8 implicit none ; private
9 
10 ! The following routines are visible to the outside world
11 public p1m_interpolation, p1m_boundary_extrapolation
12 
13 contains
14 
15 !> Linearly interpolate between edge values
16 !!
17 !! The resulting piecewise interpolant is stored in 'ppoly'.
18 !! See 'ppoly.F90' for a definition of this structure.
19 !!
20 !! The edge values MUST have been estimated prior to calling this routine.
21 !!
22 !! The estimated edge values must be limited to ensure monotonicity of the
23 !! interpolant. We also make sure that edge values are NOT discontinuous.
24 !!
25 !! It is assumed that the size of the array 'u' is equal to the number of cells
26 !! defining 'grid' and 'ppoly'. No consistency check is performed here.
27 subroutine p1m_interpolation( N, h, u, edge_values, ppoly_coef, h_neglect, answers_2018 )
28  integer, intent(in) :: N !< Number of cells
29  real, dimension(:), intent(in) :: h !< cell widths (size N) [H]
30  real, dimension(:), intent(in) :: u !< cell average properties (size N) [A]
31  real, dimension(:,:), intent(inout) :: edge_values !< Potentially modified edge values [A]
32  real, dimension(:,:), intent(inout) :: ppoly_coef !< Potentially modified
33  !! piecewise polynomial coefficients, mainly [A]
34  real, optional, intent(in) :: h_neglect !< A negligibly small width [H]
35  logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions.
36 
37  ! Local variables
38  integer :: k ! loop index
39  real :: u0_l, u0_r ! edge values (left and right)
40 
41  ! Bound edge values (routine found in 'edge_values.F90')
42  call bound_edge_values( n, h, u, edge_values, h_neglect, answers_2018 )
43 
44  ! Systematically average discontinuous edge values (routine found in
45  ! 'edge_values.F90')
46  call average_discontinuous_edge_values( n, edge_values )
47 
48  ! Loop on interior cells to build interpolants
49  do k = 1,n
50 
51  u0_l = edge_values(k,1)
52  u0_r = edge_values(k,2)
53 
54  ppoly_coef(k,1) = u0_l
55  ppoly_coef(k,2) = u0_r - u0_l
56 
57  enddo ! end loop on interior cells
58 
59 end subroutine p1m_interpolation
60 
61 !> Interpolation by linear polynomials within boundary cells
62 !!
63 !! The left and right edge values in the left and right boundary cells,
64 !! respectively, are estimated using a linear extrapolation within the cells.
65 !!
66 !! It is assumed that the size of the array 'u' is equal to the number of cells
67 !! defining 'grid' and 'ppoly'. No consistency check is performed here.
68 subroutine p1m_boundary_extrapolation( N, h, u, edge_values, ppoly_coef )
69  ! Arguments
70  integer, intent(in) :: N !< Number of cells
71  real, dimension(:), intent(in) :: h !< cell widths (size N) [H]
72  real, dimension(:), intent(in) :: u !< cell averages (size N) [A]
73  real, dimension(:,:), intent(inout) :: edge_values !< edge values of piecewise polynomials [A]
74  real, dimension(:,:), intent(inout) :: ppoly_coef !< coefficients of piecewise polynomials, mainly [A]
75 
76  ! Local variables
77  real :: u0, u1 ! cell averages
78  real :: h0, h1 ! corresponding cell widths
79  real :: slope ! retained PLM slope
80  real :: u0_l, u0_r ! edge values
81 
82  ! -----------------------------------------
83  ! Left edge value in the left boundary cell
84  ! -----------------------------------------
85  h0 = h(1)
86  h1 = h(2)
87 
88  u0 = u(1)
89  u1 = u(2)
90 
91  ! The standard PLM slope is computed as a first estimate for the
92  ! interpolation within the cell
93  slope = 2.0 * ( u1 - u0 )
94 
95  ! The right edge value is then computed and we check whether this
96  ! right edge value is consistent: it cannot be larger than the edge
97  ! value in the neighboring cell if the data set is increasing.
98  ! If the right value is found to too large, the slope is further limited
99  ! by using the edge value in the neighboring cell.
100  u0_r = u0 + 0.5 * slope
101 
102  if ( (u1 - u0) * (edge_values(2,1) - u0_r) < 0.0 ) then
103  slope = 2.0 * ( edge_values(2,1) - u0 )
104  endif
105 
106  ! Using the limited slope, the left edge value is reevaluated and
107  ! the interpolant coefficients recomputed
108  if ( h0 /= 0.0 ) then
109  edge_values(1,1) = u0 - 0.5 * slope
110  else
111  edge_values(1,1) = u0
112  endif
113 
114  ppoly_coef(1,1) = edge_values(1,1)
115  ppoly_coef(1,2) = edge_values(1,2) - edge_values(1,1)
116 
117  ! ------------------------------------------
118  ! Right edge value in the left boundary cell
119  ! ------------------------------------------
120  h0 = h(n-1)
121  h1 = h(n)
122 
123  u0 = u(n-1)
124  u1 = u(n)
125 
126  slope = 2.0 * ( u1 - u0 )
127 
128  u0_l = u1 - 0.5 * slope
129 
130  if ( (u1 - u0) * (u0_l - edge_values(n-1,2)) < 0.0 ) then
131  slope = 2.0 * ( u1 - edge_values(n-1,2) )
132  endif
133 
134  if ( h1 /= 0.0 ) then
135  edge_values(n,2) = u1 + 0.5 * slope
136  else
137  edge_values(n,2) = u1
138  endif
139 
140  ppoly_coef(n,1) = edge_values(n,1)
141  ppoly_coef(n,2) = edge_values(n,2) - edge_values(n,1)
142 
143 end subroutine p1m_boundary_extrapolation
144 
145 !> \namespace p1m_functions
146 !!
147 !! Date of creation: 2008.06.09
148 !! L. White
149 !!
150 !! This module contains p1m (linear) interpolation routines.
151 !!
152 !! p1m interpolation is performed by estimating the edge values and
153 !! linearly interpolating between them.
154 !
155 !! Once the edge values are estimated, the limiting process takes care of
156 !! ensuring that (1) edge values are bounded by neighoring cell averages
157 !! and (2) discontinuous edge values are averaged in order to provide a
158 !! fully continuous interpolant throughout the domain. This last step is
159 !! essential for the regridding problem to yield a unique solution.
160 !! Also, a routine is provided that takes care of linear extrapolation
161 !! within the boundary cells.
162 
163 end module p1m_functions
Edge value estimation for high-order resconstruction.
Linear interpolation functions.