
      program rddatv
c
c Read data volume
c
c     parameter(imx=73,imxp3=imx+3,kmx=25,jmx=36)
      parameter(imx=73,imxp3=imx+3,kmx=45,jmx=36)
      parameter(nflddat=6,nfdatv=12,ntndown=26)
      character*8 datlab(nfdatv+1)
      character*24 msspath, disk, tnlab
      common/datlb/ wrlb(jmx,ntndown+nfdatv),fdatv(imxp3*kmx*nflddat),
     +  tndown(jmx,ntndown),datlab,msspath
      character*4 lbnames(nfdatv)
      dimension iasf(13)
      data iasf/13*1/
      data datlab 
     +  /'XH2OLB  ','XH2LB   ','XCOLB   ','XCO2LB  ','TNGRND  ',
     +   'TNLB    ','ZLB     ','UNLB    ','XOXLB   ','XNOZLB  ',
     +   'XHOXLB  ','XCH4LB  ','TNDOWN  '/
c
c timesgcm volumes:
c     data msspath     /'/FOSTER/TIMEDATV/EQSM01Z'/ 
c     data disk        /'/usr/tmp/TIGCM/EQSM01Z  '/
      data msspath     /'/FOSTER/TIMEDATV/SOLM01Z'/ 
      data disk        /'/usr/tmp/TIGCM/SOLM01Z  '/
c
c timegcm volumes:
c     data msspath     /'/FOSTER/TIMEDATV/EQSM01 '/ 
c     data msspath     /'/FOSTER/TIMEDATV/SOLM01 '/ 
c     data disk        /'/usr/tmp/TIGCM/EQSM01   '/
c     data disk        /'/usr/tmp/TIGCM/SOLM01   '/
c
      data lu/8/
      data ludata/-90/, iplt/1/
      data lbnames /'H2O ','H2  ','CO  ','CO2 ','TNG ','TN  ',
     +              'HT  ','UN  ','OX  ','NOZ ','HOX ','CH4 '/
c
c Acquire data vol:
      lenmss = lenstr(msspath)
      lendisk = lenstr(disk)
      write(6,"('Doing msread of ',a,'...')") msspath(1:lenmss)
      call msread(ierr,disk(1:lendisk),msspath(1:lenmss),' ',' ')
      if (ierr.eq.3) then
        write(6,"('rddatv: msread found file ',a,' on the disk',
     +            /9x,'and did not read mss file ',a)")
     +            disk(1:lendisk),msspath(1:lenmss)
      elseif (ier.ne.0) then
        call mserror(errmsg)
        write(6,"('rddatv: msread error ',i3,' errmsg=',a)")
     +    ier,errmsg
      else
        write(6,"('rddatv: successful msread of mss file ',a,' to ',
     +    /'  unicos file ',a)") msspath(1:lenmss),disk(1:lendisk)
      endif
      call assgn(disk(1:lendisk),lu,ier)
      if (ier.ne.0) then
        write(6,"('>>> rddatv: error ',i3,' from assgn')") ier
      endif
c
c Read lat slice data:
      lbtap = imxp3*kmx*nflddat
      do j=1,jmx
        buffer in(lu,1)(fdatv(1),fdatv(lbtap))
      enddo
c
c Read in lower boundaries:
c 9/91: lower boundaries for h2o,h2,co,co2,h,oh,o,o3,ho2,no2,no
c       are found from acd 2d model (see ~/acd2d), and are
c       stored on the data volume.
c
      buffer in(lu,1)(wrlb(1),wrlb(jmx,ntndown+nfdatv))
c
c     do ip=1,nfdatv
c       write(6,"('rddatv lower bounds: ip=',i3,' field ',a,'=',
c    +    /(6e12.4))") ip,lbnames(ip),(wrlb(j,ip),j=1,jmx)
c     enddo
c     do ip=1,ntndown
c       write(6,"('tndown: ip=',i3,' tn=',/(6e12.4))") ip,
c    +    (wrlb(j,nfdatv+ip),j=1,jmx)
c     enddo
c
c Write data statements of lower bounds:
c     subroutine wrdata(x,n,lab,lu)
c
      do ip=1,ntndown
        tndown(:,ip) = wrlb(:,nfdatv+ip)
      enddo
      if (ludata.gt.0) then
        call assgn('lowbnd.data',ludata,ier)
        do ip=1,nfdatv
          call wrdata(wrlb(1,ip),jmx,datlab(ip),ludata)
        enddo
        do ip=1,26
          write(tnlab,"('(TNDOWN(JJ,',i2,'),JJ=1,ZJMX)')") ip
          call wrdata(tndown(1,ip),jmx,tnlab,ludata)    
        enddo
      endif 
c
c Make plots:
c
      if (iplt.gt.0) then
        call opngks
        call gsclip(0)
        call gsasf(iasf)
        call gsfais(1)
        call pltdatv
        call clsgks
      endif
      stop
      end
c
c------------------------------------------------------------------
c
      subroutine assgn(dname,lu,ier)
c
c Attach file dname to unit lu (dname and lu defined on input)
c 11/91: Like assign.f, but took out nblocks, and changed the ishell
c        command to a call assign to avoid the fork necessary in ishell
c
      character*(*) dname
      character fmt*120, cmnd*120
c
c Check input:
c
      ier = 0
      idch = lenstr(dname)
      if (idch.le.0.or.idch.gt.99) then
        write(6,"('assgn: bad dname: idch=',i3,' dname=',a)") 
     +    idch,dname
        ier = 1
        return
      endif
      if (lu.le.0.or.lu.gt.99) then
        write(6,"('assgn: bad lu=',i5,'(dname=',a,')')") lu,dname
        ier = 2
        return
      endif
c
c Make format for 'assign -a flnm' part of command:
c
      write(fmt(1:15),"('(''assign -a '',A')")
      if (idch.lt.10) then     
        write(fmt(16:16),"(i1)") idch
        nfmt = 16
      elseif (idch.lt.100) then
        write(fmt(16:17),"(i2)") idch
        nfmt = 17
      endif
c
c Add format for lu part of command:
c
      if (lu.lt.10) then
        write(fmt(nfmt+1:nfmt+16),"(','' fort.'',I1)')")
      elseif (lu.lt.100) then
        write(fmt(nfmt+1:nfmt+17),"(','' fort.'',I2)')")
      endif
      nfmt = nfmt+16
c
c Make the command, using format just made:
c
      write(cmnd,fmt) dname(1:idch),lu
      ncmnd = lnblnk2(cmnd)
c
c Execute the command and check status:
c
      istat = 999
      call assign(cmnd(1:ncmnd),istat)
      if (istat.ne.0) then
        write(6,"('assign: bad return from call assign=',i5)") istat
        write(6,"('        command=',a)") cmnd(1:ncmnd)
        ier = 3
        return
      else
        write(6,"('assgn: successful assign of unit ',i3,
     +    ' to file ',a)") lu,dname(1:idch)
      endif
      return
      end
c
c------------------------------------------------------------------
c
      subroutine wrdata(x,n,lab,lu)
c
c This writes a data statement of x(n) to unit lu, using
c lab as the variable name.
c (B.Foster 2/92)
c
      dimension x(n)
      character*(*) lab
      character*72 dline
c
      num = n/5
      leftover = mod(n,5)
      write(lu,"('C')")
      write(lu,"('C Data statement for ',a)") lab
      write(lu,"('C')")
      write(lu,"('      DATA ',a,' /')") lab
      do i=1,num-1
        i1 = (i-1)*5+1
        write(lu,"('     +',5(e12.5,','))") (x(ii),ii=i1,i1+4)
      enddo
      if (leftover.gt.0) then
        i1 = (num-1)*5+1
        write(lu,"('     +',5(e12.5,','))") (x(ii),ii=i1,i1+4)
        write(dline,"('(''     +'',',I1,'(E12.5,'',''),E12.5,''/'')')") 
     +    leftover-1
        write(lu,dline) (x(ii),ii=num*5+1,n)
      else
        i1 = (num-1)*5+1
        write(lu,"('     +',4(e12.5,','),e12.5,'/')") 
     +    (x(ii),ii=i1,i1+4)
      endif
c
      return
      end
