rgrd1 Subroutine

private subroutine rgrd1(nx, x, p, mx, xx, q, intpol, w, lw, iw, liw, ier)

subroutine rgrd1 interpolates the values p(i) on the grid x(i) for i=1,...,nx onto q(ii) on the grid xx(ii),ii=1,...,mx.

requirements

x must be a strictly increasing grid and xx must be an increasing grid (see ier = 4). in addition the interval

[xx(1),xx(mx)]

must lie within the interval

[x(1),x(nx)].

extrapolation is not allowed (see ier=3). if these intervals are identical and the x and xx grids are UNIFORM then subroutine rgrd1u should be used in place of rgrd1.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nx

the integer dimension of the grid vector x and the dimension of p. nx > 1 if intpol = 1 or nx > 3 if intpol = 3 is required.
real(kind=wp), intent(in), dimension(nx) :: x

a real(wp) nx vector of strictly increasing values which defines the x grid on which p is given.
real(kind=wp), intent(in), dimension(nx) :: p

a real(wp) nx vector of values given on the x grid
integer, intent(in) :: mx

the integer dimension of the grid vector xx and the dimension of q. mx > 0 is required.
real(kind=wp), intent(in), dimension(mx) :: xx

a real(wp) mx vector of increasing values which defines the grid on which q is defined. xx(1) < x(1) or xx(mx) > x(nx) is not allowed (see ier = 3)
real(kind=wp), intent(out) :: q(mx)

a real(wp) mx vector of values on the xx grid which are interpolated from p on the x grid
integer, intent(in) :: intpol

an integer which sets linear or cubic interpolation as follows:

  • intpol = 1 sets linear interpolation
  • intpol = 3 sets cubic interpolation

values other than 1 or 3 in intpol are not allowed (ier = 6).
real(kind=wp), intent(inout), dimension(lw) :: w

a real(wp) work space of length at least lw which must be provided in the routine calling rgrd1
integer, intent(in) :: lw

the integer length of the real(wp) work space w. let

  • lwmin = mx if intpol(1) = 1
  • lwmin = 4*mx if intpol(1) = 3

then lw must be greater than or equal to lwmin
integer, intent(inout), dimension(*) :: iw

an integer work space of length at least liw which must be provided in the routine calling rgrd1
integer, intent(in) :: liw

the length of the integer work space iw. liw must be greater than or equal to mx.
integer, intent(out) :: ier

an integer error flag set as follows:

  • ier = 0 if no errors in input arguments are detected
  • ier = 1 if mx < 1
  • ier = 2 if nx < 2 when intpol=1 or nx < 4 when intpol=3
  • ier = 3 if xx(1) < x(1) or x(nx) < xx(mx) to avoid this flag when end points are intended to be the same but may differ slightly due to roundoff error, they should be set exactly in the calling routine (e.g., if both grids have the same x boundaries then xx(1)=x(1) and xx(mx)=x(nx) should be set before calling rgrd1)
  • ier = 4 if the x grid is not strictly monotonically increasing or if the xx grid is not montonically increasing. more precisely if: x(i+1) <= x(i) for some i such that 1 <= i < nx (or) xx(ii+1) < xx(ii) for some ii such that 1 <= ii < mx
  • ier = 5 if lw or liw is too small (insufficient work space)
  • ier = 6 if intpol is not equal to 1 or 3

Calls

proc~~rgrd1~~CallsGraph proc~rgrd1 regridpack_module::rgrd1 proc~cubnmx regridpack_module::cubnmx proc~rgrd1->proc~cubnmx proc~cubt1 regridpack_module::cubt1 proc~rgrd1->proc~cubt1 proc~linmx regridpack_module::linmx proc~rgrd1->proc~linmx proc~lint1 regridpack_module::lint1 proc~rgrd1->proc~lint1

Called by

proc~~rgrd1~~CalledByGraph proc~rgrd1 regridpack_module::rgrd1 interface~regrid regridpack_module::regrid interface~regrid->proc~rgrd1 proc~rgrd1_wrapper regridpack_module::rgrd1_wrapper interface~regrid->proc~rgrd1_wrapper proc~rgrd1_wrapper->proc~rgrd1

Source Code

    subroutine rgrd1(nx,x,p,mx,xx,q,intpol,w,lw,iw,liw,ier)

    implicit none

    integer,intent(in) :: nx                       !! the integer dimension of the grid
                                                   !! vector x and the dimension of p.
                                                   !! nx > 1 if intpol = 1 or nx > 3 if
                                                   !! intpol = 3 is required.
    real(wp),dimension(nx),intent(in) :: x         !! a real(wp) nx vector of strictly
                                                   !! increasing values which defines the x
                                                   !! grid on which p is given.
    real(wp),dimension(nx),intent(in) :: p         !! a real(wp) nx vector of values given on the x grid
    integer,intent(in) :: mx                       !! the integer dimension of the grid vector
                                                   !! xx and the dimension of q.
                                                   !! mx > 0 is required.
    real(wp),dimension(mx),intent(in)  :: xx       !! a real(wp) mx vector of increasing values which defines the
                                                   !! grid on which q is defined.  xx(1) < x(1) or xx(mx) > x(nx)
                                                   !! is not allowed (see ier = 3)
    integer,intent(in) :: intpol                   !! an integer which sets linear or cubic
                                                   !! interpolation as follows:
                                                   !!
                                                   !! * intpol = 1 sets linear interpolation
                                                   !! * intpol = 3 sets cubic interpolation
                                                   !!
                                                   !! values other than 1 or 3 in intpol are not allowed (ier = 6).
    real(wp),intent(out) :: q(mx)                  !! a real(wp) mx vector of values on the xx grid which are
                                                   !! interpolated from p on the x grid
    integer,intent(in) :: lw                       !! the integer length of the real(wp) work space w.  let
                                                   !!
                                                   !!  * lwmin = mx     if intpol(1) = 1
                                                   !!  * lwmin = 4*mx   if intpol(1) = 3
                                                   !!
                                                   !! then lw must be greater than or equal to lwmin
    real(wp),dimension(lw),intent(inout) :: w      !! a real(wp) work space of length at least
                                                   !! lw which must be provided in the
                                                   !! routine calling rgrd1
    integer,intent(in) :: liw                      !! the length of the integer work space iw.
                                                   !! liw must be greater than or equal to mx.
    integer,dimension(*),intent(inout) :: iw       !! an integer work space of length at least
                                                   !! liw which must be provided in the
                                                   !! routine calling rgrd1
    integer,intent(out) :: ier                     !! an integer error flag set as follows:
                                                   !!
                                                   !! * ier = 0 if no errors in input arguments are detected
                                                   !! * ier = 1 if mx < 1
                                                   !! * ier = 2 if nx < 2 when intpol=1 or nx < 4 when intpol=3
                                                   !! * ier = 3 if xx(1) < x(1) or x(nx) < xx(mx)
                                                   !!    to avoid this flag when end points are intended to be the
                                                   !!    same but may differ slightly due to roundoff error, they
                                                   !!    should be set exactly in the calling routine (e.g., if both
                                                   !!    grids have the same x boundaries then xx(1)=x(1) and xx(mx)=x(nx)
                                                   !!    should be set before calling rgrd1)
                                                   !! * ier = 4 if the x grid is not strictly monotonically increasing
                                                   !!    or if the xx grid is not montonically increasing.  more
                                                   !!    precisely if:
                                                   !!    x(i+1) <= x(i) for some i such that 1 <= i < nx (or)
                                                   !!    xx(ii+1) < xx(ii) for some ii such that 1 <= ii < mx
                                                   !! * ier = 5 if lw or liw is too small (insufficient work space)
                                                   !! * ier = 6 if intpol is not equal to 1 or 3

    integer :: i,ii,i1,i2,i3,i4

    ! check arguments for errors

    ! check xx grid resolution
    ier = 1
    if (mx < 1) return

    ! check intpol
    ier = 6
    if (intpol/=1 .and. intpol/=3) return

    ! check x grid resolution
    ier = 2
    if (intpol==1 .and. nx<2) return
    if (intpol==3 .and. nx<4) return

    ! check xx grid contained in x grid
    ier = 3
    if (xx(1)<x(1) .or. xx(mx)>x(nx)) return

    ! check montonicity of grids
    do i=2,nx
        if (x(i-1)>=x(i)) then
            ier = 4
            return
        end if
    end do
    do ii=2,mx
        if (xx(ii-1)>xx(ii)) then
            ier = 4
            return
        end if
    end do

    ! check minimum work space lengths
    ier = 5
    if (intpol==1) then
        if (lw < mx) return
    else
        if (lw < 4*mx) return
    end if
    if (liw < mx) return

    ! arguments o.k.

    ier = 0

    if (intpol==1) then
        ! linear interpolation in x
        call linmx(nx,x,mx,xx,iw,w)
        call lint1(nx,p,mx,q,iw,w)
    else
        ! cubic interpolation in x
        i1 = 1
        i2 = i1+mx
        i3 = i2+mx
        i4 = i3+mx
        call cubnmx(nx,x,mx,xx,iw,w(i1),w(i2),w(i3),w(i4))
        call cubt1(nx,p,mx,q,iw,w(i1),w(i2),w(i3),w(i4))
    end if

    end subroutine rgrd1