************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.
Type | Intent | Optional | 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) |
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