lint2 Subroutine

private subroutine lint2(nx, ny, p, mx, my, q, intpol, jy, dy, pj, pjp, ix, dxm, dx, dxp, dxpp)

linearly interpolate 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)

Calls

proc~~lint2~~CallsGraph proc~lint2 regridpack_module::lint2 proc~cubt1 regridpack_module::cubt1 proc~lint2->proc~cubt1 proc~lint1 regridpack_module::lint1 proc~lint2->proc~lint1

Called by

proc~~lint2~~CalledByGraph proc~lint2 regridpack_module::lint2 proc~cubt3 regridpack_module::cubt3 proc~cubt3->proc~lint2 proc~lint3 regridpack_module::lint3 proc~lint3->proc~lint2 proc~rgrd2 regridpack_module::rgrd2 proc~rgrd2->proc~lint2 interface~regrid regridpack_module::regrid interface~regrid->proc~rgrd2 proc~rgrd2_wrapper regridpack_module::rgrd2_wrapper interface~regrid->proc~rgrd2_wrapper proc~rgrd3 regridpack_module::rgrd3 interface~regrid->proc~rgrd3 proc~rgrd3_wrapper regridpack_module::rgrd3_wrapper interface~regrid->proc~rgrd3_wrapper proc~rgrd4 regridpack_module::rgrd4 interface~regrid->proc~rgrd4 proc~rgrd4_wrapper regridpack_module::rgrd4_wrapper interface~regrid->proc~rgrd4_wrapper proc~cubt4 regridpack_module::cubt4 proc~cubt4->proc~cubt3 proc~cubt4->proc~lint3 proc~lint4 regridpack_module::lint4 proc~lint4->proc~cubt3 proc~lint4->proc~lint3 proc~rgrd2_wrapper->proc~rgrd2 proc~rgrd3->proc~cubt3 proc~rgrd3->proc~lint3 proc~rgrd3_wrapper->proc~rgrd3 proc~rgrd4->proc~cubt4 proc~rgrd4->proc~lint4 proc~rgrd4_wrapper->proc~rgrd4

Source Code

    subroutine lint2(nx,ny,p,mx,my,q,intpol,jy,dy,pj,pjp,ix,dxm,dx,dxp,dxpp)

    implicit none

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

    if (intpol(1)==1) then

        ! linear in x

        jsave = -1
        do jj=1,my
            j = jy(jj)
            if (j==jsave) then
                ! j pointer has not moved since last pass (no updates or interpolation)
            else if (j==jsave+1) then
                ! update j and interpolate j+1
                do ii=1,mx
                    pj(ii) = pjp(ii)
                end do
                call lint1(nx,p(1,j+1),mx,pjp,ix,dx)
            else
                ! interpolate j,j+1in pj,pjp on xx mesh
                call lint1(nx,p(1,j),mx,pj,ix,dx)
                call lint1(nx,p(1,j+1),mx,pjp,ix,dx)
            end if

            ! save j pointer for next pass

            jsave = j

            ! linearly interpolate q(ii,jj) from pjp,pj in y direction

            do ii=1,mx
                q(ii,jj) = pj(ii)+dy(jj)*(pjp(ii)-pj(ii))
            end do
        end do

    else

        ! cubic in x

        jsave = -1
        do jj=1,my
            j = jy(jj)
            if (j==jsave) then
                ! j pointer has not moved since last pass (no updates or interpolation)
            else if (j==jsave+1) then
                ! update j and interpolate j+1
                do ii=1,mx
                    pj(ii) = pjp(ii)
                end do
                call cubt1(nx,p(1,j+1),mx,pjp,ix,dxm,dx,dxp,dxpp)
            else
                ! interpolate j,j+1 in pj,pjp on xx mesh
                call cubt1(nx,p(1,j),mx,pj,ix,dxm,dx,dxp,dxpp)
                call cubt1(nx,p(1,j+1),mx,pjp,ix,dxm,dx,dxp,dxpp)
            end if

            ! save j pointer for next pass

            jsave = j

            ! linearly interpolate q(ii,jj) from pjp,pj in y direction

            do ii=1,mx
                q(ii,jj) = pj(ii)+dy(jj)*(pjp(ii)-pj(ii))
            end do
        end do

    end if

    end subroutine lint2