c    @(#)writer.f	1.1
c
c
c
      subroutine writer(tx)
      include'qg_par.inc'
      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/field/psi(mn0,k0),zeta(mn0,k0),tlast,day1,tkeep,
     +   curpsi(mn0,k0),curzet(mn0,k0),psiprv(mn0,k0),zetprv(mn0,k0),
     +     topprv(mn0),topcur(mn0),topdens(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/dynam/alpha,beta,rf
      common/user/pram(16)
      common/unit/iin,iout,idff,idif,iorr,iowr,iplt,ifndd
c
      dimension scratch1(441),scratch2(441)
c
c
       ml=23
       mu=43
       mln=23      
       mun=43


      idate=pram(5)+1+tx/day1 +0.5

          ip=0
          kk=0
        do 20 j=mln,mun
           ip=(j-1)*m+ml-1
         do 10 i=ml,mu   
              ip=ip+1
              kk=kk+1 
              scratch1(kk)=topden(ip)
   10   continue
   20 continue
         write(25)scratch1
c
c ---  now write psi and zeta fields
c
       do 50 k=1,kz
          ip=0
          kk=0 
        do 40 j=mln,mun
            ip=(j-1)*m+ml-1
          do 30 i=ml,mu
              ip=ip+1
              kk=kk+1
              scratch1(kk)=stream(ip,k)
              scratch2(kk)=vort(ip,k)
   30     continue
   40   continue
              write(25)scratch1
              write(25)scratch2
   50  continue 


      return
      end
