      subroutine plt
c
c bf 4/8/93:
c Contour arrays from gwave2d (replaces old calcon calls):
c
      PARAMETER (MX=21,ITMX=21,MZ=96,KMX=96,MT=50,NV=2,KMXP=96)
      PARAMETER(NHTINT=68,HT1=66.,DHT=2.)
c
      common/pcontour/ ETNN(MX,MZ),UWIND(MX,MZ),VWIND(MX,MZ),
     +  WWIND(MX,MZ),ZHT(MX,MZ),
     +  PKE(MX,MZ),pui(mx,mz),pvi(mx,mz),pwi(mx,mz),pwgam(mx,mz),
     +  POX(MX,MZ),PNE(MX,MZ),PO(MX,MZ),PO3(MX,MZ),PHOX(MX,MZ),
     +  PH(MX,MZ),POH(MX,MZ),PHO2(MX,MZ),PNOZ(MX,MZ),PNO(MX,MZ),
     +  PNO2(MX,MZ),PN4S(MX,MZ),PLNAS(MX,MZ),PLNASP(MX,MZ),
     +  eun(mx,mz),ewn(mx,mz),eke(mx,mz),UWINDZ(MX,MZ),
     +  EDDT(MX,MZ),TNPER(MX,MZ),HTINT(NHTINT),FINT(MX,NHTINT),x(mx)
      parameter (nplt=24)
      dimension fplt(mx,mz,nplt)
      equivalence(fplt,etnn)	! etn -> plnasp for contour loop
c
      common/ehist/shto(mz),eox(mx,mz),eo(mx,mz),eo3(mx,mz),ehox(mx,mz),
     +  eh(mx,mz),eho2(mx,mz),eoh(mx,mz),enoz(mx,mz),eno(mx,mz),
     +  eno2(mx,mz),en4s(mx,mz),enas(mx,mz),enasp(mx,mz),ene(mx,mz),
     +  etion(mx,mz),eo2(mx,mz),en2(mx,mz),eo1d(mx,mz),ete(mx,mz),
     +  eti(mx,mz),etn(mx,mz),eiop(mx,mz),en2d(mx,mz),enh2o(mx,mz),
     +  enh2(mx,mz),ench4(mx,mz),enh2o2(mx,mz),enco(mx,mz),enco2(mx,mz)
     +  ,enax(mx,mz),enao(mx,mz),enao2(mx,mz),enaoh(mx,mz)
c
      include "blank.h"
      COMMON/TIMETRF/TIMEE
      common/iyrday/IYD
c
      character*8 flab(nplt)
      character*56 toplab
      data flab /
     +  'TN      ','UWIND   ','VWIND   ','WWIND   ','ZHT     ',
     +  'EKE     ','UI      ','VI      ','WI      ','WGAM    ',
     +  'XNOX    ','XNE     ','XNO     ','XNO3    ','XNHOX   ',
     +  'XNH     ','XNHOH   ','XNHO2   ','NOZ     ','XNNO    ',
     +  'XNNO2   ','XN4S    ','XNAS    ','XNASP   '/
      dimension vp(4)
c
      call cpset(x,itmx,zp,kmx,vp,xmid) ! vp(4) and xmid are returned
      etnn(:,:) = etn(:,:)
      finc = -6. ! number of contour levels for cpcnrc
c
c Zp on y-axis:
c
      write(6,"('plt contouring ',i2,' fields with zp on y-axis: ',
     +  ' time=',f5.2,' f107=',f5.1,' day=',i5)") nplt,timee,f107,iyd
      do ip=1,nplt
        call cpcnrc(fplt(1,1,ip),itmx,itmx,kmx,0.,0.,finc,1,-1,-1634B)
        call labrect(x,itmx,zp,kmx,'XDIST','ZPRES',0.)
        call clearstr(toplab)
        write(toplab,"('FIELD=',a,' TIME=',f5.1,' F107=',f5.1,
     +    ' DAY=',i5)") flab(ip),timee,f107,iyd
        call wrlab(toplab(1:lenstr(toplab)),xmid,vp(4)+.05,.018)
        call frame
      enddo
c
c Contour fields interpolated to height scale (ht on y-axis)
c (originally added with old calcon by bf 5/1/90)
c
      call cpset(x,itmx,htint,nhtint,vp,xmid)
      write(6,"('plt contouring ',i2,' fields with ht on y-axis: ',
     +  ' time=',f5.2,' f107=',f5.1,' day=',i5)") nplt,timee,f107,iyd
      write(6,"('plt: nhtint=',i3,' htint=',/(6e12.4))") nhtint,htint
      do ip=1,nplt
        call twodint(fplt(1,1,ip),zht,itmx,kmx,fint,htint,nhtint,0,0)
        call cpcnrc(fint,itmx,itmx,nhtint,0.,0.,finc,1,-1,-1634B)
        call labrect(x,itmx,htint,nhtint,'XDIST','HT (KM)',0.)
        call clearstr(toplab)
        write(toplab,"('FIELD=',a,' TIME=',f5.1,' F107=',f5.1,
     +    ' DAY=',i5)") flab(ip),timee,f107,iyd
        call wrlab(toplab(1:lenstr(toplab)),xmid,vp(4)+.05,.018)
        call frame
      enddo
c
      return
      end
c
c----------------------------------------------------------------------
c
      subroutine labrect(xx,nx,yy,ny,xlab,ylab,chsize)
c
c Draw axes and axis numeric and char labels for any rectangular
c plot (not called for elliptical projections) -- uses autograph
c
c On input:
c   xx(nx) array of nx x-coord values (e.g., -180 -> 180)
c   yy(ny) array of ny y-coord values (e.g., -87.5 -> 87.5)
c
      dimension xx(nx),yy(ny)
      character*(*) xlab,ylab
      character*56 blank56
      data blank56
     + /'                                                        '/
c
      call agseti("SET.",4)
      if (chsize.le.0.) then
        charsz = .025
      else
        charsz = chsize
      endif
c
c x-axis:
c
      call agsetc("LABEL/NAME.","B")
      call agseti("LINE/NUMBER.",-100)
      call agsetf("LINE/CHARACTER.",charsz)
      call agsetc("LINE/TEXT.",xlab)
      call agsetf ('AXIS/BOTTOM/NUMERIC/WIDTH/MANTISSA.', charsz)
c
c y-axis:
c
      call agsetc("LABEL/NAME.","L")
      call agseti("LINE/NUMBER.",100)
      call agsetf("LINE/CHARACTER.",charsz)
      call agsetc("LINE/TEXT.",ylab)
      call agsetf ('AXIS/LEFT/NUMERIC/WIDTH/MANTISSA.', charsz)
c
c Disable top label:
c
      call agsetc("LABEL/NAME.","T")
      call agsetr("LABEL/DEF/SUPPRESSION.",1.)
c
c Draw the background
c
      call agstup(xx,1,0,nx,1, yy,1,0,ny,1)
      call agback
c
c Reenable top label:
c
      call agsetc("LABEL/NAME.","T")
      call agsetr("LABEL/DEF/SUPPRESSION.",0.)
c
      return
      end
c
c------------------------------------------------------------------
c
      subroutine wrlab(lab,xpos,ypos,chsize)
      character*(*) lab
c
c Add bottom label to plot centered at xpos,ypos (virtual coords):
c
      call getset(vl,vr,vb,vt,wl,wr,wb,wt,lnlg)
      if (chsize.le.0.) then
        charsz = .015
      else
        charsz = chsize
      endif
      call set(0.,1.,0.,1.,0.,1.,0.,1.,1)
      call plchhq(xpos,ypos,lab,charsz,0.,0.)
      call set(vl,vr,vb,vt,wl,wr,wb,wt,lnlg)
      return
      end
c
c------------------------------------------------------------------
c
      function lenstr(str)
      character*(*) str
c
c Return index to last non-blank char in str
c
      length = len(str)
      do i=length,1,-1
        if (str(i:i).ne.' ') then
          lenstr = i
          return
        endif
      enddo
      lenstr = 0
      return
      end
c
      subroutine clearstr(str)
c 
c Set given string to all blanks 
c 
      character*(*) str
      length = len(str)
      do i=1,length
        str(i:i) = ' '
      enddo
      return
      end
c
c------------------------------------------------------------------
c
      subroutine cpset(x,nx,y,ny,vport,xxmid)
c
c Prepare conpack for contouring (return vport and xxmid):
c
      dimension vp(4),vport(4),x(nx),y(ny)
      data vp /.15,.89,.26,.91/
      dimension cpcit(10),icplit(10) 
      data cpcit /1.0, 1.5, 2.0, 2.5, 3.0, 4.0, 5.0, 6.0, 7.0, 7.5/
      data icplit/  2,   2,   2,   2,   2,   2,   2,   2,   2,   2/
c
      xmid = 0.5*(vp(1)+vp(2))
      call pcseti('QU',2) ! use low quality chars
      call cpsetr('SPV',1.e36)
      call cpsetc('ILT','MIN $ZMN$, MAX $ZMX$, INT $CIU$')
      call cpsetr('ORV',1.e12)
      call cpseti('LLP',2)
      call cpsetr('LLS',.02)
      call cpsetr('RC2',.5)
      call cpseti('LLO',1) 
      call cpsetr('XC1',x(1))
      call cpsetr('XCM',x(nx))
      call cpsetr('YC1',y(1))
      call cpsetr('YCN',y(ny))
      call cpsetr('ILX',xmid)
      call cpsetr('ILY',-.16)
      call cpsetr('ILS',.025)
      call cpseti('ILP',0)
      do i=1,10
        call cpseti('PAI -- parameter array index',i)
        call cpsetr('CIT -- contour interval table',cpcit(i))
        call cpseti('LIT -- label interval table',icplit(i))
      enddo
      call set(vp(1),vp(2),vp(3),vp(4),x(1),x(nx),y(1),y(ny),1)
      vport(:) = vp(:)
      xxmid = xmid
      return
      end
