program rdflxdat
c
c Read existing COS blocked file written by flux coupler containing 
c   boundary conditions for timesgcm.nmc, and rewrite to new file for 
c   first iter only. This new file will be used to fix boundaries in 
c   the timesgcm nmc.
c (the files may be in /d/foster/flx)
c 12/27: modified for only one iteration, and contour option
c
      parameter (nlon=72,nlat=36,nf=5)
      dimension glb(nlon,nlat)
      dimension iasf(13)
      character*1 fname(nf)
      character*16 lab
      data iasf/13*1/
      data lurd/9/, luwr/0/, iplt/1/
      data fname/'U','V','T','Q','Z'/
c
      open(lurd,file='flx.uvtqz.dat',status='OLD',
     +  form='UNFORMATTED',err=900)
      if (luwr.gt.0)
     +  open(luwr,file='flx.uvtqz.dat',status='NEW',
     +    form='UNFORMATTED',err=901)
      if (iplt.gt.0) then
        call opngks
        call gsclip(0)
        call gsasf(iasf)
        call gsfais(1)
      endif
      do ip=1,nf
        read(lurd) glb
        if (iplt.gt.0) then
          call cpcnrc(glb,nlon,nlat,nlat,0.,0.,0.,0,-1,-1634B)
          write(lab,"('FIELD ',a)") fname(ip)
          call getset(vl,vr,vb,vt,wl,wr,wb,wt,ltyp)
          call plchmq(.5*(wl+wr),wt-.02,lab(1:7),20.,0.,0.)
          call frame
          write(6,"('Contoured field at ip=',i3)") ip
        endif
        if (luwr.gt.0) then
          write(luwr) glb
          write(6,"('Wrote data to unit ',i3,' at ip=',i3)")
     +      luwr,ip
        endif
      enddo
      close(lurd)
      if (luwr.gt.0) close(luwr)
      if (iplt.gt.0) call clsgks
      stop 'done'
 900  write(6,"('>>> Error opening old file')")
      stop 'lurd'
 901  write(6,"('>>> Error opening new file')")
      stop 'luwr'
      end