        program plotpg
c       Purpose - General purpose plotting routine
        integer pgbegin,ilw(10),n(500)
        character*80 device,xlbl,ylbl,toplbl,fildat,label
        character*80 sline,filnm,scommnd,replist(100)
        character*25 spar(10),scom,dum,querry,spar1,spar2,spar3
        character*1 snx,sny
        character txt(500)*4,ch*1,name*10,golabel*15,comfile*20
        logical*1 text,errx,erry,line,point,polar,pair,bin,center
        logical*1 hist,rewind,lwswitch,spherical,rotphi,rottheta
        logical*1 autoscale,filesw,prnt,nmstrg,interact,points
        logical*1 dash_inbound,record,repeat,eofsw
        real a(15),x(500),y(500),x1(500),x2(500),y1(500),y2(500)
        real p(2),q(2),z(500),z2(500)
        integer ipts(500)
        call getarg(1,comfile)
        if (comfile .ne. ' ') open(unit=5,file=comfile,readonly)
        inchni = 11
        inchn = inchni
        print*, '==========================================================='
        print*, '                                       Version 2.2'
        print*, 'This is PLOTPG, a facility which allows either interactive or'
        print*, 'command file operation of PGPLOT.  With this facility, you'
        print*, 'need not write a program to make plots with PGPLOT.  The'
        print*, 'data you want plotted just need to be in a file with any'
        print*, 'number of columns.  You specify the file with the command '
        print*, 'DATAFILE followed by the name of the file and the number'
        print*, 'of columns in the file.  The program will read your data'
        print*, 'file in free format (not very good  with strings).  You'
        print*, 'specify which columns in the data file are to be used for'
        print*, 'x and y data values via the  command XYCOLUMN.'
        print*, 'PLOTPG will prompt you for the "Plotting Command File:";'
        print*, 'the response "terminal" or CR will allow the session to be'
        print*, 'interactive, otherwise you can respond with the filename '
        print*, 'of a command list.  The commands are recorded in '
        print*, 'the file "plt.plt".  Once produced, "plt.plt" can be copied,'
        print*, 'edited, and then used as the command file for similar plots.'
        print*, '                A program by          Ed Shaya             '
        print*, '==========================================================='
        ls = 1
 8      print*, ' Plotting Command File [For interactive - ''terminal'']:'
        read(*,'(a)') filnm
        if (filnm .eq. 'help') goto 140
        print*, filnm
        if (filnm(1:8) .eq. 'terminal' .or. filnm .eq. ' ') then
                interact = 1
                inchn = 5
        else
                open(inchn,file = filnm,status='old',readonly,err=8)
        end if
        filesw = 0
        indata = 12
        iout = 10
        open(iout, file = 'plt.plt', status = 'unknown')
 20     print *, 'Graphics device/type:   [/tek] '
        read(*,'(a)') device
        if (device .eq. ' ') device = '/tek'
        print *,'Number of sections in X direction: (usual 1)'
        read(*,'(a)') snx
        if (snx .eq. ' ') then
                nx = 1
                ny = 1
                goto 40
        end if
        read(snx,'(i1)') nx
        if (nx .eq. 0) nx = 1
        print *,'Number of sections in Y direction: (usual 1)'
        read(*,'(a)') sny
        read(sny,'(i1)') ny
        if (ny .eq. 0) ny = 1
 40     if (.not.(pgbegin(12,device,nx,ny) .eq. 1)) goto 20
c       ##==== set line width arrays ===#
        do kk = 1,10
                ilw(kk) = kk
        end do
        autoscale = 0
        lwswitch = 1
        just = 0
        axis = 0
        if (interact) write(*,*) ' Begin commands.'
 100    if (repeat) then
                jline = jline + 1
                sline = replist(jline)
                if (jline .eq. jlinet) then
                        jline = 0
                        repcnt = repcnt + 1
                        if (repcnt .eq. nreps-1) then
                                repeat = 0
                        end if
                end if
        else
                read(inchn,110) sline
                write(iout,111) sline
110             format(a80)
111             format (a69)
        end if
        if (sline(1:1) .eq. '%') goto 100
        if (record) then
                jline = jline + 1
                replist(jline) = sline
        end if
        call split_line(sline,spar)
        scom = spar(1)
        if (scom .eq. ' ') go to 100
        if (scom .eq. '$') then
                ln = index(sline,'$')
                scommnd = sline(ln+1:30+ln)
                write(*,*) ln,scommnd
                kcom = system(scommnd)
        else if (scom .eq. 'help') then
                if (spar(2) .eq. ' ') then
                scommnd = 'more /mnt1/ejs/utils/plotpg.hlp'
                else
 140            scommnd = 'grep ^'//spar(2)//'/mnt1/ejs/utils/plotpg.hlp'
                end if
                kcom = system(scommnd)
        else if (scom .eq. 'repeat') then
                read(spar(2),*,end=900) nreps
                spar1 = 'NUMBER_OF_REPEATS'
                jline = 0
                repcnt = 0
                record = 1
        else if (scom .eq. 'endrepeat') then
                jlinet = jline - 1
                jline = 0
                record = 0
                repeat = 1
        else if (scom .eq. 'goto') then
                golabel = spar(2)
                let = index(golabel,' ')
                golabel(let:let) = ':'
                eofsw = 0
 175            do while (golabel .ne. spar(1))
                        read(inchn,110,end=180) sline
                        call split_line(sline,spar)
                end do
                go to 100
 180            if (eofsw) then
                        write(*,*) 'Missing Label ',golabel
                        stop
                else
                        eofsw = 1
                end if
                rewind inchn
                go to 175
        else if (scom .eq. 'terminal') then
                inchn = 5
                interact = 1
                write(*,*) ' Enter commands interactively'
        else if (scom .eq. 'commandfile') then
                inchn = inchni
                interact = 0
                if (spar(2) .ne. ' ') then
                        close(inchn)
                open(unit=inchn,file=spar(2),status='old',readonly)
                end if
        else if (scom .eq. 'xlabel') then
                xlbl = spar(2)
                ln1 = 0
                do jj = 3, 10
                        ln = index(xlbl(ln1+1:),' ')
                        xlbl = xlbl(1:ln1+ln)//spar(jj)
                        ln1 = ln1 + ln
                end do
        else if (scom .eq. 'ylabel') then
                ln1 = 0
                ylbl = spar(2)
                do jj = 3, 10
                        ln = index(ylbl(ln1+1:),' ')
                        ylbl = ylbl(1:ln1+ln)//spar(jj)
                        ln1 = ln1 + ln
                end do
        else if (scom .eq. 'tlabel') then
                ln1 = 0
                toplbl = spar(2)
                do jj = 3, 10
                        ln = index(toplbl(ln1+1:),' ')
                        toplbl = toplbl(1:ln1+ln)//spar(jj)
                        ln1 = ln1 + ln
                end do
        else if (scom .eq. 'setc') then
                spar1 = 'SETC'
                read(spar(2),*,end=900) csize
                call pgsetc(csize)
        else if (scom .eq. 'setlw') then
                spar1 = 'LSIZE'
                read(spar(2),*,end=900) lsize
                call grsetlw(ilw(lsize))
        else if (scom .eq. 'setfont') then
                spar1 = 'IFONT'
                read(spar(2),*,end=900) ifont
                call grsetfont(ifont)
        else if (scom .eq. 'lwswitch') then
                if (lwswitch .eq. 1) then
                        lwswitch = 0
                        do kk = 1,10
                                ilw(kk) = 1
                        end do
                else
                        lwswitch = 1
                        do kk = 1,10
                                ilw(kk) = kk
                        end do
                end if
        else if (scom .eq. 'datafile') then
                fildat = spar(2)
                spar1 = 'FILENAME'
                spar2 = 'NCOL'
                read(spar(3),*,end=950) ncol
                close(indata)
                indata = indata + 1
                open(unit=indata,file=fildat,status = 'old',readonly,
     x                                          err = 80)
                filesw = 1
                goto 90
80              write(*,'(a25,a25)') 'Unable to find datafile ',fildat
                filesw = 0
                goto 100
90              continue
        else if (scom .eq. 'pair') then
                pair = 1
                spar1 = 'ND2'
                read(spar(2),*,end=900) nx2
                read(spar(3),*,end=220) ny2
        else if (scom .eq. 'dash_inbound') then
                dash_inbound = 1
 220    else if (scom .eq. 'spherical') then
                spherical = 1
                spar1 = 'NTHETA'
                spar2 = 'NPHI'
                spar3 = 'ND'
                read(spar(2),*,end=970) ntheta
                read(spar(3),*,end=970) nphi
                read(spar(4),*,end=970) nd
        else if (scom .eq. 'rottheta') then
                rottheta = 1
                spar1 = 'THETA'
                read(spar(2),*,end=900) theta
        else if (scom .eq. 'rotphi') then
                rotphi = 1
                spar1 = 'PHI'
                read(spar(2),*,end=900) phi
        else if (scom .eq. 'polar') then
                polar = 1
                spar1 = 'NTHETA'
                spar2 = 'ND'
                read(spar(2),*,end=950) ntheta
                read(spar(3),*,end=950) nd
        else if (scom .eq. 'xycolumn') then
                spar1 = 'NX'
                spar2 = 'NY'
                read(spar(2),*,end=950) nx
                read(spar(3),*,end=950) ny
        else if (scom .eq. 'xyzcolumn') then
                spar1 = 'NX'
                spar2 = 'NY'
                spar3 = 'NZ'
                read(spar(2),*,end=970) nx
                read(spar(3),*,end=970) ny
                read(spar(4),*,end=970) nz
        else if (scom .eq. 'point') then
                point = 1
                spar1 = 'IPT'
                read(spar(2),*,end=900) ipt
        else if (scom .eq. 'points') then
                points = 1
                spar1 = 'NCOL_POINT_SYMBOL'
                read(spar(2),*,end=900) nipts
        else if (scom .eq.  'line') then
                line = 1
        else if (scom .eq. 'errx') then
                errx = 1
                spar1 = 'N_COL_ERRX1'
                spar2 = 'N_COL_ERRX2'
                spar3 = 'ERRXTYPE'
                read(spar(2),*,end=970) nerrx1
                read(spar(3),*,end=970) nerrx2
                read(spar(4),*,end=970) errxt
        else if (scom .eq. 'erry') then
                erry = 1
                spar1 = 'N_COL_ERRY1'
                spar2 = 'N_COL_ERRY2'
                spar3 = 'ERRYTYPE'
                read(spar(2),*,end=970) nerry1
                read(spar(3),*,end=970) nerry2
                read(spar(4),*,end=970) erryt
        else if (scom .eq. 'text') then
                text = 1
                spar1 = 'N_COL'
                read(spar(2),*,end=900) namcol
        else if (scom .eq. 'hist') then
                spar1 = 'DAT_MIN'
                spar2 = 'DAT_MAX'
                hist = 1
                read(spar(2),*,end=950) datmin
                read(spar(3),*,end=950) datmax
        else if (scom .eq. 'curse') then
                call pgupdt(1)
                if (spar(2) .ne. ' ') then
                        read(spar(2),*,end=900) xcoord
                        read(spar(3),*,end=900) ycoord
                end if
                call pgcurse(xcoord,ycoord,ch)
                write(*,*) ch,xcoord,ycoord
        else if (scom .eq. 'labels') then
                call pgupdt(1)
                nlabel = 1
                write(*,*) ' Present character size is ',csize
                write(*,*) ' Begin placing labels [<RTN> to end]'
 500            print *,' Label ', nlabel
                read(*,'(a)') label
                if (label .eq. '') then
                if (interact) write(*,*) ' Continue commands'
                        goto 100
                end if
                print *,' X,Y position of label'
                read(*,*) xcoord,ycoord
                call pgtext(xcoord,ycoord,label)
                nlabel = nlabel + 1
                goto 500
        else if (scom .eq. 'setls') then
                spar1 = 'LINE_STYLE'
                read(spar(2),*,end=900) ls
                call grsetls(ls)
        else if (scom .eq. 'draw') then
                spar1 = 'X'
                spar2 = 'Y'
                read(spar(2),*,end=950) xcoord
                read(spar(3),*,end=950) ycoord
                call pgdraw(xcoord,ycoord)
        else if (scom .eq. 'move') then
                spar1 = 'X'
                spar2 = 'Y'
                read(spar(2),*,end=950) xcoord
                read(spar(3),*,end=950) ycoord
                call pgmove(xcoord,ycoord)
        else if (scom .eq. 'bin') then
                spar1 = 'CENTER [LOGICAL]'
                read(spar(2),*,end=900) center
                bin = 1
        else if (scom .eq. 'just') then
                just = 1
        else if (scom .eq. 'axis') then
                spar1 = 'NAXIS'
                read(spar(2),*,end=900) naxis
        else if (scom .eq. 'env') then
                if (autoscale) then
                        write(*,*) ' Autoscale is on.'
                        write(*,*) ' Axes drawn during plot execution.'
                else
                        spar1 = 'XMIN  XMAX'
                        spar2 = 'YMIN  YMAX'
                        read(spar(2),*,end=950) xmin
                        read(spar(3),*,end=950) xmax
                        read(spar(4),*,end=950) ymin
                        read(spar(5),*,end=950) ymax
                        xcoord = (xmax-xmin)/2.
                        ycoord = (ymax-ymin)/2.
                        call pgenv(xmin,xmax,ymin,ymax,just,naxis)
                        just = 0
                end if
        else if (scom .eq. 'autoscale') then
                if (autoscale)  then
                        autoscale = 0
                else
                        autoscale = 1
                end if
        else if (scom .eq. 'label') then
                call pglabel(xlbl,ylbl,toplbl)
        else if (scom .eq. 'skip') then
                if (.not. filesw) goto 800
                spar1 = 'NLINES'
                read(spar(2),*,end=900) nlines
                do jj = 1, nlines
                        read(indata,'(a)') dum
                end do
                write(*,'(i5,a,a20)') nlines,' lines skipped in ',fildat
        else if (scom .eq. 'rewind') then
                rewind = 1
                if (rewind) rewind(indata)
        else if (scom .eq. 'print') then
                prnt = 1
        else if (scom .eq. 'noprint') then
                prnt = 0
        else if (scom .eq. 'strings') then
                nmstrg = 1
        else if (scom .eq. 'nostrings') then
                nmstrg = 0
        else if (scom .eq. 'vport') then
                spar1 = 'XLEFT XRIGHT'
                spar2 = 'YBOT YTOP'
                read(spar(2),*,end=950) xleft
                read(spar(3),*,end=950) xright
                read(spar(4),*,end=950) ybot
                read(spar(5),*,end=950) ytop
                call pgvport(xleft,xright,ybot,ytop)
        else if (scom .eq. 'advance') then
                call pgadvance
                else if (scom .eq. 'vstand') then
                call pgvstand
        else if (scom .eq. 'window') then
                spar1 = 'X1 X2'
                spar2 = 'Y1 Y2'
                read(spar(2),*,end=950) xleft
                read(spar(3),*,end=950) xright
                read(spar(4),*,end=950) ybot
                read(spar(5),*,end=950) ytop
                call pgwindow(xleft,xright,ybot,ytop)
        else if (scom .eq. 'box') then
                spar1 = 'XOPT XTICK'
                spar2 = 'NXSUB YOPT'
                spar3 = 'YTICK NYSUB'
                read(spar(2),*,end=980) xopt
                read(spar(3),*,end=980) xtick
                read(spar(4),*,end=980) nxsub
                read(spar(5),*,end=980) yopt
                read(spar(5),*,end=980) ytick
                read(spar(5),*,end=980) nysub
                call pgbox(xopt,xtick,nxsub,yopt,ytick,nysub)
        else if (scom .eq. 'plot') then
                spar1 = 'NDATA_PTS'
                read(spar(2),*,end=900) ntot
                if (ntot .gt. 500) then
                        ntot = 500
                write(*,*) ' Only 500 points can be plotted at a time'
                end if
                if (.not. filesw) goto 800
        call pgupdt(0)
C       #== READ IN DATA AND SET X, Y AND ERROR ARRAYS ===#
        j = 0
        do i = 1, ntot
                if (nmstrg) then
                  read(indata,*,end=850) name,(a(j),j=2,ncol)
                else
                  read(indata,*,end=850) (a(j),j=1,ncol)
                end if
                if (spherical) then
                        x(i) = a(nd)*cos(a(ntheta))*sin(a(nphi))
                        y(i) = a(nd)*sin(a(ntheta))*sin(a(nphi))
                        z(i) = a(nd)*cos(a(nphi))
                        if (pair) then
                                x2(i) = a(nx2)*x(i)/a(nd)
                                y2(i) = a(nx2)*y(i)/a(nd)
                                z2(i) = a(nx2)*z(i)/a(nd)
                        end if
                else if (polar) then
                        x(i) = a(nd)*cos(a(ntheta))
                        y(i) = a(nd)*sin(a(ntheta))
                        if (pair) then
                                x2(i) = a(nx2)*x(i)/a(nd)
                                y2(i) = a(nx2)*y(i)/a(nd)
                        end if
                else if (hist) then
                        x(i) = a(nx)
                else
                        x(i) = a(nx)
                        y(i) = a(ny)
                        if (pair) then
                                x2(i) = a(nx2)
                                y2(i) = a(ny2)
                        end if
                        if (rotphi) z(i) = a(nz)
                end if
                if (points) then
                        ipts(i) = a(nipts)
                end if
                if (errx) then
                        x1(i) = x(i) - a(nerrx1)
                        x2(i) = x(i) + a(nerrx2)
                end if
                if (erry) then
                        y1(i) = y(i) - a(nerry1)
                        y2(i) = y(i) + a(nerry2)
                end if
                if (text) then
                        if (nmstrg .and. namcol .eq. 1) then
                                txt(i) = name
                        else
                        n(i) = a(namcol)
                        if (n(i) .le. 9) then
                                write(txt(i),'(i1)') n(i)
                        else if (n(i) .le. 99) then
                                write(txt(i),'(i2)') n(i)
                        else if (n(i) .le. 999) then
                                write(txt(i),'(i3)') n(i)
                        end if
                        end if
                end if
                if (prnt) print *,i,name,x(i),y(i)
                if (rottheta) then
                        x(i) = x(i)*cos(theta)+y(i)*sin(theta)
                        y(i) = -x(i)*sin(theta)+y(i)*cos(theta)
                        if (pair) then
                        x2(i) = x2(i)*cos(theta)+y2(i)*sin(theta)
                        y2(i) = -x2(i)*sin(theta)+y2(i)*cos(theta)
                        end if
                end if
                if (rotphi) then
                        y(i) = y(i)*cos(phi)+z(i)*sin(phi)
                        if (pair) y2(i) = y2(i)*cos(phi)+z2(i)*sin(phi)
                end if
        end do
 850    itot = i - 1
        write(*,'(i4,a17,a20)') itot,' lines read from ',fildat
        if (text) then
                do k = 1,itot
                        call pgtext(x(k),y(k),txt(k))
                end do
        end if
        if (autoscale) then
                xmina = x(1)
                ymina = y(1)
                xmaxa = x(1)
                ymaxa = y(1)
                do ijk = 2, itot
                        if (x(ijk) .gt. xmaxa) xmaxa = x(ijk)
                        if (y(ijk) .gt. ymaxa) ymaxa = y(ijk)
                        if (x(ijk) .lt. xmina) xmina = x(ijk)
                        if (y(ijk) .lt. ymina) ymina = y(ijk)
                end do
                plusx = (xmaxa-xmina)*.05
                plusy = (ymaxa-ymina)*.05
                xmina = xmina - plusx
                xmaxa = xmaxa + plusx
                ymina = ymina - plusy
                ymaxa = ymaxa + plusy
                call pgenv(xmina,xmaxa,ymina,ymaxa,just,axis)
        end if
        if (point) call pgpoint(itot,x,y,ipt)
        if (points) call pgpoint(itot,x,y,ipts)
        if (line) call pgline(itot,x,y)
        if (bin) call pgbin(itot,x,y,center)
        if (hist) call pghist(itot,x,datmin,datmax,itot,1)
        if (pair) then
                do i = 1, itot
                        p(1) = x(i)
                        q(1) = y(i)
                        p(2) = x2(i)
                        q(2) = y2(i)
                        if (dash_inbound) then
                        if (p(1)**2+q(1)**2 .gt. p(2)**2+q(2)**2) then
                                call grsetls(4)
                        else
                                call grsetls(1)
                        end if
                        end if
                        call pgline(2,p,q)
                end do
        call grsetls(ls)
        end if
        if (errx) then
                call pgerrx(itot,x1,x2,y,errxt)
        end if
        if (erry) then
                call pgerry(itot,x,y1,y2,erryt)
        end if
        pair = 0
        spherical = 0
        rotphi = 0
        rottheta = 0
        polar = 0
        line = 0
        point = 0
        points = 0
        errx = 0
        erry = 0
        text = 0
        labels = 0
        hist = 0
        rewind = 0
        else if (scom .eq. 'quit') then
                goto 999
        else
                write(*,*) ' Do not understand ',scom
                write(iout,*) ' Do not understand ',scom
        end if
        go to 100
 800    write(*,*) 'No datafile chosen.  Use command DATAFILE.'
        goto 980
 900    write(*,*) ' Command "',scom,'" requires more parameters.'
        write(*,'(a15,2x,a17)') scom,spar1
        go to 980
 950    write(*,*) ' Command "',scom,'" requires more parameters.'
        write(*,'(a15,2x,a17,2x,a17)') scom,spar1,spar2
        go to 980
 970    write(*,*) ' Command "',scom,'" requires more parameters.'
        write(*,'(a15,2x,a17,2x,a17,2x,a17)') scom,spar1,spar2,spar3
        go to 980
 980    if (.not.interact) then
                inchn = 5
                interact = 1
                write(*,*) ' Enter commands interactively'
        write(*,985) ' Type "commandfile" to return control to ',filnm
 985    format(a,a17)
        end if
        go to 100
 999    call pgupdt(1)
        call pgend
        close(indata)
        if (device .eq. '/ps') then
                write(*,'(a)') ' Send plot to laserwriter?'
                read(*,'(a)') querry
                if (querry(1:1) .eq. 'y') then
                        kcom = system('print -v PGPLOT.PS')
                        write(*,*) ' Printing'
                end if
        end if
        end
