      SUBROUTINE plotter(string, iparse, dset_new, qmodel, qhist, qini,
     &                   dset, qinter)
c		make the plot using PGPLOT routines
c		fwj haberl march 1988
      INCLUDE 'xplot.inc'
      CHARACTER*(*) string
      REAL*4 plim(2, 2)
      INTEGER*4 iparse, dset_new
      INTEGER*4 divxy(2, dset_max), dset, iset, is
      LOGICAL*4 qmodel, qhist, qini, qinter
      INTEGER*4 ix, iy, i, itmp, nret, iflag, idelim, len, lenact, nlab
      INTEGER*4 igrp
      CHARACTER*128 lab
      CHARACTER*8 slab
      REAL NO, MLOG
      PARAMETER (NO=-1.2E-34,MLOG=1.2e-34)
c entry stscf
      INTEGER*4 ibeg, iend, jfont
      INTEGER*4 ifont, lwidth
      SAVE ifont, lwidth
      REAL*4 rfont
      REAL*4 sfont
      SAVE sfont
      LOGICAL*4 qskip
      INTEGER*4 maxscm
      PARAMETER (maxscm=4)
      CHARACTER*(6) subcom(maxscm)
      INTEGER*4 nvec, iery(3)
c entries addcmd,delcmd,liscmd
      INTEGER*4 idel, nucmd

      DATA subcom/'normal', 'roman', 'italic', 'script'/
      DATA ifont/1/
      DATA sfont/1.0/
      DATA lwidth/1/
      DATA divxy/dset_max*1, dset_max*1/
c two-sided errors on x and y, no errors on model y:
      DATA iery/2,2,0/
c
      DO is = 1, dset_new
         if (pos(1,is).GT.0) divxy(1,is) = pos(1,is)
         if (pos(2,is).GT.0) divxy(2,is) = pos(2,is)
      ENDDO
      CALL xgtint(string, iparse, 2*dset_new, 'plot position', 1, divxy,
     &            nret, iflag, idelim)
      IF (iflag.LT.0) THEN
         GOTO 900
      ENDIF
c counter for PLT labels
      nlab = 0
c command 1 always plot device filled by STPLOT
c above iucmd user defined commands, flush out rest
      DO I = 2, IUCOM
         CMD(I) = ' '
      ENDDO
      ncmd = 1
c plot device:
      IF (.NOT.qini) THEN
         WRITE (*, *) ' Plot device not defined yet'
         RETURN
      ENDIF
      IF (ifont.NE.1) THEN
         ncmd = ncmd + 1
         cmd(ncmd) = 'font '//subcom(ifont)
      ENDIF
      ncmd = ncmd + 1
      WRITE (slab, '(a,f4.2)') ' cs ', sfont
      cmd(ncmd) = slab
      IF (lwidth.NE.1) THEN
         ncmd = ncmd + 1
         WRITE (cmd(ncmd), '(a,i3)') 'lwidth ', lwidth
      ENDIF

      iset = dset
      DO is = 1, dset_new
         ix = divxy(1, is)
         iy = divxy(2, is)
         IF (ix.gt.divx) THEN
            write (*,'(2(a,i2))')' x-viewport ', ix,
     &                           ' exceeds current setting ', divx
            return
         ENDIF
         IF (iy.gt.divy) THEN
            write (*,'(2(a,i2))')' y-viewport ', iy,
     &                           ' exceeds current setting ', divy
            return
         ENDIF
         iset = iset + 1
         pos(1, iset) = ix
         pos(2, iset) = iy
         CALL fndlim(ix, iy, iset, qmodel)
      ENDDO
      dset = iset 

c x, y, and model y vectors:
      IF (qmodel) THEN
         nvec = 3
      ELSE
         nvec = 2
      ENDIF
 
      IF (dset.EQ.0) THEN
         WRITE (*, '(a)') ' No data to plot read in yet'
         ncmd = 0
         RETURN
      ELSEIF (dset.eq.1) THEN
         if(qmodel)then
            ncmd = ncmd + 1
            cmd(ncmd) = 'skip single'
         ENDIF
      ELSEIF (dset.GT.1) THEN
         ncmd = ncmd + 1
         cmd(ncmd) = 'skip single'
      ENDIF
C
c create window frames with labeling:
C
      itmp = 0
      igrp = 0
      do is = 1, dset
         ix = pos(1, is)
         iy = pos(2, is)
c location:
         ncmd = ncmd + 1
         WRITE (cmd(ncmd), '(a,i)') 'window ', is
         ncmd = ncmd + 1
         WRITE (cmd(ncmd), '(a,4f7.2)') 'location ', framex1(ix),
     &                                  framey1(iy), framex2(ix),
     &                                  framey2(iy)
         ncmd = ncmd + 1
         cmd(ncmd) = 'view 0. 0. 1. 1.'
c axes attributes:
         IF (qxlog(ix)) THEN
            ncmd = ncmd + 1
            WRITE (cmd(ncmd), '(a,i)') 'log x on ', is
         ENDIF
         IF (qylog(iy)) THEN
            ncmd = ncmd + 1
            WRITE (cmd(ncmd), '(a,i)') 'log y on ', is
         ENDIF
c axes labels:
         IF (ix.EQ.1) THEN
            lab = ylab(is)
            len = lenact(lab)
            IF (len.GT.0) THEN
               ncmd = ncmd + 1
               cmd(ncmd) = 'la y '//lab(:len)
            ENDIF
         ELSEIF (ix.GT.1) THEN
            ncmd = ncmd + 1
            cmd(ncmd) = 'label ny off '
         ENDIF
         IF (iy.EQ.1) THEN
            lab = xlab(is)
            len = lenact(lab)
            IF (len.GT.0) THEN
               ncmd = ncmd + 1
               cmd(ncmd) = 'la x '//lab(:len)
            ENDIF
         ELSEIF (iy.GT.1) THEN
            ncmd = ncmd + 1
            cmd(ncmd) = 'label nx off '
         ENDIF
c inside labels:
         IF (qabc) THEN
            lab = abc(ix, iy)
            len = lenact(lab)
            IF (len.GT.0) THEN
               ncmd = ncmd + 1
               nlab = nlab + 1
               WRITE (cmd(ncmd), '(a,i3,a,2f7.2)') 'la ', nlab,
     &                slab//' j r vp ', framex2(ix) - 0.05*plenx(ix),
     &                framey2(iy) - 0.1*pleny(iy)
               ncmd = ncmd + 1
               WRITE (cmd(ncmd), '(a,i3,a)') 
     &               'la ', nlab, ' "'//lab(:len)//'"'
            ENDIF
         ENDIF
c other labels:
         IF (iy.EQ.divy) THEN
            lab = phead(is)
            len = lenact(lab)
            IF (len.GT.0) THEN
               ncmd = ncmd + 1
               cmd(ncmd) = 'la t '//lab(:len)
            ENDIF
            lab = tllab(is)
            len = lenact(lab)
            IF (len.GT.0) THEN
               ncmd = ncmd + 1
               nlab = nlab + 1
               WRITE (cmd(ncmd), '(a,i3,a,2f7.2,a)') 'la ', nlab,
     &                slab//' j l vp ', framex1(ix), framey2(iy)
     &                 + 0.06*pleny(iy), ' "'//lab(:len)//'"'
            ENDIF
            lab = trlab(is)
            len = lenact(lab)
            IF (len.GT.0) THEN
               ncmd = ncmd + 1
               nlab = nlab + 1
               WRITE (cmd(ncmd), '(a,i3,a,2f7.2,a)') 'la ', nlab,
     &                slab//' j r vp ', framex2(ix), framey2(iy)
     &                 + 0.06*pleny(iy), ' "'//lab(:len)//'"'
            ENDIF
         ENDIF
c scaling:
         IF (qslimx(ix)) then
c           manually entered limits
            plim(1, 1) = limitx(1, ix)
            plim(2, 1) = limitx(2, ix)
         ELSE
c           automatic scaling
            IF (qxlog(ix)) THEN
               plim(1, 1) = alog10(max(mlog,limitx(1, ix)))
               plim(2, 1) = alog10(max(mlog,limitx(2, ix)))
c              add some extra space
               CALL delta(plim(2,1), plim(1,1))
               plim(1, 1) = 10**(plim(1,1))
               plim(2, 1) = 10**(plim(2,1))
            ELSE
               plim(1, 1) = limitx(1, ix)
               plim(2, 1) = limitx(2, ix)
               CALL delta(plim(2,1), plim(1,1))
            ENDIF
         ENDIF
         IF (qslimy(iy)) then
            plim(1, 2) = limity(1, iy)
            plim(2, 2) = limity(2, iy)
         ELSE
            IF (qylog(iy)) THEN
               plim(1, 2) = alog10(max(mlog,limity(1, iy)))
               plim(2, 2) = alog10(max(mlog,limity(2, iy)))
               CALL delta(plim(2,2), plim(1,2))
               plim(1, 2) = 10**(plim(1,2))
               plim(2, 2) = 10**(plim(2,2))
            ELSE
               plim(1, 2) = limity(1, iy)
               plim(2, 2) = limity(2, iy)
               CALL delta(plim(2,2), plim(1,2))
            ENDIF
         ENDIF
         ncmd = ncmd + 1
         WRITE (cmd(ncmd), '(a,4(1x,g15.5))') 'rescale ', 
     &                                   plim(1, 1), plim(2, 1), 
     &                                   plim(1, 2), plim(2, 2)
         IF (symbol(is).GE.0) THEN
            igrp = igrp+1
            ncmd = ncmd + 1
            WRITE (cmd(ncmd), '(a,i4)') 'yaxis on ', igrp
            ncmd = ncmd + 1
            WRITE (cmd(ncmd), '(a,i4)') 'error on ', igrp
            ncmd = ncmd + 1
            WRITE (cmd(ncmd), '(a,i4,a,i4)')
     &            'marker ',symbol(is),' on ', igrp
c colors, colind(2) for data points
            ncmd = ncmd + 1
            WRITE (cmd(ncmd), '(2(a,i4))') 'color ', colind(2), ' on ',
     &                                     igrp
c fill data:
            DO i = nbins(is), nbine(is)
               itmp = itmp + 1
               buf(itmp, 1) = datax(i)
               buf(itmp, 2) = errux(i) - datax(i)
               buf(itmp, 3) = errlx(i) - datax(i)
               buf(itmp, 4) = datay(i)
               buf(itmp, 5) = erruy(i) - datay(i)
               buf(itmp, 6) = errly(i) - datay(i)
               buf(itmp, 7) = modely(i)
            ENDDO
            itmp = itmp + 1
            buf(itmp, 1) = NO
            buf(itmp, 2) = NO
            buf(itmp, 3) = NO
            buf(itmp, 4) = NO
            buf(itmp, 5) = NO
            buf(itmp, 6) = NO
            buf(itmp, 7) = NO
            IF (qmodel) THEN
               igrp = igrp + 1
               ncmd = ncmd + 1
               WRITE (cmd(ncmd), '(a,i4)') 'yaxis on ', igrp
               ncmd = ncmd + 1
               IF (qhist) THEN
                  write (cmd(ncmd), '(a,i4)') 'line stepped ',igrp
               ELSE
                  write (cmd(ncmd), '(a,i4)') 'line on ',igrp
               ENDIF
c colors, colind(3) for model
               ncmd = ncmd + 1
               WRITE (cmd(ncmd), '(2(a,i4))') 'color ', colind(3), 
     &               ' on ',igrp
            ENDIF
         ENDIF
      ENDDO
      itmp = itmp - 1
      IF (.NOT.qinter) THEN
         cmd(mxcmd-1) = 'plot'
         cmd(mxcmd) = 'exit'
      ELSE
         cmd(mxcmd-1) = ' '
         cmd(mxcmd) = ' '
      ENDIF
      CALL plt(buf, iery, max_points_set, itmp, nvec, cmd, mxcmd, iflag)
      dset_new = 0
      RETURN
 900  CONTINUE
      RETURN
 
      ENTRY stscf(string, iparse)
c	args:
c	string	c*	i/r: input string to be parsed
c	iparse	i4	i/r: current position
 
      CALL xgtarg(string, iparse, ibeg, iend, qskip, iflag, idelim)
      IF (iflag.LT.0) THEN
         GOTO 910
      ENDIF
      IF (iend.GE.ibeg) THEN
         jfont = ifont
         CALL xmatch(string(ibeg:iend), subcom, maxscm, jfont)
      ENDIF
      IF (jfont.GT.0 .AND. jfont.LE.maxscm) THEN
         ifont = jfont
      ELSE
         CALL xptarg(string, iparse, string(ibeg:iend), iflag,
     &               idelim)
         CALL xgtrl4(string, iparse, 1, 'font size', 1, rfont, nret,
     &               iflag, idelim)
         IF (rfont.GT.0.) THEN
            sfont = rfont
         ELSE
            lwidth = -rfont
         ENDIF
      ENDIF
      RETURN
 910  CONTINUE
      RETURN
C---
      ENTRY ADDCMD(STRING, IPARSE, NUCMD)
      IF (IUCOM.LE.MXUCMD-30) THEN
         WRITE (*, *) 'Too many commands.  Command ignored.'
      ELSE
         CMD(IUCOM) = STRING(IPARSE+1:)
         IUCOM = IUCOM - 1
         NUCMD = MXUCMD - IUCOM
      ENDIF
      RETURN
C---
      ENTRY DELCMD(IDEL,NUCMD)
      ITMP = MXUCMD - IDEL + 1
      IF (ITMP.LE.IUCOM .OR. ITMP.GT.MXUCMD) THEN
         WRITE (*, *) 'Only', NUCMD, ' commands exist.'
      ELSE
         IUCOM = IUCOM + 1
         NUCMD = MXUCMD - IUCOM
         DO I = ITMP, IUCOM, -1
            CMD(I) = CMD(I-1)
         ENDDO
      ENDIF
      RETURN
C---
      ENTRY LISCMD
      IF (IUCOM.GE.MXUCMD) THEN
         WRITE (*, *) 'There are no user-created PLT commands.'
      ELSE
         WRITE (*, *) 'Current user-created PLT commands are:'
         DO I = MXUCMD, IUCOM + 1, -1
            WRITE (*, 2011) MXUCMD - I + 1, CMD(I)(:LENACT(CMD(I)))
 2011       FORMAT (1X, I2, ': ', A)
         ENDDO
      ENDIF
      RETURN
      END

