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 )