blend.f90

FORTRAN程序 共有8个插值程序 希望能帮到大家

!    Construction of Curvilinear Coordinate Systems and Application to
!      Mesh Generation,
!    International Journal of Numerical Methods in Engineering,
!    Volume 7, 1973, pages 461-477.
!
!    Joe Thompson, Bharat Soni, Nigel Weatherill,
!    Handbook of Grid Generation,
!    CRC Press, 1999.
!
!  Modified:
!
!    19 December 1998
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input/output, real X(M1,M2).  
!
!    On input, data is contained in the "edge entries" X(1,J), X(I,1), 
!    X(M1,J) and X(I,M2), for I = 1 to M1, and J = 1 to M2.
!    
!    On output, all entries in X have been assigned a value.
!
!    Input, integer M1, M2, the number of rows and columns in X.
!
  implicit none
!
  integer m1
  integer m2
!
  integer i
  integer j
  real x(m1,m2)
  real r
  real s
!
!  Interpolate values in the interior.
!
  do i = 2, m1 - 1

    r = real ( i - 1 ) / real ( m1 - 1 )

    do j = 2, m2 - 1

      s = real ( j - 1 ) / real ( m2 - 1 )

      call blend_112 ( r, s, x(1,1), x(1,m2), x(m1,1), x(m1,m2), &
        x(i,1), x(i,m2), x(1,j), x(m1,j), x(i,j) )

    end do

  end do

  return
end
subroutine blend_ij_w_1d1 ( x, r, s, m1, m2 )
!
!*******************************************************************************
!
!! BLEND_IJ_W_1D1 extends weighted indexed scalar data along edges into a table.
!
!
!  Diagram:
!
!    Instead of assuming that the data in the table is equally spaced,
!    the arrays R and S are supplied, which should behave as
!    "coordinates" for the data.
!
!            S(1)  S(2)  S(3)  S(4)  S(5)  S(6)  S(M2)
!      
!    R(1)  ( X11,  X12,  X13,  X14,  X15,  X16,  X1M2  )
!    R(2)  ( X21,  ...,  ...,  ...,  ...,  ...,  X2M2  )
!    R(3)  ( X31,  ...,  ...,  ...,  ...,  ...,  X3M2  )
!    R(4)  ( X41,  ...,  ...,  ...,  ...,  ...,  X4M2  )
!    R(M1) ( XM11, XM12, XM13, XM14, XM15, XM16, XM1M2 )
!
!  Reference:
!
!    William Gordon,
!    Blending-Function Methods of Bivariate and Multivariate Interpolation
!      and Approximation,
!    SIAM Journal on Numerical Analysis,
!    Volume 8, Number 1, March 1971, pages 158-177.
!
!    William Gordon and Charles Hall,
!    Transfinite Element Methods: Blending-Function Interpolation over
!      Arbitrary Curved Element Domains,
!    Numerische Mathematik,
!    Volume 21, Number 1, 1973, pages 109-129.
!
!    William Gordon and Charles Hall,
!    Construction of Curvilinear Coordinate Systems and Application to
!      Mesh Generation,
!    International Journal of Numerical Methods in Engineering,
!    Volume 7, 1973, pages 461-477.
!
!    Joe Thompson, Bharat Soni, Nigel Weatherill,
!    Handbook of Grid Generation,
!    CRC Press, 1999.
!
!  Modified:
!
!    16 August 1999
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input/output, real X(M1,M2).  
!    On input, data is contained in the "edge entries" X(1,J), X(I,1), 
!    X(M1,J) and X(I,M2), for I = 1 to M1, and J = 1 to M2.
!    On output, all entries in X have been assigned a value.
!
!    Input, real R(M1), S(M2), are "coordinates" for the rows and
!    columns of the array.  The values in R, and the values in S, should 
!    be strictly increasing or decreasing.
!
!    Input, integer M1, M2, the number of rows and columns in X.
!
  implicit none
!
  integer m1
  integer m2
!
  integer i
  integer j
  real x(m1,m2)
  real r(m1)
  real rr
  real s(m2)
  real ss
!
!  Interpolate values in the interior.
!
  do i = 2, m1 - 1

    rr = ( r(i) - r(1) ) / ( r(m1) - r(1) )

    do j = 2, m2 - 1

      ss = ( s(j) - s(1) ) / ( s(m2) - s(1) )

      call blend_112 ( rr, ss, x(1,1), x(1,m2), x(m1,1), x(m1,m2), &
        x(i,1), x(i,m2), x(1,j), x(m1,j), x(i,j) )

    end do

  end do

  return
end
subroutine blend_ijk_0d1 ( x, m1, m2, m3 )
!
!*******************************************************************************
!
!! BLEND_IJK_0D1 extends indexed scalar corner data into a cubic table.
!
!
!  Diagram:
!
!    ( X111,   ...,  ...,  ...,  ...,  ...,  X1M21   )
!    ( ....,   ...,  ...,  ...,  ...,  ...,  ...     )
!    ( ....,   ...,  ...,  ...,  ...,  ...,  ...     )   First "layer"
!    ( ....,   ...,  ...,  ...,  ...,  ...,  ...     )
!    ( XM111,  ...,  ...,  ...,  ...,  ...,  XM1M21  )
!
!    ( ....,   ...,  ...,  ...,  ...,  ...,  ...     )
!    ( ....,   ...,  ...,  ...,  ...,  ...,  ...     )
!    ( ....,   ...,  ...,  ...,  ...,  ...,  ...     )   Middle "layers"
!    ( ....,   ...,  ...,  ...,  ...,  ...,  ...     )
!    ( ....,   ...,  ...,  ...,  ...,  ...,  ...     )
!
!    ( X11M3,  ...,  ...,  ...,  ...,  ...,  X1M2M3  )
!    ( ....,   ...,  ...,  ...,  ...,  ...,  ...     )
!    ( ....,   ...,  ...,  ...,  ...,  ...,  ...     )   Last "layer"
!    ( ....,   ...,  ...,  ...,  ...,  ...,  ...     )
!    ( XM11M3, ...,  ...,  ...,  ...,  ...,  XM1M2M3 )
!
!  Reference:
!
!    William Gordon,
!    Blending-Function Methods of Bivariate and Multivariate Interpolation
!      and Approximation,
!    SIAM Journal on Numerical Analysis,
!    Volume 8, Number 1, March 1971, pages 158-177.
!
!    William Gordon and Charles Hall,
!    Transfinite Element Methods: Blending-Function Interpolation over
!      Arbitrary Curved Element Domains,
!    Numerische Mathematik,
!    Volume 21, Number 1, 1973, pages 109-129.
!
!    William Gordon and Charles Hall,
!    Construction of Curvilinear Coordinate Systems and Application to
!      Mesh Generation,
!    International Journal of Numerical Methods in Engineering,
!    Volume 7, 1973, pages 461-477.
!
!    Joe Thompson, Bharat Soni, Nigel Weatherill,
!    Handbook of Grid Generation,
!    CRC Press, 1999.
!
!  Modified:
!
!    16 December 1998
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input/output, real X(M1,M2,M3).  
!
!    On input, X(1,1,1), X(1,M2,1), X(M1,1,1), X(M1,M2,1), X(1,1,M3),
!    X(1,M2,M3), X(M1,1,M3) and X(M1,M2,M3) contain scalar values 
!    which are to be interpolated throughout the table, using the table
!    indices I and J as independent variables. 
!    
!    On output, all entries in X have been assigned a value.
!
!    Input, integer M1, M2, M3, the number of rows, columns, and layers 
!    in X.
!
  implicit none
!
  integer m1
  integer m2
  integer m3
!
  integer i
  integer j
  integer k
  real r
  real s
  real t
  real x(m1,m2,m3)
!
!  Interpolate values along the "edges", that is, index triplets (i,j,k)
!  with exactly two of I, J, K an "extreme" value.
!
  do i = 2, m1 - 1
    r = real ( i - 1 ) / real ( m1 - 1 )
    call blend_101 ( r, x( 1, 1, 1), x(m1, 1, 1), x( i, 1, 1) )
    call blend_101 ( r, x( 1,m2, 1), x(m1,m2, 1), x( i,m2, 1) )
    call blend_101 ( r, x( 1, 1,m3), x(m1, 1,m3), x( i, 1,m3) )
    call blend_101 ( r, x( 1,m2,m3), x(m1,m2,m3), x( i,m2,m3) )
  end do

  do j = 2, m2 - 1
    s = real ( j - 1 ) / real ( m2 - 1 )
    call blend_101 ( s, x( 1, 1, 1), x( 1,m2, 1), x( 1, j, 1) )
    call blend_101 ( s, x(m1, 1, 1), x(m1,m2, 1), x(m1, j, 1) )
    call blend_101 ( s, x( 1, 1,m3), x( 1,m2,m3), x( 1, j,m3) )
    call blend_101 ( s, x(m1, 1,m3), x(m1,m2,m3), x(m1, j,m3) )
  end do

  do k = 2, m3 - 1
    t = real ( k - 1 ) / real ( m3 - 1 )
    call blend_101 ( t, x( 1, 1,1), x( 1, 1,m3), x( 1, 1,k) )
    call blend_101 ( t, x(m1, 1,1), x(m1, 1,m3), x(m1, 1,k) )
    call blend_101 ( t, x( 1,m2,1), x( 1,m2,m3), x( 1,m2,k) )
    call blend_101 ( t, x(m1,m2,1), x(m1,m2,m3), x(m1,m2,k) )
  end do
!
!  Interpolate values along the "faces", that is, index triplets (i,j,k)
!  with exactly one of I, J, K is an "extreme" value.
!
  do j = 2, m2 - 1
    s = real ( j - 1 ) / real ( m2 - 1 )
    do k = 2, m3 - 1
      t = real ( k - 1 ) / real ( m3 - 1 )

      call blend_112 ( s, t, x(1,1,1), x(1,1,m3), x(1,m2,1), x(1,m2,m3), &
        x(1,j,1), x(1,j,m3), x(1,1,k), x(1,m2,k), x(1,j,k) )

      call blend_112 ( s, t, x(m1,1,1), x(m1,1,m3), x(m1,m2,1), x(m1,m2,m3), &
        x(m1,j,1), x(m1,j,m3), x(m1,1,k), x(m1,m2,k), x(m1,j,k) )

    end do
  end do 

  do i = 2, m1 - 1
    r = real ( i - 1 ) / real ( m1 - 1 )
    do k = 2, m3 - 1
      t = real ( k - 1 ) / real ( m3 - 1 )

      call blend_112 ( r, t, x(1,1,1), x(1,1,m3), x(m1,1,1), x(m1,1,m3), &
        x(i,1,1), x(i,1,m3), x(1,1,k), x(m1,1,k), x(i,1,k) )

      call blend_112 ( r, t, x(1,m2,1), x(1,m2,m3), x(m1,m2,1), x(m1,m2,m3), &
        x(i,m2,1), x(i,m2,m3), x(1,m2,k), x(m1,m2,k), x(i,m2,k) )

    end do
  end do 

  do i = 2, m1 - 1
    r = real ( i - 1 ) / real ( m1 - 1 )
    do j = 2, m2 - 1
      s = real ( j - 1 ) / real ( m2 - 1 )

      call blend_112 ( r, s, x(1,1,1), x(1,m2,1), x(m1,1,1), x(m1,m2,1), &
        x(i,1,1), x(i,m2,1), x(1,j,1), x(m1,j,1), x(i,j,1) )

      call blend_112 ( r, s, x(1,1,m3), x(1,m2,m3), x(m1,1,m3), x(m1,m2,m3), &
        x(i,1,m3), x(i,m2,m3), x(1,j,m3), x(m1,j,m3), x(i,j,m3) )

    end do
  end do
!
!  Interpolate values in the interior.
!
  do i = 2, m1 - 1

    r = real ( i - 1 ) / real ( m1 - 1 )

    do j = 2, m2 - 1

      s = real ( j - 1 ) / real ( m2 - 1 )

      do k = 2, m3 - 1

        t = real ( k - 1 ) / real ( m3 - 1 )

        call blend_123 ( r, s, t, &
          x( 1,1,1), x( 1, 1,m3), x( 1,m2,1), x( 1,m2,m3), &
          x(m1,1,1), x(m1, 1,m3), x(m1,m2,1), x(m1,m2,m3), &
          x( i,1,1), x( i, 1,m3), x( i,m2,1), x( i,m2,m3), &
          x( 1,j,1), x( 1, j,m3), x(m1, j,1), x(m1, j,m3), &
          x( 1,1,k), x( 1,m2, k), x(m1, 1,k), x(m1,m2, k), &
          x( 1,j,k), x(m1, j, k), x( i, 1,k), x( i,m2, k), &
          x( i,j,1), x( i, j,m3), x( i, j,k) )

      end do

    end do

  end do

  return
end
subroutine blend_ijk_1d1 ( x, m1, m2, m3 )
!
!*******************************************************************************
!
!! BLEND_IJK_1D1 extends indexed scalar edge data into a cubic table.
!
!
!  Diagram:
!
!    ( X111,   X121,   X131,   X141,   X151,   X1M21   )
!    ( X211,   ...,    ...,    ...,    ...,    X2M21   )
!    ( X311,   ...,    ...,    ...,    ...,    X3M21   )   Layer 1
!    ( X411,   ...,    ...,    ...,    ...,    X4M21   )
!    ( XM111,  XM121,  XM131,  XM141,  XM151,  XM1M21  )
!
!    ( X11K,   ...,    ...,    ...,    ...,    X1M2K   )
!    ( ....,   ...,    ...,    ...,    ...,    ...     )
!    ( ....,   ...,    ...,    ...,    ...,    ...     )   Layer K
!    ( ....,   ...,    ...,    ...,    ...,    ...     )   1 < K < M3
!    ( XM11K,  ...,    ...,    ...,    ...,    XM1M2K  )
!
!    ( X11M3,  X12M3,  X13M3,  X14M3,  X15M3,  X1M2M3  )
!    ( X21M3,  ...,    ...,    ...,    ...,    X2M2M3  )
!    ( X31M3,  ...,    ...,    ...,    ...,    X3M2M3  )   Layer M3
!    ( X41M3   ...,    ...,    ...,    ...,    X4M2M3  )
!    ( XM11M3, XM12M3, XM13M3, XM14M3, XM15M3, XM1M2M3 )
!
!  Reference:
!
!    William Gordon,
!    Blending-Function Methods of Bivariate and Multivariate Interpolation
!      and Approximation,
!    SIAM Journal on Numerical Analysis,
!    Volume 8, Number 1, March 1971, pages 158-177.
!
!    William Gordon and Charles Hall,
!    Transfinite Element Methods: Blending-Function Interpolation over
!      Arbitrary Curved Element Domains,
!    Numerische Mathematik,
!    Volume 21, Number 1, 1973, pages 109-129.
!
!    William Gordon and Charles Hall,
!    Construction of Curvilinear Coordinate Systems and Application to
!      Mesh Generation,
!    International Journal of Numerical Methods in Engineering,
!    Volume 7, 1973, pages 461-477.
!
!    Joe Thompson, Bharat Soni, Nigel Weatherill,
!    Handbook of Grid Generation,
!    CRC Press, 1999.
!
!  Modified:
!
!    15 December 1998
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input/output, real X(M1,M2,M3).  
!
!    On input, there is already scalar data in the entries X(I,J,K) 
!    corresponding to "edges" of the table, that is, entries for which
!    at least two of the three indices I, J and K are equal to their
!    minimum or maximum possible values.
!    
!    On output, all entries in X have been assigned a value, using the
!    table indices as independent variables.
!
!    Input, integer M1, M2, M3, the number of rows, columns, and layers 
!    in X.
!
  implicit none
!
  integer m1
  integer m2
  integer m3
!
  integer i
  integer j
  integer k
  real r
  real s
  real t
  real x(m1,m2,m3)
!
!  Interpolate values along the "faces", that is, index triplets (i,j,k)
!  where exactly one of I, J, K is an "extreme" value.
!
  do j = 2, m2 - 1
    s = real ( j - 1 ) / real ( m2 - 1 )
    do k = 2, m3 - 1
      t = real ( k - 1 ) / real ( m3 - 1 )

      call blend_112 ( s, t, x(1,1,1), x(1,1,m3), x(1,m2,1), &
        x(1,m2,m3), x(1,j,1), x(1,j,m3), x(1,1,k), x(1,m2,k), x(1,j,k) )

      call blend_112 ( s, t, x(m1,1,1), x(m1,1,m3), x(m1,m2,1), &
        x(m1,m2,m3), x(m1,j,1), x(m1,j,m3), x(m1,1,k), x(m1,m2,k), x(m1,j,k) )

    end do
  end do