INTERP1D: EXAMPLE IN F77:
c         Declare any routine as external to fill the place of m_slStateValue()
          external Extrap1D_LapseRate_X

          integer ij,k
          integer ni, nj, srcNk, destNk
          parameter(ni=20,nj=40,srcNk=10,dstNk=15)
          real HuSrc(ni*nj,srcNk),HuDst(ni*nj,dstNk)
          real HuDeriv(ni*nj,srcNk),HuDerivDst(ni*nj,dstNk)
          real LevSrc(ni*nj,srcNk),LevDst(ni*nj,dstNk),Posn(ni*nj,dstNk)
          logical extrapEnableUp,extrapEnableDown
          real extrapGuideUp,extrapGuideDown
          integer numExtArraysIn, numExtArraysOut
          real ExtArraysIn(1,1), ExtArraysOut(1,1)
c
c         Calculate and fill the array Posn
c
          call Interp1D_FindPos(ni*nj, srcNk, dstNk,srcNiNj,
     $                          dstNiNj,LevSrc, Posn, LevDst)
c
c         Fill in the input values
c
          do k=1,srcNk
             do i=1,srcNiNJ
                   LevSrc(i,k)=i
                   LevDst(i,k)=i+0.2
                   HuSrc (i,k)=40.4
                enddo
             enddo
          enddo
          extrapEnableUp = .true.
          extrapEnableDown = .false.
          extrapGuideUp = 0.
          extrapGuideDown = 0.
          call Interp1D_CubicLagrange_X(ni*nj, srcNk, dstNk,
     $                                  srcNiNj, dstNiNj,
     $                                  LevSrc, HuSrc,
     $                                  HuDeriv, Posn,
     $                                  LevDst, HuDst, HuDerivDst,
     $                                  extrapEnableDown, extrapEnableUp,
     $                                  extrapGuideDown, extrapGuideUp,
     $                                  Extrap1D_LapseRate_X,
     $                                  numExtArraysIn, numExtArraysOut,
     $                                  ExtArraysIn, ExtArraysOut )
c
c    Overwrite the (upward) extrapolated values, based on a lapse rate
c
c    roll off to smaller values with higher levels
          extrapGuideUp = -0.25

c    roll off to smaller values with lower levels
          extrapGuideDown = +0.25

          call Extrap1D_LapseRate_X  (ni*nj, srcNk, dstNk,
     $                                srcNiNj, dstNiNj,
     $                                LevSrc, HuSrc, HuDeriv,
     $                                Posn,
     $                                LevDst, HuDst, HuDerivDst,
     $                                extrapEnableDown, extrapEnableUp,
     $                                extrapGuideDown, extrapGuideUp,
     $                                Extrap1D_LapseRate_X,
     $                                numExtArraysIn, numExtArraysOut,
     $                                ExtArraysIn, ExtArraysOut )




Return to RPN Libraries home page
Return to product index
Last updated: December 5, 2003