lint2u Subroutine

private subroutine lint2u(nx, ny, p, mx, my, q, intpol, jy, dy, pj, pjp, ix, dxm, dx, dxp, dxpp, inmx, jnmy, isubx, jsuby)

linearly interpolate p onto q in y

Arguments

Type IntentOptional Attributes Name
integer :: nx
integer :: ny
real(kind=wp) :: p(nx,ny)
integer :: mx
integer :: my
real(kind=wp) :: q(mx,my)
integer :: intpol(2)
integer :: jy(my)
real(kind=wp) :: dy(my)
real(kind=wp) :: pj(mx)
real(kind=wp) :: pjp(mx)
integer :: ix(mx)
real(kind=wp) :: dxm(mx)
real(kind=wp) :: dx(mx)
real(kind=wp) :: dxp(mx)
real(kind=wp) :: dxpp(mx)
integer :: inmx
integer :: jnmy
integer :: isubx
integer :: jsuby

Calls

proc~~lint2u~~CallsGraph proc~lint2u regridpack_module::lint2u proc~cubt1u regridpack_module::cubt1u proc~lint2u->proc~cubt1u proc~lint1u regridpack_module::lint1u proc~lint2u->proc~lint1u

Called by

proc~~lint2u~~CalledByGraph proc~lint2u regridpack_module::lint2u proc~cubt3u regridpack_module::cubt3u proc~cubt3u->proc~lint2u proc~lint3u regridpack_module::lint3u proc~lint3u->proc~lint2u proc~rgrd2u regridpack_module::rgrd2u proc~rgrd2u->proc~lint2u interface~regrid regridpack_module::regrid interface~regrid->proc~rgrd2u proc~rgrd3u regridpack_module::rgrd3u interface~regrid->proc~rgrd3u proc~rgrd4u regridpack_module::rgrd4u interface~regrid->proc~rgrd4u proc~cubt4u regridpack_module::cubt4u proc~cubt4u->proc~cubt3u proc~cubt4u->proc~lint3u proc~lint4u regridpack_module::lint4u proc~lint4u->proc~cubt3u proc~lint4u->proc~lint3u proc~rgrd3u->proc~cubt3u proc~rgrd3u->proc~lint3u proc~rgrd4u->proc~cubt4u proc~rgrd4u->proc~lint4u

Source Code

    subroutine lint2u(nx,ny,p,mx,my,q,intpol,jy,dy,pj,pjp,ix,dxm,dx,dxp,dxpp,inmx,jnmy,isubx,jsuby)

    implicit none

    integer :: nx,ny,mx,my,intpol(2),jy(my),ix(mx),inmx,jnmy,isubx,jsuby
    integer :: j,jj,ii,jsave
    real(wp) :: p(nx,ny),q(mx,my)
    real(wp) :: dy(my),pj(mx),pjp(mx)
    real(wp) :: dxm(mx),dx(mx),dxp(mx),dxpp(mx)

    if (intpol(1) == 1) then

        ! linear in x

        if (jsuby == 1) then
            ! my grid is subset of ny grid
            do jj=1,my
                j = jnmy*(jj-1)+1
                call lint1u(nx,p(1,j),mx,q(1,jj),ix,dx,inmx,isubx)
            end do
            return
        end if

        jsave = -1
        do jj=1,my
            j = jy(jj)
            if (j == jsave) then
                ! pointer has not moved, no interpolation in pj,pjp necessary
            else if (j == jsave+1) then
                do ii=1,mx
                    pj(ii) = pjp(ii)
                end do
                call lint1u(nx,p(1,j+1),mx,pjp,ix,dx,inmx,isubx)
            else
                call lint1u(nx,p(1,j),mx,pj,ix,dx,inmx,isubx)
                call lint1u(nx,p(1,j+1),mx,pjp,ix,dx,inmx,isubx)
            end if
            ! update pointer
            jsave = j
            do ii=1,mx
                q(ii,jj) = pj(ii)+dy(jj)*(pjp(ii)-pj(ii))
            end do
        end do

    else

        ! cubic in x

        if (jsuby == 1) then
            ! my grid is subset of ny grid
            do jj=1,my
                j = jnmy*(jj-1)+1
                call cubt1u(nx,p(1,j),mx,q(1,jj),ix,dxm,dx,dxp,dxpp,inmx,isubx)
            end do
            return
        end if

        jsave = -1
        do jj=1,my
            j = jy(jj)
            if (j == jsave) then
                ! no interpolation in pj,pjp necessary
            else if (j == jsave+1) then
                do ii=1,mx
                    pj(ii) = pjp(ii)
                end do
                call cubt1u(nx,p(1,j+1),mx,pjp,ix,dxm,dx,dxp,dxpp,inmx,isubx)
            else
                call cubt1u(nx,p(1,j),mx,pj,ix,dxm,dx,dxp,dxpp,inmx,isubx)
                call cubt1u(nx,p(1,j+1),mx,pjp,ix,dxm,dx,dxp,dxpp,inmx,isubx)
            end if
            ! update pointer
            jsave = j
            do ii=1,mx
                q(ii,jj) = pj(ii)+dy(jj)*(pjp(ii)-pj(ii))
            end do
        end do

    end if

    end subroutine lint2u