
      subroutine labsv(toplab,iclrbar,icolor,labform,icella,kpbar,
     +  kpgraph,mt,jday1)
c
c Label satellite view projection:
c
      character*40 toplab(2)
      character*8 labform
      character*10 labclv
      dimension cbport(4),lfin(256),mt(3)
      data top1off/.08/, top2off/.03/
      data labclv /'          '/
c
c Get current set and switch to fractional coords:
      call getset(vl,vr,vb,vt,wl,wr,wb,wt,ity)
      call set(0.,1.,0.,1.,0.,1.,0.,1.,1)
      xmid = 0.5*(vl+vr)
      charsize = .03*(vr-vl)
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 Top labels:
      call sflush
      call gsplci(1)
      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 label bar:
      if (iclrbar.gt.0) then
        cbport(1) = vr+.010
        cbport(2) = cbport(1) + .1
        cbport(3) = vb
        cbport(4) = vt
        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 = .5
        hsfb = 1.
        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(1,cbport(1),cbport(2),cbport(3),cbport(4),
     +    nbox,wsfb,hsfb,lfin,iftp,labclv,nlbs,lbab)
        write(labclv,labform) cl0
c
c If there is not room for the label string between right edge of
c visible color bar and right edge of frame, set angle at 45 deg:
c (cbnumoff is neg because write to left of right (invis) edge of 
c  label part of color bar)
c
        cbnumoff = -.03
        chxloc = cbport(2)+cbnumoff	! left edge of label string
        call pcseti('TE',1)
        call plchhq(chxloc,vb+1./float(nbox)*(vt-vb),
     +    labclv(1:lenstr(labclv)),charsize,360.,-1.)
        call pcgetr('DR',dr)		! distance to right edge of string
        if (1.-chxloc.lt.dr) then
          ang = 45.
          eoff = .02
        else
          ang = 0.
          eoff = 0.
          cbnumoff = -.02
          chxloc = cbport(2)+cbnumoff	! left edge of label string
        endif
        call pcseti('TE',0)
        call plchhq(chxloc,vb+1./float(nbox)*(vt-vb)-eoff,
     +    labclv(1:lenstr(labclv)),charsize,ang,-1.)
        write(labclv,labform) clmid
        call plchhq(chxloc,0.5*(vb+vt)-eoff,
     +    labclv(1:lenstr(labclv)),charsize,ang,-1.)
        write(labclv,labform) cl1
        call plchhq(chxloc,vt-1./float(nbox)*(vt-vb)-eoff,
     +    labclv(1:lenstr(labclv)),charsize,ang,-1.)
      endif	! iclrbar
c
c Return set and function code delimitor:
      call set(vl,vr,vb,vt,wl,wr,wb,wt,ity)
      call pcsetc('FC',fc)
c
c Add color bar showing kp:
      if (kpbar.gt.0.and.icolor.gt.0) call mkkpbarh(mt,jday1)
      if (kpgraph.gt.0.and.icolor.gt.0) call kplinesv(mt,jday1)
c
      return
      end
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
      subroutine mkkpbarh(mt,jday1)
c
c Make horizontal color bar at bottom of satv plot showing range
c of kp values from 0 to 7 (left to right). Indicat current
c kp value as vertical black line 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) = .05
      viewkp(4) = .13
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,viewkp(4)+rkpoff,'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 kplinesv(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(vpkpgsv(1),vpkpgsv(2),vpkpgsv(3),vpkpgsv(4),
c    +  1.,float(ntmstot),0.,7.,1)
      call set(vpkpgsv(1),vpkpgsv(2),vpkpgsv(3),vpkpgsv(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
        if (utinc.ge.utincc) then
          ikp = i
          ckp = rkp(i)
          goto 100
        endif  
      enddo
      write(6,"('>>> warning kplinesv: cannot find kp corresponding ',
     +  'to ut=',f9.3,' mt=',3i3,' jday=',i6)") 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,"('kplinesv: 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
