r8mat_expand_linear2 Subroutine

subroutine r8mat_expand_linear2(m, n, a, m2, n2, a2)

************80

! R8MAT_EXPAND_LINEAR2 expands an R8MAT by linear interpolation.

Discussion:

An R8MAT is an array of R8 values.

In this version of the routine, the expansion is indicated
by specifying the dimensions of the expanded array.

Licensing:

This code is distributed under the GNU LGPL license.

Modified:

07 December 2004

Author:

John Burkardt

Parameters:

Input, integer ( kind = 4 ) M, N, the number of rows and columns in A.

Input, real ( kind = 8 ) A(M,N), a "small" M by N array.

Input, integer ( kind = 4 ) M2, N2, the number of rows and columns in A2.

Output, real ( kind = 8 ) A2(M2,N2), the expanded array, which
contains an interpolated version of the data in A.

Arguments

Type IntentOptional Attributes Name
integer(kind=4) :: m
integer(kind=4) :: n
real(kind=8) :: a(m,n)
integer(kind=4) :: m2
integer(kind=4) :: n2
real(kind=8) :: a2(m2,n2)

Source Code

subroutine r8mat_expand_linear2 ( m, n, a, m2, n2, a2 )

  !*****************************************************************************80
  !
  !! R8MAT_EXPAND_LINEAR2 expands an R8MAT by linear interpolation.
  !
  !  Discussion:
  !
  !    An R8MAT is an array of R8 values.
  !
  !    In this version of the routine, the expansion is indicated
  !    by specifying the dimensions of the expanded array.
  !
  !  Licensing:
  !
  !    This code is distributed under the GNU LGPL license. 
  !
  !  Modified:
  !
  !    07 December 2004
  !
  !  Author:
  !
  !    John Burkardt
  !
  !  Parameters:
  !
  !    Input, integer ( kind = 4 ) M, N, the number of rows and columns in A.
  !
  !    Input, real ( kind = 8 ) A(M,N), a "small" M by N array.
  !
  !    Input, integer ( kind = 4 ) M2, N2, the number of rows and columns in A2.
  !
  !    Output, real ( kind = 8 ) A2(M2,N2), the expanded array, which
  !    contains an interpolated version of the data in A.
  !
  implicit none

  integer ( kind = 4 ) m
  integer ( kind = 4 ) m2
  integer ( kind = 4 ) n
  integer ( kind = 4 ) n2

  real    ( kind = 8 ) a(m,n)
  real    ( kind = 8 ) a2(m2,n2)
  integer ( kind = 4 ) i
  integer ( kind = 4 ) i1
  integer ( kind = 4 ) i2
  integer ( kind = 4 ) j
  integer ( kind = 4 ) j1
  integer ( kind = 4 ) j2
  real    ( kind = 8 ) r
  real    ( kind = 8 ) r1
  real    ( kind = 8 ) r2
  real    ( kind = 8 ) s
  real    ( kind = 8 ) s1
  real    ( kind = 8 ) s2

  do i = 1, m2

     if ( m2 == 1 ) then
        r = 0.5D+00
     else
        r = real ( i - 1, kind = 8 ) &
             / real ( m2 - 1, kind = 8 )
     end if

     i1 = 1 + int ( r * real ( m - 1, kind = 8 ) )
     i2 = i1 + 1

     if ( m < i2 ) then
        i1 = m - 1
        i2 = m
     end if

     r1 = real ( i1 - 1, kind = 8 ) &
          / real ( m - 1, kind = 8 )

     r2 = real ( i2 - 1, kind = 8 ) &
          / real ( m - 1, kind = 8 )

     do j = 1, n2

        if ( n2 == 1 ) then
           s = 0.5D+00
        else
           s = real ( j - 1, kind = 8 ) &
                / real ( n2 - 1, kind = 8 )
        end if

        j1 = 1 + int ( s * real ( n - 1, kind = 8 ) )
        j2 = j1 + 1

        if ( n < j2 ) then
           j1 = n - 1
           j2 = n
        end if

        s1 = real ( j1 - 1, kind = 8 ) &
             / real ( n - 1, kind = 8 )

        s2 = real ( j2 - 1, kind = 8 ) &
             / real ( n - 1, kind = 8 )

        a2(i,j) = &
             ( ( r2 - r ) * ( s2 - s ) * a(i1,j1) &
             + ( r - r1 ) * ( s2 - s ) * a(i2,j1) &
             + ( r2 - r ) * ( s - s1 ) * a(i1,j2) &
             + ( r - r1 ) * ( s - s1 ) * a(i2,j2) ) &
             / ( ( r2 - r1 ) * ( s2 - s1 ) )

     end do

  end do

  return
end subroutine r8mat_expand_linear2