c    @(#)wget.f	1.6
      subroutine wget
c
c leonard walstad
c
c 5/84
c
c
c
c routine to calculate u,v,w from the q-g streamfunction, vorticity
c and surface density.
c
c----------------------------------------------------------------------
c
c
      include'mladv.inc'
c
c
c
c
c----------------------------------------------------------------------
c
c variables needed from the qg model.
c
      common/scrat/r(mn0),r1(mn0),r2(mn0),r3(mn0)
      common/fields/vort(mn0,k0),stream(mn0,k0),prvjac(mn0,k0),
     +     topden(mn0),botden(mn0),relief(mn0),prvtop(mn0),
     +     prvbot(mn0),topfct(k0),botfct(k0),pvort(mn0)
      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
                
      common/threed/hz(k0),scsig,sigz(k01),eigval(k0),ainv(k0,k0),
     +              amat(k0,k0)
      common/user/pram(16)
      common/dynam/alpha,beta,rf
      common/unit/iin,iout,idff,idif,iorr,iowr,iplt,ifndd
      common /cnn/ n, nm1, nm2, np1
      common /extpar/ rlat0, rlng0, t0, v0, dhor, ht, time0,
     +                r0,f0star
c
c
c----------------------------------------------------------------------
c
c
      data iwcur/1/, iwpast/2/, cnew/0.0/, cold/0.0/, icw/0/
c
c
      if (ifrst .eq. 1) then
         cnew = 1.5
         cold = -.5
       endif
c
c
c  first move the streamfunction into r
c
      do 10 ip=1,msq
        r(ip)=strm0(ip)
   10 continue
c
      itmp=iwcur
      iwcur=iwpast
      iwpast=itmp
c
      fact=1.0/hz(1)
      fact2=-2.0*scsig*sigz(2)/(hz(1)+hz(2))
c
      do 50 ip=1,msq
        szz(ip,iwcur)=fact*(topden(ip)+
     .                      fact2*(stream(ip,1)-stream(ip,2)))
        if (icw .lt. iwskip) then
           szz(ip,iwpast) = szz(ip,iwcur)
         endif
   50 continue
c
c
c

c
c
c
c
      icw=icw+1
      fact=1.0/dt
      if (icw .ge. iwskip) then
         fact2 = -r0*v0/dhor
        else
         fact2 = 0.0
       endif

      do 60 ip=1,msq
        wzvel(ip)=fact2*(fact*(szz(ip,iwcur)-szz(ip,iwpast))
     .            +cnew*adv(ip,iwcur)+cold*adv(ip,iwpast))
   60 continue

c      call filter(wzvel,m,n,nord)

      fact=alpha/hy/hy
      call darajac(stream(1,1),szz(1,iwcur),adv(1,iwpast),m,n,fact)
      if(icw.gt.2)return
      cnew=1.0
      if(icw.eq.1)return
      cnew=1.5
      cold=-.5
c
c
c
      return
      end
