! source file: /Users/oschlies/UVIC/master/source/mom/filt.F
      subroutine filt (joff, js, je)

!=======================================================================
!     subroutine filt sets up input needed for fourier filtering
!     (when the "fourfil" option is defined) -or- symmetric finite
!     impulse response filtering (when the "firfil" option is defined)
!     of tracers at the specifiied high latitude row "jrow".
!=======================================================================

      include "param.h"
      include "grdvar.h"
      include "index.h"
      include "levind.h"
      include "mw.h"
      dimension tempik(imt,km)

      do n=1,nt
        do j=js,je
          call setbcx (t(1,1,j,n,taup1), imt, km)
        enddo
      enddo

!---------------------------------------------------------------------
!     fourier filter tracers at high latitudes
!---------------------------------------------------------------------

      do j=js,je
        jrow = j + joff
      if ((jrow.gt.jft1.and.jrow.lt.jft2) .or. jrow.lt.jfrst) goto 101
      jj = jrow-jfrst+1
      if (jrow .ge. jft2) jj = jj-jskpt+1

!    if previous strips were of same length, do not recompute
!    fourier coeffs

      isave = 0
      ieave = 0
      do l=1,lsegf
        do k=1,km
          if (istf(jj,l,k) .ne. 0) then
            is    = istf(jj,l,k)
            ie    = ietf(jj,l,k)
            iredo = 0
            if (is.ne.isave .or. ie.ne.ieave) then
              iredo = -1
              isave = is
              ieave = ie
              im = ie-is+1
              if (im.ne.imtm2 .or. kmt(1,jrow).lt.k) then
                m = 1
                n = nint(im*cst(jrow)*cstr(jft0))
              else
                m = 3
                n = nint(im*cst(jrow)*cstr(jft0)*0.5)
              endif
            endif
            do mm=1,nt
              idx  = iredo+mm
              ism1 = is-1
              iea  = ie
              if (ie .ge. imt) iea = imtm1
              do i=is,iea
                tempik(i-ism1,k) = t(i,k,j,mm,taup1)
              enddo
              if (ie .ge. imt) then
                ieb = ie-imtm2
                ii  = imtm1-is
                do i=2,ieb
                  tempik(i+ii,k) = t(i,k,j,mm,taup1)
                enddo
              endif

              call filtr (tempik(1,k), im, m, n, idx)

              do i=is,iea
                t(i,k,j,mm,taup1) = tempik(i-ism1,k)
              enddo
              if (ie .ge. imt) then
                do i=2,ieb
                  t(i,k,j,mm,taup1) = tempik(i+ii,k)
                enddo
              endif
            enddo
          endif
        enddo
      enddo
101   continue
      enddo

      return
      end