cat > param.grid << '\eof'
c     +++param.grid+++
cc  major dimensions
      parameter(nx=126,ny=126,nz=81)
      parameter(nxyz=nx*ny*nz)
'\eof'

cat > src.for << '\eof'
      program data_save
cc
      include 'param.grid'

cc  grid (for regular dzeta isosurfaces)
      data dx,dy,dz,dt /400.,400.,300.,6./
      common/grid/ time,dt,dx,dy,dz,dti,dxi,dyi,dzi

CC  MODEL VARIABLES
      real*8 theta(nx,ny,nz),qv(nx,ny,nz),qc(nx,ny,nz),qr(nx,ny,nz)
      real*8 qid(nx,ny,nz),qir(nx,ny,nz)
      real*8 qcn(nx,ny,nz),qrn(nx,ny,nz),qin(nx,ny,nz)
      real*8 ux(nx,ny,nz),uy(nx,ny,nz),uz(nx,ny,nz) 

CC SINGLE PRECISION:
      real*4 ths(nx,ny,nz),qvs(nx,ny,nz),qcs(nx,ny,nz),qrs(nx,ny,nz)
      real*4 qids(nx,ny,nz),qirs(nx,ny,nz)
      real*4 qcns(nx,ny,nz),qrns(nx,ny,nz),qins(nx,ny,nz)
      real*4 uxs(nx,ny,nz),uys(nx,ny,nz),uzs(nx,ny,nz) 

cc analysis of the tape: 6hrs, data every 6 min
      parameter(nt=1+10*6)


                  do icas=1,2
                   print*,'---+++ case: ',icas
                  do itap=1,3
                   print*,'---+++ tape: ',itap

c PRIS.NW driving:
       if(icas.eq.1 .and. itap.eq.1) then
       open(17,file='../../RUN1/fort.17.nowind1',form='unformatted',
     1        status='old')
       endif
       if(icas.eq.1 .and. itap.eq.2) then
       open(17,file='../../RUN1/fort.17.nowind2',form='unformatted',
     1        status='old')
       endif
       if(icas.eq.1 .and. itap.eq.3) then
       open(17,file='../../RUN1/fort.17.nowind3',form='unformatted',
     1        status='old')
       endif

c ADCN.NW driving:
       if(icas.eq.2 .and. itap.eq.1) then
       open(17,file='../../RUN71/fort.17.nowind1',form='unformatted',
     1        status='old')
       endif
       if(icas.eq.2 .and. itap.eq.2) then
       open(17,file='../../RUN71/fort.17.nowind2',form='unformatted',
     1        status='old')
       endif
       if(icas.eq.2 .and. itap.eq.3) then
       open(17,file='../../RUN71/fort.17.nowind3',form='unformatted',
     1        status='old')
       endif

cc skip 6 hours...
          do it=1,10*6
       read(17) 
       read(17) 
       read(17) 
       read(17) 
       read(17) 
       read(17) 
          enddo

cc 360 min:
          do it=1,1

         if(icas.eq.1) then
       read(17) !time,nx1,ny1,nz1
       read(17) ux,uy,uz
       read(17) theta,qv,qc,qr,qcn,qrn
       read(17) qid,qir,qin
       read(17) theta7,qv7,qc7,qr7,qcn,qrn
       read(17) qid7,qir7qin7
         endif
         if(icas.eq.2) then
       read(17) !time,nx1,ny1,nz1
       read(17) ux,uy,uz
       read(17) theta7,qv7,qc7,qr7,qcn,qrn
       read(17) qid7,qir7,qin7
       read(17) theta,qv,qc,qr,qcn,qrn
       read(17) qid,qir,qin
         endif

           do i=1,nx
           do j=1,ny
           do k=1,nz
      ths(i,j,k)=theta(i,j,k)
      qvs(i,j,k)=qv(i,j,k)
      qcs(i,j,k)=qc(i,j,k)
      qrs(i,j,k)=qr(i,j,k)
      qids(i,j,k)=qid(i,j,k)
      qirs(i,j,k)=qir(i,j,k)
      qcns(i,j,k)=qcn(i,j,k)
      qrns(i,j,k)=qrn(i,j,k)
      qins(i,j,k)=qin(i,j,k)
      uxs(i,j,k)=ux(i,j,k)
      uys(i,j,k)=uy(i,j,k)
      uzs(i,j,k)=uz(i,j,k)
          enddo
          enddo
          enddo
       write(19) ths,qvs,qcs,qrs,qids,qirs,qcns,qrns,qins,uxs,uys,uzs 

          enddo

          close(17)

          enddo   ! tapes...

          enddo   ! case...


        stop
        end

'\eof'
ncargf77 src.for