rgrd4_wrapper Subroutine

private subroutine rgrd4_wrapper(x, y, z, t, p, xx, yy, zz, tt, q, intpol, ier)

Wrapper to rgrd4. 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(:) :: y

original y
real(kind=wp), intent(in), dimension(:) :: z

original z
real(kind=wp), intent(in), dimension(:) :: t

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

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

regridded xx
real(kind=wp), intent(in), dimension(:) :: yy

regridded yy
real(kind=wp), intent(in), dimension(:) :: zz

regridded zz
real(kind=wp), intent(in), dimension(:) :: tt

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

regridded q(xx,yy,zz,tt)
integer, intent(in), dimension(4) :: intpol
integer, intent(out) :: ier
  • 0 : no errors
  • 1-6 : error [see original code]
  • 10 : input vectors are the wrong size
  • 100 : out of memory

Calls

proc~~rgrd4_wrapper~~CallsGraph proc~rgrd4_wrapper regridpack_module::rgrd4_wrapper proc~rgrd4 regridpack_module::rgrd4 proc~rgrd4_wrapper->proc~rgrd4 proc~cubnmx regridpack_module::cubnmx proc~rgrd4->proc~cubnmx proc~cubt4 regridpack_module::cubt4 proc~rgrd4->proc~cubt4 proc~linmx regridpack_module::linmx proc~rgrd4->proc~linmx proc~lint4 regridpack_module::lint4 proc~rgrd4->proc~lint4 proc~cubt3 regridpack_module::cubt3 proc~cubt4->proc~cubt3 proc~lint3 regridpack_module::lint3 proc~cubt4->proc~lint3 proc~lint4->proc~cubt3 proc~lint4->proc~lint3 proc~cubt2 regridpack_module::cubt2 proc~cubt3->proc~cubt2 proc~lint2 regridpack_module::lint2 proc~cubt3->proc~lint2 proc~lint3->proc~cubt2 proc~lint3->proc~lint2 proc~cubt1 regridpack_module::cubt1 proc~cubt2->proc~cubt1 proc~lint1 regridpack_module::lint1 proc~cubt2->proc~lint1 proc~lint2->proc~cubt1 proc~lint2->proc~lint1

Called by

proc~~rgrd4_wrapper~~CalledByGraph proc~rgrd4_wrapper regridpack_module::rgrd4_wrapper interface~regrid regridpack_module::regrid interface~regrid->proc~rgrd4_wrapper

Source Code

    subroutine rgrd4_wrapper(x,y,z,t,p,xx,yy,zz,tt,q,intpol,ier)

    implicit none

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

    integer :: nx, ny, nz, nt, mx, my, mz, mt
    integer,dimension(4) :: np, nq
    integer :: lw, liw
    integer :: lwx, lwy, lwz, lwt
    real(wp),dimension(:),allocatable :: w
    integer,dimension(:),allocatable :: iw
    integer :: ierr1, ierr2

    !get array sizes:

    nx = size(x)
    ny = size(y)
    nz = size(z)
    nt = size(t)

    np(1) = size(p,1)
    np(2) = size(p,2)
    np(3) = size(p,3)
    np(4) = size(p,4)

    mx = size(xx)
    my = size(yy)
    mz = size(zz)
    mt = size(tt)

    nq(1) = size(q,1)
    nq(2) = size(q,2)
    nq(3) = size(q,3)
    nq(4) = size(q,4)

    if (nx/=np(1) .or. ny/=np(2) .or. nz/=np(3) .or. nt/=np(4) .or. &
        mx/=nq(1).or. my/=nq(2) .or. mz/=nq(3) .or. mt/=nq(4)) then

        !Error: vectors are the wrong size
        ier = 10
        return

    end if

    !allocate work matrices:

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

    select case(intpol(2))
    case(1)
        lwy = my+2*mx
    case(3)
        lwy = 4*(mx+my)
    end select

    select case(intpol(3))
    case(1)
        lwz = 2*mx*my+mz
    case(3)
        lwz = 4*(mx*my+mz)
    end select

    select case(intpol(4))
    case(1)
        lwt = 2*mx*my*mz+mt
    case(3)
        lwt = 4*(mx*my*mz+mt)
    end select

    lw  = lwx + lwy + lwz + lwt
    liw = mx + my + mz + mt

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

    if (ierr1==0 .and. ierr2==0) then

        !call the main routine:
        call rgrd4(nx,ny,nz,nt,x,y,z,t,p,mx,my,mz,mt,xx,yy,zz,tt,q,intpol,w,lw,iw,liw,ier)

    else

        !error: out of memory
        ier = 100

    end if

    !clean up:

    deallocate(w)
    deallocate(iw)

    end subroutine rgrd4_wrapper