subroutine basin_se(pot,n,xin,win,now,nrms,tmean,semiss)
C 06/11/01
C INPUT ARRAYS should be without MISSING values
C
C 03/27/00 if POT<=0.0 TMEAN is UNTRIMMED mean
C
c computes standard error of basin
c trimmed/untrimmed mean/total for input unsorted data array
c
c      n - number of input values
c      x(n) - array of ODSQ standard errors (ODSQse)
c      w(n) - array of corresponding weights (area,volume, etc.)
c      pot  - proportion of data trimmed off each end of x*w
c             or (x*w)**2
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 then w=1 (for unweighted basin total)
c                2 then w=1/n (for unweighted basin mean)
c                3 then w are read-in weights
c      nrms - if 1 then se of basin mean is sum(w*ODSQse)
c                2 then se of basin mean is
c                                   sqrt(sum((w*ODSQse)**2))

       dimension xin(*),win(*)
       double precision s1,s2,w1,w2,sum,wsum,vk
       double precision x(64800),w(64800)
       integer uend

       if(now.eq.1)then
         do i=1,n
          w(i)=1.d0
         enddo
       elseif(now.eq.2)then
         do i=1,n
          w(i)=1.d0/real(n)
         enddo
       else
         do i=1,n
          w(i)=dble(win(i))
         enddo
       endif

       if(nrms.eq.1)then
         do i=1,n
          x(i)=dble(xin(i)) * w(i)
         enddo
       elseif(nrms.eq.2)then
         do i=1,n
          x(i)=dble(xin(i)) * w(i) * dble(xin(i)) * w(i)
         enddo
       endif

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

       p=0.01*pot

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

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

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

        sum=sum-s1-s2
        wsum=wsum-w1-w2
        if (wsum .gt. 0.d0)then
           if(now.le.2) wsum=1.d0
           if(nrms.eq.1)then
              tmean = real( sum / wsum )
           elseif(nrms.eq.2)then
              tmean = real( dsqrt(sum) / wsum )
           else
              tmean = semiss
           endif
        else
           tmean = semiss
        endif

       return
       end
************************************************************
       subroutine findk_se(k,a,a1,n,vkth)
       double precision a(*),a1(*),xx,ww,vkth
       integer r

       l=1
       r=n

       do 1000 while(l .lt. r)
        xx=a(k)
        i=l
        j=r
        do 1010 irept=1,1000000
         do while(a(i) .lt. xx)
         i=i+1
         enddo
         do while(xx .lt. a(j))
         j=j-1
         enddo
         if(i .le. j)then
          ww=a(i)
          a(i)=a(j)
          a(j)=ww
 
          ww=a1(i)
          a1(i)=a1(j)
          a1(j)=ww
 
          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