subroutine trimmer(pot,n,x,w,now,tmean,bmiss)
C 05/21/07 corrected computation of UEND
c 06/12/01 basin total computation is added
C 03/27/00 if POT<=0.0 TMEAN is UNTRIMMED mean
c computes trimmed mean for input unsorted data array
c      n - number of input values
c      x(n) - input data array
c      w(n) - array of corresponding weights
c      pot  - proportion of data trimmed off each end of x(n)
c             e.g., pot=5 means 5% of the smallest and 
c             5% of the biggest input values will not be used
c             to compute the trimmed mean 
c      now  - if 1 unweighted basin total
c                2 unweighted basin mean
c                3 weighted basin mean (read-in weights)

       dimension x(*),w(*)
       integer uend

       if(now.le.2)then
         do i=1,n
          w(i)=1.
         enddo
       endif

       do i=1,n
         x(i)=x(i)*w(i)
       enddo

       if(pot.le.0.0)then
          s1=0.
          s2=0.
          w1=0.
          w2=0.
          goto 100
       endif

       p=0.01*pot

       lend=nint(p*n)
       call findk2(lend,x,w,n,vk)
       s1=0.
       w1=0.
       do i=1,lend
         s1=s1+x(i)
         w1=w1+w(i)
       enddo

c      uend=nint((1.-p)*n)
       uend=n-lend+1
       call findk2(uend,x,w,n,vk)
       s2=0.
       w2=0.
c      do i=uend+1,n
       do i=uend,n
         s2=s2+x(i)
         w2=w2+w(i)
       enddo

 100   sum=0.
       wsum=0.
       do i=1,n
        sum=sum+x(i)
        wsum=wsum+w(i)
       enddo

        sum=sum-s1-s2
        wsum=wsum-w1-w2
        if (wsum .ne. 0.)then
          if(now.eq.1)then
           tmean=sum
          else
           tmean=sum/wsum
          endif
        else
           tmean=bmiss
        endif

       return
       end
************************************************************
       subroutine findk2(k,a,a1,n,vkth)
       dimension a(*),a1(*)
       integer r

       l=1
       r=n

       do 1000 while(l .lt. r)
        x=a(k)
        i=l
        j=r
        do 1010 irept=1,1000000
         do while(a(i) .lt. x)
         i=i+1
         enddo
         do while(x .lt. a(j))
         j=j-1
         enddo
         if(i .le. j)then
          w=a(i)
          a(i)=a(j)
          a(j)=w
c
          w=a1(i)
          a1(i)=a1(j)
          a1(j)=w
c
          i=i+1
          j=j-1
         endif
         if(i .gt. j) goto 2000
1010  continue
2000  if(j .lt. k) l=i
      if(k .lt. i) r=j
1000  continue
      vkth=a(k)
      return
      end