lint3 Subroutine

private subroutine lint3(nx, ny, nz, p, mx, my, mxmy, mz, q, intpol, kz, dz, pk, pkp, jy, dym, dy, dyp, dypp, pjm, pj, pjp, pjpp, ix, dxm, dx, dxp, dxpp)

linearly interpolate in z direction

Arguments

Type IntentOptional Attributes Name
integer :: nx
integer :: ny
integer :: nz
real(kind=wp) :: p(nx,ny,nz)
integer :: mx
integer :: my
integer :: mxmy
integer :: mz
real(kind=wp) :: q(mxmy,mz)
integer :: intpol(3)
integer :: kz(mz)
real(kind=wp) :: dz(mz)
real(kind=wp) :: pk(mxmy)
real(kind=wp) :: pkp(mxmy)
integer :: jy(my)
real(kind=wp) :: dym(my)
real(kind=wp) :: dy(my)
real(kind=wp) :: dyp(my)
real(kind=wp) :: dypp(my)
real(kind=wp) :: pjm(mx)
real(kind=wp) :: pj(mx)
real(kind=wp) :: pjp(mx)
real(kind=wp) :: pjpp(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~~lint3~~CallsGraph proc~lint3 regridpack_module::lint3 proc~cubt2 regridpack_module::cubt2 proc~lint3->proc~cubt2 proc~lint2 regridpack_module::lint2 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~~lint3~~CalledByGraph proc~lint3 regridpack_module::lint3 proc~cubt4 regridpack_module::cubt4 proc~cubt4->proc~lint3 proc~lint4 regridpack_module::lint4 proc~lint4->proc~lint3 proc~rgrd3 regridpack_module::rgrd3 proc~rgrd3->proc~lint3 interface~regrid regridpack_module::regrid 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~rgrd3_wrapper->proc~rgrd3 proc~rgrd4->proc~cubt4 proc~rgrd4->proc~lint4 proc~rgrd4_wrapper->proc~rgrd4

Source Code

    subroutine lint3(nx,ny,nz,p,mx,my,mxmy,mz,q,intpol,kz,&
                     dz,pk,pkp,jy,dym,dy,dyp,dypp,pjm,pj,pjp,&
                     pjpp,ix,dxm,dx,dxp,dxpp)

    implicit none

    integer  :: nx,ny,nz,mx,my,mz,mxmy
    real(wp) :: p(nx,ny,nz),q(mxmy,mz)
    real(wp) :: dz(mz),pk(mxmy),pkp(mxmy)
    real(wp) :: dym(my),dy(my),dyp(my),dypp(my)
    real(wp) :: pjm(mx),pj(mx),pjp(mx),pjpp(mx)
    real(wp) :: dxm(mx),dx(mx),dxp(mx),dxpp(mx)
    integer  :: intpol(3),kz(mz),jy(my),ix(mx)
    integer  :: k,kk,iijj,ksave

    if (intpol(2) == 1) then

        ! linear in y

        ksave = -1
        do kk=1,mz
            k = kz(kk)
            if (k==ksave) then
                ! k pointer has not moved since last pass (no updates or interpolation)
            else if (k==ksave+1) then
                ! update k and interpolate k+1
                do iijj=1,mxmy
                    pk(iijj) = pkp(iijj)
                end do
                call lint2(nx,ny,p(1,1,k+1),mx,my,pkp,intpol,jy,dy,pj,pjp,ix,dxm,dx,dxp,dxpp)
            else
                ! interpolate k,k+1 in pk,pkp on xx,yy mesh
                call lint2(nx,ny,p(1,1,k),mx,my,pk,intpol,jy,dy,pj,pjp,ix,dxm,dx,dxp,dxpp)
                call lint2(nx,ny,p(1,1,k+1),mx,my,pkp,intpol,jy,dy,pj,pjp,ix,dxm,dx,dxp,dxpp)
            end if

            ! save k pointer for next pass

            ksave = k

            ! linearly interpolate q(ii,jj,k) from pk,pkp in z direction

            do iijj=1,mxmy
                q(iijj,kk) = pk(iijj)+dz(kk)*(pkp(iijj)-pk(iijj))
            end do
        end do

    else

        ! cubic in y

        ksave = -1
        do kk=1,mz
            k = kz(kk)
            if (k==ksave) then
                ! k pointer has not moved since last pass (no updates or interpolation)
            else if (k==ksave+1) then
                ! update k and interpolate k+1
                do iijj=1,mxmy
                    pk(iijj) = pkp(iijj)
                end do
                call cubt2(nx,ny,p(1,1,k+1),mx,my,pkp,intpol,jy,dym,dy,dyp,dypp,pjm,pj,pjp,pjpp,ix,dxm,dx,dxp,dxpp)
            else
                ! interpolate k,k+1 in pk,pkp on xx,yy mesh
                call cubt2(nx,ny,p(1,1,k),mx,my,pk,intpol,jy,dym,dy,dyp,dypp,pjm,pj,pjp,pjpp,ix,dxm,dx,dxp,dxpp)
                call cubt2(nx,ny,p(1,1,k+1),mx,my,pkp,intpol,jy,dym,dy,dyp,dypp,pjm,pj,pjp,pjpp,ix,dxm,dx,dxp,dxpp)
            end if

            ! save k pointer for next pass

            ksave = k

            ! linearly interpolate q(ii,jj,k) from pk,pkp in z direction

            do iijj=1,mxmy
                q(iijj,kk) = pk(iijj)+dz(kk)*(pkp(iijj)-pk(iijj))
            end do
        end do

    end if

    end subroutine lint3