
      subroutine labce(chx,nx,chy,ny,xlab,ylab,toplab,iclrbar,icolor,
     +  labform,icella,kpbar,kpgraph,mt,jday1)
c 
c Label a cylindrical equidistant plot (axes, etc):
c
      character*(*) chx(nx),chy(ny),xlab,ylab,toplab(2)
      character*1 fc
      character*8 labform
      character*10 labclv
      dimension cbport(4),lfin(256),mt(3)
      data ynumoff/.05/, xnumoff/.04/, cbnumoff/.015/
      data ylaboff/.1/, xlaboff/.09/
      data ticlen/.016/
      data top1off/.10/, top2off/.04/
      data labclv /'          '/
c
c Change function code delimiter (default is colon, and we use that
c for time label day:hr:min
c
      call pcgetc('FC',fc)
      call pcsetc('FC','$')
c
c Draw perimeter, and get into fractional coords:
      call getset(vl,vr,vb,vt,wl,wr,wb,wt,lin)
      call sflush
      call gsplci(1)
      call line(wl,wb,wr,wb)
      call line(wr,wb,wr,wt)
      call line(wr,wt,wl,wt)
      call line(wl,wt,wl,wb)
      call set(0.,1.,0.,1.,0.,1.,0.,1.,1)
      charsize = .03*(vr-vl)
      xmid = 0.5*(vr+vl)
      ymid = 0.5*(vt+vb)
c
c X-axis (black tic marks if color):
      do i=1,nx
        xpos = vl + float(i-1)/float(nx-1)*(vr-vl)
        if (icolor.gt.0) then
          call sflush
          call gsplci(1)
        endif
        call plchhq(xpos,vb-xnumoff,chx(i),charsize,0.,0.)
        if (icolor.gt.0) then
          call sflush
          call gsplci(0)
        endif
        if (i.ne.1.and.i.ne.nx) then
          call line(xpos,vb,xpos,vb+ticlen)
          call line(xpos,vt,xpos,vt-ticlen)
        endif
      enddo
      if (icolor.gt.0) then
        call sflush
        call gsplci(1)
      endif
      call plchhq(xmid,vb-xlaboff,xlab,charsize,0.,0.)
c
c Y-axis (black tic marks if color):
      do i=1,ny
        ypos = vb + float(i-1)/float(ny-1)*(vt-vb)
        if (icolor.gt.0) then
          call sflush
          call gsplci(1)
        endif
        call plchhq(vl-ynumoff,ypos,chy(i),charsize,0.,0.)
        if (icolor.gt.0) then
          call sflush
          call gsplci(0)
        endif
        if (i.ne.1.and.i.ne.ny) then
          call line(vl,ypos,vl+ticlen,ypos)
          call line(vr,ypos,vr-ticlen,ypos)
        endif
      enddo
      if (icolor.gt.0) then
        call sflush
        call gsplci(1)
      endif
      call plchhq(vl-ylaboff,ymid,ylab,charsize,90.,0.)
c
c Top labels:
      call plchhq(xmid,vt+top1off,toplab(1)(1:lenstr(toplab(1))),
     +  charsize,0.,0.)
      call plchhq(xmid,vt+top2off,toplab(2)(1:lenstr(toplab(2))),
     +  charsize,0.,0.)
c
c Color bar
c Note labclv is a blank dummy passed to lblbar. We don't want lblbar
c   to put any lables on since we want to control size, and want only
c   three labels (min, mid, and max). This is done with plchhq.
c
      if (iclrbar.gt.0) then
        cbport(1) = vl
        cbport(2) = vr
        cbport(3) = vb-xnumoff-xlaboff-.08
        cbport(4) = cbport(3)+.10
        call cpgeti('NCL -- number of contour levels',ncl)
        nbox = ncl+1
        if (icella.gt.0) nbox = -nbox
        do i=1,ncl
          call cpseti('PAI -- parameter array index',i)
          call cpgetr('CLV -- contour level',clev)
          call cpgeti('AIA - area identifier above',ia)
          call cpgeti('AIB - area identifier below',ib)
          lfin(i) = i+1
        enddo
        call cpgetr('CMN -- contour minimum',cl0)
        call cpgetr('CMX -- contour maximum',cl1)
        clmid = 0.5*(cl0+cl1)
        lfin(ncl+1) = ncl+2
        wsfb = 1.
        hsfb = .5
        iftp = 1
        nlbs = ncl
        lbab = 0
c
c Note in new version of lblbar received from Kennison, a negated
c value of nbox will prevent the boxes from being outlined; this
c is useful if doing cell arrays (icella=1).
c
        call lblbar(0,cbport(1),cbport(2),cbport(3),cbport(4),
     +    nbox,wsfb,hsfb,lfin,iftp,labclv,nlbs,lbab) 
        write(labclv,labform) cl0
        call plchhq(vl,cbport(3)-cbnumoff,
     +    labclv(1:lenstr(labclv)),charsize,0.,-1.)
        write(labclv,labform) clmid
        call plchhq(xmid,cbport(3)-cbnumoff,
     +    labclv(1:lenstr(labclv)),charsize,0.,0.)
        write(labclv,labform) cl1
        call plchhq(vr,cbport(3)-cbnumoff,
     +    labclv(1:lenstr(labclv)),charsize,0.,1.)
      endif
c
c Return set and function code delimitor:
      call set(vl,vr,vb,vt,wl,wr,wb,wt,lin)
      call pcsetc('FC',fc)
c
c Add color bar showing kp:
      if (kpbar.gt.0.and.icolor.gt.0) call mkkpbarv(mt,jday1)
      if (kpgraph.gt.0.and.icolor.gt.0) call kplinece(mt,jday1)
c
      return
      end
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
      subroutine mkkpbarv(mt,jday1)
c
c Make horizontal color bar at bottom of CE plot showing range
c of kp values from 0 to 7 (left to right). Indicate current
c kp value as black cursor block on color bar 
c
      parameter (mxgpi=200,nkp=22)
      common/kp/ kpbar,ngpi,gpikp(mxgpi),igpiday(mxgpi),gpiut(mxgpi)
      dimension viewkp(4),mt(3),labkp(8),rgbkp(3,nkp),icikp(nkp),
     +  rkp(nkp),xcurs(4),ycurs(4)
      character*10 labclv
      data labclv /'          '/
      data labkp/0,1,2,3,4,5,6,7/
      data rkpoff /.013/
      data rkp/0.,.33,.66,1.0,1.33,1.66,2.,2.33,2.66,3.,3.33,3.66,
     +         4.0,4.33,4.66,5.,5.33,5.66,6.,6.33,6.66,7./
      data rkpthick/.01/
c
c A color table for the 22 values of kp from 0 to 7 (chosen more or
c less arbitrarilly from NCAR film production color chart). Fixes
c red, and varies green and blue:
c
      data rgbkp
     +/1., 1.,.63, 1.,1.,.50, 1.,1.,.38, 1.,1.,.25, 1.,1.,.12, 1.,1.,0.,
     + 1.,.88, 0., 1.,.75,0., 1.,.63,0., 1.,.50,0., 1.,.38,0.,1.,.25,0.,
     + 1.,.12, 0., 1., 0.,0., 1.,0.,.12, 1.,0.,.25, 1.,0.,.38,1.,0.,.50,
     + 1., 0.,.63, 1.,0.,.75, 1.,0.,.88, 1.,0.,1./
c
      call getset(vl,vr,vb,vt,wl,wr,wb,wt,ity)
      call set(0.,1.,0.,1.,0.,1.,0.,1.,1)
      viewkp(1) = vl
      viewkp(2) = vr
      viewkp(3) = .06
      viewkp(4) = .14
c
c Define color indices, 200-221, for color bar:
      icstart = 200
      do i=1,nkp
        icikp(i) = icstart+i-1
        call gscr(1,icikp(i),rgbkp(1,i),rgbkp(2,i),rgbkp(3,i))
      enddo
c
c Make the color bar:
      call lblbar(0,viewkp(1),viewkp(2),viewkp(3),viewkp(4),-nkp,
     +  1.,.5,icikp,1,labclv,nkp,0)
c
c Label the color bar and outline it in white:
      charsize = .03*(vr-vl)
      call plchhq(vl-.03,viewkp(3)+.5*(viewkp(4)-viewkp(3)),
     +  'KP',charsize,0.,1.)
      do i=1,8
        write(labclv,"(i1)") labkp(i)
        xpos = vl + (i-1)*3./float(nkp)*(vr-vl) + 0.5*(vr-vl)/float(nkp)
        call plchhq(xpos,viewkp(3)-rkpoff,labclv(1:lenstr(labclv)),
     +    charsize,0.,0.)
      enddo
      call sflush
      call gsplci(1)
      quart = .25*(viewkp(4)-viewkp(3))
      call line(viewkp(2),viewkp(3)+quart,viewkp(1),viewkp(3)+quart) 
      call line(viewkp(1),viewkp(3)+quart,viewkp(1),viewkp(4)-quart) 
      call line(viewkp(1),viewkp(4)-quart,viewkp(2),viewkp(4)-quart) 
      call line(viewkp(2),viewkp(4)-quart,viewkp(2),viewkp(3)+quart) 
c
c Find current kp (ckp):
c (common /kp/ defined earlier by vid.f from data file)
c     common/kp/ kpbar,ngpi,gpikp(mxgpi),igpiday(mxgpi),gpiut(mxgpi)
c
      ut = float(mt(2)) + float(mt(3))/60.
      jday = jday1 + mt(1) - 1	! don't check for year rollover right now
      do i=1,ngpi
        if (igpiday(i).eq.jday.and.
     +      ut.ge.gpiut(i)-1.5.and.ut.lt.gpiut(i)+1.5) then
          ckp = gpikp(i)
          goto 100
        endif
      enddo
      write(6,"('>>> warning mkkpbarh: cannot find kp corresponding to',
     +  ' ut=',f9.3,' mt=',3i3,' jday=',i6)") 
     +  ut,mt,jday
      ckp = 0.
 100  continue
c
c Mark current kp on kp bar with black cursor of thickness rkpthick:
c
c     write(6,"('mkkpbarh: mt=',i2,':',i2,':',i2,' jday=',i6,' ckp=',
c    +  f6.3)") mt,jday,ckp
      do i=1,nkp
        if (ckp.le.rkp(i)+.00001.and.ckp.ge.rkp(i)-.00001) then
          ikp = i
          goto 101
        endif
      enddo
      write(6,"('>>> warning mkkpbarh: bad ckp? ckp = ',e12.4)") ckp
 101  continue
      call sflush
      call gsplci(0)
      xpos = vl + float(ikp-1)/float(nkp)*(vr-vl) + 
     +       0.5*(vr-vl)/float(nkp)
      xcurs(1) = xpos+0.5*rkpthick
      xcurs(2) = xpos-0.5*rkpthick
      xcurs(3) = xpos-0.5*rkpthick
      xcurs(4) = xpos+0.5*rkpthick
      ycurs(1) = viewkp(3)+quart
      ycurs(2) = viewkp(3)+quart
      ycurs(3) = viewkp(4)-quart-.005
      ycurs(4) = viewkp(4)-quart-.005
      call gsfaci(0)
      call gfa(4,xcurs,ycurs)
      call sflush
      call gsplci(1)
c
      return
      end

c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
      subroutine kplinece(mt,jday1)
c     parameter (mxgpi=200,ndays=10,ntmstot=ndays*24+1)
      parameter (mxgpi=200,ndays=8,ntmstot=ndays*24+1)
      dimension mt(3),view(4),xx(ntmstot+2),yy(ntmstot+2)
      common/kp/ kpbar,kpgraph,ngpi,gpikp(mxgpi),igpiday(mxgpi),
     +  gpiut(mxgpi),nkp,vpkpgce(4),vpkpgsv(4),rkp(ntmstot)
      character*6 fbname
c
c     call set(vpkpgce(1),vpkpgce(2),vpkpgce(3),vpkpgce(4),
c    +  1.,float(ntmstot),0.,7.,1)
      call set(vpkpgce(1),vpkpgce(2),vpkpgce(3),vpkpgce(4),
     +  1.,float(ntmstot),0.,9.,1)
      ut = float(mt(2)) + float(mt(3))/60.
      jday = jday1 + mt(1) - 1	! don't check for year rollover right now
      xx(1) = 1.
      yy(1) = 0.

      utincc = float(mt(1)-1)*24.+float(mt(2))+float(mt(3))/60.
      uthr = -1.
c     iday = 1
      iday = 9
      do i=1,ntmstot
        xx(i+1) = float(i)
        yy(i+1) = rkp(i)
        uthr = uthr+1.
        if (uthr.gt.23.) then
          uthr = 0.
          iday = iday+1 
        endif
        utinc = (iday-1)*24.+uthr
c       write(6,"('labce: i=',i3,' utincc=',f9.3,' utinc=',f9.3,
c    +    ' iday=',i2,' uthr=',f6.2,' rkp=',f6.2)") i,utincc,utinc,
c    +    iday,uthr,rkp(i)
        if (utinc.ge.utincc) then
          ikp = i
          ckp = rkp(i)
          goto 100
        endif  
      enddo
      write(6,"('>>> warning kplinece: cannot find kp corresponding ',
     +  'to utincc=',f9.3,' ut=',f7.3,' mt=',3i3,' jday=',i6)") 
     +  utincc,ut,mt,jday
      ckp = 0.
 100  continue
      xx(ikp+1) = float(ikp)
      yy(ikp+1) = rkp(ikp)
      xx(ikp+2) = float(ikp)
      yy(ikp+2) = 0.
c     write(6,"('kplinece: mt=',3i3,' iday=',i3,' utincc=',f8.3,
c    +  ' utinc=',f8.3,' ikp=',i3,' ckp=',f5.2)") mt,iday,utincc,
c    +  utinc,ikp,ckp
      call sflush
      call gsplci(1)
      call line(float(ikp),0.,float(ikp),ckp)
      call gscr(1,250,1.,0.,0.)
      call gsfaci(250)
      call gfa(ikp+2,xx,yy)
c
      return
      end
