function r8vec_norm_affine ( n, v0, v1 ) !*****************************************************************************80 ! !! r8vec_norm_affine() returns the affine norm of an R8VEC. ! ! Discussion: ! ! An R8VEC is a vector of R8's. ! ! The affine vector L2 norm is defined as: ! ! R8VEC_NORM_AFFINE(V0,V1) ! = sqrt ( sum ( 1 <= I <= N ) ( V1(I) - V0(I) )^2 ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 October 2010 ! ! Author: ! ! John Burkardt ! ! Input: ! ! integer N, the order of the vectors. ! ! real ( kind = rk8 ) V0(N), the base vector. ! ! real ( kind = rk8 ) V1(N), the vector whose affine norm is desired. ! ! Output: ! ! real ( kind = rk8 ) R8VEC_NORM_AFFINE, the L2 norm of V1-V0. ! implicit none integer, parameter :: rk8 = kind ( 1.0D+00 ) integer n real ( kind = rk8 ) r8vec_norm_affine real ( kind = rk8 ) v0(n) real ( kind = rk8 ) v1(n) r8vec_norm_affine = sqrt ( sum ( ( v0(1:n) - v1(1:n) ) ** 2 ) ) return end subroutine shepard_interp_2d ( nd, xd, yd, zd, p, ni, xi, yi, zi ) !*****************************************************************************80 ! !! shepard_interp_2d() evaluates a 2D Shepard interpolant. ! ! Discussion: ! ! This code should be vectorized. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 21 September 2012 ! ! Author: ! ! John Burkardt ! ! Reference: ! ! Donald Shepard, ! A two-dimensional interpolation function for irregularly spaced data, ! ACM '68: Proceedings of the 1968 23rd ACM National Conference, ! ACM, pages 517-524, 1969. ! ! Parameters: ! ! Input, integer ND, the number of data points. ! ! Input, real ( kind = rk ) XD(ND), YD(ND), the data points. ! ! Input, real ( kind = rk ) ZD(ND), the data values. ! ! Input, real ( kind = rk ) P, the power. ! ! Input, integer NI, the number of interpolation points. ! ! Input, real ( kind = rk ) XI(NI), YI(NI), the interpolation points. ! ! Output, real ( kind = rk ) ZI(NI), the interpolated values. ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer nd integer ni integer i integer j real ( kind = rk ) p real ( kind = rk ) s real ( kind = rk ) w(nd) real ( kind = rk ) xd(nd) real ( kind = rk ) xi(ni) real ( kind = rk ) yd(nd) real ( kind = rk ) yi(ni) integer z real ( kind = rk ) zd(nd) real ( kind = rk ) zi(ni) do i = 1, ni if ( p == 0.0D+00 ) then w(1:nd) = 1.0D+00 / real ( nd, kind = rk ) else z = -1 do j = 1, nd w(j) = sqrt ( ( xi(i) - xd(j) ) ** 2 + ( yi(i) - yd(j) ) ** 2 ) if ( w(j) == 0.0D+00 ) then z = j exit end if end do if ( z /= -1 ) then w(1:nd) = 0.0D+00 w(z) = 1.0D+00 else w(1:nd) = 1.0D+00 / w(1:nd) ** p s = sum ( w ) w(1:nd) = w(1:nd) / s end if end if zi(i) = dot_product ( w, zd ) end do return end