rgrd1_wrapper Subroutine

private subroutine rgrd1_wrapper(x, p, xx, q, intpol, ier)

Wrapper to rgrd1. Allocates the work arrays internally.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in), dimension(:) :: x

original x
real(kind=wp), intent(in), dimension(:) :: p

original p(x)
real(kind=wp), intent(in), dimension(:) :: xx

regridded xx
real(kind=wp), intent(out), dimension(:) :: q

regridded q(xx)
integer, intent(in) :: intpol
integer, intent(out) :: ier

status code:

  • 0 : no errors
  • 1-6 : error [see original code]
  • 10 : input vectors are the wrong size
  • 100 : out of memory

Calls

proc~~rgrd1_wrapper~~CallsGraph proc~rgrd1_wrapper regridpack_module::rgrd1_wrapper proc~rgrd1 regridpack_module::rgrd1 proc~rgrd1_wrapper->proc~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_wrapper~~CalledByGraph proc~rgrd1_wrapper regridpack_module::rgrd1_wrapper interface~regrid regridpack_module::regrid interface~regrid->proc~rgrd1_wrapper

Source Code

    subroutine rgrd1_wrapper(x,p,xx,q,intpol,ier)

    implicit none

    real(wp),dimension(:),intent(in)     :: x            !! original x
    real(wp),dimension(:),intent(in)     :: p            !! original p(x)
    real(wp),dimension(:),intent(in)     :: xx           !! regridded xx
    real(wp),dimension(:),intent(out)    :: q            !! regridded q(xx)
    integer,intent(in)                   :: intpol
    integer,intent(out)                  :: ier          !! status code:
                                                         !!
                                                         !! * 0    : no errors
                                                         !! * 1-6 : error [see original code]
                                                         !! * 10  : input vectors are the wrong size
                                                         !! * 100 : out of memory

    integer :: lw, liw
    integer :: nx, mx
    integer :: np, nq
    real(wp),dimension(:),allocatable :: w
    integer,dimension(:),allocatable :: iw
    integer :: ierr1, ierr2

    !get array sizes:

    nx = size(x)
    np = size(p)

    mx = size(xx)
    nq = size(q)

    if (nx/=np .or. mx/=nq) then
        !Error: vectors are the wrong size
        ier = 10
        return
    end if

    !allocate work matrices:

    select case(intpol)
    case(1)
        lw = mx
    case(3)
        lw = 4*mx
    case default
        ier = 6     !Error: invalid intpol value
        return
    end select

    liw = mx

    allocate(w(lw),   stat=ierr1)
    allocate(iw(liw), stat=ierr2)

    if (ierr1==0 .and. ierr2==0) then
        !call the main routine:
        call rgrd1(nx,x,p,mx,xx,q,intpol,w,lw,iw,liw,ier)
    else
        !error: out of memory
        ier = 100
    end if

    !clean up:
    if (allocated(w)) deallocate(w)
    if (allocated(iw)) deallocate(iw)

    end subroutine rgrd1_wrapper