subroutine tintrp3(nx,f,g,dx,dy,dz,obstime,gridtime,deltat, & 5,1 lat1,lon1,nlon,nsig,n,mype) !$$$ subprogram documentation block ! . . . . ! subprogram: intrp3 linear interpolation in 3 dimensions. ! prgmmr: parrish org: w/nmc22 date: 90-10-11 ! ! abstract: linear interpolate in 3 dims (2nd dim always periodic). ! ! program history log: ! 90-10-11 parrish ! 98-04-05 weiyu yang ! 99-08-24 derber, j., treadon, r., yang, w., first frozen mpp version ! ! input argument list: ! nx - 2*nlath ! f - input interpolator ! dx,dy,dz - input x,y,z-coords of interpolation points (grid units) ! nlon - number of longitudes ! lat1 - number of gaussian lats in the sub-domain array ! lon1 - number of gaussian longitudes in the sub-domain array ! nsig - number of sigma levels ! n - number of interpolatees ! istart - start latitude of the whole array in each pe ! jstart - start longitude of the whole array in each pe ! ! output argument list: ! g - output interpolatees ! ! attributes: ! language: f90 ! machine: ibm RS/6000 SP ! !$$$ use type_kinds, only: fp_kind implicit none include 'ijstart.h' integer nx,lat1,lon1,nlon,n,mype,ione,m1,i,ix1,iy1,ix,ixp,iyp integer iy,iz,izp,nsig real(fp_kind) zero,one,delx,rdelt,delyp,delxp,point1,point2 real(fp_kind) point3,deltat,dely,delz,delzp real(fp_kind),dimension(lat1+2,lon1+2,nsig,3):: f real(fp_kind),dimension(n):: g,g2,g3,dx,dy,dz,obstime real(fp_kind),dimension(2):: gridtime !ibm* prefetch_for_store(zero,one,ione,m1) zero=0.0; one=1.0; ione=1 m1=mype+ione do i=ione,n !ibm* prefetch_for_store(ix1,iy1,iz) ix1=int(dx(i)) iy1=int(dy(i)) iz=int(dz(i)) ix1=max(ione,min(ix1,nx)); iz=max(ione,min(iz,nsig)) !ibm* prefetch_for_store(delx,dely,delz) delx=dx(i)-float(ix1) dely=dy(i)-float(iy1) delz=dz(i)-float(iz) delx=max(zero,min(delx,one)); delz=max(zero,min(delz,one)) !ibm* prefetch_for_store(ix,iy) ix=ix1-istart(m1)+2 iy=iy1-jstart(m1)+2 if(iy<ione) then iy1=iy1+nlon !ibm* prefetch_for_store(iy) iy=iy1-jstart(m1)+2 end if if(iy>lon1+ione) then iy1=iy1-nlon !ibm* prefetch_for_store(iy) iy=iy1-jstart(m1)+2 end if !ibm* prefetch_for_store(ixp,iyp,izp) ixp=ix+ione; iyp=iy+ione izp=min(iz+ione,nsig) if(ix1==nx) then !ibm* prefetch_for_store(ixp) ixp=ix end if !ibm* prefetch_for_store(delxp,delyp,delzp) delxp=one-delx; delyp=one-dely delzp=one-delz !ibm* prefetch_for_store(g(i)) g(i) =f(ix,iy ,iz, 1)*delxp*delyp*delzp+f(ixp,iy ,iz, 1)*delx*delyp*delzp& +f(ix,iyp,iz, 1)*delxp*dely *delzp+f(ixp,iyp,iz, 1)*delx*dely *delzp& +f(ix,iy ,izp,1)*delxp*delyp*delz +f(ixp,iy ,izp,1)*delx*delyp*delz& +f(ix,iyp,izp,1)*delxp*dely *delz +f(ixp,iyp,izp,1)*delx*dely *delz if(deltat >0.)then g2(i)=f(ix,iy ,iz, 2)*delxp*delyp*delzp+f(ixp,iy ,iz ,2)*delx*delyp*delzp& +f(ix,iyp,iz, 2)*delxp*dely *delzp+f(ixp,iyp,iz ,2)*delx*dely *delzp& +f(ix,iy ,izp,2)*delxp*delyp*delz +f(ixp,iy ,izp,2)*delx*delyp*delz& +f(ix,iyp,izp,2)*delxp*dely *delz +f(ixp,iyp,izp,2)*delx*dely *delz g3(i)=f(ix,iy ,iz, 3)*delxp*delyp*delzp+f(ixp,iy ,iz ,3)*delx*delyp*delzp& +f(ix,iyp,iz, 3)*delxp*dely *delzp+f(ixp,iyp,iz ,3)*delx*dely *delzp& +f(ix,iy ,izp,3)*delxp*delyp*delz +f(ixp,iy ,izp,3)*delx*delyp*delz& +f(ix,iyp,izp,3)*delxp*dely *delz +f(ixp,iyp,izp,3)*delx*dely *delz rdelt=60.0/deltat point2=1.0-abs((obstime(i)-gridtime(1))*rdelt) if(point2<0.0)point2=0. point3=1.0-abs((obstime(i)-gridtime(2))*rdelt) if(point3<0.0)point3=0. point1=1.0-point2-point3 g(i)=point1*g(i)+point2*g2(i)+point3*g3(i) end if end do return end