subroutine intrp2a(f,g,dx,dy,n,nlevs,mype) !$$$ subprogram documentation block ! . . . . ! subprogram: intrp2a ! prgmmr: parrish org: np22 date: 1990-10-11 ! ! abstract: linear interpolate in 2 dimensions over n levels ! ! program history log: ! 1990-10-11 parrish ! 1998-04-05 weiyu yang ! 1999-08-24 derber, j., treadon, r., yang, w., first frozen mpp version ! 2003-12-22 kleist, modified to perform 2-d interpolation over a ! specified number of vertical levels ! 2004-05-17 kleist, documentation ! 2004-08-02 treadon - add only to module use, add intent in/out ! 2006-04-03 derber - optimize ! 2008-05-31 safford - rm unused use ! ! input argument list: ! f - input interpolator ! dx,dy - input x,y -coords of interpolation points (grid units) ! n - number of interpolatees in each pe subdomain ! nlevs - number of vertical levels over which to perform the ! 2-d intrpolation ! mype - mpi task id ! ! output argument list: ! g - output interpolatees ! ! remarks: see modules used ! ! attributes: ! language: f90 ! machine: ibm RS/6000 SP ! !$$$ use kinds, only: r_kind,i_kind use gridmod, only: istart,jstart,lon1,lat2,lon2,nlat,nlon use constants, only: zero,one implicit none ! Declare passed variables integer(i_kind) ,intent(in ) :: mype,n,nlevs real(r_kind),dimension(n) ,intent(in ) :: dx,dy real(r_kind),dimension(lat2,lon2,nlevs),intent(in ) :: f real(r_kind),dimension(nlevs,n) ,intent( out) :: g ! Declare local variables integer(i_kind) mm1,k,i,ix1,iy1,ix,iy,ixp,iyp real(r_kind) delx,dely,delxp,delyp mm1=mype+1 do i=1,n ix1=int(dx(i)) iy1=int(dy(i)) ix1=max(1,min(ix1,nlat)) delx=dx(i)-float(ix1) dely=dy(i)-float(iy1) delx=max(zero,min(delx,one)) ix=ix1-istart(mm1)+2 iy=iy1-jstart(mm1)+2 if(iy<1) then iy1=iy1+nlon iy=iy1-jstart(mm1)+2 end if if(iy>lon1+1) then iy1=iy1-nlon iy=iy1-jstart(mm1)+2 end if ixp=ix+1; iyp=iy+1 if(ix1==nlat) then ixp=ix end if delxp=one-delx; delyp=one-dely do k=1,nlevs g(k,i)=f(ix,iy,k)*delxp*delyp+f(ixp,iy,k)*delx*delyp& +f(ix,iyp,k)*delxp*dely+f(ixp,iyp,k)*delx*dely end do end do return end subroutine intrp2a subroutine intrp2a1(f,g,dx,dy,nlevs,mype) !$$$ subprogram documentation block ! . . . . ! subprogram: intrp2a1 ! prgmmr: parrish org: np22 date: 2013-01-26 ! ! abstract: same as intrp2a but for special case n=1, with n argument removed. ! This has been created to solve problem of type mismatch debug compile ! error on WCOSS. ! ! program history log: ! 2013-01-26 parrish ! ! input argument list: ! f - input interpolator ! dx,dy - input x,y -coords of interpolation points (grid units) ! nlevs - number of vertical levels over which to perform the ! 2-d intrpolation ! mype - mpi task id ! ! output argument list: ! g - output interpolatees ! ! remarks: see modules used ! ! attributes: ! language: f90 ! machine: ibm RS/6000 SP ! !$$$ use kinds, only: r_kind,i_kind use gridmod, only: istart,jstart,lon1,lat2,lon2,nlat,nlon use constants, only: zero,one implicit none ! Declare passed variables integer(i_kind) ,intent(in ) :: mype,nlevs real(r_kind) ,intent(in ) :: dx,dy real(r_kind),dimension(lat2,lon2,nlevs),intent(in ) :: f real(r_kind),dimension(nlevs) ,intent( out) :: g ! Declare local variables integer(i_kind) mm1,k,ix1,iy1,ix,iy,ixp,iyp real(r_kind) delx,dely,delxp,delyp mm1=mype+1 ix1=int(dx) iy1=int(dy) ix1=max(1,min(ix1,nlat)) delx=dx-float(ix1) dely=dy-float(iy1) delx=max(zero,min(delx,one)) ix=ix1-istart(mm1)+2 iy=iy1-jstart(mm1)+2 if(iy<1) then iy1=iy1+nlon iy=iy1-jstart(mm1)+2 end if if(iy>lon1+1) then iy1=iy1-nlon iy=iy1-jstart(mm1)+2 end if ixp=ix+1; iyp=iy+1 if(ix1==nlat) then ixp=ix end if delxp=one-delx; delyp=one-dely do k=1,nlevs g(k)=f(ix,iy,k)*delxp*delyp+f(ixp,iy,k)*delx*delyp& +f(ix,iyp,k)*delxp*dely+f(ixp,iyp,k)*delx*dely end do return end subroutine intrp2a1 subroutine intrp2a11(f,g,dx,dy,mype) !$$$ subprogram documentation block ! . . . . ! subprogram: intrp2a ! prgmmr: parrish org: np22 date: 2013-01-26 ! ! abstract: same as intrp2a but for special case n=1 and nlevs=1, with n,nlevs arguments removed. ! This has been created to solve problem of type mismatch debug compile ! error on WCOSS. ! ! program history log: ! 2013-01-26 parrish ! ! input argument list: ! f - input interpolator ! dx,dy - input x,y -coords of interpolation points (grid units) ! mype - mpi task id ! ! output argument list: ! g - output interpolatees ! ! remarks: see modules used ! ! attributes: ! language: f90 ! machine: ibm RS/6000 SP ! !$$$ use kinds, only: r_kind,i_kind use gridmod, only: istart,jstart,lon1,lat2,lon2,nlat,nlon use constants, only: zero,one implicit none ! Declare passed variables integer(i_kind) ,intent(in ) :: mype real(r_kind) ,intent(in ) :: dx,dy real(r_kind),dimension(lat2,lon2) ,intent(in ) :: f real(r_kind) ,intent( out) :: g ! Declare local variables integer(i_kind) mm1,ix1,iy1,ix,iy,ixp,iyp real(r_kind) delx,dely,delxp,delyp mm1=mype+1 ix1=int(dx) iy1=int(dy) ix1=max(1,min(ix1,nlat)) delx=dx-float(ix1) dely=dy-float(iy1) delx=max(zero,min(delx,one)) ix=ix1-istart(mm1)+2 iy=iy1-jstart(mm1)+2 if(iy<1) then iy1=iy1+nlon iy=iy1-jstart(mm1)+2 end if if(iy>lon1+1) then iy1=iy1-nlon iy=iy1-jstart(mm1)+2 end if ixp=ix+1; iyp=iy+1 if(ix1==nlat) then ixp=ix end if delxp=one-delx; delyp=one-dely g=f(ix,iy)*delxp*delyp+f(ixp,iy)*delx*delyp& +f(ix,iyp)*delxp*dely+f(ixp,iyp)*delx*dely return end subroutine intrp2a11