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