c
c @(#)stinst.f	1.3
c
      subroutine stinst
c
c
c
      include'mladv.inc'

      parameter(small=1.0e-5,maxit=1000)

      dimension b(lmax)

      common/unit/iin,iout,idff,idif,iorr,iowr,iplt,ifndd

      common/parm/kz,m,mm1,mm2,mp1,msq,tim,tmax,tstart,hy,rea,dt,
     +   xbasin,yy(mx0),icalc,kzp1,kzm1,iftop,ifbot,iftvv,ifrel,theta,
     +   ifsbl,ifeva


      do 1 ip=1,msq

         call findkml(hdpth(ip,mlcur),zml,l,kml)

         do 10 k=kml+1,l
            b(k) = buoy(ip,k,mlcur)+bqgofk(ip,k)
 10       continue

         do 2 k=kml+1,l-1

            ibint = 1
            istat = 0

 12         bint = 0.0

            do 11 kint=1,ibint
               bint = bint + b(k+kint-1) / float (ibint)
 11          continue

            if (bint .lt. b(k+ibint)) then

               if (istat .eq. 0) then
                  istat = 1
                  kstat = k
                endif

               ibint = ibint + 1
               if (k+ibint .lt. l) goto 12

             endif

            if (istat.eq.1) then

               do 23 k1=1,l
                  b(k1) = buoy(ip,k1,mlcur)+bqgofk(ip,k1)
c                 write(98)zml(k1),b(k1)
 23             continue

c              write(96,*)mltime,ip,h,kml,kstat,ibint

               do 13 k1=1,ibint
                  buoy(ip,kstat+k1-1,mlcur) = bint 
     .                                      - bqgofk(ip,kstat+k1-1)
 13             continue

               do 3 k1=1,l
                  b(k1) = buoy(ip,k1,mlcur)+bqgofk(ip,k1)
c                 write(97)zml(k1),b(k1)
  3             continue

              endif

  2       continue


  1    continue

      return
      end
