pgplot.src

        Copyright (c) Kapteyn Laboratorium Groningen 2001
        All Rights Reserved.

Name:         pgplot.src
Creator:      terlouw
Host:         bessel
Date:         Oct 12, 2001
Contents:     Makefile.uti allincludes.pl ggixor.dc2 ggixor.f grarea.dc3
              grarea.f grbpic.dc3 grbpic.f grchar.dc3 grchar.f
              grchr0.dc3 grchr0.f grchsz.dc3 grchsz.f grclip.dc3
              grclip.f grclos.dc3 grclos.f grclpl.dc3 grclpl.f
              grclpl.f.orig grctoi.dc3 grctoi.f grcurs.dc3 grcurs.f
              grdat2.dc3 grdat2.f grdate.c.orig grdate.dc3 grdate.f
              grdot0.dc3 grdot0.f grdot1.dc3 grdot1.f grdtyp.dc3
              grdtyp.f grepic.dc3 grepic.f gresc.dc3 gresc.f
              gretxt.dc3 gretxt.f grfa.dc3 grfa.f grfao.dc3
              grfao.f grflun.dc3 grflun.f grgcom.f.orig grgenv.dc3
              grgenv.f grgenv.f.orig grgfil.dc3 grgfil.f grglun.dc3
              grglun.f grgmsg.dc3 grgmsg.f grgray.dc3 grgray.f
              grgtc0.dc3 grgtc0.f grimg0.dc3 grimg0.f grimg1.dc3
              grimg1.f grimg1.f.orig grimg2.dc3 grimg2.f grimg2.f.orig
              grimg3.dc3 grimg3.f grinit.dc3 grinit.f grinqfont.f.orig
              grinqli.dc3 grinqli.f grinqpen.dc3 grinqpen.f gritoc.dc3
              gritoc.f grldev.dc3 grldev.f grldev.f.orig grlen.dc3
              grlen.f grlgtr.dc3 grlgtr.f grlin0.dc3 grlin0.f
              grlin1.dc3 grlin1.f grlin2.dc3 grlin2.f grlin3.dc3
              grlin3.f grlina.dc3 grlina.f grlinr.dc3 grlinr.f
              grmark.dc3 grmark.f grmcur.dc3 grmcur.f grmker.dc3
              grmker.f grmova.dc3 grmova.f grmovr.dc3 grmovr.f
              grmsg.dc3 grmsg.f grmsg.f.orig gropen.dc3 gropen.f
              groptx.dc3 groptx.f grpage.dc3 grpage.f grpars.dc3
              grpars.f grpars.f.orig grpckg1.inc grpckg1.inc.orig grpixl.dc3
              grpixl.f grpocl.dc3 grpocl.f grprom.dc3 grprom.f
              grprom.f.orig grpxpo.dc3 grpxpo.f grpxps.dc3 grpxps.f
              grpxpx.dc3 grpxpx.f grpxre.dc3 grpxre.f grqbci.dc3
              grqbci.f grqcap.dc3 grqcap.f grqci.dc3 grqci.f
              grqcol.dc3 grqcol.f grqcr.dc3 grqcr.f grqdev.dc3
              grqdev.f grqdt.dc3 grqdt.f grqfnt.dc3 grqfnt.f
              grqls.dc3 grqls.f grqlw.dc3 grqlw.f grqpos.dc3
              grqpos.f grqtxt.dc3 grqtxt.f grqtyp.dc3 grqtyp.f
              grqtyp.f.orig grquit.dc3 grquit.f grrec0.dc3 grrec0.f
              grrect.dc3 grrect.f grsbci.dc3 grsbci.f grsci.dc3
              grsci.f grscr.dc3 grscr.f grscrl.dc3 grscrl.f
              grsetc.dc3 grsetc.f grsetfont.f.orig grsetli.dc3 grsetli.f
              grsetpen.dc3 grsetpen.f grsets.dc3 grsets.f grsfnt.dc3
              grsfnt.f grsize.dc3 grsize.f grskpb.dc3 grskpb.f
              grslct.dc3 grslct.f grsls.dc3 grsls.f grslw.dc3
              grslw.f grsncr.dc3 grsncr.f grsy00.dc3 grsy00.f
              grsyds.dc3 grsyds.f grsymk.dc3 grsymk.f grsyxd.dc3
              grsyxd.f grterm.dc3 grterm.f grtext.dc3 grtext.f
              grtoup.dc3 grtoup.f grtran.dc3 grtran.f grtrim.dc3
              grtrim.f grtrml.dc3 grtrml.f grtrn0.dc3 grtrn0.f
              grtter.dc3 grtter.f grtxy0.dc3 grtxy0.f gruser.c.orig
              gruser.dc3 gruser.f grvct0.dc3 grvct0.f grvect.dc3
              grvect.f grwarn.dc3 grwarn.f grwarn.f.orig grxhls.dc3
              grxhls.f grxrgb.dc3 grxrgb.f notes.txt pgadvance.dc2
              pgadvance.f pgarro.dc2 pgarro.f pgask.dc2 pgask.f
              pgaxis.dc2 pgaxis.f pgaxlg.dc3 pgaxlg.f pgband.dc2
              pgband.f pgbbuf.dc2 pgbbuf.f pgbeg.dc2 pgbeg.f
              pgbegin.dc2 pgbegin.f pgbin.dc2 pgbin.f pgbox.dc2
              pgbox.f pgbox.f.orig pgbox1.dc3 pgbox1.f pgcirc.dc2
              pgcirc.f pgcl.dc3 pgcl.f pgclos.dc2 pgclos.f
              pgcn01.dc3 pgcn01.f pgcnsc.dc3 pgcnsc.f pgconb.dc2
              pgconb.f pgconf.dc2 pgconf.f pgconl.dc2 pgconl.f
              pgcons.dc2 pgcons.f pgcont.dc2 pgcont.f pgconx.dc2
              pgconx.f pgcotic.dc2 pgcotic.f pgcp.dc3 pgcp.f
              pgctab.dc2 pgctab.f pgcurs.dc2 pgcurs.f pgcurse.dc2
              pgcurse.f pgdraw.dc2 pgdraw.f pgebuf.dc2 pgebuf.f
              pgend.dc2 pgend.f pgenv.dc2 pgenv.f pgeras.dc2
              pgeras.f pgerr1.dc2 pgerr1.f pgerrb.dc2 pgerrb.f
              pgerrx.dc2 pgerrx.f pgerry.dc2 pgerry.f pgetxt.dc2
              pgetxt.f pgexist.dc2 pgexist.f pgfunt.dc2 pgfunt.f
              pgfunx.dc2 pgfunx.f pgfuny.dc2 pgfuny.f pggray.dc2
              pggray.f pghi2d.dc2 pghi2d.f pghis1.dc3 pghis1.f
              pghist.dc2 pghist.f pghtch.dc3 pghtch.f pgiden.dc2
              pgiden.f pgimag.dc2 pgimag.f pginit.dc3 pginit.f
              pglab.dc2 pglab.f pglab.f.orig pglabel.dc2 pglabel.f
              pglcur.dc2 pglcur.f pgldev.dc2 pgldev.f pgldev.f.orig
              pglen.dc2 pglen.f pgline.dc2 pgline.f pgline.f.orig
              pgmove.dc2 pgmove.f pgmtext.dc2 pgmtext.f pgmtxt.dc2
              pgmtxt.f pgncur.dc2 pgncur.f pgncurse.dc2 pgncurse.f
              pgnoto.dc3 pgnoto.f pgnpl.dc3 pgnpl.f pgnumb.dc2
              pgnumb.f pgolin.dc2 pgolin.f pgopen.dc2 pgopen.f
              pgopen.f.orig pgpage.dc2 pgpage.f pgpanl.dc2 pgpanl.f
              pgpap.dc2 pgpap.f pgpaper.dc2 pgpaper.f pgpat.dc2
              pgpat.f pgpixl.dc2 pgpixl.f pgplot.dc3 pgplot.h
              pgplot.inc pgplot.inc.orig pgpnts.dc2 pgpnts.f pgpoint.dc2
              pgpoint.f pgpoly.dc2 pgpoly.f pgpt.dc2 pgpt.f
              pgpt1.dc2 pgpt1.f pgptext.dc2 pgptext.f pgptxt.dc2
              pgptxt.f pgqah.dc2 pgqah.f pgqbci.dc2 pgqbci.f
              pgqcf.dc2 pgqcf.f pgqch.dc2 pgqch.f pgqci.dc2
              pgqci.f pgqcir.dc2 pgqcir.f pgqclp.dc2 pgqclp.f
              pgqcol.dc2 pgqcol.f pgqcr.dc2 pgqcr.f pgqcs.dc2
              pgqcs.f pgqdt.dc2 pgqdt.f pgqfs.dc2 pgqfs.f
              pgqhs.dc2 pgqhs.f pgqid.dc2 pgqid.f pgqinf.dc2
              pgqinf.f pgqimi.dc2 pgqitf.dc2 pgqitf.f pgqls.dc2
              pgqls.f pgqlw.dc2 pgqlw.f pgqndt.dc2 pgqndt.f
              pgqpos.dc2 pgqpos.f pgqtbg.dc2 pgqtbg.f pgqtxt.dc2
              pgqtxt.f pgqvp.dc2 pgqvp.f pgqvsz.dc2 pgqvsz.f
              pgqwin.dc2 pgqwin.f pgrect.dc2 pgrect.f pgrnd.dc2
              pgrnd.f pgrnge.dc2 pgrnge.f pgsah.dc2 pgsah.f
              pgsave.dc2 pgsave.f pgsbci.dc2 pgsbci.f pgscf.dc2
              pgscf.f pgsch.dc2 pgsch.f pgsci.dc2 pgsci.f
              pgscir.dc2 pgscir.f pgsclp.dc2 pgsclp.f pgscr.dc2
              pgscr.f pgscrl.dc2 pgscrl.f pgscrn.dc2 pgscrn.f
              pgsetc.dc3 pgsetc.f pgsfs.dc2 pgsfs.f pgshls.dc2
              pgshls.f pgshs.dc2 pgshs.f pgsimi.dc2 pgsimi.f
              pgsitf.dc2 pgsitf.f pgsize.dc3 pgsize.f pgslct.dc2
              pgslct.f pgsls.dc2 pgsls.f pgslw.dc2 pgslw.f
              pgsncr.dc2 pgsncr.f pgstbg.dc2 pgstbg.f pgsubp.dc2
              pgsubp.f pgsvp.dc2 pgsvp.f pgswin.dc2 pgswin.f
              pgtbox.dc2 pgtbox.f pgtbx1.dc3 pgtbx2.dc3 pgtbx3.dc3
              pgtbx4.dc3 pgtbx5.dc3 pgtbx6.dc3 pgtbx7.dc3 pgtext.dc2
              pgtext.f pgtick.dc2 pgtick.f pgtikl.dc3 pgtikl.f
              pgunsa.dc2 pgupdt.dc2 pgupdt.f pgvect.dc2 pgvect.f
              pgvport.dc2 pgvport.f pgvsiz.dc2 pgvsiz.f pgvsize.dc2
              pgvsize.f pgvstand.dc2 pgvstand.f pgvstd.dc2 pgvstd.f
              pgvw.dc3 pgvw.f pgwedg.dc2 pgwedg.f pgwindow.dc2
              pgwindow.f pgwnad.dc2 pgwnad.f togipsy.pl

#>            Makefile.uti
SHELL  = /bin/sh

pack::
	$$gip_sys/pack.csh pgplot.src Makefile.uti \
	allincludes.pl ggixor.dc2 ggixor.f grarea.dc3 grarea.f \
	grbpic.dc3 grbpic.f grchar.dc3 grchar.f grchr0.dc3 \
	grchr0.f grchsz.dc3 grchsz.f grclip.dc3 grclip.f \
	grclos.dc3 grclos.f grclpl.dc3 grclpl.f grclpl.f.orig \
	grctoi.dc3 grctoi.f grcurs.dc3 grcurs.f grdat2.dc3 \
	grdat2.f grdate.c.orig grdate.dc3 grdate.f grdot0.dc3 \
	grdot0.f grdot1.dc3 grdot1.f grdtyp.dc3 grdtyp.f \
	grepic.dc3 grepic.f gresc.dc3 gresc.f gretxt.dc3 \
	gretxt.f grfa.dc3 grfa.f grfao.dc3 grfao.f \
	grflun.dc3 grflun.f grgcom.f.orig grgenv.dc3 grgenv.f \
	grgenv.f.orig grgfil.dc3 grgfil.f grglun.dc3 grglun.f \
	grgmsg.dc3 grgmsg.f grgray.dc3 grgray.f \
	grgtc0.dc3 \
	grgtc0.f grimg0.dc3 grimg0.f grimg1.dc3 grimg1.f grimg1.f.orig \
	grimg2.dc3 grimg2.f grimg2.f.orig grimg3.dc3 grimg3.f grinit.dc3 \
	grinit.f grinqfont.f.orig grinqli.dc3 grinqli.f grinqpen.dc3 \
	grinqpen.f gritoc.dc3 gritoc.f grldev.dc3 grldev.f \
	grldev.f.orig grlen.dc3 grlen.f grlgtr.dc3 grlgtr.f \
	grlin0.dc3 grlin0.f grlin1.dc3 grlin1.f grlin2.dc3 \
	grlin2.f grlin3.dc3 grlin3.f grlina.dc3 grlina.f \
	grlinr.dc3 grlinr.f grmark.dc3 grmark.f grmcur.dc3 \
	grmcur.f grmker.dc3 grmker.f grmova.dc3 grmova.f \
	grmovr.dc3 grmovr.f grmsg.dc3 grmsg.f grmsg.f.orig \
	gropen.dc3 gropen.f groptx.dc3 groptx.f grpage.dc3 \
	grpage.f grpars.dc3 grpars.f grpars.f.orig grpckg1.inc \
	grpckg1.inc.orig \
	grpixl.dc3 grpixl.f grpocl.dc3 grpocl.f grprom.dc3 \
	grprom.f grprom.f.orig grpxpo.dc3 grpxpo.f grpxps.dc3 \
	grpxps.f grpxpx.dc3 grpxpx.f grpxre.dc3 grpxre.f \
	grqbci.dc3 grqbci.f grqcap.dc3 grqcap.f grqci.dc3 grqci.f grqcol.dc3 \
	grqcol.f grqcr.dc3 grqcr.f grqdev.dc3 grqdev.f \
	grqdt.dc3 grqdt.f grqfnt.dc3 grqfnt.f grqls.dc3 \
	grqls.f grqlw.dc3 grqlw.f grqpos.dc3 grqpos.f \
	grqtxt.dc3 grqtxt.f grqtyp.dc3 grqtyp.f grqtyp.f.orig \
	grquit.dc3 grquit.f grrec0.dc3 grrec0.f grrect.dc3 \
	grrect.f grsbci.dc3 grsbci.f grsci.dc3 grsci.f grscr.dc3 grscr.f \
	grscrl.dc3 grscrl.f grsetc.dc3 grsetc.f grsetfont.f.orig \
	grsetli.dc3 grsetli.f grsetpen.dc3 grsetpen.f grsets.dc3 \
	grsets.f grsfnt.dc3 grsfnt.f grsize.dc3 grsize.f \
	grskpb.dc3 grskpb.f grslct.dc3 grslct.f grsls.dc3 \
	grsls.f grslw.dc3 grslw.f grsncr.dc3 grsncr.f grsy00.dc3 grsy00.f \
	grsyds.dc3 grsyds.f grsymk.dc3 grsymk.f grsyxd.dc3 \
	grsyxd.f grterm.dc3 grterm.f grtext.dc3 grtext.f \
	grtoup.dc3 grtoup.f grtran.dc3 grtran.f grtrim.dc3 \
	grtrim.f grtrml.dc3 grtrml.f grtrn0.dc3 grtrn0.f \
	grtter.dc3 grtter.f grtxy0.dc3 grtxy0.f gruser.c.orig \
	gruser.dc3 gruser.f grvct0.dc3 grvct0.f grvect.dc3 \
	grvect.f grwarn.dc3 grwarn.f grwarn.f.orig grxhls.dc3 \
	grxhls.f grxrgb.dc3 grxrgb.f notes.txt pgadvance.dc2 \
	pgadvance.f pgarro.dc2 pgarro.f pgask.dc2 pgask.f \
	pgaxis.dc2 pgaxis.f pgaxlg.dc3 pgaxlg.f pgband.dc2 \
	pgband.f pgbbuf.dc2 pgbbuf.f pgbeg.dc2 pgbeg.f \
	pgbegin.dc2 pgbegin.f pgbin.dc2 pgbin.f pgbox.dc2 \
	pgbox.f pgbox.f.orig pgbox1.dc3 pgbox1.f \
	pgcirc.dc2 pgcirc.f pgcl.dc3 pgcl.f pgclos.dc2 \
	pgclos.f pgcn01.dc3 pgcn01.f pgcnsc.dc3 pgcnsc.f \
	pgconb.dc2 pgconb.f pgconf.dc2 \
	pgconf.f pgconl.dc2 pgconl.f pgcons.dc2 pgcons.f \
	pgcont.dc2 pgcont.f pgconx.dc2 pgconx.f pgcotic.dc2 \
	pgcotic.f pgcp.dc3 pgcp.f pgctab.dc2 pgctab.f \
	pgcurs.dc2 pgcurs.f pgcurse.dc2 pgcurse.f pgdraw.dc2 \
	pgdraw.f pgebuf.dc2 pgebuf.f pgend.dc2 pgend.f \
	pgenv.dc2 pgenv.f pgeras.dc2 pgeras.f pgerr1.dc2 \
	pgerr1.f pgerrb.dc2 pgerrb.f pgerrx.dc2 pgerrx.f \
	pgerry.dc2 pgerry.f pgetxt.dc2 pgetxt.f pgexist.dc2 \
	pgexist.f pgfunt.dc2 pgfunt.f pgfunx.dc2 pgfunx.f \
	pgfuny.dc2 pgfuny.f pggray.dc2 pggray.f \
	pghi2d.dc2 pghi2d.f \
	pghis1.dc3 pghis1.f pghist.dc2 pghist.f pghtch.dc3 \
	pghtch.f pgiden.dc2 pgiden.f pgimag.dc2 pgimag.f \
	pginit.dc3 pginit.f pglab.dc2 pglab.f pglab.f.orig \
	pglabel.dc2 pglabel.f pglcur.dc2 pglcur.f pgldev.dc2 \
	pgldev.f pgldev.f.orig pglen.dc2 pglen.f pgline.dc2 \
	pgline.f pgline.f.orig pgmove.dc2 pgmove.f \
	pgmtext.dc2 pgmtext.f pgmtxt.dc2 pgmtxt.f pgncur.dc2 \
	pgncur.f pgncurse.dc2 pgncurse.f pgnoto.dc3 pgnoto.f \
	pgnpl.dc3 pgnpl.f pgnumb.dc2 pgnumb.f pgolin.dc2 \
	pgolin.f pgopen.dc2 pgopen.f pgopen.f.orig pgpage.dc2 \
	pgpage.f pgpanl.dc2 pgpanl.f pgpap.dc2 pgpap.f \
	pgpaper.dc2 pgpaper.f pgpat.dc2 pgpat.f pgpixl.dc2 \
	pgpixl.f pgplot.dc3 pgplot.h pgplot.inc \
	pgplot.inc.orig pgpnts.dc2 pgpnts.f pgpoint.dc2 pgpoint.f \
	pgpoly.dc2 pgpoly.f pgpt.dc2 pgpt.f pgpt1.dc2 \
	pgpt1.f pgptext.dc2 pgptext.f pgptxt.dc2 pgptxt.f \
	pgqah.dc2 pgqah.f pgqbci.dc2 pgqbci.f pgqcf.dc2 pgqcf.f pgqch.dc2 \
	pgqch.f pgqci.dc2 pgqci.f pgqcir.dc2 pgqcir.f \
	pgqclp.dc2 pgqclp.f pgqcol.dc2 pgqcol.f pgqcr.dc2 \
	pgqcr.f pgqcs.dc2 pgqcs.f pgqdt.dc2 pgqdt.f \
	pgqfs.dc2 pgqfs.f pgqhs.dc2 pgqhs.f pgqid.dc2 \
	pgqid.f pgqinf.dc2 pgqinf.f pgqimi.dc2 pgqitf.dc2 pgqitf.f \
	pgqls.dc2 pgqls.f pgqlw.dc2 pgqlw.f pgqndt.dc2 \
	pgqndt.f pgqpos.dc2 pgqpos.f pgqtbg.dc2 pgqtbg.f \
	pgqtxt.dc2 pgqtxt.f pgqvp.dc2 pgqvp.f pgqvsz.dc2 \
	pgqvsz.f pgqwin.dc2 pgqwin.f pgrect.dc2 pgrect.f \
	pgrnd.dc2 pgrnd.f pgrnge.dc2 pgrnge.f pgsah.dc2 \
	pgsah.f pgsave.dc2 pgsave.f pgsbci.dc2 pgsbci.f pgscf.dc2 pgscf.f \
	pgsch.dc2 pgsch.f pgsci.dc2 pgsci.f pgscir.dc2 \
	pgscir.f pgsclp.dc2 pgsclp.f pgscr.dc2 pgscr.f \
	pgscrl.dc2 pgscrl.f pgscrn.dc2 pgscrn.f pgsetc.dc3 \
	pgsetc.f pgsfs.dc2 pgsfs.f pgshls.dc2 pgshls.f \
	pgshs.dc2 pgshs.f pgsimi.dc2 pgsimi.f pgsitf.dc2 pgsitf.f pgsize.dc3 \
	pgsize.f pgslct.dc2 pgslct.f pgsls.dc2 pgsls.f \
	pgslw.dc2 pgslw.f pgsncr.dc2 pgsncr.f pgstbg.dc2 pgstbg.f pgsubp.dc2 \
	pgsubp.f pgsvp.dc2 pgsvp.f pgswin.dc2 pgswin.f \
	pgtbox.dc2 pgtbox.f pgtbx1.dc3 pgtbx2.dc3 pgtbx3.dc3 \
	pgtbx4.dc3  pgtbx5.dc3 pgtbx6.dc3 pgtbx7.dc3 \
	pgtext.dc2 pgtext.f pgtick.dc2 \
	pgtick.f pgtikl.dc3 pgtikl.f pgunsa.dc2 pgupdt.dc2 \
	pgupdt.f pgvect.dc2 pgvect.f pgvport.dc2 pgvport.f \
	pgvsiz.dc2 pgvsiz.f pgvsize.dc2 pgvsize.f pgvstand.dc2 \
	pgvstand.f pgvstd.dc2 pgvstd.f pgvw.dc3 pgvw.f \
	pgwedg.dc2 pgwedg.f pgwindow.dc2 pgwindow.f pgwnad.dc2 \
	pgwnad.f togipsy.pl
#<

#>            allincludes.pl
#!/usr/local/bin/perl

unlink "pgplot.h";
@files = sort <*.h>;
open PGPLOT, ">pgplot.h";

print PGPLOT "/* pgplot.h */\n";
print PGPLOT "#if !defined(_pgplot_h_)\n";
print PGPLOT "#define _pgplot_h_\n";

foreach $file (@files) {
   open SOURCE, $file;
   while (<SOURCE>) {
      print PGPLOT;
   }
   close SOURCE;
}
print PGPLOT "#endif\n";
close PGPLOT;
#<

#>            ggixor.dc2
Function:     GGIXOR

Purpose:      Set or clear Ggi non-destructive drawing mode.

Category:     GRAPHICS

File:         pgplot.src

Author:       J.P. Terlouw

Use:          LOGICAL GGIXOR( MODE )
              
                GGIXOR -  previous drawing mode
                MODE   - .TRUE.  :  start non-destructive drawing.
                         .FALSE. :  stop non-destructive drawing.

Description:  This subroutine checks whether the device is of type "GGI"
              and if this is true, then instructs the driver to enter
              the desired mode. Driver function code 23 ('escape') is
              used for this. If the device is not "GGI", no action
              is taken.

Updates:      Oct 26, 1995: JPT Document created.
#<

#>            ggixor.f
* GIPSY-private
*

      LOGICAL FUNCTION GGIXOR(MODE)
C@ logical function ggixor(logical)
      INCLUDE 'grpckg1.inc'
      LOGICAL         MODE

      CHARACTER*6     GGIFUN
      CHARACTER*10    VALUE
      REAL            RBUF(1)
      INTEGER         NBUF, LCHR, TYPLEN

      GGIFUN  = 'GgiXOR'
      LCHR    = 6
      RBUF(1) = 0.0
      IF (MODE) RBUF(1) = 1.0
      NBUF    = 1

      GGIXOR = .FALSE.
      CALL PGQINF('TYPE', VALUE, TYPLEN)
      IF (VALUE(:TYPLEN).EQ.'GGI') THEN
         CALL GREXEC (GRGTYP, 23, RBUF, NBUF, GGIFUN, LCHR)
         GGIXOR = RBUF(1).EQ.1.0
      END IF

*
*  Include other devices supporting 'non-destructive' drawing here.
*


      END

#<

#>            grarea.dc3
Name:         GRAREA

Purpose:      define a clipping window

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRAREA (IDENT,X0,Y0,XSIZE,YSIZE)
      
       GRPCKG: Define a rectangular window in the current plotting area. All
       graphics (except characters written with GRCHAR) will be blanked
       outside this window.  The default window is the full plotting area
       defined by default or by GRSETS.
      
       Arguments:
      
       IDENT (input, integer): the plot identifier, returned by GROPEN.
       X0, Y0 (input, real): the lower left corner of the window, in absolute
             device coordinates.
       XSIZE, YSIZE (input, real): width and height of the window in absolute
             coordinates; if either is negative, the window will be reset to
             the full plotting area.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grarea.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRAREA -- define a clipping window
C+
      SUBROUTINE GRAREA (IDENT,X0,Y0,XSIZE,YSIZE)
C
C GRPCKG: Define a rectangular window in the current plotting area. All
C graphics (except characters written with GRCHAR) will be blanked
C outside this window.  The default window is the full plotting area
C defined by default or by GRSETS.
C
C Arguments:
C
C IDENT (input, integer): the plot identifier, returned by GROPEN.
C X0, Y0 (input, real): the lower left corner of the window, in absolute
C       device coordinates.
C XSIZE, YSIZE (input, real): width and height of the window in absolute
C       coordinates; if either is negative, the window will be reset to
C       the full plotting area.
C--
C  1-Feb-1983 - [TJP].
C 25-Nov-1994 - use floating-point [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER IDENT
      REAL X0, Y0, XSIZE, YSIZE
C
      CALL GRSLCT(IDENT)
C
      IF ((XSIZE.LE.0.0) .OR. (YSIZE.LE.0.0)) THEN
          GRXMIN(IDENT) = 0
          GRXMAX(IDENT) = GRXMXA(IDENT)
          GRYMIN(IDENT) = 0
          GRYMAX(IDENT) = GRYMXA(IDENT)
      ELSE
          GRXMIN(IDENT) = MAX(X0,0.0)
          GRYMIN(IDENT) = MAX(Y0,0.0)
          GRXMAX(IDENT) = MIN(XSIZE+X0,REAL(GRXMXA(IDENT)))
          GRYMAX(IDENT) = MIN(YSIZE+Y0,REAL(GRYMXA(IDENT)))
      END IF
C
      END
#<

#>            grbpic.dc3
Name:         GRBPIC

Purpose:      begin picture

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRBPIC
      
       GRPCKG (internal routine). Send a "begin picture" command to the
       device driver, and send commands to set deferred attributes (color,
       line width, etc.)

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grbpic.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRBPIC -- begin picture
C+
      SUBROUTINE GRBPIC
C
C GRPCKG (internal routine). Send a "begin picture" command to the
C device driver, and send commands to set deferred attributes (color,
C line width, etc.)
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      REAL RBUF(2)
      INTEGER NBUF, LCHR
      CHARACTER*20 CHR
C
      GRPLTD(GRCIDE) = .TRUE.
      IF (GRGTYP.GT.0) THEN
C         -- begin picture
          RBUF(1) = GRXMXA(GRCIDE)
          RBUF(2) = GRYMXA(GRCIDE)
          NBUF = 2
          CALL GREXEC(GRGTYP,11,RBUF,NBUF,CHR,LCHR)
C         -- set color index
          RBUF(1) = GRCCOL(GRCIDE)
          NBUF = 1
          CALL GREXEC(GRGTYP,15,RBUF,NBUF,CHR,LCHR)
C         -- set line width
          IF (GRGCAP(GRCIDE)(5:5).EQ.'T') THEN
              RBUF(1) = ABS(GRWIDT(GRCIDE))
              NBUF = 1
              CALL GREXEC(GRGTYP,22,RBUF,NBUF,CHR,LCHR)
          END IF
C         -- set hardware dashing
          IF (GRGCAP(GRCIDE)(3:3).EQ.'D') THEN
              RBUF(1) = GRSTYL(GRCIDE)
              NBUF = 1
              CALL GREXEC(GRGTYP,19,RBUF,NBUF,CHR,LCHR)
          END IF
      END IF
C
      END
#<

#>            grchar.dc3
Name:         GRCHAR

Purpose:      draw a string of characters

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRCHAR (IDENT,CENTER,ORIENT,ABSXY,X0,Y0,STRING)
      
       GRPCKG: Draw a string of characters. The plot is not windowed
       in the current subarea, but in the full plotting area.
      
       Arguments:
      
       IDENT (input, integer): plot identifier, as returned by GROPEN.
       CENTER (input, logical): if .TRUE., the first character of the string
            is centered at (X0,Y0); otherwise the bottom left corner of the
            first character is placed at (X0,Y0).
       ORIENT (input, real): the angle in degrees that the string is to make
            with the horizontal, increasing anticlockwise.
       ABSXY (input, logical): if .TRUE., (X0,Y0) are absolute device
            coordinates; otherwise they are world coordinates (the scaling
            transformation is applied).
       X0, Y0 (input, real): position of first character (see CENTER).
       STRING (input, character): the string of ASCII characters; control
            characters 0-20 have special representations; all other
            non-graphic characters are plotted as blank spaces.
      
       (1-Feb-1983)

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grchar.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C+
***********************************************************************
*                                                                     *
*  PGPLOT Fortran Graphics Subroutine Library                         *
*                                                                     *
*  T. J. Pearson, California Institute of Technology,                 *
*  Pasadena, California 91125.                                        *
*                                                                     *
*  Routines for handling the obsolete character set                   *
*  ------------------------------------------------                   *
*  These routines are not called by PGPLOT but are called by some     *
*  old user-written programs.                                         *
***********************************************************************

******* Index of Modules **********************************************

* GRCHAR -- draw a string of characters
* GRCHR0 -- support routine for GRCHAR and GRMARK
* GRDAT2 -- character set definition (block data)
* GRGTC0 -- obtain character digitization
* GRMARK -- mark points with specified symbol

***********************************************************************
C--

C*GRCHAR -- draw a string of characters
C+
      SUBROUTINE GRCHAR (IDENT,CENTER,ORIENT,ABSXY,X0,Y0,STRING)
C
C GRPCKG: Draw a string of characters. The plot is not windowed
C in the current subarea, but in the full plotting area.
C
C Arguments:
C
C IDENT (input, integer): plot identifier, as returned by GROPEN.
C CENTER (input, logical): if .TRUE., the first character of the string
C      is centered at (X0,Y0); otherwise the bottom left corner of the
C      first character is placed at (X0,Y0).
C ORIENT (input, real): the angle in degrees that the string is to make
C      with the horizontal, increasing anticlockwise.
C ABSXY (input, logical): if .TRUE., (X0,Y0) are absolute device
C      coordinates; otherwise they are world coordinates (the scaling
C      transformation is applied).
C X0, Y0 (input, real): position of first character (see CENTER).
C STRING (input, character): the string of ASCII characters; control
C      characters 0-20 have special representations; all other
C      non-graphic characters are plotted as blank spaces.
C
C (1-Feb-1983)
C-----------------------------------------------------------------------
      CHARACTER*(*) STRING
      INTEGER  IDENT
      LOGICAL  ABSXY, CENTER
      REAL     ORIENT, X0, Y0
C
      CALL GRSLCT(IDENT)
      CALL GRCHR0(.FALSE., CENTER, ORIENT, ABSXY, X0, Y0, STRING)
      RETURN
      END
#<

#>            grchr0.dc3
Name:         GRCHR0

Purpose:      support routine for GRCHAR and GRMARK

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRCHR0 (WINDOW,CENTER,ORIENT,ABSXY,X0,Y0,STRING)
      
       GRPCKG (internal routine): Support routine for GRCHAR and GRMARK.
       Draw a string of characters.
      
       Arguments:
      
       WINDOW (input, logical): if .TRUE., the plot is windowed in the
            current window.
       CENTER (input, logical): if .TRUE., the first character of the string
            is centered at (X0,Y0); otherwise the bottom left corner of the
            first character is placed at (X0,Y0).
       ORIENT (input, real): the angle in degrees that the string is to make
            with the horizontal, increasing anticlockwise.
       ABSXY (input, logical): if .TRUE., (X0,Y0) are absolute device
            coordinates; otherwise they are world coordinates (the scaling
            transformation is applied).
       X0, Y0 (input, real): position of first character (see CENTER).
       STRING (input, character): the string of ASCII characters; control
            characters 0-20 have special representations; all other
            non-graphic characters are plotted as blank spaces.
      
       (1-Mar-1983)

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grchr0.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRCHR0 -- support routine for GRCHAR and GRMARK
C+
      SUBROUTINE GRCHR0 (WINDOW,CENTER,ORIENT,ABSXY,X0,Y0,STRING)
C
C GRPCKG (internal routine): Support routine for GRCHAR and GRMARK.
C Draw a string of characters.
C
C Arguments:
C
C WINDOW (input, logical): if .TRUE., the plot is windowed in the
C      current window.
C CENTER (input, logical): if .TRUE., the first character of the string
C      is centered at (X0,Y0); otherwise the bottom left corner of the
C      first character is placed at (X0,Y0).
C ORIENT (input, real): the angle in degrees that the string is to make
C      with the horizontal, increasing anticlockwise.
C ABSXY (input, logical): if .TRUE., (X0,Y0) are absolute device
C      coordinates; otherwise they are world coordinates (the scaling
C      transformation is applied).
C X0, Y0 (input, real): position of first character (see CENTER).
C STRING (input, character): the string of ASCII characters; control
C      characters 0-20 have special representations; all other
C      non-graphic characters are plotted as blank spaces.
C
C (1-Mar-1983)
C-----------------------------------------------------------------------
      INTEGER  DOT, MOVE, VECSIZ
      REAL     PI
      PARAMETER (DOT = 3)
      PARAMETER (MOVE = 2)
      PARAMETER (VECSIZ = 30)
      PARAMETER (PI = 3.14159265359)
      INCLUDE 'grpckg1.inc'
      CHARACTER*(*) STRING
      CHARACTER*1   NEXT
      REAL     XMIN, XMAX, YMIN, YMAX
      INTEGER  MODE,LSTYLE,LEVEL
      INTEGER  I, J, L, CH, POINTS
      LOGICAL  ABSXY, CENTER, MORE, WINDOW
      REAL     ORIENT, X0, Y0
      REAL     ANGLE, FACTOR, BASE, FAC
      REAL     COSA, SINA
      REAL     DX, DY, XORG, YORG
      REAL     XC(VECSIZ), YC(VECSIZ), XT, YT
C
      IF (LEN(STRING).LE.0) RETURN
C
C Compute scaling and orientation.
C
      CALL GRQLS(LSTYLE)
      CALL GRSLS(1)
      ANGLE = (AMOD(ORIENT, 360.0) / 180.0) * PI
      FACTOR = GRCFAC(GRCIDE)
      COSA = FACTOR * COS(ANGLE)
      SINA = FACTOR * SIN(ANGLE)
      DX = 10.0 * COSA
      DY = 10.0 * SINA
      CALL GRTXY0(ABSXY, X0, Y0, XORG, YORG)
      IF (.NOT.WINDOW) THEN
          XMIN = GRXMIN(GRCIDE)
          XMAX = GRXMAX(GRCIDE)
          YMIN = GRYMIN(GRCIDE)
          YMAX = GRYMAX(GRCIDE)
          CALL GRAREA(GRCIDE, 0.0, 0.0, 0.0, 0.0)
      END IF
C
C Plot the string of characters.
C
      MODE = MOVE
      BASE = 0.0
      FAC = 1.0
      I = 1
      LEVEL = 0
      L = LEN(STRING)
C     -- DO WHILE (I.LE.L)
   10 IF (I.LE.L) THEN
        IF (I.LT.L .AND. STRING(I:I).EQ.CHAR(92)) THEN
            CALL GRTOUP(NEXT,STRING(I+1:I+1))
            IF (NEXT.EQ.'U') THEN
                LEVEL = LEVEL+1
                BASE = BASE + 4.0*FAC
                FAC = 0.6**IABS(LEVEL)
                I = I+2
            ELSE IF (NEXT.EQ.'D') THEN
                LEVEL = LEVEL-1
                FAC = 0.6**IABS(LEVEL)
                BASE = BASE - 4.0*FAC
                I = I+2
            ELSE
                I = I+1
            END IF
        ELSE
          CH = ICHAR(STRING(I:I))
          IF (CH.GT.127 .OR. CH.LT.0) CH = ICHAR(' ')
          MORE = .TRUE.
C         -- DO WHILE (MORE)
   20     IF (MORE) THEN
            CALL GRGTC0(CH, CENTER, POINTS, XC, YC, MORE)
            DO 30 J=1,POINTS
                    XT = XC(J)*FAC
                    YT = YC(J)*FAC + BASE
                    XC(J) = XORG + COSA * XT - SINA * YT
                    YC(J) = YORG + SINA * XT + COSA * YT
   30       CONTINUE
            IF (POINTS.EQ.1) MODE = DOT
            IF (POINTS.GT.0) CALL GRVCT0(MODE,.TRUE.,POINTS,XC,YC)
            IF (POINTS.EQ.1) MODE = MOVE
          GOTO 20
          END IF
C         -- end DO WHILE
          XORG = XORG + DX*FAC
          YORG = YORG + DY*FAC
          I = I+1
        END IF
      GOTO 10
      END IF
C     -- end DO WHILE
C
C Clean up and return.
C
      IF (.NOT.WINDOW) THEN
          GRXMIN(GRCIDE) = XMIN
          GRXMAX(GRCIDE) = XMAX
          GRYMIN(GRCIDE) = YMIN
          GRYMAX(GRCIDE) = YMAX
      END IF
      CALL GRSLS(LSTYLE)
      RETURN
      END
#<

#>            grchsz.dc3
Name:         GRCHSZ

Purpose:      inquire default character attributes

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRCHSZ (IDENT,XSIZE,YSIZE,XSPACE,YSPACE)
      
       GRPCKG: Obtain the default character attributes.
      
       Arguments:
      
       IDENT (input, integer): the plot identifier, returned by GROPEN.
       XSIZE, YSIZE (output, real): the default character size
            (absolute device units).
       XSPACE, YSPACE (output, real): the default character spacing
            (absolute units); XSPACE is the distance between the lower left
            corners of adjacent characters in a plotted string; YSPACE
            is the corresponding vertical spacing.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grchsz.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRCHSZ -- inquire default character attributes
C+
      SUBROUTINE GRCHSZ (IDENT,XSIZE,YSIZE,XSPACE,YSPACE)
C
C GRPCKG: Obtain the default character attributes.
C
C Arguments:
C
C IDENT (input, integer): the plot identifier, returned by GROPEN.
C XSIZE, YSIZE (output, real): the default character size
C      (absolute device units).
C XSPACE, YSPACE (output, real): the default character spacing
C      (absolute units); XSPACE is the distance between the lower left
C      corners of adjacent characters in a plotted string; YSPACE
C      is the corresponding vertical spacing.
C--
C (1-Feb-1983)
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER  IDENT
      REAL     FACTOR, XSIZE, YSIZE, XSPACE, YSPACE
C
      CALL GRSLCT(IDENT)
      FACTOR = GRCSCL(IDENT)
      XSIZE = GRCXSZ * FACTOR
      YSIZE = GRCYSZ * FACTOR
      XSPACE = 10.0 * FACTOR
      YSPACE = 13.0 * FACTOR
      END
#<

#>            grclip.dc3
Name:         GRCLIP

Purpose:      clip a point against clipping rectangle

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRCLIP (X,Y,XMIN,XMAX,YMIN,YMAX,C)
            REAL X,Y
            REAL XMIN,XMAX,YMIN,YMAX
            INTEGER C
      
       GRPCKG (internal routine): support routine for the clipping algorithm;
       called from GRLIN0 only. C is a 4 bit code indicating the relationship
       between point (X,Y) and the window boundaries; 0 implies the point is
       within the window.
      
       Arguments:

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grclip.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRCLIP -- clip a point against clipping rectangle
C+
      SUBROUTINE GRCLIP (X,Y,XMIN,XMAX,YMIN,YMAX,C)
      REAL X,Y
      REAL XMIN,XMAX,YMIN,YMAX
      INTEGER C
C
C GRPCKG (internal routine): support routine for the clipping algorithm;
C called from GRLIN0 only. C is a 4 bit code indicating the relationship
C between point (X,Y) and the window boundaries; 0 implies the point is
C within the window.
C
C Arguments:
C--
C (11-Feb-1983)
C Revised 20-Jun-1985 (TJP); use floating arithmetic
C Revised 12-Jun-1992 (TJP); clip exactly on the boundary
C-----------------------------------------------------------------------
C
      C = 0
      IF (X.LT.XMIN) THEN
          C = 1
      ELSE IF (X.GT.XMAX) THEN
          C = 2
      END IF
      IF (Y.LT.YMIN) THEN
          C = C+4
      ELSE IF (Y.GT.YMAX) THEN
          C = C+8
      END IF
      END
#<

#>            grclos.dc3
Name:         GRCLOS

Purpose:      close graphics device

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRCLOS
      
       GRPCKG: Close the open plot on the current device. Any pending output
       is sent to the device, the device is released for other users or the
       disk file is closed, and no further plotting is allowed on the device
       without a new call to GROPEN.
      
       Arguments: none.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grclos.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRCLOS -- close graphics device
C+
      SUBROUTINE GRCLOS
C
C GRPCKG: Close the open plot on the current device. Any pending output
C is sent to the device, the device is released for other users or the
C disk file is closed, and no further plotting is allowed on the device
C without a new call to GROPEN.
C
C Arguments: none.
C--
C  1-Jun-1984 - [TJP].
C 17-Jul-1984 - ignore call if plot is not open [TJP].
C  1-Oct-1984 - reset color to default (1) and position text cursor
C               at bottom of VT screen [TJP].
C 19-Oct-1984 - add VV device [TJP].
C 22-Dec-1984 - use GRBUFL and GRIOTA parameters [TJP].
C  5-Aug-1986 - add GREXEC support [AFT].
C 21-Feb-1987 - modify END_PICTURE sequence [AFT].
C 11-Jun-1987 - remove built-ins [TJP].
C 31-Aug-1987 - do not eject blank page [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      REAL    RBUF(6)
      INTEGER NBUF,LCHR
      CHARACTER CHR
C
C Check a plot is open.
C
      IF (GRCIDE.LT.1) RETURN
C
C Reset color to default (1). This is useful
C for VT240 terminals, which use the color tables for text.
C
      CALL GRSCI(1)
C
C Flush buffer.
C
      CALL GRTERM
C
C End picture.
C
      CALL GREPIC
C
C This plot identifier is no longer in use.
C Set state to "workstation closed".
C
      GRSTAT(GRCIDE) = 0
      GRCIDE = 0
C
C Close workstation.
C
      CALL GREXEC(GRGTYP,10,RBUF,NBUF,CHR,LCHR)
C
      END
#<

#>            grclpl.dc3
Name:         GRCLPL

Purpose:      clip line against clipping rectangle

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRCLPL (X0,Y0,X1,Y1,VIS)
      
       GRPCKG (internal routine): Change the end-points of the line (X0,Y0)
       (X1,Y1) to clip the line at the window boundary.  The algorithm is
       that of Cohen and Sutherland (ref: Newman & Sproull).
      
       Arguments:
      
       X0, Y0 (input/output, real): device coordinates of starting point
             of line.
       X1, Y1 (input/output, real): device coordinates of end point of line.
       VIS (output, logical): .TRUE. if line lies wholly or partially
             within the clipping rectangle; .FALSE. if it lies entirely
             outside the rectangle.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
              Oct 24, 1998: JPT use GIPSY's IANDF function instead of IAND
#<

#>            grclpl.f
* GIPSY-modified
*

C*GRCLPL -- clip line against clipping rectangle
C+
      SUBROUTINE GRCLPL (X0,Y0,X1,Y1,VIS)
C
C GRPCKG (internal routine): Change the end-points of the line (X0,Y0)
C (X1,Y1) to clip the line at the window boundary.  The algorithm is
C that of Cohen and Sutherland (ref: Newman & Sproull).
C
C Arguments:
C
C X0, Y0 (input/output, real): device coordinates of starting point
C       of line.
C X1, Y1 (input/output, real): device coordinates of end point of line.
C VIS (output, logical): .TRUE. if line lies wholly or partially
C       within the clipping rectangle; .FALSE. if it lies entirely
C       outside the rectangle.
C--
C 13-Jul-1984 - [TJP].
C 20-Jun-1985 - [TJP] - revise clipping algorithm.
C 28-Jun-1991 - [TJP] - use IAND().
C 12-Jun-1992 - [TJP] - clip exactly on the boundary.
C 24-Oct-1998 - [JPT] - use GIPSY's IANDF instead of IAND
C
C Caution: IAND is a non-standard intrinsic function to do bitwise AND
C of two integers. If it is not supported by your Fortran compiler, you
C will need to modify this routine or supply an IAND function.
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      LOGICAL  VIS
      INTEGER  C0,C1,C
      REAL     XMIN,XMAX,YMIN,YMAX
      REAL     X,Y, X0,Y0, X1,Y1
      INTEGER IANDF
C
      XMIN = GRXMIN(GRCIDE)
      YMIN = GRYMIN(GRCIDE)
      XMAX = GRXMAX(GRCIDE)
      YMAX = GRYMAX(GRCIDE)
      CALL GRCLIP(X0,Y0,XMIN,XMAX,YMIN,YMAX,C0)
      CALL GRCLIP(X1,Y1,XMIN,XMAX,YMIN,YMAX,C1)
   10 IF (C0.NE.0 .OR. C1.NE.0) THEN
          IF (IANDF(C0,C1).NE.0) THEN
C             ! line is invisible
              VIS = .FALSE.
              RETURN
          END IF
          C = C0
          IF (C.EQ.0) C = C1
          IF (IANDF(C,1).NE.0) THEN
C             ! crosses XMIN
              Y = Y0 + (Y1-Y0)*(XMIN-X0)/(X1-X0)
              X = XMIN
          ELSE IF (IANDF(C,2).NE.0) THEN
C             ! crosses XMAX
              Y = Y0 + (Y1-Y0)*(XMAX-X0)/(X1-X0)
              X = XMAX
          ELSE IF (IANDF(C,4).NE.0) THEN
C             ! crosses YMIN
              X = X0 + (X1-X0)*(YMIN-Y0)/(Y1-Y0)
              Y = YMIN
          ELSE IF (IANDF(C,8).NE.0) THEN
C             ! crosses YMAX
              X = X0 + (X1-X0)*(YMAX-Y0)/(Y1-Y0)
              Y = YMAX
          END IF
          IF (C.EQ.C0) THEN
              X0 = X
              Y0 = Y
              CALL GRCLIP(X,Y,XMIN,XMAX,YMIN,YMAX,C0)
          ELSE
              X1 = X
              Y1 = Y
              CALL GRCLIP(X,Y,XMIN,XMAX,YMIN,YMAX,C1)
          END IF
      GOTO 10
      END IF
      VIS = .TRUE.
      END
#<

#>            grclpl.f.orig
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRCLPL -- clip line against clipping rectangle
C+
      SUBROUTINE GRCLPL (X0,Y0,X1,Y1,VIS)
C
C GRPCKG (internal routine): Change the end-points of the line (X0,Y0)
C (X1,Y1) to clip the line at the window boundary.  The algorithm is
C that of Cohen and Sutherland (ref: Newman & Sproull).
C
C Arguments:
C
C X0, Y0 (input/output, real): device coordinates of starting point
C       of line.
C X1, Y1 (input/output, real): device coordinates of end point of line.
C VIS (output, logical): .TRUE. if line lies wholly or partially
C       within the clipping rectangle; .FALSE. if it lies entirely
C       outside the rectangle.
C--
C 13-Jul-1984 - [TJP].
C 20-Jun-1985 - [TJP] - revise clipping algorithm.
C 28-Jun-1991 - [TJP] - use IAND().
C 12-Jun-1992 - [TJP] - clip exactly on the boundary.
C
C Caution: IAND is a non-standard intrinsic function to do bitwise AND
C of two integers. If it is not supported by your Fortran compiler, you
C will need to modify this routine or supply an IAND function.
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      LOGICAL  VIS
      INTEGER  C0,C1,C
      REAL     XMIN,XMAX,YMIN,YMAX
      REAL     X,Y, X0,Y0, X1,Y1
      INTEGER IAND
C
      XMIN = GRXMIN(GRCIDE)
      YMIN = GRYMIN(GRCIDE)
      XMAX = GRXMAX(GRCIDE)
      YMAX = GRYMAX(GRCIDE)
      CALL GRCLIP(X0,Y0,XMIN,XMAX,YMIN,YMAX,C0)
      CALL GRCLIP(X1,Y1,XMIN,XMAX,YMIN,YMAX,C1)
   10 IF (C0.NE.0 .OR. C1.NE.0) THEN
          IF (IAND(C0,C1).NE.0) THEN
C             ! line is invisible
              VIS = .FALSE.
              RETURN
          END IF
          C = C0
          IF (C.EQ.0) C = C1
          IF (IAND(C,1).NE.0) THEN
C             ! crosses XMIN
              Y = Y0 + (Y1-Y0)*(XMIN-X0)/(X1-X0)
              X = XMIN
          ELSE IF (IAND(C,2).NE.0) THEN
C             ! crosses XMAX
              Y = Y0 + (Y1-Y0)*(XMAX-X0)/(X1-X0)
              X = XMAX
          ELSE IF (IAND(C,4).NE.0) THEN
C             ! crosses YMIN
              X = X0 + (X1-X0)*(YMIN-Y0)/(Y1-Y0)
              Y = YMIN
          ELSE IF (IAND(C,8).NE.0) THEN
C             ! crosses YMAX
              X = X0 + (X1-X0)*(YMAX-Y0)/(Y1-Y0)
              Y = YMAX
          END IF
          IF (C.EQ.C0) THEN
              X0 = X
              Y0 = Y
              CALL GRCLIP(X,Y,XMIN,XMAX,YMIN,YMAX,C0)
          ELSE
              X1 = X
              Y1 = Y
              CALL GRCLIP(X,Y,XMIN,XMAX,YMIN,YMAX,C1)
          END IF
      GOTO 10
      END IF
      VIS = .TRUE.
      END
#<

#>            grctoi.dc3
Name:         GRCTOI

Purpose:      convert character string to integer

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            INTEGER FUNCTION GRCTOI (S, I)
            CHARACTER*(*) S
            INTEGER I
      
       GRCTOI: attempt to read an integer from a character string, and return
       the result. No attempt is made to avoid integer overflow. A valid 
       integer is any sequence of decimal digits.
      
       Returns:
        GRCTOI           : the value of the integer; if the first character
                          read is not a decimal digit, the value returned
                          is zero.
       Arguments:
        S      (input)  : character string to be parsed.
        I      (in/out) : on input, I is the index of the first character
                          in S to be examined; on output, either it points
                          to the next character after a valid integer, or
                          it is equal to LEN(S)+1.
      

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grctoi.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRCTOI -- convert character string to integer
C+
      INTEGER FUNCTION GRCTOI (S, I)
      CHARACTER*(*) S
      INTEGER I
C
C GRCTOI: attempt to read an integer from a character string, and return
C the result. No attempt is made to avoid integer overflow. A valid 
C integer is any sequence of decimal digits.
C
C Returns:
C  GRCTOI           : the value of the integer; if the first character
C                    read is not a decimal digit, the value returned
C                    is zero.
C Arguments:
C  S      (input)  : character string to be parsed.
C  I      (in/out) : on input, I is the index of the first character
C                    in S to be examined; on output, either it points
C                    to the next character after a valid integer, or
C                    it is equal to LEN(S)+1.
C
C--
C  1985 Oct  8 - New routine, based on CTOI (T. J. Pearson).
C  1997 Jun  3 - allow leading + or - sign (TJP).
C-----------------------------------------------------------------------
      INTEGER K, SIGN, X
      CHARACTER*1 DIGITS(0:9)
      DATA  DIGITS/'0','1','2','3','4','5','6','7','8','9'/
C
      X = 0
      SIGN = +1
      IF (I.GT.LEN(S)) GOTO 30
      IF (S(I:I).EQ.'+') THEN
         I = I+1
      ELSE IF (S(I:I).EQ.'-') THEN
         I = I+1
         SIGN = -1
      END IF
 10   IF (I.GT.LEN(S)) GOTO 30
      DO 20 K=0,9
         IF (S(I:I).EQ.DIGITS(K)) THEN
            X = X*10 + K
            I = I+1
            GOTO 10
         END IF
 20   CONTINUE
 30   GRCTOI = X*SIGN
      RETURN
      END
#<

#>            grcurs.dc3
Name:         GRCURS

Purpose:      read cursor position

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            INTEGER FUNCTION GRCURS (IDENT,IX,IY,IXREF,IYREF,MODE,POSN,CH)
            INTEGER IDENT, IX, IY, IXREF, IYREF, MODE, POSN
            CHARACTER*(*) CH
      
       GRPCKG: Read the cursor position and a character typed by the user.
       The position is returned in absolute device coordinates (pixels).
       GRCURS positions the cursor at the position specified, and
       allows the user to move the cursor using the joystick or
       arrow keys or whatever is available on the device. When he has
       positioned the cursor, the user types a single character on his
       keyboard; GRCURS then returns this character and the new cursor
       position.
      
       "Rubber band" feedback of cursor movement can be requested (although
       it may not be supported on some devices). If MODE=1, a line from
       the anchor point to the current cursor position is displayed as
       the cursor is moved. If MODE=2, a rectangle with vertical and
       horizontal sides and one vertex at the anchor point and the opposite
       vertex at the current cursor position is displayed as the cursor is
       moved.
      
       Returns:
      
       GRCURS (integer): 1 if the call was successful; 0 if the device
            has no cursor or some other error occurs. 
      
       Arguments:
      
       IDENT (integer, input):  GRPCKG plot identifier (from GROPEN).
       IX    (integer, in/out): the device x-coordinate of the cursor.
       IY    (integer, in/out): the device y-coordinate of the cursor.
       IXREF (integer, input):  x-coordinate of anchor point.
       IYREF (integer, input):  y-coordinate of anchor point.
       MODE  (integer, input):  type of rubber-band feedback.
       CH    (char,    output): the character typed by the user; if the device
            has no cursor or if some other error occurs, the value CHAR(0)
            [ASCII NUL character] is returned.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grcurs.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRCURS -- read cursor position
C+
      INTEGER FUNCTION GRCURS (IDENT,IX,IY,IXREF,IYREF,MODE,POSN,CH)
      INTEGER IDENT, IX, IY, IXREF, IYREF, MODE, POSN
      CHARACTER*(*) CH
C
C GRPCKG: Read the cursor position and a character typed by the user.
C The position is returned in absolute device coordinates (pixels).
C GRCURS positions the cursor at the position specified, and
C allows the user to move the cursor using the joystick or
C arrow keys or whatever is available on the device. When he has
C positioned the cursor, the user types a single character on his
C keyboard; GRCURS then returns this character and the new cursor
C position.
C
C "Rubber band" feedback of cursor movement can be requested (although
C it may not be supported on some devices). If MODE=1, a line from
C the anchor point to the current cursor position is displayed as
C the cursor is moved. If MODE=2, a rectangle with vertical and
C horizontal sides and one vertex at the anchor point and the opposite
C vertex at the current cursor position is displayed as the cursor is
C moved.
C
C Returns:
C
C GRCURS (integer): 1 if the call was successful; 0 if the device
C      has no cursor or some other error occurs. 
C
C Arguments:
C
C IDENT (integer, input):  GRPCKG plot identifier (from GROPEN).
C IX    (integer, in/out): the device x-coordinate of the cursor.
C IY    (integer, in/out): the device y-coordinate of the cursor.
C IXREF (integer, input):  x-coordinate of anchor point.
C IYREF (integer, input):  y-coordinate of anchor point.
C MODE  (integer, input):  type of rubber-band feedback.
C CH    (char,    output): the character typed by the user; if the device
C      has no cursor or if some other error occurs, the value CHAR(0)
C      [ASCII NUL character] is returned.
C--
C  1-Aug-1984 - extensively revised [TJP].
C 29-Jan-1985 - add ARGS and HP2648 devices (?) [KS/TJP].
C  5-Aug-1986 - add GREXEC support [AFT].
C 11-Jun-1987 - remove built-ins [TJP].
C 15-Feb-1988 - remove test for batch jobs; leave this to the device
C               handler [TJP].
C 13-Dec-1990 - remove code to abort after 10 cursor errors [TJP].
C  7-Sep-1994 - add support for rubber-band modes [TJP].
C 17-Jan-1995 - start picture if necessary [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      REAL           RBUF(6)
      INTEGER        NBUF, LCHR, ICURS, ERRCNT
      CHARACTER*16   CHR
      CHARACTER      C
      SAVE           ERRCNT
      DATA           ERRCNT/0/
C
C Validate identifier, and select device.
C
      CALL GRSLCT(IDENT)
      CALL GRTERM
C
C Begin picture if necessary.
C
      IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC
C
C Make sure cursor is on view surface. (It does not
C have to be in the viewport.)
C
      IX = MAX(0,MIN(GRXMXA(GRCIDE),IX))
      IY = MAX(0,MIN(GRYMXA(GRCIDE),IY))
C
C Does the device have a cursor?
C
      C = GRGCAP(GRCIDE)(2:2)
      ICURS = 0
      IF (C.EQ.'C' .OR. C.EQ.'X') ICURS=1
C
C Device does have a cursor.
C
      IF (ICURS.GT.0) THEN
C         -- initial position of cursor
          RBUF(1) = IX
          RBUF(2) = IY
C         -- reference point for rubber band
          RBUF(3) = IXREF
          RBUF(4) = IYREF
C         -- rubber band mode
          RBUF(5) = MODE
C         -- position cursor?
          RBUF(6) = POSN
          NBUF = 6
          LCHR = 0
          CALL GREXEC(GRGTYP,17,RBUF,NBUF,CHR,LCHR)
          IX = RBUF(1)
          IY = RBUF(2)
          CH = CHR(1:1)
          GRCURS = 1
C         -- error if driver returns NUL
          IF (ICHAR(CHR(1:1)).EQ.0) GRCURS = 0
C
C Other devices are illegal.
C
      ELSE
          CALL GREXEC(GRGTYP, 1,RBUF,NBUF,CHR,LCHR)
          LCHR = INDEX(CHR,' ')
          IF (ERRCNT.LE.10) CALL 
     1        GRWARN('output device has no cursor: '//CHR(:LCHR))
          CH = CHAR(0)
          GRCURS = 0
          ERRCNT = ERRCNT+1
      END IF
C
      END
#<

#>            grdat2.dc3
Name:         GRDAT2

Purpose:      character set definition (block data)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            BLOCK DATA GRDAT2
      
       GRPCKG (internal routine): Block data for to define the character set.
      
       Arguments: none.
      
       (1-Feb-1983)

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grdat2.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRDAT2 -- character set definition (block data)
C+
      BLOCK DATA GRDAT2
C
C GRPCKG (internal routine): Block data for to define the character set.
C
C Arguments: none.
C
C (1-Feb-1983)
C-----------------------------------------------------------------------
      INTEGER   CTD1, CTD2
      PARAMETER (CTD1 = 30)
      PARAMETER (CTD2 = 128)
C
      INTEGER   CINDX1, CINDX2
      INTEGER   CHTBL(CTD1,CTD2)
      INTEGER   SPCH00(CTD1), SPCH01(CTD1), SPCH02(CTD1), SPCH03(CTD1)
     1        , SPCH04(CTD1), SPCH05(CTD1), SPCH06(CTD1), SPCH07(CTD1)
     2        , SPCH08(CTD1), SPCH09(CTD1), SPCH10(CTD1), SPCH11(CTD1)
     3        , SPCH12(CTD1), SPCH13(CTD1), SPCH14(CTD1), SPCH15(CTD1)
     4        , SPCH16(CTD1), SPCH17(CTD1), SPCH18(CTD1), SPCH19(CTD1)
     5        , SPCH20(CTD1), SPCH21(CTD1), SPCH22(CTD1), SPCH23(CTD1)
     6        , SPCH24(CTD1), SPCH25(CTD1), SPCH26(CTD1), SPCH27(CTD1)
     7        , SPCH28(CTD1), SPCH29(CTD1), SPCH30(CTD1), SPCH31(CTD1)
     8        , SPACE (CTD1), EXCLAM(CTD1), QUOTE (CTD1), POUND (CTD1)
     9        , DOLLAR(CTD1), PERCNT(CTD1), AMPERS(CTD1), APOSTR(CTD1)
     A        , LPAREN(CTD1), RPAREN(CTD1), ASTER (CTD1), PLUS  (CTD1)
     B        , COMMA (CTD1), MINUS (CTD1), PERIOD(CTD1), SLASH (CTD1)
     C        , ZERO  (CTD1), ONE   (CTD1), TWO   (CTD1), THREE (CTD1)
     D        , FOUR  (CTD1), FIVE  (CTD1), SIX   (CTD1), SEVEN (CTD1)
     E        , EIGHT (CTD1), NINE  (CTD1), COLON (CTD1), SEMICO(CTD1)
     F        , LESS  (CTD1), EQUALS(CTD1), GREATR(CTD1), QUESTN(CTD1)
      INTEGER   ATSIGN(CTD1), AUPPER(CTD1), BUPPER(CTD1), CUPPER(CTD1)
     1        , DUPPER(CTD1), EUPPER(CTD1), FUPPER(CTD1), GUPPER(CTD1)
     2        , HUPPER(CTD1), IUPPER(CTD1), JUPPER(CTD1), KUPPER(CTD1)
     3        , LUPPER(CTD1), MUPPER(CTD1), NUPPER(CTD1), OUPPER(CTD1)
     4        , PUPPER(CTD1), QUPPER(CTD1), RUPPER(CTD1), SUPPER(CTD1)
     5        , TUPPER(CTD1), UUPPER(CTD1), VUPPER(CTD1), WUPPER(CTD1)
     6        , XUPPER(CTD1), YUPPER(CTD1), ZUPPER(CTD1), LBRACK(CTD1)
     7        , BKSLSH(CTD1), RBRACK(CTD1), CARET (CTD1), USCORE(CTD1)
     8        , ACCENT(CTD1), ALOWER(CTD1), BLOWER(CTD1), CLOWER(CTD1)
     9        , DLOWER(CTD1), ELOWER(CTD1), FLOWER(CTD1), GLOWER(CTD1)
     A        , HLOWER(CTD1), ILOWER(CTD1), JLOWER(CTD1), KLOWER(CTD1)
     B        , LLOWER(CTD1), MLOWER(CTD1), NLOWER(CTD1), OLOWER(CTD1)
     C        , PLOWER(CTD1), QLOWER(CTD1), RLOWER(CTD1), SLOWER(CTD1)
     D        , TLOWER(CTD1), ULOWER(CTD1), VLOWER(CTD1), WLOWER(CTD1)
     E        , XLOWER(CTD1), YLOWER(CTD1), ZLOWER(CTD1), LBRACE(CTD1)
     F        , ORSIGN(CTD1), RBRACE(CTD1), TILDE (CTD1), SPC127(CTD1)
      EQUIVALENCE (SPCH00, CHTBL(1,   1)), (SPCH01, CHTBL(1,   2))
     1          , (SPCH02, CHTBL(1,   3)), (SPCH03, CHTBL(1,   4))
     2          , (SPCH04, CHTBL(1,   5)), (SPCH05, CHTBL(1,   6))
     3          , (SPCH06, CHTBL(1,   7)), (SPCH07, CHTBL(1,   8))
     4          , (SPCH08, CHTBL(1,   9)), (SPCH09, CHTBL(1,  10))
     5          , (SPCH10, CHTBL(1,  11)), (SPCH11, CHTBL(1,  12))
     6          , (SPCH12, CHTBL(1,  13)), (SPCH13, CHTBL(1,  14))
     7          , (SPCH14, CHTBL(1,  15)), (SPCH15, CHTBL(1,  16))
     8          , (SPCH16, CHTBL(1,  17)), (SPCH17, CHTBL(1,  18))
     9          , (SPCH18, CHTBL(1,  19)), (SPCH19, CHTBL(1,  20))
     A          , (SPCH20, CHTBL(1,  21)), (SPCH21, CHTBL(1,  22))
     B          , (SPCH22, CHTBL(1,  23)), (SPCH23, CHTBL(1,  24))
     C          , (SPCH24, CHTBL(1,  25)), (SPCH25, CHTBL(1,  26))
     D          , (SPCH26, CHTBL(1,  27)), (SPCH27, CHTBL(1,  28))
     E          , (SPCH28, CHTBL(1,  29)), (SPCH29, CHTBL(1,  30))
     F          , (SPCH30, CHTBL(1,  31)), (SPCH31, CHTBL(1,  32))
      EQUIVALENCE (SPACE , CHTBL(1,  33)), (EXCLAM, CHTBL(1,  34))
     1          , (QUOTE , CHTBL(1,  35)), (POUND , CHTBL(1,  36))
     2          , (DOLLAR, CHTBL(1,  37)), (PERCNT, CHTBL(1,  38))
     3          , (AMPERS, CHTBL(1,  39)), (APOSTR, CHTBL(1,  40))
     4          , (LPAREN, CHTBL(1,  41)), (RPAREN, CHTBL(1,  42))
     5          , (ASTER , CHTBL(1,  43)), (PLUS  , CHTBL(1,  44))
     6          , (COMMA , CHTBL(1,  45)), (MINUS , CHTBL(1,  46))
     7          , (PERIOD, CHTBL(1,  47)), (SLASH , CHTBL(1,  48))
     8          , (ZERO  , CHTBL(1,  49)), (ONE   , CHTBL(1,  50))
     9          , (TWO   , CHTBL(1,  51)), (THREE , CHTBL(1,  52))
     A          , (FOUR  , CHTBL(1,  53)), (FIVE  , CHTBL(1,  54))
     B          , (SIX   , CHTBL(1,  55)), (SEVEN , CHTBL(1,  56))
     C          , (EIGHT , CHTBL(1,  57)), (NINE  , CHTBL(1,  58))
     D          , (COLON , CHTBL(1,  59)), (SEMICO, CHTBL(1,  60))
     E          , (LESS  , CHTBL(1,  61)), (EQUALS, CHTBL(1,  62))
     F          , (GREATR, CHTBL(1,  63)), (QUESTN, CHTBL(1,  64))
      EQUIVALENCE (ATSIGN, CHTBL(1,  65)), (AUPPER, CHTBL(1,  66))
     1          , (BUPPER, CHTBL(1,  67)), (CUPPER, CHTBL(1,  68))
     2          , (DUPPER, CHTBL(1,  69)), (EUPPER, CHTBL(1,  70))
     3          , (FUPPER, CHTBL(1,  71)), (GUPPER, CHTBL(1,  72))
     4          , (HUPPER, CHTBL(1,  73)), (IUPPER, CHTBL(1,  74))
     5          , (JUPPER, CHTBL(1,  75)), (KUPPER, CHTBL(1,  76))
     6          , (LUPPER, CHTBL(1,  77)), (MUPPER, CHTBL(1,  78))
     7          , (NUPPER, CHTBL(1,  79)), (OUPPER, CHTBL(1,  80))
     8          , (PUPPER, CHTBL(1,  81)), (QUPPER, CHTBL(1,  82))
     9          , (RUPPER, CHTBL(1,  83)), (SUPPER, CHTBL(1,  84))
     A          , (TUPPER, CHTBL(1,  85)), (UUPPER, CHTBL(1,  86))
     B          , (VUPPER, CHTBL(1,  87)), (WUPPER, CHTBL(1,  88))
     C          , (XUPPER, CHTBL(1,  89)), (YUPPER, CHTBL(1,  90))
     D          , (ZUPPER, CHTBL(1,  91)), (LBRACK, CHTBL(1,  92))
     E          , (BKSLSH, CHTBL(1,  93)), (RBRACK, CHTBL(1,  94))
     F          , (CARET , CHTBL(1,  95)), (USCORE, CHTBL(1,  96))
      EQUIVALENCE (ACCENT, CHTBL(1,  97)), (ALOWER, CHTBL(1,  98))
     1          , (BLOWER, CHTBL(1,  99)), (CLOWER, CHTBL(1, 100))
     2          , (DLOWER, CHTBL(1, 101)), (ELOWER, CHTBL(1, 102))
     3          , (FLOWER, CHTBL(1, 103)), (GLOWER, CHTBL(1, 104))
     4          , (HLOWER, CHTBL(1, 105)), (ILOWER, CHTBL(1, 106))
     5          , (JLOWER, CHTBL(1, 107)), (KLOWER, CHTBL(1, 108))
     6          , (LLOWER, CHTBL(1, 109)), (MLOWER, CHTBL(1, 110))
     7          , (NLOWER, CHTBL(1, 111)), (OLOWER, CHTBL(1, 112))
     8          , (PLOWER, CHTBL(1, 113)), (QLOWER, CHTBL(1, 114))
     9          , (RLOWER, CHTBL(1, 115)), (SLOWER, CHTBL(1, 116))
     A          , (TLOWER, CHTBL(1, 117)), (ULOWER, CHTBL(1, 118))
     B          , (VLOWER, CHTBL(1, 119)), (WLOWER, CHTBL(1, 120))
     C          , (XLOWER, CHTBL(1, 121)), (YLOWER, CHTBL(1, 122))
     D          , (ZLOWER, CHTBL(1, 123)), (LBRACE, CHTBL(1, 124))
     E          , (ORSIGN, CHTBL(1, 125)), (RBRACE, CHTBL(1, 126))
     F          , (TILDE , CHTBL(1, 127)), (SPC127, CHTBL(1, 128))
C
      COMMON /GRCS02/ CINDX1, CINDX2, CHTBL
C
      DATA CINDX1 /1/
      DATA CINDX2 /0/
C
      DATA SPCH00 /07, 34, 37, 67, 61, 01, 07, 37, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH01 /11, 34, 37, 47, 65, 63, 41, 21, 03, 05
     1           , 27, 37, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH02 /07, 34, 37, 64, 61, 01, 04, 37, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH03 /02, 04, 64, 02, 37, 31, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH04 /02, 01, 67, 02, 07, 61, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH05 /06, 34, 37, 64, 31, 04, 37, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH06 /05, 31, 37, 64, 04, 37, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH07 /04, 01, 67, 07, 61, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH08 /04, 07, 67, 01, 61, 02, 14, 54, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH09 /03, 07, 34, 67, 02, 34, 31, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH10 /06, 61, 52, 56, 16, 12, 52, 02, 01, 12
     1           , 02, 07, 16, 02, 67, 34, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH11 /02, 01, 67, 02, 07, 61, 02, 04, 64, 02
     1           , 37, 31, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH12 /05, 01, 67, 07, 61, 01, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH13 /02, 24, 44, 02, 37, 31, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH14 /02, 07, 67, 02, 01, 61, 05, 31, 64, 37
     1           , 04, 31, 01, 34, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH15 /07, 23, 43, 44, 24, 25, 45, 44, 02, 35
     1           , 33, 02, 23, 24, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH16 /27, 01, 61, 62, 02, 03, 63, 64, 04, 05
     1           , 65, 66, 06, 07, 67, 61, 51, 57, 47, 41
     2           , 31, 37, 27, 21, 11, 17, 07, 01, 00, 00/
      DATA SPCH17 /14, 21, 41, 52, 12, 03, 63, 64, 04, 05
     1           , 65, 56, 16, 27, 47, 14, 03, 05, 16, 12
     2           , 21, 27, 37, 31, 41, 47, 56, 52, 63, 65/
      DATA SPCH18 /12, 31, 42, 22, 13, 53, 64, 04, 15, 55
     1           , 46, 26, 37, 12, 64, 55, 53, 42, 46, 37
     2           , 31, 22, 26, 15, 13, 04, 00, 00, 00, 00/
      DATA SPCH19 /09, 26, 15, 13, 22, 42, 53, 55, 46, 26
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH20 /09, 27, 05, 03, 21, 41, 63, 65, 47, 27
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH21 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH22 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH23 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH24 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH25 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH26 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH27 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH28 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH29 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH30 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPCH31 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPACE  /00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA EXCLAM /02, 38, 33, 01, 30, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA QUOTE  /02, 28, 26, 02, 48, 46, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA POUND  /02, 10, 18, 02, 58, 50, 02, 62, 02, 02
     1           , 06, 66, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA DOLLAR /10, 01, 51, 62, 63, 54, 14, 05, 06, 17
     1           , 67, 02, 38, 30, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA PERCNT /05, 07, 18, 27, 16, 07, 02, 01, 67, 05
     1           , 50, 61, 52, 41, 50, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA AMPERS /11, 60, 06, 07, 18, 48, 46, 02, 01, 10
     1           , 30, 63, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA APOSTR /06, 24, 46, 48, 38, 37, 47, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA LPAREN /04, 40, 22, 26, 48, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA RPAREN /04, 20, 42, 46, 28, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA ASTER  /02, 01, 67, 02, 07, 61, 02, 04, 64, 02
     1           , 37, 31, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA PLUS   /02, 14, 54, 02, 36, 32, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA COMMA  /06, 20, 42, 44, 34, 33, 43, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA MINUS  /02, 14, 54, 00, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA PERIOD /05, 20, 30, 31, 21, 20, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SLASH  /02, 01, 67, 00, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA ZERO   /09, 10, 50, 61, 67, 58, 18, 07, 01, 10
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA ONE    /02, 10, 50, 03, 30, 38, 16, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA TWO    /10, 07, 18, 58, 67, 65, 54, 24, 02, 00
     1           , 60, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA THREE  /07, 07, 18, 58, 67, 65, 54, 34, 06, 54
     1           , 63, 61, 50, 10, 01, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA FOUR   /05, 50, 58, 03, 02, 72, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA FIVE   /10, 01, 10, 40, 62, 63, 45, 05, 08, 68
     1           , 67, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SIX    /11, 04, 54, 63, 61, 50, 10, 01, 06, 28
     1           , 58, 67, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SEVEN  /06, 20, 23, 67, 68, 08, 07, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA EIGHT  /16, 14, 03, 01, 10, 50, 61, 63, 54, 14
     1           , 05, 07, 18, 58, 67, 65, 54, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA NINE   /11, 01, 10, 40, 62, 67, 58, 18, 07, 05
     1           , 14, 64, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA COLON  /05, 22, 32, 33, 23, 22, 05, 26, 36, 37
     1           , 27, 26, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SEMICO /06, 10, 32, 34, 24, 23, 33, 05, 26, 36
     1           , 37, 27, 26, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA LESS   /03, 50, 14, 58, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA EQUALS /02, 12, 52, 02, 16, 56, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA GREATR /03, 10, 54, 18, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA QUESTN /07, 06, 07, 18, 58, 67, 34, 33, 01, 31
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA ATSIGN /13, 54, 45, 34, 43, 54, 64, 66, 48, 28
     1           , 06, 02, 20, 50, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA AUPPER /05, 00, 05, 38, 65, 60, 02, 03, 63, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA BUPPER /06, 00, 50, 61, 63, 54, 14, 05, 08, 58
     1           , 67, 65, 54, 02, 18, 10, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA CUPPER /08, 67, 58, 28, 06, 02, 20, 50, 61, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA DUPPER /06, 00, 40, 62, 66, 48, 08, 02, 18, 10
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA EUPPER /04, 60, 00, 08, 68, 02, 34, 04, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA FUPPER /03, 00, 08, 68, 02, 34, 04, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA GUPPER /10, 67, 58, 28, 06, 02, 20, 50, 61, 64
     1           , 44, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA HUPPER /02, 00, 08, 02, 60, 68, 02, 04, 64, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA IUPPER /02, 10, 50, 02, 30, 38, 02, 18, 58, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA JUPPER /05, 01, 10, 20, 31, 38, 02, 18, 58, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA KUPPER /02, 00, 08, 02, 68, 02, 02, 24, 60, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA LUPPER /03, 08, 00, 60, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA MUPPER /05, 00, 08, 35, 68, 60, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA NUPPER /02, 00, 08, 02, 07, 61, 02, 60, 68, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA OUPPER /09, 20, 40, 62, 66, 48, 28, 06, 02, 20
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA PUPPER /07, 00, 08, 58, 67, 66, 55, 05, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA QUPPER /09, 20, 40, 62, 66, 48, 28, 06, 02, 20
     1           , 02, 33, 60, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA RUPPER /07, 00, 08, 58, 67, 66, 55, 05, 02, 15
     1           , 60, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SUPPER /12, 01, 10, 50, 61, 63, 54, 14, 05, 07
     1           , 18, 58, 67, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA TUPPER /02, 30, 38, 02, 08, 68, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA UUPPER /06, 08, 01, 10, 50, 61, 68, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA VUPPER /05, 08, 03, 30, 63, 68, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA WUPPER /05, 08, 00, 33, 60, 68, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA XUPPER /04, 00, 01, 67, 68, 04, 08, 07, 61, 60
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA YUPPER /03, 08, 35, 68, 02, 35, 30, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA ZUPPER /06, 08, 68, 67, 01, 00, 60, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA LBRACK /04, 40, 20, 28, 48, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA BKSLSH /02, 07, 61, 00, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA RBRACK /04, 20, 40, 48, 28, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA CARET  /03, 05, 38, 65, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA USCORE /02,-01,-61, 00, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA ACCENT /05, 27, 28, 38, 37, 55, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA ALOWER /05, 06, 26, 35, 31, 40, 07, 31, 20, 10
     1           , 01, 02, 13, 33, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA BLOWER /02, 08, 00, 08, 02, 20, 30, 41, 44, 35
     1           , 25, 03, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA CLOWER /08, 41, 30, 10, 01, 04, 15, 35, 44, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA DLOWER /02, 48, 40, 08, 42, 20, 10, 01, 04, 15
     1           , 25, 43, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA ELOWER /10, 40, 10, 01, 04, 15, 35, 44, 43, 32
     1           , 02, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA FLOWER /04, 10, 17, 28, 37, 02, 04, 24, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA GLOWER /11, 40, 10, 01, 04, 15, 35, 44,-41,-23
     1           ,-13,-02, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA HLOWER /02, 00, 08, 05, 03, 25, 35, 44, 40, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA ILOWER /01, 37, 03, 25, 35, 30, 02, 20, 40, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA JLOWER /01, 37, 06, 35,-32,-23,-13,-02,-01, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA KLOWER /02, 08, 00, 02, 01, 45, 03, 40, 22, 23
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA LLOWER /02, 20, 40, 03, 30, 38, 28, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA MLOWER /06, 00, 04, 15, 25, 34, 30, 05, 34, 45
     1           , 55, 64, 60, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA NLOWER /02, 00, 05, 05, 03, 25, 35, 44, 40, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA OLOWER /09, 01, 04, 15, 35, 44, 41, 30, 10, 01
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA PLOWER /02,-03, 05, 08, 03, 25, 35, 44, 41, 30
     1           , 20, 02, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA QLOWER /02,-43, 45, 08, 43, 25, 15, 04, 01, 10
     1           , 20, 42, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA RLOWER /02, 00, 05, 04, 03, 25, 35, 44, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SLOWER /09, 00, 30, 41, 42, 33, 13, 04, 15, 45
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA TLOWER /02, 06, 26, 05, 18, 11, 20, 30, 41, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA ULOWER /05, 05, 01, 10, 20, 42, 02, 40, 45, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA VLOWER /05, 05, 02, 20, 42, 45, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA WLOWER /06, 05, 01, 10, 20, 31, 35, 05, 31, 40
     1           , 50, 61, 65, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA XLOWER /02, 00, 55, 02, 05, 50, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA YLOWER /05, 05, 01, 10, 30, 41, 05, 45,-42,-33
     1           ,-23,-12, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA ZLOWER /04, 05, 55, 00, 50, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA LBRACE /06, 40, 30, 21, 23, 14, 04, 05, 14, 25
     1           , 27, 38, 48, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA ORSIGN /02, 30, 38, 00, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA RBRACE /06, 20, 30, 41, 43, 54, 64, 05, 54, 45
     1           , 47, 38, 28, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA TILDE  /04, 06, 28, 46, 68, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      DATA SPC127 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     1           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
     2           , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/
      END
#<

#>            grdate.c.orig
#include <time.h>
#include <string.h>

#ifdef PG_PPU
#define GRDATE grdate_
#else
#define GRDATE grdate
#endif

/**GRDATE -- get date and time as character string (Cray)
 *+
 *    SUBROUTINE GRDATE(STRING, L)
 *    CHARACTER*(*) STRING
 *     INTEGER L
 *
 * Return the current date and time, in format 'dd-Mmm-yyyy hh:mm'.
 * To receive the whole string, the STRING should be declared
 * CHARACTER*17.
 *
 * Arguments:
 *  STRING : receives date and time, truncated or extended with
 *           blanks as necessary.
 *  SLEN   : receives the number of characters in STRING, excluding
 *           trailing blanks. This will always be 17, unless the length
 *           of the string supplied is shorter.
 *--
 * 09-Nov-1994 - [mcs] Fortran callable C version for CRAY.
 *-----------------------------------------------------------------------
 */
void GRDATE(string, slen, maxlen)
     char *string; int *slen; int maxlen;
{
  char vtime[18];  /* Output string compilation buffer */
  char *utime;     /* Returned string from ctime() */
  time_t x;        /* Time returned by time() */
  int i;
/*
 * Get the standard C time string.
 */
  time(&x);
  utime = ctime(&x);
/*
 * Copy a re-organised version of the time string into vtime[].
 */
  vtime[0] = utime[8];
  vtime[1] = utime[9];
  vtime[2] = '-';
  vtime[3] = utime[4];
  vtime[4] = utime[5];
  vtime[5] = utime[6];
  vtime[6] = '-';
  vtime[7] = utime[20];
  vtime[8] = utime[21];
  vtime[9] = utime[22];
  vtime[10] = utime[23];
  vtime[11] = ' ';
  strncpy(vtime+12, utime+11, 5);
  vtime[17]='\0';
/*
 * Copy up to maxlen characters of vtime into the output FORTRAN string.
 */
  strncpy(string, vtime, maxlen);
  *slen = (maxlen < 17) ? maxlen : 17;
/*
 * Pad the FORTRAN string with spaces.
 */
  for(i=17; i<maxlen; i++)
    string[i] = ' ';
  return;
}
#<

#>            grdate.dc3
Name:         GRDATE

Purpose:      get date and time as character string

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

          SUBROUTINE GRDATE(STRING, L)
          CHARACTER*(*) STRING
           INTEGER L
      
       Return the current date and time, in format 'dd-Mmm-yyyy hh:mm'.
       To receive the whole string, the STRING should be declared
       CHARACTER*17.
      
       Arguments:
        STRING : receives date and time, truncated or extended with
                 blanks as necessary.
        SLEN   : receives the number of characters in STRING, excluding
                 trailing blanks. This will always be 17, unless the length
                 of the string supplied is shorter.

Updates:      Oct 16, 1998: JPT document extracted from 5.2.0 source;
                                Fortran source copied from GIPSY's v4.9E.
#<

#>            grdate.f
* GIPSY-modified
*

C*GRDATE -- get date and time as character string (Alliant-UNIX)
C+
      SUBROUTINE GRDATE(STRING, L)
      CHARACTER*(*) STRING
      INTEGER L
C
C Return the current date and time, in format 'dd-Mmm-yyyy hh:mm'.
C To receive the whole string, the STRING should be declared
C CHARACTER*17.
C
C Arguments:
C  STRING : receives date and time, truncated or extended with
C           blanks as necessary.
C  L      : receives the number of characters in STRING, excluding
C           trailing blanks. This will always be 17, unless the length
C           of the string supplied is shorter.
C--
C 28-Jul-1988
C 23-Oct-1989 ALF. Conforms to Alliant use of FDATE.
C-----------------------------------------------------------------------
CWZ   CHARACTER*24 UTIME, FDATE
      CHARACTER*24 UTIME
      CHARACTER*17 VTIME
C
CWZ   UTIME = FDATE()
      CALL GETDATE(UTIME)
      VTIME(1:2) = UTIME(9:10)
      VTIME(3:3) = '-'
      VTIME(4:6) = UTIME(5:7)
      VTIME(7:7) = '-'
      VTIME(8:11) = UTIME(21:24)
      VTIME(12:12) = ' '
      VTIME(13:17) = UTIME(12:16)
      STRING = VTIME
      L = MIN(17, LEN(STRING))
      END
#<

#>            grdot0.dc3
Name:         GRDOT0

Purpose:      draw a dot

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRDOT0 (X,Y)
      
       GRPCKG (internal routine): Draw a single dot (pixel) at a specified
       location.
      
       Arguments:
      
       X, Y (real, input): absolute device coordinates of the dot (these
             are rounded to the nearest integer by GRDOT0).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grdot0.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRDOT0 -- draw a dot
C+
      SUBROUTINE GRDOT0 (X,Y)
C
C GRPCKG (internal routine): Draw a single dot (pixel) at a specified
C location.
C
C Arguments:
C
C X, Y (real, input): absolute device coordinates of the dot (these
C       are rounded to the nearest integer by GRDOT0).
C--
C (1-Jun-1984)
C 22-Oct-1984 - rewrite [TJP].
C 29-Jan-1985 - add HP2648 device [KS/TJP].
C  5-Aug-1986 - add GREXEC support [AFT].
C 21-Feb-1987 - If needed, calls begin picture [AFT].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER  NBUF, LCHR
      REAL     X, Y, RBUF(6)
      CHARACTER CHR
C
C (X,Y) is the new current position.
C
      GRXPRE(GRCIDE) = X
      GRYPRE(GRCIDE) = Y
C
C Check window.
C
      IF (X .LT. GRXMIN(GRCIDE)) RETURN
      IF (X .GT. GRXMAX(GRCIDE)) RETURN
      IF (Y .LT. GRYMIN(GRCIDE)) RETURN
      IF (Y .GT. GRYMAX(GRCIDE)) RETURN
C
C Begin picture if necessary.
C
      IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC
C
C If a "thick pen" is to be simulated, use the line-drawing routines
C instead.
C
      IF (GRWIDT(GRCIDE).GT.1) THEN
          CALL GRLIN3(X,Y,X,Y)
      ELSE
          RBUF(1)=X
          RBUF(2)=Y
          NBUF=2
          CALL GREXEC(GRGTYP,13,RBUF,NBUF,CHR,LCHR)
      END IF
      END
#<

#>            grdot1.dc3
Name:         GRDOT1

Purpose:      draw dots

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRDOT1(POINTS, X, Y)
            INTEGER POINTS
            REAL X(POINTS), Y(POINTS)
      
       GRPCKG (internal routine): Draw a set of dots.
      
       Arguments:
      
       POINTS (input, integer): the number of coordinate pairs.
       X, Y (input, real arrays, dimensioned POINTS or greater): the
             X and Y world coordinates of the points.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grdot1.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRDOT1 -- draw dots
C+
      SUBROUTINE GRDOT1(POINTS, X, Y)
      INTEGER POINTS
      REAL X(POINTS), Y(POINTS)
C
C GRPCKG (internal routine): Draw a set of dots.
C
C Arguments:
C
C POINTS (input, integer): the number of coordinate pairs.
C X, Y (input, real arrays, dimensioned POINTS or greater): the
C       X and Y world coordinates of the points.
C--
C 14-Mar-1997 - new routine to optimize drawing many dots [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER  I, NBUF, LCHR
      REAL     RBUF(2), XP, YP
      CHARACTER CHR
      EQUIVALENCE (XP, RBUF(1)), (YP, RBUF(2))
C
C Begin picture if necessary.
C
      IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC
C
C Loop for points: driver support.
C
      IF (GRWIDT(GRCIDE).LE.1) THEN
         NBUF = 2
         LCHR = 0
         DO 10 I=1,POINTS
C        -- Convert to device coordinates
            XP = X(I)*GRXSCL(GRCIDE) + GRXORG(GRCIDE)
            YP = Y(I)*GRYSCL(GRCIDE) + GRYORG(GRCIDE)
C           -- Clip against viewport
            IF (XP .GE. GRXMIN(GRCIDE) .AND.
     :          XP .LE. GRXMAX(GRCIDE) .AND.
     :          YP .GE. GRYMIN(GRCIDE) .AND.
     :          YP .LE. GRYMAX(GRCIDE)) THEN
               CALL GREXEC(GRGTYP,13,RBUF,NBUF,CHR,LCHR)
            END IF
 10      CONTINUE
C
C Thick line emulation required.
C
      ELSE
         DO 20 I=1,POINTS
C        -- Convert to device coordinates
            XP = X(I)*GRXSCL(GRCIDE) + GRXORG(GRCIDE)
            YP = Y(I)*GRYSCL(GRCIDE) + GRYORG(GRCIDE)
C           -- Clip against viewport
            IF (XP .GE. GRXMIN(GRCIDE) .AND.
     :          XP .LE. GRXMAX(GRCIDE) .AND.
     :          YP .GE. GRYMIN(GRCIDE) .AND.
     :          YP .LE. GRYMAX(GRCIDE)) THEN
               CALL GRLIN3(XP, YP, XP, YP)
            END IF
 20      CONTINUE
      END IF
C
C New pen position.
C
      GRXPRE(GRCIDE) = XP
      GRYPRE(GRCIDE) = YP
C
      END
#<

#>            grdtyp.dc3
Name:         GRDTYP

Purpose:      decode graphics device type string

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            INTEGER FUNCTION GRDTYP (TEXT)
      
       GRPCKG (internal routine): determine graphics device type code from
       type name. It compares the argument with the table of known device
       types in common.
      
       Argument:
      
       TEXT (input, character): device type name, eg 'PRINTRONIX'; the name
             may be abbreviated to uniqueness.
      
       Returns:
      
       GRDTYP (integer): the device type code, in the range 1 to
             GRTMAX, zero if the type name is not recognised, or -1
             if the type name is ambiguous.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grdtyp.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRDTYP -- decode graphics device type string
C+
      INTEGER FUNCTION GRDTYP (TEXT)
C
C GRPCKG (internal routine): determine graphics device type code from
C type name. It compares the argument with the table of known device
C types in common.
C
C Argument:
C
C TEXT (input, character): device type name, eg 'PRINTRONIX'; the name
C       may be abbreviated to uniqueness.
C
C Returns:
C
C GRDTYP (integer): the device type code, in the range 1 to
C       GRTMAX, zero if the type name is not recognised, or -1
C       if the type name is ambiguous.
C--
C 27-Dec-1984 - rewrite so that is doesn't have to be modified for
C               new devices [TJP].
C  5-Aug-1986 - add GREXEC support [AFT].
C 10-Nov-1995 - ignore drivers that report no device type [TJP].
C 30-Aug-1996 - check for an exact match; indicate if type is
C               ambiguous [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      CHARACTER*(*) TEXT
      INTEGER  CODE, I, L, MATCH
      REAL     RBUF(6)
      INTEGER NDEV,NBUF,LCHR
      INTEGER GRTRIM
      CHARACTER*32 CHR
C
      GRDTYP = 0
      L = GRTRIM(TEXT)
      IF (L.LT.1) RETURN
      MATCH = 0
      CODE = 0
      CALL GREXEC(0,0,RBUF,NBUF,CHR,LCHR)
      NDEV=NINT(RBUF(1))
      DO 30 I=1,NDEV
         CALL GREXEC(I, 1,RBUF,NBUF,CHR,LCHR)
         IF (LCHR.GT.0) THEN
            IF(TEXT(1:L).EQ.CHR(1:L)) THEN
               IF (CHR(L+1:L+1).EQ.' ') THEN
C                 -- exact match
                  GRDTYP = I
                  GRGTYP = GRDTYP
                  RETURN
               ELSE
                  MATCH = MATCH+1
                  CODE = I
               END IF
            END IF
         END IF
   30 CONTINUE
      IF (MATCH.EQ.0) THEN
C        -- no match
         GRDTYP = 0
      ELSE IF (MATCH.EQ.1) THEN
         GRDTYP = CODE
         GRGTYP = GRDTYP
      ELSE
         GRDTYP = -1
      END IF
C
      END
#<

#>            grepic.dc3
Name:         GREPIC

Purpose:      end picture

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GREPIC
      
       GRPCKG: End the current picture.
      
       Arguments: none.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grepic.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GREPIC -- end picture
C+
      SUBROUTINE GREPIC
C
C GRPCKG: End the current picture.
C
C Arguments: none.
C--
C 17-Nov-1994 - [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      REAL    RBUF(6)
      INTEGER NBUF,LCHR
      CHARACTER CHR
C
C Check a plot is open.
C
      IF (GRCIDE.LT.1) RETURN
C
C End picture.
C
      IF (GRPLTD(GRCIDE)) THEN
            RBUF(1) = 1.
            NBUF = 1
            CALL GREXEC(GRGTYP,14,RBUF,NBUF,CHR,LCHR)
      END IF
      GRPLTD(GRCIDE) = .FALSE.
C
      END
#<

#>            gresc.dc3
Name:         GRESC

Purpose:      escape routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRESC (TEXT)
      
       GRPCKG: "Escape" routine. The specified text is sent directly to the
       selected graphics device, with no interpretation by GRPCKG. This
       routine must be used with care; e.g., the programmer needs to know
       the device type of the currently selected device, and the instructions
       that that device can accept.
      
       Arguments: none.
        TEXT (input, character*(*)):  text to be sent to the device.
      
       15-May-1985 - new routine [TJP].
       26-May-1987 - add GREXEC support [TJP].
       19-Dec-1988 - start new page if necessary [TJP].
        4-Feb-1997 - RBUF should be an array, not a scalar [TJP].

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            gresc.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRESC -- escape routine
C+
      SUBROUTINE GRESC (TEXT)
C
C GRPCKG: "Escape" routine. The specified text is sent directly to the
C selected graphics device, with no interpretation by GRPCKG. This
C routine must be used with care; e.g., the programmer needs to know
C the device type of the currently selected device, and the instructions
C that that device can accept.
C
C Arguments: none.
C  TEXT (input, character*(*)):  text to be sent to the device.
C
C 15-May-1985 - new routine [TJP].
C 26-May-1987 - add GREXEC support [TJP].
C 19-Dec-1988 - start new page if necessary [TJP].
C  4-Feb-1997 - RBUF should be an array, not a scalar [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      CHARACTER*(*) TEXT
      REAL RBUF(1)
      INTEGER NBUF
C
C If no device is currently selected, do nothing.
C
      IF (GRCIDE.GT.0) THEN
          IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC
          NBUF = 0
          CALL GREXEC(GRGTYP,23,RBUF,NBUF,TEXT,LEN(TEXT))
      END IF
      END
#<

#>            gretxt.dc3
Name:         GRETXT

Purpose:      erase text from graphics screen

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRETXT
      
       GRPCKG: Erase the text screen.  Some graphics devices have
       two superimposed view surfaces, of which one is used for graphics and
       the other for alphanumeric text.  This routine erases the text
       view surface without affecting the graphics view surface. It does
       nothing if there is no text view surface associated with the device.
      
       Arguments: none.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            gretxt.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRETXT -- erase text from graphics screen
C+
      SUBROUTINE GRETXT
C
C GRPCKG: Erase the text screen.  Some graphics devices have
C two superimposed view surfaces, of which one is used for graphics and
C the other for alphanumeric text.  This routine erases the text
C view surface without affecting the graphics view surface. It does
C nothing if there is no text view surface associated with the device.
C
C Arguments: none.
C--
C (1-Feb-1983)
C 16-Oct-1984 - add ID100 device [RSS/TJP].
C 29-Jan-1985 - add HP2648 device [KS/TJP].
C  5-Aug-1986 - add GREXEC support [AFT].
C 11-Jun-1987 - remove built-in devices [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      CHARACTER*1   CHR
      REAL    RBUF(6)
      INTEGER NBUF,LCHR
C
      IF (GRCIDE.GE.1) THEN
          CALL GREXEC(GRGTYP,18,RBUF,NBUF,CHR,LCHR)
      END IF
C
      END
#<

#>            grfa.dc3
Name:         GRFA

Purpose:      fill area (polygon)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRFA (N,PX,PY)
            INTEGER N
            REAL PX(*), PY(*)
      
       GRPCKG: FILL AREA: fill a polygon with solid color.  The polygon
       is defined by the (x,y) world coordinates of its N vertices.  If
       this is not a function supported by the device, shading is
       accomplished by drawing horizontal lines spaced by 1 pixel.  By
       selecting color index 0, the interior of the polygon can be erased
       on devices which permit it.  The polygon need not be convex, but if
       it is re-entrant (i.e., edges intersect other than at the vertices),
       it may not be obvious which regions are "inside" the polygon.  The
       following rule is applied: for a given point, create a straight line
       starting at the point and going to infinity. If the number of
       intersections between the straight line and the polygon is odd, the
       point is within the polygon; otherwise it is outside. If the
       straight line passes a polygon vertex tangentially, the
       intersection  count is not affected. The only attribute which applies
       to FILL AREA is color index: line-width and line-style are ignored.
       There is a limitation on the complexity of the polygon: GFA will
       fail if any horizontal line intersects more than 32 edges of the
       polygon.
      
       Arguments:
      
       N (input, integer): the number of vertices of the polygon (at least
             3).
       PX, PY (input, real arrays, dimension at least N): world coordinates
             of the N vertices of the polygon.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grfa.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRFA -- fill area (polygon)
C+
      SUBROUTINE GRFA (N,PX,PY)
      INTEGER N
      REAL PX(*), PY(*)
C
C GRPCKG: FILL AREA: fill a polygon with solid color.  The polygon
C is defined by the (x,y) world coordinates of its N vertices.  If
C this is not a function supported by the device, shading is
C accomplished by drawing horizontal lines spaced by 1 pixel.  By
C selecting color index 0, the interior of the polygon can be erased
C on devices which permit it.  The polygon need not be convex, but if
C it is re-entrant (i.e., edges intersect other than at the vertices),
C it may not be obvious which regions are "inside" the polygon.  The
C following rule is applied: for a given point, create a straight line
C starting at the point and going to infinity. If the number of
C intersections between the straight line and the polygon is odd, the
C point is within the polygon; otherwise it is outside. If the
C straight line passes a polygon vertex tangentially, the
C intersection  count is not affected. The only attribute which applies
C to FILL AREA is color index: line-width and line-style are ignored.
C There is a limitation on the complexity of the polygon: GFA will
C fail if any horizontal line intersects more than 32 edges of the
C polygon.
C
C Arguments:
C
C N (input, integer): the number of vertices of the polygon (at least
C       3).
C PX, PY (input, real arrays, dimension at least N): world coordinates
C       of the N vertices of the polygon.
C--
C 16-Jul-1984 - [TJP].
C  5-Aug-1986 - add GREXEC support [AFT].
C 21-Feb-1987 - If needed, calls begin picture [AFT].
C  7-Sep-1994 - avoid driver call for capabilities [TJP].
C  1-May-1995 - fixed bug for re-entrant polygons, and optimized code
C               [A.F.Carman].
C 18-Oct-1995 - fixed bug: emulated fill failed for reversed y-axis
C               [S.C.Allendorf/TJP].
C  4-Dec-1995 - remove use of real variable as do-loop variable [TJP].
C 20-Mar-1996 - use another do loop 40 to avoid gaps between adjacent
C               polygons [RS]
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER MAXSEC
      PARAMETER (MAXSEC=32)
      INTEGER I, J, NSECT, LW, LS, NBUF, LCHR, LINE
      REAL    RBUF(6)
      CHARACTER*32 CHR
      REAL    X(MAXSEC), Y, YMIN, YMAX, DY, YD, TEMP, S1, S2, T1, T2
      LOGICAL FORWD
C
      IF (GRCIDE.LT.1) RETURN
      IF (N.LT.3) THEN
          CALL GRWARN('GRFA - polygon has < 3 vertices.')
          RETURN
      END IF
C
C Devices with polygon fill capability.
C
      IF(GRGCAP(GRCIDE)(4:4).EQ.'A') THEN
         IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC
         RBUF(1) = N
         CALL GREXEC(GRGTYP,20,RBUF,NBUF,CHR,LCHR)
         DO 10 I=1,N
            RBUF(1) = PX(I)*GRXSCL(GRCIDE) + GRXORG(GRCIDE)
            RBUF(2) = PY(I)*GRYSCL(GRCIDE) + GRYORG(GRCIDE)
            CALL GREXEC(GRGTYP,20,RBUF,NBUF,CHR,LCHR)
 10      CONTINUE
         RETURN
      END IF
C
C For other devices fill area is simulated.
C
C Save attributes.
C
      CALL GRQLS(LS)
      CALL GRQLW(LW)
      CALL GRSLS(1)
      CALL GRSLW(1)
C
C Find range of raster-lines to be shaded.
C
      YMIN = PY(1)*GRYSCL(GRCIDE) + GRYORG(GRCIDE)
      YMAX = YMIN
      DO 20 I=2,N
         YD = PY(I)*GRYSCL(GRCIDE) + GRYORG(GRCIDE)
         YMIN = MIN(YMIN,YD)
         YMAX = MAX(YMAX,YD)
 20   CONTINUE
      CALL GREXEC(GRGTYP, 3,RBUF,NBUF,CHR,LCHR)
      DY = ABS(RBUF(3))
C
C Find intersections of edges with current raster line.
C
      FORWD = .TRUE.
      S1 = PX(N)*GRXSCL(GRCIDE) + GRXORG(GRCIDE)
      T1 = PY(N)*GRYSCL(GRCIDE) + GRYORG(GRCIDE)
C
      DO 40 LINE = NINT(YMIN/DY),NINT(YMAX/DY)
         Y = LINE * DY
         NSECT = 0
         DO 30 I=1,N
            S2 = PX(I)*GRXSCL(GRCIDE) + GRXORG(GRCIDE)
            T2 = PY(I)*GRYSCL(GRCIDE) + GRYORG(GRCIDE)
            IF ((T1.LT.Y .AND. Y.LE.T2).OR.
     :          (T1.GE.Y .AND. Y.GT.T2)) THEN
               NSECT = NSECT+1
               IF (NSECT.GT.MAXSEC) THEN
                  CALL GRWARN('GRFA - polygon is too complex.')
                  RETURN
               END IF
               X(NSECT)=(S1+(S2-S1)*((Y-T1)/(T2-T1)))
            END IF
            S1 = S2
            T1 = T2
 30      CONTINUE
C
C Sort the intersections into increasing x order.
C
         DO 34 I=2,NSECT
            DO 32 J=1,I
               IF (X(J).GT.X(I)) THEN
                  TEMP = X(J)
                  X(J) = X(I)
                  X(I) = TEMP
               END IF
 32         CONTINUE
 34      CONTINUE
C
C Draw the horizontal line-segments.
C
         GRYPRE(GRCIDE) = Y
         IF (FORWD) THEN
            DO 36 I=1,NSECT-1,2
               GRXPRE(GRCIDE) = X(I)
               CALL GRLIN0(X(I+1),Y)
 36         CONTINUE
            FORWD = .FALSE.
         ELSE
            DO 38 I=NSECT,2,-2
               GRXPRE(GRCIDE) = X(I)
               CALL GRLIN0(X(I-1),Y)
 38         CONTINUE
            FORWD = .TRUE.
         END IF
 40   CONTINUE
C
C Restore attributes.
C
      CALL GRSLS(LS)
      CALL GRSLW(LW)
      END
#<

#>            grfao.dc3
Name:         GRFAO

Purpose:      format character string containing integers

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRFAO (FORMAT, L, STR, V1, V2, V3, V4)
            CHARACTER*(*) FORMAT
            INTEGER L
            CHARACTER*(*) STR
            INTEGER V1, V2, V3, V4
      
       The input string FORMAT is copied to the output string STR with
       the first occurrence of '#' replaced by the value of V1, the second
       by the value of V2, etc.  The length of the resulting string is 
       returned in L.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grfao.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRFAO - format character string containing integers
C+
      SUBROUTINE GRFAO (FORMAT, L, STR, V1, V2, V3, V4)
      CHARACTER*(*) FORMAT
      INTEGER L
      CHARACTER*(*) STR
      INTEGER V1, V2, V3, V4
C
C The input string FORMAT is copied to the output string STR with
C the first occurrence of '#' replaced by the value of V1, the second
C by the value of V2, etc.  The length of the resulting string is 
C returned in L.
C-----------------------------------------------------------------------
      INTEGER I,Q,VAL,GRITOC
C
      L = 0
      Q = 0
      DO 10 I=1,LEN(FORMAT)
          IF (L.GE.LEN(STR)) RETURN
          IF (FORMAT(I:I).NE.'#') THEN
              L = L+1
              STR(L:L) = FORMAT(I:I)
          ELSE
              Q = Q+1
              VAL = 0
              IF (Q.EQ.1) VAL = V1
              IF (Q.EQ.2) VAL = V2
              IF (Q.EQ.3) VAL = V3
              IF (Q.EQ.4) VAL = V4
              L = L + GRITOC(VAL, STR(L+1:))
          END IF
   10 CONTINUE
C-----------------------------------------------------------------------
      END
#<

#>            grflun.dc3
Name:         grflun

Purpose:      free a Fortran logical unit number (Sun/Convex-UNIX)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRFLUN(LUN)
            INTEGER LUN
      
       Free a Fortran logical unit number allocated by GRGLUN. [This version
       does nothing.]
      
       Arguments:
        LUN    : the logical unit number to free.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grflun.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Fri Oct 16, 1998 at 13:32:47. The Fortran code is unmodified.

C*GRFLUN -- free a Fortran logical unit number (Sun/Convex-UNIX)
C+
      SUBROUTINE GRFLUN(LUN)
      INTEGER LUN
C
C Free a Fortran logical unit number allocated by GRGLUN. [This version
C does nothing.]
C
C Arguments:
C  LUN    : the logical unit number to free.
C--
C 25-Nov-1988
C-----------------------------------------------------------------------
      RETURN
      END
#<

#>            grgcom.f.orig
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Fri Oct 16, 1998 at 13:32:47. The Fortran code is unmodified.

C*GRGCOM -- read with prompt from user's terminal (Sun/Convex-UNIX)
C+
      INTEGER FUNCTION GRGCOM(STRING, PROMPT, L)
      CHARACTER*(*) STRING, PROMPT
      INTEGER L
C
C Issue prompt and read a line from the user's terminal; in VMS,
C this is equivalent to LIB$GET_COMMAND.
C
C Arguments:
C  STRING : (output) receives the string read from the terminal.
C  PROMPT : (input) prompt string.
C  L      : (output) length of STRING.
C
C Returns:
C  GRGCOM : 1 if successful, 0 if an error occurs (e.g., end of file).
C--
C 9-Feb-1988
C 10-Feb-1990 revised to always read from stdin (unit 5), but issue a
C             prompt only when device is a terminal.
C-----------------------------------------------------------------------
      INTEGER IER
C
      GRGCOM = 0
      L = 0
      IER = 0
      WRITE (*, '(1X,A,$)', IOSTAT=IER) PROMPT
      IF (IER.EQ.0) READ (*, '(A)', IOSTAT=IER) STRING
      IF (IER.EQ.0) GRGCOM = 1
      L = LEN(STRING)
   10 IF (STRING(L:L).NE.' ') GOTO 20
          L = L-1
          GOTO 10
   20 CONTINUE
      END
#<

#>            grgenv.dc3
Name:         GRGENV

Purpose:      get value of PGPLOT environment parameter

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRGENV(NAME, VALUE, L)
            CHARACTER*(*) NAME, VALUE
            INTEGER L
      
       Return the value of a PGPLOT environment parameter. In Sun/Convex-UNIX,
       environment parameters are UNIX environment variables; e.g. parameter
       ENVOPT is environment variable PGPLOT_ENVOPT. Translation is not
       recursive and is case-sensitive.
      
       Arguments:
        NAME   : (input) the name of the parameter to evaluate.
        VALUE  : receives the value of the parameter, truncated or extended
                 with blanks as necessary. If the parameter is undefined,
                 a blank string is returned.
        L      : receives the number of characters in VALUE, excluding
                 trailing blanks. If the parameter is undefined, zero is
                 returned.

Updates:      Oct 16, 1998: JPT document extracted from 5.2.0 source;
                                Fortran source copied from GIPSY's v4.9E.
#<

#>            grgenv.f
* GIPSY-modified        
*

C*GRGENV -- get value of PGPLOT environment parameter (Sun/Convex-UNIX)
C+
      SUBROUTINE GRGENV(NAME, VALUE, L)
      CHARACTER*(*) NAME, VALUE
      INTEGER L
C
C Return the value of a PGPLOT environment parameter. In Sun/Convex-UNIX,
C environment parameters are UNIX environment variables; e.g. parameter
C ENVOPT is environment variable PGPLOT_ENVOPT. Translation is not
C recursive and is case-sensitive.
C
C Arguments:
C  NAME   : (input) the name of the parameter to evaluate.
C  VALUE  : receives the value of the parameter, truncated or extended
C           with blanks as necessary. If the parameter is undefined,
C           a blank string is returned.
C  L      : receives the number of characters in VALUE, excluding
C           trailing blanks. If the parameter is undefined, zero is
C           returned.
C--
C 19-Jan-1988
C
C 29-Jun-1991 KGB. Replaced call to GETENV with TRALOG.
C
C-----------------------------------------------------------------------
      INTEGER I, LIN
      INTEGER TRALOG
      CHARACTER*32 TEST
C
      TEST = 'PGPLOT_'//NAME
      LIN = INDEX(TEST, ' ')-1
      L = TRALOG(TEST(:LIN), VALUE)
      IF (L.LE.0) THEN
         L = 0
      ENDIF
CWZ   CALL GETENV(TEST(:LIN), VALUE)
CWZ   IF (VALUE.EQ.' ') THEN
CWZ       L = 0
CWZ   ELSE
CWZ       DO 10 I=LEN(VALUE),1,-1
CWZ           L = I
CWZ           IF (VALUE(I:I).NE.' ') GOTO 20
CWZ10     CONTINUE
CWZ       L = 0
CWZ20     CONTINUE
CWZ   END IF
      END

#<

#>            grgenv.f.orig
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Fri Oct 16, 1998 at 13:32:47. The Fortran code is unmodified.


C*GRGENV -- get value of PGPLOT environment parameter (Sun/Convex-UNIX)
C+
      SUBROUTINE GRGENV(NAME, VALUE, L)
      CHARACTER*(*) NAME, VALUE
      INTEGER L
C
C Return the value of a PGPLOT environment parameter. In Sun/Convex-UNIX,
C environment parameters are UNIX environment variables; e.g. parameter
C ENVOPT is environment variable PGPLOT_ENVOPT. Translation is not
C recursive and is case-sensitive.
C
C Arguments:
C  NAME   : (input) the name of the parameter to evaluate.
C  VALUE  : receives the value of the parameter, truncated or extended
C           with blanks as necessary. If the parameter is undefined,
C           a blank string is returned.
C  L      : receives the number of characters in VALUE, excluding
C           trailing blanks. If the parameter is undefined, zero is
C           returned.
C--
C 19-Jan-1988
C-----------------------------------------------------------------------
      INTEGER I, LIN
      CHARACTER*32 TEST
C
      TEST = 'PGPLOT_'//NAME
      LIN = INDEX(TEST, ' ')-1
      CALL GETENV(TEST(:LIN), VALUE)
      IF (VALUE.EQ.' ') THEN
          L = 0
      ELSE
          DO 10 I=LEN(VALUE),1,-1
              L = I
              IF (VALUE(I:I).NE.' ') GOTO 20
   10     CONTINUE
          L = 0
   20     CONTINUE
      END IF
      END
#<

#>            grgfil.dc3
Name:         GRGFIL

Purpose:      find data file

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRGFIL(TYPE, NAME)
            CHARACTER*(*) TYPE, NAME
      
       This routine encsapsulates the algorithm for finding the PGPLOT
       run-time data files.
      
       1. The binary font file: try the following in order:
           file specified by PGPLOT_FONT
           file "grfont.dat" in directory specified by PGPLOT_DIR
                             (with or without '/' appended)
           file "grfont.dat" in directory /usr/local/pgplot/
      
       2. The color-name database: try the following in order:
           file specified by PGPLOT_RGB
           file "rgb.txt" in directory specified by PGPLOT_DIR
                             (with or without '/' appended)
           file "rgb.txt" in directory /usr/local/pgplot/
      
       Arguments:
        TYPE (input)  : either 'FONT' or 'RGB' to request the corresponding
                        file.
        NAME (output) : receives the file name.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grgfil.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRGFIL -- find data file
C+
      SUBROUTINE GRGFIL(TYPE, NAME)
      CHARACTER*(*) TYPE, NAME
C
C This routine encsapsulates the algorithm for finding the PGPLOT
C run-time data files.
C
C 1. The binary font file: try the following in order:
C     file specified by PGPLOT_FONT
C     file "grfont.dat" in directory specified by PGPLOT_DIR
C                       (with or without '/' appended)
C     file "grfont.dat" in directory /usr/local/pgplot/
C
C 2. The color-name database: try the following in order:
C     file specified by PGPLOT_RGB
C     file "rgb.txt" in directory specified by PGPLOT_DIR
C                       (with or without '/' appended)
C     file "rgb.txt" in directory /usr/local/pgplot/
C
C Arguments:
C  TYPE (input)  : either 'FONT' or 'RGB' to request the corresponding
C                  file.
C  NAME (output) : receives the file name.
C--
C  2-Dec-1994 - new routine [TJP].
C-----------------------------------------------------------------------
      CHARACTER*(*) DEFDIR, DEFFNT, DEFRGB
      PARAMETER  (DEFDIR='/usr/local/pgplot/')
      PARAMETER  (DEFFNT='grfont.dat')
      PARAMETER  (DEFRGB='rgb.txt')
      CHARACTER*255 FF
      CHARACTER*16 DEFLT
      INTEGER I, L, LD
      LOGICAL TEST, DEBUG
C
C Is debug output requested?
C
      CALL GRGENV('DEBUG', FF, L)
      DEBUG = L.GT.0
C
C Which file?
C
      IF (TYPE.EQ.'FONT') THEN
         DEFLT = DEFFNT
         LD = LEN(DEFFNT)
      ELSE IF (TYPE.EQ.'RGB') THEN
         DEFLT = DEFRGB
         LD = LEN(DEFRGB)
      ELSE
         CALL GRWARN('Internal error in routine GRGFIL')
      END IF
C
C Try each possibility in turn.
C
      DO 10 I=1,4
         IF (I.EQ.1) THEN
            CALL GRGENV(TYPE, FF, L)
         ELSE IF (I.EQ.2) THEN
            CALL GRGENV('DIR', FF, L)
            IF (L.GT.0) THEN
               FF(L+1:) = DEFLT
               L = L+LD
            END IF
         ELSE IF (I.EQ.3) THEN
            CALL GRGENV('DIR', FF, L)
            IF (L.GT.0) THEN
               FF(L+1:L+1) = '/'
               FF(L+2:) = DEFLT
               L = L+1+LD
            END IF
         ELSE IF (I.EQ.4) THEN
            FF = DEFDIR//DEFLT
            L = LEN(DEFDIR)+LD
         END IF
         IF (L.GT.0) THEN
            IF (DEBUG) THEN
               CALL GRWARN('Looking for '//FF(:L))
            END IF
            INQUIRE (FILE=FF(:L), EXIST=TEST)
            IF (TEST) THEN
               NAME = FF(:L)
               RETURN
            ELSE IF (DEBUG) THEN
               CALL GRWARN('WARNING: file not found')
            END IF
         END IF
 10   CONTINUE
C
C Failed to find the file.
C
      NAME = DEFLT
C-----------------------------------------------------------------------
      END
#<

#>            grglun.dc3
Name:         grglun

Purpose:      get a Fortran logical unit number (Sun/Convex-UNIX)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRGLUN(LUN)
            INTEGER LUN
      
       Get an unused Fortran logical unit number. 
       Returns a Logical Unit Number that is not currently opened.
       After GRGLUN is called, the unit should be opened to reserve
       the unit number for future calls.  Once a unit is closed, it
       becomes free and another call to GRGLUN could return the same
       number.  Also, GRGLUN will not return a number in the range 1-9
       as older software will often use these units without warning.
      
       Arguments:
        LUN    : receives the logical unit number, or -1 on error.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grglun.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Fri Oct 16, 1998 at 13:32:47. The Fortran code is unmodified.

C*GRGLUN -- get a Fortran logical unit number (Sun/Convex-UNIX)
C+
      SUBROUTINE GRGLUN(LUN)
      INTEGER LUN
C
C Get an unused Fortran logical unit number. 
C Returns a Logical Unit Number that is not currently opened.
C After GRGLUN is called, the unit should be opened to reserve
C the unit number for future calls.  Once a unit is closed, it
C becomes free and another call to GRGLUN could return the same
C number.  Also, GRGLUN will not return a number in the range 1-9
C as older software will often use these units without warning.
C
C Arguments:
C  LUN    : receives the logical unit number, or -1 on error.
C--
C 12-Feb-1989 [AFT/TJP].
C-----------------------------------------------------------------------
      INTEGER I
      LOGICAL QOPEN
C---
      DO 10 I=99,10,-1
          INQUIRE (UNIT=I,  OPENED=QOPEN)
          IF (.NOT.QOPEN) THEN
              LUN = I
              RETURN
          END IF
   10 CONTINUE
      CALL GRWARN('GRGLUN: out of units.')
      LUN = -1
      RETURN
      END
#<

#>            grgmsg.dc3
Name:         grgmsg

Purpose:      print system message (Sun/Convex-UNIX)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRGMSG (STATUS)
            INTEGER STATUS
      
       This routine obtains the text of the VMS system message corresponding
       to code STATUS, and displays it using routine GRWARN. On non-VMS
       systems, it just displays the error number.
      
       Argument:
        STATUS (input): 32-bit system message code.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grgmsg.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Fri Oct 16, 1998 at 13:32:47. The Fortran code is unmodified.


C*GRGMSG -- print system message (Sun/Convex-UNIX)
C+
      SUBROUTINE GRGMSG (STATUS)
      INTEGER STATUS
C
C This routine obtains the text of the VMS system message corresponding
C to code STATUS, and displays it using routine GRWARN. On non-VMS
C systems, it just displays the error number.
C
C Argument:
C  STATUS (input): 32-bit system message code.
C--
C 18-Feb-1988
C-----------------------------------------------------------------------
      CHARACTER*10 BUFFER
C
      WRITE (BUFFER, '(I10)') STATUS
      CALL GRWARN('system message number: '//BUFFER)
      END
#<

#>            grgray.dc3
Name:         GRGRAY

Purpose:      gray-scale map of a 2D data array

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRGRAY (A, IDIM, JDIM, I1, I2, J1, J2,
           1                   FG, BG, PA, MININD, MAXIND, MODE)
            INTEGER IDIM, JDIM, I1, I2, J1, J2, MININD, MAXIND, MODE
            REAL    A(IDIM,JDIM)
            REAL    FG, BG
            REAL    PA(6)
      
       This is a device-dependent support routine for PGGRAY.
      
       Draw gray-scale map of an array in current window. Array
       values between FG and BG are shaded in gray levels determined
       by linear interpolation. FG may be either less than or greater
       than BG.  Array values outside the range FG to BG are
       shaded black or white as appropriate.
      
       GRGRAY uses GRIMG0 on devices with enough color indices available.
       Note that it changes the color table to gray-scale.
       Otherwise in does a random dither with GRIMG3.
      
       Arguments:
        A      (input)  : the array to be plotted.
        IDIM   (input)  : the first dimension of array A.
        JDIM   (input)  : the second dimension of array A.
        I1, I2 (input)  : the inclusive range of the first index
                          (I) to be plotted.
        J1, J2 (input)  : the inclusive range of the second
                          index (J) to be plotted.
        FG     (input)  : the array value which is to appear in
                          foreground color.
        BG     (input)  : the array value which is to appear in
                          background color.
        PA     (input)  : transformation matrix between array grid and
                          device coordinates (see GRCONT).
        MODE   (input)  : transfer function.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grgray.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRGRAY -- gray-scale map of a 2D data array
C+
      SUBROUTINE GRGRAY (A, IDIM, JDIM, I1, I2, J1, J2,
     1                   FG, BG, PA, MININD, MAXIND, MODE)
      INTEGER IDIM, JDIM, I1, I2, J1, J2, MININD, MAXIND, MODE
      REAL    A(IDIM,JDIM)
      REAL    FG, BG
      REAL    PA(6)
C
C This is a device-dependent support routine for PGGRAY.
C
C Draw gray-scale map of an array in current window. Array
C values between FG and BG are shaded in gray levels determined
C by linear interpolation. FG may be either less than or greater
C than BG.  Array values outside the range FG to BG are
C shaded black or white as appropriate.
C
C GRGRAY uses GRIMG0 on devices with enough color indices available.
C Note that it changes the color table to gray-scale.
C Otherwise in does a random dither with GRIMG3.
C
C Arguments:
C  A      (input)  : the array to be plotted.
C  IDIM   (input)  : the first dimension of array A.
C  JDIM   (input)  : the second dimension of array A.
C  I1, I2 (input)  : the inclusive range of the first index
C                    (I) to be plotted.
C  J1, J2 (input)  : the inclusive range of the second
C                    index (J) to be plotted.
C  FG     (input)  : the array value which is to appear in
C                    foreground color.
C  BG     (input)  : the array value which is to appear in
C                    background color.
C  PA     (input)  : transformation matrix between array grid and
C                    device coordinates (see GRCONT).
C  MODE   (input)  : transfer function.
C--
C 12-Dec-1986 - Speed up plotting [J. Biretta].
C  3-Apr-1987 - Add special code for /PS, /VPS, /GR.
C  2-Sep-1987 - Adapted from PGGRAY [TJP].
C  1-Dec-1988 - Put random-number generator inline [TJP].
C  3-Apr-1989 - Use "line of pixels" primitive where available [TJP].
C  6-Sep-1989 - Changes for standard Fortran-77 [TJP].
C 19-Jan-1990 - Add special code for /CPS, /VCPS [DLM]
C  3-Sep-1992 - Add special code for NULL device [TJP].
C 25-Nov-1992 - Add special code for /NEXT [AFT].
C 17-Mar-1994 - Scale in device coordinates [TJP].
C 31-Aug-1994 - use GRIMG0 when appropriate [TJP].
C  7-Sep-1994 - speed up random dither [TJP].
C  8-Feb-1995 - use color ramp based on color indices 0 and 1 [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER I
      REAL    A0, A1, CR0, CG0, CB0, CR1, CG1, CB1
      INTRINSIC REAL
C-----------------------------------------------------------------------
C
C N.B. Arguments are assumed to be valid (checked by PGGRAY).
C
C Use GRIMG0 if this an appropriate device; first initialize the
C color table to a linear ramp between the colors assigned to color
C indices 0 and 1.
C
      IF (GRGCAP(GRCIDE)(7:7).NE.'N' .AND. MAXIND-MININD .GT. 15) THEN
         CALL GRQCR(0, CR0, CG0, CB0)
         CALL GRQCR(1, CR1, CG1, CB1)
         DO 5 I=MININD,MAXIND
            A0 = REAL(I-MININD)/REAL(MAXIND-MININD)
            A1 = 1.0 - A0
            CALL GRSCR(I, A0*CR0+A1*CR1, A0*CG0+A1*CG1, A0*CB0+A1*CB1)
 5       CONTINUE
         CALL GRIMG0(A, IDIM, JDIM, I1, I2, J1, J2,
     :               FG, BG, PA, MININD, MAXIND, MODE)
         RETURN
C
C Otherwise use random dither in current color index.
C
      ELSE
         CALL GRIMG3(A, IDIM, JDIM, I1, I2, J1, J2,
     :               FG, BG, PA, MODE)
      END IF
C-----------------------------------------------------------------------
      END
#<

#>            grgtc0.dc3
Name:         GRGTC0

Purpose:      obtain character digitization

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRGTC0 (CHAR,CENTER,POINTS,X,Y,MORE)
      
       GRPCKG (internal routine): obtain character digitization.
      
       (10-Feb-1983)

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grgtc0.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRGTC0 -- obtain character digitization
C+
      SUBROUTINE GRGTC0 (CHAR,CENTER,POINTS,X,Y,MORE)
C
C GRPCKG (internal routine): obtain character digitization.
C
C (10-Feb-1983)
C-----------------------------------------------------------------------
      EXTERNAL GRDAT2
      LOGICAL CENTER
      INTEGER POINTS, CHAR
      REAL X(1)
      REAL Y(1)
      LOGICAL MORE
C
      INTEGER CINDX1, CINDX2
      INTEGER CTD1, CTD2
      PARAMETER (CTD1 = 30, CTD2 = 128)
      INTEGER CHTBL(CTD1, CTD2)
      COMMON /GRCS02/ CINDX1, CINDX2, CHTBL
C
      INTEGER I
      INTEGER COORDS
      LOGICAL TAILED
C-----------------------------------------------------------------------
      IF (CINDX2.LE.0) CINDX2 = CHAR + 1
C
C Get the next segment of the character.
C
      POINTS = CHTBL(CINDX1, CINDX2)
      IF(POINTS .EQ. 0) GO TO 240
      DO 220 I = 1, POINTS
          CINDX1 = CINDX1 + 1
          COORDS = CHTBL(CINDX1, CINDX2)
          TAILED = COORDS .LT. 0
          IF(TAILED) COORDS = IABS(COORDS)
          X(I) = FLOAT(COORDS / 10)
          Y(I) = FLOAT(MOD(COORDS, 10))
          IF(TAILED) Y(I) = - Y(I)
          IF(.NOT. CENTER) GO TO 220
          X(I) = X(I) - 3.0
          Y(I) = Y(I) - 4.0
  220     CONTINUE
  240 CONTINUE
C
C Set status and return.
C
      IF(CINDX1 .EQ. CTD1) GO TO 320
      CINDX1 = CINDX1 + 1
      IF(CHTBL(CINDX1, CINDX2) .EQ. 0) GO TO 320
      MORE = .TRUE.
      RETURN
  320 MORE = .FALSE.
      CINDX1 = 1
      CINDX2 = 0
      RETURN
      END
#<

#>            grimg0.dc3
Name:         GRIMG0

Purpose:      color image of a 2D data array

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRIMG0 (A, IDIM, JDIM, I1, I2, J1, J2,
           1                   A1, A2, PA, MININD, MAXIND, MODE)
            INTEGER IDIM, JDIM, I1, I2, J1, J2, MININD, MAXIND, MODE
            REAL    A(IDIM,JDIM), A1, A2, PA(6)
      
       This is a support routine for PGIMAG.
      
       Arguments:
        A      (input)  : the array to be plotted.
        IDIM   (input)  : the first dimension of array A.
        JDIM   (input)  : the second dimension of array A.
        I1, I2 (input)  : the inclusive range of the first index
                          (I) to be plotted.
        J1, J2 (input)  : the inclusive range of the second
                          index (J) to be plotted.
        A1     (input)  : the array value which is to appear in color
                          index MININD.
        A2     (input)  : the array value which is to appear in color
                          index MAXIND.
        PA     (input)  : transformation matrix between array grid and
                          device coordinates.
        MININD (input)  : minimum color index to use.
        MAXIND (input)  : maximum color index to use.
        MODE   (input)  : =0 for linear, =1 for logarithmic, =2 for
                          square-root mapping of array values to color
                          indices.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grimg0.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRIMG0 -- color image of a 2D data array
C+
      SUBROUTINE GRIMG0 (A, IDIM, JDIM, I1, I2, J1, J2,
     1                   A1, A2, PA, MININD, MAXIND, MODE)
      INTEGER IDIM, JDIM, I1, I2, J1, J2, MININD, MAXIND, MODE
      REAL    A(IDIM,JDIM), A1, A2, PA(6)
C
C This is a support routine for PGIMAG.
C
C Arguments:
C  A      (input)  : the array to be plotted.
C  IDIM   (input)  : the first dimension of array A.
C  JDIM   (input)  : the second dimension of array A.
C  I1, I2 (input)  : the inclusive range of the first index
C                    (I) to be plotted.
C  J1, J2 (input)  : the inclusive range of the second
C                    index (J) to be plotted.
C  A1     (input)  : the array value which is to appear in color
C                    index MININD.
C  A2     (input)  : the array value which is to appear in color
C                    index MAXIND.
C  PA     (input)  : transformation matrix between array grid and
C                    device coordinates.
C  MININD (input)  : minimum color index to use.
C  MAXIND (input)  : maximum color index to use.
C  MODE   (input)  : =0 for linear, =1 for logarithmic, =2 for
C                    square-root mapping of array values to color
C                    indices.
C--
C  7-Sep-1994 - new routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      CHARACTER C
C-----------------------------------------------------------------------
C
C Switch on type of device support.
C
      C = GRGCAP(GRCIDE)(7:7)
      IF (C.EQ.'Q') THEN
C         -- Image-primitive devices
          CALL GRIMG1(A, IDIM, JDIM, I1, I2, J1, J2, A1, A2, PA,
     :                MININD, MAXIND, MODE)
      ELSE IF (C.EQ.'P') THEN
C         -- Pixel-primitive devices         
          CALL GRIMG2(A, IDIM, JDIM, I1, I2, J1, J2, A1, A2, PA,
     :                MININD, MAXIND, MODE)
      ELSE IF (C.EQ.'N') THEN
C         -- Other devices
          CALL GRWARN(
     :     'images cannot be displayed on the selected device')
      ELSE
C         -- Unknown device code
          CALL GRWARN('unexpected error in routine GRIMG0')
      END IF
C-----------------------------------------------------------------------
      END
#<

#>            grimg1.dc3
Name:         GRIMG1

Purpose:      image of a 2D data array (image-primitive devices)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRIMG1 (A, IDIM, JDIM, I1, I2, J1, J2,
           1                   A1, A2, PA, MININD, MAXIND, MODE)
            INTEGER IDIM, JDIM, I1, I2, J1, J2, MININD, MAXIND, MODE
            REAL    A(IDIM,JDIM), A1, A2, PA(6)
      
       (This routine is called by GRIMG0.)

Updates:      Oct 16, 1998: JPT automatically extracted from source.
              Sep 30, 1999: JPT check for BLANK data values.
              Apr 18, 2000: JPT implemented PostScript interpolation.
              Oct 12, 2001: JPT write current BLANK color index to output.
#<

#>            grimg1.f
* GIPSY-modified
*

C*GRIMG1 -- image of a 2D data array (image-primitive devices)
C+
      SUBROUTINE GRIMG1 (A, IDIM, JDIM, I1, I2, J1, J2,
     1                   A1, A2, PA, MININD, MAXIND, MODE)
      INTEGER IDIM, JDIM, I1, I2, J1, J2, MININD, MAXIND, MODE
      REAL    A(IDIM,JDIM), A1, A2, PA(6)
C
C (This routine is called by GRIMG0.)
C--
C 7-Sep-1994  New routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER NBUF, LCHR
      REAL    RBUF(21), FAC, AV, SFAC, SFACL, BLANK
      CHARACTER*1 CHR
      CHARACTER*20 SBLANK
      INTEGER  I, J, II, NXP, NYP, IV
      INTRINSIC NINT, LOG
      PARAMETER (SFAC=65000.0)
C-----------------------------------------------------------------------
C Blank value
C
      CALL SETFBLANK(BLANK)
C
C Size of image.
C
      NXP = I2 - I1 + 1
      NYP = J2 - J1 + 1
      RBUF(1) = 0.0
      RBUF(2) = NXP
      RBUF(3) = NYP
C
C Clipping rectangle.
C
      RBUF(4) = GRXMIN(GRCIDE)
      RBUF(5) = GRXMAX(GRCIDE)
      RBUF(6) = GRYMIN(GRCIDE)
      RBUF(7) = GRYMAX(GRCIDE)
C
C Image transformation matrix.
C
      FAC = PA(2)*PA(6) - PA(3)*PA(5)
      RBUF(8)  =  PA(6)/FAC
      RBUF(9)  = (-PA(5))/FAC
      RBUF(10) = (-PA(3))/FAC
      RBUF(11) =  PA(2)/FAC
      RBUF(12) = (PA(3)*PA(4) - PA(1)*PA(6))/FAC - (I1-0.5)
      RBUF(13) = (PA(5)*PA(1) - PA(4)*PA(2))/FAC - (J1-0.5)
C
C Send setup info to driver.
C
      IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC
      CALL GRTERM
C
C Specify interpolation mode
C
      IF (GRIMIP(GRCIDE).NE.0) THEN
         CALL GRESC(' /grimip true def ')
      ELSE
         CALL GRESC(' /grimip false def ')
      END IF
C
C Inform about BLANK
C
      IBLANK = GRBLCI(GRCIDE)
      IF (IBLANK.LT.GRMNCI(GRCIDE) .OR. IBLANK.GT.GRMXCI(GRCIDE))
     -IBLANK = GRMNCI(GRCIDE)
      WRITE(SBLANK, '('' /Blank '', I3, '' def '')') IBLANK
      CALL GRESC(SBLANK)
C 
      NBUF = 13
      LCHR = 0
      CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR)
C
C Convert image array to color indices and send to driver.
C
      SFACL = LOG(1.0+SFAC)
      II = 0
      DO 20 J = J1,J2
          DO 10 I = I1,I2
              AV = A(I,J)
              IF (AV.EQ.BLANK) THEN
                  IV = GRBLCI(GRCIDE)
              ELSE
                 IF (A2.GT.A1) THEN
                     AV = MIN(A2, MAX(A1,AV))
                 ELSE
                     AV = MIN(A1, MAX(A2,AV))
                 END IF
                 IF (MODE.EQ.0) THEN
                   IV = NINT((MININD*(A2-AV) +
     :                                MAXIND*(AV-A1))/(A2-A1))
                 ELSE IF (MODE.EQ.1) THEN
                   IV = MININD + NINT((MAXIND-MININD)*
     :                  LOG(1.0+SFAC*ABS((AV-A1)/(A2-A1)))/SFACL)
                 ELSE IF (MODE.EQ.2) THEN
                   IV = MININD + NINT((MAXIND-MININD)*
     :                                SQRT(ABS((AV-A1)/(A2-A1))))
                 ELSE
                   IV = MININD
                 END IF
              END IF
              II = II + 1
              RBUF(II+1) = IV
              IF (II.EQ.20) THEN
                  NBUF = II + 1
                  RBUF(1) = II
                  CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR)
                  II = 0
              END IF
   10     CONTINUE
   20 CONTINUE
      IF (II.GT.0) THEN
          NBUF = II + 1
          RBUF(1) = II
          CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR)
          II = 0
      END IF
C
C Send termination code to driver.
C
      NBUF = 1
      RBUF(1) = -1
      CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR)
C-----------------------------------------------------------------------
      END
#<

#>            grimg1.f.orig
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRIMG1 -- image of a 2D data array (image-primitive devices)
C+
      SUBROUTINE GRIMG1 (A, IDIM, JDIM, I1, I2, J1, J2,
     1                   A1, A2, PA, MININD, MAXIND, MODE)
      INTEGER IDIM, JDIM, I1, I2, J1, J2, MININD, MAXIND, MODE
      REAL    A(IDIM,JDIM), A1, A2, PA(6)
C
C (This routine is called by GRIMG0.)
C--
C 7-Sep-1994  New routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER NBUF, LCHR
      REAL    RBUF(21), FAC, AV, SFAC, SFACL
      CHARACTER*1 CHR
      INTEGER  I, J, II, NXP, NYP, IV
      INTRINSIC NINT, LOG
      PARAMETER (SFAC=65000.0)
C-----------------------------------------------------------------------
C Size of image.
C
      NXP = I2 - I1 + 1
      NYP = J2 - J1 + 1
      RBUF(1) = 0.0
      RBUF(2) = NXP
      RBUF(3) = NYP
C
C Clipping rectangle.
C
      RBUF(4) = GRXMIN(GRCIDE)
      RBUF(5) = GRXMAX(GRCIDE)
      RBUF(6) = GRYMIN(GRCIDE)
      RBUF(7) = GRYMAX(GRCIDE)
C
C Image transformation matrix.
C
      FAC = PA(2)*PA(6) - PA(3)*PA(5)
      RBUF(8)  =  PA(6)/FAC
      RBUF(9)  = (-PA(5))/FAC
      RBUF(10) = (-PA(3))/FAC
      RBUF(11) =  PA(2)/FAC
      RBUF(12) = (PA(3)*PA(4) - PA(1)*PA(6))/FAC - (I1-0.5)
      RBUF(13) = (PA(5)*PA(1) - PA(4)*PA(2))/FAC - (J1-0.5)
C
C Send setup info to driver.
C
      IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC
      CALL GRTERM
      NBUF = 13
      LCHR = 0
      CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR)
C
C Convert image array to color indices and send to driver.
C
      SFACL = LOG(1.0+SFAC)
      II = 0
      DO 20 J = J1,J2
          DO 10 I = I1,I2
              AV = A(I,J)
              IF (A2.GT.A1) THEN
                  AV = MIN(A2, MAX(A1,AV))
              ELSE
                  AV = MIN(A1, MAX(A2,AV))
              END IF
              IF (MODE.EQ.0) THEN
                IV = NINT((MININD*(A2-AV) + MAXIND*(AV-A1))/(A2-A1))
              ELSE IF (MODE.EQ.1) THEN
                IV = MININD + NINT((MAXIND-MININD)*
     :               LOG(1.0+SFAC*ABS((AV-A1)/(A2-A1)))/SFACL)
              ELSE IF (MODE.EQ.2) THEN
                IV = MININD + NINT((MAXIND-MININD)*
     :                             SQRT(ABS((AV-A1)/(A2-A1))))
              ELSE
                IV = MININD
              END IF
              II = II + 1
              RBUF(II+1) = IV
              IF (II.EQ.20) THEN
                  NBUF = II + 1
                  RBUF(1) = II
                  CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR)
                  II = 0
              END IF
   10     CONTINUE
   20 CONTINUE
      IF (II.GT.0) THEN
          NBUF = II + 1
          RBUF(1) = II
          CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR)
          II = 0
      END IF
C
C Send termination code to driver.
C
      NBUF = 1
      RBUF(1) = -1
      CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR)
C-----------------------------------------------------------------------
      END
#<

#>            grimg2.dc3
Name:         GRIMG2

Purpose:      image of a 2D data array (pixel-primitive devices)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRIMG2 (A, IDIM, JDIM, I1, I2, J1, J2,
           1                   A1, A2, PA, MININD, MAXIND, MODE)
            INTEGER IDIM, JDIM, I1, I2, J1, J2, MININD, MAXIND, MODE
            REAL    A(IDIM,JDIM)
            REAL    A1, A2
            REAL    PA(6)
      
       (This routine is called by GRIMG0.)

Updates:      Oct 16, 1998: JPT automatically extracted from source.
              Sep 30, 1999: JPT check for BLANK data values.
              Apr  7, 2000: JPT implemented bilinear interpolation.
              Oct  5, 2001: JPT increased line buffer size.
#<

#>            grimg2.f
* GIPSY-modified
*

C*GRIMG2 -- image of a 2D data array (pixel-primitive devices)
C+
      SUBROUTINE GRIMG2 (A, IDIM, JDIM, I1, I2, J1, J2,
     1                   A1, A2, PA, MININD, MAXIND, MODE)
      INTEGER IDIM, JDIM, I1, I2, J1, J2, MININD, MAXIND, MODE
      REAL    A(IDIM,JDIM)
      REAL    A1, A2
      REAL    PA(6)
C
C (This routine is called by GRIMG0.)
C--
C 7-Sep-1994  New routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER  I,IV,IX,IX1,IX2,IY,IY1,IY2,J, NPIX, LCHR
      REAL     DEN, AV, SFAC, SFACL, BLANK
      REAL     XXAA,XXBB,YYAA,YYBB,XYAA,XYBB,YXAA,YXBB,XYAAIY,YXAAIY
      REAL     BUFFER(4002)
      CHARACTER*1 CHR
      INTRINSIC NINT, LOG
      PARAMETER (SFAC=65000.0)
C-----------------------------------------------------------------------
C
C Blank value
C
      CALL SETFBLANK(BLANK)
C
C Location of current window in device coordinates.
C
      IX1 = NINT(GRXMIN(GRCIDE))+1
      IX2 = NINT(GRXMAX(GRCIDE))-1
      IY1 = NINT(GRYMIN(GRCIDE))+1
      IY2 = NINT(GRYMAX(GRCIDE))-1
C
C Transformation from array coordinates to device coordinates.
C
      DEN = PA(2)*PA(6)-PA(3)*PA(5)
      XXAA = (-PA(6))*PA(1)/DEN
      XXBB = PA(6)/DEN
      XYAA = (-PA(3))*PA(4)/DEN
      XYBB = PA(3)/DEN
      YYAA = (-PA(2))*PA(4)/DEN
      YYBB = PA(2)/DEN
      YXAA = (-PA(5))*PA(1)/DEN
      YXBB = PA(5)/DEN
C
C Start a new page if necessary.
C
      IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC
C
C Run through every device pixel (IX, IY) in the current window and
C determine which array pixel (I,J) it falls in.
C
      SFACL = LOG(1.0+SFAC)
      DO 120 IY=IY1,IY2
          XYAAIY = XXAA-XYAA-XYBB*IY
          YXAAIY = YYAA+YYBB*IY-YXAA
          NPIX = 0
          BUFFER(2) = IY
          DO 110 IX=IX1,IX2
            I = NINT(XYAAIY+XXBB*IX)
            IF (I.LT.I1.OR.I.GT.I2) GOTO 110
            J = NINT(YXAAIY-YXBB*IX)
            IF (J.LT.J1.OR.J.GT.J2) GOTO 110
C
C           -- determine color index IV of this pixel
C
            AV = A(I,J)
            IF (AV.EQ.BLANK) THEN
               IV = GRBLCI(GRCIDE)
            ELSE
               IF (GRIMIP(GRCIDE).NE.0) THEN
                  DI = (XYAAIY+XXBB*IX)-I
                  DJ = (YXAAIY-YXBB*IX)-J
                  IP = I+SIGN(1.0, DI)
                  JP = J+SIGN(1.0, DJ)
                  IF (IP.LT.I1) THEN
                     IP = I1
                  ELSE IF (IP.GT.I2) THEN
                     IP = I2
                  END IF
                  IF (JP.LT.J1) THEN
                     JP = J1
                  ELSE IF (JP.GT.J2) THEN
                     JP = J2
                  END IF
                  DI = ABS(DI)
                  DJ = ABS(DJ)
                  BV = A(IP,J)
                  IF (BV.EQ.BLANK) BV = AV
                  CV = A(I,JP)
                  IF (CV.EQ.BLANK) CV = AV
                  DV = A(IP,JP)
                  IF (DV.EQ.BLANK) DV = AV
                  AV = (1.0-DJ)*((1.0-DI)*AV + DI*BV) +
     -                      DJ *((1.0-DI)*CV + DI*DV)
               END IF
               IF (A2.GT.A1) THEN
                   AV = MIN(A2, MAX(A1,AV))
               ELSE
                   AV = MIN(A1, MAX(A2,AV))
               END IF
               IF (MODE.EQ.0) THEN
                   IV = NINT((MININD*(A2-AV) + MAXIND*(AV-A1))/(A2-A1))
               ELSE IF (MODE.EQ.1) THEN
                   IV = MININD + NINT((MAXIND-MININD)*
     :                  LOG(1.0+SFAC*ABS((AV-A1)/(A2-A1)))/SFACL)
               ELSE IF (MODE.EQ.2) THEN
                   IV = MININD + NINT((MAXIND-MININD)*
     :                                SQRT(ABS((AV-A1)/(A2-A1))))
               ELSE
                   IV = MININD
               END IF
            END IF
C
            IF (NPIX.LE.4000) THEN
C               -- drop pixels if buffer too small (to be fixed!)
                NPIX = NPIX+1
                IF (NPIX.EQ.1) BUFFER(1) = IX
                BUFFER(NPIX+2) = IV
            END IF
  110     CONTINUE
          IF (NPIX.GT.0) CALL 
     :                   GREXEC(GRGTYP, 26, BUFFER, NPIX+2, CHR, LCHR)
  120 CONTINUE
C-----------------------------------------------------------------------
      END
#<

#>            grimg2.f.orig
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRIMG2 -- image of a 2D data array (pixel-primitive devices)
C+
      SUBROUTINE GRIMG2 (A, IDIM, JDIM, I1, I2, J1, J2,
     1                   A1, A2, PA, MININD, MAXIND, MODE)
      INTEGER IDIM, JDIM, I1, I2, J1, J2, MININD, MAXIND, MODE
      REAL    A(IDIM,JDIM)
      REAL    A1, A2
      REAL    PA(6)
C
C (This routine is called by GRIMG0.)
C--
C 7-Sep-1994  New routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER  I,IV,IX,IX1,IX2,IY,IY1,IY2,J, NPIX, LCHR
      REAL     DEN, AV, SFAC, SFACL
      REAL     XXAA,XXBB,YYAA,YYBB,XYAA,XYBB,YXAA,YXBB,XYAAIY,YXAAIY
      REAL     BUFFER(1026)
      CHARACTER*1 CHR
      INTRINSIC NINT, LOG
      PARAMETER (SFAC=65000.0)
C-----------------------------------------------------------------------
C
C Location of current window in device coordinates.
C
      IX1 = NINT(GRXMIN(GRCIDE))+1
      IX2 = NINT(GRXMAX(GRCIDE))-1
      IY1 = NINT(GRYMIN(GRCIDE))+1
      IY2 = NINT(GRYMAX(GRCIDE))-1
C
C Transformation from array coordinates to device coordinates.
C
      DEN = PA(2)*PA(6)-PA(3)*PA(5)
      XXAA = (-PA(6))*PA(1)/DEN
      XXBB = PA(6)/DEN
      XYAA = (-PA(3))*PA(4)/DEN
      XYBB = PA(3)/DEN
      YYAA = (-PA(2))*PA(4)/DEN
      YYBB = PA(2)/DEN
      YXAA = (-PA(5))*PA(1)/DEN
      YXBB = PA(5)/DEN
C
C Start a new page if necessary.
C
      IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC
C
C Run through every device pixel (IX, IY) in the current window and
C determine which array pixel (I,J) it falls in.
C
      SFACL = LOG(1.0+SFAC)
      DO 120 IY=IY1,IY2
          XYAAIY = XXAA-XYAA-XYBB*IY
          YXAAIY = YYAA+YYBB*IY-YXAA
          NPIX = 0
          BUFFER(2) = IY
          DO 110 IX=IX1,IX2
            I = NINT(XYAAIY+XXBB*IX)
            IF (I.LT.I1.OR.I.GT.I2) GOTO 110
            J = NINT(YXAAIY-YXBB*IX)
            IF (J.LT.J1.OR.J.GT.J2) GOTO 110
C
C           -- determine color index IV of this pixel
C
            AV = A(I,J)
            IF (A2.GT.A1) THEN
                AV = MIN(A2, MAX(A1,AV))
            ELSE
                AV = MIN(A1, MAX(A2,AV))
            END IF
            IF (MODE.EQ.0) THEN
                IV = NINT((MININD*(A2-AV) + MAXIND*(AV-A1))/(A2-A1))
            ELSE IF (MODE.EQ.1) THEN
                IV = MININD + NINT((MAXIND-MININD)*
     :               LOG(1.0+SFAC*ABS((AV-A1)/(A2-A1)))/SFACL)
            ELSE IF (MODE.EQ.2) THEN
                IV = MININD + NINT((MAXIND-MININD)*
     :                             SQRT(ABS((AV-A1)/(A2-A1))))
            ELSE
                IV = MININD
            END IF
C
            IF (NPIX.LE.1024) THEN
C               -- drop pixels if buffer too small (to be fixed!)
                NPIX = NPIX+1
                IF (NPIX.EQ.1) BUFFER(1) = IX
                BUFFER(NPIX+2) = IV
            END IF
  110     CONTINUE
          IF (NPIX.GT.0) CALL 
     :                   GREXEC(GRGTYP, 26, BUFFER, NPIX+2, CHR, LCHR)
  120 CONTINUE
C-----------------------------------------------------------------------
      END
#<

#>            grimg3.dc3
Name:         GRIMG3

Purpose:      gray-scale map of a 2D data array, using dither

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRIMG3 (A, IDIM, JDIM, I1, I2, J1, J2,
           1                   BLACK, WHITE, PA, MODE)
            INTEGER IDIM, JDIM, I1, I2, J1, J2, MODE
            REAL    A(IDIM,JDIM)
            REAL    BLACK, WHITE
            REAL    PA(6)

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grimg3.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRIMG3 -- gray-scale map of a 2D data array, using dither
C+
      SUBROUTINE GRIMG3 (A, IDIM, JDIM, I1, I2, J1, J2,
     1                   BLACK, WHITE, PA, MODE)
      INTEGER IDIM, JDIM, I1, I2, J1, J2, MODE
      REAL    A(IDIM,JDIM)
      REAL    BLACK, WHITE
      REAL    PA(6)
C--
C 2-Sep-1994 - moved from GRGRAY [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER  I,IX,IX1,IX2,IY,IY1,IY2,J
      REAL     DEN,VALUE,BW
      REAL     XXAA,XXBB,YYAA,YYBB,XYAA,XYBB,YXAA,YXBB,XYAAIY,YXAAIY
      INTEGER  M, IAA, ICC, JRAN, ILAST, JLAST, IXSTEP, IYSTEP
      REAL     RAND, RM, FAC, FACL
      PARAMETER (M=714025, IAA=1366, ICC=150889, RM=1.0/M)
      PARAMETER (FAC=65000.0)
      INTRINSIC MOD, NINT, REAL, LOG
C-----------------------------------------------------------------------
C
      IF (MODE.LT.0 .OR. MODE.GT.2) RETURN
C
C Initialize random-number generator (based on RAN2 of Press et al.,
C Numerical Recipes)
C
      JRAN = 76773
C
      IX1 = NINT(GRXMIN(GRCIDE))+1
      IX2 = NINT(GRXMAX(GRCIDE))-1
      IY1 = NINT(GRYMIN(GRCIDE))+1
      IY2 = NINT(GRYMAX(GRCIDE))-1
      DEN = PA(2)*PA(6)-PA(3)*PA(5)
C
C Calculate constants.
C
      BW   = ABS(BLACK-WHITE)
      FACL = LOG(1.0+FAC)
      XXAA = (-PA(6))*PA(1)/DEN
      XXBB = PA(6)/DEN
      XYAA = (-PA(3))*PA(4)/DEN
      XYBB = PA(3)/DEN
      YYAA = (-PA(2))*PA(4)/DEN
      YYBB = PA(2)/DEN
      YXAA = (-PA(5))*PA(1)/DEN
      YXBB = PA(5)/DEN
C
C Choose step size: at least 1/200 inch, assuming the line-width
C unit is 1/200 inch.
C
      IXSTEP = MAX(1,NINT(GRWIDT(GRCIDE)*GRPXPI(GRCIDE)/200.0))
      IYSTEP = MAX(1,NINT(GRWIDT(GRCIDE)*GRPYPI(GRCIDE)/200.0))
C
C Draw dots.
C
      ILAST = 0
      JLAST = 0
      DO 120 IY=IY1,IY2,IYSTEP
          XYAAIY = XXAA-XYAA-XYBB*IY
          YXAAIY = YYAA+YYBB*IY-YXAA
          DO 110 IX=IX1,IX2,IXSTEP
              I = NINT(XYAAIY+XXBB*IX)
              IF (I.LT.I1.OR.I.GT.I2) GOTO 110
              J = NINT(YXAAIY-YXBB*IX)
              IF (J.LT.J1.OR.J.GT.J2) GOTO 110
              IF (I.NE.ILAST .OR. J.NE.JLAST) THEN
                  ILAST = I
                  JLAST = J
                  VALUE = ABS(A(I,J)-WHITE)/BW
                  IF (MODE.EQ.0) THEN
C                     -- "linear"
                      CONTINUE
                  ELSE IF (MODE.EQ.1) THEN
C                     -- "logarithmic"
                      VALUE = LOG(1.0+FAC*VALUE)/FACL
                  ELSE IF (MODE.EQ.2) THEN
C                     -- "square root"
                      VALUE = SQRT(VALUE)
                  END IF
              END IF
              JRAN = MOD(JRAN*IAA+ICC, M)
              RAND = JRAN*RM
              IF (VALUE.GT.RAND) CALL GRDOT0(REAL(IX),REAL(IY))
  110     CONTINUE
  120  CONTINUE
C-----------------------------------------------------------------------
       END
#<

#>            grinit.dc3
Name:         GRINIT

Purpose:      initialize GRPCKG

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRINIT
      
       Initialize GRPCKG and read font file. Called by GROPEN, but may be 
       called explicitly if needed.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grinit.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRINIT -- initialize GRPCKG
C+
      SUBROUTINE GRINIT
C
C Initialize GRPCKG and read font file. Called by GROPEN, but may be 
C called explicitly if needed.
C--
C 29-Apr-1996 - new routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER   I
      LOGICAL   INIT
      SAVE      INIT
      DATA      INIT / .TRUE. /
C
      IF (INIT) THEN
         DO 10 I=1,GRIMAX
            GRSTAT(I) = 0
 10      CONTINUE
         CALL GRSY00
         INIT = .FALSE.
      END IF
      RETURN
      END
#<

#>            grinqfont.f.orig
C*GRINQFONT -- inquire current font [obsolete]
C
      SUBROUTINE GRINQFONT (IF)
      INTEGER IF
      CALL GRQFNT(IF)
      END
#<

#>            grinqli.dc3
Name:         GRINQLI

Purpose:      *obsolete routine*

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRINQLI (INTEN)
      
       GRPCKG: obtain the line intensity of the current graphics device.
       Obsolete routine.
       Argument:
      
       INTEN (integer, output): always returns 1.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grinqli.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRINQLI -- *obsolete routine*
C+
      SUBROUTINE GRINQLI (INTEN)
C
C GRPCKG: obtain the line intensity of the current graphics device.
C Obsolete routine.
C Argument:
C
C INTEN (integer, output): always returns 1.
C--
C (1-Feb-1983; revised 16-Aug-1987).
C-----------------------------------------------------------------------
      INTEGER  INTEN
C
      INTEN = 1
      END
#<

#>            grinqpen.dc3
Name:         GRINQPEN

Purpose:      *obsolete routine*

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRINQPEN (IP)
      
       GRPCKG: obtain the pen number of the current graphics device.
       Obsolete routine.
       Argument:
      
       IP (integer, output): always receives 1.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grinqpen.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRINQPEN -- *obsolete routine*
C+
      SUBROUTINE GRINQPEN (IP)
C
C GRPCKG: obtain the pen number of the current graphics device.
C Obsolete routine.
C Argument:
C
C IP (integer, output): always receives 1.
C--
C 16-Aug-1987 - [TJP].
C-----------------------------------------------------------------------
      INTEGER  IP
C
      IP = 1
      END
#<

#>            gritoc.dc3
Name:         GRITOC

Purpose:      convert integer to character string

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            INTEGER FUNCTION GRITOC(INT, STR)
            INTEGER INT
            CHARACTER*(*) STR
      
       Convert integer INT into (decimal) character string in STR.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            gritoc.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRITOC - convert integer to character string
C+
      INTEGER FUNCTION GRITOC(INT, STR)
      INTEGER INT
      CHARACTER*(*) STR
C
C Convert integer INT into (decimal) character string in STR.
C-----------------------------------------------------------------------
      CHARACTER*10 DIGITS
      INTEGER D, I, INTVAL, J, L
      CHARACTER K
      DATA DIGITS /'0123456789'/
C
      INTVAL = ABS(INT)
      I = 0
C
C Generate digits in reverse order.
C
  10  CONTINUE
          I = I+1
          D = 1 + MOD(INTVAL, 10)
          STR(I:I) = DIGITS(D:D)
          INTVAL = INTVAL/10
          IF (I.LT.LEN(STR) .AND. INTVAL.NE.0) GOTO 10
C
C Add minus sign if necessary.
C
      IF (INT.LT.0 .AND. I.LT.LEN(STR)) THEN
          I = I+1
          STR(I:I) = '-'
      END IF
      GRITOC = I
C
C Reverse string in place.
C
      L = I/2
      DO 20 J=1,L
          K = STR(I:I)
          STR(I:I) = STR(J:J)
          STR(J:J) = K
          I = I-1
   20 CONTINUE
C-----------------------------------------------------------------------
      END
#<

#>            grldev.dc3
Name:         GRLDEV

Purpose:      list supported device types

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRLDEV
      
       Support routine for PGLDEV.
      
       Arguments: none

Updates:      Oct 16, 1998: JPT document extracted from 5.2.0 source;
                                Fortran source copied from GIPSY's v4.9E.
#<

#>            grldev.f
* GIPSY-modified        
*

C*GRLDEV -- list supported device types
C+
      SUBROUTINE GRLDEV
C
C Support routine for PGLDEV.  Makes use of information in grpckg1.inc
C file.
C
C Arguments: none
C--
C  5-Aug-1986 [AFT]
C 13-Dec-1990 Change warnings to messages [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER I,K,NDEV,NUM,NBUF,LCHR
      REAL    RBUF(6)
      CHARACTER*18 CNAM(4),CHR
      CHARACTER*72 TEXT
C
  111 FORMAT(4A18)
C---
      CALL GRMSG('Device types available:')
      NUM=0
C
C--- First obtain number of devices.
      CALL GREXEC(0,0,RBUF,NBUF,CHR,LCHR)
      NDEV=NINT(RBUF(1))
C
      DO 10 I=1,NDEV
          NUM=NUM+1
          CALL GREXEC(I, 1,RBUF,NBUF,CHR,LCHR)
CWZ       CNAM(NUM)='/'//CHR
          CNAM(NUM)=CHR
          IF(NUM.GE.4) THEN
              NUM=0
              WRITE (TEXT,111) CNAM(1),CNAM(2),CNAM(3),CNAM(4)
              CALL GRMSG(TEXT)
          END IF
   10 CONTINUE
C
C Lastly list partial line, if needed.
C
      IF (NUM.GT.0) THEN
          WRITE (TEXT,111) (CNAM(K),K=1,NUM)
          CALL GRMSG(TEXT)
      END IF
      END
#<

#>            grldev.f.orig
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRLDEV -- list supported device types
C+
      SUBROUTINE GRLDEV
C
C Support routine for PGLDEV.
C
C Arguments: none
C--
C  5-Aug-1986 [AFT]
C 13-Dec-1990 Change warnings to messages [TJP].
C 18-Jan-1993 Display one per line [TJP].
C 13-Jan-1995 Change message [TJP].
C 10-Nov-1995 Ignore device types of zero length [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER I,NDEV,NBUF,LCHR
      REAL    RBUF(6)
      CHARACTER*72 CHR
      CHARACTER*72 TEXT
C---
      CALL GRMSG('Device types available:')
C--- First obtain number of devices.
      CALL GREXEC(0,0,RBUF,NBUF,CHR,LCHR)
      NDEV=NINT(RBUF(1))
C
      DO 10 I=1,NDEV
         CALL GREXEC(I, 1,RBUF,NBUF,CHR,LCHR)
         IF (LCHR.GT.0) THEN
            TEXT(1:1) = '/'
            TEXT(2:) = CHR(:LCHR)
            CALL GRMSG(TEXT)
         END IF
 10   CONTINUE
C
      END
#<

#>            grlen.dc3
Name:         GRLEN

Purpose:      inquire plotted length of character string

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRLEN (STRING, D)
      
       GRPCKG: length of text string (absolute units)

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grlen.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRLEN -- inquire plotted length of character string
C+
      SUBROUTINE GRLEN (STRING, D)
C
C GRPCKG: length of text string (absolute units)
C--
C (3-Mar-1983)
C 19-Jan-1988 - remove unused label [TJP].
C  9-Sep-1989 - standardize [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      LOGICAL UNUSED
      INTEGER XYGRID(300)
      INTEGER LIST(256)
      CHARACTER*(*) STRING
      REAL FACTOR, COSA, SINA, DX, D, RATIO, FNTBAS, FNTFAC
      INTEGER I, IFNTLV, LX, NLIST
      INTRINSIC ABS, LEN
C
      D = 0.0
      IF (LEN(STRING).LE.0) RETURN
C-----------------------------------------------------------------------
C               Compute scaling and orientation
C-----------------------------------------------------------------------
      FACTOR = GRCFAC(GRCIDE)/2.5
      RATIO = GRPXPI(GRCIDE)/GRPYPI(GRCIDE)
      COSA = FACTOR
      SINA = 0.0
      FNTBAS = 0.0
      FNTFAC = 1.0
      IFNTLV = 0
C
C               Convert string to symbol numbers:
C               \u and \d escape sequences are converted to -1,-2
C
      CALL GRSYDS(LIST,NLIST,STRING,GRCFNT(GRCIDE))
C
C               Plot the string of characters
C
      DO 380 I = 1,NLIST
          IF (LIST(I).LT.0) THEN
              IF (LIST(I).EQ.-1) THEN
                  IFNTLV = IFNTLV+1
                  FNTBAS = FNTBAS + 16.0*FNTFAC
                  FNTFAC = 0.6**ABS(IFNTLV)
              ELSE IF (LIST(I).EQ.-2) THEN
                  IFNTLV = IFNTLV-1
                  FNTFAC = 0.6**ABS(IFNTLV)
                  FNTBAS = FNTBAS - 16.0*FNTFAC
              END IF
              GOTO 380
          END IF
          CALL GRSYXD(LIST(I),XYGRID,UNUSED)
          LX = XYGRID(5)-XYGRID(4)
          DX = COSA*LX*RATIO
          D = D + DX*FNTFAC
  380 CONTINUE
C
      END
#<

#>            grlgtr.dc3
Name:         grlgtr

Purpose:      translate logical name (dummy version)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRLGTR (NAME)
            CHARACTER*(*) NAME
      
       Recursive translation of a logical name.
       This is used in the parsing of device specifications in the
       VMS implementation of PGPLOT. In other implementations, it may
       be replaced by a null routine.
      
       Argument:
        NAME (input/output): initially contains the name to be
             inspected.  If an equivalence is found it will be replaced
             with the new name. If not, the old name will be left there.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grlgtr.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Fri Oct 16, 1998 at 13:32:47. The Fortran code is unmodified.

C*GRLGTR -- translate logical name (dummy version)
C+
      SUBROUTINE GRLGTR (NAME)
      CHARACTER*(*) NAME
C
C Recursive translation of a logical name.
C This is used in the parsing of device specifications in the
C VMS implementation of PGPLOT. In other implementations, it may
C be replaced by a null routine.
C
C Argument:
C  NAME (input/output): initially contains the name to be
C       inspected.  If an equivalence is found it will be replaced
C       with the new name. If not, the old name will be left there.
C--
C 19-Dec-1994
C-----------------------------------------------------------------------
      END
#<

#>            grlin0.dc3
Name:         GRLIN0

Purpose:      draw a line

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRLIN0 (XP,YP)
      
       GRPCKG (internal routine): draw a line from the current position to a
       specified position, which becomes the new current position. This
       routine takes care of clipping at the viewport boundary, dashed and
       thick lines.
      
       Arguments:
      
       XP, YP (input, real): absolute device coordinates of the end-point of
             the line.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grlin0.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRLIN0 -- draw a line
C+
      SUBROUTINE GRLIN0 (XP,YP)
C
C GRPCKG (internal routine): draw a line from the current position to a
C specified position, which becomes the new current position. This
C routine takes care of clipping at the viewport boundary, dashed and
C thick lines.
C
C Arguments:
C
C XP, YP (input, real): absolute device coordinates of the end-point of
C       the line.
C--
C 13-Jul-1984
C  7-May-1985 - add MIN/MAX kluge to prevent integer overflow [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      LOGICAL  VIS
      REAL     XP,YP, X0,Y0, X1,Y1
C
C End-points of line are (X0,Y0), (X1,Y1).
C
      X0 = GRXPRE(GRCIDE)
      Y0 = GRYPRE(GRCIDE)
      X1 = MIN(2E9,MAX(-2E9,XP))
      Y1 = MIN(2E9,MAX(-2E9,YP))
      GRXPRE(GRCIDE) = X1
      GRYPRE(GRCIDE) = Y1
C
C Change the end-points of the line (X0,Y0) - (X1,Y1)
C to clip the line at the window boundary.
C
      CALL GRCLPL(X0,Y0,X1,Y1,VIS)
      IF (.NOT.VIS) RETURN
C
C Draw the line in the appropriate style.
C
      IF (GRDASH(GRCIDE)) THEN
C         ! dashed line
         CALL GRLIN1(X0,Y0,X1,Y1,.FALSE.)
      ELSE IF (GRWIDT(GRCIDE).GT.1) THEN
C         ! heavy line
         CALL GRLIN3(X0,Y0,X1,Y1)
      ELSE
C         ! full line
         CALL GRLIN2(X0,Y0,X1,Y1)
      END IF
      END
#<

#>            grlin1.dc3
Name:         GRLIN1

Purpose:      draw a dashed line

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRLIN1 (X0,Y0,X1,Y1,RESET)
      
       GRPCKG : dashed line. Generate a visible dashed line between points
       (X0,Y0) and (X1,Y1) according to the dash pattern stored in common.
       If RESET = .TRUE., the pattern will start from the beginning.
       Otherwise, it will continue from its last position.
           DASHED LINE PATTERN ARRAY CONTAINING LENGTHS OF
                MARKS AND SPACES IN UNIT CUBE: GRPATN(*)
           OFFSET IN CURRENT PATTERN SEGMENT: GRPOFF
           CURRENT PATTERN SEGMENT NUMBER: GRIPAT
           NUMBER OF PATTERN SEGMENTS: 8

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grlin1.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRLIN1 -- draw a dashed line
C+
      SUBROUTINE GRLIN1 (X0,Y0,X1,Y1,RESET)
C
C GRPCKG : dashed line. Generate a visible dashed line between points
C (X0,Y0) and (X1,Y1) according to the dash pattern stored in common.
C If RESET = .TRUE., the pattern will start from the beginning.
C Otherwise, it will continue from its last position.
C     DASHED LINE PATTERN ARRAY CONTAINING LENGTHS OF
C          MARKS AND SPACES IN UNIT CUBE: GRPATN(*)
C     OFFSET IN CURRENT PATTERN SEGMENT: GRPOFF
C     CURRENT PATTERN SEGMENT NUMBER: GRIPAT
C     NUMBER OF PATTERN SEGMENTS: 8
C--
C (1-Feb-1983)
C  6-Sep-1989 - Changes for standard Fortran-77 [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
C
      REAL ADJUST, ARG1, ARG2, ALFARG
      REAL SCALE, SEGLEN, X1, X0, Y1, Y0, DS, DSOLD
      REAL ALPHA1, ALPHA2, XP, YP, XQ, YQ
      LOGICAL RESET
      INTEGER THICK
      INTRINSIC ABS, MIN, MOD, REAL, SQRT
C
      ADJUST(ARG1,ARG2,ALFARG) = ALFARG*(ARG2 - ARG1) + ARG1
C
      THICK = GRWIDT(GRCIDE)
      SCALE = SQRT(REAL(ABS(THICK)))
      IF (RESET) THEN
          GRPOFF(GRCIDE) = 0.0
          GRIPAT(GRCIDE) = 1
      END IF
      SEGLEN = SQRT((X1-X0)**2 + (Y1-Y0)**2)
      IF (SEGLEN .EQ. 0.0) RETURN
      DS = 0.0
C
C       Repeat until (ALPHA2 .GE. 1.0)
C
C       Line segments matching the pattern segments are determined
C       by finding values (ALPHA1,ALPHA2) defining the start and end
C       of the segment in the parametric equation (1-ALPHA)*P1 + ALPHA*P2
C       defining the line.  DS measures the progress along the line
C       segment and defines the starting ALPHA1.  The ending ALPHA2
C       is computed from the end of the current pattern mark or space
C       or the segment end, whichever comes first.
C
   10 DSOLD = DS
      ALPHA1 = DS/SEGLEN
      ALPHA2 = MIN(1.0,(DS+SCALE*GRPATN(GRCIDE,GRIPAT(GRCIDE))-
     1           GRPOFF(GRCIDE))/SEGLEN)
      IF (MOD(GRIPAT(GRCIDE),2) .NE. 0) THEN
          XP = ADJUST(X0,X1,ALPHA1)
          YP = ADJUST(Y0,Y1,ALPHA1)
          XQ = ADJUST(X0,X1,ALPHA2)
          YQ = ADJUST(Y0,Y1,ALPHA2)
          IF (THICK.GT.1) THEN
              CALL GRLIN3(XP,YP,XQ,YQ)
          ELSE
              CALL GRLIN2(XP,YP,XQ,YQ)
          END IF
      END IF
      DS = ALPHA2*SEGLEN
      IF (ALPHA2 .GE. 1.0) THEN
          GRPOFF(GRCIDE) = GRPOFF(GRCIDE) + DS - DSOLD
          RETURN
      END IF
      GRIPAT(GRCIDE) = MOD(GRIPAT(GRCIDE),8) + 1
      GRPOFF(GRCIDE) = 0.0
      GO TO 10
      END
#<

#>            grlin2.dc3
Name:         GRLIN2

Purpose:      draw a normal line

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRLIN2 (X0,Y0,X1,Y1)
      
       GRPCKG : plot a visible line segment in absolute coords from
       (X0,Y0) to (X1,Y1).  The endpoints of the line segment are rounded
       to the nearest integer and passed to the appropriate device-specific
       routine. It is assumed that the entire line-segment lies within the
       view surface, and that the physical device coordinates are
       non-negative.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grlin2.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRLIN2 -- draw a normal line
C+
      SUBROUTINE GRLIN2 (X0,Y0,X1,Y1)
C
C GRPCKG : plot a visible line segment in absolute coords from
C (X0,Y0) to (X1,Y1).  The endpoints of the line segment are rounded
C to the nearest integer and passed to the appropriate device-specific
C routine. It is assumed that the entire line-segment lies within the
C view surface, and that the physical device coordinates are
C non-negative.
C--
C (1-Jun-1984)
C 19-Oct-1984 - rewritten for speed [TJP].
C 29-Jan-1985 - add HP2648 device [KS/TJP].
C  5-Aug-1986 - add GREXEC support [AFT].
C 21-Feb-1987 - If needed, calls begin picture [AFT].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      REAL    X0,Y0,X1,Y1
      REAL    RBUF(6)
      INTEGER NBUF,LCHR
      CHARACTER CHR
C
C- If this is first thing plotted then set something plotted flag
C- and for a GREXEC device call BEGIN_PICTURE.
C
      IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC
C---
      RBUF(1)=X0
      RBUF(2)=Y0
      RBUF(3)=X1
      RBUF(4)=Y1
      NBUF=4
C     WRITE(*,'(A,4F10.5)') 'GRLIN2',RBUF(1), RBUF(2), RBUF(3), RBUF(4)
      CALL GREXEC(GRGTYP,12,RBUF,NBUF,CHR,LCHR)
C
      END
#<

#>            grlin3.dc3
Name:         GRLIN3

Purpose:      draw a thick line (multiple strokes)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRLIN3 (X0,Y0,X1,Y1)
      
       GRPCKG: draw a heavy line from (X0,Y0) to (X1,Y1) by making multiple
       strokes.  In order to simulate a thick pen, the line drawn has
       circular, rather than square, end points.  If this is not done,
       thick letters and other figures have an abnormal and unpleasant
       appearance.
      
       Vocabulary:
      
       LINEWT: the number of strokes required to draw the line; if
             this is odd, one stroke will lie along the requested vector.
             The nominal line thickness is (LINEWT-1)*0.005 in.
       RSQURD: the square of the semi-line thickness.
       (DX,DY): the vector length of the line.
       (VX,VY): a vector of length 1 pixel in the direction of the line.
       (VY,-VX): a vector of length 1 pixel perpendicular to (VX,VY).
       OFF: the offset parallel to (VY,-VX) of the K'th stroke.
       (VXK,VYK): the vector increment of the K'th stroke to allow for the
             semi-circular terminal on the line.
       (PXK,PYK): the vector offset of the K'th stroke perpendicular to the
             line vector.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grlin3.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRLIN3 -- draw a thick line (multiple strokes)
C+
      SUBROUTINE GRLIN3 (X0,Y0,X1,Y1)
C
C GRPCKG: draw a heavy line from (X0,Y0) to (X1,Y1) by making multiple
C strokes.  In order to simulate a thick pen, the line drawn has
C circular, rather than square, end points.  If this is not done,
C thick letters and other figures have an abnormal and unpleasant
C appearance.
C
C Vocabulary:
C
C LINEWT: the number of strokes required to draw the line; if
C       this is odd, one stroke will lie along the requested vector.
C       The nominal line thickness is (LINEWT-1)*0.005 in.
C RSQURD: the square of the semi-line thickness.
C (DX,DY): the vector length of the line.
C (VX,VY): a vector of length 1 pixel in the direction of the line.
C (VY,-VX): a vector of length 1 pixel perpendicular to (VX,VY).
C OFF: the offset parallel to (VY,-VX) of the K'th stroke.
C (VXK,VYK): the vector increment of the K'th stroke to allow for the
C       semi-circular terminal on the line.
C (PXK,PYK): the vector offset of the K'th stroke perpendicular to the
C       line vector.
C--
C (1-Feb-1983)
C 23-Nov-1994 - change algorithm so that the unit of line-width is
C               0.005 inch instead of 1 pixel [TJP].
C March 1995 - added ABS to prevent domain error in SQRT (CTD)
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER  K,LINEWT
      REAL     DX,DY, HK, OFF, PXK,PYK, RSQURD, VLEN,VX,VY,VXK,VYK
      REAL     X0,X1,Y0,Y1
      REAL     XS0,XS1, YS0,YS1, SPIX,SPIY
      LOGICAL  VIS
C
C Determine number of strokes and line thickness.
C
      LINEWT = GRWIDT(GRCIDE)
      RSQURD = ((LINEWT-1)**2)*0.25
C
C Determine the vectors (VX,VY), (VY,-VX). If the line-length is zero,
C pretend it is a very short horizontal line.
C
      DX = X1 - X0
      DY = Y1 - Y0
      VLEN = SQRT(DX**2 + DY**2)
      SPIX = GRPXPI(GRCIDE)*0.005
      SPIY = GRPYPI(GRCIDE)*0.005
C
      IF (VLEN .EQ. 0.0) THEN
          VX = SPIX
          VY = 0.0
      ELSE
          VX = DX/VLEN*SPIX
          VY = DY/VLEN*SPIY
      END IF
C
C Draw LINEWT strokes. We have to clip again in case thickening the
C line has taken us outside the window.
C
      OFF = (LINEWT-1)*0.5
      DO 10 K=1,LINEWT
          PXK = VY*OFF
          PYK = -(VX*OFF)
          HK  = SQRT(ABS(RSQURD - OFF**2))
          VXK = VX*HK
          VYK = VY*HK
          XS1 = X1+PXK+VXK
          YS1 = Y1+PYK+VYK
          XS0 = X0+PXK-VXK
          YS0 = Y0+PYK-VYK
          CALL GRCLPL(XS1,YS1,XS0,YS0,VIS)
          IF (VIS) CALL GRLIN2(XS1, YS1, XS0, YS0)
          OFF = OFF - 1.0
   10 CONTINUE
      END
#<

#>            grlina.dc3
Name:         GRLINA

Purpose:      draw a line (absolute, world coordinates)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRLINA (X,Y)
      
       GRPCKG: draw line from current position to a specified position.
      
       Arguments:
      
       X, Y (real, input): world coordinates of the end-point of the line.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grlina.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRLINA -- draw a line (absolute, world coordinates)
C+
      SUBROUTINE GRLINA (X,Y)
C
C GRPCKG: draw line from current position to a specified position.
C
C Arguments:
C
C X, Y (real, input): world coordinates of the end-point of the line.
C--
C (1-Feb-1983)
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      REAL     X,Y
C
      IF (GRCIDE.GE.1) THEN
C         WRITE (*,'(A,2F10.5)') 'GRLINA', X, Y
          CALL GRLIN0( X * GRXSCL(GRCIDE) + GRXORG(GRCIDE),
     1                 Y * GRYSCL(GRCIDE) + GRYORG(GRCIDE) )
      END IF
      END
#<

#>            grlinr.dc3
Name:         GRLINR

Purpose:      draw a line (relative, world coordinates)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRLINR (DX,DY)
      
       GRPCKG: draw a line from the current position by a specified
       relative displacement.
      
       Arguments:
      
       DX, DY (real, input): the displacement in world coordinates: the pen
             position is incremented by DX in x and DY in y.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grlinr.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRLINR -- draw a line (relative, world coordinates)
C+
      SUBROUTINE GRLINR (DX,DY)
C
C GRPCKG: draw a line from the current position by a specified
C relative displacement.
C
C Arguments:
C
C DX, DY (real, input): the displacement in world coordinates: the pen
C       position is incremented by DX in x and DY in y.
C--
C (1-Feb-1983)
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      REAL     DX,DY
C
      IF (GRCIDE.GE.1) THEN
          CALL GRLIN0( DX * GRXSCL(GRCIDE) + GRXPRE(GRCIDE),
     1                 DY * GRYSCL(GRCIDE) + GRYPRE(GRCIDE) )
      END IF
      END
#<

#>            grmark.dc3
Name:         GRMARK

Purpose:      mark points with specified symbol

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRMARK (IDENT,CENTER,SYMBOL,ABSXY,POINTS,X,Y)
      
       GRPCKG: mark a sequence of points with a specified symbol. The
       plot is windowed in the current subarea.
      
       Arguments:
      
       IDENT (integer, input): plot identifier from GROPEN.
       CENTER (input, logical): if .TRUE. the symbol is centered on the point,
            otherwise the bottom left corner is placed at the point.
       SYMBOL (byte or integer, input): code number of symbol in range 0-127
            (ASCII character or special symbol); if SYMBOL is outside this
            range, nothing is plotted.
       ABSXY (logical, input): if .TRUE. (X,Y) are absolute (device)
            coordinates; otherwise they are world coordinates and the
            scaling transformation is applied.
       POINTS (integer, input): the number of points; if POINTS is less than
            or equal to 0, nothing is plotted.
       X,Y (real arrays, dimension at least POINTS, input): the coordinate
            pairs; if POINTS=1, these may be scalars instead of arrays.
      
       (9-Mar-1983)

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grmark.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRMARK -- mark points with specified symbol
C+
      SUBROUTINE GRMARK (IDENT,CENTER,SYMBOL,ABSXY,POINTS,X,Y)
C
C GRPCKG: mark a sequence of points with a specified symbol. The
C plot is windowed in the current subarea.
C
C Arguments:
C
C IDENT (integer, input): plot identifier from GROPEN.
C CENTER (input, logical): if .TRUE. the symbol is centered on the point,
C      otherwise the bottom left corner is placed at the point.
C SYMBOL (byte or integer, input): code number of symbol in range 0-127
C      (ASCII character or special symbol); if SYMBOL is outside this
C      range, nothing is plotted.
C ABSXY (logical, input): if .TRUE. (X,Y) are absolute (device)
C      coordinates; otherwise they are world coordinates and the
C      scaling transformation is applied.
C POINTS (integer, input): the number of points; if POINTS is less than
C      or equal to 0, nothing is plotted.
C X,Y (real arrays, dimension at least POINTS, input): the coordinate
C      pairs; if POINTS=1, these may be scalars instead of arrays.
C
C (9-Mar-1983)
C-----------------------------------------------------------------------
      INTEGER  SYMBOL
      CHARACTER*1 MARK
      INTEGER  I, IDENT, POINTS
      LOGICAL  ABSXY, CENTER
      REAL     X(*), Y(*)
C-----------------------------------------------------------------------
      IF (POINTS.LE.0 .OR. SYMBOL.LT.0 .OR. SYMBOL.GT.127) RETURN
      CALL GRSLCT(IDENT)
      MARK = CHAR(SYMBOL)
      DO 10 I=1,POINTS
          CALL GRCHR0(.TRUE., CENTER, 0.0, ABSXY, X(I), Y(I), MARK)
   10 CONTINUE
C-----------------------------------------------------------------------
      END
#<

#>            grmcur.dc3
Name:         grmcur

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Oct 16, 1998: JPT automatically generated.
#<

#>            grmcur.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

      SUBROUTINE GRMCUR (ICH, ICX, ICY)
      INTEGER ICH, ICX, ICY
C
C Cursor movement:
C Input: ICH character code
C In/Out: ICX, ICY cursor position
C-----------------------------------------------------------------------
      INTEGER STEP
      SAVE STEP
      DATA STEP /4/
C
C     Up arrow or keypad 8:
      IF (ICH.EQ.-1 .OR. ICH.EQ.-28) THEN
          ICY = ICY+STEP
C     Down arrow or keypad 2:
      ELSE IF (ICH.EQ.-2 .OR. ICH.EQ.-22) THEN
          ICY = ICY-STEP
C     Right arrow or keypad 6:
      ELSE IF (ICH.EQ.-3 .OR. ICH.EQ.-26) THEN
          ICX = ICX+STEP
C     Left arrow or keypad 4:
      ELSE IF (ICH.EQ.-4 .OR. ICH.EQ.-24) THEN
          ICX = ICX-STEP
C     Keypad 7 (left and up):
      ELSE IF (ICH.EQ.-27) THEN
          ICX = ICX-STEP
          ICY = ICY+STEP
C     Keypad 9 (right and up):
      ELSE IF (ICH.EQ.-29) THEN
          ICX = ICX+STEP
          ICY = ICY+STEP
C     Keypad 3 (right and down):
      ELSE IF (ICH.EQ.-23) THEN
          ICX = ICX+STEP
          ICY = ICY-STEP
C     Keypad 1 (left and down):
      ELSE IF (ICH.EQ.-21) THEN
          ICX = ICX-STEP
          ICY = ICY-STEP
C     PF1:
      ELSE IF (ICH.EQ.-11) THEN
          STEP = 1
C     PF2:
      ELSE IF (ICH.EQ.-12) THEN
          STEP = 4
C     PF3:
      ELSE IF (ICH.EQ.-13) THEN
          STEP = 16
C     PF4:
      ELSE IF (ICH.EQ.-14) THEN
          STEP = 64
      END IF
      END
#<

#>            grmker.dc3
Name:         GRMKER

Purpose:      draw graph markers

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRMKER (SYMBOL,ABSXY,N,X,Y)
      
       GRPCKG: Draw a graph marker at a set of points in the current
       window. Line attributes (color, intensity, and  thickness)
       apply to markers, but line-style is ignored. After the call to
       GRMKER, the current pen position will be the center of the last
       marker plotted.
      
       Arguments:
      
       SYMBOL (input, integer): the marker number to be drawn. Numbers
             0-31 are special marker symbols; numbers 32-127 are the
             corresponding ASCII characters (in the current font). If the
             number is >127, it is taken to be a Hershey symbol number.
             If -ve, a regular polygon is drawn.
       ABSXY (input, logical): if .TRUE., the input corrdinates (X,Y) are
             taken to be absolute device coordinates; if .FALSE., they are
             taken to be world coordinates.
       N (input, integer): the number of points to be plotted.
       X, Y (input, real arrays, dimensioned at least N): the (X,Y)
             coordinates of the points to be plotted.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grmker.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRMKER -- draw graph markers
C+
      SUBROUTINE GRMKER (SYMBOL,ABSXY,N,X,Y)
C
C GRPCKG: Draw a graph marker at a set of points in the current
C window. Line attributes (color, intensity, and  thickness)
C apply to markers, but line-style is ignored. After the call to
C GRMKER, the current pen position will be the center of the last
C marker plotted.
C
C Arguments:
C
C SYMBOL (input, integer): the marker number to be drawn. Numbers
C       0-31 are special marker symbols; numbers 32-127 are the
C       corresponding ASCII characters (in the current font). If the
C       number is >127, it is taken to be a Hershey symbol number.
C       If -ve, a regular polygon is drawn.
C ABSXY (input, logical): if .TRUE., the input corrdinates (X,Y) are
C       taken to be absolute device coordinates; if .FALSE., they are
C       taken to be world coordinates.
C N (input, integer): the number of points to be plotted.
C X, Y (input, real arrays, dimensioned at least N): the (X,Y)
C       coordinates of the points to be plotted.
C--
C (19-Mar-1983)
C 20-Jun-1985 - revise to window markers whole [TJP].
C  5-Aug-1986 - add GREXEC support [AFT].
C  1-Aug-1988 - add direct use of Hershey number [TJP].
C 15-Dec-1988 - standardize [TJP].
C 17-Dec-1990 - add polygons [PAH/TJP].
C 12-Jun-1992 - [TJP]
C 22-Sep-1992 - add support for hardware markers [TJP].
C  1-Sep-1994 - suppress driver call [TJP].
C 15-Feb-1994 - fix bug (expanding viewport!) [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER  SYMBOL
      INTEGER  C 
      LOGICAL  ABSXY, UNUSED, VISBLE
      INTEGER  I, K, LSTYLE, LX, LY, LXLAST, LYLAST, N, SYMNUM, NV
      INTEGER  XYGRID(300)
      REAL     ANGLE, COSA, SINA, FACTOR, RATIO, X(*), Y(*)
      REAL     XCUR, YCUR, XORG, YORG
      REAL     THETA, XOFF(40), YOFF(40), XP(40), YP(40)
      REAL     XMIN, XMAX, YMIN, YMAX
      REAL     XMINX, XMAXX, YMINX, YMAXX
      REAL     RBUF(4)
      INTEGER  NBUF,LCHR
      CHARACTER*32 CHR
C
C Check that there is something to be plotted.
C
      IF (N.LE.0) RETURN
C
C Check that a device is selected.
C
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRMKER - no graphics device is active.')
          RETURN
      END IF
C
      XMIN = GRXMIN(GRCIDE)
      XMAX = GRXMAX(GRCIDE)
      YMIN = GRYMIN(GRCIDE)
      YMAX = GRYMAX(GRCIDE)
      XMINX = XMIN-0.01
      XMAXX = XMAX+0.01
      YMINX = YMIN-0.01
      YMAXX = YMAX+0.01
C
C Does the device driver do markers (only markers 0-31 at present)?
C
      IF (GRGCAP(GRCIDE)(10:10).EQ.'M' .AND.
     :     SYMBOL.GE.0 .AND. SYMBOL.LE.31) THEN
          IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC
C         -- symbol number
          RBUF(1) = SYMBOL
C          -- scale factor
          RBUF(4) = GRCFAC(GRCIDE)/2.5
          NBUF = 4
          LCHR = 0
          DO 10 K=1,N
C             -- convert to device coordinates
              CALL GRTXY0(ABSXY, X(K), Y(K), XORG, YORG)
C             -- is the marker visible?
              CALL GRCLIP(XORG, YORG, XMINX, XMAXX, YMINX, YMAXX, C)
              IF (C.EQ.0) THEN
                  RBUF(2) = XORG
                  RBUF(3) = YORG
                  CALL GREXEC(GRGTYP,28,RBUF,NBUF,CHR,LCHR)
              END IF
   10     CONTINUE
          RETURN
      END IF
C
C Otherwise, draw the markers here.
C
C Save current line-style, and set style "normal".
C
      CALL GRQLS(LSTYLE)
      CALL GRSLS(1)
C
C Save current viewport, and open the viewport to include the full
C view surface.
C
      CALL GRAREA(GRCIDE, 0.0, 0.0, 0.0, 0.0)
C
C Compute scaling and orientation.
C
      ANGLE = 0.0
      FACTOR = GRCFAC(GRCIDE)/2.5
      RATIO = GRPXPI(GRCIDE)/GRPYPI(GRCIDE)
      COSA = FACTOR * COS(ANGLE)
      SINA = FACTOR * SIN(ANGLE)
C
C Convert the supplied marker number SYMBOL to a symbol number and
C obtain the digitization.
C
      IF (SYMBOL.GE.0) THEN
          IF (SYMBOL.GT.127) THEN
              SYMNUM = SYMBOL
          ELSE
              CALL GRSYMK(SYMBOL,GRCFNT(GRCIDE),SYMNUM)
          END IF
          CALL GRSYXD(SYMNUM, XYGRID, UNUSED)
C
C Positive symbols.
C
      DO 380 I=1,N
          CALL GRTXY0(ABSXY, X(I), Y(I), XORG, YORG)
          CALL GRCLIP(XORG, YORG, XMINX, XMAXX, YMINX, YMAXX, C)
          IF (C.NE.0) GOTO 380
          VISBLE = .FALSE.
          K = 4
          LXLAST = -64
          LYLAST = -64
  320       K = K+2
            LX = XYGRID(K)
            LY = XYGRID(K+1)
            IF (LY.EQ.-64) GOTO 380
            IF (LX.EQ.-64) THEN
                VISBLE = .FALSE.
            ELSE
                IF ((LX.NE.LXLAST) .OR. (LY.NE.LYLAST)) THEN
                    XCUR = XORG + (COSA*LX - SINA*LY)*RATIO
                    YCUR = YORG + (SINA*LX + COSA*LY)
                    IF (VISBLE) THEN
                        CALL GRLIN0(XCUR,YCUR)
                    ELSE
                        GRXPRE(GRCIDE) = XCUR
                        GRYPRE(GRCIDE) = YCUR
                    END IF
                END IF
                VISBLE = .TRUE.
                LXLAST = LX
                LYLAST = LY
            END IF
            GOTO 320
  380 CONTINUE
C
C Negative symbols.
C
      ELSE
C         ! negative symbol: filled polygon of radius 8
          NV = MIN(31,MAX(3,ABS(SYMBOL)))
          DO 400 I=1,NV
              THETA = 3.14159265359*(REAL(2*(I-1))/REAL(NV)+0.5) - ANGLE
              XOFF(I) = COS(THETA)*FACTOR*RATIO/GRXSCL(GRCIDE)*8.0
              YOFF(I) = SIN(THETA)*FACTOR/GRYSCL(GRCIDE)*8.0
  400     CONTINUE
          DO 420 K=1,N
              CALL GRTXY0(ABSXY, X(K), Y(K), XORG, YORG)
              CALL GRCLIP(XORG, YORG, XMINX, XMAXX, YMINX, YMAXX, C)
              IF (C.EQ.0) THEN
                  DO 410 I=1,NV
                      XP(I) = X(K)+XOFF(I)
                      YP(I) = Y(K)+YOFF(I)
  410             CONTINUE
                  CALL GRFA(NV, XP, YP)
              END IF
  420     CONTINUE
      END IF
C
C Set current pen position.
C
      GRXPRE(GRCIDE) = XORG
      GRYPRE(GRCIDE) = YORG
C
C Restore the viewport and line-style, and return.
C
      GRXMIN(GRCIDE) = XMIN
      GRXMAX(GRCIDE) = XMAX
      GRYMIN(GRCIDE) = YMIN
      GRYMAX(GRCIDE) = YMAX
      CALL GRSLS(LSTYLE)
C
      END
#<

#>            grmova.dc3
Name:         GRMOVA

Purpose:      move pen (absolute, world coordinates)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRMOVA (X,Y)
      
       GRPCKG: move the pen to a specified location.
      
       Arguments:
      
       X, Y (real, input): world coordinates of the new pen position.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grmova.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRMOVA -- move pen (absolute, world coordinates)
C+
      SUBROUTINE GRMOVA (X,Y)
C
C GRPCKG: move the pen to a specified location.
C
C Arguments:
C
C X, Y (real, input): world coordinates of the new pen position.
C--
C (1-Feb-1983)
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      REAL     X,Y
C
      IF (GRCIDE.GE.1) THEN
C         WRITE (*,'(A,2F10.5)') 'GRMOVA', X, Y
          GRXPRE(GRCIDE) = X * GRXSCL(GRCIDE) + GRXORG(GRCIDE)
          GRYPRE(GRCIDE) = Y * GRYSCL(GRCIDE) + GRYORG(GRCIDE)
      END IF
      END
#<

#>            grmovr.dc3
Name:         GRMOVR

Purpose:      move pen (relative, world coordinates)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRMOVR (DX,DY)
      
       GRPCKG: move the pen through a specified displacement.
      
       Arguments:
      
       DX, DY (real, input): the displacement in world coordinates: the pen
             position is incremented by DX in x and DY in y.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grmovr.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRMOVR -- move pen (relative, world coordinates)
C+
      SUBROUTINE GRMOVR (DX,DY)
C
C GRPCKG: move the pen through a specified displacement.
C
C Arguments:
C
C DX, DY (real, input): the displacement in world coordinates: the pen
C       position is incremented by DX in x and DY in y.
C--
C (1-Feb-1983)
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      REAL     DX,DY
C
      IF (GRCIDE.GE.1) THEN
          GRXPRE(GRCIDE) = GRXPRE(GRCIDE) + DX*GRXSCL(GRCIDE)
          GRYPRE(GRCIDE) = GRYPRE(GRCIDE) + DY*GRYSCL(GRCIDE)
      END IF
      END
#<

#>            grmsg.dc3
Name:         GRMSG

Purpose:      issue message to user

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRMSG (TEXT)
            CHARACTER*(*) TEXT
      
       Display a message on standard output.
      
       Argument:
        TEXT (input): text of message to be printed (the string
            may not be blank).

Updates:      Oct 16, 1998: JPT document extracted from 5.2.0 source;
                                Fortran source copied from GIPSY's v4.9E.
#<

#>            grmsg.f
* GIPSY-modified        
*

C*GRMSG -- issue message to user (Alliant-UNIX)
C+
      SUBROUTINE GRMSG (TEXT)
      CHARACTER*(*) TEXT
C
C Display a message on standard error.
C It is assumed that Fortran unit 0 is attached to stderr.
C
C Argument:
C  TEXT (input): text of message to be printed (the string
C      may not be blank).
C--
C 13-Dec-1990 [TJP].
C-----------------------------------------------------------------------
      INTEGER   I
      CHARACTER*250 WZ
C
      IF (TEXT.NE.' ') THEN
          I = LEN(TEXT)
   10     IF (TEXT(I:I).EQ.' ') THEN
              I = I-1
          GOTO 10
          END IF
CWZ       WRITE (0, '(1X,A)') TEXT(1:I)
          WZ = '%PGPLOT, '// TEXT(1:I)
          CALL ANYOUT( 1, WZ )
      END IF
      END
#<

#>            grmsg.f.orig
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRMSG -- issue message to user
C+
      SUBROUTINE GRMSG (TEXT)
      CHARACTER*(*) TEXT
C
C Display a message on standard output.
C
C Argument:
C  TEXT (input): text of message to be printed (the string
C      may not be blank).
C--
C  8-Nov-1994 [TJP].
C-----------------------------------------------------------------------
      INTEGER   GRTRIM
C
      IF (TEXT.NE.' ') THEN
          WRITE (*, '(1X,A)') TEXT(1:GRTRIM(TEXT))
      END IF
      END
#<

#>            gropen.dc3
Name:         GROPEN

Purpose:      open device for graphics

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            INTEGER FUNCTION GROPEN (TYPE,DUMMY,FILE,IDENT)
            INTEGER   TYPE, DUMMY, IDENT
            CHARACTER*(*) FILE
      
       GRPCKG: assign a device and prepare for plotting.  GROPEN must be
       called before all other calls to GRPCKG routines.
      
       Returns:
      
       GROPEN (output, integer): 1 => success, any other value
             indicates a failure (usually the value returned will
             be a VMS error code). In the event of an error, a
             message will be sent to the standard error unit.
      
       Arguments:
      
       TYPE (input, integer): default device type (integer code).
       DUMMY (input, integer): not used at present.
       FILE (input, character): plot specifier, of form 'device/type'.
       IDENT (output, integer): plot identifier to be used in later
             calls to GRPCKG.
      
        1-Jun-1984 - [TJP].
        2-Jul-1984 - change to call GRSLCT [TJP].
       13-Jul-1984 - add device initialization [TJP].
       23-Jul-1984 - add /APPEND qualifier.
       19-Oct-1984 - add VV device [TJP].
       26-Dec-1984 - obtain default file name from common [TJP].
       29-Jan-1985 - add HP2648 device [KS/TJP].
        5-Aug-1986 - add GREXEC support [AFT].
       12-Oct-1986 - fix bug causing GREXEC to erase screen [AFT].
        3-Jun-1987 - remove declaration of exit handler [TJP].
       15-Dec-1988 - standardize [TJP].
       25-Jun-1989 - remove code that removes spaces from the device name 
                     [TJP].
       26-Nov-1990 - [TJP].
        5-Jan-1993 - [TJP].
        1-Sep-1994 - store device capabilities in common for later use [TJP].
       17-Apr-1995 - zero-length string fix [TJP].
        6-Jun-1995 - explicitly initialize GRSTAT [TJP].
       29-Apr-1996 - moved initialization into GRINIT [TJP].

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            gropen.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GROPEN -- open device for graphics
C+
      INTEGER FUNCTION GROPEN (TYPE,DUMMY,FILE,IDENT)
      INTEGER   TYPE, DUMMY, IDENT
      CHARACTER*(*) FILE
C
C GRPCKG: assign a device and prepare for plotting.  GROPEN must be
C called before all other calls to GRPCKG routines.
C
C Returns:
C
C GROPEN (output, integer): 1 => success, any other value
C       indicates a failure (usually the value returned will
C       be a VMS error code). In the event of an error, a
C       message will be sent to the standard error unit.
C
C Arguments:
C
C TYPE (input, integer): default device type (integer code).
C DUMMY (input, integer): not used at present.
C FILE (input, character): plot specifier, of form 'device/type'.
C IDENT (output, integer): plot identifier to be used in later
C       calls to GRPCKG.
C
C  1-Jun-1984 - [TJP].
C  2-Jul-1984 - change to call GRSLCT [TJP].
C 13-Jul-1984 - add device initialization [TJP].
C 23-Jul-1984 - add /APPEND qualifier.
C 19-Oct-1984 - add VV device [TJP].
C 26-Dec-1984 - obtain default file name from common [TJP].
C 29-Jan-1985 - add HP2648 device [KS/TJP].
C  5-Aug-1986 - add GREXEC support [AFT].
C 12-Oct-1986 - fix bug causing GREXEC to erase screen [AFT].
C  3-Jun-1987 - remove declaration of exit handler [TJP].
C 15-Dec-1988 - standardize [TJP].
C 25-Jun-1989 - remove code that removes spaces from the device name 
C               [TJP].
C 26-Nov-1990 - [TJP].
C  5-Jan-1993 - [TJP].
C  1-Sep-1994 - store device capabilities in common for later use [TJP].
C 17-Apr-1995 - zero-length string fix [TJP].
C  6-Jun-1995 - explicitly initialize GRSTAT [TJP].
C 29-Apr-1996 - moved initialization into GRINIT [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER   IER, FTYPE, NBUF, LCHR
      INTEGER   GRPARS, GRTRIM
      REAL      RBUF(6)
      LOGICAL   APPEND
      CHARACTER*128 FFILE,CHR
C
C Initialize GRPCKG; read font file (if necessary).
C
      CALL GRINIT
C
C Allocate an identifier.
C
      IDENT = 1
   10 IF (GRSTAT(IDENT).NE.0) THEN
          IDENT = IDENT+1
          IF (IDENT.GT.GRIMAX) THEN
              CALL GRWARN('Too many active plots.')
              GROPEN = -1
              IDENT = 0
              RETURN
          END IF
      GOTO 10
      END IF
C
C Validate the device specification.
C
      IER = GRPARS(FILE,FFILE,FTYPE,APPEND)
      IF (IER.NE.1) THEN
          CHR = 'Invalid device specification: '
          CHR(31:) = FILE
          CALL GRWARN(CHR)
          GROPEN = -1
          RETURN
      END IF
      IF (FTYPE.EQ.0) FTYPE = TYPE
      IF (1.LE.FTYPE) THEN
          GRTYPE(IDENT) = FTYPE
          GRGTYP = FTYPE
      ELSE
          CHR = 'Device type omitted or invalid: '
          CHR(33:) = FILE
          CALL GRWARN(CHR)
          GROPEN = -1
          RETURN
      END IF
C
C Install the file name, or assign default.
C
      IF (FFILE.EQ.' ') THEN
          CALL GREXEC(GRGTYP, 5,RBUF,NBUF,FFILE,LCHR)
      END IF
      GRFILE(IDENT) = FFILE
      GRFNLN(IDENT) = MAX(1,GRTRIM(GRFILE(IDENT)))
C
C Open workstation.
C
      RBUF(3)=0
      IF (APPEND) RBUF(3)=1
      NBUF=3
      CALL GREXEC(GRGTYP, 9,RBUF,NBUF, GRFILE(IDENT),GRFNLN(IDENT))
      GRUNIT(IDENT)=RBUF(1)
      GROPEN=RBUF(2)
      IF (GROPEN.NE.1) RETURN
      GRPLTD(IDENT) = .FALSE.
      GRSTAT(IDENT) = 1
      CALL GRSLCT(IDENT)
C
C Install the default plot parameters
C
C--- Inquire color-index range.
      CALL GREXEC(GRGTYP, 2,RBUF,NBUF,CHR,LCHR)
      GRMNCI(IDENT)=RBUF(5)
      GRMXCI(IDENT)=RBUF(6)
C--- Inquire resolution.
      CALL GREXEC(GRGTYP, 3,RBUF,NBUF,CHR,LCHR)
      GRPXPI(IDENT)=RBUF(1)
      GRPYPI(IDENT)=RBUF(2)
C--- Inquire default character size.
      CALL GREXEC(GRGTYP, 7,RBUF,NBUF,CHR,LCHR)
      GRCSCL(IDENT) = RBUF(1)
      GRCFAC(IDENT) = RBUF(1)
C--- Inquire default plot size.
      CALL GREXEC(GRGTYP, 6,RBUF,NBUF,CHR,LCHR)
      GRXMXA(IDENT) = RBUF(2)
      GRYMXA(IDENT) = RBUF(4)
      GRXMIN(IDENT) = RBUF(1)
      GRXMAX(IDENT) = RBUF(2)
      GRYMIN(IDENT) = RBUF(3)
      GRYMAX(IDENT) = RBUF(4)
C--- Inquire device capabilities.
      GRGCAP(IDENT) = 'NNNNNNNNNNN'
      CALL GREXEC(GRGTYP, 4,RBUF,NBUF,CHR,LCHR)
      IF (LCHR.GT.LEN(GRGCAP(IDENT))) LCHR = LEN(GRGCAP(IDENT))
      GRGCAP(IDENT)(1:LCHR) = CHR(:LCHR)
C--- Current pen position.
      GRXPRE(IDENT) = 0.0
      GRYPRE(IDENT) = 0.0
C--- GRSETS has not been called.
      GRADJU(IDENT) = .FALSE.
C---Default scaling.
      CALL GRTRN0(0.0, 0.0, 1.0, 1.0)
C
C Default attributes.
C  text font (normal)
C  color (white)
C  line-style (full)
C  line-width (minimum)
C  marker number (dot)
C
      GRCFNT(IDENT) = 1
      GRCCOL(IDENT) = 1
      GRSTYL(IDENT) = 1
      GRWIDT(IDENT) = 1
      GRCMRK(IDENT) = 1
      GRDASH(IDENT) = .FALSE.
C
      GROPEN = 1
C
      END
#<

#>            groptx.dc3
Name:         groptx

Purpose:      open input/output text file [Unix]

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            INTEGER FUNCTION GROPTX (UNIT, NAME, DEFNAM, MODE)
            INTEGER UNIT, MODE
            CHARACTER*(*) NAME, DEFNAM
      
       Input:
        UNIT : Fortran unit number to use
        NAME : name of file to create
        DEFNAM : default file name (used to fill in missing fields for VMS)
        MODE : 0 to open for reading, 1 to open for writing.
      
       Returns:
        0 => success; any other value => error.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            groptx.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Fri Oct 16, 1998 at 13:32:47. The Fortran code is unmodified.

C*GROPTX -- open input/output text file [Unix]
C+
      INTEGER FUNCTION GROPTX (UNIT, NAME, DEFNAM, MODE)
      INTEGER UNIT, MODE
      CHARACTER*(*) NAME, DEFNAM
C
C Input:
C  UNIT : Fortran unit number to use
C  NAME : name of file to create
C  DEFNAM : default file name (used to fill in missing fields for VMS)
C  MODE : 0 to open for reading, 1 to open for writing.
C
C Returns:
C  0 => success; any other value => error.
C-----------------------------------------------------------------------
      INTEGER IER
      IF (MODE.EQ.1) THEN
          OPEN (UNIT=UNIT, FILE=NAME, STATUS='UNKNOWN', IOSTAT=IER)
      ELSE
          OPEN (UNIT=UNIT, FILE=NAME, STATUS='OLD', IOSTAT=IER)
      END IF
      GROPTX = IER
C-----------------------------------------------------------------------
      END
#<

#>            grpage.dc3
Name:         GRPAGE

Purpose:      end picture

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRPAGE
      
       GRPCKG: Advance the plotting area to a new page. For video devices,
       this amounts to erasing the screen; for hardcopy devices, the plot
       buffer is written to the output file followed by a form-feed to
       advance the paper to the start of the next page.
      
       Arguments: none.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grpage.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRPAGE -- end picture
C+
      SUBROUTINE GRPAGE
C
C GRPCKG: Advance the plotting area to a new page. For video devices,
C this amounts to erasing the screen; for hardcopy devices, the plot
C buffer is written to the output file followed by a form-feed to
C advance the paper to the start of the next page.
C
C Arguments: none.
C--
C  3-Jun-1983 - [TJP].
C 18-Feb-1984 - remove unnecessary 'T' initialization of VT125, and add
C               S(G1) for Rainbow REGIS [TJP].
C  1-Jun-1984 - add type GMFILE [TJP].
C  2-Jul-1984 - change initialization of VT125 for color [TJP].
C 13-Jul-1984 - move initialization of VT125 and Grinnell to GROPEN
C               [TJP].
C 19-Oct-1984 - add VV device [TJP].
C 29-Jan-1985 - add HP2648 terminal [KS/TJP].
C  5-Aug-1986 - add GREXEC support [AFT].
C 21-Feb-1987 - fix GREXEC end picture sequence [AFT].
C 11-Jun-1987 - remove built-in devices [TJP].
C 11-Feb-1992 - update veiew surface size: it may have changed! [TJP].
C  5-Jan-1993 - but only if GRSETS has not been called! [TJP]
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
C
      INTEGER NBUF,LCHR
      REAL    RBUF(6)
C
      CHARACTER CHR
C
C Flush the buffer.
C
      CALL GRTERM
C
C Erase the text screen (if there is one).
C
      CALL GRETXT
C
C End picture.
C
      CALL GREPIC
C
C Update the view surface size: it may have changed (on windowing 
C devices)
C
      IF (.NOT.GRADJU(GRCIDE)) THEN
          CALL GREXEC(GRGTYP, 6,RBUF,NBUF,CHR,LCHR)
          GRXMXA(GRCIDE) = RBUF(2)
          GRYMXA(GRCIDE) = RBUF(4)
      END IF
C
      END
#<

#>            grpars.dc3
Name:         GRPARS

Purpose:      parse device specification string

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            INTEGER FUNCTION GRPARS (SPEC,DEV,TYPE,APPEND)
            CHARACTER*(*) SPEC, DEV
            INTEGER  TYPE
            LOGICAL  APPEND
      
       GRPCKG: decode a device-specification; called by GROPEN.
      
       Returns:
        GRPARS (output): 1 if the device-specification is
             acceptable; any other value indicates an error.
      
       Arguments:
        SPEC (input): the device specification.
        DEV  (output):  device name or file spec.
        TYPE (output): device type (integer code); 0 if no device
             type is specified.
        APPEND (output): .TRUE. if /APPEND specified, .FALSE. otherwise.

Updates:      Oct 16, 1998: JPT document extracted from 5.2.0 source;
                                Fortran source copied from GIPSY's v4.9E.
#<

#>            grpars.f
* GIPSY-modified
*

C*GRPARS -- parse device specification string
C+
      INTEGER FUNCTION GRPARS (DESCR,DEV,TYPE,APPEND)
      CHARACTER*(*) DESCR, DEV
      INTEGER  TYPE
      LOGICAL  APPEND
C
C GRPCKG: decode a device-specification; called by GROPEN.
C
C Returns:
C  GRPARS (output): 1 if the device-specification is
C       acceptable; any other value indicates an error.
C
C Arguments:
C  DESCR (input): the device specification.
C  DEV (output):  device name or file spec.
C  TYPE (output): device type (integer code); 0 if no device
C       type is specified.
C  APPEND (output): .TRUE. if /APPEND specified, .FALSE. otherwise.
C--
C 23-Jul-1984 - [TJP].
C 19-Feb-1988 - allow device part to be quoted [TJP].
C 30-Mar-1989 - remove logical translation of device and type [TJP].
C-----------------------------------------------------------------------
      INTEGER       MAXW
      PARAMETER     (MAXW=3)
      CHARACTER*128 UPPER
      CHARACTER*32  CTYPE
      INTEGER       GRDTYP, I, L, NW, P1(10), P2(10), B, E
      LOGICAL       QUOTE
C
C Default results.
C
      DEV = ' '
      TYPE = 0
      APPEND = .FALSE.
      GRPARS = 1
C
C Null string is acceptable.
C
      IF (LEN(DESCR).LT.1) RETURN
      IF (DESCR.EQ.' ') RETURN
C
C Discount trailing blanks.
C
      L = LEN(DESCR)
   10 IF (DESCR(L:L).EQ.' ') THEN
          L = L-1
      GOTO 10
      END IF
C
C Perform logical name translation (system dependent), and
C discount trailing blanks again.
C
      UPPER = DESCR(1:L)
      CALL GRLGTR(UPPER)
      L = LEN(UPPER)
   20 IF (UPPER(L:L).EQ.' ') THEN
          L = L-1
      GOTO 20
      END IF
C
C Divide string into substrings delimited by slashes. Ignore
C slashes within quotes.
C
      NW = 1
      I = 1
      P1(1) = 0
      QUOTE = .FALSE.
   30 IF (I.LE.L) THEN
          IF ((UPPER(I:I).EQ.'/').AND.(.NOT.QUOTE)) THEN
              P2(NW) = I-1
              NW = NW+1
              IF (NW.GT.MAXW) THEN
                  CALL GRWARN(
     1               'Too many qualifiers in device specification')
                  GRPARS = 64
                  RETURN
              END IF
              P1(NW) = I
          ELSE IF (UPPER(I:I).EQ.'"') THEN
              QUOTE = .NOT.QUOTE
          END IF
          I = I+1
      GOTO 30
      END IF
      P2(NW) = L
C
C Substring 2 is the device name. Remove enclosing quotes if necessary.
C
      IF (NW.EQ.2) THEN
         B = P1(2)+1
         E = P2(2)
         IF (UPPER(B:B).EQ.'"'.AND.UPPER(E:E).EQ.'"'.AND.B.NE.E) THEN
             B = B+1
             E = E-1
         END IF
         IF (E.GE.B) THEN
             DEV = UPPER(B:E)
C;           CALL GRLGTR(DEV)
         END IF
      ENDIF
C
C Substring 1, if present, is the device type. 
C
      IF (NW.LT.1) THEN
          TYPE = 0
      ELSE IF (P2(1).LE.P1(1)) THEN
          CALL GRWARN('No device type specified')
          GRPARS = GRPARS+16
          TYPE = 0
      ELSE
          CTYPE = UPPER(P1(1)+1:P2(1))
C;        CALL GRLGTR(CTYPE)
          CALL GRTOUP(CTYPE,CTYPE)
          TYPE = GRDTYP(CTYPE)
          IF (TYPE.EQ.0) THEN
              CALL GRWARN('Unrecognized device type')
              GRPARS = GRPARS+2
          END IF
      END IF
C
C Substring 3, if present, is a qualifier.
C
      IF (NW.LT.3) THEN
          APPEND = .FALSE.
      ELSE IF (P2(3).LE.P1(3)) THEN
          CALL GRWARN('Invalid qualifier in device specification')
          GRPARS = GRPARS+4
          APPEND = .FALSE.
      ELSE
          CTYPE = UPPER(P1(3)+1:P2(3))
          CALL GRTOUP(CTYPE,CTYPE)
          L = P2(3) - P1(3)
          IF (CTYPE(1:L) .EQ. 'NOAPPEND') THEN
              APPEND = .FALSE.
          ELSE  IF (CTYPE(1:L).EQ.'APPEND') THEN
              APPEND = .TRUE.
          ELSE
              CALL GRWARN('Invalid qualifier in device specification')
              GRPARS = GRPARS+8
          END IF
      END IF
C
      END

#<

#>            grpars.f.orig
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRPARS -- parse device specification string
C+
      INTEGER FUNCTION GRPARS (SPEC,DEV,TYPE,APPEND)
      CHARACTER*(*) SPEC, DEV
      INTEGER  TYPE
      LOGICAL  APPEND
C
C GRPCKG: decode a device-specification; called by GROPEN.
C
C Returns:
C  GRPARS (output): 1 if the device-specification is
C       acceptable; any other value indicates an error.
C
C Arguments:
C  SPEC (input): the device specification.
C  DEV  (output):  device name or file spec.
C  TYPE (output): device type (integer code); 0 if no device
C       type is specified.
C  APPEND (output): .TRUE. if /APPEND specified, .FALSE. otherwise.
C--
C 23-Jul-1984 - [TJP].
C 19-Feb-1988 - allow device part to be quoted [TJP].
C 30-Mar-1989 - remove logical translation of device and type [TJP].
C 17-Jun-1991 - ignore comments after ' (' [TJP].
C 19-Dec-1994 - rewritten to scan backwards [TJP].
C  6-Jun-1995 - correct a zero-length string problem [TJP].
C-----------------------------------------------------------------------
      CHARACTER*32  CTYPE, UPPER
      CHARACTER*6   APPSTR
      CHARACTER*256 DESCR
      INTEGER       GRDTYP, GRTRIM
      INTEGER       L, LC, LS
      DATA          APPSTR/'APPEND'/
C
C Default results.
C
      DEV = ' '
      TYPE = 0
      APPEND = .FALSE.
      GRPARS = 1
      CTYPE = ' '
C
C Null string is acceptable.
C
      IF (LEN(SPEC).LT.1) RETURN
      IF (SPEC.EQ.' ') RETURN
C
C On systems where it is possible, perform a "logical name" translation.
C
      DESCR = SPEC
      CALL GRLGTR(DESCR)
C
C Discard trailing blanks: L is length of remainder.
C
      L = GRTRIM(DESCR)
C
C Find last slash in string (position LS or 0).
C
      LS = L
 20   IF (DESCR(LS:LS).NE.'/') THEN
         LS = LS-1
         IF (LS.GT.0) GOTO 20
      END IF
C
C Check for /APPEND qualifier; if present, look again for type.
C
      IF (LS.GT.0) THEN
         CTYPE = DESCR(LS+1:L)
         CALL GRTOUP(UPPER,CTYPE)
         CTYPE = UPPER
         IF (CTYPE.EQ.APPSTR) THEN
            APPEND = .TRUE.
            L = LS-1
            LS = L
 30         IF (DESCR(LS:LS).NE.'/') THEN
               LS = LS-1
               IF (LS.GT.0) GOTO 30
            END IF
         ELSE
            APPEND = .FALSE.
         END IF
      END IF
C
C If LS=0 there is no type field: use PGPLOT_TYPE.
C
      IF (LS.EQ.0) THEN
         CALL GRGENV('TYPE', CTYPE, LC)
      ELSE
         CTYPE = DESCR(LS+1:L)
         LC = L-LS
         L = LS-1
      END IF
C
C Check for allowed type.
C
      IF (LC.GT.0) THEN
         CALL GRTOUP(UPPER,CTYPE)
         CTYPE = UPPER
         TYPE = GRDTYP(CTYPE)
         IF (TYPE.EQ.0) CALL GRWARN('Unrecognized device type')
         IF (TYPE.EQ.-1) CALL GRWARN('Device type is ambiguous')
      ELSE
         TYPE = 0
         CALL GRWARN('Device type omitted')
      END IF
      IF (TYPE.EQ.0) GRPARS = GRPARS+2
C
C Remove quotes from device if necessary.
C
      IF (L.GE.1) THEN
         IF (DESCR(1:1).EQ.'"' .AND. DESCR(L:L).EQ.'"') THEN
            DEV = DESCR(2:L-1)
            L = L-2
         ELSE
            DEV = DESCR(1:L)
         END IF
      END IF
C
C      write (*,*) 'Device = [', DEV(1:L), ']'
C      write (*,*) 'Type   = [', CTYPE, ']', TYPE
C      write (*,*) 'APPEND = ', APPEND
C
      END
#<

#>            grpckg1.inc
C-----------------------------------------------------------------------
C            Include file for GRPCKG
C Modifications:
C   29-Jan-1985 - add HP2648 (KS/TJP).
C   16-Sep-1985 - remove tabs (TJP).
C   30-Dec-1985 - add PS, VPS (TJP).
C   27-May-1987 - remove ARGS, NULL, PS, VPS, QMS, VQMS, HIDMP,
C                 HP7221, GRINL (TJP).
C    6-Jun-1987 - remove PRTX, TRILOG, VERS, VV (TJP).
C   11-Jun-1987 - remove remaining built-in devices (TJP).
C    5-Jul-1987 - replace GRINIT, GRPLTD by GRSTAT.
C   16-Aug-1987 - remove obsolete variables.
C    9-Sep-1989 - add SAVE statement.
C   26-Nov-1990 - remove GRCTYP.
C    5-Jan-1993 - add GRADJU.
C    1-Sep-1994 - add GRGCAP.
C   21-Dec-1995 - increase GRIMAX to 8.
C   30-Apr-1997 - remove GRC{XY}SP
C   30-Sep-1999 - add GRBLCI, increase GRIMAX to 12.
C    7-Apr-2000 - add GRIMIP, increase GRIMAX to 16.
C-----------------------------------------------------------------------
C
C Parameters:
C   GRIMAX : maximum number of concurrent devices
C   GRFNMX : maximum length of file names
C   GRCXSZ : default width of chars (pixels)
C   GRCYSZ : default height of chars (pixels)
C
      INTEGER   GRIMAX, GRFNMX
      REAL      GRCXSZ, GRCYSZ
      PARAMETER (GRIMAX = 16)
      PARAMETER (GRFNMX = 90)
      PARAMETER (GRCXSZ =  7.0, GRCYSZ =  9.0)
C
C Common blocks:
C   GRCIDE : identifier of current plot
C   GRGTYP : device type of current plot
C The following are qualified by a plot id:
C   GRSTAT : 0 => workstation closed
C            1 => workstation open
C            2 => picture open
C   GRPLTD :
C   GRDASH : software dashing in effect?
C   GRUNIT : unit associated with id
C   GRFNLN : length of filename
C   GRTYPE : device type
C   GRXMXA : x size of plotting surface
C   GRYMXA : y size of plotting surface
C   GRXMIN : blc of plotting window
C   GRYMIN : ditto
C   GRXMAX : trc of plotting window
C   GRYMAX : ditto
C   GRSTYL : line style (integer code)
C   GRWIDT : line width (integer code)
C   GRCCOL : current color index (integer code)
C   GRMNCI : minimum color index on this device
C   GRMXCI : maximum color index on this device
C   GRCMRK : marker number
C   GRXPRE : previous (current) pen position (x)
C   GRYPRE : ditto (y)
C   GRXORG : transformation variables (GRTRAN)
C   GRYORG : ditto
C   GRXSCL : ditto
C   GRYSCL : ditto
C   GRCSCL : character scaling factor
C   GRCFAC :
C   GRCFNT : character font
C   GRFILE : file name (character)
C   GRGCAP : device capabilities (character)
C   GRPXPI : pixels per inch in x
C   GRPYPI : pixels per inch in y
C   GRADJU : TRUE if GRSETS (PGPAP) has been called
C   GRBLCI : color index associated with blank value
C   GRIMIP : if not equal to zero, GRIMG2 should interpolate
C
      INTEGER   GRCIDE, GRGTYP
      LOGICAL   GRPLTD(GRIMAX), GRDASH(GRIMAX), GRADJU(GRIMAX)
      INTEGER   GRSTAT(GRIMAX)
      INTEGER   GRUNIT(GRIMAX), GRFNLN(GRIMAX), GRTYPE(GRIMAX),
     1          GRXMXA(GRIMAX), GRYMXA(GRIMAX), 
     2          GRSTYL(GRIMAX), GRWIDT(GRIMAX), GRCCOL(GRIMAX),
     3          GRCMRK(GRIMAX), GRIPAT(GRIMAX), GRCFNT(GRIMAX),
     4          GRMNCI(GRIMAX), GRMXCI(GRIMAX), GRBLCI(GRIMAX),
     5          GRIMIP(GRIMAX)
      REAL      GRXMIN(GRIMAX), GRYMIN(GRIMAX),
     1          GRXMAX(GRIMAX), GRYMAX(GRIMAX)
      REAL      GRXPRE(GRIMAX), GRYPRE(GRIMAX), GRXORG(GRIMAX),
     1          GRYORG(GRIMAX), GRXSCL(GRIMAX), GRYSCL(GRIMAX),
     2          GRCSCL(GRIMAX), GRCFAC(GRIMAX), GRPOFF(GRIMAX),
     3          GRPATN(GRIMAX,8),GRPXPI(GRIMAX),GRPYPI(GRIMAX)
      COMMON /GRCM00/ GRCIDE, GRGTYP, GRSTAT, GRPLTD, GRUNIT,
     1                GRFNLN, GRTYPE, GRXMXA, GRYMXA, GRXMIN, GRYMIN,
     2                GRXMAX, GRYMAX, GRWIDT, GRCCOL, GRSTYL,
     3                GRXPRE, GRYPRE, GRXORG, GRYORG, GRXSCL, GRYSCL,
     4                GRCSCL, GRCFAC, GRDASH, GRPATN, GRPOFF,
     5                GRIPAT, GRCFNT, GRCMRK, GRPXPI, GRPYPI, GRADJU,
     6                GRMNCI, GRMXCI, GRBLCI, GRIMIP
C
      CHARACTER*(GRFNMX) GRFILE(GRIMAX)
      CHARACTER*11       GRGCAP(GRIMAX)
      COMMON /GRCM01/ GRFILE, GRGCAP
      SAVE /GRCM00/, /GRCM01/
C-----------------------------------------------------------------------
#<

#>            grpckg1.inc.orig
C-----------------------------------------------------------------------
C            Include file for GRPCKG
C Modifications:
C   29-Jan-1985 - add HP2648 (KS/TJP).
C   16-Sep-1985 - remove tabs (TJP).
C   30-Dec-1985 - add PS, VPS (TJP).
C   27-May-1987 - remove ARGS, NULL, PS, VPS, QMS, VQMS, HIDMP,
C                 HP7221, GRINL (TJP).
C    6-Jun-1987 - remove PRTX, TRILOG, VERS, VV (TJP).
C   11-Jun-1987 - remove remaining built-in devices (TJP).
C    5-Jul-1987 - replace GRINIT, GRPLTD by GRSTAT.
C   16-Aug-1987 - remove obsolete variables.
C    9-Sep-1989 - add SAVE statement.
C   26-Nov-1990 - remove GRCTYP.
C    5-Jan-1993 - add GRADJU.
C    1-Sep-1994 - add GRGCAP.
C   21-Dec-1995 - increase GRIMAX to 8.
C   30-Apr-1997 - remove GRC{XY}SP
C-----------------------------------------------------------------------
C
C Parameters:
C   GRIMAX : maximum number of concurrent devices
C   GRFNMX : maximum length of file names
C   GRCXSZ : default width of chars (pixels)
C   GRCYSZ : default height of chars (pixels)
C
      INTEGER   GRIMAX, GRFNMX
      REAL      GRCXSZ, GRCYSZ
      PARAMETER (GRIMAX = 8)
      PARAMETER (GRFNMX = 90)
      PARAMETER (GRCXSZ =  7.0, GRCYSZ =  9.0)
C
C Common blocks:
C   GRCIDE : identifier of current plot
C   GRGTYP : device type of current plot
C The following are qualified by a plot id:
C   GRSTAT : 0 => workstation closed
C            1 => workstation open
C            2 => picture open
C   GRPLTD :
C   GRDASH : software dashing in effect?
C   GRUNIT : unit associated with id
C   GRFNLN : length of filename
C   GRTYPE : device type
C   GRXMXA : x size of plotting surface
C   GRYMXA : y size of plotting surface
C   GRXMIN : blc of plotting window
C   GRYMIN : ditto
C   GRXMAX : trc of plotting window
C   GRYMAX : ditto
C   GRSTYL : line style (integer code)
C   GRWIDT : line width (integer code)
C   GRCCOL : current color index (integer code)
C   GRMNCI : minimum color index on this device
C   GRMXCI : maximum color index on this device
C   GRCMRK : marker number
C   GRXPRE : previous (current) pen position (x)
C   GRYPRE : ditto (y)
C   GRXORG : transformation variables (GRTRAN)
C   GRYORG : ditto
C   GRXSCL : ditto
C   GRYSCL : ditto
C   GRCSCL : character scaling factor
C   GRCFAC :
C   GRCFNT : character font
C   GRFILE : file name (character)
C   GRGCAP : device capabilities (character)
C   GRPXPI : pixels per inch in x
C   GRPYPI : pixels per inch in y
C   GRADJU : TRUE if GRSETS (PGPAP) has been called
C
      INTEGER   GRCIDE, GRGTYP
      LOGICAL   GRPLTD(GRIMAX), GRDASH(GRIMAX), GRADJU(GRIMAX)
      INTEGER   GRSTAT(GRIMAX)
      INTEGER   GRUNIT(GRIMAX), GRFNLN(GRIMAX), GRTYPE(GRIMAX),
     1          GRXMXA(GRIMAX), GRYMXA(GRIMAX), 
     2          GRSTYL(GRIMAX), GRWIDT(GRIMAX), GRCCOL(GRIMAX),
     3          GRCMRK(GRIMAX), GRIPAT(GRIMAX), GRCFNT(GRIMAX),
     4          GRMNCI(GRIMAX), GRMXCI(GRIMAX)
      REAL      GRXMIN(GRIMAX), GRYMIN(GRIMAX),
     1          GRXMAX(GRIMAX), GRYMAX(GRIMAX)
      REAL      GRXPRE(GRIMAX), GRYPRE(GRIMAX), GRXORG(GRIMAX),
     1          GRYORG(GRIMAX), GRXSCL(GRIMAX), GRYSCL(GRIMAX),
     2          GRCSCL(GRIMAX), GRCFAC(GRIMAX), GRPOFF(GRIMAX),
     3          GRPATN(GRIMAX,8),GRPXPI(GRIMAX),GRPYPI(GRIMAX)
      COMMON /GRCM00/ GRCIDE, GRGTYP, GRSTAT, GRPLTD, GRUNIT,
     1                GRFNLN, GRTYPE, GRXMXA, GRYMXA, GRXMIN, GRYMIN,
     2                GRXMAX, GRYMAX, GRWIDT, GRCCOL, GRSTYL,
     3                GRXPRE, GRYPRE, GRXORG, GRYORG, GRXSCL, GRYSCL,
     4                GRCSCL, GRCFAC, GRDASH, GRPATN, GRPOFF,
     5                GRIPAT, GRCFNT, GRCMRK, GRPXPI, GRPYPI, GRADJU,
     6                GRMNCI, GRMXCI
C
      CHARACTER*(GRFNMX) GRFILE(GRIMAX)
      CHARACTER*11       GRGCAP(GRIMAX)
      COMMON /GRCM01/ GRFILE, GRGCAP
      SAVE /GRCM00/, /GRCM01/
C-----------------------------------------------------------------------
#<

#>            grpixl.dc3
Name:         GRPIXL

Purpose:      solid-fill multiple rectangular areas

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRPIXL (IA, IDIM, JDIM, I1, I2, J1, J2, 
           1                   X1, X2, Y1, Y2)
            INTEGER IDIM, JDIM, I1, I2, J1, J2
            INTEGER IA(IDIM,JDIM)
            REAL    X1, X2, Y1, Y2
      
       Determine the size of each rectangular element. If it is equal
       to the device pen width and the device supports pixel primitives,
       use pixel primitives. Otherwise, if the size is smaller than the
       device pen width emulate pixel output by plotting points. If the
       size is larger than the device pen width, emulate by outputting
       solid-filled rectangles.
      
       Arguments:
        IA     (input)  : the array to be plotted.
        IDIM   (input)  : the first dimension of array A.
        JDIM   (input)  : the second dimension of array A.
        I1, I2 (input)  : the inclusive range of the first index
                          (I) to be plotted.
        J1, J2 (input)  : the inclusive range of the second
                          index (J) to be plotted.
        X1, Y1 (input)  : world coordinates of one corner of the output
                          region
        X2, Y2 (input)  : world coordinates of the opposite corner of the
                          output region

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grpixl.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRPIXL -- solid-fill multiple rectangular areas
C+
      SUBROUTINE GRPIXL (IA, IDIM, JDIM, I1, I2, J1, J2, 
     1                   X1, X2, Y1, Y2)
      INTEGER IDIM, JDIM, I1, I2, J1, J2
      INTEGER IA(IDIM,JDIM)
      REAL    X1, X2, Y1, Y2
C
C Determine the size of each rectangular element. If it is equal
C to the device pen width and the device supports pixel primitives,
C use pixel primitives. Otherwise, if the size is smaller than the
C device pen width emulate pixel output by plotting points. If the
C size is larger than the device pen width, emulate by outputting
C solid-filled rectangles.
C
C Arguments:
C  IA     (input)  : the array to be plotted.
C  IDIM   (input)  : the first dimension of array A.
C  JDIM   (input)  : the second dimension of array A.
C  I1, I2 (input)  : the inclusive range of the first index
C                    (I) to be plotted.
C  J1, J2 (input)  : the inclusive range of the second
C                    index (J) to be plotted.
C  X1, Y1 (input)  : world coordinates of one corner of the output
C                    region
C  X2, Y2 (input)  : world coordinates of the opposite corner of the
C                    output region
C--
C 18-Jan-1991 - [Ge van Geldorp]
C 31-Mar-1993 - Include color PostScript GRPXPS [Remko Scharroo]
C  4-Apr-1993 - New version of GRPXPS incorporated
C  4-Aug-1993 - Debugging
C  7-Sep-1994 - Revised for v5.0 [TJP].
C 24-Jan-1996 - GRXMIN etc changed to REAL as required in grpckg1.inc [RS]
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      REAL    RBUF(3)
      INTEGER NBUF, LCHR
      CHARACTER*32 CHR
      REAL    XLL, YLL, XUR, YUR
      REAL    XMIN, YMIN, XMAX, YMAX, XPIX, YPIX
      REAL    WIDTH, XSIZE, YSIZE
      INTEGER IL, IR, JB, JT
C
      IF (GRCIDE.LT.1) RETURN
C
C Convert to device coordinates
C
      CALL GRTXY0(.FALSE., X1, Y1, XLL, YLL)
      CALL GRTXY0(.FALSE., X2, Y2, XUR, YUR)
      XMIN = MIN(XLL,XUR)
      XMAX = MAX(XLL,XUR)
      YMIN = MIN(YLL,YUR)
      YMAX = MAX(YLL,YUR)
C
C Check if completely outside clipping region
C
      IF (XMAX .LT. GRXMIN(GRCIDE) .OR. GRXMAX(GRCIDE) .LT. XMIN .OR.
     1    YMAX .LT. GRYMIN(GRCIDE) .OR. GRYMAX(GRCIDE) .LT. YMIN)
     2   RETURN
C
C Don't paint "pixels" completely before left clipping boundary
C
      XPIX = XMAX - XMIN
      YPIX = YMAX - YMIN
      IF (XMIN .LT. GRXMIN(GRCIDE)) THEN
         IL = I1 + (GRXMIN(GRCIDE) - XMIN) * (I2 - I1 + 1) / XPIX
         XMIN = XMIN + (XPIX * (IL - I1)) / (I2 - I1 + 1)
      ELSE
         IL = I1
      ENDIF
C
C Don't paint "pixels" completely after right clipping boundary
C
      IF (GRXMAX(GRCIDE) .LT. XMAX) THEN
         IR = I2 - (XMAX - GRXMAX(GRCIDE)) * (I2 - I1 + 1) / XPIX + 1
         XMAX = XMIN + (XPIX * (IR - I1 + 1)) /
     1                 (I2 - I1 + 1)
      ELSE
         IR = I2
      ENDIF
C
C Don't paint "pixels" completely under bottom clipping boundary
C
      IF (YMIN .LT. GRYMIN(GRCIDE)) THEN
         JB = J1 + (GRYMIN(GRCIDE) - YMIN) * (J2 - J1 + 1) / YPIX
         YMIN = YMIN + (YPIX * (JB - J1)) / (J2 - J1 + 1)
      ELSE
         JB = J1
      ENDIF
C
C Don't paint "pixels" completely above top clipping boundary
C
      IF (GRYMAX(GRCIDE) .LT. YMAX) THEN
         JT = J2 - (YMAX - GRYMAX(GRCIDE)) * (J2 - J1 + 1) / YPIX + 1
         YMAX = YMIN + (YPIX * (JT - J1 + 1)) /
     1                 (J2 - J1 + 1)
      ELSE
         JT = J2
      ENDIF
C
C If device accepts image primitives, use GRPXPS
C
      IF (GRGCAP(GRCIDE)(7:7).EQ.'Q') THEN
         CALL GRPXPS(IA, IDIM, JDIM, IL, IR, JB, JT,
     1		     XMIN,XMAX,YMIN,YMAX)
         RETURN
      ENDIF
C
C Check against pen width
C
      CALL GREXEC(GRGTYP, 3, RBUF, NBUF, CHR, LCHR)
      WIDTH = RBUF(3)
      XSIZE = (I2 - I1 + 1) * WIDTH
      YSIZE = (J2 - J1 + 1) * WIDTH
      XPIX = XMAX - XMIN + 1
      YPIX = YMAX - YMIN + 1
C
C Use rectangles if "pixel" is too large
C
      IF (XPIX .GT. XSIZE + 0.5 * WIDTH .OR.
     1    YPIX .GT. YSIZE + 0.5 * WIDTH) THEN
*     write (6,*) 'GRPXRE'
         CALL GRPXRE(IA, IDIM, JDIM, IL, IR, JB, JT,
     1		     XMIN, XMAX, YMIN, YMAX)
C
C Use either pixel primitives or points
C
      ELSE
C
C Clip pixels lying more than 50% outside clipping boundaries
C
         IF (XMIN .LT. GRXMIN(GRCIDE) - 0.5 * WIDTH) THEN
            XMIN = XMIN + XPIX / (IR - IL + 1)
            IL = IL + 1
         ENDIF
         IF (GRXMAX(GRCIDE) + 0.5 * WIDTH .LT. XMAX) THEN
            XMAX = XMAX - XPIX / (IR - IL + 1)
            IR = IR - 1
         ENDIF
         IF (YMIN .LT. GRYMIN(GRCIDE) - 0.5 * WIDTH) THEN
            YMIN = YMIN + YPIX / (JT - JB + 1)
            JB = JB + 1
         ENDIF
         IF (GRYMAX(GRCIDE) + 0.5 * WIDTH .LT. YMAX) THEN
            YMAX = YMAX - YPIX / (JT - JB + 1)
            JT = JT - 1
         ENDIF
C
C Recalculate size
C
         XSIZE = (IR - IL + 1) * WIDTH
         YSIZE = (JT - JB + 1) * WIDTH
         XPIX = XMAX - XMIN + 1
         YPIX = YMAX - YMIN + 1
C
C Use pixel primitives if available and possible
C
         IF (GRGCAP(GRCIDE)(7:7) .EQ. 'P' .AND. 
     1       XSIZE - 0.5 * WIDTH .LE. XPIX .AND.
     2       YSIZE - 0.5 * WIDTH .LE. YPIX) THEN
*     write (6,*) 'GRPXPX'
            CALL GRPXPX(IA, IDIM, JDIM, IL, IR, JB, JT, XMIN, YMIN)
C
C Otherwise, use points
C
         ELSE
*     write (6,*) 'GRPXPO'
            CALL GRPXPO(IA, IDIM, JDIM, IL, IR, JB, JT,
     1		     XMIN, XMAX, YMIN, YMAX)
         ENDIF
      ENDIF
      END
#<

#>            grpocl.dc3
Name:         GRPOCL

Purpose:      polygon clip

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRPOCL (N,PX,PY, EDGE, VAL, MAXOUT, NOUT, QX, QY)
            INTEGER N, NOUT, EDGE, MAXOUT
            REAL    PX(*), PY(*), QX(*), QY(*)
            REAL    VAL
      
       Clip a polygon against a rectangle: Sutherland-Hodgman algorithm.
       this routine must be called four times to clip against each of the
       edges of the rectangle in turn.      
      
       Arguments:
      
       N (input, integer): the number of vertices of the polygon (at least
             3).
       PX, PY (input, real arrays, dimension at least N): world coordinates
             of the N vertices of the input polygon.
       EDGE (input, integer):
           1: clip against left edge,   X > XMIN=VAL
           2: clip against right edge,  X < XMAX=VAL
           3: clip against bottom edge, Y > YMIN=VAL
           4: clip against top edge,    Y < YMIN=VAL
       VAL  (input, real): coordinate value of current edge.
       MAXOUT (input, integer): maximum number of vertices allowed in
           output polygon (dimension of QX, QY).
       NOUT (output, integer): the number of vertices in the clipped polygon.
       QX, QY (output, real arrays, dimension at least MAXOUT): world
             coordinates of the NOUT vertices of the output polygon.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grpocl.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRPOCL -- polygon clip
C+
      SUBROUTINE GRPOCL (N,PX,PY, EDGE, VAL, MAXOUT, NOUT, QX, QY)
      INTEGER N, NOUT, EDGE, MAXOUT
      REAL    PX(*), PY(*), QX(*), QY(*)
      REAL    VAL
C
C Clip a polygon against a rectangle: Sutherland-Hodgman algorithm.
C this routine must be called four times to clip against each of the
C edges of the rectangle in turn.      
C
C Arguments:
C
C N (input, integer): the number of vertices of the polygon (at least
C       3).
C PX, PY (input, real arrays, dimension at least N): world coordinates
C       of the N vertices of the input polygon.
C EDGE (input, integer):
C     1: clip against left edge,   X > XMIN=VAL
C     2: clip against right edge,  X < XMAX=VAL
C     3: clip against bottom edge, Y > YMIN=VAL
C     4: clip against top edge,    Y < YMIN=VAL
C VAL  (input, real): coordinate value of current edge.
C MAXOUT (input, integer): maximum number of vertices allowed in
C     output polygon (dimension of QX, QY).
C NOUT (output, integer): the number of vertices in the clipped polygon.
C QX, QY (output, real arrays, dimension at least MAXOUT): world
C       coordinates of the NOUT vertices of the output polygon.
C--
C 19-Sep-1994 - [TJP].
C 27-Feb-1996 - fix bug: overflow if coordinates are large [TJP].
C 11-Jul-1996 - fix bug: left and bottom edges disappeared when precisely
C               on edge [Remko Scharroo]
C-----------------------------------------------------------------------
      INTEGER I
      REAL FX, FY, SX, SY
C
      NOUT = 0
      DO 100 I=1,N
         IF (I.EQ.1) THEN
C           -- save first point
            FX = PX(I)
            FY = PY(I)
         ELSE IF ((EDGE.EQ.1 .OR.EDGE.EQ.2) .AND.
     :            (SIGN(1.0,PX(I)-VAL).NE.SIGN(1.0,SX-VAL))) THEN
C           -- SP intersects this edge: output vertex at intersection
            NOUT = NOUT+1
            IF (NOUT.LE.MAXOUT) THEN
               QX(NOUT) = VAL
               QY(NOUT) = SY + (PY(I)-SY)*((VAL-SX)/(PX(I)-SX))
            END IF
         ELSE IF ((EDGE.EQ.3 .OR.EDGE.EQ.4) .AND.
     :            (SIGN(1.0,PY(I)-VAL).NE.SIGN(1.0,SY-VAL))) THEN
C           -- SP intersects this edge: output vertex at intersection
            NOUT = NOUT+1
            IF (NOUT.LE.MAXOUT) THEN
               QX(NOUT) = SX + (PX(I)-SX)*((VAL-SY)/(PY(I)-SY))
               QY(NOUT) = VAL
            END IF
         END IF
         SX = PX(I)
         SY = PY(I)
         IF ((EDGE.EQ.1.AND.SX.GE.VAL) .OR.
     :       (EDGE.EQ.2.AND.SX.LE.VAL) .OR.
     :       (EDGE.EQ.3.AND.SY.GE.VAL) .OR.
     :       (EDGE.EQ.4.AND.SY.LE.VAL)) THEN
C           -- output visible vertex S
            NOUT = NOUT + 1
            IF (NOUT.LE.MAXOUT) THEN
                QX(NOUT) = SX
                QY(NOUT) = SY
            END IF
         END IF
 100  CONTINUE
C      -- Does SF intersect edge?
      IF ((EDGE.EQ.1 .OR. EDGE.EQ.2) .AND.
     :    (SIGN(1.0,SX-VAL).NE.SIGN(1.0,FX-VAL))) THEN
         NOUT = NOUT+1
         IF (NOUT.LE.MAXOUT) THEN
            QX(NOUT) = VAL
            QY(NOUT) = SY + (FY-SY)*((VAL-SX)/(FX-SX))
         END IF
      ELSE IF ((EDGE.EQ.3 .OR. EDGE.EQ.4) .AND.
     :         (SIGN(1.0,SY-VAL).NE.SIGN(1.0,FY-VAL))) THEN
         NOUT = NOUT+1
         IF (NOUT.LE.MAXOUT) THEN
            QY(NOUT) = VAL
            QX(NOUT) = SX + (FX-SX)*((VAL-SY)/(FY-SY))
         END IF
      END IF
C
      END
#<

#>            grprom.dc3
Name:         GRPROM

Purpose:      prompt user before clearing screen

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRPROM
      
       If the program is running under control of a terminal, display
       message and wait for the user to type <CR> before proceeding.
      
       Arguments:
        none

Updates:      Oct 16, 1998: JPT document extracted from 5.2.0 source;
                                Fortran source copied from GIPSY's v4.9E.
#<

#>            grprom.f
* GIPSY-modified
*

C*GRPROM -- prompt user before clearing screen (Sun/Convex-UNIX)
C+
      SUBROUTINE GRPROM
C
C If the program is running under control of a terminal (in VMS,
C if SYS$COMMAND is a terminal), display "Type <RETURN> for next
C page: " and wait for the user to type <CR> before proceeding.
C
C Arguments:
C  none
C--
C 15-Dec-1988
C 23-JAN-1991 Modified for GIPSY (KGB)
C-----------------------------------------------------------------------
CWZ   INTEGER IER
CWZ   LOGICAL ISATTY
C
CWZ   IF (ISATTY(0) .AND. ISATTY(5)) THEN
CWZ       WRITE (0, '(A,A,$)', IOSTAT=IER)
CWZ  1        CHAR(7), 'Type <RETURN> for next page: '
CWZ       IF (IER.EQ.0) READ (5, '(1X)', IOSTAT=IER)
CWZ   END IF
      INTEGER USERLOG, I
      LOGICAL NEXT
C
      I=USERLOG(NEXT,1,1,'NEXTPAGE=','Type <RETURN> for next page')
      CALL CANCEL('NEXTPAGE=')
      END

#<

#>            grprom.f.orig
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRPROM -- prompt user before clearing screen
C+
      SUBROUTINE GRPROM
C
C If the program is running under control of a terminal, display
C message and wait for the user to type <CR> before proceeding.
C
C Arguments:
C  none
C--
C 18-Aug-1994
C-----------------------------------------------------------------------
      INTEGER IER, L, GRGCOM
      CHARACTER*16 JUNK
C
      IER = GRGCOM(JUNK, 'Type <RETURN> for next page: ', L)
      END
#<

#>            grpxpo.dc3
Name:         GRPXPO

Purpose:      Emulate pixel operations using points

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRPXPO (IA, IDIM, JDIM, I1, I2, J1, J2, 
           1                   X1, X2, Y1, Y2)
            INTEGER IDIM, JDIM, I1, I2, J1, J2
            INTEGER IA(IDIM,JDIM)
            REAL    X1, X2, Y1, Y2
      
       Arguments:
        IA     (input)  : the array to be plotted.
        IDIM   (input)  : the first dimension of array A.
        JDIM   (input)  : the second dimension of array A.
        I1, I2 (input)  : the inclusive range of the first index
                          (I) to be plotted.
        J1, J2 (input)  : the inclusive range of the second
                          index (J) to be plotted.
        X1, X2 (input)  : the horizontal range of the output region
        Y1, Y2 (input)  : the vertical range of the output region

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grpxpo.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRPXPO -- Emulate pixel operations using points
C+
      SUBROUTINE GRPXPO (IA, IDIM, JDIM, I1, I2, J1, J2, 
     1                   X1, X2, Y1, Y2)
      INTEGER IDIM, JDIM, I1, I2, J1, J2
      INTEGER IA(IDIM,JDIM)
      REAL    X1, X2, Y1, Y2
C
C Arguments:
C  IA     (input)  : the array to be plotted.
C  IDIM   (input)  : the first dimension of array A.
C  JDIM   (input)  : the second dimension of array A.
C  I1, I2 (input)  : the inclusive range of the first index
C                    (I) to be plotted.
C  J1, J2 (input)  : the inclusive range of the second
C                    index (J) to be plotted.
C  X1, X2 (input)  : the horizontal range of the output region
C  Y1, Y2 (input)  : the vertical range of the output region
C--
C 16-Jan-1991 - [GvG]
C 28-Jun-1991
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER LW
      INTEGER I, J
      INTEGER ICOL, LSTCOL
C
C Save attributes
C
      CALL GRQLW(LW)
      CALL GRQCI(ICOL)
      CALL GRSLW(1)
      LSTCOL = ICOL
      DO 20 J = J1, J2
         DO 10 I = I1, I2
C
C Color changed?
C
            IF (IA(I, J) .NE. LSTCOL) THEN
               CALL GRSCI(IA(I, J))
               LSTCOL = IA(I, J)
            ENDIF
C
C Output dot
C
            CALL GRDOT0(X1 + (X2 - X1) * (I - I1 + 0.5) / (I2 - I1 + 1),
     1                  Y1 + (Y2 - Y1) * (J - J1 + 0.5) / (J2 - J1 + 1))
  10     CONTINUE
  20  CONTINUE
C
C Restore attributes
C
      CALL GRSCI(ICOL)
      CALL GRSLW(LW)
      END
#<

#>            grpxps.dc3
Name:         GRPXPS

Purpose:      pixel dump for color or grey PostScript.

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRPXPS (IA, IDIM, JDIM, I1, I2, J1, J2,
           :                   XMIN, XMAX, YMIN, YMAX)
            INTEGER IDIM, JDIM, I1, I2, J1, J2
            INTEGER IA(IDIM,JDIM)
            REAL XMIN, XMAX, YMIN, YMAX
      
       This routine is called by GRPIXL.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grpxps.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRPXPS -- pixel dump for color or grey PostScript.
C+
      SUBROUTINE GRPXPS (IA, IDIM, JDIM, I1, I2, J1, J2,
     :                   XMIN, XMAX, YMIN, YMAX)
      INTEGER IDIM, JDIM, I1, I2, J1, J2
      INTEGER IA(IDIM,JDIM)
      REAL XMIN, XMAX, YMIN, YMAX
C
C This routine is called by GRPIXL.
C--
C  4-Apr-93 - Created from GRGRAY by Remko Scharroo - DUT/SSRT
C  8-Apr-93 - Bugs fixed.
C  6-Jul-94 - Aligned with PGPLOT V4.9H
C  7-Sep-94 - updated for V5.0 [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER  I, J, NXP, NYP, NBUF, LCHR, II
      REAL     DX,DY,RBUF(32)
      CHARACTER*32 CHR
C-----------------------------------------------------------------------
      NXP = I2 - I1 + 1
      NYP = J2 - J1 + 1
C
C Build an image transformation matrix.
C
      DX = (XMAX-XMIN)/NXP
      DY = (YMAX-YMIN)/NYP
      RBUF(1) = 0
      RBUF(2) = NXP
      RBUF(3) = NYP
      RBUF(4) = GRXMIN(GRCIDE)
      RBUF(5) = GRXMAX(GRCIDE)
      RBUF(6) = GRYMIN(GRCIDE)
      RBUF(7) = GRYMAX(GRCIDE)
      RBUF(8) = 1.0/DX
      RBUF(9) = 0.0
      RBUF(10) = 0.0
      RBUF(11) = 1.0/DY
      RBUF(12) = (-XMIN)/DX
      RBUF(13) = (-YMIN)/DY
C
C Send setup info to driver.
C
      IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC
      CALL GRTERM
      NBUF = 13
      LCHR = 0
      CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR)
C
C Send the array of color indices to the driver.
C
      II = 0
      DO 20 J=J1,J2
         DO 10 I=I1,I2
            II = II + 1
            RBUF(II+1) = IA(I,J)
            IF (II.EQ.20) THEN
               NBUF = II+1
               RBUF(1) = II
               CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR)
               II = 0
            END IF
 10      CONTINUE
 20   CONTINUE
      IF (II.GT.0) THEN
         NBUF = II+1
         RBUF(1) = II
         CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR)
         II = 0
      END IF
C
C Send termination code to driver.
C
      NBUF = 1
      RBUF(1) = -1
      CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR)
C-----------------------------------------------------------------------
      END
#<

#>            grpxpx.dc3
Name:         GRPXPX

Purpose:      Perform pixel operations using pixel primitive

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRPXPX (IA, IDIM, JDIM, I1, I2, J1, J2, X, Y)
            INTEGER IDIM, JDIM, I1, I2, J1, J2
            INTEGER IA(IDIM,JDIM)
            REAL    X, Y
      
       Arguments:
        IA     (input)  : the array to be plotted.
        IDIM   (input)  : the first dimension of array A.
        JDIM   (input)  : the second dimension of array A.
        I1, I2 (input)  : the inclusive range of the first index
                          (I) to be plotted.
        J1, J2 (input)  : the inclusive range of the second
                          index (J) to be plotted.
        X, Y   (input)  : the lower left corner of the output region
                          (device coordinates)

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grpxpx.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRPXPX -- Perform pixel operations using pixel primitive
C+
      SUBROUTINE GRPXPX (IA, IDIM, JDIM, I1, I2, J1, J2, X, Y)
      INTEGER IDIM, JDIM, I1, I2, J1, J2
      INTEGER IA(IDIM,JDIM)
      REAL    X, Y
C
C Arguments:
C  IA     (input)  : the array to be plotted.
C  IDIM   (input)  : the first dimension of array A.
C  JDIM   (input)  : the second dimension of array A.
C  I1, I2 (input)  : the inclusive range of the first index
C                    (I) to be plotted.
C  J1, J2 (input)  : the inclusive range of the second
C                    index (J) to be plotted.
C  X, Y   (input)  : the lower left corner of the output region
C                    (device coordinates)
C--
C 16-Jan-1991 - [GvG]
*  4-Aug-1993 - Debugged by Remko Scharroo
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER     NSIZE
      PARAMETER   (NSIZE = 1280)
      REAL        RBUF(NSIZE + 2)
      REAL        WIDTH
      INTEGER     IC1, IC2
      INTEGER     I, J, L
      INTEGER     NBUF, LCHR
      CHARACTER*1 CHR

      IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC
C
C Get allowable color range and pixel width
C
      CALL GRQCOL(IC1, IC2)
      CALL GREXEC(GRGTYP, 3, RBUF, NBUF, CHR, LCHR)
      WIDTH = RBUF(3)
      DO 30 J = J1, J2
C
C Compute Y coordinate for this line
C
         RBUF(2) = Y + (J - J1) * WIDTH
         I = I1
  10        L = 1
C
C Compute left X coordinate for this line segment
C
            RBUF(1) = X + (I - I1) * WIDTH
C
C Check color index
C
  20           IF (IA(I, J) .LT. IC1 .OR. IC2 .LT. IA(I, J)) THEN
                  RBUF(L + 2) = 1
               ELSE
                  RBUF(L + 2) = IA(I, J)
               ENDIF
               L = L + 1
               I = I + 1
C
C Still room in segment and something left?
C
            IF (L .LE. NSIZE .AND. I .LE. I2) GOTO 20
C
C Output segment
C
*           NBUF = L + 2 ! wrong ! should be: (RS)
            NBUF = L + 1
            CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR)
C
C Something left?
C
         IF (I .LE. I2) GOTO 10
  30  CONTINUE

      END
#<

#>            grpxre.dc3
Name:         GRPXRE

Purpose:      Emulate pixel operations using rectangles

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRPXRE (IA, IDIM, JDIM, I1, I2, J1, J2, 
           1                   X1, X2, Y1, Y2)
            INTEGER IDIM, JDIM, I1, I2, J1, J2
            INTEGER IA(IDIM,JDIM)
            REAL    X1, X2, Y1, Y2
      
       Arguments:
        IA     (input)  : the array to be plotted.
        IDIM   (input)  : the first dimension of array A.
        JDIM   (input)  : the second dimension of array A.
        I1, I2 (input)  : the inclusive range of the first index
                          (I) to be plotted.
        J1, J2 (input)  : the inclusive range of the second
                          index (J) to be plotted.
        X1, X2 (input)  : the horizontal range of the output region
        Y1, Y2 (input)  : the vertical range of the output region

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grpxre.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRPXRE -- Emulate pixel operations using rectangles
C+
      SUBROUTINE GRPXRE (IA, IDIM, JDIM, I1, I2, J1, J2, 
     1                   X1, X2, Y1, Y2)
      INTEGER IDIM, JDIM, I1, I2, J1, J2
      INTEGER IA(IDIM,JDIM)
      REAL    X1, X2, Y1, Y2
C
C Arguments:
C  IA     (input)  : the array to be plotted.
C  IDIM   (input)  : the first dimension of array A.
C  JDIM   (input)  : the second dimension of array A.
C  I1, I2 (input)  : the inclusive range of the first index
C                    (I) to be plotted.
C  J1, J2 (input)  : the inclusive range of the second
C                    index (J) to be plotted.
C  X1, X2 (input)  : the horizontal range of the output region
C  Y1, Y2 (input)  : the vertical range of the output region
C--
C 18-Jan-1991 - [GvG]
C-----------------------------------------------------------------------
      REAL YB, YT
      INTEGER I, J, ICOL, LSTCOL
C
C Save color attribute
C
      CALL GRQCI(ICOL)
      LSTCOL = ICOL
      DO 20 J = J1, J2
C
C Compute Y range for this index
C
         YB = Y1 + ((Y2 - Y1) * (J - J1)) / (J2 - J1 + 1)
         YT = Y1 + ((Y2 - Y1) * (J - J1 + 1)) / (J2 - J1 + 1)
         DO 10 I = I1, I2
C
C Need to change color?
C
            IF (IA(I, J) .NE. LSTCOL) THEN
               CALL GRSCI(IA(I, J))
               LSTCOL = IA(I, J)
            ENDIF
C
C Output rectangle
C
            CALL GRREC0(X1 + ((X2 - X1) * (I - I1)) / (I2 - I1 + 1), YB,
     1                  X1 + ((X2 - X1) * (I - I1 + 1)) / (I2 - I1 + 1),
     2                  YT)

  10     CONTINUE
  20  CONTINUE
C
C Restore color attribute
C
      CALL GRSCI(ICOL)
      END
#<

#>            grqbci.dc3
Subroutine:   GRQBCI

Purpose:      Query color index for displaying BLANKs by PGIMAG.

Category:     GRAPHICS

File:         pgplot.src

Author:       J.P. Terlouw

Use:          CALL GRQBCI(CI)

Updates:      Sep 30, 1999: JPT Document created.
#<

#>            grqbci.f
* GIPSY-private
*

      SUBROUTINE GRQBCI (IC)
      INCLUDE 'grpckg1.inc'
C 
C Error if no workstation is open.
C 
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRQBCI - no graphics device is active.')
          IC = 0
      ELSE
          IC = GRBLCI(GRCIDE)
      END IF
      END
#<

#>            grqcap.dc3
Name:         GRQCAP

Purpose:      inquire device capabilities

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRQCAP (STRING)
            CHARACTER*(*) STRING
      
       GRPCKG: obtain the "device capabilities" string from the device
       driver for the current device.
      
       Arguments:
      
       STRING (output, CHARACTER*(*)): receives the device capabilities
             string.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grqcap.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRQCAP -- inquire device capabilities
C+
      SUBROUTINE GRQCAP (STRING)
      CHARACTER*(*) STRING
C
C GRPCKG: obtain the "device capabilities" string from the device
C driver for the current device.
C
C Arguments:
C
C STRING (output, CHARACTER*(*)): receives the device capabilities
C       string.
C--
C 26-Nov-92: new routine [TJP].
C  1-Sep-94: get from common instead of driver [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
C
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRQCAP - no graphics device is active.')
          STRING = 'NNNNNNNNNN'
      ELSE
          STRING = GRGCAP(GRCIDE)
      END IF
C
      END
#<

#>            grqci.dc3
Name:         GRQCI

Purpose:      inquire current color index

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRQCI (C)
      
       GRPCKG: obtain the color index of the current graphics device.
      
       Argument:
      
       C (integer, output): receives the current color index (0-255).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grqci.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRQCI -- inquire current color index
C+
      SUBROUTINE GRQCI (C)
C
C GRPCKG: obtain the color index of the current graphics device.
C
C Argument:
C
C C (integer, output): receives the current color index (0-255).
C--
C (1-Feb-1983)
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER  C
C
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRQCI - no graphics device is active.')
          C = 1
      ELSE
          C = GRCCOL(GRCIDE)
      END IF
      END
#<

#>            grqcol.dc3
Name:         GRQCOL

Purpose:      inquire color capability

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRQCOL (CI1, CI2)
            INTEGER  CI1, CI2
      
       Query the range of color indices available on the current device.
      
       Argument:
        CI1    (output) : the minimum available color index. This will be
                          either 0 if the device can write in the
                          background color, or 1 if not.
        CI2    (output) : the maximum available color index. This will be
                          1 if the device has no color capability, or a
                          larger number (e.g., 3, 7, 15, 255).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grqcol.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRQCOL -- inquire color capability
C+
      SUBROUTINE GRQCOL (CI1, CI2)
      INTEGER  CI1, CI2
C
C Query the range of color indices available on the current device.
C
C Argument:
C  CI1    (output) : the minimum available color index. This will be
C                    either 0 if the device can write in the
C                    background color, or 1 if not.
C  CI2    (output) : the maximum available color index. This will be
C                    1 if the device has no color capability, or a
C                    larger number (e.g., 3, 7, 15, 255).
C--
C 31-May-1989 - new routine [TJP].
C  1-Sep-1994 - avoid driver call [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
C
C Error if no workstation is open.
C
      IF (GRCIDE.LT.1) THEN
          CI1 = 0
          CI2 = 0
      ELSE
          CI1 = GRMNCI(GRCIDE)
          CI2 = GRMXCI(GRCIDE)
      END IF
C
      END
#<

#>            grqcr.dc3
Name:         GRQCR

Purpose:      inquire color representation

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRQCR (CI, CR, CG, CB)
            INTEGER  CI
            REAL     CR, CG, CB
      
       Return the color representation (red, green, blue intensities) 
       currently associated with the specified color index. This may be
       different from that requested on some devices.
      
       Arguments:
      
       CI (integer, input): color index.
       CR, CG, CB (real, output): red, green, and blue intensities,
             in range 0.0 to 1.0.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grqcr.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRQCR -- inquire color representation
C+
      SUBROUTINE GRQCR (CI, CR, CG, CB)
      INTEGER  CI
      REAL     CR, CG, CB
C
C Return the color representation (red, green, blue intensities) 
C currently associated with the specified color index. This may be
C different from that requested on some devices.
C
C Arguments:
C
C CI (integer, input): color index.
C CR, CG, CB (real, output): red, green, and blue intensities,
C       in range 0.0 to 1.0.
C--
C  7-Sep-1994 - rewrite [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER   NBUF, LCHR, K
      REAL      RBUF(6)
      CHARACTER CHR
C
      CR = 1.0
      CG = 1.0
      CB = 1.0
      K  = CI
      IF (GRCIDE.LT.1) THEN
C         -- no device open: return white
          CALL GRWARN('GRQCR: no plot device is open.')
      ELSE IF (GRGCAP(GRCIDE)(9:9).NE.'Y') THEN
C         -- devices that don't allow query color representation:
C            return black for ci 0, white for all others
          IF (K.EQ.0) THEN
             CR = 0.0
             CG = 0.0
             CB = 0.0
          END IF
      ELSE
C         -- query device driver; treat invalid ci as 1
          IF (K.LT.GRMNCI(GRCIDE) .OR. CI.GT.GRMXCI(GRCIDE)) THEN
             CALL GRWARN('GRQCR: invalid color index.')
             K = 1
          END IF
          RBUF(1) = K
          NBUF = 1
          LCHR = 0
          CALL GREXEC(GRGTYP,29,RBUF,NBUF,CHR,LCHR)
          IF (NBUF.LT.4) THEN
             CALL GRWARN('GRSCR: device driver error')
          ELSE
              CR = RBUF(2)
              CG = RBUF(3)
              CB = RBUF(4)
          END IF
      END IF
C
      END
#<

#>            grqdev.dc3
Name:         GRQDEV

Purpose:      inquire current device

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRQDEV (DEVICE, L)
            CHARACTER*(*) DEVICE
            INTEGER L
      
       Obtain the name of the current graphics device or file.
      
       Argument:
        DEVICE (output): receives the device name of the
             currently active device.
        L (output): number of characters in DEVICE, excluding trailing
             blanks.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grqdev.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRQDEV -- inquire current device
C+
      SUBROUTINE GRQDEV (DEVICE, L)
      CHARACTER*(*) DEVICE
      INTEGER L
C
C Obtain the name of the current graphics device or file.
C
C Argument:
C  DEVICE (output): receives the device name of the
C       currently active device.
C  L (output): number of characters in DEVICE, excluding trailing
C       blanks.
C--
C 19-Feb-1988
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
C
      IF (GRCIDE.LT.1) THEN
          DEVICE = '?'
          L = 1
      ELSE
          DEVICE = GRFILE(GRCIDE)
          L = GRFNLN(GRCIDE)
          IF (L.GT.LEN(DEVICE)) L = LEN(DEVICE)
      END IF
      END
#<

#>            grqdt.dc3
Name:         GRQDT

Purpose:      inquire current device and type

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRQDT (DEVICE)
      
       GRPCKG: obtain the name and type of the current graphics device.
      
       Argument:
      
       DEVICE (output, character): receives the device name and type of the
             currently active device in the form 'device/type'; this is a
             valid string for input to GROPEN.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grqdt.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRQDT -- inquire current device and type
C+
      SUBROUTINE GRQDT (DEVICE)
C
C GRPCKG: obtain the name and type of the current graphics device.
C
C Argument:
C
C DEVICE (output, character): receives the device name and type of the
C       currently active device in the form 'device/type'; this is a
C       valid string for input to GROPEN.
C--
C  1-Feb-1983
C 19-Feb-1988 - add quotes if necessary.
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      CHARACTER*(*) DEVICE
      CHARACTER*14 TYPE
      LOGICAL   JUNK
      INTEGER   L
C
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRQDT - no graphics device is active.')
          DEVICE = '/NULL'
      ELSE
          CALL GRQTYP(TYPE,JUNK)
          L = GRFNLN(GRCIDE)
          IF (L.LE.0) THEN
              DEVICE = '/'//TYPE
          ELSE IF (INDEX(GRFILE(GRCIDE)(1:L), '/').EQ.0) THEN
              DEVICE = GRFILE(GRCIDE)(1:L)//'/'//TYPE
          ELSE
              DEVICE = '"'//GRFILE(GRCIDE)(1:L)//'"/'//TYPE
          END IF
      END IF
      END
#<

#>            grqfnt.dc3
Name:         GRQFNT

Purpose:      inquire current font

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRQFNT (IF)
      
       GRPCKG: obtain the font number of the current graphics device.
      
       Argument:
      
       IF (integer, output): receives the current font number (1-3).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grqfnt.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRQFNT -- inquire current font
C+
      SUBROUTINE GRQFNT (IF)
C
C GRPCKG: obtain the font number of the current graphics device.
C
C Argument:
C
C IF (integer, output): receives the current font number (1-3).
C--
C (19-Mar-1983)
C 15-Dec-1988 - change name [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER  IF
C
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRQFNT - no graphics device is active.')
          IF = 1
      ELSE
          IF = GRCFNT(GRCIDE)
      END IF
      END
#<

#>            grqls.dc3
Name:         GRQLS

Purpose:      inquire current line-style

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRQLS (ISTYLE)
            INTEGER  ISTYLE
      
       GRPCKG: obtain the line-style of the current graphics device.
      
       Argument:
        ISTYLE (output): receives the current line-style code.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grqls.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRQLS -- inquire current line-style
C+
      SUBROUTINE GRQLS (ISTYLE)
      INTEGER  ISTYLE
C
C GRPCKG: obtain the line-style of the current graphics device.
C
C Argument:
C  ISTYLE (output): receives the current line-style code.
C--
C (1-Feb-1983)
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
C
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRQLS - no graphics device is active.')
          ISTYLE = 1
      ELSE
          ISTYLE = GRSTYL(GRCIDE)
      END IF
      END
#<

#>            grqlw.dc3
Name:         GRQLW

Purpose:      inquire current line width

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRQLW (IWIDTH)
            INTEGER  IWIDTH
      
       GRPCKG: obtain the line-width of the current graphics device.
      
       Argument:
        IWIDTH (output): receives the current line-width.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grqlw.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRQLW -- inquire current line width
C+
      SUBROUTINE GRQLW (IWIDTH)
      INTEGER  IWIDTH
C
C GRPCKG: obtain the line-width of the current graphics device.
C
C Argument:
C  IWIDTH (output): receives the current line-width.
C--
C (1-Feb-1983)
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
C
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRQLW - no graphics device is active.')
          IWIDTH = 1
      ELSE
          IWIDTH = ABS(GRWIDT(GRCIDE))
      END IF
      END
#<

#>            grqpos.dc3
Name:         GRQPOS

Purpose:      return current pen position (absolute, world coordinates)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRQPOS(X,Y)
      
       GRQPOS: returns the current pen position in absolute, world
       coordinates.
      
       Arguments:
      
       X, Y (real, output): world coordinates of the pen position.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grqpos.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRQPOS -- return current pen position (absolute, world coordinates)
C+
      SUBROUTINE GRQPOS(X,Y)
C
C GRQPOS: returns the current pen position in absolute, world
C coordinates.
C
C Arguments:
C
C X, Y (real, output): world coordinates of the pen position.
C--
C  1-Mar-1991 - new routine  [JM].
C-----------------------------------------------------------------------
      REAL     X,Y
      INCLUDE 'grpckg1.inc'
C
      IF (GRCIDE.GE.1) THEN
          X = (GRXPRE(GRCIDE) - GRXORG(GRCIDE)) / GRXSCL(GRCIDE)
          Y = (GRYPRE(GRCIDE) - GRYORG(GRCIDE)) / GRYSCL(GRCIDE)
      END IF
      END
#<

#>            grqtxt.dc3
Name:         GRQTXT

Purpose:      get text bounding box

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRQTXT (ORIENT,X0,Y0,STRING, XBOX, YBOX)
      
       GRPCKG: get the bounding box of a string drawn by GRTEXT.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grqtxt.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRQTXT -- get text bounding box
C+
      SUBROUTINE GRQTXT (ORIENT,X0,Y0,STRING, XBOX, YBOX)
C
C GRPCKG: get the bounding box of a string drawn by GRTEXT.
C--
C 12-Sep-1993 - [TJP].
C  8-Nov-1994 - return something even if string is blank [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      LOGICAL UNUSED, VISBLE, PLOT
      INTEGER XYGRID(300)
      INTEGER LIST(256)
      CHARACTER*(*) STRING
      REAL XBOX(4), YBOX(4)
      REAL ANGLE, FACTOR, FNTBAS, FNTFAC, COSA, SINA, DX, DY, XORG, YORG
      REAL ORIENT, RATIO, X0, Y0, RLX, RLY
      REAL XG, YG, XGMIN, XGMAX, YGMIN, YGMAX
      INTEGER I, IFNTLV,NLIST,LX,LY, K, LXLAST,LYLAST
      INTRINSIC ABS, COS, LEN, MAX, MIN, SIN
C
C Default return values.
C
      DO 10 I=1,4
         XBOX(I) = X0
         YBOX(I) = Y0
 10   CONTINUE
C
C Check that there is something to be plotted.
C
      IF (LEN(STRING).LE.0) RETURN
C
C Check that a device is selected.
C
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRQTXT - no graphics device is active.')
          RETURN
      END IF
C
      XORG = GRXPRE(GRCIDE)
      YORG = GRYPRE(GRCIDE)
C
C Compute scaling and orientation.
C
      ANGLE = ORIENT*(3.14159265359/180.)
      FACTOR = GRCFAC(GRCIDE)/2.5
      RATIO = GRPXPI(GRCIDE)/GRPYPI(GRCIDE)
      COSA = FACTOR * COS(ANGLE)
      SINA = FACTOR * SIN(ANGLE)
      XORG = X0
      YORG = Y0
C
C Convert the string to a list of symbol numbers; to prevent overflow
C of array LIST, the length of STRING is limited to 256 characters.
C
      CALL GRSYDS(LIST,NLIST,STRING(1:MIN(256,LEN(STRING))),
     1             GRCFNT(GRCIDE))
C
C Run through the string of characters, getting bounding box
C in character coordinates. (XG, YG) is the starting point
C of the current character. The x/y limits of the bbox are
C XGMIN...XGMAX, YGMIN...YGMAX.
C
      FNTBAS = 0.0
      FNTFAC = 1.0
      IFNTLV = 0
      DX = 0.0
      DY = 0.0
      XG = 0.0
      YG = 0.0
      XGMIN = 1E30
      XGMAX = -1E30
      YGMIN = 1E30
      YGMAX = -1E30
      PLOT  = .FALSE.
      DO 380 I=1,NLIST
          IF (LIST(I).LT.0) THEN
              IF (LIST(I).EQ.-1) THEN
C                 ! up
                  IFNTLV = IFNTLV+1
                  FNTBAS = FNTBAS + 16.0*FNTFAC
                  FNTFAC = 0.75**ABS(IFNTLV)
              ELSE IF (LIST(I).EQ.-2) THEN
C                 ! down
                  IFNTLV = IFNTLV-1
                  FNTFAC = 0.75**ABS(IFNTLV)
                  FNTBAS = FNTBAS - 16.0*FNTFAC
              ELSE IF (LIST(I).EQ.-3) THEN
C                 ! backspace
                  XG = XG - DX*FNTFAC
              END IF
              GOTO 380
          END IF
          CALL GRSYXD(LIST(I),XYGRID,UNUSED)
          VISBLE = .FALSE.
          DX = XYGRID(5)-XYGRID(4)
          K = 4
          LXLAST = -64
          LYLAST = -64
  320     K = K+2
          LX = XYGRID(K)
          LY = XYGRID(K+1)
          IF (LY.EQ.-64) GOTO 330
          IF (LX.EQ.-64) THEN
              VISBLE = .FALSE.
          ELSE
              RLX = (LX - XYGRID(4))*FNTFAC
              RLY = (LY - XYGRID(2))*FNTFAC + FNTBAS
              IF ((LX.NE.LXLAST) .OR. (LY.NE.LYLAST)) THEN
                  XGMIN = MIN(XGMIN,XG+RLX)
                  XGMAX = MAX(XGMAX,XG+RLX)
                  YGMIN = MIN(YGMIN,RLY)
                  YGMAX = MAX(YGMAX,RLY)
                  PLOT = .TRUE.
              END IF
              VISBLE = .TRUE.
              LXLAST = LX
              LYLAST = LY
          END IF
          GOTO 320
  330     XG = XG + DX*FNTFAC
  380 CONTINUE
C
C Check whether anything was plotted.
C
      IF (.NOT.PLOT) RETURN
C
C Expand the box a bit to allow for line-width.
C
      XGMIN = XGMIN - 5.0
      XGMAX = XGMAX + 5.0
      YGMIN = YGMIN - 4.0
      YGMAX = YGMAX + 4.0
C
C Convert bounding box to device coordinates.
C
C     WRITE (*,*) XGMIN, XGMAX, YGMIN, YGMAX
      XBOX(1) = XORG + (COSA*XGMIN - SINA*YGMIN)*RATIO
      YBOX(1) = YORG + (SINA*XGMIN + COSA*YGMIN)
      XBOX(2) = XORG + (COSA*XGMIN - SINA*YGMAX)*RATIO
      YBOX(2) = YORG + (SINA*XGMIN + COSA*YGMAX)
      XBOX(3) = XORG + (COSA*XGMAX - SINA*YGMAX)*RATIO
      YBOX(3) = YORG + (SINA*XGMAX + COSA*YGMAX)
      XBOX(4) = XORG + (COSA*XGMAX - SINA*YGMIN)*RATIO
      YBOX(4) = YORG + (SINA*XGMAX + COSA*YGMIN)
C
      END
#<

#>            grqtyp.dc3
Name:         GRQTYP

Purpose:      inquire current device type

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRQTYP (TYPE,INTER)
            CHARACTER*(*) TYPE
            LOGICAL INTER
      
       GRPCKG: obtain the device type of the currently selected graphics
       device, and determine whether or not it is an interactive device.
      
       Arguments:
      
       TYPE (output, CHARACTER*(*)): receives the device type, as a
             character string, eg 'PRINTRONIX', 'TRILOG', 'VERSATEC',
             'TEK4010', 'TEK4014', 'GRINNELL', or 'VT125'.  The character
             string should have a length of at least 8 to ensure that the
             type is unique.
       INTER (output, LOGICAL): receives the value .TRUE. if the device is
             interactive, .FALSE. otherwise.

Updates:      Oct 16, 1998: JPT document extracted from 5.2.0 source;
                                Fortran source copied from GIPSY's v4.9E.
#<

#>            grqtyp.f
* GIPSY-modified
*

C*GRQTYP -- inquire current device type
C+
      SUBROUTINE GRQTYP (TYPE,INTER)
      CHARACTER*(*) TYPE
      LOGICAL INTER
C
C GRPCKG: obtain the device type of the currently selected graphics
C device, and determine whether or not it is an interactive device.
C
C Arguments:
C
C TYPE (output, CHARACTER*(*)): receives the device type, as a
C       character string, eg 'PRINTRONIX', 'TRILOG', 'VERSATEC',
C       'TEK4010', 'TEK4014', 'GRINNELL', or 'VT125'.  The character
C       string should have a length of at least 8 to ensure that the
C       type is unique.
C INTER (output, LOGICAL*4): receives the value .TRUE. if the device is
C       interactive, .FALSE. otherwise.  Interactive devices are
C       terminals and Grinnells, which are capable of graphical input;
C       non-interactive devices include the printers, metafiles, and
C       the null device.
C--
C (23-May-1983)
C  5-Aug-1986 - add GREXEC support [AFT].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      REAL    RBUF(6)
      INTEGER NBUF,LCHR
      CHARACTER*10 CHR
C
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRQTYP - no graphics device is active.')
          TYPE = 'NULL'
          INTER = .FALSE.
      ELSE
CWZ       CALL GREXEC(GRGTYP, 1,RBUF,NBUF,TYPE,LCHR)
          CALL GREXEC(GRGTYP,-1,RBUF,NBUF,TYPE,LCHR)
          CALL GREXEC(GRGTYP, 4,RBUF,NBUF,CHR,LCHR)
          INTER = (CHR(1:1).EQ.'I')
      END IF
C
      END
#<

#>            grqtyp.f.orig
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRQTYP -- inquire current device type
C+
      SUBROUTINE GRQTYP (TYPE,INTER)
      CHARACTER*(*) TYPE
      LOGICAL INTER
C
C GRPCKG: obtain the device type of the currently selected graphics
C device, and determine whether or not it is an interactive device.
C
C Arguments:
C
C TYPE (output, CHARACTER*(*)): receives the device type, as a
C       character string, eg 'PRINTRONIX', 'TRILOG', 'VERSATEC',
C       'TEK4010', 'TEK4014', 'GRINNELL', or 'VT125'.  The character
C       string should have a length of at least 8 to ensure that the
C       type is unique.
C INTER (output, LOGICAL): receives the value .TRUE. if the device is
C       interactive, .FALSE. otherwise.
C--
C (23-May-1983)
C  5-Aug-1986 - add GREXEC support [AFT].
C 18-Jan-1993 - return type only, not description [TJP].
C  1-Sep-1994 - get capabilities from common [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      REAL    RBUF(6)
      INTEGER NBUF,LCHR
      CHARACTER*32 CHR
C
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRQTYP - no graphics device is active.')
          TYPE = 'NULL'
          INTER = .FALSE.
      ELSE
          CALL GREXEC(GRGTYP, 1,RBUF,NBUF,CHR,LCHR)
          LCHR = INDEX(CHR,' ')
          TYPE = CHR(:LCHR)
          INTER = (GRGCAP(GRCIDE)(1:1).EQ.'I')
      END IF
C
      END
#<

#>            grquit.dc3
Name:         GRQUIT

Purpose:      report a fatal error and abort execution

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRQUIT (TEXT)
            CHARACTER*(*) TEXT
      
       Report a fatal error (via GRWARN) and exit program.
       This routine should be called in the event of an unrecoverable 
       PGPLOT error.
      
       Argument:
        TEXT (input): text of message to be sent to GRWARN.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grquit.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRQUIT -- report a fatal error and abort execution
C+
      SUBROUTINE GRQUIT (TEXT)
      CHARACTER*(*) TEXT
C
C Report a fatal error (via GRWARN) and exit program.
C This routine should be called in the event of an unrecoverable 
C PGPLOT error.
C
C Argument:
C  TEXT (input): text of message to be sent to GRWARN.
C--
C 12-Nov-1994
C-----------------------------------------------------------------------
C
      CALL GRWARN(TEXT)
      CALL GRWARN('Fatal error in PGPLOT library: program terminating.')
      STOP 
      END
#<

#>            grrec0.dc3
Name:         GRREC0

Purpose:      fill a rectangle (device coordinates)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRREC0 (X0,Y0,X1,Y1)
            REAL X0, Y0, X1, Y1
      
       GRPCKG: Fill a rectangle with solid color.  The rectangle
       is defined by the (x,y) device coordinates of its lower left and
       upper right corners; the edges are parallel to the coordinate axes.
       X0 is guaranteed to be <= X1 and Y0 <= Y1. The rectangle possible
       extends beyond the clipping boundaries
      
       Arguments:
      
       X0, Y0 (input, real): device coordinates of one corner of the 
             rectangle.
       X1, Y1 (input, real): device coordinates of the opposite corner of 
             the rectangle.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grrec0.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRREC0 -- fill a rectangle (device coordinates)
C+
      SUBROUTINE GRREC0 (X0,Y0,X1,Y1)
      REAL X0, Y0, X1, Y1
C
C GRPCKG: Fill a rectangle with solid color.  The rectangle
C is defined by the (x,y) device coordinates of its lower left and
C upper right corners; the edges are parallel to the coordinate axes.
C X0 is guaranteed to be <= X1 and Y0 <= Y1. The rectangle possible
C extends beyond the clipping boundaries
C
C Arguments:
C
C X0, Y0 (input, real): device coordinates of one corner of the 
C       rectangle.
C X1, Y1 (input, real): device coordinates of the opposite corner of 
C       the rectangle.
C--
C 23-Mar-1988 - [TJP].
C 18-Jan-1991 - Code moved from GRRECT to GRREC0 so that it can also be
C               used by GRPXRE.
C  1-Sep-1994 - suppress driver call [TJP].
C  4-Dec-1995 - avoid use of real variable as do-loop index [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      REAL    RBUF(6)
      INTEGER NBUF,LCHR
      CHARACTER*32 CHR
      REAL    XMIN, YMIN, XMAX, YMAX, Y, DY
      INTEGER LS, LW, I, NLINES
C
C Clip
C
      XMIN = X0
      XMAX = X1
      YMIN = Y0
      YMAX = Y1
      IF (XMIN .LT. GRXMIN(GRCIDE)) XMIN = GRXMIN(GRCIDE)
      IF (XMAX .GT. GRXMAX(GRCIDE)) XMAX = GRXMAX(GRCIDE)
      IF (YMIN .LT. GRYMIN(GRCIDE)) YMIN = GRYMIN(GRCIDE)
      IF (YMAX .GT. GRYMAX(GRCIDE)) YMAX = GRYMAX(GRCIDE)
      IF (XMIN .GT. XMAX) RETURN
      IF (YMIN .GT. YMAX) RETURN
C
C Use hardware rectangle fill if available.
C
      IF (GRGCAP(GRCIDE)(6:6).EQ.'R') THEN
          IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC
          RBUF(1) = XMIN
          RBUF(2) = YMIN
          RBUF(3) = XMAX
          RBUF(4) = YMAX
          CALL GREXEC(GRGTYP,24,RBUF,NBUF,CHR,LCHR)
          RETURN
C
C Else use hardware polygon fill if available.
C
      ELSE IF (GRGCAP(GRCIDE)(4:4).EQ.'A') THEN
          IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC
          RBUF(1) = 4
          CALL GREXEC(GRGTYP,20,RBUF,NBUF,CHR,LCHR)
          RBUF(1) = XMIN
          RBUF(2) = YMIN
          CALL GREXEC(GRGTYP,20,RBUF,NBUF,CHR,LCHR)
          RBUF(1) = XMAX
          RBUF(2) = YMIN
          CALL GREXEC(GRGTYP,20,RBUF,NBUF,CHR,LCHR)
          RBUF(1) = XMAX
          RBUF(2) = YMAX
          CALL GREXEC(GRGTYP,20,RBUF,NBUF,CHR,LCHR)
          RBUF(1) = XMIN
          RBUF(2) = YMAX
          CALL GREXEC(GRGTYP,20,RBUF,NBUF,CHR,LCHR)
          RETURN
      END IF
C
C For other devices fill area is simulated.
C
C Save attributes.
C
      CALL GRQLS(LS)
      CALL GRQLW(LW)
      CALL GRSLS(1)
      CALL GRSLW(1)
      CALL GREXEC(GRGTYP, 3,RBUF,NBUF,CHR,LCHR)
      DY = RBUF(3)
C
C Draw horizontal raster lines.
C
      NLINES = ABS((YMAX-YMIN)/DY)
      Y = YMIN - DY/2.0
      DO 40 I=1,NLINES
         Y = Y + DY
         GRXPRE(GRCIDE) = XMIN
         GRYPRE(GRCIDE) = Y
         CALL GRLIN0(XMAX,Y)
   40 CONTINUE
C
C Restore attributes.
C
      CALL GRSLS(LS)
      CALL GRSLW(LW)
      END
#<

#>            grrect.dc3
Name:         GRRECT

Purpose:      fill a rectangle

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRRECT (X0,Y0,X1,Y1)
            REAL X0, Y0, X1, Y1
      
       GRPCKG: Fill a rectangle with solid color.  The rectangle
       is defined by the (x,y) world coordinates of its lower left and upper 
       right corners; the edges are parallel to the coordinate axes.
      
       Arguments:
      
       X0, Y0 (input, real): world coordinates of one corner of the 
             rectangle.
       X1, Y1 (input, real): world coordinates of the opposite corner of the 
             rectangle.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grrect.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRRECT -- fill a rectangle
C+
      SUBROUTINE GRRECT (X0,Y0,X1,Y1)
      REAL X0, Y0, X1, Y1
C
C GRPCKG: Fill a rectangle with solid color.  The rectangle
C is defined by the (x,y) world coordinates of its lower left and upper 
C right corners; the edges are parallel to the coordinate axes.
C
C Arguments:
C
C X0, Y0 (input, real): world coordinates of one corner of the 
C       rectangle.
C X1, Y1 (input, real): world coordinates of the opposite corner of the 
C       rectangle.
C--
C 23-Mar-1988 - [TJP].
C 18-Jan-1991 - Code moved from GRRECT to GRREC0 so that it can also be
C               used by GRPXRE
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      REAL    XLL, YLL, XUR, YUR
      REAL    XMIN, YMIN, XMAX, YMAX
C
      IF (GRCIDE.LT.1) RETURN
C
C Convert to device coordinates and clip.
C
      CALL GRTXY0(.FALSE.,X0,Y0,XLL,YLL)
      CALL GRTXY0(.FALSE.,X1,Y1,XUR,YUR)
      XMIN = MIN(XLL,XUR)
      XMAX = MAX(XLL,XUR)
      YMIN = MIN(YLL,YUR)
      YMAX = MAX(YLL,YUR)
C
C Do the real work
C
      CALL GRREC0(XMIN,YMIN,XMAX,YMAX)
      END
#<

#>            grsbci.dc3
Subroutine:   GRSBCI

Purpose:      Specify color index for displaying BLANKs by PGIMAG.

Category:     GRAPHICS

File:         pgplot.src

Author:       J.P. Terlouw

Use:          CALL GRSBCI(CI)

Updates:      Sep 30, 1999: JPT Document created.
#<

#>            grsbci.f
* GIPSY-private
*

      SUBROUTINE GRSBCI (IC)
      INCLUDE 'grpckg1.inc'
      INTEGER COLOR
C 
C Error if no workstation is open.
C 
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRSBCI - no graphics device is active.')
          RETURN
      END IF
C 
C Use color index 0 if out of range.
C       
      IC1 = GRMNCI(GRCIDE)
      IC2 = GRMXCI(GRCIDE)
      COLOR = IC
      IF (COLOR.LT.IC1 .OR. COLOR.GT.IC2) COLOR = 0
C
C Set the BLANK color index.
C
      GRBLCI(GRCIDE)=COLOR
C 
      END

#<

#>            grsci.dc3
Name:         GRSCI

Purpose:      set color index

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRSCI (IC)
      
       GRPCKG: Set the color index for subsequent plotting. Calls to GRSCI
       are ignored for monochrome devices. The default color index is 1,
       usually white on a black background for video displays or black on a
       white background for printer plots. The color index is an integer in
       the range 0 to a device-dependent maximum. Color index 0 corresponds
       to the background color; lines may be "erased" by overwriting them
       with color index 0.
      
       Color indices 0-7 are predefined as follows: 0 = black (background
       color), 1 = white (default), 2 = red, 3 = green, 4 = blue, 5 = cyan
       (blue + green), 6 = magenta (red + blue), 7 = yellow (red + green).
       The assignment of colors to color indices can be changed with
       subroutine GRSCR (set color representation).
      
       Argument:
      
       IC (integer, input): the color index to be used for subsequent
             plotting on the current device (in range 0-255). If the
             index exceeds the device-dependent maximum, the result is
             device-dependent.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grsci.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRSCI -- set color index
C+
      SUBROUTINE GRSCI (IC)
C
C GRPCKG: Set the color index for subsequent plotting. Calls to GRSCI
C are ignored for monochrome devices. The default color index is 1,
C usually white on a black background for video displays or black on a
C white background for printer plots. The color index is an integer in
C the range 0 to a device-dependent maximum. Color index 0 corresponds
C to the background color; lines may be "erased" by overwriting them
C with color index 0.
C
C Color indices 0-7 are predefined as follows: 0 = black (background
C color), 1 = white (default), 2 = red, 3 = green, 4 = blue, 5 = cyan
C (blue + green), 6 = magenta (red + blue), 7 = yellow (red + green).
C The assignment of colors to color indices can be changed with
C subroutine GRSCR (set color representation).
C
C Argument:
C
C IC (integer, input): the color index to be used for subsequent
C       plotting on the current device (in range 0-255). If the
C       index exceeds the device-dependent maximum, the result is
C       device-dependent.
C--
C 11-Apr-1983 - [TJP].
C  3-Jun-1984 - add GMFILE device [TJP].
C 13-Jun-1984 - add code for TK4100 devices [TJP].
C  2-Jul-1984 - add code for RETRO and VT125 (REGIS) devices [TJP].
C  2-Oct-1984 - change REGIS to improve VT240 behavior [TJP].
C 22-Dec-1984 - add PRTX, TRILOG, VERS and VV devices [TJP].
C 29-Jan-1985 - add HP2648 device [KS/TJP].
C  5-Aug-1986 - add GREXEC support [AFT].
C 21-Feb-1987 - delays setting color if picture not open [AFT].
C 11-Jun-1987 - remove built-in devices [TJP].
C 31-May-1989 - add check for valid color index [TJP].
C  1-Sep-1994 - use common data [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER  IC, COLOR, IC1, IC2, NBUF,LCHR
      REAL     RBUF(6)
      CHARACTER*1 CHR
C
C Error if no workstation is open.
C
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRSCI - no graphics device is active.')
          RETURN
      END IF
C
C Use color index 1 if out of range.
C
      IC1 = GRMNCI(GRCIDE)
      IC2 = GRMXCI(GRCIDE)
      COLOR = IC
      IF (COLOR.LT.IC1 .OR. COLOR.GT.IC2) COLOR = 1
C
C If no change to color index is requested, take no action.
C
      IF (COLOR.EQ.GRCCOL(GRCIDE)) RETURN
C
C If the workstation is in "picture open" state, send command to
C driver.
C
      IF (GRPLTD(GRCIDE)) THEN
          RBUF(1) = COLOR
          CALL GREXEC(GRGTYP,15,RBUF,NBUF,CHR,LCHR)
      END IF
C
C Set the current color index.
C
      GRCCOL(GRCIDE)=COLOR
C
      END
#<

#>            grscr.dc3
Name:         GRSCR

Purpose:      set color representation

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRSCR (CI, CR, CG, CB)
            INTEGER  CI
            REAL     CR, CG, CB
      
       GRPCKG: SET COLOUR REPRESENTATION -- define the colour to be
       associated with a colour index.  Ignored for devices which do not
       support variable colour or intensity.  On monochrome output
       devices (e.g. VT125 terminals with monochrome monitors), the
       monochrome intensity is computed from the specified Red, Green, Blue
       intensities as 0.30*R + 0.59*G + 0.11*B, as in US color television
       systems, NTSC encoding.  Note that most devices do not have an
       infinite range of colours or monochrome intensities available;
       the nearest available colour is used.
      
       Arguments:
      
       CI (integer, input): colour index. If the colour index is outside the
             range available on the device, the call is ignored. Colour
             index 0 applies to the background colour.
       CR, CG, CB (real, input): red, green, and blue intensities,
             in range 0.0 to 1.0.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grscr.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRSCR -- set color representation
C+
      SUBROUTINE GRSCR (CI, CR, CG, CB)
      INTEGER  CI
      REAL     CR, CG, CB
C
C GRPCKG: SET COLOUR REPRESENTATION -- define the colour to be
C associated with a colour index.  Ignored for devices which do not
C support variable colour or intensity.  On monochrome output
C devices (e.g. VT125 terminals with monochrome monitors), the
C monochrome intensity is computed from the specified Red, Green, Blue
C intensities as 0.30*R + 0.59*G + 0.11*B, as in US color television
C systems, NTSC encoding.  Note that most devices do not have an
C infinite range of colours or monochrome intensities available;
C the nearest available colour is used.
C
C Arguments:
C
C CI (integer, input): colour index. If the colour index is outside the
C       range available on the device, the call is ignored. Colour
C       index 0 applies to the background colour.
C CR, CG, CB (real, input): red, green, and blue intensities,
C       in range 0.0 to 1.0.
C--
C 20-Feb-1984 - [TJP].
C  5-Jun-1984 - add GMFILE device [TJP].
C  2-Jul-1984 - add REGIS device [TJP].
C  2-Oct-1984 - change use of map tables in Regis [TJP].
C 11-Nov-1984 - add code for /TK [TJP].
C  1-Sep-1986 - add GREXEC support [AFT].
C 21-Feb-1987 - If needed, calls begin picture [AFT].
C 31-Aug-1994 - suppress call of begin picture [TJP].
C  1-Sep-1994 - use common data [TJP].
C 26-Jul-1995 - fix bug: some drivers would ignore a change to the
C               current color [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER   NBUF, LCHR
      REAL      RBUF(6)
      CHARACTER CHR
C
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRSCR - Specified workstation is not open.')
      ELSE IF (CR.LT.0.0 .OR. CG.LT.0.0 .OR. CB.LT.0.0 .OR.
     1    CR.GT.1.0 .OR. CG.GT.1.0 .OR. CB.GT.1.0) THEN
          CALL GRWARN('GRSCR - Colour is outside range [0,1].')
      ELSE IF (CI.GE.GRMNCI(GRCIDE) .AND. CI.LE.GRMXCI(GRCIDE)) THEN
C         IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC
          RBUF(1)=CI
          RBUF(2)=CR
          RBUF(3)=CG
          RBUF(4)=CB
          NBUF=4
          CALL GREXEC(GRGTYP,21,RBUF,NBUF,CHR,LCHR)
C         -- If this is the current color, reselect it in the driver.
          IF (CI.EQ.GRCCOL(GRCIDE)) THEN
             RBUF(1) = CI
             CALL GREXEC(GRGTYP,15,RBUF,NBUF,CHR,LCHR)
          END IF
      END IF
C
      END
#<

#>            grscrl.dc3
Name:         grscrl

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Oct 16, 1998: JPT automatically generated.
#<

#>            grscrl.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C GRSCRL -- scroll pixels in viewport
C+
      SUBROUTINE GRSCRL (DX, DY)
      INTEGER DX, DY
C
C Shift the pixels in the viewport by DX and DY in device coordinates.
C--
C 24-Feb-97: new routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER NBUF, LCHR
      REAL RBUF(6)
      CHARACTER*8 CHR
C
C Do nothing if device is not open or not in appropriate state.
C
      IF (GRCIDE.LT.1) RETURN
      IF (.NOT.GRPLTD(GRCIDE)) RETURN
C
C If device has scroll capability, use it. The arguments in
C RBUF are: (1..4) current viewport in device coordinates; 
C (5..6) scroll displacement in world coordinates.
C
      IF (GRGCAP(GRCIDE)(11:11).EQ.'S') THEN
         RBUF(1) = NINT(GRXMIN(GRCIDE))
         RBUF(2) = NINT(GRYMIN(GRCIDE))
         RBUF(3) = NINT(GRXMAX(GRCIDE))
         RBUF(4) = NINT(GRYMAX(GRCIDE))
         RBUF(5) = DX
         RBUF(6) = DY
         NBUF = 6
         LCHR = 0
         CALL GREXEC(GRGTYP,30,RBUF,NBUF,CHR,LCHR)
C
C Otherwise, report an error.
C
      ELSE
         CALL GRWARN('Device does not support scrolling')
      END IF
      END
#<

#>            grsetc.dc3
Name:         GRSETC

Purpose:      set character size

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRSETC (IDENT,XSIZE)
      
       GRPCKG : change the character size (user-callable routine).
      
       Input:   IDENT : plot identifier
                XSIZE : the new character width. The character height
                        and spacing will be scaled by the same factor.
                        If XSIZE is negative or zero, the character size
                        will be set to the default size.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grsetc.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRSETC -- set character size
C+
      SUBROUTINE GRSETC (IDENT,XSIZE)
C
C GRPCKG : change the character size (user-callable routine).
C
C Input:   IDENT : plot identifier
C          XSIZE : the new character width. The character height
C                  and spacing will be scaled by the same factor.
C                  If XSIZE is negative or zero, the character size
C                  will be set to the default size.
C--
C (1-Feb-1983)
C 16-Sep-1985 - add code for metafile output (TJP).
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER IDENT
      REAL XSIZE
C
C Record the new size (GRCFAC).
C
      CALL GRSLCT(IDENT)
      IF (XSIZE.LE.0.0) THEN
          GRCFAC(IDENT) = 1.0
      ELSE
          GRCFAC(IDENT) = XSIZE / GRCXSZ
      END IF
C
      END
#<

#>            grsetfont.f.orig
C*GRSETFONT -- set text font [obsolete]
C
      SUBROUTINE GRSETFONT (IF)
      INTEGER IF
      CALL GRSFNT(IF)
      END
#<

#>            grsetli.dc3
Name:         GRSETLI

Purpose:      *obsolete routine*

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRSETLI (IN)
      
       GRPCKG: Set the line intensity for subsequent plotting on the current
       device. *** OBSOLETE ROUTINE *** Intensity is now set with GRSCI
       and GRSCR. For compatibility, GRSETLI now sets color zero if its
       argument is 0, and resets the previous color if its argument is
       non-zero.
      
       Argument:
      
       IN (integer, input): the intensity to be used for subsequent
             plotting on the current device (in range 0-3).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grsetli.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRSETLI -- *obsolete routine*
C+
      SUBROUTINE GRSETLI (IN)
C
C GRPCKG: Set the line intensity for subsequent plotting on the current
C device. *** OBSOLETE ROUTINE *** Intensity is now set with GRSCI
C and GRSCR. For compatibility, GRSETLI now sets color zero if its
C argument is 0, and resets the previous color if its argument is
C non-zero.
C
C Argument:
C
C IN (integer, input): the intensity to be used for subsequent
C       plotting on the current device (in range 0-3).
C--
C 11-Apr-1983 - [TJP].
C 12-Jul-1984 - modify to call GRSCI [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER  IN, OLDCOL(GRIMAX)
      DATA     OLDCOL /GRIMAX*1/
C
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRSETLI - no graphics device is active.')
      ELSE IF (IN.EQ.0) THEN
          OLDCOL(GRCIDE) = GRCCOL(GRCIDE)
          CALL GRSCI(0)
      ELSE
          CALL GRSCI(OLDCOL(GRCIDE))
      END IF
      END
#<

#>            grsetpen.dc3
Name:         GRSETPEN

Purpose:      *obsolete routine*

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRSETPEN
      
       GRPCKG: Set the pen number for subsequent plotting.  Obsolete
       routine: ignored.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grsetpen.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRSETPEN -- *obsolete routine*
C+
      SUBROUTINE GRSETPEN
C
C GRPCKG: Set the pen number for subsequent plotting.  Obsolete
C routine: ignored.
C-----------------------------------------------------------------------
      CALL GRWARN('GRSETPEN is an obsolete routine.')
      END
#<

#>            grsets.dc3
Name:         GRSETS

Purpose:      change size of view surface

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRSETS (IDENT,XSIZE,YSIZE)
      
       GRPCKG : change size of plotting area. The requested dimensions
       will be reduced to the absolute maximum of the plot device if
       necessary.
      
       Arguments:
      
       IDENT (input, integer): plot identifier from GROPEN.
       XSIZE (input, real): new x dimension of plot area (absolute
                     units); if less than zero, the default dimension
                     will be used.
       YSIZE (input, real): new y dimension of plot area (absolute
                     units); if less than zero, the default dimension
                     will be used.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grsets.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRSETS -- change size of view surface
C+
      SUBROUTINE GRSETS (IDENT,XSIZE,YSIZE)
C
C GRPCKG : change size of plotting area. The requested dimensions
C will be reduced to the absolute maximum of the plot device if
C necessary.
C
C Arguments:
C
C IDENT (input, integer): plot identifier from GROPEN.
C XSIZE (input, real): new x dimension of plot area (absolute
C               units); if less than zero, the default dimension
C               will be used.
C YSIZE (input, real): new y dimension of plot area (absolute
C               units); if less than zero, the default dimension
C               will be used.
C--
C (1-Feb-1983)
C  5-Aug-1986 - add GREXEC support [AFT].
C  5-Jan-1993 - set GRADJU [TJP].
C------------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER  I, IDENT, J, IX, IY, NBUF,LCHR
      REAL     RBUF(6)
      CHARACTER CHR
      REAL     XSIZE,YSIZE
C
      CALL GRSLCT(IDENT)
C     write (*,*) 'GRSETS: old size', GRXMXA(IDENT), GRYMXA(IDENT)
      CALL GRPAGE
      IF ((XSIZE .LT. 0.0) .OR. (YSIZE .LT. 0.0)) THEN
          CALL GREXEC(GRGTYP, 6,RBUF,NBUF,CHR,LCHR)
          GRXMXA(IDENT) = RBUF(2)
          GRYMXA(IDENT) = RBUF(4)
      ELSE
          I = NINT(XSIZE)
          J = NINT(YSIZE)
          CALL GREXEC(GRGTYP, 2,RBUF,NBUF,CHR,LCHR)
          IX=RBUF(2)
          IY=RBUF(4)
          IF (IX.GT.0) I = MIN(I,IX)
          IF (IY.GT.0) J = MIN(J,IY)
          GRXMXA(IDENT) = I
          GRYMXA(IDENT) = J
      END IF
C     write (*,*) 'GRSETS: new size', GRXMXA(IDENT), GRYMXA(IDENT)
      GRXMIN(IDENT) = 0
      GRXMAX(IDENT) = GRXMXA(IDENT)
      GRYMIN(IDENT) = 0
      GRYMAX(IDENT) = GRYMXA(IDENT)
      GRADJU(IDENT) = .TRUE.
C
      END
#<

#>            grsfnt.dc3
Name:         GRSFNT

Purpose:      set text font

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRSFNT (IF)
            INTEGER IF
      
       GRPCKG: Set the font for subsequent text plotting.
       The default font is 1 ("Normal" font); others available are 2
       ("Roman"), 3 ("Italic"), and 4 ("Script").
      
       Argument:
        IF (input): the font number to be used for subsequent
             text plotting on the current device (in range 1-4).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grsfnt.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRSFNT -- set text font
C+
      SUBROUTINE GRSFNT (IF)
      INTEGER IF
C
C GRPCKG: Set the font for subsequent text plotting.
C The default font is 1 ("Normal" font); others available are 2
C ("Roman"), 3 ("Italic"), and 4 ("Script").
C
C Argument:
C  IF (input): the font number to be used for subsequent
C       text plotting on the current device (in range 1-4).
C--
C 19-Mar-1983 - [TJP].
C  4-Jun-1984 - add code for GMFILE device [TJP].
C 15-Dec-1988 - change name [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER    I
C
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRSFNT - no graphics device is active.')
          RETURN
      END IF
C
C Set software font index.
C
      IF (IF.LT.1 .OR. IF.GT.4) THEN
          CALL GRWARN('Illegal font selected: font 1 used.')
          I = 1
      ELSE
          I = IF
      END IF
C
C Ignore request if no change is to be made.
C
      IF (IF.EQ.GRCFNT(GRCIDE)) RETURN
C
C Save font setting.
C
      GRCFNT(GRCIDE) = I
C
      END
#<

#>            grsize.dc3
Name:         GRSIZE

Purpose:      inquire device size and resolution

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRSIZE (IDENT,XSZDEF,YSZDEF,XSZMAX,YSZMAX,
           1                   XPERIN,YPERIN)
      
       GRPCKG : obtain device parameters (user-callable routine).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grsize.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRSIZE -- inquire device size and resolution
C+
      SUBROUTINE GRSIZE (IDENT,XSZDEF,YSZDEF,XSZMAX,YSZMAX,
     1                   XPERIN,YPERIN)
C
C GRPCKG : obtain device parameters (user-callable routine).
C--
C (1-Feb-1983)
C  5-Aug-1986 - add GREXEC support [AFT].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER IDENT
      REAL XSZDEF, YSZDEF, XSZMAX, YSZMAX, XPERIN, YPERIN
      INTEGER NBUF,LCHR
      REAL    RBUF(6)
      CHARACTER CHR
C
      CALL GRSLCT(IDENT)
      CALL GREXEC(GRGTYP, 6,RBUF,NBUF,CHR,LCHR)
      XSZDEF = RBUF(2)
      YSZDEF = RBUF(4)
      CALL GREXEC(GRGTYP, 2,RBUF,NBUF,CHR,LCHR)
      XSZMAX = RBUF(2)
      YSZMAX = RBUF(4)
      XPERIN = GRPXPI(GRCIDE)
      YPERIN = GRPYPI(GRCIDE)
C
      END
#<

#>            grskpb.dc3
Name:         GRSKPB

Purpose:      skip blanks in character string

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRSKPB (S, I)
            CHARACTER*(*) S
            INTEGER I
      
       GRSKPB: increment I so that it points to the next non-blank
       character in string S.  'Blank' characters are space and tab (ASCII 
       character value 9).
      
       Arguments:
        S      (input)  : character string to be parsed.
        I      (in/out) : on input, I is the index of the first character
                          in S to be examined; on output, either it points
                          to the next non-blank character, or it is equal
                          to LEN(S)+1 (if all the rest of the string is 
                          blank).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grskpb.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRSKPB -- skip blanks in character string
C+
      SUBROUTINE GRSKPB (S, I)
      CHARACTER*(*) S
      INTEGER I
C
C GRSKPB: increment I so that it points to the next non-blank
C character in string S.  'Blank' characters are space and tab (ASCII 
C character value 9).
C
C Arguments:
C  S      (input)  : character string to be parsed.
C  I      (in/out) : on input, I is the index of the first character
C                    in S to be examined; on output, either it points
C                    to the next non-blank character, or it is equal
C                    to LEN(S)+1 (if all the rest of the string is 
C                    blank).
C--
C  1985 Oct 8 - New routine, based on SKIPBL (T. J. Pearson).
C-----------------------------------------------------------------------
C
   10 IF (I.GT.LEN(S)) RETURN
      IF (S(I:I).NE.' ' .AND. S(I:I).NE.CHAR(9)) RETURN
      I = I+1
      GOTO 10
      END
#<

#>            grslct.dc3
Name:         GRSLCT

Purpose:      select active output device

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRSLCT (IDENT)
      
       GRPCKG: Check that IDENT is a valid plot identifier, and select the
       corresponding plot as the current plot. All subsequent plotting will
       be directed to this device until the assignment is changed by another
       call to GRSLCT.
      
       Argument:
      
       IDENT (input, integer): the identifier of the plot to be selected, as
             returned by GROPEN.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grslct.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRSLCT -- select active output device
C+
      SUBROUTINE GRSLCT (IDENT)
C
C GRPCKG: Check that IDENT is a valid plot identifier, and select the
C corresponding plot as the current plot. All subsequent plotting will
C be directed to this device until the assignment is changed by another
C call to GRSLCT.
C
C Argument:
C
C IDENT (input, integer): the identifier of the plot to be selected, as
C       returned by GROPEN.
C--
C (1-Feb-1983)
C  5-Aug-1986 - add GREXEC support [AFT].
C  4-Jun-1987 - skip action if no change in ID [TJP].
C 26-Nov-1990 - [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      REAL     RBUF(6)
      INTEGER  IDENT, NBUF,LCHR
      CHARACTER CHR
C
      IF ((IDENT.LE.0) .OR. (IDENT.GT.GRIMAX) .OR.
     1    (GRSTAT(IDENT).EQ.0)) THEN
            CALL GRWARN('GRSLCT - invalid plot identifier.')
      ELSE IF (IDENT.EQ.GRCIDE) THEN
          RETURN
      ELSE
          GRCIDE = IDENT
          GRGTYP = GRTYPE(IDENT)
          RBUF(1)= GRCIDE
          RBUF(2)= GRUNIT(GRCIDE)
          NBUF   = 2
          CALL GREXEC(GRGTYP, 8,RBUF,NBUF,CHR,LCHR)
      END IF
      END
#<

#>            grsls.dc3
Name:         GRSLS

Purpose:      set line style

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRSLS (IS)
            INTEGER IS
      
       GRPCKG: Set the line style for subsequent plotting on the current
       device. The different line styles are generated in hardware on
       some devices and by GRPCKG software for the other devices. Five
       different line styles are available, with the following codes:
       1 (full line), 2 (dashed), 3 (dot-dash-dot-dash), 4 (dotted),
       5 (dash-dot-dot-dot). The default is 1 (normal full line). Line
       style is ignored when drawing characters, which are always drawn with
       a full line.
      
       Argument:
      
       IS (input, integer): the line-style code for subsequent plotting on
             the current device (in range 1-5).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grsls.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRSLS -- set line style
C+
      SUBROUTINE GRSLS (IS)
      INTEGER IS
C
C GRPCKG: Set the line style for subsequent plotting on the current
C device. The different line styles are generated in hardware on
C some devices and by GRPCKG software for the other devices. Five
C different line styles are available, with the following codes:
C 1 (full line), 2 (dashed), 3 (dot-dash-dot-dash), 4 (dotted),
C 5 (dash-dot-dot-dot). The default is 1 (normal full line). Line
C style is ignored when drawing characters, which are always drawn with
C a full line.
C
C Argument:
C
C IS (input, integer): the line-style code for subsequent plotting on
C       the current device (in range 1-5).
C--
C  9-Feb-1983 - [TJP].
C  3-Jun-1984 - add GMFILE device [TJP].
C  5-Aug-1986 - add GREXEC support [AFT].
C 21-Feb-1987 - If needed, calls begin picture [AFT].
C 19-Jan-1987 - fix bug in GREXEC call [TJP].
C 16-May-1989 - fix bug for hardware line dash [TJP].
C  1-Sep-1994 - do not call driver to get size and capabilities [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER I, L, IDASH, NBUF,LCHR
      REAL    RBUF(6),TMP
      CHARACTER*10 CHR
      REAL PATERN(8,5)
C
      DATA PATERN/ 8*10.0,
     1             8*10.0,
     2             8.0, 6.0, 1.0, 6.0, 8.0, 6.0, 1.0, 6.0,
     3             1.0, 6.0, 1.0, 6.0, 1.0, 6.0, 1.0, 6.0,
     4             8.0, 6.0, 1.0, 6.0, 1.0, 6.0, 1.0, 6.0 /
C
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRSLS - no graphics device is active.')
          RETURN
      END IF
C
      I = IS
      IF (I.LT.1 .OR. I.GT.5) THEN
          CALL GRWARN('GRSLS - invalid line-style requested.')
          I = 1
      END IF
C
C Inquire if hardware dash is available.
C
      IDASH=0
      IF(GRGCAP(GRCIDE)(3:3).EQ.'D') IDASH=1
C
C Set up for hardware dash.
C
      IF(IDASH.NE.0) THEN
          GRDASH(GRCIDE) = .FALSE.
          IF (GRPLTD(GRCIDE)) THEN
              RBUF(1)=I
              NBUF=1
              CALL GREXEC(GRGTYP,19,RBUF,NBUF,CHR,LCHR)
          END IF
C
C Set up for software dash.
C
      ELSE
          IF (I.EQ.1) THEN
              GRDASH(GRCIDE) = .FALSE.
          ELSE
              GRDASH(GRCIDE) = .TRUE.
              GRIPAT(GRCIDE) = 1
              GRPOFF(GRCIDE) = 0.0
              TMP = GRYMXA(GRCIDE)/1000.
              DO 10 L=1,8
                  GRPATN(GRCIDE,L) = PATERN(L,I)*TMP
   10         CONTINUE
          END IF
      END IF
      GRSTYL(GRCIDE) = I
      END
#<

#>            grslw.dc3
Name:         GRSLW

Purpose:      set line width

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRSLW (IW)
            INTEGER IW
      
       GRPCKG: Set the line width for subsequent plotting on the current
       device. If the hardware does not support thick lines, they are
       simulated by tracing each line with multiple strokes offset in the
       direction perpendicular to the line. The line width is specified by
       the number of strokes to be used, which must be in the range 1-201.
       The actual line width obtained depends on the device resolution.
       If the hardware does support thick lines, the width of the line
       is approximately 0.005 inches times the value of argument IW.
      
       Argument:
      
       IW (integer, input): the number of strokes to be used for subsequent
             plotting on the current device (in range 1-201).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grslw.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRSLW -- set line width
C+
      SUBROUTINE GRSLW (IW)
      INTEGER IW
C
C GRPCKG: Set the line width for subsequent plotting on the current
C device. If the hardware does not support thick lines, they are
C simulated by tracing each line with multiple strokes offset in the
C direction perpendicular to the line. The line width is specified by
C the number of strokes to be used, which must be in the range 1-201.
C The actual line width obtained depends on the device resolution.
C If the hardware does support thick lines, the width of the line
C is approximately 0.005 inches times the value of argument IW.
C
C Argument:
C
C IW (integer, input): the number of strokes to be used for subsequent
C       plotting on the current device (in range 1-201).
C--
C  1-Feb-1983 [TJP].
C  3-Jun-1984 [TJP] - add GMFILE device.
C 28-Aug-1984 [TJP] - correct bug in GMFILE: redundant SET_LINEWIDTH
C                     commands were not being filtered out.
C 26-May-1987 [TJP] - add GREXEC support.
C 11-Jun-1987 [TJP] - remove built-in devices.
C 31-May-1989 [TJP] - increase maximum width from 21 to 201.
C  1-Sep-1994 [TJP] 
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER I, ITHICK
      REAL    RBUF(1)
      INTEGER NBUF,LCHR
      CHARACTER*32 CHR
C
C Check that graphics is active.
C
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRSLW - no graphics device is active.')
          RETURN
      END IF
C
C Check that requested line-width is valid.
C
      I = IW
      IF (I.LT.1 .OR. I.GT.201) THEN
          CALL GRWARN('GRSLW - invalid line-width requested.')
          I = 1
      END IF
C
C Ignore the request if the linewidth is unchanged.
C
      IF (I.EQ.ABS(GRWIDT(GRCIDE))) RETURN
C
C Inquire if hardware supports thick lines.
C
      ITHICK = 0
      IF (GRGCAP(GRCIDE)(5:5).EQ.'T') ITHICK = 1
C
C For devices with hardware support of thick lines, send the
C appropriate commands to the device driver, and give the "current
C linewidth" parameter a negative value to suppress software linewidth
C emulation.
C
      IF (ITHICK.EQ.1 .AND. GRPLTD(GRCIDE)) THEN
          RBUF(1) = I
          CALL GREXEC(GRGTYP,22,RBUF,NBUF,CHR,LCHR)
      END IF
C
C Save the current linewidth.
C
      GRWIDT(GRCIDE) = I
      IF (ITHICK.EQ.1) GRWIDT(GRCIDE) = -I
C
      END
#<

#>            grsncr.dc3
Subroutine:   GRSNCR

Purpose:      set multiple color representations

Category:     GRAPHICS

File:         pgplot.src

Author:       J. P. Terlouw

Use:          see description below.

Description:

            SUBROUTINE GRSNCR (CI, CR, CG, CB, N)
            INTEGER  CI, N
            REAL     CR(N), CG(N), CB(N)
      
       GRPCKG: SET COLOUR REPRESENTATION -- define the colour to be
       associated with a colour index.  Ignored for devices which do not
       support variable colour or intensity.  On monochrome output
       devices (e.g. VT125 terminals with monochrome monitors), the
       monochrome intensity is computed from the specified Red, Green, Blue
       intensities as 0.30*R + 0.59*G + 0.11*B, as in US color television
       systems, NTSC encoding.  Note that most devices do not have an
       infinite range of colours or monochrome intensities available;
       the nearest available colour is used.
      
       Arguments:
      
       CI (integer, input): first colour index. If any colour index is
             outside the range available on the device, the call is ignored.
             Colour index 0 applies to the background colour.
       CR, CG, CB (real array, input): red, green, and blue intensities,
             in range 0.0 to 1.0.
       N  (integer, input): number of colour indices to be modified.

       This subroutine is an extension of GRSCR, which allows one
       color index to be modified. It is only called by PGSNCR.

Updates:      Sep  3, 1999: JPT document created.
#<

#>            grsncr.f
* GIPSY-private
*
      SUBROUTINE GRSNCR (CI, CR, CG, CB, N)
      INCLUDE 'grpckg1.inc'
      INTEGER  CI, N
      REAL     CR(N), CG(N), CB(N)
      INTEGER   NBUF, LCHR
      REAL      RBUF(3*256+1)
      CHARACTER CHR
C
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRSNCR - Specified workstation is not open.')
      ELSE IF (CI.GE.GRMNCI(GRCIDE) .AND. CI+N-1.LE.GRMXCI(GRCIDE)) THEN
          RBUF(1)=CI
          DO 1 I=1,N
             RBUF(I*3-1)=CR(I)
             RBUF(I*3  )=CG(I)
             RBUF(I*3+1)=CB(I)
    1     CONTINUE
          NBUF=N*3+1
          CALL GREXEC(GRGTYP,21,RBUF,NBUF,CHR,LCHR)
      ELSE
          CALL GRWARN('GRSNCR - Color index out of range.')
      END IF
C
      END
#<

#>            grsy00.dc3
Name:         grsy00

Purpose:      initialize font definition

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRSY00
      
       This routine must be called once in order to initialize the tables
       defining the symbol numbers to be used for ASCII characters in each
       font, and to read the character digitization from a file.
      
       Arguments: none.
      
       Implicit input:
        The file with name specified in environment variable PGPLOT_FONT
        is read, if it is available.
        This is a binary file containing two arrays INDEX and BUFFER.
        The digitization of each symbol occupies a number of words in
        the INTEGER*2 array BUFFER; the start of the digitization
        for symbol number N is in BUFFER(INDEX(N)), where INDEX is an
        integer array of 3000 elements. Not all symbols 1...3000 have
        a representation; if INDEX(N) = 0, the symbol is undefined.
      
      *  PGPLOT uses the Hershey symbols for two `primitive' operations:
      *  graph markers and text.  The Hershey symbol set includes several
      *  hundred different symbols in a digitized form that allows them to
      *  be drawn with a series of vectors (polylines).
      *
      *  The digital representation of all the symbols is stored in common
      *  block /GRSYMB/.  This is read from a disk file at run time. The
      *  name of the disk file is specified in environment variable
      *  PGPLOT_FONT.
      *
      * Modules:
      *
      * GRSY00 -- initialize font definition
      * GRSYDS -- decode character string into list of symbol numbers
      * GRSYMK -- convert marker number into symbol number
      * GRSYXD -- obtain the polyline representation of a given symbol
      *
      * PGPLOT calls these routines as follows:
      *
      * Routine          Called by
      *
      * GRSY00          GROPEN
      * GRSYDS          GRTEXT, GRLEN
      * GRSYMK          GRMKER,
      * GRSYXD          GRTEXT, GRLEN, GRMKER
      ***********************************************************************

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grsy00.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Fri Oct 16, 1998 at 13:32:47. The Fortran code is unmodified.

C*GRSY00 -- initialize font definition
C+
      SUBROUTINE GRSY00
C
C This routine must be called once in order to initialize the tables
C defining the symbol numbers to be used for ASCII characters in each
C font, and to read the character digitization from a file.
C
C Arguments: none.
C
C Implicit input:
C  The file with name specified in environment variable PGPLOT_FONT
C  is read, if it is available.
C  This is a binary file containing two arrays INDEX and BUFFER.
C  The digitization of each symbol occupies a number of words in
C  the INTEGER*2 array BUFFER; the start of the digitization
C  for symbol number N is in BUFFER(INDEX(N)), where INDEX is an
C  integer array of 3000 elements. Not all symbols 1...3000 have
C  a representation; if INDEX(N) = 0, the symbol is undefined.
C
*  PGPLOT uses the Hershey symbols for two `primitive' operations:
*  graph markers and text.  The Hershey symbol set includes several
*  hundred different symbols in a digitized form that allows them to
*  be drawn with a series of vectors (polylines).
*
*  The digital representation of all the symbols is stored in common
*  block /GRSYMB/.  This is read from a disk file at run time. The
*  name of the disk file is specified in environment variable
*  PGPLOT_FONT.
*
* Modules:
*
* GRSY00 -- initialize font definition
* GRSYDS -- decode character string into list of symbol numbers
* GRSYMK -- convert marker number into symbol number
* GRSYXD -- obtain the polyline representation of a given symbol
*
* PGPLOT calls these routines as follows:
*
* Routine          Called by
*
* GRSY00          GROPEN
* GRSYDS          GRTEXT, GRLEN
* GRSYMK          GRMKER,
* GRSYXD          GRTEXT, GRLEN, GRMKER
***********************************************************************
C--
C (2-Jan-1984)
C 22-Jul-1984 - revise to use DATA statements [TJP].
C  5-Jan-1985 - make missing font file non-fatal [TJP].
C  9-Feb-1988 - change default file name to Unix name; overridden
C               by environment variable PGPLOT_FONT [TJP].
C 29-Nov-1990 - move font assignment to GRSYMK.
C  7-Nov-1994 - look for font file in PGPLOT_DIR if PGPLOT_FONT is
C               undefined [TJP].
C-----------------------------------------------------------------------
      INTEGER*2  BUFFER(27000)
      INTEGER    FNTFIL, IER, INDEX(3000), NC1, NC2, NC3
      INTEGER    L, GRTRIM
      COMMON     /GRSYMB/ NC1, NC2, INDEX, BUFFER
      CHARACTER*128 FF
C
C Read the font file. If an I/O error occurs, it is ignored; the
C effect will be that all symbols will be undefined (treated as 
C blank spaces).
C
      CALL GRGFIL('FONT', FF)
      L = GRTRIM(FF)
      IF (L.LT.1) L = 1
      CALL GRGLUN(FNTFIL)
      OPEN (UNIT=FNTFIL, FILE=FF(1:L), FORM='UNFORMATTED',
     2      STATUS='OLD', IOSTAT=IER)
      IF (IER.EQ.0) READ (UNIT=FNTFIL, IOSTAT=IER) 
     1            NC1,NC2,NC3,INDEX,BUFFER
      IF (IER.EQ.0) CLOSE (UNIT=FNTFIL, IOSTAT=IER)
      CALL GRFLUN(FNTFIL)
      IF (IER.NE.0) THEN
          CALL GRWARN('Unable to read font file: '//FF(:L))
          CALL GRWARN('Use environment variable PGPLOT_FONT to specify '
     :          //'the location of the PGPLOT grfont.dat file.')
      END IF
      RETURN
      END
#<

#>            grsyds.dc3
Name:         GRSYDS

Purpose:      decode character string into list of symbol numbers

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRSYDS (SYMBOL, NSYMBS, TEXT, FONT)
            INTEGER SYMBOL(*), NSYMBS, FONT
            CHARACTER*(*) TEXT
      
       Given a character string, this routine returns a list of symbol
       numbers to be used to plot it. It is responsible for interpreting
       all escape sequences.  Negative `symbol numbers' are inserted in the
       list to represent pen movement. The following escape sequences are
       defined (the letter following the \ may be either upper or lower 
       case):
      
       \u       :      up one level (returns -1)
       \d       :      down one level (returns -2)
       \b       :      backspace (returns -3)
       \A       :      (upper case only) Angstrom symbol, roman font
       \x       :      multiplication sign
       \.       :      centered dot
       \\       :      \, returns the code for backslash
       \gx      :      greek letter corresponding to roman letter x
       \fn      :      switch to Normal font
       \fr      :      switch to Roman font
       \fi      :      switch to Italic font
       \fs      :      switch to Script font
       \mn or \mnn :   graph marker number n or nn (1 or 2 digits)
       \(nnn)   :      Hershey symbol number nnn (any number of digits)
      
       Arguments:
        SYMBOL (output) : receives the list of symbol numers.
        NSYMBS (output) : receives the actual number of symbols specified
                          by the string; it is assumed that the dimension of
                          SYMBOL is big enough (not less than LEN(TEXT)).
        TEXT   (input)  : the text string to be decoded.
        FONT   (input)  : the font number (1..4) to be used for decoding the
                          string (this can be overridden by an escape
                          sequence within the string).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grsyds.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRSYDS -- decode character string into list of symbol numbers
C+
      SUBROUTINE GRSYDS (SYMBOL, NSYMBS, TEXT, FONT)
      INTEGER SYMBOL(*), NSYMBS, FONT
      CHARACTER*(*) TEXT
C
C Given a character string, this routine returns a list of symbol
C numbers to be used to plot it. It is responsible for interpreting
C all escape sequences.  Negative `symbol numbers' are inserted in the
C list to represent pen movement. The following escape sequences are
C defined (the letter following the \ may be either upper or lower 
C case):
C
C \u       :      up one level (returns -1)
C \d       :      down one level (returns -2)
C \b       :      backspace (returns -3)
C \A       :      (upper case only) Angstrom symbol, roman font
C \x       :      multiplication sign
C \.       :      centered dot
C \\       :      \, returns the code for backslash
C \gx      :      greek letter corresponding to roman letter x
C \fn      :      switch to Normal font
C \fr      :      switch to Roman font
C \fi      :      switch to Italic font
C \fs      :      switch to Script font
C \mn or \mnn :   graph marker number n or nn (1 or 2 digits)
C \(nnn)   :      Hershey symbol number nnn (any number of digits)
C
C Arguments:
C  SYMBOL (output) : receives the list of symbol numers.
C  NSYMBS (output) : receives the actual number of symbols specified
C                    by the string; it is assumed that the dimension of
C                    SYMBOL is big enough (not less than LEN(TEXT)).
C  TEXT   (input)  : the text string to be decoded.
C  FONT   (input)  : the font number (1..4) to be used for decoding the
C                    string (this can be overridden by an escape
C                    sequence within the string).
C--
C  3-May-1983 - [TJP].
C 13-Jun-1984 - add \A [TJP].
C 15-Dec-1988 - standardize [TJP].
C 29-Nov-1990 - add \m escapes [TJP].
C 27-Nov-1991 - add \x escape [TJP].
C 27-Jul-1995 - extend for 256-character set [TJP]
C  7-Nov-1995 - add \. escape [TJP].
C-----------------------------------------------------------------------
      CHARACTER*8  FONTS
      CHARACTER*48 GREEK
      PARAMETER (FONTS = 'nrisNRIS')
      PARAMETER (GREEK = 'ABGDEZYHIKLMNCOPRSTUFXQW' //
     1                   'abgdezyhiklmncoprstufxqw' )
      INTEGER  CH, IG, J, LENTXT, IFONT, MARK
C
C Initialize parameters.
C
      IFONT = FONT
      LENTXT = LEN(TEXT)
      NSYMBS = 0
      J = 0
C
C Get next character; treat non-printing characters as spaces.
C
  100 J = J+1
      IF (J.GT.LENTXT) RETURN
      CH = ICHAR(TEXT(J:J))
      IF (CH.LT.0)   CH = 32
      IF (CH.GT.303) CH = 32
C
C Test for escape sequence (\)
C
      IF (CH.EQ.92) THEN
          IF ((LENTXT-J).GE.1) THEN
            IF (TEXT(J+1:J+1).EQ.CHAR(92)) THEN
                J = J+1
            ELSE IF (TEXT(J+1:J+1).EQ.'u' .OR.
     1                     TEXT(J+1:J+1).EQ.'U') THEN
                NSYMBS = NSYMBS + 1
                SYMBOL(NSYMBS) = -1
                J = J+1
                GOTO 100
            ELSE IF (TEXT(J+1:J+1).EQ.'d' .OR.
     1                     TEXT(J+1:J+1).EQ.'D') THEN
                NSYMBS = NSYMBS + 1
                SYMBOL(NSYMBS) = -2
                J = J+1
                GOTO 100
            ELSE IF (TEXT(J+1:J+1).EQ.'b' .OR.
     1                     TEXT(J+1:J+1).EQ.'B') THEN
                NSYMBS = NSYMBS + 1
                SYMBOL(NSYMBS) = -3
                J = J+1
                GOTO 100
            ELSE IF (TEXT(J+1:J+1).EQ.'A') THEN
                NSYMBS = NSYMBS + 1
                SYMBOL(NSYMBS) = 2078
                J = J+1
                GOTO 100
            ELSE IF (TEXT(J+1:J+1).EQ.'x') THEN
                NSYMBS = NSYMBS + 1
                SYMBOL(NSYMBS) = 2235
                IF (IFONT.EQ.1) SYMBOL(NSYMBS) = 727
                J = J+1
                GOTO 100
            ELSE IF (TEXT(J+1:J+1).EQ.'.') THEN
                NSYMBS = NSYMBS + 1
                SYMBOL(NSYMBS) = 2236
                IF (IFONT.EQ.1) SYMBOL(NSYMBS) = 729
                J = J+1
                GOTO 100
            ELSE IF (TEXT(J+1:J+1).EQ.'(') THEN
                NSYMBS = NSYMBS + 1
                SYMBOL(NSYMBS) = 0
                J = J+2
C               -- DO WHILE ('0'.LE.TEXT(J:J).AND.TEXT(J:J).LE.'9')
   90           IF ('0'.LE.TEXT(J:J).AND.TEXT(J:J).LE.'9') THEN
                  SYMBOL(NSYMBS) = SYMBOL(NSYMBS)*10 +
     1                      ICHAR(TEXT(J:J)) - ICHAR('0')
                   J = J+1
                GOTO 90
                END IF
C               -- end DO WHILE
                IF (TEXT(J:J).NE.')') J = J-1
                GOTO 100
            ELSE IF (TEXT(J+1:J+1).EQ.'m' .OR.
     1               TEXT(J+1:J+1).EQ.'M') THEN
                MARK = 0
                J = J+2
                IF ('0'.LE.TEXT(J:J).AND.TEXT(J:J).LE.'9') THEN
                    MARK = MARK*10 + ICHAR(TEXT(J:J)) - ICHAR('0')
                    J = J+1
                END IF
                IF ('0'.LE.TEXT(J:J).AND.TEXT(J:J).LE.'9') THEN
                    MARK = MARK*10 + ICHAR(TEXT(J:J)) - ICHAR('0')
                    J = J+1
                END IF
                J = J-1
                NSYMBS = NSYMBS + 1
                CALL GRSYMK(MARK, IFONT, SYMBOL(NSYMBS))
                GOTO 100
            ELSE IF (TEXT(J+1:J+1).EQ.'f' .OR.
     1               TEXT(J+1:J+1).EQ.'F') THEN
                IFONT = INDEX(FONTS, TEXT(J+2:J+2))
                IF (IFONT.GT.4) IFONT = IFONT-4
                IF (IFONT.EQ.0) IFONT = 1
                J = J+2
                GOTO 100
            ELSE IF (TEXT(J+1:J+1).EQ.'g' .OR.
     1               TEXT(J+1:J+1).EQ.'G') THEN
                IG = INDEX(GREEK, TEXT(J+2:J+2))
                NSYMBS = NSYMBS + 1
                CALL GRSYMK(255+IG, IFONT, SYMBOL(NSYMBS))
                J = J+2
                GOTO 100
            END IF
          END IF
      END IF
C
C Decode character.
C
      NSYMBS = NSYMBS + 1
      CALL GRSYMK(CH, IFONT, SYMBOL(NSYMBS))
      GOTO 100
      END
#<

#>            grsymk.dc3
Name:         GRSYMK

Purpose:      convert character number into symbol number

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRSYMK (CODE, FONT, SYMBOL)
            INTEGER CODE, FONT, SYMBOL
      
       This routine returns the Hershey symbol number (SYMBOL) corresponding
       to ASCII code CODE in font FONT.
      
       Characters 0-31 are the same in all fonts, and are the standard
       graph markers. Characters 32-127 are standard representations of
       the ASCII codes. Characters 128-255 are reserved for the upper
       half of the ISO Latin-1 character set. Characters 256-303 are
       used for the greek alphabet.
      
       Arguments:
        CODE   (input)  : the extended ASCII code number.
        FONT   (input)  : the font to be used 31 (range 1-4).
        SYMBOL (output) : the number of the symbol to be plotted.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grsymk.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRSYMK -- convert character number into symbol number
C+
      SUBROUTINE GRSYMK (CODE, FONT, SYMBOL)
      INTEGER CODE, FONT, SYMBOL
C
C This routine returns the Hershey symbol number (SYMBOL) corresponding
C to ASCII code CODE in font FONT.
C
C Characters 0-31 are the same in all fonts, and are the standard
C graph markers. Characters 32-127 are standard representations of
C the ASCII codes. Characters 128-255 are reserved for the upper
C half of the ISO Latin-1 character set. Characters 256-303 are
C used for the greek alphabet.
C
C Arguments:
C  CODE   (input)  : the extended ASCII code number.
C  FONT   (input)  : the font to be used 31 (range 1-4).
C  SYMBOL (output) : the number of the symbol to be plotted.
C--
C 24-Apr-1986.
C 15-Dec-1988 - standardize [TJP].
C 29-Nov-1990 - eliminate common block [TJP].
C 27-Nov-1991 - correct code for backslash [TJP].
C 27-Jul-1995 - extend for 256-character set; add some defaults for
C               ISO Latin-1 (full glyph set not available) [TJP].
C-----------------------------------------------------------------------
      INTEGER   I, K, HERSH(0:303,4)
      SAVE      HERSH
C
C Special characters (graph markers).
C
      DATA (HERSH(  0,K),K=1,4) / 841, 841, 841, 841/
      DATA (HERSH(  1,K),K=1,4) / 899, 899, 899, 899/
      DATA (HERSH(  2,K),K=1,4) / 845, 845, 845, 845/
      DATA (HERSH(  3,K),K=1,4) / 847, 847, 847, 847/
      DATA (HERSH(  4,K),K=1,4) / 840, 840, 840, 840/
      DATA (HERSH(  5,K),K=1,4) / 846, 846, 846, 846/
      DATA (HERSH(  6,K),K=1,4) / 841, 841, 841, 841/
      DATA (HERSH(  7,K),K=1,4) / 842, 842, 842, 842/
      DATA (HERSH(  8,K),K=1,4) /2284,2284,2284,2284/
      DATA (HERSH(  9,K),K=1,4) /2281,2281,2281,2281/
      DATA (HERSH( 10,K),K=1,4) / 735, 735, 735, 735/
      DATA (HERSH( 11,K),K=1,4) / 843, 843, 843, 843/
      DATA (HERSH( 12,K),K=1,4) / 844, 844, 844, 844/
      DATA (HERSH( 13,K),K=1,4) / 852, 852, 852, 852/
      DATA (HERSH( 14,K),K=1,4) / 866, 866, 866, 866/
      DATA (HERSH( 15,K),K=1,4) / 868, 868, 868, 868/
      DATA (HERSH( 16,K),K=1,4) / 851, 851, 851, 851/
      DATA (HERSH( 17,K),K=1,4) / 850, 850, 850, 850/
      DATA (HERSH( 18,K),K=1,4) / 856, 856, 856, 856/
      DATA (HERSH( 19,K),K=1,4) / 254, 254, 254, 254/
      DATA (HERSH( 20,K),K=1,4) / 900, 900, 900, 900/
      DATA (HERSH( 21,K),K=1,4) / 901, 901, 901, 901/
      DATA (HERSH( 22,K),K=1,4) / 902, 902, 902, 902/
      DATA (HERSH( 23,K),K=1,4) / 903, 903, 903, 903/
      DATA (HERSH( 24,K),K=1,4) / 904, 904, 904, 904/
      DATA (HERSH( 25,K),K=1,4) / 905, 905, 905, 905/
      DATA (HERSH( 26,K),K=1,4) / 906, 906, 906, 906/
      DATA (HERSH( 27,K),K=1,4) / 907, 907, 907, 907/
      DATA (HERSH( 28,K),K=1,4) /2263,2263,2263,2263/
      DATA (HERSH( 29,K),K=1,4) /2261,2261,2261,2261/
      DATA (HERSH( 30,K),K=1,4) /2262,2262,2262,2262/
      DATA (HERSH( 31,K),K=1,4) /2264,2264,2264,2264/
C
C US-ASCII (ISO Latin-1 lower half).
C
C   32:39 space exclam quotdbl numbersign
C         dollar percent ampersand quoteright
      DATA (HERSH( 32,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH( 33,K),K=1,4) / 714,2214,2764,2764/
      DATA (HERSH( 34,K),K=1,4) / 717,2217,2778,2778/
      DATA (HERSH( 35,K),K=1,4) / 733,2275,2275,2275/
      DATA (HERSH( 36,K),K=1,4) / 719,2274,2769,2769/
      DATA (HERSH( 37,K),K=1,4) /2271,2271,2271,2271/
      DATA (HERSH( 38,K),K=1,4) / 734,2272,2768,2768/
      DATA (HERSH( 39,K),K=1,4) / 716,2216,2777,2777/
C   40:47 parenleft parenright asterisk plus
C         comma minus period slash
      DATA (HERSH( 40,K),K=1,4) / 721,2221,2771,2771/
      DATA (HERSH( 41,K),K=1,4) / 722,2222,2772,2772/
      DATA (HERSH( 42,K),K=1,4) / 728,2219,2773,2773/
      DATA (HERSH( 43,K),K=1,4) / 725,2232,2775,2775/
      DATA (HERSH( 44,K),K=1,4) / 711,2211,2761,2761/
      DATA (HERSH( 45,K),K=1,4) / 724,2231,2774,2774/
      DATA (HERSH( 46,K),K=1,4) / 710,2210,2760,2760/
      DATA (HERSH( 47,K),K=1,4) / 720,2220,2770,2770/
C   48:55 zero one two three four five six seven
      DATA (HERSH( 48,K),K=1,4) / 700,2200,2750,2750/
      DATA (HERSH( 49,K),K=1,4) / 701,2201,2751,2751/
      DATA (HERSH( 50,K),K=1,4) / 702,2202,2752,2752/
      DATA (HERSH( 51,K),K=1,4) / 703,2203,2753,2753/
      DATA (HERSH( 52,K),K=1,4) / 704,2204,2754,2754/
      DATA (HERSH( 53,K),K=1,4) / 705,2205,2755,2755/
      DATA (HERSH( 54,K),K=1,4) / 706,2206,2756,2756/
      DATA (HERSH( 55,K),K=1,4) / 707,2207,2757,2757/
C   56:63 eight nine colon semicolon less equal greater question
      DATA (HERSH( 56,K),K=1,4) / 708,2208,2758,2758/
      DATA (HERSH( 57,K),K=1,4) / 709,2209,2759,2759/
      DATA (HERSH( 58,K),K=1,4) / 712,2212,2762,2762/
      DATA (HERSH( 59,K),K=1,4) / 713,2213,2763,2763/
      DATA (HERSH( 60,K),K=1,4) /2241,2241,2241,2241/
      DATA (HERSH( 61,K),K=1,4) / 726,2238,2776,2776/
      DATA (HERSH( 62,K),K=1,4) /2242,2242,2242,2242/
      DATA (HERSH( 63,K),K=1,4) / 715,2215,2765,2765/
C   64:71 at A B C D E F G
      DATA (HERSH( 64,K),K=1,4) /2273,2273,2273,2273/
      DATA (HERSH( 65,K),K=1,4) / 501,2001,2051,2551/
      DATA (HERSH( 66,K),K=1,4) / 502,2002,2052,2552/
      DATA (HERSH( 67,K),K=1,4) / 503,2003,2053,2553/
      DATA (HERSH( 68,K),K=1,4) / 504,2004,2054,2554/
      DATA (HERSH( 69,K),K=1,4) / 505,2005,2055,2555/
      DATA (HERSH( 70,K),K=1,4) / 506,2006,2056,2556/
      DATA (HERSH( 71,K),K=1,4) / 507,2007,2057,2557/
C   72:79 H I J K L M N O
      DATA (HERSH( 72,K),K=1,4) / 508,2008,2058,2558/
      DATA (HERSH( 73,K),K=1,4) / 509,2009,2059,2559/
      DATA (HERSH( 74,K),K=1,4) / 510,2010,2060,2560/
      DATA (HERSH( 75,K),K=1,4) / 511,2011,2061,2561/
      DATA (HERSH( 76,K),K=1,4) / 512,2012,2062,2562/
      DATA (HERSH( 77,K),K=1,4) / 513,2013,2063,2563/
      DATA (HERSH( 78,K),K=1,4) / 514,2014,2064,2564/
      DATA (HERSH( 79,K),K=1,4) / 515,2015,2065,2565/
C   80:87 P Q R S T U V W
      DATA (HERSH( 80,K),K=1,4) / 516,2016,2066,2566/
      DATA (HERSH( 81,K),K=1,4) / 517,2017,2067,2567/
      DATA (HERSH( 82,K),K=1,4) / 518,2018,2068,2568/
      DATA (HERSH( 83,K),K=1,4) / 519,2019,2069,2569/
      DATA (HERSH( 84,K),K=1,4) / 520,2020,2070,2570/
      DATA (HERSH( 85,K),K=1,4) / 521,2021,2071,2571/
      DATA (HERSH( 86,K),K=1,4) / 522,2022,2072,2572/
      DATA (HERSH( 87,K),K=1,4) / 523,2023,2073,2573/
C   88:95 X Y Z bracketleft 
C         backslash bracketright asciicircum underscore
      DATA (HERSH( 88,K),K=1,4) / 524,2024,2074,2574/
      DATA (HERSH( 89,K),K=1,4) / 525,2025,2075,2575/
      DATA (HERSH( 90,K),K=1,4) / 526,2026,2076,2576/
      DATA (HERSH( 91,K),K=1,4) /2223,2223,2223,2223/
      DATA (HERSH( 92,K),K=1,4) / 804, 804, 804, 804/
      DATA (HERSH( 93,K),K=1,4) /2224,2224,2224,2224/
      DATA (HERSH( 94,K),K=1,4) / 718,2218,2779,2779/
      DATA (HERSH( 95,K),K=1,4) / 590, 590, 590, 590/
C   96:103 quoteleft a b c d e f g
      DATA (HERSH( 96,K),K=1,4) /2249,2249,2249,2249/
      DATA (HERSH( 97,K),K=1,4) / 601,2101,2151,2651/
      DATA (HERSH( 98,K),K=1,4) / 602,2102,2152,2652/
      DATA (HERSH( 99,K),K=1,4) / 603,2103,2153,2653/
      DATA (HERSH(100,K),K=1,4) / 604,2104,2154,2654/
      DATA (HERSH(101,K),K=1,4) / 605,2105,2155,2655/
      DATA (HERSH(102,K),K=1,4) / 606,2106,2156,2656/
      DATA (HERSH(103,K),K=1,4) / 607,2107,2157,2657/
C  104:111 h i j k l m n o
      DATA (HERSH(104,K),K=1,4) / 608,2108,2158,2658/
      DATA (HERSH(105,K),K=1,4) / 609,2109,2159,2659/
      DATA (HERSH(106,K),K=1,4) / 610,2110,2160,2660/
      DATA (HERSH(107,K),K=1,4) / 611,2111,2161,2661/
      DATA (HERSH(108,K),K=1,4) / 612,2112,2162,2662/
      DATA (HERSH(109,K),K=1,4) / 613,2113,2163,2663/
      DATA (HERSH(110,K),K=1,4) / 614,2114,2164,2664/
      DATA (HERSH(111,K),K=1,4) / 615,2115,2165,2665/
C  112:119 p q r s t u v w
      DATA (HERSH(112,K),K=1,4) / 616,2116,2166,2666/
      DATA (HERSH(113,K),K=1,4) / 617,2117,2167,2667/
      DATA (HERSH(114,K),K=1,4) / 618,2118,2168,2668/
      DATA (HERSH(115,K),K=1,4) / 619,2119,2169,2669/
      DATA (HERSH(116,K),K=1,4) / 620,2120,2170,2670/
      DATA (HERSH(117,K),K=1,4) / 621,2121,2171,2671/
      DATA (HERSH(118,K),K=1,4) / 622,2122,2172,2672/
      DATA (HERSH(119,K),K=1,4) / 623,2123,2173,2673/
C  120:127 x y z braceleft bar braceright asciitilde -
      DATA (HERSH(120,K),K=1,4) / 624,2124,2174,2674/
      DATA (HERSH(121,K),K=1,4) / 625,2125,2175,2675/
      DATA (HERSH(122,K),K=1,4) / 626,2126,2176,2676/
      DATA (HERSH(123,K),K=1,4) /2225,2225,2225,2225/
      DATA (HERSH(124,K),K=1,4) / 723,2229,2229,2229/
      DATA (HERSH(125,K),K=1,4) /2226,2226,2226,2226/
      DATA (HERSH(126,K),K=1,4) /2246,2246,2246,2246/
      DATA (HERSH(127,K),K=1,4) / 699,2199,2199,2199/
C
C ISO Latin-1 upper half.
C
C  128:135 - - - - - - - -
      DATA (HERSH(128,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(129,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(130,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(131,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(132,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(133,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(134,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(135,K),K=1,4) / 699,2199,2199,2199/
C  136:143 - - - - - - - -
      DATA (HERSH(136,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(137,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(138,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(139,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(140,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(141,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(142,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(143,K),K=1,4) / 699,2199,2199,2199/
C   144:151 dotlessi grave acute circumflex tilde - breve dotaccent
      DATA (HERSH(144,K),K=1,4) / 699,2182,2196,2199/
      DATA (HERSH(145,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(146,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(147,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(148,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(149,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(150,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(151,K),K=1,4) / 699,2199,2199,2199/
C   152:159 dieresis - ring - - - - -
      DATA (HERSH(152,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(153,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(154,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(155,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(156,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(157,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(158,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(159,K),K=1,4) / 699,2199,2199,2199/
C   160:167 space exclamdown cent sterling currency yen brokenbar section
      DATA (HERSH(160,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(161,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(162,K),K=1,4) / 910, 910, 910, 910/
      DATA (HERSH(163,K),K=1,4) / 272, 272, 272, 272/
      DATA (HERSH(164,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(165,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(166,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(167,K),K=1,4) /2276,2276,2276,2276/
C   168:175 - copyright - - - - registered -
      DATA (HERSH(168,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(169,K),K=1,4) / 274, 274, 274, 274/
      DATA (HERSH(170,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(171,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(172,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(173,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(174,K),K=1,4) / 273, 273, 273, 273/
      DATA (HERSH(175,K),K=1,4) / 699,2199,2199,2199/
C   176:183 degree plusminus twosuperior threesuperior
C           acute mu paragraph periodcentered
      DATA (HERSH(176,K),K=1,4) / 718,2218,2779,2779/
      DATA (HERSH(177,K),K=1,4) /2233,2233,2233,2233/
      DATA (HERSH(178,K),K=1,4) / 702,2202,2752,2752/
      DATA (HERSH(179,K),K=1,4) / 703,2203,2753,2753/
      DATA (HERSH(180,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(181,K),K=1,4) / 638,2138,2138,2138/
      DATA (HERSH(182,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(183,K),K=1,4) / 729, 729, 729, 729/
C   184:191 cedilla onesuperior ordmasculine guillemotright
C           onequarter onehalf threequarters questiondown
      DATA (HERSH(184,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(185,K),K=1,4) / 701,2201,2751,2751/
      DATA (HERSH(186,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(187,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(188,K),K=1,4) / 270, 270, 270, 270/
      DATA (HERSH(189,K),K=1,4) / 261, 261, 261, 261/
      DATA (HERSH(190,K),K=1,4) / 271, 271, 271, 271/
      DATA (HERSH(191,K),K=1,4) / 699,2199,2199,2199/
C   192:199 Agrave Aacute Acircumflex Atilde Aring AE Ccedilla
      DATA (HERSH(192,K),K=1,4) / 501,2001,2051,2551/
      DATA (HERSH(193,K),K=1,4) / 501,2001,2051,2551/
      DATA (HERSH(194,K),K=1,4) / 501,2001,2051,2551/
      DATA (HERSH(195,K),K=1,4) / 501,2001,2051,2551/
      DATA (HERSH(196,K),K=1,4) / 501,2001,2051,2551/
      DATA (HERSH(197,K),K=1,4) / 501,2078,2051,2551/
      DATA (HERSH(198,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(199,K),K=1,4) / 503,2003,2053,2553/
C   200:207 Egrave Eacute Ecircumflex Edieresis 
C           Igrave Iacute Icircumflex Idieresis
      DATA (HERSH(200,K),K=1,4) / 505,2005,2055,2555/
      DATA (HERSH(201,K),K=1,4) / 505,2005,2055,2555/
      DATA (HERSH(202,K),K=1,4) / 505,2005,2055,2555/
      DATA (HERSH(203,K),K=1,4) / 505,2005,2055,2555/
      DATA (HERSH(204,K),K=1,4) / 509,2009,2059,2559/
      DATA (HERSH(205,K),K=1,4) / 509,2009,2059,2559/
      DATA (HERSH(206,K),K=1,4) / 509,2009,2059,2559/
      DATA (HERSH(207,K),K=1,4) / 509,2009,2059,2559/
C   208:215 Eth Ntilde Ograve Oacute 
C           Ocircumflex Otilde Odieresis multiply
      DATA (HERSH(208,K),K=1,4) / 504,2004,2054,2554/
      DATA (HERSH(209,K),K=1,4) / 514,2014,2064,2564/
      DATA (HERSH(210,K),K=1,4) / 515,2015,2065,2565/
      DATA (HERSH(211,K),K=1,4) / 515,2015,2065,2565/
      DATA (HERSH(212,K),K=1,4) / 515,2015,2065,2565/
      DATA (HERSH(213,K),K=1,4) / 515,2015,2065,2565/
      DATA (HERSH(214,K),K=1,4) / 515,2015,2065,2565/
      DATA (HERSH(215,K),K=1,4) /2235,2235,2235,2235/
C   216:223 Oslash Ugrave Uacute Ucircumflex
C           Udieresis Yacute Thorn germandbls
      DATA (HERSH(216,K),K=1,4) / 515,2015,2065,2565/
      DATA (HERSH(217,K),K=1,4) / 521,2021,2071,2571/
      DATA (HERSH(218,K),K=1,4) / 521,2021,2071,2571/
      DATA (HERSH(219,K),K=1,4) / 521,2021,2071,2571/
      DATA (HERSH(220,K),K=1,4) / 521,2021,2071,2571/
      DATA (HERSH(221,K),K=1,4) / 525,2025,2075,2575/
      DATA (HERSH(222,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(223,K),K=1,4) / 699,2199,2199,2199/
C   224:231 agrave aacute acircumflex atilde aring ae ccedilla
      DATA (HERSH(224,K),K=1,4) / 601,2101,2151,2651/
      DATA (HERSH(225,K),K=1,4) / 601,2101,2151,2651/
      DATA (HERSH(226,K),K=1,4) / 601,2101,2151,2651/
      DATA (HERSH(227,K),K=1,4) / 601,2101,2151,2651/
      DATA (HERSH(228,K),K=1,4) / 601,2101,2151,2651/
      DATA (HERSH(229,K),K=1,4) / 601,2101,2151,2651/
      DATA (HERSH(230,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(231,K),K=1,4) / 603,2103,2153,2653/
C   232:239 egrave eacute ecircumflex edieresis 
C           igrave iacute icircumflex idieresis
      DATA (HERSH(232,K),K=1,4) / 605,2105,2155,2655/
      DATA (HERSH(233,K),K=1,4) / 605,2105,2155,2655/
      DATA (HERSH(234,K),K=1,4) / 605,2105,2155,2655/
      DATA (HERSH(235,K),K=1,4) / 605,2105,2155,2655/
      DATA (HERSH(236,K),K=1,4) / 609,2109,2159,2659/
      DATA (HERSH(237,K),K=1,4) / 609,2109,2159,2659/
      DATA (HERSH(238,K),K=1,4) / 609,2109,2159,2659/
      DATA (HERSH(239,K),K=1,4) / 609,2109,2159,2659/
C   240:247 eth ntilde ograve oacute 
C           ocircumflex otilde odieresis divide
      DATA (HERSH(240,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(241,K),K=1,4) / 614,2114,2164,2664/
      DATA (HERSH(242,K),K=1,4) / 615,2115,2165,2665/
      DATA (HERSH(243,K),K=1,4) / 615,2115,2165,2665/
      DATA (HERSH(244,K),K=1,4) / 615,2115,2165,2665/
      DATA (HERSH(245,K),K=1,4) / 615,2115,2165,2665/
      DATA (HERSH(246,K),K=1,4) / 615,2115,2165,2665/
      DATA (HERSH(247,K),K=1,4) /2237,2237,2237,2237/
C   248:255 oslash ugrave uacute ucircumflex
C           udieresis yacute thorn ydieresis
      DATA (HERSH(248,K),K=1,4) / 615,2115,2165,2665/
      DATA (HERSH(249,K),K=1,4) / 621,2121,2171,2671/
      DATA (HERSH(250,K),K=1,4) / 621,2121,2171,2671/
      DATA (HERSH(251,K),K=1,4) / 621,2121,2171,2671/
      DATA (HERSH(252,K),K=1,4) / 621,2121,2171,2671/
      DATA (HERSH(253,K),K=1,4) / 625,2125,2175,2675/
      DATA (HERSH(254,K),K=1,4) / 699,2199,2199,2199/
      DATA (HERSH(255,K),K=1,4) / 625,2125,2175,2675/
C
C Greek alphabet.
C
      DATA (HERSH(256,K),K=1,4) / 527,2027,2027,2027/
      DATA (HERSH(257,K),K=1,4) / 528,2028,2028,2028/
      DATA (HERSH(258,K),K=1,4) / 529,2029,2029,2029/
      DATA (HERSH(259,K),K=1,4) / 530,2030,2030,2030/
      DATA (HERSH(260,K),K=1,4) / 531,2031,2031,2031/
      DATA (HERSH(261,K),K=1,4) / 532,2032,2032,2032/
      DATA (HERSH(262,K),K=1,4) / 533,2033,2033,2033/
      DATA (HERSH(263,K),K=1,4) / 534,2034,2034,2034/
      DATA (HERSH(264,K),K=1,4) / 535,2035,2035,2035/
      DATA (HERSH(265,K),K=1,4) / 536,2036,2036,2036/
      DATA (HERSH(266,K),K=1,4) / 537,2037,2037,2037/
      DATA (HERSH(267,K),K=1,4) / 538,2038,2038,2038/
      DATA (HERSH(268,K),K=1,4) / 539,2039,2039,2039/
      DATA (HERSH(269,K),K=1,4) / 540,2040,2040,2040/
      DATA (HERSH(270,K),K=1,4) / 541,2041,2041,2041/
      DATA (HERSH(271,K),K=1,4) / 542,2042,2042,2042/
      DATA (HERSH(272,K),K=1,4) / 543,2043,2043,2043/
      DATA (HERSH(273,K),K=1,4) / 544,2044,2044,2044/
      DATA (HERSH(274,K),K=1,4) / 545,2045,2045,2045/
      DATA (HERSH(275,K),K=1,4) / 546,2046,2046,2046/
      DATA (HERSH(276,K),K=1,4) / 547,2047,2047,2047/
      DATA (HERSH(277,K),K=1,4) / 548,2048,2048,2048/
      DATA (HERSH(278,K),K=1,4) / 549,2049,2049,2049/
      DATA (HERSH(279,K),K=1,4) / 550,2050,2050,2050/
      DATA (HERSH(280,K),K=1,4) / 627,2127,2127,2127/
      DATA (HERSH(281,K),K=1,4) / 628,2128,2128,2128/
      DATA (HERSH(282,K),K=1,4) / 629,2129,2129,2129/
      DATA (HERSH(283,K),K=1,4) / 630,2130,2130,2130/
      DATA (HERSH(284,K),K=1,4) / 684,2184,2184,2184/
      DATA (HERSH(285,K),K=1,4) / 632,2132,2132,2132/
      DATA (HERSH(286,K),K=1,4) / 633,2133,2133,2133/
      DATA (HERSH(287,K),K=1,4) / 685,2185,2185,2185/
      DATA (HERSH(288,K),K=1,4) / 635,2135,2135,2135/
      DATA (HERSH(289,K),K=1,4) / 636,2136,2136,2136/
      DATA (HERSH(290,K),K=1,4) / 637,2137,2137,2137/
      DATA (HERSH(291,K),K=1,4) / 638,2138,2138,2138/
      DATA (HERSH(292,K),K=1,4) / 639,2139,2139,2139/
      DATA (HERSH(293,K),K=1,4) / 640,2140,2140,2140/
      DATA (HERSH(294,K),K=1,4) / 641,2141,2141,2141/
      DATA (HERSH(295,K),K=1,4) / 642,2142,2142,2142/
      DATA (HERSH(296,K),K=1,4) / 643,2143,2143,2143/
      DATA (HERSH(297,K),K=1,4) / 644,2144,2144,2144/
      DATA (HERSH(298,K),K=1,4) / 645,2145,2145,2145/
      DATA (HERSH(299,K),K=1,4) / 646,2146,2146,2146/
      DATA (HERSH(300,K),K=1,4) / 686,2186,2186,2186/
      DATA (HERSH(301,K),K=1,4) / 648,2148,2148,2148/
      DATA (HERSH(302,K),K=1,4) / 649,2149,2149,2149/
      DATA (HERSH(303,K),K=1,4) / 650,2150,2150,2150/
C
      IF ((CODE.LT.0) .OR. (CODE.GT.303)) THEN
          I = 1
      ELSE
          I = CODE
      END IF
      SYMBOL = HERSH(I,FONT)
C
      END
#<

#>            grsyxd.dc3
Name:         GRSYXD

Purpose:      obtain the polyline representation of a given symbol

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRSYXD (SYMBOL, XYGRID, UNUSED)
            INTEGER SYMBOL
            INTEGER XYGRID(300)
            LOGICAL UNUSED
      
       Return the digitization coordinates of a character. Each character is
       defined on a grid with X and Y coordinates in the range (-49,49), 
       with the origin (0,0) at the center of the character.  The coordinate
       system is right-handed, with X positive to the right, and Y positive
       upward.  
      
       Arguments:
        SYMBOL (input)  : symbol number in range (1..3000).
        XYGRID (output) : height range, width range, and pairs of (x,y)
                          coordinates returned.  Height range = (XYGRID(1),
                          XYGRID(3)).  Width range = (XYGRID(4),XYGRID(5)).
                          (X,Y) = (XYGRID(K),XYGRID(K+1)) (K=6,8,...).
        UNUSED (output) : receives .TRUE. if SYMBOL is an unused symbol
                          number. A character of normal height and zero width
                          is returned. Receives .FALSE. if SYMBOL is a 
                          valid symbol number.
       
       The height range consists of 3 values: (minimum Y, baseline Y,
       maximum Y).  The first is reached by descenders on lower-case g, p,
       q, and y.  The second is the bottom of upper-case letters.  The third
       is the top of upper-case letters.  A coordinate pair (-64,0) requests
       a pen raise, and a pair (-64,-64) terminates the coordinate list. It
       is assumed that movement to the first coordinate position will be
       done with the pen raised - no raise command is explicitly included to
       do this. 

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grsyxd.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRSYXD -- obtain the polyline representation of a given symbol
C+
      SUBROUTINE GRSYXD (SYMBOL, XYGRID, UNUSED)
      INTEGER SYMBOL
      INTEGER XYGRID(300)
      LOGICAL UNUSED
C
C Return the digitization coordinates of a character. Each character is
C defined on a grid with X and Y coordinates in the range (-49,49), 
C with the origin (0,0) at the center of the character.  The coordinate
C system is right-handed, with X positive to the right, and Y positive
C upward.  
C
C Arguments:
C  SYMBOL (input)  : symbol number in range (1..3000).
C  XYGRID (output) : height range, width range, and pairs of (x,y)
C                    coordinates returned.  Height range = (XYGRID(1),
C                    XYGRID(3)).  Width range = (XYGRID(4),XYGRID(5)).
C                    (X,Y) = (XYGRID(K),XYGRID(K+1)) (K=6,8,...).
C  UNUSED (output) : receives .TRUE. if SYMBOL is an unused symbol
C                    number. A character of normal height and zero width
C                    is returned. Receives .FALSE. if SYMBOL is a 
C                    valid symbol number.
C 
C The height range consists of 3 values: (minimum Y, baseline Y,
C maximum Y).  The first is reached by descenders on lower-case g, p,
C q, and y.  The second is the bottom of upper-case letters.  The third
C is the top of upper-case letters.  A coordinate pair (-64,0) requests
C a pen raise, and a pair (-64,-64) terminates the coordinate list. It
C is assumed that movement to the first coordinate position will be
C done with the pen raised - no raise command is explicitly included to
C do this. 
C--
C  7-Mar-1983.
C 15-Dec-1988 - standardize.
C-----------------------------------------------------------------------
      INTEGER*2    BUFFER(27000)
      INTEGER      INDEX(3000), IX, IY, K, L, LOCBUF
      INTEGER      NC1, NC2
      COMMON       /GRSYMB/ NC1, NC2, INDEX, BUFFER
C
C Extract digitization.
C
      IF (SYMBOL.LT.NC1 .OR. SYMBOL.GT.NC2) GOTO 3000
      L = SYMBOL - NC1 + 1
      LOCBUF = INDEX(L)
      IF (LOCBUF .EQ. 0) GOTO 3000
      XYGRID(1) = BUFFER(LOCBUF)
      LOCBUF = LOCBUF + 1
      K = 2
      IY = -1
C     -- DO WHILE (IY.NE.-64)
  100 IF (IY.NE.-64) THEN
          IX = BUFFER(LOCBUF)/128
          IY = BUFFER(LOCBUF) - 128*IX - 64
          XYGRID(K) = IX - 64
          XYGRID(K+1) = IY
          K = K + 2
          LOCBUF = LOCBUF + 1
      GOTO 100
      END IF
C     -- end DO WHILE
      UNUSED = .FALSE.
      RETURN
C
C Unimplemented character.
C
3000  XYGRID(1) = -16
      XYGRID(2) =  -9
      XYGRID(3) = +12
      XYGRID(4) =   0
      XYGRID(5) =   0
      XYGRID(6) = -64
      XYGRID(7) = -64
      UNUSED = .TRUE.
      RETURN
      END
#<

#>            grterm.dc3
Name:         GRTERM

Purpose:      flush buffer to output device

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRTERM
      
       GRPCKG: flush the buffer associated with the current plot. GRTERM
       should be called only when it is necessary to make sure that all the
       graphics created up to this point in the program are visible on the
       device, e.g., before beginning a dialog with the user. GRTERM has no
       effect on hardcopy devices.
      
       Arguments: none.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grterm.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRTERM -- flush buffer to output device
C+
      SUBROUTINE GRTERM
C
C GRPCKG: flush the buffer associated with the current plot. GRTERM
C should be called only when it is necessary to make sure that all the
C graphics created up to this point in the program are visible on the
C device, e.g., before beginning a dialog with the user. GRTERM has no
C effect on hardcopy devices.
C
C Arguments: none.
C--
C  6-Oct-1983
C 29-Jan-1985 - add HP2648 device [KS/TJP].
C 31-Dec-1985 - do not send CAN code to true Tek [TJP/PCP].
C  5-Aug-1986 - add GREXEC support [AFT].
C 11-Jun-1987 - remove built-in devices [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER NBUF,LCHR
      REAL    RBUF(6)
      CHARACTER CHR
C
      IF (GRCIDE.GE.1) THEN
          CALL GREXEC(GRGTYP,16,RBUF,NBUF,CHR,LCHR)
      END IF
      END
#<

#>            grtext.dc3
Name:         GRTEXT

Purpose:      draw text

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRTEXT (CENTER,ORIENT,ABSXY,X0,Y0,STRING)
      
       GRPCKG: Write a text string using the high-quality character set.
       The text is NOT windowed in the current viewport, but may extend over
       the whole view surface.  Line attributes (color, intensity thickness)
       apply to text, but line-style is ignored.  The current pen position
       after a call to GRTEXT is undefined.
      
       Arguments:
      
       STRING (input, character): the character string to be plotted. This
             may include standard escape-sequences to represent non-ASCII
             characters and special commands. The number of characters in
             STRING (i.e., LEN(STRING)) should not exceed 256.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grtext.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRTEXT -- draw text
C+
      SUBROUTINE GRTEXT (CENTER,ORIENT,ABSXY,X0,Y0,STRING)
C
C GRPCKG: Write a text string using the high-quality character set.
C The text is NOT windowed in the current viewport, but may extend over
C the whole view surface.  Line attributes (color, intensity thickness)
C apply to text, but line-style is ignored.  The current pen position
C after a call to GRTEXT is undefined.
C
C Arguments:
C
C STRING (input, character): the character string to be plotted. This
C       may include standard escape-sequences to represent non-ASCII
C       characters and special commands. The number of characters in
C       STRING (i.e., LEN(STRING)) should not exceed 256.
C--
C (3-May-1983)
C  5-Aug-1986 - add GREXEC support [AFT].
C  6-Sep-1989 - standardize [TJP].
C 20-Apr-1995 - Verbose PS file support.  If PGPLOT_PS_VERBOSE_TEXT is
C               defined, text strings in PS files are preceded by a 
C               comment with the text of the string plotted as vectors
C               [TJP after D.S.Briggs].
C  4-Feb-1997 - grexec requires an RBUF array, not a scalar [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      LOGICAL ABSXY,UNUSED,VISBLE,CENTER
      INTEGER XYGRID(300)
      INTEGER LIST(256)
      CHARACTER*(*) STRING
      REAL ANGLE, FACTOR, FNTBAS, FNTFAC, COSA, SINA, DX, DY, XORG, YORG
      REAL XCUR, YCUR, ORIENT, RATIO, X0, Y0, RLX, RLY
      REAL XMIN, XMAX, YMIN, YMAX
      REAL RBUF(6)
      INTEGER I, IFNTLV,NLIST,LX,LY, K, LXLAST,LYLAST, LSTYLE
      INTEGER SLEN, GRTRIM
      INTRINSIC ABS, COS, LEN, MIN, SIN
      CHARACTER DEVTYP*14, STEMP*258
      LOGICAL DEVINT, VTEXT
C
C Check that there is something to be plotted.
C
      IF (LEN(STRING).LE.0) RETURN
C
C Check that a device is selected.
C
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRTEXT - no graphics device is active.')
          RETURN
      END IF
C
C Save current line-style, and set style "normal".
C
      CALL GRQLS(LSTYLE)
      CALL GRSLS(1)
C
C Put device dependent code here or at end
C
      VTEXT = .FALSE.
      CALL GRQTYP (DEVTYP, DEVINT)
      IF ((DEVTYP.EQ.'PS').OR.(DEVTYP.EQ.'VPS').OR.
     1    (DEVTYP.EQ.'CPS').OR.(DEVTYP.EQ.'VCPS')) THEN
         CALL GRGENV ('PS_VERBOSE_TEXT', STEMP, I)
         VTEXT = (I.GT.0)
         IF (VTEXT) THEN
            SLEN = GRTRIM(STRING)
            STEMP = '% Start "' // STRING(1:SLEN) // '"'
            CALL GREXEC (GRGTYP, 23, RBUF, 0, STEMP, SLEN+10)
         END IF
      END IF
C
C Save current viewport, and open the viewport to include the full
C view surface.
C
      XORG = GRXPRE(GRCIDE)
      YORG = GRYPRE(GRCIDE)
      XMIN = GRXMIN(GRCIDE)
      XMAX = GRXMAX(GRCIDE)
      YMIN = GRYMIN(GRCIDE)
      YMAX = GRYMAX(GRCIDE)
      CALL GRAREA(GRCIDE, 0.0, 0.0, 0.0, 0.0)
C
C Compute scaling and orientation.
C
      ANGLE = ORIENT*(3.14159265359/180.)
      FACTOR = GRCFAC(GRCIDE)/2.5
      RATIO = GRPXPI(GRCIDE)/GRPYPI(GRCIDE)
      COSA = FACTOR * COS(ANGLE)
      SINA = FACTOR * SIN(ANGLE)
      CALL GRTXY0(ABSXY, X0, Y0, XORG, YORG)
      FNTBAS = 0.0
      FNTFAC = 1.0
      IFNTLV = 0
      DX = 0.0
      DY = 0.0
C
C Convert the string to a list of symbol numbers; to prevent overflow
C of array LIST, the length of STRING is limited to 256 characters.
C
      CALL GRSYDS(LIST,NLIST,STRING(1:MIN(256,LEN(STRING))),
     1             GRCFNT(GRCIDE))
C
C Plot the string of characters
C
      DO 380 I = 1,NLIST
          IF (LIST(I).LT.0) THEN
              IF (LIST(I).EQ.-1) THEN
C                 ! up
                  IFNTLV = IFNTLV+1
                  FNTBAS = FNTBAS + 16.0*FNTFAC
                  FNTFAC = 0.75**ABS(IFNTLV)
              ELSE IF (LIST(I).EQ.-2) THEN
C                 ! down
                  IFNTLV = IFNTLV-1
                  FNTFAC = 0.75**ABS(IFNTLV)
                  FNTBAS = FNTBAS - 16.0*FNTFAC
              ELSE IF (LIST(I).EQ.-3) THEN
C                 ! backspace
                  XORG = XORG - DX*FNTFAC
                  YORG = YORG - DY*FNTFAC
              END IF
              GOTO 380
          END IF
          CALL GRSYXD(LIST(I),XYGRID,UNUSED)
          VISBLE = .FALSE.
          LX = XYGRID(5)-XYGRID(4)
          DX = COSA*LX*RATIO
          DY = SINA*LX
          K = 4
          LXLAST = -64
          LYLAST = -64
  320     K = K+2
          LX = XYGRID(K)
          LY = XYGRID(K+1)
          IF (LY.EQ.-64) GOTO 330
          IF (LX.EQ.-64) THEN
              VISBLE = .FALSE.
          ELSE
              RLX = (LX - XYGRID(4))*FNTFAC
              RLY = (LY - XYGRID(2))*FNTFAC + FNTBAS
              IF ((LX.NE.LXLAST) .OR. (LY.NE.LYLAST)) THEN
                  XCUR = XORG + (COSA*RLX - SINA*RLY)*RATIO
                  YCUR = YORG + (SINA*RLX + COSA*RLY)
                  IF (VISBLE) THEN
                      CALL GRLIN0(XCUR,YCUR)
                  ELSE
                      GRXPRE(GRCIDE) = XCUR
                      GRYPRE(GRCIDE) = YCUR
                  END IF
              END IF
              VISBLE = .TRUE.
              LXLAST = LX
              LYLAST = LY
          END IF
          GOTO 320
  330     XORG = XORG + DX*FNTFAC
          YORG = YORG + DY*FNTFAC
  380 CONTINUE
C
C Set pen position ready for next character.
C
      GRXPRE(GRCIDE) = XORG
      GRYPRE(GRCIDE) = YORG
C
C Another possible device dependent section
C
      IF (VTEXT) THEN
         STEMP = '% End "' // STRING(1:SLEN) // '"'
         CALL GREXEC(GRGTYP, 23, RBUF, 0, STEMP, SLEN+8)
      END IF
C
C Restore the viewport and line-style, and return.
C
      GRXMIN(GRCIDE) = XMIN
      GRXMAX(GRCIDE) = XMAX
      GRYMIN(GRCIDE) = YMIN
      GRYMAX(GRCIDE) = YMAX
      CALL GRSLS(LSTYLE)
C
      END
#<

#>            grtoup.dc3
Name:         GRTOUP

Purpose:      convert character string to upper case

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRTOUP (DST, SRC)
            CHARACTER*(*) DST, SRC
      
       GRPCKG (internal routine): convert character string to upper case.
      
       Arguments:
        DST    (output) : output string (upper case).
        SRC    (input)  : input string to be converted.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grtoup.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRTOUP -- convert character string to upper case
C+
      SUBROUTINE GRTOUP (DST, SRC)
      CHARACTER*(*) DST, SRC
C
C GRPCKG (internal routine): convert character string to upper case.
C
C Arguments:
C  DST    (output) : output string (upper case).
C  SRC    (input)  : input string to be converted.
C--
C 1988-Jan-18 (TJP)
C-----------------------------------------------------------------------
      INTEGER I, N, NCHI, NCHO, NCH
      NCHI = LEN(SRC)
      NCHO = LEN(DST)
      NCH = MIN(NCHI, NCHO)
      DO 10 I=1,NCH
          N = ICHAR(SRC(I:I))
          IF ((N .GE. 97) .AND. (N .LE. 122)) THEN
              DST(I:I) = CHAR(N - 32)
          ELSE
              DST(I:I) = CHAR(N)
          END IF
   10 CONTINUE
      IF (NCHO .GT. NCHI) DST(NCHI+1:NCHO) = ' '
      END
#<

#>            grtran.dc3
Name:         GRTRAN

Purpose:      define scaling transformation

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRTRAN (IDENT,XORG,YORG,XSCALE,YSCALE)
      
       GRPCKG (internal routine): Define scaling transformation.
      
       Arguments:
      
       IDENT (input, integer): plot identifier, as returned by GROPEN.
       XORG, YORG, XSCALE, YSCALE (input, real): parameters of the scaling
             transformation. This is defined by:
                     XABS = XORG + XWORLD * XSCALE,
                     YABS = YORG + YWORLD * YSCALE,
             where (XABS, YABS) are the absolute device coordinates
             corresponding to world coordinates (XWORLD, YWORLD).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grtran.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRTRAN -- define scaling transformation
C+
      SUBROUTINE GRTRAN (IDENT,XORG,YORG,XSCALE,YSCALE)
C
C GRPCKG (internal routine): Define scaling transformation.
C
C Arguments:
C
C IDENT (input, integer): plot identifier, as returned by GROPEN.
C XORG, YORG, XSCALE, YSCALE (input, real): parameters of the scaling
C       transformation. This is defined by:
C               XABS = XORG + XWORLD * XSCALE,
C               YABS = YORG + YWORLD * YSCALE,
C       where (XABS, YABS) are the absolute device coordinates
C       corresponding to world coordinates (XWORLD, YWORLD).
C--
C (1-Feb-1983)
C-----------------------------------------------------------------------
      INTEGER  IDENT
      REAL     XORG, YORG, XSCALE, YSCALE
C
      CALL GRSLCT(IDENT)
      CALL GRTRN0(XORG, YORG, XSCALE, YSCALE)
C
      END
#<

#>            grtrim.dc3
Name:         GRTRIM

Purpose:      length of string excluding trailing blanks

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            INTEGER FUNCTION GRTRIM(S)
            CHARACTER*(*) S
      
       Find the length of a character string excluding trailing blanks.
       A blank string returns a value of 0.
      
       Argument:
        S      (input)  : character string.
      
       Returns:
        GRTRIM          : number of characters in S, excluding trailing
                          blanks, in range 0...LEN(S). A blank string
                          returns a value of 0.
      
       Subroutines required:
        None
      
       Fortran 77 extensions:
        None
      
       History:
        1987 Nov 12 - TJP.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grtrim.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRTRIM -- length of string excluding trailing blanks
C+
      INTEGER FUNCTION GRTRIM(S)
      CHARACTER*(*) S
C
C Find the length of a character string excluding trailing blanks.
C A blank string returns a value of 0.
C
C Argument:
C  S      (input)  : character string.
C
C Returns:
C  GRTRIM          : number of characters in S, excluding trailing
C                    blanks, in range 0...LEN(S). A blank string
C                    returns a value of 0.
C
C Subroutines required:
C  None
C
C Fortran 77 extensions:
C  None
C
C History:
C  1987 Nov 12 - TJP.
C-----------------------------------------------------------------------
      INTEGER  I
C
      IF (S.EQ.' ') THEN
          GRTRIM = 0
      ELSE
          DO 10 I=LEN(S),1,-1
              GRTRIM = I
              IF (S(I:I).NE.' ') GOTO 20
   10     CONTINUE
          GRTRIM = 0
   20     CONTINUE
      END IF
      END
#<

#>            grtrml.dc3
Name:         grtrml

Purpose:      get name of user's terminal (UNIX)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRTRML(STRING, L)
            CHARACTER*(*) STRING
            INTEGER L
      
       Return the device name of the user's terminal, if any. In Sun/Convex-UNIX,
       the name of the terminal is always /dev/tty.
      
       Arguments:
        STRING : receives the terminal name, truncated or extended with
                 blanks as necessary.
        L      : receives the number of characters in STRING, excluding
                 trailing blanks. If there is not attached terminal, 
                 zero is returned.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grtrml.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Fri Oct 16, 1998 at 13:32:47. The Fortran code is unmodified.


C*GRTRML -- get name of user's terminal (UNIX)
C+
      SUBROUTINE GRTRML(STRING, L)
      CHARACTER*(*) STRING
      INTEGER L
C
C Return the device name of the user's terminal, if any. In Sun/Convex-UNIX,
C the name of the terminal is always /dev/tty.
C
C Arguments:
C  STRING : receives the terminal name, truncated or extended with
C           blanks as necessary.
C  L      : receives the number of characters in STRING, excluding
C           trailing blanks. If there is not attached terminal, 
C           zero is returned.
C--
C 19-Jan-1988
C-----------------------------------------------------------------------
      STRING = '/dev/tty'
      L = MIN(LEN(STRING),8)
      END
#<

#>            grtrn0.dc3
Name:         GRTRN0

Purpose:      define scaling transformation

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRTRN0 (XORG,YORG,XSCALE,YSCALE)
      
       GRPCKG (internal routine): Define scaling transformation for current
       device (equivalent to GRTRAN without device selection).
      
       Arguments:
      
       XORG, YORG, XSCALE, YSCALE (input, real): parameters of the scaling
             transformation. This is defined by:
                     XABS = XORG + XWORLD * XSCALE,
                     YABS = YORG + YWORLD * YSCALE,
             where (XABS, YABS) are the absolute device coordinates
             corresponding to world coordinates (XWORLD, YWORLD).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grtrn0.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRTRN0 -- define scaling transformation
C+
      SUBROUTINE GRTRN0 (XORG,YORG,XSCALE,YSCALE)
C
C GRPCKG (internal routine): Define scaling transformation for current
C device (equivalent to GRTRAN without device selection).
C
C Arguments:
C
C XORG, YORG, XSCALE, YSCALE (input, real): parameters of the scaling
C       transformation. This is defined by:
C               XABS = XORG + XWORLD * XSCALE,
C               YABS = YORG + YWORLD * YSCALE,
C       where (XABS, YABS) are the absolute device coordinates
C       corresponding to world coordinates (XWORLD, YWORLD).
C--
C  1-Feb-83:
C 11-Feb-92: Add driver support (TJP).
C  1-Sep-94: Suppress driver call (TJP).
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      REAL     XORG, YORG, XSCALE, YSCALE
      REAL           RBUF(6)
      INTEGER        NBUF,LCHR
      CHARACTER*16   CHR
C
      GRXORG(GRCIDE) = XORG
      GRXSCL(GRCIDE) = XSCALE
      GRYORG(GRCIDE) = YORG
      GRYSCL(GRCIDE) = YSCALE
C
C Pass info to device driver?
C
      IF (GRGCAP(GRCIDE)(2:2).EQ.'X') THEN
          RBUF(1) = XORG
          RBUF(2) = XSCALE
          RBUF(3) = YORG
          RBUF(4) = YSCALE
          NBUF = 4
          LCHR = 0
          CALL GREXEC(GRGTYP,27,RBUF,NBUF,CHR,LCHR)
      END IF
C
      END
#<

#>            grtter.dc3
Name:         grtter

Purpose:      test whether device is user's terminal (Sun/Convex-UNIX)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRTTER(STRING, SAME)
            CHARACTER*(*) STRING
            LOGICAL SAME
      
       Return a logical flag indicating whether the supplied device
       name is a name for the user's controlling terminal or not.
       (Some PGPLOT programs wish to take special action if they are
       plotting on the user's terminal.)
      
       Arguments:
        STRING : (input) the device name to be tested.
        SAME   : (output) .TRUE. is STRING contains a valid name for the
                 user's terminal; .FALSE. otherwise.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grtter.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Fri Oct 16, 1998 at 13:32:47. The Fortran code is unmodified.


C*GRTTER -- test whether device is user's terminal (Sun/Convex-UNIX)
C+
      SUBROUTINE GRTTER(STRING, SAME)
      CHARACTER*(*) STRING
      LOGICAL SAME
C
C Return a logical flag indicating whether the supplied device
C name is a name for the user's controlling terminal or not.
C (Some PGPLOT programs wish to take special action if they are
C plotting on the user's terminal.)
C
C Arguments:
C  STRING : (input) the device name to be tested.
C  SAME   : (output) .TRUE. is STRING contains a valid name for the
C           user's terminal; .FALSE. otherwise.
C--
C 18-Feb-1988
C-----------------------------------------------------------------------
      CHARACTER*64 T
      INTEGER L
C
      CALL GRTRML(T, L)
      SAME = (STRING.EQ.T(:L))
      END
#<

#>            grtxy0.dc3
Name:         GRTXY0

Purpose:      convert world coordinates to device coordinates

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRTXY0 (ABSXY,X,Y,XT,YT)
      
       GRPCKG (internal routine): Convert scaled position to absolute
       position.
      
       Arguments:
      
       ABSXY (input, logical): if FALSE, convert world coordinates to
             absolute device coordinates; if TRUE, return the input
             coordinates unchanged.
       X, Y (input, real): input coordinates (absolute or world, depending
             on setting of ABSXY).
       XT, YT (output, real): output absolute device coordinates.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grtxy0.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRTXY0 -- convert world coordinates to device coordinates
C+
      SUBROUTINE GRTXY0 (ABSXY,X,Y,XT,YT)
C
C GRPCKG (internal routine): Convert scaled position to absolute
C position.
C
C Arguments:
C
C ABSXY (input, logical): if FALSE, convert world coordinates to
C       absolute device coordinates; if TRUE, return the input
C       coordinates unchanged.
C X, Y (input, real): input coordinates (absolute or world, depending
C       on setting of ABSXY).
C XT, YT (output, real): output absolute device coordinates.
C--
C (1-Feb-1983)
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      LOGICAL  ABSXY
      REAL     X, Y, XT, YT
C
      IF (ABSXY) THEN
          XT = X
          YT = Y
      ELSE
          XT = X * GRXSCL(GRCIDE) + GRXORG(GRCIDE)
          YT = Y * GRYSCL(GRCIDE) + GRYORG(GRCIDE)
      END IF
C
      END
#<

#>            gruser.c.orig
/*
 **GRUSER -- get user name (POSIX)
 *+
 *     SUBROUTINE GRUSER(STRING, L)
 *     CHARACTER*(*) STRING
 *     INTEGER L
 *
 * Return the name of the user running the program.
 *
 * Arguments:
 *  STRING : receives user name, truncated or extended with
 *           blanks as necessary.
 *  L      : receives the number of characters in VALUE, excluding
 *           trailing blanks.
 *--
 * 08-Nov-1994
 *-----------------------------------------------------------------------
 */

#ifdef PG_PPU
#define GRUSER gruser_
#else
#define GRUSER gruser
#endif

char *getlogin();

void GRUSER(string, length, maxlen)
     char *string;
     int *length;
     int maxlen;
{
  int i;
/*
 * Get the login name of the PGPLOT user.
 */
  char *user = getlogin();
/*
 * If the user name is not available substitute an empty string.
 */
  if(!user)
    user = "";
/*
 * Copy the user name to the output string.
 */
  for(i=0; i<maxlen && user[i]; i++)
    string[i] = user[i];
/*
 * Return the un-padded length of the user name string.
 */
  *length = i;
/*
 * Pad to the end of the output string with spaces.
 */
  for( ; i<maxlen; i++)
    string[i] = ' ';
  return;
}
#<

#>            gruser.dc3
Name:         GRUSER

Purpose:      get user name (POSIX)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

           SUBROUTINE GRUSER(STRING, L)
           CHARACTER*(*) STRING
           INTEGER L
      
       Return the name of the user running the program.
      
       Arguments:
        STRING : receives user name, truncated or extended with
                 blanks as necessary.
        L      : receives the number of characters in VALUE, excluding
                 trailing blanks.

Updates:      Oct 16, 1998: JPT document extracted from 5.2.0 source;
                                Fortran source copied from GIPSY's v4.9E.
#<

#>            gruser.f
* GIPSY-modified        
*

C*GRUSER -- get user name (Alliant-UNIX)
C+
      SUBROUTINE GRUSER(STRING, L)
      CHARACTER*(*) STRING
      INTEGER L
C
C Return the name of the user running the program.
C
C Arguments:
C  STRING : receives user name, truncated or extended with
C           blanks as necessary.
C  L      : receives the number of characters in VALUE, excluding
C           trailing blanks.
C--
C 19-Jan-1988
C 23-Oct-1989 ALF. Change to Alliant use of GETLOG.
C-----------------------------------------------------------------------
      INTEGER I
CWZ   CHARACTER*31 GETLOG
C
CWZ   STRING = GETLOG()
      CALL GETLOGNAM(STRING)
      IF (STRING.EQ.' ') THEN
          L = 0
      ELSE
          DO 10 I=LEN(STRING),1,-1
              L = I
              IF (STRING(I:I).NE.' ') GOTO 20
   10     CONTINUE
          L = 0
   20     CONTINUE
      END IF
      END
#<

#>            grvct0.dc3
Name:         GRVCT0

Purpose:      draw line segments or dots

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRVCT0 (MODE,ABSXY,POINTS,X,Y)
      
       GRPCKG (internal routine): Draw a line or a set of dots. This
       is the same as GRVECT, but without device selection. It can be used to
       draw a single line-segment, a continuous series of line segments, or
       one or more single dots (pixels).
      
       Arguments:
      
       MODE (input, integer): if MODE=1, a series of line segments is drawn,
             starting at the current position, moving to X(1),Y(1), ... and
             ending at X(POINTS),Y(POINTS).
             If MODE=2, the first vector is blanked, so the line starts at
             X(1),Y(1).
             If MODE=3, a single dot is placed at each coordinate pair, with
             no connecting lines.
       ABSXY (input, logical): if TRUE, the coordinates are absolute device
             coordinates; if FALSE, they are world coordinates and the
             scaling transformation is applied.
       POINTS (input, integer): the number of coordinate pairs.
       X, Y (input, real arrays, dimensioned POINTS or greater): the
             X and Y coordinates of the points.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grvct0.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRVCT0 -- draw line segments or dots
C+
      SUBROUTINE GRVCT0 (MODE,ABSXY,POINTS,X,Y)
C
C GRPCKG (internal routine): Draw a line or a set of dots. This
C is the same as GRVECT, but without device selection. It can be used to
C draw a single line-segment, a continuous series of line segments, or
C one or more single dots (pixels).
C
C Arguments:
C
C MODE (input, integer): if MODE=1, a series of line segments is drawn,
C       starting at the current position, moving to X(1),Y(1), ... and
C       ending at X(POINTS),Y(POINTS).
C       If MODE=2, the first vector is blanked, so the line starts at
C       X(1),Y(1).
C       If MODE=3, a single dot is placed at each coordinate pair, with
C       no connecting lines.
C ABSXY (input, logical): if TRUE, the coordinates are absolute device
C       coordinates; if FALSE, they are world coordinates and the
C       scaling transformation is applied.
C POINTS (input, integer): the number of coordinate pairs.
C X, Y (input, real arrays, dimensioned POINTS or greater): the
C       X and Y coordinates of the points.
C--
C (1-Feb-1983)
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER  I, MODE, POINTS
      LOGICAL  ABSXY
      REAL     X(POINTS), Y(POINTS), XCUR, YCUR
C
      IF (MODE.EQ.1) THEN
          CALL GRTXY0(ABSXY, X(1), Y(1), XCUR, YCUR)
          CALL GRLIN0(XCUR, YCUR)
      ELSE IF (MODE.EQ.2) THEN
          CALL GRTXY0(ABSXY, X(1), Y(1), GRXPRE(GRCIDE), GRYPRE(GRCIDE))
      END IF
      IF (MODE.EQ.1 .OR. MODE.EQ.2) THEN
          DO 10 I=2,POINTS
              CALL GRTXY0(ABSXY, X(I), Y(I), XCUR, YCUR)
              CALL GRLIN0(XCUR, YCUR)
   10     CONTINUE
      ELSE IF (MODE.EQ.3) THEN
          DO 20 I=1,POINTS
              CALL GRTXY0(ABSXY, X(I), Y(I), XCUR, YCUR)
              CALL GRDOT0(XCUR, YCUR)
   20     CONTINUE
      END IF
C
      END
#<

#>            grvect.dc3
Name:         GRVECT

Purpose:      draw line segments or dots

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRVECT (IDENT,MODE,ABSXY,POINTS,X,Y)
      
       GRPCKG: Draw a line or a set of dots. This routine can be used to
       draw a single line-segment, a continuous series of line segments, or
       one or more single dots (pixels).
      
       Arguments:
      
       IDENT (input, integer): the plot identifier, as returned by GROPEN.
       MODE (input, integer): if MODE=1, a series of line segments is drawn,
             starting at the current position, moving to X(1),Y(1), ... and
             ending at X(POINTS),Y(POINTS).
             If MODE=2, the first vector is blanked, so the line starts at
             X(1),Y(1).
             If MODE=3, a single dot is placed at each coordinate pair, with
             no connecting lines.
       ABSXY (input, logical): if TRUE, the coordinates are absolute device
             coordinates; if FALSE, they are world coordinates and the
             scaling transformation is applied.
       POINTS (input, integer): the number of coordinate pairs.
       X, Y (input, real arrays, dimensioned POINTS or greater): the
             X and Y coordinates of the points.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grvect.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C*GRVECT -- draw line segments or dots
C+
      SUBROUTINE GRVECT (IDENT,MODE,ABSXY,POINTS,X,Y)
C
C GRPCKG: Draw a line or a set of dots. This routine can be used to
C draw a single line-segment, a continuous series of line segments, or
C one or more single dots (pixels).
C
C Arguments:
C
C IDENT (input, integer): the plot identifier, as returned by GROPEN.
C MODE (input, integer): if MODE=1, a series of line segments is drawn,
C       starting at the current position, moving to X(1),Y(1), ... and
C       ending at X(POINTS),Y(POINTS).
C       If MODE=2, the first vector is blanked, so the line starts at
C       X(1),Y(1).
C       If MODE=3, a single dot is placed at each coordinate pair, with
C       no connecting lines.
C ABSXY (input, logical): if TRUE, the coordinates are absolute device
C       coordinates; if FALSE, they are world coordinates and the
C       scaling transformation is applied.
C POINTS (input, integer): the number of coordinate pairs.
C X, Y (input, real arrays, dimensioned POINTS or greater): the
C       X and Y coordinates of the points.
C--
C (1-Feb-1983)
C-----------------------------------------------------------------------
      INTEGER  IDENT, MODE, POINTS
      LOGICAL  ABSXY
      REAL     X(POINTS), Y(POINTS)
C
      CALL GRSLCT(IDENT)
      IF (MODE.LE.0 .OR. MODE.GT.3) THEN
          CALL GRWARN('GRVECT - invalid MODE parameter.')
      ELSE IF (POINTS.GT.0) THEN
          CALL GRVCT0(MODE, ABSXY, POINTS, X, Y)
      END IF
C
      END
#<

#>            grwarn.dc3
Name:         GRWARN

Purpose:      issue warning message to user

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRWARN (TEXT)
            CHARACTER*(*) TEXT
      
       Report a warning message on standard output, with prefix "%PGPLOT, ".
      
       Argument:
        TEXT (input): text of message to be printed (the string
            may not be blank).

Updates:      Oct 16, 1998: JPT document extracted from 5.2.0 source;
                                Fortran source copied from GIPSY's v4.9E.
#<

#>            grwarn.f
* GIPSY-modified
*

C*GRWARN -- issue warning message to user (Sun/Convex-UNIX)
C+
      SUBROUTINE GRWARN (TEXT)
      CHARACTER*(*) TEXT
      CHARACTER*250 KGB
C
C Report a warning message on standard error, with prefix "%PGPLOT, ".
C It is assumed that Fortran unit 0 is attached to stderr.
C
C Argument:
C  TEXT (input): text of message to be printed (the string
C      may not be blank).
C--
C 18-Feb-1988
C 23-Jan-1991 Replaced write( 0 , .. ) by a call to ANYOUT (KGB)
C 14-May-1991 Addapted for DEC crummy Fortran compiler (KGB)
C-----------------------------------------------------------------------
      INTEGER   I
C
      IF (TEXT.NE.' ') THEN
          I = LEN(TEXT)
   10     IF (TEXT(I:I).EQ.' ') THEN
              I = I-1
          GOTO 10
          END IF
CWZ       WRITE (0, '(2A)') '%PGPLOT, ', TEXT(1:I)
          KGB = '%PGPLOT, '// TEXT(1:I)
          CALL ANYOUT( 1, KGB )
      END IF
      END

#<

#>            grwarn.f.orig
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRWARN -- issue warning message to user
C+
      SUBROUTINE GRWARN (TEXT)
      CHARACTER*(*) TEXT
C
C Report a warning message on standard output, with prefix "%PGPLOT, ".
C
C Argument:
C  TEXT (input): text of message to be printed (the string
C      may not be blank).
C--
C  8-Nov-1994 [TJP]
C-----------------------------------------------------------------------
      INTEGER   GRTRIM
C
      IF (TEXT.NE.' ') THEN
          WRITE (*, '(1X,2A)') '%PGPLOT, ', TEXT(1:GRTRIM(TEXT))
      END IF
      END
#<

#>            grxhls.dc3
Name:         GRXHLS

Purpose:      convert RGB color to HLS color

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRXHLS (R,G,B,H,L,S)
      
       GRPCKG: Convert a color specified in the RGB color model to one in
       the HLS model.  This is a support routine: no graphics I/O occurs.
       The inverse transformation is accomplished with routine GRXRGB.
       Reference: SIGGRAPH Status Report of the Graphic Standards Planning
       Committee, Computer Graphics, Vol.13, No.3, Association for
       Computing Machinery, New York, NY, 1979.
      
       Arguments:
      
       R,G,B (real, input): red, green, blue color coordinates, each in the
             range 0.0 to 1.0. Input outside this range causes HLS = (0,1,0)
             [white] to be returned.
       H,L,S (real, output): hue (0 to 360), lightness (0 to 1.0), and
             saturation (0 to 1.0).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grxhls.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRXHLS -- convert RGB color to HLS color
C+
      SUBROUTINE GRXHLS (R,G,B,H,L,S)
C
C GRPCKG: Convert a color specified in the RGB color model to one in
C the HLS model.  This is a support routine: no graphics I/O occurs.
C The inverse transformation is accomplished with routine GRXRGB.
C Reference: SIGGRAPH Status Report of the Graphic Standards Planning
C Committee, Computer Graphics, Vol.13, No.3, Association for
C Computing Machinery, New York, NY, 1979.
C
C Arguments:
C
C R,G,B (real, input): red, green, blue color coordinates, each in the
C       range 0.0 to 1.0. Input outside this range causes HLS = (0,1,0)
C       [white] to be returned.
C H,L,S (real, output): hue (0 to 360), lightness (0 to 1.0), and
C       saturation (0 to 1.0).
C--
C  2-Jul-1984 - new routine [TJP].
C 29-Sep-1994 - force H to be in rnage 0-360 [Remko Scharroo; TJP].
C-----------------------------------------------------------------------
      REAL     R,G,B, H,L,S, MA, MI, RR, GG, BB, D
C
      H = 0.0
      L = 1.0
      S = 0.0
      MA = MAX(R,G,B)
      MI = MIN(R,G,B)
      IF (MA.GT.1.0 .OR. MI.LT.0.0) RETURN
      RR = (MA-R)
      GG = (MA-G)
      BB = (MA-B)
C
C Lightness
C
      L = 0.5*(MA+MI)
C
C Achromatic case (R=G=B)
C
      IF (MA.EQ.MI) THEN
          S = 0.0
          H = 0.0
C
C Chromatic case
C
      ELSE
C         -- Saturation
          D = MA-MI
          IF (L.LE.0.5) THEN
              S = D/(MA+MI)
          ELSE
              S = D/(2.0-MA-MI)
          END IF
C         -- Hue
          IF (R.EQ.MA) THEN
C             -- yellow to magenta
              H = (2.0*D+BB-GG)
          ELSE IF (G.EQ.MA) THEN
              H = (4.0*D+RR-BB)
          ELSE
C             ! (B.EQ.MA)
              H = (6.0*D+GG-RR)
          END IF
          H = MOD(H*60.0/D,360.0)
          IF (H.LT.0.0) H = H+360.0
      END IF
C
      END
#<

#>            grxrgb.dc3
Name:         GRXRGB

Purpose:      convert HLS color to RGB color

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE GRXRGB (H,L,S,R,G,B)
      
       GRPCKG: Convert a color specified in the HLS color model to one in
       the RGB model.  This is a support routine: no graphics I/O occurs.
       The inverse transformation is accomplished with routine GRXHLS.
       Reference: SIGGRAPH Status Report of the Graphic Standards Planning
       Committee, Computer Graphics, Vol.13, No.3, Association for
       Computing Machinery, New York, NY, 1979.
      
       Arguments:
      
       H,L,S (real, input): hue (0 to 360), lightness (0 to 1.0), and
             saturation (0 to 1.0).
       R,G,B (real, output): red, green, blue color coordinates, each in the
             range 0.0 to 1.0.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            grxrgb.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*GRXRGB -- convert HLS color to RGB color
C+
      SUBROUTINE GRXRGB (H,L,S,R,G,B)
C
C GRPCKG: Convert a color specified in the HLS color model to one in
C the RGB model.  This is a support routine: no graphics I/O occurs.
C The inverse transformation is accomplished with routine GRXHLS.
C Reference: SIGGRAPH Status Report of the Graphic Standards Planning
C Committee, Computer Graphics, Vol.13, No.3, Association for
C Computing Machinery, New York, NY, 1979.
C
C Arguments:
C
C H,L,S (real, input): hue (0 to 360), lightness (0 to 1.0), and
C       saturation (0 to 1.0).
C R,G,B (real, output): red, green, blue color coordinates, each in the
C       range 0.0 to 1.0.
C--
C  2-Jul-1984 - new routine [TJP].
C 29-Sep-1994 - take H module 360 [TJP].
C 26-Nov-1996 - force results to be in range (avoid rounding error
C               problems on some machines) [TJP].
C-----------------------------------------------------------------------
      REAL     H,L,S, R,G,B, MA, MI, HM
C
      HM = MOD(H, 360.0)
      IF (HM.LT.0.0) HM = HM+360.0
      IF (L.LE.0.5) THEN
          MA = L*(1.0+S)
      ELSE
          MA = L + S - L*S
      END IF
      MI = 2.0*L-MA
C
C R component
C
      IF (HM.LT.60.0) THEN
          R = MI + (MA-MI)*HM/60.0
      ELSE IF (HM.LT.180.0) THEN
          R = MA
      ELSE IF (HM.LT.240.0) THEN
          R = MI + (MA-MI)*(240.0-HM)/60.0
      ELSE
          R = MI
      END IF
C
C G component
C
      IF (HM.LT.120.0) THEN
          G = MI
      ELSE IF (HM.LT.180.0) THEN
          G = MI + (MA-MI)*(HM-120.0)/60.0
      ELSE IF (HM.LT.300.0) THEN
          G = MA
      ELSE
          G = MI + (MA-MI)*(360.0-HM)/60.0
      END IF
C
C B component
C
      IF (HM.LT.60.0 .OR. HM.GE.300.0) THEN
          B = MA
      ELSE IF (HM.LT.120.0) THEN
          B = MI + (MA-MI)*(120.0-HM)/60.0
      ELSE IF (HM.LT.240.0) THEN
          B = MI
      ELSE
          B = MI + (MA-MI)*(HM-240.0)/60.0
      END IF
C
      R = MIN(1.0, MAX(0.0,R))
      G = MIN(1.0, MAX(0.0,G))
      B = MIN(1.0, MAX(0.0,B))
C
      END
#<

#>            notes.txt
             Notes on the installation of PGPLOT version 5.2.0
             =================================================

- new/unimplemented driver opcodes.
  which ones do we need?
  . 26 for pgimag and pggray
  . 29

- new drivers, e.g. GIF

- many drivers (including GIF) use non-standard Fortran, e.g. for dynamic
  memory allocation (%VAL), and also BYTE, INTEGER*4, etc.

- driver argument lists are different: GIPSY has a device (idev) argument;
  PGPLOT has a mode argument.
  
- The implementation of menu buttons as demonstrated in pgdemo13
  is quite simple. No toolkit or other O-O stuff - just a set of
  circles and cursor read-out. (Use of Ggi is to be preferred.)

- There is also a PGPLOT Motif widget. (Use of Ggi is to be preferred.)

- PGPLOT's own C binding can be implemented as follows:
  1. maintain GIPSY's f2cvv interface and
  2. use this as a virtual platform upon which PGPLOT's C binding is built.

  advantages:
    portability same as f2cvv, not dependent on PGPLOT's portability mechanism;
    easier maintenance.
  disadvantages:
    one extra layer in calling chain -> small performance loss;
    we must implement f2cvv - PGPLOT-C interface ourselves


- GIPSY 'private' PGxxx and GRxxx routines:

   pgcolim.f  ---  Code copied from 'pggray' and and adapted for colours.
   pgcotic.f  ---  Derived from PGCONS
   pgexist.f
   pggray2.f  --- Code copied from 'pggray' and and adapted for supplied
                  gray scales.
   pgmappar.f --- Obtain PGPLOT world <-> phys. coordinate mapping parameters.
                  (obsolete, handled by 'X'-cursor capability in ggiplot)
   pgpat.f    --- set line style according to pattern

   grgray2.f  --- Adapted from GRGRAY
   grgrgr2.f  --- This routine is called by GRGRAY2 - Adapted from GRGRGR
   grgrps2.f  --- This routine is called by GRGRAY2... - Adapted from 'GRGRPS'
   grgrpscol.f -- called by PGCOLIM when output device is of type PostScript.
   

- other PGxxx and GRxxx routines absent in version 5.2.0:

   pgtime.f   --- was called by pgtbox, not needed anymore
   pgtlab.f   --- was called by pgtbox, not needed anymore
   pgtlb1.f   --- was called by pgtlab, not needed anymore

   grgrgr.f   --- was called by grgray, not needed anymore but see also grgray2
   grgrps.f   --- called by grgray and grgray2
   grsfs.f    --- was called by pgsfs, not needed anymore


- GRxxx routines from pgplot/sys/:

   grdate.f   --- GIPSY-modified: uses GETDATE instead of FDATE. Now in C.
   grgenv.f   --- GIPSY-modified: uses TRALOG instead of GETENV.
   grfileio.c --- New in version 5.2.0, not needed
   grflun.f   
   grgcom.f   --- absent in GIPSY
   grgetc.c   --- New in version 5.2.0, not needed
   grglun.f
   grgmem.c   --- New in version 5.2.0, not needed
   grlgtr.f
   grsy00.f
   grtermio.c --- New in version 5.2.0, not needed
   grtrml.f
   grtter.f
   gruser.f  --- GIPSY-modified: uses GETLOGNAM instead of GETLOG. Now in C.
    

- GIPSY-modified PGxxx and GRxxx routines:
   
   pgbeg.f   --- communicates through Hermes (use 5.2.0 version unmodified)
   pgbox.f   --- manipulates LABLEN in (modified) pgplot.inc (see pglab.f)
   pgconx.f  --- Argument PLOT has been removed ... (now use standard)
   pgfunt.f  --- Arguments FX, FY have been remove ... (now use standard)
   pgfunx.f  --- Argument FY has been removed ... (now use standard)
   pgfuny.f  --- Argument FX has been removed ... (now use standard)
   pglab.f   --- New position for y title if y labels were plotted horizontally.
                 (adapt to multi-device operation, also modify pgplot.inc)

   grexec    --- GIPSY-specific dispatcher (pgdriv, no immediate action needed)
   grldev.f  --- improved layout
   grmsg.f   --- uses ANYOUT for messages
   grpars.f  --- First type, then file/device name
   grprom.f  --- communicates through Hermes
   grqtyp.f  --- uses different GREXEC function codes
   grwarn.f  --- uses ANYOUT for messages

   The new pgbeg just calls the new central plot opening routine pgopen.
   Modifications made in pgbeg should be transferred to pgopen.
   
   The original of any modified module should be kept in pgplot.src for
   later reference, e.g. under the name pgbox.f.orig.


- Dependencies

   pgcolim  : cplot gplot
   pgcotic  : gplot
   pgexist  : plotsym
   pggray2  : cplot gplot
   pgmappar : ggi -> GUI programs using PGPLOT
   pgpat    : gplot

   pgbeg    : MANY
   pgconx   : pgfunt -> pgdemo
   pgfunt   : pgdemo
   pgfunx   : pgdemo
   pgfuny   :  -
   pglab    : MANY
   
   grdate   : pgiden.f pgqinf.f
   grfileio : driver support, not needed in GIPSY
   grgetc   : driver support, not needed in GIPSY
   grgmem   : driver support, not needed in GIPSY
   grtermio : driver support, not needed in GIPSY
   gruser   : pgiden.f pgqinf.f

- Documentation:
  Generate automatically using the Perl script 'togipsy.pl' which is
  in this respect similar to PGPLOT's makedoc script.
  Makedoc can also generate an .html document. This might be useful.

- f2cvv layer:
  Only necessary for 'public', i.e. most PGxxx, routines.
  Derived automatically from C% directives in source code using
  the Perl script 'togipsy.pl', which generates modified .f files
  containing the Fortran-to-C C@ directives.

- togipsy.pl:
  Incorporate this script in the final GIPSY source file for later use with
  possible new PGPLOT versions.

- version 5.2.0 Fortran sources not documented in pgplot.doc
  (internal and support routines). For these routines minimal
  .dc3 documentation is generated.
   
   pgaxlg.f
   pgbox1.f
   pgcl.f
   pgcn01.f
   pgcnsc.f
   pgcp.f
   pghis1.f
   pghtch.f
   pginit.f
   pgnoto.f
   pgnpl.f 
   pgsetc.f
   pgsize.f
   pgvw.f

- Include updated pgplot.dc3 from old version.

- Testing the new library:
  Generate a temporary pgplot.a library containing all pgplot objects.
  Key applications are built with this library specified before giplib.a
  on the compile statement, so that this 'shields' the pgplot objects
  in giplib.a.

- Generate all-encompassing pgplot.h: Perl script allincludes.pl.
  Existing pgplot.h has been installed separate from pgplot.src. 
  Must be deleted first.

- For using PGIMAG and the new version of PGGRAY, our device drivers need
  to support opcode 26.

- Include these notes in pgplot.src


                                                     Nov 9, 1998: J.P. Terlouw
#<

#>            pgadvance.dc2
Name:         PGADVANCE

Purpose:      non-standard alias for PGPAGE

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGADVANCE
      
       See description of PGPAGE.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgadvance.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGADVANCE -- non-standard alias for PGPAGE
C+
      SUBROUTINE PGADVANCE
C
C See description of PGPAGE.
C--
      CALL PGPAGE
      END
#<

#>            pgarro.dc2
Name:         PGARRO

Purpose:      draw an arrow

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGARRO (X1, Y1, X2, Y2)
            REAL X1, Y1, X2, Y2
      
       Draw an arrow from the point with world-coordinates (X1,Y1) to 
       (X2,Y2). The size of the arrowhead at (X2,Y2) is determined by 
       the current character size set by routine PGSCH. The default size 
       is 1/40th of the smaller of the width or height of the view surface.
       The appearance of the arrowhead (shape and solid or open) is
       controlled by routine PGSAH.
      
       Arguments:
        X1, Y1 (input)  : world coordinates of the tail of the arrow.
        X2, Y2 (input)  : world coordinates of the head of the arrow.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgarro.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGARRO -- draw an arrow
C%void cpgarro(float x1, float y1, float x2, float y2);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgarro( real, real, real, real )
*

C+
      SUBROUTINE PGARRO (X1, Y1, X2, Y2)
      REAL X1, Y1, X2, Y2
C
C Draw an arrow from the point with world-coordinates (X1,Y1) to 
C (X2,Y2). The size of the arrowhead at (X2,Y2) is determined by 
C the current character size set by routine PGSCH. The default size 
C is 1/40th of the smaller of the width or height of the view surface.
C The appearance of the arrowhead (shape and solid or open) is
C controlled by routine PGSAH.
C
C Arguments:
C  X1, Y1 (input)  : world coordinates of the tail of the arrow.
C  X2, Y2 (input)  : world coordinates of the head of the arrow.
C--
C  7-Feb-92 Keith Horne @ STScI / TJP.
C 13-Oct-92 - use arrowhead attributes; scale (TJP).
C-----------------------------------------------------------------------
      INTEGER AHFS, FS
      REAL DX, DY, XV1, XV2, YV1, YV2, XL, XR, YB, YT, DINDX, DINDY
      REAL XINCH, YINCH, RINCH, CA, SA, SO, CO, YP, XP, YM, XM, DHX, DHY
      REAL PX(4), PY(4)
      REAL AHANGL, AHVENT, SEMANG, CH, DH, XS1, XS2, YS1, YS2
C
      CALL PGBBUF
      CALL PGQAH(AHFS, AHANGL, AHVENT)
      CALL PGQFS(FS)
      CALL PGSFS(AHFS)
      DX = X2 - X1
      DY = Y2 - Y1
      CALL PGQCH(CH)
      CALL PGQVSZ(1, XS1, XS2, YS1, YS2)
C     -- length of arrowhead: 1 40th of the smaller of the height or
C        width of the view surface, scaled by character height.
      DH = CH*MIN(ABS(XS2-XS1),ABS(YS2-YS1))/40.0
      CALL PGMOVE(X2, Y2)
C     -- Is there to be an arrowhead ?
      IF (DH.GT.0.) THEN
          IF (DX.NE.0. .OR. DY.NE.0.) THEN
C             -- Get x and y scales
              CALL PGQVP(1, XV1, XV2, YV1, YV2)
              CALL PGQWIN(XL, XR, YB, YT)
              IF (XR.NE.XL .AND. YT.NE.YB) THEN
                  DINDX = (XV2 - XV1) / (XR - XL)
                  DINDY = (YV2 - YV1) / (YT - YB)
                  DHX = DH / DINDX
                  DHY = DH / DINDY
C                 -- Unit vector in direction of the arrow
                  XINCH = DX * DINDX
                  YINCH = DY * DINDY
                  RINCH = SQRT(XINCH*XINCH + YINCH*YINCH)
                  CA = XINCH / RINCH
                  SA = YINCH / RINCH
C                 -- Semiangle in radians
                  SEMANG = AHANGL/2.0/57.296
                  SO = SIN(SEMANG)
                  CO = -COS(SEMANG)
C                 -- Vector back along one edge of the arrow
                  XP = DHX * (CA*CO - SA*SO)
                  YP = DHY * (SA*CO + CA*SO)
C                 -- Vector back along other edge of the arrow
                  XM = DHX * (CA*CO + SA*SO)
                  YM = DHY * (SA*CO - CA*SO)
C                 -- Draw the arrowhead
                  PX(1) = X2
                  PY(1) = Y2
                  PX(2) = X2 + XP
                  PY(2) = Y2 + YP
                  PX(3) = X2 + 0.5*(XP+XM)*(1.0-AHVENT)
                  PY(3) = Y2 + 0.5*(YP+YM)*(1.0-AHVENT)
                  PX(4) = X2 + XM
                  PY(4) = Y2 + YM
                  CALL PGPOLY(4, PX, PY)
                  CALL PGMOVE(PX(3), PY(3))
              END IF
          END IF
      END IF
      CALL PGDRAW(X1, Y1)
      CALL PGMOVE(X2,Y2)
      CALL PGSFS(FS)
      CALL PGEBUF
      RETURN
      END
#<

#>            pgask.dc2
Name:         PGASK

Purpose:      control new page prompting

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGASK (FLAG)
            LOGICAL FLAG
      
       Change the ``prompt state'' of PGPLOT. If the prompt state is
       ON, PGPAGE will type ``Type RETURN for next page:'' and will wait
       for the user to type a carriage-return before starting a new page.
       The initial prompt state (after the device has been opened) is ON
       for interactive devices. Prompt state is always OFF for
       non-interactive devices.
      
       Arguments:
        FLAG   (input)  : if .TRUE., and if the device is an interactive
                          device, the prompt state will be set to ON. If
                          .FALSE., the prompt state will be set to OFF.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgask.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGASK -- control new page prompting
C%void cpgask(Logical flag);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgask( logical )
*

C+
      SUBROUTINE PGASK (FLAG)
      LOGICAL FLAG
C
C Change the ``prompt state'' of PGPLOT. If the prompt state is
C ON, PGPAGE will type ``Type RETURN for next page:'' and will wait
C for the user to type a carriage-return before starting a new page.
C The initial prompt state (after the device has been opened) is ON
C for interactive devices. Prompt state is always OFF for
C non-interactive devices.
C
C Arguments:
C  FLAG   (input)  : if .TRUE., and if the device is an interactive
C                    device, the prompt state will be set to ON. If
C                    .FALSE., the prompt state will be set to OFF.
C--
C-----------------------------------------------------------------------
      INCLUDE     'pgplot.inc'
      LOGICAL     PGNOTO
      CHARACTER*1 TYPE
C
      IF (PGNOTO('PGASK')) RETURN
C
      IF (FLAG) THEN
          CALL GRQTYP(TYPE,PGPRMP(PGID))
      ELSE
          PGPRMP(PGID) = .FALSE.
      END IF
      END
#<

#>            pgaxis.dc2
Name:         PGAXIS

Purpose:      draw an axis

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGAXIS (OPT, X1, Y1, X2, Y2, V1, V2, STEP, NSUB,
           :                   DMAJL, DMAJR, FMIN, DISP, ORIENT)
            CHARACTER*(*) OPT
            REAL X1, Y1, X2, Y2, V1, V2, STEP, DMAJL, DMAJR, FMIN, DISP
            REAL ORIENT
            INTEGER NSUB
      
       Draw a labelled graph axis from world-coordinate position (X1,Y1) to
       (X2,Y2).
      
       Normally, this routine draws a standard LINEAR axis with equal
       subdivisions.   The quantity described by the axis runs from V1 to V2;
       this may be, but need not be, the same as X or Y. 
      
       If the 'L' option is specified, the routine draws a LOGARITHMIC axis.
       In this case, the quantity described by the axis runs from 10**V1 to
       10**V2. A logarithmic axis always has major, labeled, tick marks 
       spaced by one or more decades. If the major tick marks are spaced
       by one decade (as specified by the STEP argument), then minor
       tick marks are placed at 2, 3, .., 9 times each power of 10;
       otherwise minor tick marks are spaced by one decade. If the axis
       spans less than two decades, numeric labels are placed at 1, 2, and
       5 times each power of ten.
      
       If the axis spans less than one decade, or if it spans many decades,
       it is preferable to use a linear axis labeled with the logarithm of
       the quantity of interest.
      
       Arguments:
        OPT    (input)  : a string containing single-letter codes for
                          various options. The options currently
                          recognized are:
                          L : draw a logarithmic axis
                          N : write numeric labels
                          1 : force decimal labelling, instead of automatic
                              choice (see PGNUMB).
                          2 : force exponential labelling, instead of
                              automatic.
        X1, Y1 (input)  : world coordinates of one endpoint of the axis.
        X2, Y2 (input)  : world coordinates of the other endpoint of the axis.
        V1     (input)  : axis value at first endpoint.
        V2     (input)  : axis value at second endpoint.
        STEP   (input)  : major tick marks are drawn at axis value 0.0 plus
                          or minus integer multiples of STEP. If STEP=0.0,
                          a value is chosen automatically.
        NSUB   (input)  : minor tick marks are drawn to divide the major
                          divisions into NSUB equal subdivisions (ignored if
                          STEP=0.0). If NSUB <= 1, no minor tick marks are
                          drawn. NSUB is ignored for a logarithmic axis.
        DMAJL  (input)  : length of major tick marks drawn to left of axis
                          (as seen looking from first endpoint to second), in
                          units of the character height.
        DMAJR  (input)  : length of major tick marks drawn to right of axis,
                          in units of the character height.
        FMIN   (input)  : length of minor tick marks, as fraction of major.
        DISP   (input)  : displacement of baseline of tick labels to
                          right of axis, in units of the character height.
        ORIENT (input)  : orientation of label text, in degrees; angle between
                          baseline of text and direction of axis (0-360°).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgaxis.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGAXIS -- draw an axis
C%void cpgaxis(const char *opt, float x1, float y1, float x2, float y2, \
C%             float v1, float v2, float step, int nsub, float dmajl, \
C%             float dmajr, float fmin, float disp, float orient);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgaxis( character, real, real, real, real, real, real, real, integer, real, real, real, real, real )
*

C+
      SUBROUTINE PGAXIS (OPT, X1, Y1, X2, Y2, V1, V2, STEP, NSUB,
     :                   DMAJL, DMAJR, FMIN, DISP, ORIENT)
      CHARACTER*(*) OPT
      REAL X1, Y1, X2, Y2, V1, V2, STEP, DMAJL, DMAJR, FMIN, DISP
      REAL ORIENT
      INTEGER NSUB
C
C Draw a labelled graph axis from world-coordinate position (X1,Y1) to
C (X2,Y2).
C
C Normally, this routine draws a standard LINEAR axis with equal
C subdivisions.   The quantity described by the axis runs from V1 to V2;
C this may be, but need not be, the same as X or Y. 
C
C If the 'L' option is specified, the routine draws a LOGARITHMIC axis.
C In this case, the quantity described by the axis runs from 10**V1 to
C 10**V2. A logarithmic axis always has major, labeled, tick marks 
C spaced by one or more decades. If the major tick marks are spaced
C by one decade (as specified by the STEP argument), then minor
C tick marks are placed at 2, 3, .., 9 times each power of 10;
C otherwise minor tick marks are spaced by one decade. If the axis
C spans less than two decades, numeric labels are placed at 1, 2, and
C 5 times each power of ten.
C
C If the axis spans less than one decade, or if it spans many decades,
C it is preferable to use a linear axis labeled with the logarithm of
C the quantity of interest.
C
C Arguments:
C  OPT    (input)  : a string containing single-letter codes for
C                    various options. The options currently
C                    recognized are:
C                    L : draw a logarithmic axis
C                    N : write numeric labels
C                    1 : force decimal labelling, instead of automatic
C                        choice (see PGNUMB).
C                    2 : force exponential labelling, instead of
C                        automatic.
C  X1, Y1 (input)  : world coordinates of one endpoint of the axis.
C  X2, Y2 (input)  : world coordinates of the other endpoint of the axis.
C  V1     (input)  : axis value at first endpoint.
C  V2     (input)  : axis value at second endpoint.
C  STEP   (input)  : major tick marks are drawn at axis value 0.0 plus
C                    or minus integer multiples of STEP. If STEP=0.0,
C                    a value is chosen automatically.
C  NSUB   (input)  : minor tick marks are drawn to divide the major
C                    divisions into NSUB equal subdivisions (ignored if
C                    STEP=0.0). If NSUB <= 1, no minor tick marks are
C                    drawn. NSUB is ignored for a logarithmic axis.
C  DMAJL  (input)  : length of major tick marks drawn to left of axis
C                    (as seen looking from first endpoint to second), in
C                    units of the character height.
C  DMAJR  (input)  : length of major tick marks drawn to right of axis,
C                    in units of the character height.
C  FMIN   (input)  : length of minor tick marks, as fraction of major.
C  DISP   (input)  : displacement of baseline of tick labels to
C                    right of axis, in units of the character height.
C  ORIENT (input)  : orientation of label text, in degrees; angle between
C                    baseline of text and direction of axis (0-360°).
C--
C 25-Mar-1997 - new routine [TJP].
C-----------------------------------------------------------------------
      REAL V, VMIN, VMAX, DVMAJ, DVMIN
      REAL PGRND
      INTEGER I, K, K1, K2, NSUBT, NV, NP, LLAB, CLIP, FORM
      LOGICAL OPTN, PGNOTO
      CHARACTER CH, LABEL*32
C
C Check arguments.
C
      IF (PGNOTO('PGAXIS')) RETURN
      IF (X1.EQ.X2 .AND. Y1.EQ.Y2) RETURN
      IF (V1.EQ.V2) RETURN
C
C Decode options.
C
      FORM = 0
      OPTN = .FALSE.
      DO 10 I=1,LEN(OPT)
         CH = OPT(I:I)
         CALL GRTOUP(CH, CH)
         IF (CH.EQ.'N') THEN
C           -- numeric labels requested
            OPTN = .TRUE.
         ELSE IF (CH.EQ.'L') THEN
C           -- logarithmic axis requested
            CALL PGAXLG(OPT, X1, Y1, X2, Y2, V1, V2, STEP,
     :                  DMAJL, DMAJR, FMIN, DISP, ORIENT)
            RETURN
         ELSE IF (CH.EQ.'1') THEN
C           -- decimal labels requested
            FORM = 1
         ELSE IF (CH.EQ.'2') THEN
C           -- exponential labels requested
            FORM = 2
         END IF
 10   CONTINUE
C
C Choose major interval if defaulted. Requested interval = STEP,
C with NSUB subdivisions. We will use interval = DVMAJ with NSUBT
C subdivisions of size DVMIN. Note that DVMAJ is always positive.
C
      IF (STEP.EQ.0.0) THEN
          DVMAJ = PGRND(0.20*ABS(V1-V2),NSUBT)
      ELSE
          DVMAJ = ABS(STEP)
          NSUBT = MAX(NSUB,1)
      END IF
      DVMIN = DVMAJ/NSUBT
C
C For labelling, we need to express DVMIN as an integer times a
C power of 10, NV*(10**NP).
C
      NP = INT(LOG10(ABS(DVMIN)))-4
      NV = NINT(DVMIN/10.0**NP)
      DVMIN = REAL(NV)*(10.0**NP)
C
      CALL PGBBUF
      CALL PGQCLP(CLIP)
      CALL PGSCLP(0)
C
C Draw the axis.
C
      CALL PGMOVE(X1, Y1)
      CALL PGDRAW(X2, Y2)
C
C Draw the tick marks. Minor ticks are drawn at V = K*DVMIN, 
C major (labelled) ticks where K is a multiple of NSUBT.
C
      VMIN = MIN(V1, V2)
      VMAX = MAX(V1, V2)
      K1 = INT(VMIN/DVMIN)
      IF (DVMIN*K1.LT.VMIN) K1 = K1+1
      K2 = INT(VMAX/DVMIN)
      IF (DVMIN*K2.GT.VMAX) K2 = K2-1
      DO 20 K=K1,K2
         V = (K*DVMIN-V1)/(V2-V1)
         IF (MOD(K,NSUBT).EQ.0) THEN
C             -- major tick mark
            IF (OPTN) THEN
               CALL PGNUMB(K*NV, NP, FORM, LABEL, LLAB)
            ELSE
               LABEL = ' '
               LLAB = 1
            END IF
            CALL PGTICK(X1, Y1, X2, Y2, V, DMAJL, DMAJR,
     :                  DISP, ORIENT, LABEL(:LLAB))
         ELSE
C             -- minor tick mark
            CALL PGTICK(X1, Y1, X2, Y2, V, DMAJL*FMIN, DMAJR*FMIN,
     :                  0.0, ORIENT, ' ')
         END IF
 20   CONTINUE
C
      CALL PGSCLP(CLIP)
      CALL PGEBUF
      END
#<

#>            pgaxlg.dc3
Name:         pgaxlg

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Oct 16, 1998: JPT automatically generated.
#<

#>            pgaxlg.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C PGAXLG -- draw a logarithmic axis [internal routine]
C
      SUBROUTINE PGAXLG (OPT, X1, Y1, X2, Y2, V1, V2, STEP,
     :                   DMAJL, DMAJR, FMIN, DISP, ORIENT)
      CHARACTER*(*) OPT
      REAL X1, Y1, X2, Y2, V1, V2, STEP
      REAL DMAJL, DMAJR, FMIN, DISP, ORIENT
C
C Draw a labelled graph axis from world-coordinate position (X1,Y1)
C  to (X2,Y2). The quantity described by the axis runs from 10**V1 to
C 10**V2. A logarithmic axis always has major, labeled, tick marks 
C spaced by one or more decades. If the major tick marks are spaced
C by one decade (as specified by the STEP argument), then minor
C tick marks are placed at 2, 3, .., 9 times each power of 10;
C otherwise minor tick marks are spaced by one decade. If the axis
C spans less than two decades, numeric labels are placed at 1, 2, and
C 5 times each power of ten.
C
C It is not advisable to use this routine if the axis spans less than
C one decade, or if it spans many decades. In these cases it is
C preferable to use a linear axis labeled with the logarithm of the
C quantity of interest.
C
C Arguments:
C  OPT    (input)  : a string containing single-letter codes for
C                    various options. The options currently
C                    recognized are:
C                    N : write numeric labels
C                    1 : force decimal labelling, instead of automatic
C                        choice (see PGNUMB).
C                    2 : force exponential labelling, instead of
C                        automatic.
C  X1, Y1 (input)  : world coordinates of one endpoint of the axis.
C  X2, Y2 (input)  : world coordinates of the other endpoint of the axis.
C  V1     (input)  : logarithm of axis value at first endpoint.
C  V2     (input)  : logarithm of axis value at second endpoint.
C  STEP   (input)  : the number of decades between major (labeled) tick
C                    marks.
C  DMAJL  (input)  : length of major tick marks drawn to left of axis
C                    (as seen looking from first endpoint to second), in
C                    units of the character height.
C  DMAJR  (input)  : length of major tick marks drawn to right of axis,
C                    in units of the character height.
C  FMIN   (input)  : length of minor tick marks, as fraction of major.
C  DISP   (input)  : displacement of baseline of tick labels to
C                    right of axis, in units of the character height.
C  ORIENT (input)  : orientation of text label relative to axis (see
C                    PGTICK).
C--
C 25-Mar-1997 - new routine [TJP].
C-----------------------------------------------------------------------
      REAL V, VMIN, VMAX, DVMAJ, DVMIN, PGRND
      INTEGER I, K, K1, K2, LLAB, NSUBT, CLIP, FORM
      LOGICAL XLAB, OPTN
      CHARACTER*32 LABEL
      REAL TAB(9)
C
C Table of logarithms 1..9
C
      DATA TAB / 0.00000, 0.30103, 0.47712, 0.60206, 0.69897,
     :           0.77815, 0.84510, 0.90309, 0.95424 /
C
C Check arguments.
C
      IF (X1.EQ.X2 .AND. Y1.EQ.Y2) RETURN
      IF (V1.EQ.V2) RETURN
C
C Decode options.
C
      OPTN = INDEX(OPT,'N').NE.0 .OR. INDEX(OPT,'n').NE.0
      FORM =0
      IF (INDEX(OPT,'1').NE.0) FORM = 1
      IF (INDEX(OPT,'2').NE.0) FORM = 2
C
C Choose major interval (DVMAJ in the logarithm, with minimum value
C 1.0 = one decade). The minor interval is always 1.0.
C
      IF (STEP.GT.0.5) THEN
         DVMAJ = NINT(STEP)
      ELSE
         DVMAJ = PGRND(0.20*ABS(V1-V2),NSUBT)
         IF (DVMAJ.LT.1.0) DVMAJ = 1.0
      END IF
      DVMIN = 1.0
      NSUBT = DVMAJ/DVMIN
C
      CALL PGBBUF
      CALL PGQCLP(CLIP)
      CALL PGSCLP(0)
C
C Draw the axis.
C
      CALL PGMOVE(X1, Y1)
      CALL PGDRAW(X2, Y2)
C
C Draw the tick marks. Major ticks are drawn at V = K*DVMAJ.
C
      VMIN = MIN(V1, V2)
      VMAX = MAX(V1, V2)
      K1 = INT(VMIN/DVMIN)
      IF (DVMIN*K1.LT.VMIN) K1 = K1+1
      K2 = INT(VMAX/DVMIN)
      IF (DVMIN*K2.GT.VMAX) K2 = K2-1
      XLAB = (K2-K1) .LE. 2
      DO 20 K=K1,K2
         V = (K*DVMIN-V1)/(V2-V1)
         IF (MOD(K,NSUBT).EQ.0) THEN
C             -- major tick mark
            IF (OPTN) THEN
               CALL PGNUMB(1, NINT(K*DVMIN), FORM, LABEL, LLAB)
            ELSE
               LABEL = ' '
               LLAB = 1
            END IF
            CALL PGTICK(X1, Y1, X2, Y2, V, DMAJL, DMAJR,
     :                  DISP, ORIENT, LABEL(:LLAB))
         ELSE
C             -- minor tick mark
            CALL PGTICK(X1, Y1, X2, Y2, V, DMAJL*FMIN, DMAJR*FMIN,
     :                  0.0, ORIENT, ' ')
         END IF
 20   CONTINUE
C
C Draw intermediate tick marks if required. 
C Label them if axis spans less than 2 decades.
C
      IF (NSUBT.EQ.1) THEN
         DO 30 K=K1-1,K2+1
            DO 25 I=2,9
               V = (K*DVMIN + TAB(I) -V1)/(V2-V1)
               IF (V.GE.0.0 .AND. V.LE.1.0) THEN
                  IF (OPTN.AND.(XLAB .AND.(I.EQ.2 .OR. I.EQ.5))) THEN
C                    -- labeled minor tick mark
                     CALL PGNUMB(I, NINT(K*DVMIN), FORM, LABEL, LLAB)
                  ELSE
C                    -- unlabeled minor tick mark
                     LABEL = ' '
                     LLAB = 1
                  END IF
                  CALL PGTICK(X1, Y1, X2, Y2, V, DMAJL*FMIN, DMAJR*FMIN,
     :                        DISP, ORIENT, LABEL(:LLAB))
               END IF
 25         CONTINUE
 30      CONTINUE
      END IF
C
      CALL PGSCLP(CLIP)
      CALL PGEBUF
      END
#<

#>            pgband.dc2
Name:         PGBAND

Purpose:      read cursor position, with anchor

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            INTEGER FUNCTION PGBAND (MODE, POSN, XREF, YREF, X, Y, CH)
            INTEGER MODE, POSN
            REAL XREF, YREF, X, Y
            CHARACTER*(*) CH
      
       Read the cursor position and a character typed by the user.
       The position is returned in world coordinates.  PGBAND positions
       the cursor at the position specified (if POSN=1), allows the user to
       move the cursor using the mouse or arrow keys or whatever is available
       on the device. When he has positioned the cursor, the user types a
       single character on the keyboard; PGBAND then returns this
       character and the new cursor position (in world coordinates).
      
       Some interactive devices offer a selection of cursor types,
       implemented as thin lines that move with the cursor, but without
       erasing underlying graphics. Of these types, some extend between
       a stationary anchor-point at XREF,YREF, and the position of the
       cursor, while others simply follow the cursor without changing shape
       or size. The cursor type is specified with one of the following MODE
       values. Cursor types that are not supported by a given device, are
       treated as MODE=0.
      
       -- If MODE=0, the anchor point is ignored and the routine behaves
       like PGCURS.
       -- If MODE=1, a straight line is drawn joining the anchor point 
       and the cursor position.
       -- If MODE=2, a hollow rectangle is extended as the cursor is moved,
       with one vertex at the anchor point and the opposite vertex at the
       current cursor position; the edges of the rectangle are horizontal
       and vertical.
       -- If MODE=3, two horizontal lines are extended across the width of
       the display, one drawn through the anchor point and the other
       through the moving cursor position. This could be used to select
       a Y-axis range when one end of the range is known.
       -- If MODE=4, two vertical lines are extended over the height of
       the display, one drawn through the anchor point and the other
       through the moving cursor position. This could be used to select an
       X-axis range when one end of the range is known.
       -- If MODE=5, a horizontal line is extended through the cursor
       position over the width of the display. This could be used to select
       an X-axis value such as the start of an X-axis range. The anchor point
       is ignored.
       -- If MODE=6, a vertical line is extended through the cursor
       position over the height of the display. This could be used to select
       a Y-axis value such as the start of a Y-axis range. The anchor point
       is ignored.
       -- If MODE=7, a cross-hair, centered on the cursor, is extended over
       the width and height of the display. The anchor point is ignored.
      
       Returns:
        PGBAND          : 1 if the call was successful; 0 if the device
                          has no cursor or some other error occurs.
       Arguments:
        MODE   (input)  : display mode (0, 1, ..7: see above).
        POSN   (input)  : if POSN=1, PGBAND attempts to place the cursor
                          at point (X,Y); if POSN=0, it leaves the cursor
                          at its current position. (On some devices this
                          request may be ignored.)
        XREF   (input)  : the world x-coordinate of the anchor point.
        YREF   (input)  : the world y-coordinate of the anchor point.
        X      (in/out) : the world x-coordinate of the cursor.
        Y      (in/out) : the world y-coordinate of the cursor.
        CH     (output) : the character typed by the user; if the device has
                          no cursor or if some other error occurs, the value
                          CHAR(0) [ASCII NUL character] is returned.
      
       Note: The cursor coordinates (X,Y) may be changed by PGBAND even if
       the device has no cursor or if the user does not move the cursor.
       Under these circumstances, the position returned in (X,Y) is that of
       the pixel nearest to the requested position.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgband.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGBAND -- read cursor position, with anchor
C%int cpgband(int mode, int posn, float xref, float yref, float *x,\
C%            float *y, char *ch_scalar);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ integer function pgband( integer, integer, real, real, real, real, character )
*

C+
      INTEGER FUNCTION PGBAND (MODE, POSN, XREF, YREF, X, Y, CH)
      INTEGER MODE, POSN
      REAL XREF, YREF, X, Y
      CHARACTER*(*) CH
C
C Read the cursor position and a character typed by the user.
C The position is returned in world coordinates.  PGBAND positions
C the cursor at the position specified (if POSN=1), allows the user to
C move the cursor using the mouse or arrow keys or whatever is available
C on the device. When he has positioned the cursor, the user types a
C single character on the keyboard; PGBAND then returns this
C character and the new cursor position (in world coordinates).
C
C Some interactive devices offer a selection of cursor types,
C implemented as thin lines that move with the cursor, but without
C erasing underlying graphics. Of these types, some extend between
C a stationary anchor-point at XREF,YREF, and the position of the
C cursor, while others simply follow the cursor without changing shape
C or size. The cursor type is specified with one of the following MODE
C values. Cursor types that are not supported by a given device, are
C treated as MODE=0.
C
C -- If MODE=0, the anchor point is ignored and the routine behaves
C like PGCURS.
C -- If MODE=1, a straight line is drawn joining the anchor point 
C and the cursor position.
C -- If MODE=2, a hollow rectangle is extended as the cursor is moved,
C with one vertex at the anchor point and the opposite vertex at the
C current cursor position; the edges of the rectangle are horizontal
C and vertical.
C -- If MODE=3, two horizontal lines are extended across the width of
C the display, one drawn through the anchor point and the other
C through the moving cursor position. This could be used to select
C a Y-axis range when one end of the range is known.
C -- If MODE=4, two vertical lines are extended over the height of
C the display, one drawn through the anchor point and the other
C through the moving cursor position. This could be used to select an
C X-axis range when one end of the range is known.
C -- If MODE=5, a horizontal line is extended through the cursor
C position over the width of the display. This could be used to select
C an X-axis value such as the start of an X-axis range. The anchor point
C is ignored.
C -- If MODE=6, a vertical line is extended through the cursor
C position over the height of the display. This could be used to select
C a Y-axis value such as the start of a Y-axis range. The anchor point
C is ignored.
C -- If MODE=7, a cross-hair, centered on the cursor, is extended over
C the width and height of the display. The anchor point is ignored.
C
C Returns:
C  PGBAND          : 1 if the call was successful; 0 if the device
C                    has no cursor or some other error occurs.
C Arguments:
C  MODE   (input)  : display mode (0, 1, ..7: see above).
C  POSN   (input)  : if POSN=1, PGBAND attempts to place the cursor
C                    at point (X,Y); if POSN=0, it leaves the cursor
C                    at its current position. (On some devices this
C                    request may be ignored.)
C  XREF   (input)  : the world x-coordinate of the anchor point.
C  YREF   (input)  : the world y-coordinate of the anchor point.
C  X      (in/out) : the world x-coordinate of the cursor.
C  Y      (in/out) : the world y-coordinate of the cursor.
C  CH     (output) : the character typed by the user; if the device has
C                    no cursor or if some other error occurs, the value
C                    CHAR(0) [ASCII NUL character] is returned.
C
C Note: The cursor coordinates (X,Y) may be changed by PGBAND even if
C the device has no cursor or if the user does not move the cursor.
C Under these circumstances, the position returned in (X,Y) is that of
C the pixel nearest to the requested position.
C--
C 7-Sep-1994 - new routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE      'pgplot.inc'
      INTEGER      GRCURS, I, J, IREF, JREF
      LOGICAL      PGNOTO
C
      IF (PGNOTO('PGBAND')) THEN
          CH = CHAR(0)
          PGBAND = 0
          RETURN
      END IF
      IF (MODE.LT.0 .OR. MODE.GT.7) CALL GRWARN(
     :     'Invalid MODE argument in PGBAND')
      IF (POSN.LT.0 .OR. POSN.GT.1) CALL GRWARN(
     :     'Invalid POSN argument in PGBAND')
C
      I = NINT(PGXORG(PGID) + X*PGXSCL(PGID))
      J = NINT(PGYORG(PGID) + Y*PGYSCL(PGID))
      IREF = NINT(PGXORG(PGID) + XREF*PGXSCL(PGID))
      JREF = NINT(PGYORG(PGID) + YREF*PGYSCL(PGID))
      PGBAND = GRCURS(PGID,I,J,IREF,JREF,MODE,POSN,CH)
      X = (I - PGXORG(PGID))/PGXSCL(PGID)
      Y = (J - PGYORG(PGID))/PGYSCL(PGID)
      CALL GRTERM
      END
#<

#>            pgbbuf.dc2
Name:         PGBBUF

Purpose:      begin batch of output (buffer)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGBBUF
      
       Begin saving graphical output commands in an internal buffer; the
       commands are held until a matching PGEBUF call (or until the buffer
       is emptied by PGUPDT). This can greatly improve the efficiency of
       PGPLOT.  PGBBUF increments an internal counter, while PGEBUF
       decrements this counter and flushes the buffer to the output
       device when the counter drops to zero.  PGBBUF and PGEBUF calls
       should always be paired.
      
       Arguments: none

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgbbuf.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGBBUF -- begin batch of output (buffer)
C%void cpgbbuf(void);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgbbuf(  )
*

C+
      SUBROUTINE PGBBUF
C
C Begin saving graphical output commands in an internal buffer; the
C commands are held until a matching PGEBUF call (or until the buffer
C is emptied by PGUPDT). This can greatly improve the efficiency of
C PGPLOT.  PGBBUF increments an internal counter, while PGEBUF
C decrements this counter and flushes the buffer to the output
C device when the counter drops to zero.  PGBBUF and PGEBUF calls
C should always be paired.
C
C Arguments: none
C--
C 21-Nov-1985 - new routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      LOGICAL PGNOTO
C
      IF (.NOT.PGNOTO('PGBBUF')) THEN
          PGBLEV(PGID) = PGBLEV(PGID) + 1
      END IF
      END
#<

#>            pgbeg.dc2
Name:         PGBEG

Purpose:      open a graphics device

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            INTEGER FUNCTION PGBEG (UNIT, FILE, NXSUB, NYSUB)
            INTEGER       UNIT
            CHARACTER*(*) FILE
            INTEGER       NXSUB, NYSUB
      
       Note: new programs should use PGOPEN rather than PGBEG. PGOPEN
       is retained for compatibility with existing programs. Unlike PGOPEN,
       PGBEG closes any graphics devices that are already open, so it 
       cannot be used to open devices to be used in parallel.
      
       PGBEG opens a graphical device or file and prepares it for
       subsequent plotting. A device must be opened with PGBEG or PGOPEN
       before any other calls to PGPLOT subroutines for the device.
      
       If any device  is already open for PGPLOT output, it is closed before
       the new device is opened.
      
       Returns:
        PGBEG         : a status return value. A value of 1 indicates
                          successful completion, any other value indicates
                          an error. In the event of error a message is
                          written on the standard error unit.  
                          To test the return value, call
                          PGBEG as a function, eg IER=PGBEG(...); note
                          that PGBEG must be declared INTEGER in the
                          calling program. Some Fortran compilers allow
                          you to use CALL PGBEG(...) and discard the
                          return value, but this is not standard Fortran.
       Arguments:
        UNIT  (input)   : this argument is ignored by PGBEG (use zero).
        FILE  (input)   : the "device specification" for the plot device.
                          (For explanation, see description of PGOPEN.)
        NXSUB  (input)  : the number of subdivisions of the view surface in
                          X (>0 or <0).
        NYSUB  (input)  : the number of subdivisions of the view surface in
                          Y (>0).
                          PGPLOT puts NXSUB x NYSUB graphs on each plot
                          page or screen; when the view surface is sub-
                          divided in this way, PGPAGE moves to the next
                          panel, not the  next physical page. If
                          NXSUB > 0, PGPLOT uses the panels in row
                          order; if <0, PGPLOT uses them in column order.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgbeg.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGBEG -- open a graphics device
C%int cpgbeg(int unit, const char *file, int nxsub, int nysub);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ integer function pgbeg( integer, character, integer, integer )
*

C+
      INTEGER FUNCTION PGBEG (UNIT, FILE, NXSUB, NYSUB)
      INTEGER       UNIT
      CHARACTER*(*) FILE
      INTEGER       NXSUB, NYSUB
C
C Note: new programs should use PGOPEN rather than PGBEG. PGOPEN
C is retained for compatibility with existing programs. Unlike PGOPEN,
C PGBEG closes any graphics devices that are already open, so it 
C cannot be used to open devices to be used in parallel.
C
C PGBEG opens a graphical device or file and prepares it for
C subsequent plotting. A device must be opened with PGBEG or PGOPEN
C before any other calls to PGPLOT subroutines for the device.
C
C If any device  is already open for PGPLOT output, it is closed before
C the new device is opened.
C
C Returns:
C  PGBEG         : a status return value. A value of 1 indicates
C                    successful completion, any other value indicates
C                    an error. In the event of error a message is
C                    written on the standard error unit.  
C                    To test the return value, call
C                    PGBEG as a function, eg IER=PGBEG(...); note
C                    that PGBEG must be declared INTEGER in the
C                    calling program. Some Fortran compilers allow
C                    you to use CALL PGBEG(...) and discard the
C                    return value, but this is not standard Fortran.
C Arguments:
C  UNIT  (input)   : this argument is ignored by PGBEG (use zero).
C  FILE  (input)   : the "device specification" for the plot device.
C                    (For explanation, see description of PGOPEN.)
C  NXSUB  (input)  : the number of subdivisions of the view surface in
C                    X (>0 or <0).
C  NYSUB  (input)  : the number of subdivisions of the view surface in
C                    Y (>0).
C                    PGPLOT puts NXSUB x NYSUB graphs on each plot
C                    page or screen; when the view surface is sub-
C                    divided in this way, PGPAGE moves to the next
C                    panel, not the  next physical page. If
C                    NXSUB > 0, PGPLOT uses the panels in row
C                    order; if <0, PGPLOT uses them in column order.
C--
C 21-Dec-1995 [TJP] - changed for multiple devices; call PGOPEN.
C 27-Feb-1997 [TJP] - updated description.
C-----------------------------------------------------------------------
      INTEGER       IER
      INTEGER       PGOPEN
C
C Initialize PGPLOT if necessary.
C
      CALL PGINIT
C
C Close the plot-file if it is already open.
C
      CALL PGEND
C
C Call PGOPEN to open the device.
C
      IER = PGOPEN(FILE)
      IF (IER.GT.0) THEN
         CALL PGSUBP(NXSUB, NYSUB)
         PGBEG = 1
      ELSE
         PGBEG = IER
      END IF
C
      RETURN
      END
#<

#>            pgbegin.dc2
Name:         PGBEGIN

Purpose:      non-standard alias for PGBEG

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            INTEGER FUNCTION PGBEGIN (UNIT, FILE, NXSUB, NYSUB)
            INTEGER       UNIT
            CHARACTER*(*) FILE
            INTEGER       NXSUB, NYSUB
      
       See description of PGBEG.   

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgbegin.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGBEGIN -- non-standard alias for PGBEG
C+
      INTEGER FUNCTION PGBEGIN (UNIT, FILE, NXSUB, NYSUB)
      INTEGER       UNIT
      CHARACTER*(*) FILE
      INTEGER       NXSUB, NYSUB
C
C See description of PGBEG.   
C--
      INTEGER       PGBEG
      PGBEGIN = PGBEG (UNIT, FILE, NXSUB, NYSUB)
      END
#<

#>            pgbin.dc2
Name:         PGBIN

Purpose:      histogram of binned data

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGBIN (NBIN, X, DATA, CENTER)
            INTEGER NBIN
            REAL X(*), DATA(*)
            LOGICAL CENTER
      
       Plot a histogram of NBIN values with X(1..NBIN) values along
       the ordinate, and DATA(1...NBIN) along the abscissa. Bin width is
       spacing between X values.
      
       Arguments:
        NBIN   (input)  : number of values.
        X      (input)  : abscissae of bins.
        DATA   (input)  : data values of bins.
        CENTER (input)  : if .TRUE., the X values denote the center of the
                          bin; if .FALSE., the X values denote the lower
                          edge (in X) of the bin.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgbin.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGBIN -- histogram of binned data
C%void cpgbin(int nbin, const float *x, const float *data, \
C% Logical center);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgbin( integer, real, real, logical )
*

C+
      SUBROUTINE PGBIN (NBIN, X, DATA, CENTER)
      INTEGER NBIN
      REAL X(*), DATA(*)
      LOGICAL CENTER
C
C Plot a histogram of NBIN values with X(1..NBIN) values along
C the ordinate, and DATA(1...NBIN) along the abscissa. Bin width is
C spacing between X values.
C
C Arguments:
C  NBIN   (input)  : number of values.
C  X      (input)  : abscissae of bins.
C  DATA   (input)  : data values of bins.
C  CENTER (input)  : if .TRUE., the X values denote the center of the
C                    bin; if .FALSE., the X values denote the lower
C                    edge (in X) of the bin.
C--
C 19-Aug-92: change argument check (TJP).
C-----------------------------------------------------------------------
      LOGICAL  PGNOTO
      INTEGER  IBIN
      REAL     TX(4), TY(4)
C
C Check arguments.
C
      IF (NBIN.LT.2) RETURN
      IF (PGNOTO('PGBIN')) RETURN
      CALL PGBBUF
C
C Draw Histogram. Centered an uncentered bins are treated separately.
C
      IF (CENTER) THEN
C         !set up initial point.
          TX(2) = (3.*X(1) - X(2))/2.
          TY(2) = DATA(1)
          TX(3) = (X(1) + X(2))/2.
          TY(3) = TY(2)
          CALL GRVCT0(2, .FALSE., 2, TX(2), TY(2))
C         !draw initial horizontal line
C         !now loop over bins
          DO 10 IBIN=2,NBIN-1
              TX(1) = TX(3)
              TX(2) = TX(1)
              TX(3) = ( X(IBIN) + X(IBIN+1) ) / 2.
              TY(1) = TY(3)
              TY(2) = DATA(IBIN)
              TY(3) = TY(2)
              CALL GRVCT0(2, .FALSE., 3, TX, TY)
   10     CONTINUE
C         !now draw last segment.
          TX(1) = TX(3)
          TX(2) = TX(1)
          TX(3) = (3.*X(NBIN) - X(NBIN-1) )/2.
          TY(1) = TY(3)
          TY(2) = DATA(NBIN)
          TY(3) = TY(2)
          CALL GRVCT0(2, .FALSE., 3, TX, TY)
C
C               Uncentered bins
C
      ELSE
C         !set up first line.
          TX(2) = X(1)
          TY(2) = DATA(1)
          TX(3) = X(2)
          TY(3) = TY(2)
          CALL GRVCT0(2, .FALSE., 2, TX(2), TY(2))
          DO 20 IBIN=2,NBIN
              TX(1) = TX(3)
              TX(2) = TX(1)
              IF (IBIN.EQ.NBIN) THEN
                  TX(3) = 2.*X(NBIN) - X(NBIN-1)
              ELSE
                  TX(3) = X(IBIN+1)
              END IF
              TY(1) = TY(3)
C             !get height for last segment.
              TY(2) = DATA(IBIN)
              TY(3) = TY(2)
              CALL GRVCT0(2, .FALSE., 3, TX, TY)
   20     CONTINUE
      END IF
C
      CALL PGEBUF
      END
#<

#>            pgbox.dc2
Name:         PGBOX

Purpose:      draw labeled frame around viewport

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGBOX (XOPT, XTICK, NXSUB, YOPT, YTICK, NYSUB)
            CHARACTER*(*) XOPT, YOPT
            REAL XTICK, YTICK
            INTEGER NXSUB, NYSUB
      
       Annotate the viewport with frame, axes, numeric labels, etc.
       PGBOX is called by on the user's behalf by PGENV, but may also be
       called explicitly.
      
       Arguments:
        XOPT   (input)  : string of options for X (horizontal) axis of
                          plot. Options are single letters, and may be in
                          any order (see below).
        XTICK  (input)  : world coordinate interval between major tick marks
                          on X axis. If XTICK=0.0, the interval is chosen by
                          PGBOX, so that there will be at least 3 major tick
                          marks along the axis.
        NXSUB  (input)  : the number of subintervals to divide the major
                          coordinate interval into. If XTICK=0.0 or NXSUB=0,
                          the number is chosen by PGBOX.
        YOPT   (input)  : string of options for Y (vertical) axis of plot.
                          Coding is the same as for XOPT.
        YTICK  (input)  : like XTICK for the Y axis.
        NYSUB  (input)  : like NXSUB for the Y axis.
      
       Options (for parameters XOPT and YOPT):
        A : draw Axis (X axis is horizontal line Y=0, Y axis is vertical
            line X=0).
        B : draw bottom (X) or left (Y) edge of frame.
        C : draw top (X) or right (Y) edge of frame.
        G : draw Grid of vertical (X) or horizontal (Y) lines.
        I : Invert the tick marks; ie draw them outside the viewport
            instead of inside.
        L : label axis Logarithmically (see below).
        N : write Numeric labels in the conventional location below the
            viewport (X) or to the left of the viewport (Y).
        P : extend ("Project") major tick marks outside the box (ignored if
            option I is specified).
        M : write numeric labels in the unconventional location above the
            viewport (X) or to the right of the viewport (Y).
        T : draw major Tick marks at the major coordinate interval.
        S : draw minor tick marks (Subticks).
        V : orient numeric labels Vertically. This is only applicable to Y.
            The default is to write Y-labels parallel to the axis.
        1 : force decimal labelling, instead of automatic choice (see PGNUMB).
        2 : force exponential labelling, instead of automatic.
      
       To get a complete frame, specify BC in both XOPT and YOPT.
       Tick marks, if requested, are drawn on the axes or frame
       or both, depending which are requested. If none of ABC is specified,
       tick marks will not be drawn. When PGENV calls PGBOX, it sets both
       XOPT and YOPT according to the value of its parameter AXIS:
       -1: 'BC', 0: 'BCNST', 1: 'ABCNST', 2: 'ABCGNST'.
      
       For a logarithmic axis, the major tick interval is always 1.0. The
       numeric label is 10**(x) where x is the world coordinate at the
       tick mark. If subticks are requested, 8 subticks are drawn between
       each major tick at equal logarithmic intervals.
      
       To label an axis with time (days, hours, minutes, seconds) or
       angle (degrees, arcmin, arcsec), use routine PGTBOX.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
              Oct 21, 1998: JPT record Y-label lenght for PGLAB.
#<

#>            pgbox.f
* GIPSY-modified
*

C*PGBOX -- draw labeled frame around viewport
C%void cpgbox(const char *xopt, float xtick, int nxsub, \
C% const char *yopt, float ytick, int nysub);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgbox( character, real, integer, character, real, integer )
*

C+
      SUBROUTINE PGBOX (XOPT, XTICK, NXSUB, YOPT, YTICK, NYSUB)
      CHARACTER*(*) XOPT, YOPT
      REAL XTICK, YTICK
      INTEGER NXSUB, NYSUB
C
C Annotate the viewport with frame, axes, numeric labels, etc.
C PGBOX is called by on the user's behalf by PGENV, but may also be
C called explicitly.
C
C Arguments:
C  XOPT   (input)  : string of options for X (horizontal) axis of
C                    plot. Options are single letters, and may be in
C                    any order (see below).
C  XTICK  (input)  : world coordinate interval between major tick marks
C                    on X axis. If XTICK=0.0, the interval is chosen by
C                    PGBOX, so that there will be at least 3 major tick
C                    marks along the axis.
C  NXSUB  (input)  : the number of subintervals to divide the major
C                    coordinate interval into. If XTICK=0.0 or NXSUB=0,
C                    the number is chosen by PGBOX.
C  YOPT   (input)  : string of options for Y (vertical) axis of plot.
C                    Coding is the same as for XOPT.
C  YTICK  (input)  : like XTICK for the Y axis.
C  NYSUB  (input)  : like NXSUB for the Y axis.
C
C Options (for parameters XOPT and YOPT):
C  A : draw Axis (X axis is horizontal line Y=0, Y axis is vertical
C      line X=0).
C  B : draw bottom (X) or left (Y) edge of frame.
C  C : draw top (X) or right (Y) edge of frame.
C  G : draw Grid of vertical (X) or horizontal (Y) lines.
C  I : Invert the tick marks; ie draw them outside the viewport
C      instead of inside.
C  L : label axis Logarithmically (see below).
C  N : write Numeric labels in the conventional location below the
C      viewport (X) or to the left of the viewport (Y).
C  P : extend ("Project") major tick marks outside the box (ignored if
C      option I is specified).
C  M : write numeric labels in the unconventional location above the
C      viewport (X) or to the right of the viewport (Y).
C  T : draw major Tick marks at the major coordinate interval.
C  S : draw minor tick marks (Subticks).
C  V : orient numeric labels Vertically. This is only applicable to Y.
C      The default is to write Y-labels parallel to the axis.
C  1 : force decimal labelling, instead of automatic choice (see PGNUMB).
C  2 : force exponential labelling, instead of automatic.
C
C To get a complete frame, specify BC in both XOPT and YOPT.
C Tick marks, if requested, are drawn on the axes or frame
C or both, depending which are requested. If none of ABC is specified,
C tick marks will not be drawn. When PGENV calls PGBOX, it sets both
C XOPT and YOPT according to the value of its parameter AXIS:
C -1: 'BC', 0: 'BCNST', 1: 'ABCNST', 2: 'ABCGNST'.
C
C For a logarithmic axis, the major tick interval is always 1.0. The
C numeric label is 10**(x) where x is the world coordinate at the
C tick mark. If subticks are requested, 8 subticks are drawn between
C each major tick at equal logarithmic intervals.
C
C To label an axis with time (days, hours, minutes, seconds) or
C angle (degrees, arcmin, arcsec), use routine PGTBOX.
C--
C 19-Oct-1983
C 23-Sep-1984 - fix bug in labelling reversed logarithmic axes.
C  6-May-1985 - improve behavior for pen plotters [TJP].
C 23-Nov-1985 - add 'P' option [TJP].
C 14-Jan-1986 - use new routine PGBOX1 to fix problem of missing
C               labels at end of axis [TJP].
C  8-Apr-1987 - improve automatic choice of tick interval; improve
C               erroneous rounding of tick interval to 1 digit [TJP].
C 23-Apr-1987 - fix bug: limit max number of ticks to ~10 [TJP].
C  7-Nov-1987 - yet another change to algorithm for choosing tick
C               interval; maximum tick interval is now 0.2*range of
C               axis, which may round up to 0.5 [TJP].
C 15-Dec-1988 - correct declaration of MAJOR [TJP].
C  6-Sep-1989 - use Fortran generic intrinsic functions [TJP].
C 18-Oct-1990 - correctly initialize UTAB(1) [AFT].
C 19-Oct-1990 - do all plotting in world coordinates [TJP].
C  6-Nov-1991 - label logarithmic subticks when necessary [TJP].
C  4-Jul-1994 - add '1' and '2' options [TJP].
C 20-Apr-1995 - adjust position of labels slightly, and move out
C               when ticks are inverted [TJP].
C 26-Feb-1997 - use new routine pgclp [TJP].
C 21-Oct-1998 - record maximum Y-label length [JPT]
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
      CHARACTER*20  CLBL
      CHARACTER*64  OPT
      LOGICAL  XOPTA, XOPTB, XOPTC, XOPTG, XOPTN, XOPTM, XOPTT, XOPTS
      LOGICAL  YOPTA, YOPTB, YOPTC, YOPTG, YOPTN, YOPTM, YOPTT, YOPTS
      LOGICAL  XOPTI, YOPTI, YOPTV, XOPTL, YOPTL, XOPTP, YOPTP, RANGE
      LOGICAL  IRANGE, MAJOR, XOPTLS, YOPTLS, PGNOTO
      REAL     TAB(9), UTAB(9)
      INTEGER  I, I1, I2, J, NC, NP, NV, KI, CLIP
      INTEGER  NSUBX, NSUBY, JMAX, XNFORM, YNFORM
      REAL     TIKL, TIKL1, TIKL2, XC, YC
      REAL     XINT, XINT2, XVAL, YINT, YINT2, YVAL
      REAL     PGRND
      REAL     A, B, C
      REAL     XNDSP, XMDSP, YNDSP, YMDSP, YNVDSP, YMVDSP
      REAL     XBLC, XTRC, YBLC, YTRC
      REAL     XL, YL
      INTRINSIC ABS, INDEX, INT, LOG10, MAX, MIN, MOD, NINT, SIGN, REAL
C
C Table of logarithms 1..9
C
      DATA TAB / 0.00000, 0.30103, 0.47712, 0.60206, 0.69897,
     1           0.77815, 0.84510, 0.90309, 0.95424 /
C
      RANGE(A,B,C) = (A.LT.B.AND.B.LT.C) .OR. (C.LT.B.AND.B.LT.A)
      IRANGE(A,B,C) = (A.LE.B.AND.B.LE.C) .OR. (C.LE.B.AND.B.LE.A)
C
      IF (PGNOTO('PGBOX')) RETURN
      CALL PGBBUF
      CALL PGQWIN(XBLC, XTRC, YBLC, YTRC)
C
C Decode options.
C
      CALL GRTOUP(OPT,XOPT)
      XOPTA = INDEX(OPT,'A').NE.0 .AND. RANGE(YBLC,0.0,YTRC)
      XOPTB = INDEX(OPT,'B').NE.0
      XOPTC = INDEX(OPT,'C').NE.0
      XOPTG = INDEX(OPT,'G').NE.0
      XOPTI = INDEX(OPT,'I').NE.0
      XOPTL = INDEX(OPT,'L').NE.0
      XOPTM = INDEX(OPT,'M').NE.0
      XOPTN = INDEX(OPT,'N').NE.0
      XOPTS = INDEX(OPT,'S').NE.0
      XOPTT = INDEX(OPT,'T').NE.0
      XOPTP = INDEX(OPT,'P').NE.0 .AND. (.NOT.XOPTI)
      XNFORM = 0
      IF (INDEX(OPT,'1').NE.0) XNFORM = 1
      IF (INDEX(OPT,'2').NE.0) XNFORM = 2
      CALL GRTOUP(OPT,YOPT)
      YOPTA = INDEX(OPT,'A').NE.0 .AND. RANGE(XBLC,0.0,XTRC)
      YOPTB = INDEX(OPT,'B').NE.0
      YOPTC = INDEX(OPT,'C').NE.0
      YOPTG = INDEX(OPT,'G').NE.0
      YOPTI = INDEX(OPT,'I').NE.0
      YOPTL = INDEX(OPT,'L').NE.0
      YOPTN = INDEX(OPT,'N').NE.0
      YOPTM = INDEX(OPT,'M').NE.0
      YOPTS = INDEX(OPT,'S').NE.0
      YOPTT = INDEX(OPT,'T').NE.0
      YOPTV = INDEX(OPT,'V').NE.0
      YOPTP = INDEX(OPT,'P').NE.0 .AND. (.NOT.YOPTI)
      YNFORM = 0
      IF (INDEX(OPT,'1').NE.0) YNFORM = 1
      IF (INDEX(OPT,'2').NE.0) YNFORM = 2
C
C Displacement of labels from edge of box
C (for X bottom/top, Y left/right, and Y left/right with V option).
C
      XNDSP = 1.2
      XMDSP = 0.7
      YNDSP = 0.7
      YMDSP = 1.2
      YNVDSP = 0.7
      YMVDSP = 0.7
      IF (XOPTI) THEN
         XNDSP = XNDSP + 0.3
         XMDSP = XMDSP + 0.3
      END IF
      IF (YOPTI) THEN
         YNDSP = YNDSP + 0.3
         YMDSP = YMDSP + 0.3
         YNVDSP = YNVDSP + 0.3
         YMVDSP = YMVDSP + 0.3
      END IF
C
C Initialize max. Y label length
C
      PGLLEN(PGID) = 0.0
C
C Disable clipping.
C
      CALL PGQCLP(CLIP)
      CALL PGSCLP(0)
C
C Draw box.
C
      IF (XOPTB) THEN
          CALL GRMOVA(XBLC, YBLC)
          CALL GRLINA(XTRC, YBLC)
      END IF
      IF (YOPTC) THEN
          CALL GRMOVA(XTRC, YBLC)
          CALL GRLINA(XTRC, YTRC)
      END IF
      IF (XOPTC) THEN
          CALL GRMOVA(XTRC, YTRC)
          CALL GRLINA(XBLC, YTRC)
      END IF
      IF (YOPTB) THEN
          CALL GRMOVA(XBLC, YTRC)
          CALL GRLINA(XBLC, YBLC)
      END IF
C
C Draw axes if required.
C
      IF (XOPTA.AND..NOT.XOPTG) THEN
          CALL GRMOVA(XBLC, 0.0)
          CALL GRLINA(XTRC, 0.0)
      END IF
      IF (YOPTA.AND..NOT.YOPTG) THEN
          CALL GRMOVA(0.0, YBLC)
          CALL GRLINA(0.0, YTRC)
      END IF
C
C Length of X tick marks.
C
      TIKL1 = PGXSP(PGID)*0.6*(YTRC-YBLC)/PGYLEN(PGID)
      IF (XOPTI) TIKL1 = -TIKL1
      TIKL2 = TIKL1*0.5
C
C Choose X tick intervals. Major interval = XINT,
C minor interval = XINT2 = XINT/NSUBX.
C
      UTAB(1) = 0.0
      IF (XOPTL) THEN
          XINT = SIGN(1.0,XTRC-XBLC)
          NSUBX = 1
          DO 10 J=2,9
              UTAB(J) = TAB(J)
              IF (XINT.LT.0.0) UTAB(J) = 1.0-TAB(J)
   10     CONTINUE
      ELSE IF (XTICK.EQ.0.0) THEN
          XINT = MAX(0.05, MIN(7.0*PGXSP(PGID)/PGXLEN(PGID), 0.20))
     1           *(XTRC-XBLC)
          XINT = PGRND(XINT,NSUBX)
      ELSE
          XINT = SIGN(XTICK,XTRC-XBLC)
          NSUBX = MAX(NXSUB,1)
      END IF
      IF (.NOT.XOPTS) NSUBX = 1
      NP = INT(LOG10(ABS(XINT)))-4
      NV = NINT(XINT/10.**NP)
      XINT2 = XINT/NSUBX
      XOPTLS = XOPTL .AND. XOPTS .AND. (ABS(XTRC-XBLC).LT.2.0)
C
C Draw X grid.
C
      IF (XOPTG) THEN
          CALL PGBOX1(XBLC, XTRC, XINT, I1, I2)
          DO 20 I=I1,I2
              CALL GRMOVA(REAL(I)*XINT, YBLC)
              CALL GRLINA(REAL(I)*XINT, YTRC)
   20     CONTINUE
      END IF
C
C Draw X ticks.
C
      IF (XOPTT.OR.XOPTS) THEN
          CALL PGBOX1(XBLC, XTRC, XINT2, I1, I2)
          JMAX = 1
          IF (XOPTL.AND.XOPTS) JMAX=9
C
C         Bottom ticks.
C
          IF (XOPTB) THEN
            DO 40 I=I1-1,I2
            DO 30 J=1,JMAX
                MAJOR = (MOD(I,NSUBX).EQ.0).AND.XOPTT.AND.J.EQ.1
                TIKL = TIKL2
                IF (MAJOR) TIKL = TIKL1
                XVAL = (I+UTAB(J))*XINT2
                IF (IRANGE(XBLC,XVAL,XTRC)) THEN
                    IF (XOPTP.AND.MAJOR) THEN
                        CALL GRMOVA(XVAL, YBLC-TIKL2)
                    ELSE
                        CALL GRMOVA(XVAL, YBLC)
                    END IF
                    CALL GRLINA(XVAL, YBLC+TIKL)
                END IF
   30        CONTINUE
   40       CONTINUE
          END IF
C
C         Axis ticks.
C
          IF (XOPTA) THEN
            DO 60 I=I1-1,I2
            DO 50 J=1,JMAX
                MAJOR = (MOD(I,NSUBX).EQ.0).AND.XOPTT.AND.J.EQ.1
                TIKL = TIKL2
                IF (MAJOR) TIKL = TIKL1
                XVAL = (I+UTAB(J))*XINT2
                IF (IRANGE(XBLC,XVAL,XTRC)) THEN
                    CALL GRMOVA(XVAL, -TIKL)
                    CALL GRLINA(XVAL, TIKL)
                END IF
   50       CONTINUE
   60       CONTINUE
          END IF
C
C         Top ticks.
C
          IF (XOPTC) THEN
            DO 80 I=I1-1,I2
            DO 70 J=1,JMAX
                MAJOR = (MOD(I,NSUBX).EQ.0).AND.XOPTT.AND.J.EQ.1
                TIKL = TIKL2
                IF (MAJOR) TIKL = TIKL1
                XVAL = (I+UTAB(J))*XINT2
                IF (IRANGE(XBLC,XVAL,XTRC)) THEN
                    CALL GRMOVA(XVAL, YTRC-TIKL)
                    CALL GRLINA(XVAL, YTRC)
                END IF
   70       CONTINUE
   80       CONTINUE
          END IF
      END IF
C
C Write X labels.
C
      IF (XOPTN .OR. XOPTM) THEN
          CALL PGBOX1(XBLC, XTRC, XINT, I1, I2)
          DO 90 I=I1,I2
              XC = (I*XINT-XBLC)/(XTRC-XBLC)
              IF (XOPTL) THEN
                  CALL PGNUMB(1,NINT(I*XINT),XNFORM,CLBL,NC)
              ELSE
                  CALL PGNUMB(I*NV,NP,XNFORM,CLBL,NC)
              END IF
              IF (XOPTN) CALL PGMTXT('B', XNDSP, XC, 0.5, CLBL(1:NC))
              IF (XOPTM) CALL PGMTXT('T', XMDSP, XC, 0.5, CLBL(1:NC))
   90     CONTINUE
      END IF
C
C Extra X labels for log axes.
C
      IF (XOPTLS) THEN
          CALL PGBOX1(XBLC, XTRC, XINT2, I1, I2)
          DO 401 I=I1-1,I2
             DO 301 J=2,5,3
                XVAL = (I+UTAB(J))*XINT2
                XC = (XVAL-XBLC)/(XTRC-XBLC)
                KI = I
                IF (XTRC.LT.XBLC) KI = KI+1
                IF (IRANGE(XBLC,XVAL,XTRC)) THEN
                    CALL PGNUMB(J,NINT(KI*XINT2),XNFORM,CLBL,NC)
                    IF (XOPTN) 
     1                CALL PGMTXT('B', XNDSP, XC, 0.5, CLBL(1:NC))
                    IF (XOPTM) 
     1                CALL PGMTXT('T', XMDSP, XC, 0.5, CLBL(1:NC))
                END IF
  301       CONTINUE
  401     CONTINUE
      END IF
C
C Length of Y tick marks.
C
      TIKL1 = PGXSP(PGID)*0.6*(XTRC-XBLC)/PGXLEN(PGID)
      IF (YOPTI) TIKL1 = -TIKL1
      TIKL2 = TIKL1*0.5
C
C Choose Y tick intervals. Major interval = YINT,
C minor interval = YINT2 = YINT/NSUBY.
C
      UTAB(1) = 0.0
      IF (YOPTL) THEN
          YINT = SIGN(1.0,YTRC-YBLC)
          NSUBY = 1
          DO 100 J=2,9
              UTAB(J) = TAB(J)
              IF (YINT.LT.0.0) UTAB(J) = 1.0-TAB(J)
  100     CONTINUE
      ELSE IF (YTICK.EQ.0.0) THEN
          YINT = MAX(0.05, MIN(7.0*PGXSP(PGID)/PGYLEN(PGID), 0.20))
     1           *(YTRC-YBLC)
          YINT = PGRND(YINT,NSUBY)
      ELSE
          YINT  = SIGN(YTICK,YTRC-YBLC)
          NSUBY = MAX(NYSUB,1)
      END IF
      IF (.NOT.YOPTS) NSUBY = 1
      NP = INT(LOG10(ABS(YINT)))-4
      NV = NINT(YINT/10.**NP)
      YINT2 = YINT/NSUBY
      YOPTLS = YOPTL .AND. YOPTS .AND. (ABS(YTRC-YBLC).LT.2.0)
C
C Draw Y grid.
C
      IF (YOPTG) THEN
          CALL PGBOX1(YBLC, YTRC, YINT, I1, I2)
          DO 110 I=I1,I2
              CALL GRMOVA(XBLC, REAL(I)*YINT)
              CALL GRLINA(XTRC, REAL(I)*YINT)
  110     CONTINUE
      END IF
C
C Draw Y ticks.
C
      IF (YOPTT.OR.YOPTS) THEN
          CALL PGBOX1(YBLC, YTRC, YINT2, I1, I2)
          JMAX = 1
          IF (YOPTL.AND.YOPTS) JMAX = 9
C
C               Left ticks.
C
            IF (YOPTB) THEN
            DO 130 I=I1-1,I2
            DO 120 J=1,JMAX
                MAJOR = (MOD(I,NSUBY).EQ.0).AND.YOPTT.AND.J.EQ.1
                TIKL = TIKL2
                IF (MAJOR) TIKL = TIKL1
                YVAL = (I+UTAB(J))*YINT2
                IF (IRANGE(YBLC,YVAL,YTRC)) THEN
                    IF (YOPTP.AND.MAJOR) THEN
                        CALL GRMOVA(XBLC-TIKL2, YVAL)
                    ELSE
                        CALL GRMOVA(XBLC, YVAL)
                    END IF
                    CALL GRLINA(XBLC+TIKL, YVAL)
                END IF
  120       CONTINUE
  130       CONTINUE
            END IF
C
C               Axis ticks.
C
            IF (YOPTA) THEN
            DO 150 I=I1-1,I2
            DO 140 J=1,JMAX
                MAJOR = (MOD(I,NSUBY).EQ.0).AND.YOPTT.AND.J.EQ.1
                TIKL = TIKL2
                IF (MAJOR) TIKL = TIKL1
                YVAL = (I+UTAB(J))*YINT2
                IF (IRANGE(YBLC,YVAL,YTRC)) THEN
                    CALL GRMOVA(-TIKL, YVAL)
                    CALL GRLINA(TIKL, YVAL)
                END IF
  140       CONTINUE
  150       CONTINUE
            END IF
C
C               Right ticks.
C
            IF (YOPTC) THEN
            DO 170 I=I1-1,I2
            DO 160 J=1,JMAX
                MAJOR = (MOD(I,NSUBY).EQ.0).AND.YOPTT.AND.J.EQ.1
                TIKL = TIKL2
                IF (MAJOR) TIKL = TIKL1
                YVAL = (I+UTAB(J))*YINT2
                IF (IRANGE(YBLC,YVAL,YTRC)) THEN
                    CALL GRMOVA(XTRC-TIKL, YVAL)
                    CALL GRLINA(XTRC, YVAL)
                END IF
  160       CONTINUE
  170       CONTINUE
            END IF
        END IF
C
C Write Y labels.
C
      IF (YOPTN.OR.YOPTM) THEN
          CALL PGBOX1(YBLC, YTRC, YINT, I1, I2)
          DO 180 I=I1,I2
              YC = (I*YINT-YBLC)/(YTRC-YBLC)
              IF (YOPTL) THEN
                  CALL PGNUMB(1,NINT(I*YINT),YNFORM,CLBL,NC)
              ELSE
                  CALL PGNUMB(I*NV,NP,YNFORM,CLBL,NC)
              END IF
              IF (YOPTV) THEN
                  IF (YOPTN) CALL PGMTXT('LV',YNVDSP,YC,1.0,CLBL(1:NC))
                  IF (YOPTM) CALL PGMTXT('RV',YMVDSP,YC,0.0,CLBL(1:NC))
                  CALL PGLEN(4, CLBL(1:NC), XL, YL)
                  IF (XL .GT. PGLLEN(PGID)) THEN
                      PGLLEN(PGID) = XL
                  END IF
              ELSE
                  IF (YOPTN) CALL PGMTXT('L',YNDSP,YC,0.5,CLBL(1:NC))
                  IF (YOPTM) CALL PGMTXT('R',YMDSP,YC,0.5,CLBL(1:NC))
              END IF
  180     CONTINUE
      END IF
C
C Extra Y labels for log axes.
C
      IF (YOPTLS) THEN
          CALL PGBOX1(YBLC, YTRC, YINT2, I1, I2)
          DO 402 I=I1-1,I2
            DO 302 J=2,5,3
                YVAL = (I+UTAB(J))*YINT2
                YC = (YVAL-YBLC)/(YTRC-YBLC)
                KI = I
                IF (YBLC.GT.YTRC) KI = KI+1
                IF (IRANGE(YBLC,YVAL,YTRC)) THEN
                    CALL PGNUMB(J,NINT(KI*YINT2),YNFORM,CLBL,NC)
                    IF (YOPTV) THEN
                    IF (YOPTN) 
     1                CALL PGMTXT('LV', YNVDSP, YC, 1.0, CLBL(1:NC))
                    IF (YOPTM) 
     1                CALL PGMTXT('RV', YMVDSP, YC, 0.0, CLBL(1:NC))
                    ELSE
                    IF (YOPTN) 
     1                CALL PGMTXT('L', YNDSP, YC, 0.5, CLBL(1:NC))
                    IF (YOPTM) 
     1                CALL PGMTXT('R', YMDSP, YC, 0.5, CLBL(1:NC))
                    END IF
                END IF
  302       CONTINUE
  402     CONTINUE
      END IF
C
C Enable clipping.
C
      CALL PGSCLP(CLIP)
C
      CALL PGEBUF
      END
#<

#>            pgbox.f.orig
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGBOX -- draw labeled frame around viewport
C%void cpgbox(const char *xopt, float xtick, int nxsub, \
C% const char *yopt, float ytick, int nysub);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgbox( character, real, integer, character, real, integer )
*

C+
      SUBROUTINE PGBOX (XOPT, XTICK, NXSUB, YOPT, YTICK, NYSUB)
      CHARACTER*(*) XOPT, YOPT
      REAL XTICK, YTICK
      INTEGER NXSUB, NYSUB
C
C Annotate the viewport with frame, axes, numeric labels, etc.
C PGBOX is called by on the user's behalf by PGENV, but may also be
C called explicitly.
C
C Arguments:
C  XOPT   (input)  : string of options for X (horizontal) axis of
C                    plot. Options are single letters, and may be in
C                    any order (see below).
C  XTICK  (input)  : world coordinate interval between major tick marks
C                    on X axis. If XTICK=0.0, the interval is chosen by
C                    PGBOX, so that there will be at least 3 major tick
C                    marks along the axis.
C  NXSUB  (input)  : the number of subintervals to divide the major
C                    coordinate interval into. If XTICK=0.0 or NXSUB=0,
C                    the number is chosen by PGBOX.
C  YOPT   (input)  : string of options for Y (vertical) axis of plot.
C                    Coding is the same as for XOPT.
C  YTICK  (input)  : like XTICK for the Y axis.
C  NYSUB  (input)  : like NXSUB for the Y axis.
C
C Options (for parameters XOPT and YOPT):
C  A : draw Axis (X axis is horizontal line Y=0, Y axis is vertical
C      line X=0).
C  B : draw bottom (X) or left (Y) edge of frame.
C  C : draw top (X) or right (Y) edge of frame.
C  G : draw Grid of vertical (X) or horizontal (Y) lines.
C  I : Invert the tick marks; ie draw them outside the viewport
C      instead of inside.
C  L : label axis Logarithmically (see below).
C  N : write Numeric labels in the conventional location below the
C      viewport (X) or to the left of the viewport (Y).
C  P : extend ("Project") major tick marks outside the box (ignored if
C      option I is specified).
C  M : write numeric labels in the unconventional location above the
C      viewport (X) or to the right of the viewport (Y).
C  T : draw major Tick marks at the major coordinate interval.
C  S : draw minor tick marks (Subticks).
C  V : orient numeric labels Vertically. This is only applicable to Y.
C      The default is to write Y-labels parallel to the axis.
C  1 : force decimal labelling, instead of automatic choice (see PGNUMB).
C  2 : force exponential labelling, instead of automatic.
C
C To get a complete frame, specify BC in both XOPT and YOPT.
C Tick marks, if requested, are drawn on the axes or frame
C or both, depending which are requested. If none of ABC is specified,
C tick marks will not be drawn. When PGENV calls PGBOX, it sets both
C XOPT and YOPT according to the value of its parameter AXIS:
C -1: 'BC', 0: 'BCNST', 1: 'ABCNST', 2: 'ABCGNST'.
C
C For a logarithmic axis, the major tick interval is always 1.0. The
C numeric label is 10**(x) where x is the world coordinate at the
C tick mark. If subticks are requested, 8 subticks are drawn between
C each major tick at equal logarithmic intervals.
C
C To label an axis with time (days, hours, minutes, seconds) or
C angle (degrees, arcmin, arcsec), use routine PGTBOX.
C--
C 19-Oct-1983
C 23-Sep-1984 - fix bug in labelling reversed logarithmic axes.
C  6-May-1985 - improve behavior for pen plotters [TJP].
C 23-Nov-1985 - add 'P' option [TJP].
C 14-Jan-1986 - use new routine PGBOX1 to fix problem of missing
C               labels at end of axis [TJP].
C  8-Apr-1987 - improve automatic choice of tick interval; improve
C               erroneous rounding of tick interval to 1 digit [TJP].
C 23-Apr-1987 - fix bug: limit max number of ticks to ~10 [TJP].
C  7-Nov-1987 - yet another change to algorithm for choosing tick
C               interval; maximum tick interval is now 0.2*range of
C               axis, which may round up to 0.5 [TJP].
C 15-Dec-1988 - correct declaration of MAJOR [TJP].
C  6-Sep-1989 - use Fortran generic intrinsic functions [TJP].
C 18-Oct-1990 - correctly initialize UTAB(1) [AFT].
C 19-Oct-1990 - do all plotting in world coordinates [TJP].
C  6-Nov-1991 - label logarithmic subticks when necessary [TJP].
C  4-Jul-1994 - add '1' and '2' options [TJP].
C 20-Apr-1995 - adjust position of labels slightly, and move out
C               when ticks are inverted [TJP].
C 26-Feb-1997 - use new routine pgclp [TJP].
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
      CHARACTER*20  CLBL
      CHARACTER*64  OPT
      LOGICAL  XOPTA, XOPTB, XOPTC, XOPTG, XOPTN, XOPTM, XOPTT, XOPTS
      LOGICAL  YOPTA, YOPTB, YOPTC, YOPTG, YOPTN, YOPTM, YOPTT, YOPTS
      LOGICAL  XOPTI, YOPTI, YOPTV, XOPTL, YOPTL, XOPTP, YOPTP, RANGE
      LOGICAL  IRANGE, MAJOR, XOPTLS, YOPTLS, PGNOTO
      REAL     TAB(9), UTAB(9)
      INTEGER  I, I1, I2, J, NC, NP, NV, KI, CLIP
      INTEGER  NSUBX, NSUBY, JMAX, XNFORM, YNFORM
      REAL     TIKL, TIKL1, TIKL2, XC, YC
      REAL     XINT, XINT2, XVAL, YINT, YINT2, YVAL
      REAL     PGRND
      REAL     A, B, C
      REAL     XNDSP, XMDSP, YNDSP, YMDSP, YNVDSP, YMVDSP
      REAL     XBLC, XTRC, YBLC, YTRC
      INTRINSIC ABS, INDEX, INT, LOG10, MAX, MIN, MOD, NINT, SIGN, REAL
C
C Table of logarithms 1..9
C
      DATA TAB / 0.00000, 0.30103, 0.47712, 0.60206, 0.69897,
     1           0.77815, 0.84510, 0.90309, 0.95424 /
C
      RANGE(A,B,C) = (A.LT.B.AND.B.LT.C) .OR. (C.LT.B.AND.B.LT.A)
      IRANGE(A,B,C) = (A.LE.B.AND.B.LE.C) .OR. (C.LE.B.AND.B.LE.A)
C
      IF (PGNOTO('PGBOX')) RETURN
      CALL PGBBUF
      CALL PGQWIN(XBLC, XTRC, YBLC, YTRC)
C
C Decode options.
C
      CALL GRTOUP(OPT,XOPT)
      XOPTA = INDEX(OPT,'A').NE.0 .AND. RANGE(YBLC,0.0,YTRC)
      XOPTB = INDEX(OPT,'B').NE.0
      XOPTC = INDEX(OPT,'C').NE.0
      XOPTG = INDEX(OPT,'G').NE.0
      XOPTI = INDEX(OPT,'I').NE.0
      XOPTL = INDEX(OPT,'L').NE.0
      XOPTM = INDEX(OPT,'M').NE.0
      XOPTN = INDEX(OPT,'N').NE.0
      XOPTS = INDEX(OPT,'S').NE.0
      XOPTT = INDEX(OPT,'T').NE.0
      XOPTP = INDEX(OPT,'P').NE.0 .AND. (.NOT.XOPTI)
      XNFORM = 0
      IF (INDEX(OPT,'1').NE.0) XNFORM = 1
      IF (INDEX(OPT,'2').NE.0) XNFORM = 2
      CALL GRTOUP(OPT,YOPT)
      YOPTA = INDEX(OPT,'A').NE.0 .AND. RANGE(XBLC,0.0,XTRC)
      YOPTB = INDEX(OPT,'B').NE.0
      YOPTC = INDEX(OPT,'C').NE.0
      YOPTG = INDEX(OPT,'G').NE.0
      YOPTI = INDEX(OPT,'I').NE.0
      YOPTL = INDEX(OPT,'L').NE.0
      YOPTN = INDEX(OPT,'N').NE.0
      YOPTM = INDEX(OPT,'M').NE.0
      YOPTS = INDEX(OPT,'S').NE.0
      YOPTT = INDEX(OPT,'T').NE.0
      YOPTV = INDEX(OPT,'V').NE.0
      YOPTP = INDEX(OPT,'P').NE.0 .AND. (.NOT.YOPTI)
      YNFORM = 0
      IF (INDEX(OPT,'1').NE.0) YNFORM = 1
      IF (INDEX(OPT,'2').NE.0) YNFORM = 2
C
C Displacement of labels from edge of box
C (for X bottom/top, Y left/right, and Y left/right with V option).
C
      XNDSP = 1.2
      XMDSP = 0.7
      YNDSP = 0.7
      YMDSP = 1.2
      YNVDSP = 0.7
      YMVDSP = 0.7
      IF (XOPTI) THEN
         XNDSP = XNDSP + 0.3
         XMDSP = XMDSP + 0.3
      END IF
      IF (YOPTI) THEN
         YNDSP = YNDSP + 0.3
         YMDSP = YMDSP + 0.3
         YNVDSP = YNVDSP + 0.3
         YMVDSP = YMVDSP + 0.3
      END IF
C
C Disable clipping.
C
      CALL PGQCLP(CLIP)
      CALL PGSCLP(0)
C
C Draw box.
C
      IF (XOPTB) THEN
          CALL GRMOVA(XBLC, YBLC)
          CALL GRLINA(XTRC, YBLC)
      END IF
      IF (YOPTC) THEN
          CALL GRMOVA(XTRC, YBLC)
          CALL GRLINA(XTRC, YTRC)
      END IF
      IF (XOPTC) THEN
          CALL GRMOVA(XTRC, YTRC)
          CALL GRLINA(XBLC, YTRC)
      END IF
      IF (YOPTB) THEN
          CALL GRMOVA(XBLC, YTRC)
          CALL GRLINA(XBLC, YBLC)
      END IF
C
C Draw axes if required.
C
      IF (XOPTA.AND..NOT.XOPTG) THEN
          CALL GRMOVA(XBLC, 0.0)
          CALL GRLINA(XTRC, 0.0)
      END IF
      IF (YOPTA.AND..NOT.YOPTG) THEN
          CALL GRMOVA(0.0, YBLC)
          CALL GRLINA(0.0, YTRC)
      END IF
C
C Length of X tick marks.
C
      TIKL1 = PGXSP(PGID)*0.6*(YTRC-YBLC)/PGYLEN(PGID)
      IF (XOPTI) TIKL1 = -TIKL1
      TIKL2 = TIKL1*0.5
C
C Choose X tick intervals. Major interval = XINT,
C minor interval = XINT2 = XINT/NSUBX.
C
      UTAB(1) = 0.0
      IF (XOPTL) THEN
          XINT = SIGN(1.0,XTRC-XBLC)
          NSUBX = 1
          DO 10 J=2,9
              UTAB(J) = TAB(J)
              IF (XINT.LT.0.0) UTAB(J) = 1.0-TAB(J)
   10     CONTINUE
      ELSE IF (XTICK.EQ.0.0) THEN
          XINT = MAX(0.05, MIN(7.0*PGXSP(PGID)/PGXLEN(PGID), 0.20))
     1           *(XTRC-XBLC)
          XINT = PGRND(XINT,NSUBX)
      ELSE
          XINT = SIGN(XTICK,XTRC-XBLC)
          NSUBX = MAX(NXSUB,1)
      END IF
      IF (.NOT.XOPTS) NSUBX = 1
      NP = INT(LOG10(ABS(XINT)))-4
      NV = NINT(XINT/10.**NP)
      XINT2 = XINT/NSUBX
      XOPTLS = XOPTL .AND. XOPTS .AND. (ABS(XTRC-XBLC).LT.2.0)
C
C Draw X grid.
C
      IF (XOPTG) THEN
          CALL PGBOX1(XBLC, XTRC, XINT, I1, I2)
          DO 20 I=I1,I2
              CALL GRMOVA(REAL(I)*XINT, YBLC)
              CALL GRLINA(REAL(I)*XINT, YTRC)
   20     CONTINUE
      END IF
C
C Draw X ticks.
C
      IF (XOPTT.OR.XOPTS) THEN
          CALL PGBOX1(XBLC, XTRC, XINT2, I1, I2)
          JMAX = 1
          IF (XOPTL.AND.XOPTS) JMAX=9
C
C         Bottom ticks.
C
          IF (XOPTB) THEN
            DO 40 I=I1-1,I2
            DO 30 J=1,JMAX
                MAJOR = (MOD(I,NSUBX).EQ.0).AND.XOPTT.AND.J.EQ.1
                TIKL = TIKL2
                IF (MAJOR) TIKL = TIKL1
                XVAL = (I+UTAB(J))*XINT2
                IF (IRANGE(XBLC,XVAL,XTRC)) THEN
                    IF (XOPTP.AND.MAJOR) THEN
                        CALL GRMOVA(XVAL, YBLC-TIKL2)
                    ELSE
                        CALL GRMOVA(XVAL, YBLC)
                    END IF
                    CALL GRLINA(XVAL, YBLC+TIKL)
                END IF
   30        CONTINUE
   40       CONTINUE
          END IF
C
C         Axis ticks.
C
          IF (XOPTA) THEN
            DO 60 I=I1-1,I2
            DO 50 J=1,JMAX
                MAJOR = (MOD(I,NSUBX).EQ.0).AND.XOPTT.AND.J.EQ.1
                TIKL = TIKL2
                IF (MAJOR) TIKL = TIKL1
                XVAL = (I+UTAB(J))*XINT2
                IF (IRANGE(XBLC,XVAL,XTRC)) THEN
                    CALL GRMOVA(XVAL, -TIKL)
                    CALL GRLINA(XVAL, TIKL)
                END IF
   50       CONTINUE
   60       CONTINUE
          END IF
C
C         Top ticks.
C
          IF (XOPTC) THEN
            DO 80 I=I1-1,I2
            DO 70 J=1,JMAX
                MAJOR = (MOD(I,NSUBX).EQ.0).AND.XOPTT.AND.J.EQ.1
                TIKL = TIKL2
                IF (MAJOR) TIKL = TIKL1
                XVAL = (I+UTAB(J))*XINT2
                IF (IRANGE(XBLC,XVAL,XTRC)) THEN
                    CALL GRMOVA(XVAL, YTRC-TIKL)
                    CALL GRLINA(XVAL, YTRC)
                END IF
   70       CONTINUE
   80       CONTINUE
          END IF
      END IF
C
C Write X labels.
C
      IF (XOPTN .OR. XOPTM) THEN
          CALL PGBOX1(XBLC, XTRC, XINT, I1, I2)
          DO 90 I=I1,I2
              XC = (I*XINT-XBLC)/(XTRC-XBLC)
              IF (XOPTL) THEN
                  CALL PGNUMB(1,NINT(I*XINT),XNFORM,CLBL,NC)
              ELSE
                  CALL PGNUMB(I*NV,NP,XNFORM,CLBL,NC)
              END IF
              IF (XOPTN) CALL PGMTXT('B', XNDSP, XC, 0.5, CLBL(1:NC))
              IF (XOPTM) CALL PGMTXT('T', XMDSP, XC, 0.5, CLBL(1:NC))
   90     CONTINUE
      END IF
C
C Extra X labels for log axes.
C
      IF (XOPTLS) THEN
          CALL PGBOX1(XBLC, XTRC, XINT2, I1, I2)
          DO 401 I=I1-1,I2
             DO 301 J=2,5,3
                XVAL = (I+UTAB(J))*XINT2
                XC = (XVAL-XBLC)/(XTRC-XBLC)
                KI = I
                IF (XTRC.LT.XBLC) KI = KI+1
                IF (IRANGE(XBLC,XVAL,XTRC)) THEN
                    CALL PGNUMB(J,NINT(KI*XINT2),XNFORM,CLBL,NC)
                    IF (XOPTN) 
     1                CALL PGMTXT('B', XNDSP, XC, 0.5, CLBL(1:NC))
                    IF (XOPTM) 
     1                CALL PGMTXT('T', XMDSP, XC, 0.5, CLBL(1:NC))
                END IF
  301       CONTINUE
  401     CONTINUE
      END IF
C
C Length of Y tick marks.
C
      TIKL1 = PGXSP(PGID)*0.6*(XTRC-XBLC)/PGXLEN(PGID)
      IF (YOPTI) TIKL1 = -TIKL1
      TIKL2 = TIKL1*0.5
C
C Choose Y tick intervals. Major interval = YINT,
C minor interval = YINT2 = YINT/NSUBY.
C
      UTAB(1) = 0.0
      IF (YOPTL) THEN
          YINT = SIGN(1.0,YTRC-YBLC)
          NSUBY = 1
          DO 100 J=2,9
              UTAB(J) = TAB(J)
              IF (YINT.LT.0.0) UTAB(J) = 1.0-TAB(J)
  100     CONTINUE
      ELSE IF (YTICK.EQ.0.0) THEN
          YINT = MAX(0.05, MIN(7.0*PGXSP(PGID)/PGYLEN(PGID), 0.20))
     1           *(YTRC-YBLC)
          YINT = PGRND(YINT,NSUBY)
      ELSE
          YINT  = SIGN(YTICK,YTRC-YBLC)
          NSUBY = MAX(NYSUB,1)
      END IF
      IF (.NOT.YOPTS) NSUBY = 1
      NP = INT(LOG10(ABS(YINT)))-4
      NV = NINT(YINT/10.**NP)
      YINT2 = YINT/NSUBY
      YOPTLS = YOPTL .AND. YOPTS .AND. (ABS(YTRC-YBLC).LT.2.0)
C
C Draw Y grid.
C
      IF (YOPTG) THEN
          CALL PGBOX1(YBLC, YTRC, YINT, I1, I2)
          DO 110 I=I1,I2
              CALL GRMOVA(XBLC, REAL(I)*YINT)
              CALL GRLINA(XTRC, REAL(I)*YINT)
  110     CONTINUE
      END IF
C
C Draw Y ticks.
C
      IF (YOPTT.OR.YOPTS) THEN
          CALL PGBOX1(YBLC, YTRC, YINT2, I1, I2)
          JMAX = 1
          IF (YOPTL.AND.YOPTS) JMAX = 9
C
C               Left ticks.
C
            IF (YOPTB) THEN
            DO 130 I=I1-1,I2
            DO 120 J=1,JMAX
                MAJOR = (MOD(I,NSUBY).EQ.0).AND.YOPTT.AND.J.EQ.1
                TIKL = TIKL2
                IF (MAJOR) TIKL = TIKL1
                YVAL = (I+UTAB(J))*YINT2
                IF (IRANGE(YBLC,YVAL,YTRC)) THEN
                    IF (YOPTP.AND.MAJOR) THEN
                        CALL GRMOVA(XBLC-TIKL2, YVAL)
                    ELSE
                        CALL GRMOVA(XBLC, YVAL)
                    END IF
                    CALL GRLINA(XBLC+TIKL, YVAL)
                END IF
  120       CONTINUE
  130       CONTINUE
            END IF
C
C               Axis ticks.
C
            IF (YOPTA) THEN
            DO 150 I=I1-1,I2
            DO 140 J=1,JMAX
                MAJOR = (MOD(I,NSUBY).EQ.0).AND.YOPTT.AND.J.EQ.1
                TIKL = TIKL2
                IF (MAJOR) TIKL = TIKL1
                YVAL = (I+UTAB(J))*YINT2
                IF (IRANGE(YBLC,YVAL,YTRC)) THEN
                    CALL GRMOVA(-TIKL, YVAL)
                    CALL GRLINA(TIKL, YVAL)
                END IF
  140       CONTINUE
  150       CONTINUE
            END IF
C
C               Right ticks.
C
            IF (YOPTC) THEN
            DO 170 I=I1-1,I2
            DO 160 J=1,JMAX
                MAJOR = (MOD(I,NSUBY).EQ.0).AND.YOPTT.AND.J.EQ.1
                TIKL = TIKL2
                IF (MAJOR) TIKL = TIKL1
                YVAL = (I+UTAB(J))*YINT2
                IF (IRANGE(YBLC,YVAL,YTRC)) THEN
                    CALL GRMOVA(XTRC-TIKL, YVAL)
                    CALL GRLINA(XTRC, YVAL)
                END IF
  160       CONTINUE
  170       CONTINUE
            END IF
        END IF
C
C Write Y labels.
C
      IF (YOPTN.OR.YOPTM) THEN
          CALL PGBOX1(YBLC, YTRC, YINT, I1, I2)
          DO 180 I=I1,I2
              YC = (I*YINT-YBLC)/(YTRC-YBLC)
              IF (YOPTL) THEN
                  CALL PGNUMB(1,NINT(I*YINT),YNFORM,CLBL,NC)
              ELSE
                  CALL PGNUMB(I*NV,NP,YNFORM,CLBL,NC)
              END IF
              IF (YOPTV) THEN
                  IF (YOPTN) CALL PGMTXT('LV',YNVDSP,YC,1.0,CLBL(1:NC))
                  IF (YOPTM) CALL PGMTXT('RV',YMVDSP,YC,0.0,CLBL(1:NC))
              ELSE
                  IF (YOPTN) CALL PGMTXT('L',YNDSP,YC,0.5,CLBL(1:NC))
                  IF (YOPTM) CALL PGMTXT('R',YMDSP,YC,0.5,CLBL(1:NC))
              END IF
  180     CONTINUE
      END IF
C
C Extra Y labels for log axes.
C
      IF (YOPTLS) THEN
          CALL PGBOX1(YBLC, YTRC, YINT2, I1, I2)
          DO 402 I=I1-1,I2
            DO 302 J=2,5,3
                YVAL = (I+UTAB(J))*YINT2
                YC = (YVAL-YBLC)/(YTRC-YBLC)
                KI = I
                IF (YBLC.GT.YTRC) KI = KI+1
                IF (IRANGE(YBLC,YVAL,YTRC)) THEN
                    CALL PGNUMB(J,NINT(KI*YINT2),YNFORM,CLBL,NC)
                    IF (YOPTV) THEN
                    IF (YOPTN) 
     1                CALL PGMTXT('LV', YNVDSP, YC, 1.0, CLBL(1:NC))
                    IF (YOPTM) 
     1                CALL PGMTXT('RV', YMVDSP, YC, 0.0, CLBL(1:NC))
                    ELSE
                    IF (YOPTN) 
     1                CALL PGMTXT('L', YNDSP, YC, 0.5, CLBL(1:NC))
                    IF (YOPTM) 
     1                CALL PGMTXT('R', YMDSP, YC, 0.5, CLBL(1:NC))
                    END IF
                END IF
  302       CONTINUE
  402     CONTINUE
      END IF
C
C Enable clipping.
C
      CALL PGSCLP(CLIP)
C
      CALL PGEBUF
      END
#<

#>            pgbox1.dc3
Name:         pgbox1

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Oct 16, 1998: JPT automatically generated.
#<

#>            pgbox1.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C PGBOX1 -- support routine for PGBOX
C
      SUBROUTINE PGBOX1 (XA, XB, XD, I1, I2)
      REAL XA, XB, XD
      INTEGER I1, I2
C
C This routine is used to determine where to draw the tick marks on
C an axis. The input arguments XA and XB are the world-coordinate
C end points of the axis; XD is the tick interval. PGBOX1 returns
C two integers, I1 and I2, such that the required tick marks are
C to be placed at world-coordinates (I*XD), for I=I1,...,I2.
C Normally I2 is greater than or equal to I1, but if there are no
C values of I such that I*XD lies in the inclusive range (XA, XB),
C then I2 will be 1 less than I1.
C
C Arguments:
C  XA, XB (input)  : world-coordinate end points of the axis. XA must
C                    not be equal to XB; otherwise, there are no
C                    restrictions.
C  XD     (input)  : world-coordinate tick interval. XD may be positive
C                    or negative, but may not be zero.
C  I1, I2 (output) : tick marks should be drawn at world
C                    coordinates I*XD for I in the inclusive range
C                    I1...I2 (see above).
C
C 14-Jan-1986 - new routine [TJP].
C 13-Dec-1990 - remove rror check [TJP].
C-----------------------------------------------------------------------
      REAL XLO, XHI
C
      XLO = MIN(XA/XD, XB/XD)
      XHI = MAX(XA/XD, XB/XD)
      I1 = NINT(XLO)
      IF (I1.LT.XLO) I1 = I1+1
      I2 = NINT(XHI)
      IF (I2.GT.XHI) I2 = I2-1
      END
#<

#>            pgcirc.dc2
Name:         PGCIRC

Purpose:      draw a circle, using fill-area attributes

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGCIRC (XCENT, YCENT, RADIUS)
            REAL XCENT, YCENT, RADIUS
      
       Draw a circle. The action of this routine depends
       on the setting of the Fill-Area Style attribute. If Fill-Area Style
       is SOLID (the default), the interior of the circle is solid-filled
       using the current Color Index. If Fill-Area Style is HOLLOW, the
       outline of the circle is drawn using the current line attributes
       (color index, line-style, and line-width).
      
       Arguments:
        XCENT  (input)  : world x-coordinate of the center of the circle.
        YCENT  (input)  : world y-coordinate of the center of the circle.
        RADIUS (input)  : radius of circle (world coordinates).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgcirc.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGCIRC -- draw a circle, using fill-area attributes
C%void cpgcirc(float xcent, float ycent, float radius);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgcirc( real, real, real )
*

C+
      SUBROUTINE PGCIRC (XCENT, YCENT, RADIUS)
      REAL XCENT, YCENT, RADIUS
C
C Draw a circle. The action of this routine depends
C on the setting of the Fill-Area Style attribute. If Fill-Area Style
C is SOLID (the default), the interior of the circle is solid-filled
C using the current Color Index. If Fill-Area Style is HOLLOW, the
C outline of the circle is drawn using the current line attributes
C (color index, line-style, and line-width).
C
C Arguments:
C  XCENT  (input)  : world x-coordinate of the center of the circle.
C  YCENT  (input)  : world y-coordinate of the center of the circle.
C  RADIUS (input)  : radius of circle (world coordinates).
C--
C 26-Nov-1992 - [TJP].
C 20-Sep-1994 - adjust number of points according to size [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      INTEGER MAXPTS
      PARAMETER (MAXPTS=72)
C
      INTEGER NPTS,I,RADPIX
      REAL ANGLE
      REAL X(MAXPTS),Y(MAXPTS)
C
      RADPIX = NINT(RADIUS*MAX(PGXSCL(PGID), PGYSCL(PGID)))
      NPTS = MAX(8, MIN(MAXPTS, RADPIX))
      DO 10 I=1,NPTS
         ANGLE = I*360.0/REAL(NPTS)/57.3
         X(I) = XCENT + RADIUS*COS(ANGLE)
         Y(I) = YCENT + RADIUS*SIN(ANGLE)
   10 CONTINUE
      CALL PGPOLY (NPTS,X,Y)
C     write (*,*) 'PGCIRC', NPTS
C-----------------------------------------------------------------------
      END
#<

#>            pgcl.dc3
Name:         pgcl

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Oct 16, 1998: JPT automatically generated.
#<

#>            pgcl.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C
      SUBROUTINE PGCL (K, X, Y, Z)
      INTEGER K
      REAL X, Y, Z
C
C PGPLOT (internal routine): Label one contour segment (for use by
C PGCONX).
C
C Arguments:
C
C K (input, integer): if K=0, move the pen to (X,Y); if K=1, draw
C       a line from the current position to (X,Y); otherwise
C       do nothing.
C X (input, real): X world-coordinate of end point.
C Y (input, real): Y world-coordinate of end point.
C Z (input, real): the value of the contour level, not used by PGCL.
C--
C  5-May-1994 - new routine [TJP]
C  7-Mar-1995 - correct error in angle; do not draw labels outside
C               window [TJP].
C 28-Aug-1995 - check arguments of atan2 [TJP].
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
      REAL     XX, YY, XC, YC, XV1, XV2, YV1, YV2, XL, XR, YB, YT
      REAL     XN, YN
      REAL     ANGLE, XO, YO, XP, YP, DINDX, DINDY, XBOX(4), YBOX(4)
      INTEGER  I, TB
      SAVE     I
      DATA     I /0/
C
C     -- transform to world coordinates
      XX = TRANS(1) + TRANS(2)*X + TRANS(3)*Y
      YY = TRANS(4) + TRANS(5)*X + TRANS(6)*Y
C
      IF (K.EQ.0) THEN
C        -- start of contour: reset segment counter
         I = 0
      ELSE
C        -- increment segment counter and check whether this
C           segment should be labelled
         I = MOD(I+1,PGCINT)
         IF (I.EQ.PGCMIN) THEN
C           -- find center of this segment (XC, YC)
            CALL PGQPOS(XP, YP)
            XC = (XX+XP)*0.5
            YC = (YY+YP)*0.5
C            -- find slope of this segment (ANGLE)
            CALL PGQVP(1, XV1, XV2, YV1, YV2)
            CALL PGQWIN(XL, XR, YB, YT)
            ANGLE = 0.0
            IF (XR.NE.XL .AND. YT.NE.YB) THEN
               DINDX = (XV2 - XV1) / (XR - XL)
               DINDY = (YV2 - YV1) / (YT - YB)
               IF (YY-YP.NE.0.0 .OR. XX-XP.NE.0.0)
     :           ANGLE = 57.3*ATAN2((YY-YP)*DINDY, (XX-XP)*DINDX)
            END IF
C           -- check whether point is in window
            XN = (XC-XL)/(XR-XL)
            YN = (YC-YB)/(YT-YB)
            IF (XN.GE.0.0 .AND. XN.LE.1.0 .AND.
     :          YN.GE.0.0 .AND. YN.LE.1.0) THEN
C              -- save current text background and set to erase
               CALL PGQTBG(TB)
               CALL PGSTBG(0)
C              -- find bounding box of label
               CALL PGQTXT(XC, YC, ANGLE, 0.5, PGCLAB, XBOX, YBOX)
               XO = 0.5*(XBOX(1)+XBOX(3))
               YO = 0.5*(YBOX(1)+YBOX(3))
C              -- plot label with bounding box centered at (XC, YC)
               CALL PGPTXT(2.0*XC-XO, 2.0*YC-YO, ANGLE, 0.5, PGCLAB)
C              -- restore text background
               CALL PGSTBG(TB)
            END IF
         END IF
      END IF
      CALL PGMOVE(XX,YY)
      END
#<

#>            pgclos.dc2
Name:         PGCLOS

Purpose:      close the selected graphics device

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGCLOS
      
       Close the currently selected graphics device. After the device has
       been closed, either another open device must be selected with PGSLCT
       or another device must be opened with PGOPEN before any further
       plotting can be done. If the call to PGCLOS is omitted, some or all 
       of the plot may be lost.
      
       [This routine was added to PGPLOT in Version 5.1.0. Older programs
       use PGEND instead.]
      
       Arguments: none

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgclos.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGCLOS -- close the selected graphics device
C%void cpgclos(void);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgclos(  )
*

C+
      SUBROUTINE PGCLOS
C
C Close the currently selected graphics device. After the device has
C been closed, either another open device must be selected with PGSLCT
C or another device must be opened with PGOPEN before any further
C plotting can be done. If the call to PGCLOS is omitted, some or all 
C of the plot may be lost.
C
C [This routine was added to PGPLOT in Version 5.1.0. Older programs
C use PGEND instead.]
C
C Arguments: none
C--
C 22-Dec-1995 - new routine, derived from the old PGEND.
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      CHARACTER*16 DEFSTR
      LOGICAL PGNOTO
C
      IF (.NOT.PGNOTO('PGCLOS')) THEN
         CALL GRTERM
         IF (PGPRMP(PGID)) THEN
            CALL GRQCAP(DEFSTR)
            IF (DEFSTR(8:8).EQ.'V') CALL GRPROM
         END IF
         CALL GRCLOS
         PGDEVS(PGID) = 0
         PGID = 0
      END IF
C     WRITE (*,*) 'PGCLOS', PGID, ':', PGDEVS
      END
#<

#>            pgcn01.dc3
Name:         pgcn01

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Oct 16, 1998: JPT automatically generated.
#<

#>            pgcn01.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

      SUBROUTINE PGCN01(Z, MX, MY, IA, IB, JA, JB, Z0, PLOT,
     1                  FLAGS, IS, JS, SDIR)
C
C Support routine for PGCNSC. This routine draws a continuous contour,
C starting at the specified point, until it either crosses the edge of
C the array or closes on itself.
C-----------------------------------------------------------------------
      INTEGER UP, DOWN, LEFT, RIGHT
      PARAMETER (UP=1, DOWN=2, LEFT=3, RIGHT=4)
      INTEGER  MAXEMX, MAXEMY
      PARAMETER (MAXEMX=100, MAXEMY=100)
      LOGICAL FLAGS(MAXEMX,MAXEMY,2)
      INTEGER MX, MY, IA, IB, JA, JB, IS, JS, I, J, II, JJ, DIR, SDIR
      REAL Z(MX,*)
      REAL Z0, X, Y, STARTX, STARTY
      EXTERNAL PLOT
C
      I = IS
      J = JS
      DIR = SDIR
      II = 1+I-IA
      JJ = 1+J-JA
      IF (DIR.EQ.UP .OR. DIR.EQ.DOWN) THEN
          X = REAL(I) + (Z0-Z(I,J))/(Z(I+1,J)-Z(I,J))
          Y = REAL(J)
      ELSE
          X = REAL(I)
          Y = REAL(J) + (Z0-Z(I,J))/(Z(I,J+1)-Z(I,J))
      END IF
CD    WRITE (*,*) 'SEGMENT'
C
C Move to start of contour and record starting point.
C
      CALL PLOT(0, X, Y, Z0)
      STARTX = X
      STARTY = Y
C
C We have reached grid-point (I,J) going in direction DIR (UP, DOWN,
C LEFT, or RIGHT). Look at the other three sides of the cell we are
C entering to decide where to go next. It is important to look to the
C two sides before looking straight ahead, in order to avoid self-
C intersecting contours. If all 3 sides have unused crossing-points,
C the cell is "degenerate" and we have to decide which of two possible 
C pairs of contour segments to draw; at present we make an arbitrary 
C choice. If we have reached the edge of the array, we have
C finished drawing an unclosed contour. If none of the other three
C sides of the cell have an unused crossing-point, we must have
C completed a closed contour, which requires a final segment back to
C the starting point.
C
  100 CONTINUE
CD    WRITE (*,*) I,J,DIR
      II = 1 + I - IA
      JJ = 1 + J - JA
      GOTO (110, 120, 130, 140), DIR
C
C DIR = UP
C
  110 CONTINUE
      FLAGS(II,JJ,1) = .FALSE.
      IF (J.EQ.JB) THEN
          RETURN
      ELSE IF (FLAGS(II,JJ,2)) THEN
          DIR = LEFT
          GOTO 200
      ELSE IF (FLAGS(II+1,JJ,2)) THEN
          DIR = RIGHT
          I = I+1
          GOTO 200
      ELSE IF (FLAGS(II,JJ+1,1)) THEN
C!        DIR = UP
          J = J+1
          GOTO 250
      ELSE
          GOTO 300
      END IF
C
C DIR = DOWN
C
  120 CONTINUE
      FLAGS(II,JJ,1) = .FALSE.
      IF (J.EQ.JA) THEN
          RETURN
      ELSE IF (FLAGS(II+1,JJ-1,2)) THEN
          DIR = RIGHT
          I = I+1
          J = J-1
          GOTO 200
      ELSE IF (FLAGS(II,JJ-1,2)) THEN
          DIR = LEFT
          J = J-1
          GOTO 200
      ELSE IF (FLAGS(II,JJ-1,1)) THEN
C!        DIR = DOWN
          J = J-1
          GOTO 250
      ELSE
          GOTO 300
      END IF
C
C DIR = LEFT
C
  130 CONTINUE
      FLAGS(II,JJ,2) = .FALSE.
      IF (I.EQ.IA) THEN
          RETURN
      ELSE IF (FLAGS(II-1,JJ,1)) THEN
          DIR = DOWN
          I = I-1
          GOTO 250
      ELSE IF (FLAGS(II-1,JJ+1,1)) THEN
          DIR = UP
          I = I-1
          J = J+1
          GOTO 250
      ELSE IF (FLAGS(II-1,JJ,2)) THEN
C!        DIR = LEFT
          I = I-1
          GOTO 200
      ELSE
          GOTO 300
      END IF
C
C DIR = RIGHT
C
  140 CONTINUE
      FLAGS(II,JJ,2) = .FALSE.
      IF (I.EQ.IB) THEN
          RETURN
      ELSE IF (FLAGS(II,JJ+1,1)) THEN
          DIR = UP
          J = J+1
          GOTO 250
      ELSE IF (FLAGS(II,JJ,1)) THEN
          DIR = DOWN
          GOTO 250
      ELSE IF (FLAGS(II+1,JJ,2)) THEN
C!        DIR = RIGHT
          I = I+1
          GOTO 200
      ELSE
          GOTO 300
      END IF
C
C Draw a segment of the contour.
C
  200 X = REAL(I)
      Y = REAL(J) + (Z0-Z(I,J))/(Z(I,J+1)-Z(I,J))
      CALL PLOT(1,X,Y,Z0)
      GOTO 100
  250 X = REAL(I) + (Z0-Z(I,J))/(Z(I+1,J)-Z(I,J))
      Y = REAL(J)
      CALL PLOT(1,X,Y,Z0)
      GOTO 100
C
C Close the contour and go look for another one.
C
  300 CALL PLOT(1,STARTX,STARTY,Z0)
      RETURN
C
      END
#<

#>            pgcnsc.dc3
Name:         pgcnsc

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Oct 16, 1998: JPT automatically generated.
#<

#>            pgcnsc.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

      SUBROUTINE PGCNSC (Z, MX, MY, IA, IB, JA, JB, Z0, PLOT)
      INTEGER MX, MY, IA, IB, JA, JB
      REAL Z(MX,*)
      REAL Z0
      EXTERNAL PLOT
C
C PGPLOT (internal routine): Draw a single contour.  This routine is
C called by PGCONT, but may be called directly by the user.
C
C Arguments:
C
C Z (real array dimension MX,MY, input): the array of function values.
C MX,MY (integer, input): actual declared dimension of Z(*,*).
C IA,IB (integer, input): inclusive range of the first index of Z to be
C       contoured.
C JA,JB (integer, input): inclusive range of the second index of Z to
C       be contoured.
C Z0 (real, input): the contour level sought.
C PLOT (the name of a subroutine declared EXTERNAL in the calling
C       routine): this routine is called by PGCNSC to do all graphical
C       output. The calling sequence is CALL PLOT(K,X,Y,Z) where Z is
C       the contour level, (X,Y) are the coordinates of a point (in the
C       inclusive range I1<X<I2, J1<Y<J2, and if K is 0, the routine is
C       to move then pen to (X,Y); if K is 1, it is to draw a line from
C       the current position to (X,Y).
C
C NOTE:  the intervals (IA,IB) and (JA,JB) must not exceed the
C dimensions of an internal array. These are currently set at 100.
C--
C 17-Sep-1989 - Completely rewritten [TJP]. The algorithm is my own,
C               but it is probably not original. It could probably be
C               coded more briefly, if not as clearly.
C  1-May-1994 - Modified to draw contours anticlockwise about maxima,
C               to prevent contours at different levels from
C               crossing in degenerate cells [TJP].
C-----------------------------------------------------------------------
      INTEGER UP, DOWN, LEFT, RIGHT
      PARAMETER (UP=1, DOWN=2, LEFT=3, RIGHT=4)
      INTEGER  MAXEMX, MAXEMY
      PARAMETER (MAXEMX=100, MAXEMY=100)
C
      LOGICAL FLAGS(MAXEMX,MAXEMY,2), RANGE
      INTEGER I, J, II, JJ, DIR
      REAL Z1, Z2, Z3, P, P1, P2
C
C The statement function RANGE decides whether a contour at level P
C crosses the line between two gridpoints with values P1 and P2. It is
C important that a contour cannot cross a line with equal endpoints.
C
      RANGE (P,P1,P2) = (P.GT.MIN(P1,P2)) .AND. (P.LE.MAX(P1,P2))
     1                  .AND. (P1.NE.P2)
C
C Check for errors.
C
      IF ( (IB-IA+1) .GT. MAXEMX .OR.  (JB-JA+1) .GT. MAXEMY ) THEN
          CALL GRWARN('PGCNSC - array index range exceeds'//
     1                ' built-in limit of 100')
          RETURN
      END IF
C
C Initialize the flags. The first flag for a gridpoint is set if
C the contour crosses the line segment to the right of the gridpoint
C (joining [I,J] to [I+1,J]); the second flag is set if if it crosses
C the line segment above the gridpoint (joining [I,J] to [I,J+1]).
C The top and right edges require special treatment. (For purposes
C of description only, we assume I increases horizontally to the right
C and J increases vertically upwards.)
C
      DO 20 I=IA,IB
          II = I-IA+1
          DO 10 J=JA,JB
              JJ = J-JA+1
              Z1 = Z(I,J)
              FLAGS(II,JJ,1) = .FALSE.
              FLAGS(II,JJ,2) = .FALSE.
              IF (I.LT.IB) THEN
                Z2 = Z(I+1,J)
                IF (RANGE(Z0,Z1,Z2)) FLAGS(II,JJ,1) = .TRUE.
              END IF
              IF (J.LT.JB) THEN
                Z3 = Z(I,J+1)
                IF (RANGE(Z0,Z1,Z3)) FLAGS(II,JJ,2) = .TRUE.
              END IF
   10     CONTINUE
   20 CONTINUE
C
C Search the edges of the array for the start of an unclosed contour.
C Note that (if the algorithm is implemented correctly) all unclosed
C contours must begin and end at the edge of the array. When one is
C found, call PGCN01 to draw the contour, telling it the correct
C starting direction so that it follows the contour into the array
C instead of out of it. A contour is only started if the higher
C ground lies to the left: this is to enforce the direction convention
C that contours are drawn anticlockwise around maxima. If the high
C ground lies to the right, we will find the other end of the contour
C and start there.
C
C Bottom edge.
C
      J = JA
      JJ = J-JA+1
      DO 26 I=IA,IB-1
          II = I-IA+1
          IF (FLAGS(II,JJ,1) .AND. (Z(I,J).GT.Z(I+1,J)))
     1          CALL PGCN01(Z, MX, MY, IA, IB, JA, JB,
     2                      Z0, PLOT, FLAGS, I, J, UP)
   26 CONTINUE
C
C Right edge.
C
      I = IB
      II = I-IA+1
      DO 27 J=JA,JB-1
          JJ = J-JA+1
          IF (FLAGS(II,JJ,2) .AND. (Z(I,J).GT.Z(I,J+1)))
     1          CALL PGCN01(Z, MX, MY, IA, IB, JA, JB,
     2                      Z0, PLOT, FLAGS, I, J, LEFT)
   27 CONTINUE
C
C Top edge.
C
      J = JB
      JJ = J-JA+1
      DO 28 I=IB-1,IA,-1
          II = I-IA+1
          IF (FLAGS(II,JJ,1) .AND. (Z(I+1,J).GT.Z(I,J)))
     1          CALL PGCN01(Z, MX, MY, IA, IB, JA, JB,
     2                      Z0, PLOT, FLAGS, I, J, DOWN)
   28 CONTINUE
C
C Left edge.
C
      I = IA
      II = I-IA+1
      DO 29 J=JB-1,JA,-1
          JJ = J-JA+1
          IF (FLAGS(II,JJ,2)  .AND. (Z(I,J+1).GT.Z(I,J)))
     1          CALL PGCN01(Z, MX, MY, IA, IB, JA, JB,
     2                      Z0, PLOT, FLAGS, I, J, RIGHT)
   29 CONTINUE
C
C Now search the interior of the array for a crossing point, which will
C lie on a closed contour (because all unclosed contours have been
C eliminated). It is sufficient to search just the horizontal crossings
C (or the vertical ones); any closed contour must cross a horizontal
C and a vertical gridline. PGCN01 assumes that when it cannot proceed
C any further, it has reached the end of a closed contour. Thus all
C unclosed contours must be eliminated first.
C
      DO 40 I=IA+1,IB-1
          II = I-IA+1
          DO 30 J=JA+1,JB-1
              JJ = J-JA+1
              IF (FLAGS(II,JJ,1)) THEN
                  DIR = UP
                  IF (Z(I+1,J).GT. Z(I,J)) DIR = DOWN
                  CALL PGCN01(Z, MX, MY, IA, IB, JA, JB,
     1                        Z0, PLOT, FLAGS, I, J, DIR)

              END IF
   30     CONTINUE
   40 CONTINUE
C
C We didn't find any more crossing points: we're finished.
C
      RETURN
      END
#<

#>            pgconb.dc2
Name:         PGCONB

Purpose:      contour map of a 2D data array, with blanking

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGCONB (A, IDIM, JDIM, I1, I2, J1, J2, C, NC, TR, 
           1                   BLANK)
            INTEGER IDIM, JDIM, I1, I2, J1, J2, NC
            REAL    A(IDIM,JDIM), C(*), TR(6), BLANK
      
       Draw a contour map of an array. This routine is the same as PGCONS,
       except that array elements that have the "magic value" defined by
       argument BLANK are ignored, making gaps in the contour map. The
       routine may be useful for data measured on most but not all of the
       points of a grid.
      
       Arguments:
        A      (input)  : data array.
        IDIM   (input)  : first dimension of A.
        JDIM   (input)  : second dimension of A.
        I1,I2  (input)  : range of first index to be contoured (inclusive).
        J1,J2  (input)  : range of second index to be contoured (inclusive).
        C      (input)  : array of contour levels (in the same units as the
                          data in array A); dimension at least NC.
        NC     (input)  : number of contour levels (less than or equal to
                          dimension of C). The absolute value of this
                          argument is used (for compatibility with PGCONT,
                          where the sign of NC is significant).
        TR     (input)  : array defining a transformation between the I,J
                          grid of the array and the world coordinates. The
                          world coordinates of the array point A(I,J) are
                          given by:
                            X = TR(1) + TR(2)*I + TR(3)*J
                            Y = TR(4) + TR(5)*I + TR(6)*J
                          Usually TR(3) and TR(5) are zero - unless the
                          coordinate transformation involves a rotation
                          or shear.
        BLANK   (input) : elements of array A that are exactly equal to
                          this value are ignored (blanked).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgconb.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGCONB -- contour map of a 2D data array, with blanking
C%void cpgconb(const float *a, int idim, int jdim, int i1, int i2, \
C% int j1, int j2, const float *c, int nc, const float *tr, \
C% float blank);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgconb( real, integer, integer, integer, integer, integer, integer, real, integer, real, real )
*

C+
      SUBROUTINE PGCONB (A, IDIM, JDIM, I1, I2, J1, J2, C, NC, TR, 
     1                   BLANK)
      INTEGER IDIM, JDIM, I1, I2, J1, J2, NC
      REAL    A(IDIM,JDIM), C(*), TR(6), BLANK
C
C Draw a contour map of an array. This routine is the same as PGCONS,
C except that array elements that have the "magic value" defined by
C argument BLANK are ignored, making gaps in the contour map. The
C routine may be useful for data measured on most but not all of the
C points of a grid.
C
C Arguments:
C  A      (input)  : data array.
C  IDIM   (input)  : first dimension of A.
C  JDIM   (input)  : second dimension of A.
C  I1,I2  (input)  : range of first index to be contoured (inclusive).
C  J1,J2  (input)  : range of second index to be contoured (inclusive).
C  C      (input)  : array of contour levels (in the same units as the
C                    data in array A); dimension at least NC.
C  NC     (input)  : number of contour levels (less than or equal to
C                    dimension of C). The absolute value of this
C                    argument is used (for compatibility with PGCONT,
C                    where the sign of NC is significant).
C  TR     (input)  : array defining a transformation between the I,J
C                    grid of the array and the world coordinates. The
C                    world coordinates of the array point A(I,J) are
C                    given by:
C                      X = TR(1) + TR(2)*I + TR(3)*J
C                      Y = TR(4) + TR(5)*I + TR(6)*J
C                    Usually TR(3) and TR(5) are zero - unless the
C                    coordinate transformation involves a rotation
C                    or shear.
C  BLANK   (input) : elements of array A that are exactly equal to
C                    this value are ignored (blanked).
C--
C 21-Sep-1989 - Derived from PGCONS [TJP].
C-----------------------------------------------------------------------
      INTEGER  I, IC, ICORN, IDELT(6), J, K, NPT
      INTEGER  IOFF(8), JOFF(8), IENC, ITMP, JTMP, ILO, ITOT
      LOGICAL  PGNOTO
      REAL     CTR, DELTA, DVAL(5), XX, YY, X(4), Y(4)
      INTRINSIC ABS
      DATA     IDELT/0,-1,-1,0,0,-1/
      DATA     IOFF/-2,-2,-1,-1, 0, 0, 1, 1/
      DATA     JOFF/ 0,-1,-2, 1,-2, 1,-1, 0/
C
C Check arguments.
C
      IF (PGNOTO('PGCONB')) RETURN
      IF (I1.LT.1 .OR. I2.GT.IDIM .OR. I1.GE.I2 .OR.
     1    J1.LT.1 .OR. J2.GT.JDIM .OR. J1.GE.J2) RETURN
      IF (NC.EQ.0) RETURN
      CALL PGBBUF
C
      DO 130 J=J1+1,J2
      DO 130 I=I1+1,I2
          DVAL(1) = A(I-1,J)
          DVAL(2) = A(I-1,J-1)
          DVAL(3) = A(I,J-1)
          DVAL(4) = A(I,J)
          DVAL(5) = DVAL(1)
          IF (DVAL(1).EQ.BLANK .OR. DVAL(2).EQ.BLANK .OR.
     1        DVAL(3).EQ.BLANK .OR. DVAL(4).EQ.BLANK) GOTO 130
      DO 110 IC=1,ABS(NC)
          CTR = C(IC)
          NPT = 0
          DO 120 ICORN=1,4
          IF( (DVAL(ICORN).LT.CTR .AND. DVAL(ICORN+1).LT.CTR)
     1    .OR.(DVAL(ICORN).GE.CTR .AND. DVAL(ICORN+1).GE.CTR) ) GOTO 120
            NPT=NPT+1
            DELTA = (CTR-DVAL(ICORN))/(DVAL(ICORN+1)-DVAL(ICORN))
            GOTO (60,70,60,70), ICORN
C
   60       XX = I+IDELT(ICORN+1)
            YY = REAL(J+IDELT(ICORN)) + 
     1           DELTA*REAL(IDELT(ICORN+1)-IDELT(ICORN))
            GOTO 80
C
   70       XX = REAL(I+IDELT(ICORN+1)) +
     1           DELTA*REAL(IDELT(ICORN+2)-IDELT(ICORN+1))
            YY  = J+IDELT(ICORN)
C
   80       X(NPT) = TR(1) + TR(2)*XX + TR(3)*YY
            Y(NPT) = TR(4) + TR(5)*XX + TR(6)*YY
C
  120     CONTINUE
          IF (NPT.EQ.2) THEN
C             -- Contour crosses two sides of cell. Draw line-segment.
              CALL PGMOVE(X(1),Y(1))
              CALL PGDRAW(X(2),Y(2))
          ELSE IF (NPT.EQ.4) THEN
C             -- The 'ambiguous' case.  The routine must draw two line
C             segments here and there are two ways to do so.  The
C             following 4 lines would implement the original PGPLOT
C             method:
C            CALL PGCP(0,X(1),Y(1),CTR)
C            CALL PGCP(1,X(2),Y(2),CTR)
C            CALL PGCP(0,X(3),Y(3),CTR)
C            CALL PGCP(1,X(4),Y(4),CTR)
C            -- Choose between \\ and // based on the 8 points just
C            outside the current box.  If half or more of these points
C            lie below the contour level, then draw the lines such that
C            the high corners lie between the lines, otherwise, draw
C            the lines such that the low corners are enclosed.  Care is
C            taken to avoid going off the edge.
            ITOT=0
            ILO=0
            DO 140 K=1,8
               ITMP=I+IOFF(K)
               JTMP=J+JOFF(K)
               IF(ITMP.LT.I1 .OR. ITMP.GT.I2) GOTO 140
               IF(JTMP.LT.J1 .OR. JTMP.GT.J2) GOTO 140
               IF(A(ITMP,JTMP).EQ.BLANK) GOTO 140
               ITOT=ITOT+1
               IF(A(ITMP,JTMP).LT.CTR) ILO=ILO+1
  140       CONTINUE
            IENC=+1
            IF(ILO.LT.ITOT/2) IENC=-1
            IF(IENC.LT.0 .AND. DVAL(1).LT.CTR .OR.
     :         IENC.GT.0 .AND. DVAL(1).GE.CTR) THEN
               CALL PGMOVE(X(1),Y(1))
               CALL PGDRAW(X(2),Y(2))
               CALL PGMOVE(X(3),Y(3))
               CALL PGDRAW(X(4),Y(4))
            ELSE
               CALL PGMOVE(X(1),Y(1))
               CALL PGDRAW(X(4),Y(4))
               CALL PGMOVE(X(3),Y(3))
               CALL PGDRAW(X(2),Y(2))
            END IF
          END IF
  110     CONTINUE
  130 CONTINUE
C
      CALL PGEBUF
      END
#<

#>            pgconf.dc2
Name:         PGCONF

Purpose:      fill between two contours

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGCONF (A, IDIM, JDIM, I1, I2, J1, J2, C1, C2, TR)
            INTEGER IDIM, JDIM, I1, I2, J1, J2
            REAL    A(IDIM,JDIM), C1, C2, TR(6)
      
       Shade the region between two contour levels of a function defined on
       the nodes of a rectangular grid. The routine uses the current fill
       attributes, hatching style (if appropriate), and color index.
      
       If you want to both shade between contours and draw the contour
       lines, call this routine first (once for each pair of levels) and 
       then CALL PGCONT (or PGCONS) to draw the contour lines on top of the
       shading.
      
       Note 1: This routine is not very efficient: it generates a polygon
       fill command for each cell of the mesh that intersects the desired
       area, rather than consolidating adjacent cells into a single polygon.
      
       Note 2: If both contours intersect all four edges of a particular
       mesh cell, the program behaves badly and may consider some parts
       of the cell to lie in more than one contour range.
      
       Note 3: If a contour crosses all four edges of a cell, this
       routine may not generate the same contours as PGCONT or PGCONS
       (these two routines may not agree either). Such cases are always
       ambiguous and the routines use different approaches to resolving
       the ambiguity.
      
       Arguments:
        A      (input)  : data array.
        IDIM   (input)  : first dimension of A.
        JDIM   (input)  : second dimension of A.
        I1,I2  (input)  : range of first index to be contoured (inclusive).
        J1,J2  (input)  : range of second index to be contoured (inclusive).
        C1, C2 (input)  : contour levels; note that C1 must be less than C2.
        TR     (input)  : array defining a transformation between the I,J
                          grid of the array and the world coordinates. The
                          world coordinates of the array point A(I,J) are
                          given by:
                            X = TR(1) + TR(2)*I + TR(3)*J
                            Y = TR(4) + TR(5)*I + TR(6)*J
                          Usually TR(3) and TR(5) are zero - unless the
                          coordinate transformation involves a rotation
                          or shear.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgconf.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGCONF -- fill between two contours
C%void cpgconf(const float *a, int idim, int jdim, int i1, int i2, \
C% int j1, int j2, float c1, float c2, const float *tr);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgconf( real, integer, integer, integer, integer, integer, integer, real, real, real )
*

C+
      SUBROUTINE PGCONF (A, IDIM, JDIM, I1, I2, J1, J2, C1, C2, TR)
      INTEGER IDIM, JDIM, I1, I2, J1, J2
      REAL    A(IDIM,JDIM), C1, C2, TR(6)
C
C Shade the region between two contour levels of a function defined on
C the nodes of a rectangular grid. The routine uses the current fill
C attributes, hatching style (if appropriate), and color index.
C
C If you want to both shade between contours and draw the contour
C lines, call this routine first (once for each pair of levels) and 
C then CALL PGCONT (or PGCONS) to draw the contour lines on top of the
C shading.
C
C Note 1: This routine is not very efficient: it generates a polygon
C fill command for each cell of the mesh that intersects the desired
C area, rather than consolidating adjacent cells into a single polygon.
C
C Note 2: If both contours intersect all four edges of a particular
C mesh cell, the program behaves badly and may consider some parts
C of the cell to lie in more than one contour range.
C
C Note 3: If a contour crosses all four edges of a cell, this
C routine may not generate the same contours as PGCONT or PGCONS
C (these two routines may not agree either). Such cases are always
C ambiguous and the routines use different approaches to resolving
C the ambiguity.
C
C Arguments:
C  A      (input)  : data array.
C  IDIM   (input)  : first dimension of A.
C  JDIM   (input)  : second dimension of A.
C  I1,I2  (input)  : range of first index to be contoured (inclusive).
C  J1,J2  (input)  : range of second index to be contoured (inclusive).
C  C1, C2 (input)  : contour levels; note that C1 must be less than C2.
C  TR     (input)  : array defining a transformation between the I,J
C                    grid of the array and the world coordinates. The
C                    world coordinates of the array point A(I,J) are
C                    given by:
C                      X = TR(1) + TR(2)*I + TR(3)*J
C                      Y = TR(4) + TR(5)*I + TR(6)*J
C                    Usually TR(3) and TR(5) are zero - unless the
C                    coordinate transformation involves a rotation
C                    or shear.
C--
C 03-Oct-1996 - new routine [TJP].
C-----------------------------------------------------------------------
      INTEGER  I, J, IC, NPT, LEV
      LOGICAL  PGNOTO
      REAL     DVAL(5), X(8), Y(8), DELTA, XX, YY, C, R
      INTEGER  IDELT(6)
      DATA     IDELT/0,-1,-1,0,0,-1/
C
C Check arguments.
C
      IF (PGNOTO('PGCONF')) RETURN
      IF (I1.LT.1 .OR. I2.GT.IDIM .OR. I1.GE.I2 .OR.
     :    J1.LT.1 .OR. J2.GT.JDIM .OR. J1.GE.J2) RETURN
      IF (C1.GE.C2) RETURN
      CALL PGBBUF
C
      DO 140 J=J1+1,J2
         DO 130 I=I1+1,I2
            DVAL(1) = A(I-1,J)
            DVAL(2) = A(I-1,J-1)
            DVAL(3) = A(I,J-1)
            DVAL(4) = A(I,J)
            DVAL(5) = DVAL(1)
C
            NPT = 0
            DO 120 IC=1,4
               IF (DVAL(IC).GE.C1 .AND. DVAL(IC).LT.C2) THEN
                  NPT = NPT+1
                  XX = I+IDELT(IC+1)
                  YY = J+IDELT(IC)
                  X(NPT) = TR(1) + TR(2)*XX + TR(3)*YY
                  Y(NPT) = TR(4) + TR(5)*XX + TR(6)*YY
               END IF
               R = DVAL(IC+1)-DVAL(IC)
               IF (R.EQ.0.0) GOTO 120
               DO 110 LEV=1,2
                  IF (R.GT.0.0) THEN
                     C = C1
                     IF (LEV.EQ.2) C = C2
                  ELSE
                     C = C2
                     IF (LEV.EQ.2) C = C1
                  END IF
                  DELTA = (C-DVAL(IC))/R
                  IF (DELTA.GT.0.0 .AND. DELTA.LT.1.0) THEN
                     IF (IC.EQ.1 .OR. IC.EQ.3) THEN
                        XX = I+IDELT(IC+1)
                        YY = REAL(J+IDELT(IC)) + 
     :                       DELTA*REAL(IDELT(IC+1)-IDELT(IC))
                     ELSE
                        XX = REAL(I+IDELT(IC+1)) +
     :                       DELTA*REAL(IDELT(IC+2)-IDELT(IC+1))
                        YY = J+IDELT(IC)
                     END IF
                     NPT = NPT+1
                     X(NPT) = TR(1) + TR(2)*XX + TR(3)*YY
                     Y(NPT) = TR(4) + TR(5)*XX + TR(6)*YY
                  END IF
 110           CONTINUE
 120        CONTINUE
            IF (NPT.GE.3) CALL PGPOLY(NPT, X, Y)
 130     CONTINUE
 140  CONTINUE
      CALL PGEBUF
      END
#<

#>            pgconl.dc2
Name:         PGCONL

Purpose:      label contour map of a 2D data array 

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGCONL (A, IDIM, JDIM, I1, I2, J1, J2, C, TR,
           1                   LABEL, INTVAL, MININT)
            INTEGER IDIM, JDIM, I1, J1, I2, J2, INTVAL, MININT
            REAL A(IDIM,JDIM), C, TR(6)
            CHARACTER*(*) LABEL
      
       Label a contour map drawn with routine PGCONT. Routine PGCONT should
       be called first to draw the contour lines, then this routine should be
       called to add the labels. Labels are written at intervals along the
       contour lines, centered on the contour lines with lettering aligned
       in the up-hill direction. Labels are opaque, so a part of the under-
       lying contour line is obscured by the label. Labels use the current
       attributes (character height, line width, color index, character
       font).
      
       The first 9 arguments are the same as those supplied to PGCONT, and
       should normally be identical to those used with PGCONT. Note that
       only one contour level can be specified; tolabel more contours, call
       PGCONL for each level.
      
       The Label is supplied as a character string in argument LABEL.
      
       The spacing of labels along the contour is specified by parameters
       INTVAL and MININT. The routine follows the contour through the
       array, counting the number of cells that the contour crosses. The
       first label will be written in the MININT'th cell, and additional
       labels will be written every INTVAL cells thereafter. A contour
       that crosses less than MININT cells will not be labelled. Some
       experimentation may be needed to get satisfactory results; a good
       place to start is INTVAL=20, MININT=10.
      
       Arguments:
        A      (input) : data array.
        IDIM   (input) : first dimension of A.
        JDIM   (input) : second dimension of A.
        I1, I2 (input) : range of first index to be contoured (inclusive).
        J1, J2 (input) : range of second index to be contoured (inclusive).
        C      (input) : the level of the contour to be labelled (one of the
                         values given to PGCONT).
        TR     (input) : array defining a transformation between the I,J
                         grid of the array and the world coordinates.
                         The world coordinates of the array point A(I,J)
                         are given by:
                           X = TR(1) + TR(2)*I + TR(3)*J
                           Y = TR(4) + TR(5)*I + TR(6)*J
                         Usually TR(3) and TR(5) are zero - unless the
                         coordinate transformation involves a rotation or
                         shear.
        LABEL  (input) : character strings to be used to label the specified
                         contour. Leading and trailing blank spaces are
                         ignored.
        INTVAL (input) : spacing along the contour between labels, in
                         grid cells.
        MININT (input) : contours that cross less than MININT cells
                         will not be labelled.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgconl.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGCONL -- label contour map of a 2D data array 
C%void cpgconl(const float *a, int idim, int jdim, int i1, int i2, \
C% int j1, int j2, float c, const float *tr, const char *label, \
C% int intval, int minint);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgconl( real, integer, integer, integer, integer, integer, integer, real, real, character, integer, integer )
*

C+
      SUBROUTINE PGCONL (A, IDIM, JDIM, I1, I2, J1, J2, C, TR,
     1                   LABEL, INTVAL, MININT)
      INTEGER IDIM, JDIM, I1, J1, I2, J2, INTVAL, MININT
      REAL A(IDIM,JDIM), C, TR(6)
      CHARACTER*(*) LABEL
C
C Label a contour map drawn with routine PGCONT. Routine PGCONT should
C be called first to draw the contour lines, then this routine should be
C called to add the labels. Labels are written at intervals along the
C contour lines, centered on the contour lines with lettering aligned
C in the up-hill direction. Labels are opaque, so a part of the under-
C lying contour line is obscured by the label. Labels use the current
C attributes (character height, line width, color index, character
C font).
C
C The first 9 arguments are the same as those supplied to PGCONT, and
C should normally be identical to those used with PGCONT. Note that
C only one contour level can be specified; tolabel more contours, call
C PGCONL for each level.
C
C The Label is supplied as a character string in argument LABEL.
C
C The spacing of labels along the contour is specified by parameters
C INTVAL and MININT. The routine follows the contour through the
C array, counting the number of cells that the contour crosses. The
C first label will be written in the MININT'th cell, and additional
C labels will be written every INTVAL cells thereafter. A contour
C that crosses less than MININT cells will not be labelled. Some
C experimentation may be needed to get satisfactory results; a good
C place to start is INTVAL=20, MININT=10.
C
C Arguments:
C  A      (input) : data array.
C  IDIM   (input) : first dimension of A.
C  JDIM   (input) : second dimension of A.
C  I1, I2 (input) : range of first index to be contoured (inclusive).
C  J1, J2 (input) : range of second index to be contoured (inclusive).
C  C      (input) : the level of the contour to be labelled (one of the
C                   values given to PGCONT).
C  TR     (input) : array defining a transformation between the I,J
C                   grid of the array and the world coordinates.
C                   The world coordinates of the array point A(I,J)
C                   are given by:
C                     X = TR(1) + TR(2)*I + TR(3)*J
C                     Y = TR(4) + TR(5)*I + TR(6)*J
C                   Usually TR(3) and TR(5) are zero - unless the
C                   coordinate transformation involves a rotation or
C                   shear.
C  LABEL  (input) : character strings to be used to label the specified
C                   contour. Leading and trailing blank spaces are
C                   ignored.
C  INTVAL (input) : spacing along the contour between labels, in
C                   grid cells.
C  MININT (input) : contours that cross less than MININT cells
C                   will not be labelled.
C--
C  5-May-1994 - New routine; this routine is virtually identical to
C               PGCONT, but calls PGCONX with a different external
C               routine [TJP].
C  4-Feb-1997 - PGCONX requires an array argument, not scalar [TJP].
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
      INTEGER  I
      LOGICAL  PGNOTO
      REAL     CL(1)
      EXTERNAL PGCL
C
      IF (PGNOTO('PGCONL')) RETURN
C
C Save TRANS matrix and other parameters.
C
      DO 10 I=1,6
          TRANS(I) = TR(I)
   10 CONTINUE
      PGCINT = INTVAL
      PGCMIN = MININT
      PGCLAB = LABEL
C
C Use PGCONX with external function PGCL.
C
      CL(1) = C
      CALL PGCONX (A, IDIM, JDIM, I1, I2, J1, J2, CL, 1, PGCL)
C
      END
#<

#>            pgcons.dc2
Name:         PGCONS

Purpose:      contour map of a 2D data array (fast algorithm)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGCONS (A, IDIM, JDIM, I1, I2, J1, J2, C, NC, TR)
            INTEGER IDIM, JDIM, I1, I2, J1, J2, NC
            REAL    A(IDIM,JDIM), C(*), TR(6)
      
       Draw a contour map of an array. The map is truncated if
       necessary at the boundaries of the viewport.  Each contour line is
       drawn with the current line attributes (color index, style, and
       width).  This routine, unlike PGCONT, does not draw each contour as a
       continuous line, but draws the straight line segments composing each
       contour in a random order.  It is thus not suitable for use on pen
       plotters, and it usually gives unsatisfactory results with dashed or
       dotted lines.  It is, however, faster than PGCONT, especially if
       several contour levels are drawn with one call of PGCONS.
      
       Arguments:
        A      (input)  : data array.
        IDIM   (input)  : first dimension of A.
        JDIM   (input)  : second dimension of A.
        I1,I2  (input)  : range of first index to be contoured (inclusive).
        J1,J2  (input)  : range of second index to be contoured (inclusive).
        C      (input)  : array of contour levels (in the same units as the
                          data in array A); dimension at least NC.
        NC     (input)  : number of contour levels (less than or equal to
                          dimension of C). The absolute value of this
                          argument is used (for compatibility with PGCONT,
                          where the sign of NC is significant).
        TR     (input)  : array defining a transformation between the I,J
                          grid of the array and the world coordinates. The
                          world coordinates of the array point A(I,J) are
                          given by:
                            X = TR(1) + TR(2)*I + TR(3)*J
                            Y = TR(4) + TR(5)*I + TR(6)*J
                          Usually TR(3) and TR(5) are zero - unless the
                          coordinate transformation involves a rotation
                          or shear.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgcons.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGCONS -- contour map of a 2D data array (fast algorithm)
C%void cpgcons(const float *a, int idim, int jdim, int i1, int i2, \
C% int j1, int j2, const float *c, int nc, const float *tr);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgcons( real, integer, integer, integer, integer, integer, integer, real, integer, real )
*

C+
      SUBROUTINE PGCONS (A, IDIM, JDIM, I1, I2, J1, J2, C, NC, TR)
      INTEGER IDIM, JDIM, I1, I2, J1, J2, NC
      REAL    A(IDIM,JDIM), C(*), TR(6)
C
C Draw a contour map of an array. The map is truncated if
C necessary at the boundaries of the viewport.  Each contour line is
C drawn with the current line attributes (color index, style, and
C width).  This routine, unlike PGCONT, does not draw each contour as a
C continuous line, but draws the straight line segments composing each
C contour in a random order.  It is thus not suitable for use on pen
C plotters, and it usually gives unsatisfactory results with dashed or
C dotted lines.  It is, however, faster than PGCONT, especially if
C several contour levels are drawn with one call of PGCONS.
C
C Arguments:
C  A      (input)  : data array.
C  IDIM   (input)  : first dimension of A.
C  JDIM   (input)  : second dimension of A.
C  I1,I2  (input)  : range of first index to be contoured (inclusive).
C  J1,J2  (input)  : range of second index to be contoured (inclusive).
C  C      (input)  : array of contour levels (in the same units as the
C                    data in array A); dimension at least NC.
C  NC     (input)  : number of contour levels (less than or equal to
C                    dimension of C). The absolute value of this
C                    argument is used (for compatibility with PGCONT,
C                    where the sign of NC is significant).
C  TR     (input)  : array defining a transformation between the I,J
C                    grid of the array and the world coordinates. The
C                    world coordinates of the array point A(I,J) are
C                    given by:
C                      X = TR(1) + TR(2)*I + TR(3)*J
C                      Y = TR(4) + TR(5)*I + TR(6)*J
C                    Usually TR(3) and TR(5) are zero - unless the
C                    coordinate transformation involves a rotation
C                    or shear.
C--
C 27-Aug-1984 - [TJP].
C 21-Sep-1989 - Better treatment of the 'ambiguous' case [A. Tennant];
C               compute world coordinates internally and eliminate
C               dependence on common block [TJP].
C-----------------------------------------------------------------------
      INTEGER  I, IC, ICORN, IDELT(6), J, K, NPT
      INTEGER  IOFF(8), JOFF(8), IENC, ITMP, JTMP, ILO, ITOT
      LOGICAL  PGNOTO
      REAL     CTR, DELTA, DVAL(5), XX, YY, X(4), Y(4)
      INTRINSIC ABS
      DATA     IDELT/0,-1,-1,0,0,-1/
      DATA     IOFF/-2,-2,-1,-1, 0, 0, 1, 1/
      DATA     JOFF/ 0,-1,-2, 1,-2, 1,-1, 0/
C
C Check arguments.
C
      IF (PGNOTO('PGCONS')) RETURN
      IF (I1.LT.1 .OR. I2.GT.IDIM .OR. I1.GE.I2 .OR.
     1    J1.LT.1 .OR. J2.GT.JDIM .OR. J1.GE.J2) RETURN
      IF (NC.EQ.0) RETURN
      CALL PGBBUF
C
      DO 130 J=J1+1,J2
      DO 130 I=I1+1,I2
          DVAL(1) = A(I-1,J)
          DVAL(2) = A(I-1,J-1)
          DVAL(3) = A(I,J-1)
          DVAL(4) = A(I,J)
          DVAL(5) = DVAL(1)
      DO 110 IC=1,ABS(NC)
          CTR = C(IC)
          NPT = 0
          DO 120 ICORN=1,4
          IF( (DVAL(ICORN).LT.CTR .AND. DVAL(ICORN+1).LT.CTR)
     1    .OR.(DVAL(ICORN).GE.CTR .AND. DVAL(ICORN+1).GE.CTR) ) GOTO 120
            NPT=NPT+1
            DELTA = (CTR-DVAL(ICORN))/(DVAL(ICORN+1)-DVAL(ICORN))
            GOTO (60,70,60,70), ICORN
C
   60       XX = I+IDELT(ICORN+1)
            YY = REAL(J+IDELT(ICORN)) + 
     1           DELTA*REAL(IDELT(ICORN+1)-IDELT(ICORN))
            GOTO 80
C
   70       XX = REAL(I+IDELT(ICORN+1)) +
     1           DELTA*REAL(IDELT(ICORN+2)-IDELT(ICORN+1))
            YY  = J+IDELT(ICORN)
C
   80       X(NPT) = TR(1) + TR(2)*XX + TR(3)*YY
            Y(NPT) = TR(4) + TR(5)*XX + TR(6)*YY
C
  120     CONTINUE
          IF (NPT.EQ.2) THEN
C             -- Contour crosses two sides of cell. Draw line-segment.
              CALL PGMOVE(X(1),Y(1))
              CALL PGDRAW(X(2),Y(2))
          ELSE IF (NPT.EQ.4) THEN
C             -- The 'ambiguous' case.  The routine must draw two line
C             segments here and there are two ways to do so.  The
C             following 4 lines would implement the original PGPLOT
C             method:
C            CALL PGCP(0,X(1),Y(1),CTR)
C            CALL PGCP(1,X(2),Y(2),CTR)
C            CALL PGCP(0,X(3),Y(3),CTR)
C            CALL PGCP(1,X(4),Y(4),CTR)
C            -- Choose between \\ and // based on the 8 points just
C            outside the current box.  If half or more of these points
C            lie below the contour level, then draw the lines such that
C            the high corners lie between the lines, otherwise, draw
C            the lines such that the low corners are enclosed.  Care is
C            taken to avoid going off the edge.
            ITOT=0
            ILO=0
            DO 140 K=1,8
               ITMP=I+IOFF(K)
               JTMP=J+JOFF(K)
               IF(ITMP.LT.I1 .OR. ITMP.GT.I2) GOTO 140
               IF(JTMP.LT.J1 .OR. JTMP.GT.J2) GOTO 140
               ITOT=ITOT+1
               IF(A(ITMP,JTMP).LT.CTR) ILO=ILO+1
  140       CONTINUE
            IENC=+1
            IF(ILO.LT.ITOT/2) IENC=-1
            IF(IENC.LT.0 .AND. DVAL(1).LT.CTR .OR.
     :         IENC.GT.0 .AND. DVAL(1).GE.CTR) THEN
               CALL PGMOVE(X(1),Y(1))
               CALL PGDRAW(X(2),Y(2))
               CALL PGMOVE(X(3),Y(3))
               CALL PGDRAW(X(4),Y(4))
            ELSE
               CALL PGMOVE(X(1),Y(1))
               CALL PGDRAW(X(4),Y(4))
               CALL PGMOVE(X(3),Y(3))
               CALL PGDRAW(X(2),Y(2))
            END IF
          END IF
  110     CONTINUE
  130 CONTINUE
C
      CALL PGEBUF
      END
#<

#>            pgcont.dc2
Name:         PGCONT

Purpose:      contour map of a 2D data array (contour-following)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGCONT (A, IDIM, JDIM, I1, I2, J1, J2, C, NC, TR)
            INTEGER IDIM, JDIM, I1, J1, I2, J2, NC
            REAL A(IDIM,JDIM), C(*), TR(6)
      
       Draw a contour map of an array.  The map is truncated if
       necessary at the boundaries of the viewport.  Each contour line
       is drawn with the current line attributes (color index, style, and
       width); except that if argument NC is positive (see below), the line
       style is set by PGCONT to 1 (solid) for positive contours or 2
       (dashed) for negative contours.
      
       Arguments:
        A      (input) : data array.
        IDIM   (input) : first dimension of A.
        JDIM   (input) : second dimension of A.
        I1, I2 (input) : range of first index to be contoured (inclusive).
        J1, J2 (input) : range of second index to be contoured (inclusive).
        C      (input) : array of NC contour levels; dimension at least NC.
        NC     (input) : +/- number of contour levels (less than or equal
                         to dimension of C). If NC is positive, it is the
                         number of contour levels, and the line-style is
                         chosen automatically as described above. If NC is
                         negative, it is minus the number of contour
                         levels, and the current setting of line-style is
                         used for all the contours.
        TR     (input) : array defining a transformation between the I,J
                         grid of the array and the world coordinates.
                         The world coordinates of the array point A(I,J)
                         are given by:
                           X = TR(1) + TR(2)*I + TR(3)*J
                           Y = TR(4) + TR(5)*I + TR(6)*J
                         Usually TR(3) and TR(5) are zero - unless the
                         coordinate transformation involves a rotation or
                         shear.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgcont.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGCONT -- contour map of a 2D data array (contour-following)
C%void cpgcont(const float *a, int idim, int jdim, int i1, int i2, \
C% int j1, int j2, const float *c, int nc, const float *tr);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgcont( real, integer, integer, integer, integer, integer, integer, real, integer, real )
*

C+
      SUBROUTINE PGCONT (A, IDIM, JDIM, I1, I2, J1, J2, C, NC, TR)
      INTEGER IDIM, JDIM, I1, J1, I2, J2, NC
      REAL A(IDIM,JDIM), C(*), TR(6)
C
C Draw a contour map of an array.  The map is truncated if
C necessary at the boundaries of the viewport.  Each contour line
C is drawn with the current line attributes (color index, style, and
C width); except that if argument NC is positive (see below), the line
C style is set by PGCONT to 1 (solid) for positive contours or 2
C (dashed) for negative contours.
C
C Arguments:
C  A      (input) : data array.
C  IDIM   (input) : first dimension of A.
C  JDIM   (input) : second dimension of A.
C  I1, I2 (input) : range of first index to be contoured (inclusive).
C  J1, J2 (input) : range of second index to be contoured (inclusive).
C  C      (input) : array of NC contour levels; dimension at least NC.
C  NC     (input) : +/- number of contour levels (less than or equal
C                   to dimension of C). If NC is positive, it is the
C                   number of contour levels, and the line-style is
C                   chosen automatically as described above. If NC is
C                   negative, it is minus the number of contour
C                   levels, and the current setting of line-style is
C                   used for all the contours.
C  TR     (input) : array defining a transformation between the I,J
C                   grid of the array and the world coordinates.
C                   The world coordinates of the array point A(I,J)
C                   are given by:
C                     X = TR(1) + TR(2)*I + TR(3)*J
C                     Y = TR(4) + TR(5)*I + TR(6)*J
C                   Usually TR(3) and TR(5) are zero - unless the
C                   coordinate transformation involves a rotation or
C                   shear.
C--
C (7-Feb-1983)
C (24-Aug-1984) Revised to add the option of not automatically
C       setting the line-style. Sorry about the ugly way this is
C       done (negative NC); this is the least incompatible way of doing
C       it (TJP).
C (21-Sep-1989) Changed to call PGCONX instead of duplicating the code
C       [TJP].
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
      INTEGER  I
      LOGICAL  PGNOTO
      EXTERNAL PGCP
C
      IF (PGNOTO('PGCONT')) RETURN
C
C Save TRANS matrix.
C
      DO 10 I=1,6
          TRANS(I) = TR(I)
   10 CONTINUE
C
C Use PGCONX with external function PGCP, which applies the TRANS
C scaling.
C
      CALL PGCONX (A, IDIM, JDIM, I1, I2, J1, J2, C, NC, PGCP)
C
      END
#<

#>            pgconx.dc2
Name:         PGCONX

Purpose:      contour map of a 2D data array (non rectangular)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGCONX (A, IDIM, JDIM, I1, I2, J1, J2, C, NC, PLOT)
            INTEGER  IDIM, JDIM, I1, J1, I2, J2, NC
            REAL     A(IDIM,JDIM), C(*)
            EXTERNAL PLOT
      
       Draw a contour map of an array using a user-supplied plotting
       routine.  This routine should be used instead of PGCONT when the
       data are defined on a non-rectangular grid.  PGCONT permits only
       a linear transformation between the (I,J) grid of the array
       and the world coordinate system (x,y), but PGCONX permits any
       transformation to be used, the transformation being defined by a
       user-supplied subroutine. The nature of the contouring algorithm,
       however, dictates that the transformation should maintain the
       rectangular topology of the grid, although grid-points may be
       allowed to coalesce.  As an example of a deformed rectangular
       grid, consider data given on the polar grid theta=0.1n(pi/2),
       for n=0,1,...,10, and r=0.25m, for m=0,1,..,4. This grid
       contains 55 points, of which 11 are coincident at the origin.
       The input array for PGCONX should be dimensioned (11,5), and
       data values should be provided for all 55 elements.  PGCONX can
       also be used for special applications in which the height of the
       contour affects its appearance, e.g., stereoscopic views.
      
       The map is truncated if necessary at the boundaries of the viewport.
       Each contour line is drawn with the current line attributes (color
       index, style, and width); except that if argument NC is positive
       (see below), the line style is set by PGCONX to 1 (solid) for
       positive contours or 2 (dashed) for negative contours. Attributes
       for the contour lines can also be set in the user-supplied
       subroutine, if desired.
      
       Arguments:
        A      (input) : data array.
        IDIM   (input) : first dimension of A.
        JDIM   (input) : second dimension of A.
        I1, I2 (input) : range of first index to be contoured (inclusive).
        J1, J2 (input) : range of second index to be contoured (inclusive).
        C      (input) : array of NC contour levels; dimension at least NC.
        NC     (input) : +/- number of contour levels (less than or equal
                         to dimension of C). If NC is positive, it is the
                         number of contour levels, and the line-style is
                         chosen automatically as described above. If NC is
                         negative, it is minus the number of contour
                         levels, and the current setting of line-style is
                         used for all the contours.
        PLOT   (input) : the address (name) of a subroutine supplied by
                         the user, which will be called by PGCONX to do
                         the actual plotting. This must be declared
                         EXTERNAL in the program unit calling PGCONX.
      
       The subroutine PLOT will be called with four arguments:
            CALL PLOT(VISBLE,X,Y,Z)
       where X,Y (input) are real variables corresponding to
       I,J indices of the array A. If  VISBLE (input, integer) is 1,
       PLOT should draw a visible line from the current pen
       position to the world coordinate point corresponding to (X,Y);
       if it is 0, it should move the pen to (X,Y). Z is the value
       of the current contour level, and may be used by PLOT if desired.
       Example:
             SUBROUTINE PLOT (VISBLE,X,Y,Z)
             REAL X, Y, Z, XWORLD, YWORLD
             INTEGER VISBLE
             XWORLD = X*COS(Y) ! this is the user-defined
             YWORLD = X*SIN(Y) ! transformation
             IF (VISBLE.EQ.0) THEN
                 CALL PGMOVE (XWORLD, YWORLD)
             ELSE
                 CALL PGDRAW (XWORLD, YWORLD)
             END IF
             END

Note:         This subroutine is only callable from Fortran, not from C.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgconx.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGCONX -- contour map of a 2D data array (non rectangular)
C+
      SUBROUTINE PGCONX (A, IDIM, JDIM, I1, I2, J1, J2, C, NC, PLOT)
      INTEGER  IDIM, JDIM, I1, J1, I2, J2, NC
      REAL     A(IDIM,JDIM), C(*)
      EXTERNAL PLOT
C
C Draw a contour map of an array using a user-supplied plotting
C routine.  This routine should be used instead of PGCONT when the
C data are defined on a non-rectangular grid.  PGCONT permits only
C a linear transformation between the (I,J) grid of the array
C and the world coordinate system (x,y), but PGCONX permits any
C transformation to be used, the transformation being defined by a
C user-supplied subroutine. The nature of the contouring algorithm,
C however, dictates that the transformation should maintain the
C rectangular topology of the grid, although grid-points may be
C allowed to coalesce.  As an example of a deformed rectangular
C grid, consider data given on the polar grid theta=0.1n(pi/2),
C for n=0,1,...,10, and r=0.25m, for m=0,1,..,4. This grid
C contains 55 points, of which 11 are coincident at the origin.
C The input array for PGCONX should be dimensioned (11,5), and
C data values should be provided for all 55 elements.  PGCONX can
C also be used for special applications in which the height of the
C contour affects its appearance, e.g., stereoscopic views.
C
C The map is truncated if necessary at the boundaries of the viewport.
C Each contour line is drawn with the current line attributes (color
C index, style, and width); except that if argument NC is positive
C (see below), the line style is set by PGCONX to 1 (solid) for
C positive contours or 2 (dashed) for negative contours. Attributes
C for the contour lines can also be set in the user-supplied
C subroutine, if desired.
C
C Arguments:
C  A      (input) : data array.
C  IDIM   (input) : first dimension of A.
C  JDIM   (input) : second dimension of A.
C  I1, I2 (input) : range of first index to be contoured (inclusive).
C  J1, J2 (input) : range of second index to be contoured (inclusive).
C  C      (input) : array of NC contour levels; dimension at least NC.
C  NC     (input) : +/- number of contour levels (less than or equal
C                   to dimension of C). If NC is positive, it is the
C                   number of contour levels, and the line-style is
C                   chosen automatically as described above. If NC is
C                   negative, it is minus the number of contour
C                   levels, and the current setting of line-style is
C                   used for all the contours.
C  PLOT   (input) : the address (name) of a subroutine supplied by
C                   the user, which will be called by PGCONX to do
C                   the actual plotting. This must be declared
C                   EXTERNAL in the program unit calling PGCONX.
C
C The subroutine PLOT will be called with four arguments:
C      CALL PLOT(VISBLE,X,Y,Z)
C where X,Y (input) are real variables corresponding to
C I,J indices of the array A. If  VISBLE (input, integer) is 1,
C PLOT should draw a visible line from the current pen
C position to the world coordinate point corresponding to (X,Y);
C if it is 0, it should move the pen to (X,Y). Z is the value
C of the current contour level, and may be used by PLOT if desired.
C Example:
C       SUBROUTINE PLOT (VISBLE,X,Y,Z)
C       REAL X, Y, Z, XWORLD, YWORLD
C       INTEGER VISBLE
C       XWORLD = X*COS(Y) ! this is the user-defined
C       YWORLD = X*SIN(Y) ! transformation
C       IF (VISBLE.EQ.0) THEN
C           CALL PGMOVE (XWORLD, YWORLD)
C       ELSE
C           CALL PGDRAW (XWORLD, YWORLD)
C       END IF
C       END
C--
C 14-Nov-1985 - new routine [TJP].
C 12-Sep-1989 - correct documentation error [TJP].
C 22-Apr-1990 - corrected bug in panelling algorithm [TJP].
C 13-Dec-1990 - make errors non-fatal [TJP].
C-----------------------------------------------------------------------
      INTEGER  MAXEMX,MAXEMY
      PARAMETER (MAXEMX=100)
      PARAMETER (MAXEMY=100)
      INTEGER  I
      INTEGER  NNX,NNY, KX,KY, KI,KJ, IA,IB, JA,JB, LS, PX, PY
      LOGICAL  STYLE, PGNOTO
C
C Check arguments.
C
      IF (PGNOTO('PGCONX')) RETURN
      IF (I1.LT.1 .OR. I2.GT.IDIM .OR. I1.GE.I2 .OR.
     1    J1.LT.1 .OR. J2.GT.JDIM .OR. J1.GE.J2) THEN
          CALL GRWARN('PGCONX: invalid range I1:I2, J1:J2')
          RETURN
      END IF
      IF (NC.EQ.0) RETURN
      STYLE = NC.GT.0
      CALL PGQLS(LS)
      CALL PGBBUF
C
C Divide arrays into panels not exceeding MAXEMX by MAXEMY for
C contouring by PGCNSC.
C
CD    write (*,*) 'PGCONX window:',i1,i2,j1,j2
      NNX = I2-I1+1
      NNY = J2-J1+1
      KX = MAX(1,(NNX+MAXEMX-2)/(MAXEMX-1))
      KY = MAX(1,(NNY+MAXEMY-2)/(MAXEMY-1))
      PX = (NNX+KX-1)/KX
      PY = (NNY+KY-1)/KY
      DO 60 KI=1,KX
          IA = I1 + (KI-1)*PX
          IB = MIN(I2, IA + PX)
          DO 50 KJ=1,KY
              JA = J1 + (KJ-1)*PY
              JB = MIN(J2, JA + PY)
C
C             Draw the contours in one panel.
C
CD            write (*,*) 'PGCONX panel:',ia,ib,ja,jb
              IF (STYLE) CALL PGSLS(1)
              DO 40 I=1,ABS(NC)
                  IF (STYLE.AND.(C(I).LT.0.0)) CALL PGSLS(2)
                  CALL PGCNSC(A,IDIM,JDIM,IA,IB,JA,JB,C(I),PLOT)
                  IF (STYLE) CALL PGSLS(1)
   40         CONTINUE
   50     CONTINUE
   60 CONTINUE
C
      CALL PGSLS(LS)
      CALL PGEBUF
      END
#<

#>            pgcotic.dc2
Function:     PGCOTIC

Purpose:      Contour map of a 2D data array, with blanking and ticks.

Category:     GRAPHICS

File:         pgplot.src

Author:       M. Vogelaar

Use:          CALL PGCOTIC(A ,            Input        REAL ARRAY (2d)
                           IDIM ,         Input        INTEGER
                           JDIM ,         Input        INTEGER
                           I1 ,           Input        INTEGER
                           I2 ,           Input        INTEGER
                           J1 ,           Input        INTEGER
                           J2 ,           Input        INTEGER
                           C ,            Input        REAL ARRAY
                           NC ,           Input        INTEGER
                           TR ,           Input        REAL ARRAY
                           BLANK,         Input        REAL
                           TLEN,          Input        REAL
                           TSTEP )        Input        INTEGER          

              A        Data array.
              IDIM     First dimension of A.
              JDIM     Second dimension of A.
              I1       Start of range of first index to be
                       contoured (inclusive).
              I2       End of range of first index to be contoured
                       (inclusive).
              J1       Start of range of second index to be
                       contoured (inclusive).
              J2       End of range of first index to be contoured
                       (inclusive).
              C        Array of contour levels (in the same units as the
                       data in array A); dimension at least NC.
              NC       number of contour levels (less than or equal to
                       dimension of C). The absolute value of this
                       argument is used (for compatibility with PGCONT,
                       where the sign of NC is significant).
              TR       Array defining a transformation between the I,J
                       grid of the array and the world coordinates. The
                       world coordinates of the array point A(I,J) are
                       given by:
                         X = TR(1) + TR(2)*I + TR(3)*J
                         Y = TR(4) + TR(5)*I + TR(6)*J
                       Usually TR(3) and TR(5) are zero - unless the
                       coordinate transformation involves a rotation
                       or shear.
              BLANK    Elements of array A that are exactly equal to
                       this value are ignored (blanked).
              TLEN     Length of ticks in world coordinates. If TLEN is
                       positive, the direction of the ticks is toward   
                       a maximum. If it is a negative number, it points  
                       to a minimum.
              TSIZE    Separation of ticks in grids.

Description:  Draw a contour map of an array. This routine is the same as
              PGCONS, except that array elements that have the "magic value"
              defined by argument BLANK are ignored, making gaps in the
              contour map. The routine may be useful for data measured on
              most but not all of the points of a grid. It also plots 
              ticks normal to contour. The ticks have length TLEN and are 
              plotted at i mod TSTEP.

Updates:      Nov 14, 1994: VOG Document created.
#<

#>            pgcotic.f
* GIPSY-private
*

C pgcotic.f
C
C	Copyright (c) Kapteyn Laboratorium Groningen 1990
C	All Rights Reserved.
C
C
C Fortran to C interface:
C
C@ subroutine pgcotic( real, integer, integer, integer, integer, integer, integer, real, integer, real, real, real, integer )
C
C*PGCOTIC -- contour map of a 2D data array, with blanking and ticks
C+
      SUBROUTINE PGCOTIC (A, IDIM, JDIM, I1, I2, J1, J2, C, NC, TR, 
     1                    BLANK, TLEN, TSTEP )
      INTEGER IDIM, JDIM, I1, I2, J1, J2, NC, TSTEP
      REAL    A(IDIM,JDIM), C(*), TR(6), BLANK, TLEN
C
C Draw a contour map of an array. This routine is the same as PGCONS,
C except that array elements that have the "magic value" defined by
C argument BLANK are ignored, making gaps in the contour map. The
C routine may be useful for data measured on most but not all of the
C points of a grid. 
C It also plots ticks normal to contour. The ticks have length TLEN
C and are plotted at i mod TSTEP
C
C Arguments:
C  A      (input)  : data array.
C  IDIM   (input)  : first dimension of A.
C  JDIM   (input)  : second dimension of A.
C  I1,I2  (input)  : range of first index to be contoured (inclusive).
C  J1,J2  (input)  : range of second index to be contoured (inclusive).
C  C      (input)  : array of contour levels (in the same units as the
C                    data in array A); dimension at least NC.
C  NC     (input)  : number of contour levels (less than or equal to
C                    dimension of C). The absolute value of this
C                    argument is used (for compatibility with PGCONT,
C                    where the sign of NC is significant).
C  TR     (input)  : array defining a transformation between the I,J
C                    grid of the array and the world coordinates. The
C                    world coordinates of the array point A(I,J) are
C                    given by:
C                      X = TR(1) + TR(2)*I + TR(3)*J
C                      Y = TR(4) + TR(5)*I + TR(6)*J
C                    Usually TR(3) and TR(5) are zero - unless the
C                    coordinate transformation involves a rotation
C                    or shear.
C  BLANK   (input) : elements of array A that are exactly equal to
C                    this value are ignored (blanked).
C  TLEN    (input) : Length of ticks in world coordinates. If TLEN is
C                    positive, the direction of the ticks is toward
C                    a maximum. If it is a negative number, it points 
C                    to a minimum.
C  TSTEP   (input) : Separation of ticks in grids.
C--
C 21-Sep-1989 - Derived from PGCONS [TJP].
C-----------------------------------------------------------------------
      INTEGER  I, IC, ICORN, IDELT(6), J, K, NPT
      INTEGER  IOFF(8), JOFF(8), IENC, ITMP, JTMP, ILO, ITOT
      INTEGER  COUNT
      REAL     CTR, DELTA, DVAL(5), XX, YY, X(4), Y(4)
      REAL     XA, YA
      REAL     LAM
      INTRINSIC ABS
      DATA     IDELT/0,-1,-1,0,0,-1/
      DATA     IOFF/-2,-2,-1,-1, 0, 0, 1, 1/
      DATA     JOFF/ 0,-1,-2, 1,-2, 1,-1, 0/
C
C Check arguments.
C
      IF (I1.LT.1 .OR. I2.GT.IDIM .OR. I1.GE.I2 .OR.
     1    J1.LT.1 .OR. J2.GT.JDIM .OR. J1.GE.J2) RETURN
      IF (NC.EQ.0) RETURN
      CALL PGBBUF
C
      COUNT = -1
      DO 130 J=J1+1,J2
      DO 130 I=I1+1,I2
          COUNT = COUNT + 1
          DVAL(1) = A(I-1,J)
          DVAL(2) = A(I-1,J-1)
          DVAL(3) = A(I,J-1)
          DVAL(4) = A(I,J)
          DVAL(5) = DVAL(1)
          IF (DVAL(1).EQ.BLANK .OR. DVAL(2).EQ.BLANK .OR.
     1        DVAL(3).EQ.BLANK .OR. DVAL(4).EQ.BLANK) GOTO 130
      DO 110 IC=1,ABS(NC)
          CTR = C(IC)
          NPT = 0
          DO 120 ICORN=1,4
          IF( (DVAL(ICORN).LT.CTR .AND. DVAL(ICORN+1).LT.CTR)
     1    .OR.(DVAL(ICORN).GE.CTR .AND. DVAL(ICORN+1).GE.CTR) ) GOTO 120
            NPT=NPT+1
            DELTA = (CTR-DVAL(ICORN))/(DVAL(ICORN+1)-DVAL(ICORN))
            GOTO (60,70,60,70), ICORN
C
   60       XX = I+IDELT(ICORN+1)
            YY = REAL(J+IDELT(ICORN)) + 
     1           DELTA*REAL(IDELT(ICORN+1)-IDELT(ICORN))
            GOTO 80
C
   70       XX = REAL(I+IDELT(ICORN+1)) +
     1           DELTA*REAL(IDELT(ICORN+2)-IDELT(ICORN+1))
            YY  = J+IDELT(ICORN)
C
   80       X(NPT) = TR(1) + TR(2)*XX + TR(3)*YY
            Y(NPT) = TR(4) + TR(5)*XX + TR(6)*YY
C
  120     CONTINUE
          IF (NPT.EQ.2) THEN
C             -- Contour crosses two sides of cell. Draw line-segment.
             CALL PGMOVE(X(1),Y(1))
             CALL PGDRAW(X(2),Y(2))
             IF (MOD(COUNT,TSTEP).EQ.0) THEN
C              IF ((MOD(J,TSTEP).EQ.0).AND.(MOD(I,TSTEP).EQ.0)) THEN
               LAM = SQRT( (X(2)-X(1))**2.0 + (Y(2)-Y(1))**2.0 )
               LAM = TLEN / LAM
               XA = 0.5*(X(1)+X(2))
               YA = 0.5*(Y(1)+Y(2))
               CALL PGMOVE(XA,YA)
C 
               IF ((X(2).GT.X(1)).AND.(Y(2).GT.Y(1))) THEN
                 IF (DVAL(1).GT.DVAL(3)) THEN
                    CALL PGDRAW(XA+LAM*(Y(1)-Y(2)),YA+LAM*(X(2)-X(1)))
                 ELSE
                    CALL PGDRAW(XA-LAM*(Y(1)-Y(2)),YA-LAM*(X(2)-X(1)))
                 END IF
               END IF
C
               IF ((X(2).GT.X(1)).AND.(Y(2).LT.Y(1))) THEN
                 IF (DVAL(2).LT.DVAL(4)) THEN
                    CALL PGDRAW(XA+LAM*(Y(1)-Y(2)),YA+LAM*(X(2)-X(1)))
                 ELSE
                    CALL PGDRAW(XA-LAM*(Y(1)-Y(2)),YA-LAM*(X(2)-X(1)))
                 END IF
               END IF
C
               IF ((X(2).LT.X(1)).AND.(Y(2).GT.Y(1))) THEN
                 IF (DVAL(2).GT.DVAL(4)) THEN
                    CALL PGDRAW(XA+LAM*(Y(1)-Y(2)),YA+LAM*(X(2)-X(1)))
                 ELSE
                    CALL PGDRAW(XA-LAM*(Y(1)-Y(2)),YA-LAM*(X(2)-X(1)))
                 END IF
               END IF
C
               IF ((X(2).LT.X(1)).AND.(Y(2).LT.Y(1))) THEN
                 IF (DVAL(1).LT.DVAL(3)) THEN
                    CALL PGDRAW(XA+LAM*(Y(1)-Y(2)),YA+LAM*(X(2)-X(1)))
                 ELSE
                    CALL PGDRAW(XA-LAM*(Y(1)-Y(2)),YA-LAM*(X(2)-X(1)))
                 END IF
               END IF
              END IF
C
          ELSE IF (NPT.EQ.4) THEN
C             -- The 'ambiguous' case.  The routine must draw two line
C             segments here and there are two ways to do so.  The
C             following 4 lines would implement the original PGPLOT
C             method:
C            CALL PGCP(0,X(1),Y(1),CTR)
C            CALL PGCP(1,X(2),Y(2),CTR)
C            CALL PGCP(0,X(3),Y(3),CTR)
C            CALL PGCP(1,X(4),Y(4),CTR)
C            -- Choose between \\ and // based on the 8 points just
C            outside the current box.  If half or more of these points
C            lie below the contour level, then draw the lines such that
C            the high corners lie between the lines, otherwise, draw
C            the lines such that the low corners are enclosed.  Care is
C            taken to avoid going off the edge.
            ITOT=0
            ILO=0
            DO 140 K=1,8
               ITMP=I+IOFF(K)
               JTMP=J+JOFF(K)
               IF(ITMP.LT.I1 .OR. ITMP.GT.I2) GOTO 140
               IF(JTMP.LT.J1 .OR. JTMP.GT.J2) GOTO 140
               IF(A(ITMP,JTMP).EQ.BLANK) GOTO 140
               ITOT=ITOT+1
               IF(A(ITMP,JTMP).LT.CTR) ILO=ILO+1
  140       CONTINUE
            IENC=+1
            IF(ILO.LT.ITOT/2) IENC=-1
            IF(IENC.LT.0 .AND. DVAL(1).LT.CTR .OR.
     :         IENC.GT.0 .AND. DVAL(1).GE.CTR) THEN
               CALL PGMOVE(X(1),Y(1))
               CALL PGDRAW(X(2),Y(2))
               CALL PGMOVE(X(3),Y(3))
               CALL PGDRAW(X(4),Y(4))
            ELSE
               CALL PGMOVE(X(1),Y(1))
               CALL PGDRAW(X(4),Y(4))
               CALL PGMOVE(X(3),Y(3))
               CALL PGDRAW(X(2),Y(2))
            END IF
          END IF
  110     CONTINUE
  130 CONTINUE
C
      CALL PGEBUF
      END

#<

#>            pgcp.dc3
Name:         pgcp

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Oct 16, 1998: JPT automatically generated.
#<

#>            pgcp.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C
      SUBROUTINE PGCP (K, X, Y, Z)
C
C PGPLOT (internal routine): Draw one contour segment (for use by
C PGCNSC).
C
C Arguments:
C
C K (input, integer): if K=0, move the pen to (X,Y); if K=1, draw
C       a line from the current position to (X,Y); otherwise
C       do nothing.
C X (input, real): X world-coordinate of end point.
C Y (input, real): Y world-coordinate of end point.
C Z (input, real): the value of the contour level, not used by PGCP at
C       the moment.
C
C (7-Feb-1983)
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
      INTEGER  K
      REAL     X,XX,Y,YY,Z
C
      XX = TRANS(1) + TRANS(2)*X + TRANS(3)*Y
      YY = TRANS(4) + TRANS(5)*X + TRANS(6)*Y
      IF (K.EQ.1) THEN
          CALL GRLINA(XX,YY)
      ELSE IF (K.EQ.0) THEN
          CALL GRMOVA(XX,YY)
      END IF
      END
#<

#>            pgctab.dc2
Name:         PGCTAB

Purpose:      install the color table to be used by PGIMAG

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGCTAB(L, R, G, B, NC, CONTRA, BRIGHT)
            INTEGER NC
            REAL    L(NC), R(NC), G(NC), B(NC), CONTRA, BRIGHT
      
       Use the given color table to change the color representations of
       all color indexes marked for use by PGIMAG. To change which
       color indexes are thus marked, call PGSCIR before calling PGCTAB
       or PGIMAG. On devices that can change the color representations
       of previously plotted graphics, PGCTAB will also change the colors
       of existing graphics that were plotted with the marked color
       indexes. This feature can then be combined with PGBAND to
       interactively manipulate the displayed colors of data previously
       plotted with PGIMAG.
      
       Limitations:
        1. Some devices do not propagate color representation changes
           to previously drawn graphics.
        2. Some devices ignore requests to change color representations.
        3. The appearance of specific color representations on grey-scale
           devices is device-dependent.
      
       Notes:
        To reverse the sense of a color table, change the chosen contrast
        and brightness to -CONTRA and 1-BRIGHT.
      
        In the following, the term 'color table' refers to the input
        L,R,G,B arrays, whereas 'color ramp' refers to the resulting
        ramp of colors that would be seen with PGWEDG.
      
       Arguments:
        L      (input)  : An array of NC normalized ramp-intensity levels
                          corresponding to the RGB primary color intensities
                          in R(),G(),B(). Colors on the ramp are linearly
                          interpolated from neighbouring levels.
                          Levels must be sorted in increasing order.
                           0.0 places a color at the beginning of the ramp.
                           1.0 places a color at the end of the ramp.
                          Colors outside these limits are legal, but will
                          not be visible if CONTRA=1.0 and BRIGHT=0.5.
        R      (input)  : An array of NC normalized red intensities.
        G      (input)  : An array of NC normalized green intensities.
        B      (input)  : An array of NC normalized blue intensities.
        NC     (input)  : The number of color table entries.
        CONTRA (input)  : The contrast of the color ramp (normally 1.0).
                          Negative values reverse the direction of the ramp.
        BRIGHT (input)  : The brightness of the color ramp. This is normally
                          0.5, but can sensibly hold any value between 0.0
                          and 1.0. Values at or beyond the latter two
                          extremes, saturate the color ramp with the colors
                          of the respective end of the color table.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgctab.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGCTAB -- install the color table to be used by PGIMAG
C%void cpgctab(const float *l, const float *r, const float *g, \
C% const float *b, int nc, float contra, float bright);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgctab( real, real, real, real, integer, real, real )
*

C+
      SUBROUTINE PGCTAB(L, R, G, B, NC, CONTRA, BRIGHT)
      INTEGER NC
      REAL    L(NC), R(NC), G(NC), B(NC), CONTRA, BRIGHT
C
C Use the given color table to change the color representations of
C all color indexes marked for use by PGIMAG. To change which
C color indexes are thus marked, call PGSCIR before calling PGCTAB
C or PGIMAG. On devices that can change the color representations
C of previously plotted graphics, PGCTAB will also change the colors
C of existing graphics that were plotted with the marked color
C indexes. This feature can then be combined with PGBAND to
C interactively manipulate the displayed colors of data previously
C plotted with PGIMAG.
C
C Limitations:
C  1. Some devices do not propagate color representation changes
C     to previously drawn graphics.
C  2. Some devices ignore requests to change color representations.
C  3. The appearance of specific color representations on grey-scale
C     devices is device-dependent.
C
C Notes:
C  To reverse the sense of a color table, change the chosen contrast
C  and brightness to -CONTRA and 1-BRIGHT.
C
C  In the following, the term 'color table' refers to the input
C  L,R,G,B arrays, whereas 'color ramp' refers to the resulting
C  ramp of colors that would be seen with PGWEDG.
C
C Arguments:
C  L      (input)  : An array of NC normalized ramp-intensity levels
C                    corresponding to the RGB primary color intensities
C                    in R(),G(),B(). Colors on the ramp are linearly
C                    interpolated from neighbouring levels.
C                    Levels must be sorted in increasing order.
C                     0.0 places a color at the beginning of the ramp.
C                     1.0 places a color at the end of the ramp.
C                    Colors outside these limits are legal, but will
C                    not be visible if CONTRA=1.0 and BRIGHT=0.5.
C  R      (input)  : An array of NC normalized red intensities.
C  G      (input)  : An array of NC normalized green intensities.
C  B      (input)  : An array of NC normalized blue intensities.
C  NC     (input)  : The number of color table entries.
C  CONTRA (input)  : The contrast of the color ramp (normally 1.0).
C                    Negative values reverse the direction of the ramp.
C  BRIGHT (input)  : The brightness of the color ramp. This is normally
C                    0.5, but can sensibly hold any value between 0.0
C                    and 1.0. Values at or beyond the latter two
C                    extremes, saturate the color ramp with the colors
C                    of the respective end of the color table.
C--
C  17-Sep-1994 - New routine [MCS].
C  14-Apr-1997 - Modified to implement a more conventional
C                interpretation of contrast and brightness [MCS].
C-----------------------------------------------------------------------
      INTEGER MININD, MAXIND, CI
      INTEGER NTOTAL, NSPAN
      INTEGER BELOW, ABOVE
      LOGICAL FORWRD
      REAL CA, CB, CIFRAC, SPAN
      REAL LEVEL
      REAL LDIFF, LFRAC
      REAL RED, GREEN, BLUE
C
C Set the minimum absolute contrast - this prevents a divide by zero.
C
      REAL MINCTR
      PARAMETER (MINCTR = 1.0/256)
C
C No colormap entries?
C
      IF(NC .EQ. 0) RETURN
C
C Determine the range of color indexes to be used.
C
      CALL PGQCIR(MININD, MAXIND)
C
C Count the total number of color indexes to be processed.
C
      NTOTAL = MAXIND - MININD + 1
C
C No definable colors?
C
      IF(NTOTAL .LT. 1 .OR. MININD .LT. 0) RETURN
C
C Prevent a divide by zero later by ensuring that CONTRA >= ABS(MINCTR).
C
      IF(ABS(CONTRA) .LT. MINCTR) THEN
        CONTRA = SIGN(MINCTR, CONTRA)
      END IF
C
C Convert contrast to the normalized stretch of the
C color table across the available color index range.
C
      SPAN = 1.0 / ABS(CONTRA)
C
C Translate from brightness and contrast to the normalized color index
C coordinates, CA and CB, at which to place the start and end of the
C color table.
C
      IF(CONTRA .GE. 0.0) THEN
        CA = 1.0 - BRIGHT * (1.0 + SPAN)
        CB = CA + SPAN
      ELSE
        CA = BRIGHT * (1.0 + SPAN)
        CB = CA - SPAN
      END IF
C
C Determine the number of color indexes spanned by the color table.
C
      NSPAN = INT(SPAN * NTOTAL)
C
C Determine the direction in which the color table should be traversed.
C
      FORWRD = CA .LE. CB
C
C Initialize the indexes at which to start searching the color table.
C
C Set the start index for traversing the table from NC to 1.
C
      BELOW = NC
C
C Set the start index for traversing the table from 1 to NC.
C
      ABOVE = 1
C
C Buffer PGPLOT commands until the color map has been completely
C installed.
C
      CALL PGBBUF
C
C Linearly interpolate the color table RGB values onto each color index.
C
      DO 1 CI=MININD, MAXIND
C
C Turn the color index into a fraction of the range MININD..MAXIND.
C
        CIFRAC = REAL(CI-MININD) / REAL(MAXIND-MININD)
C
C Determine the color table position that corresponds to color index,
C CI.
C
        IF(NSPAN .GT. 0) THEN
          LEVEL = (CIFRAC-CA) / (CB-CA)
        ELSE
          IF(CIFRAC .LE. CA) THEN
            LEVEL = 0.0
          ELSE
            LEVEL = 1.0
          END IF
        END IF
C
C Search for the indexes of the two color table entries that straddle
C LEVEL. The search algorithm assumes that values in L() are
C arranged in increasing order. This allows us to search the color table
C from the point at which the last search left off, rather than having
C to search the whole color table each time.
C
        IF(FORWRD) THEN
 2        IF(ABOVE.LE.NC .AND. L(ABOVE).LT.LEVEL) THEN
            ABOVE = ABOVE + 1
            GOTO 2
          END IF
          BELOW = ABOVE - 1
        ELSE
 3        IF(BELOW.GE.1 .AND. L(BELOW).GT.LEVEL) THEN
            BELOW = BELOW - 1
            GOTO 3
          END IF
          ABOVE = BELOW + 1
        END IF
C
C If the indexes lie outside the table, substitute the index of the
C nearest edge of the table.
C
        IF(BELOW .LT. 1) THEN
          LEVEL = 0.0
          BELOW = 1
          ABOVE = 1
        ELSE IF(ABOVE .GT. NC) THEN
          LEVEL = 1.0
          BELOW = NC
          ABOVE = NC
        END IF
C
C Linearly interpolate the primary color intensities from color table
C entries, BELOW and ABOVE.
C
        LDIFF = L(ABOVE) - L(BELOW)
        IF(LDIFF .GT. MINCTR) THEN
          LFRAC = (LEVEL - L(BELOW)) / LDIFF
        ELSE
          LFRAC = 0.0
        END IF
        RED   = R(BELOW) + (R(ABOVE) - R(BELOW)) * LFRAC
        GREEN = G(BELOW) + (G(ABOVE) - G(BELOW)) * LFRAC
        BLUE  = B(BELOW) + (B(ABOVE) - B(BELOW)) * LFRAC
C
C Intensities are only defined between 0 and 1.
C
        IF(RED   .LT. 0.0)   RED = 0.0
        IF(RED   .GT. 1.0)   RED = 1.0
        IF(GREEN .LT. 0.0) GREEN = 0.0
        IF(GREEN .GT. 1.0) GREEN = 1.0
        IF(BLUE  .LT. 0.0)  BLUE = 0.0
        IF(BLUE  .GT. 1.0)  BLUE = 1.0
C
C Install the new color representation.
C
        CALL PGSCR(CI, RED, GREEN, BLUE)
 1    CONTINUE
C
C Reveal the changed color map.
C
      CALL PGEBUF
      RETURN
      END
#<

#>            pgcurs.dc2
Name:         PGCURS

Purpose:      read cursor position

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            INTEGER FUNCTION PGCURS (X, Y, CH)
            REAL X, Y
            CHARACTER*(*) CH
      
       Read the cursor position and a character typed by the user.
       The position is returned in world coordinates.  PGCURS positions
       the cursor at the position specified, allows the user to move the
       cursor using the joystick or arrow keys or whatever is available on
       the device. When he has positioned the cursor, the user types a
       single character on the keyboard; PGCURS then returns this
       character and the new cursor position (in world coordinates).
      
       Returns:
        PGCURS         : 1 if the call was successful; 0 if the device
                          has no cursor or some other error occurs.
       Arguments:
        X      (in/out) : the world x-coordinate of the cursor.
        Y      (in/out) : the world y-coordinate of the cursor.
        CH     (output) : the character typed by the user; if the device has
                          no cursor or if some other error occurs, the value
                          CHAR(0) [ASCII NUL character] is returned.
      
       Note: The cursor coordinates (X,Y) may be changed by PGCURS even if
       the device has no cursor or if the user does not move the cursor.
       Under these circumstances, the position returned in (X,Y) is that of
       the pixel nearest to the requested position.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgcurs.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGCURS -- read cursor position
C%int cpgcurs(float *x, float *y, char *ch_scalar);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ integer function pgcurs( real, real, character )
*

C+
      INTEGER FUNCTION PGCURS (X, Y, CH)
      REAL X, Y
      CHARACTER*(*) CH
C
C Read the cursor position and a character typed by the user.
C The position is returned in world coordinates.  PGCURS positions
C the cursor at the position specified, allows the user to move the
C cursor using the joystick or arrow keys or whatever is available on
C the device. When he has positioned the cursor, the user types a
C single character on the keyboard; PGCURS then returns this
C character and the new cursor position (in world coordinates).
C
C Returns:
C  PGCURS         : 1 if the call was successful; 0 if the device
C                    has no cursor or some other error occurs.
C Arguments:
C  X      (in/out) : the world x-coordinate of the cursor.
C  Y      (in/out) : the world y-coordinate of the cursor.
C  CH     (output) : the character typed by the user; if the device has
C                    no cursor or if some other error occurs, the value
C                    CHAR(0) [ASCII NUL character] is returned.
C
C Note: The cursor coordinates (X,Y) may be changed by PGCURS even if
C the device has no cursor or if the user does not move the cursor.
C Under these circumstances, the position returned in (X,Y) is that of
C the pixel nearest to the requested position.
C--
C  7-Sep-1994 - changed to use PGBAND [TJP].
C-----------------------------------------------------------------------
      INTEGER PGBAND
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGCURS')) THEN
         CH = CHAR(0)
         PGCURS = 0
      ELSE
         PGCURS = PGBAND(0, 1, 0.0, 0.0, X, Y, CH)
      END IF
      END
#<

#>            pgcurse.dc2
Name:         PGCURSE

Purpose:      non-standard alias for PGCURS

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            INTEGER FUNCTION PGCURSE (X, Y, CH)
            REAL X, Y
            CHARACTER*1 CH
      
       See description of PGCURS.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgcurse.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGCURSE -- non-standard alias for PGCURS
C+
      INTEGER FUNCTION PGCURSE (X, Y, CH)
      REAL X, Y
      CHARACTER*1 CH
C
C See description of PGCURS.
C--
      INTEGER PGCURS
      PGCURSE = PGCURS (X, Y, CH)
      END
#<

#>            pgdraw.dc2
Name:         PGDRAW

Purpose:      draw a line from the current pen position to a point

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGDRAW (X, Y)
            REAL X, Y
      
       Draw a line from the current pen position to the point
       with world-coordinates (X,Y). The line is clipped at the edge of the
       current window. The new pen position is (X,Y) in world coordinates.
      
       Arguments:
        X      (input)  : world x-coordinate of the end point of the line.
        Y      (input)  : world y-coordinate of the end point of the line.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgdraw.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGDRAW -- draw a line from the current pen position to a point
C%void cpgdraw(float x, float y);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgdraw( real, real )
*

C+
      SUBROUTINE PGDRAW (X, Y)
      REAL X, Y
C
C Draw a line from the current pen position to the point
C with world-coordinates (X,Y). The line is clipped at the edge of the
C current window. The new pen position is (X,Y) in world coordinates.
C
C Arguments:
C  X      (input)  : world x-coordinate of the end point of the line.
C  Y      (input)  : world y-coordinate of the end point of the line.
C--
C 27-Nov-1986
C-----------------------------------------------------------------------
      CALL PGBBUF
      CALL GRLINA(X,Y)
      CALL PGEBUF
      END
#<

#>            pgebuf.dc2
Name:         PGEBUF

Purpose:      end batch of output (buffer)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGEBUF
      
       A call to PGEBUF marks the end of a batch of graphical output begun
       with the last call of PGBBUF.  PGBBUF and PGEBUF calls should always
       be paired. Each call to PGBBUF increments a counter, while each call
       to PGEBUF decrements the counter. When the counter reaches 0, the
       batch of output is written on the output device.
      
       Arguments: none

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgebuf.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGEBUF -- end batch of output (buffer)
C%void cpgebuf(void);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgebuf(  )
*

C+
      SUBROUTINE PGEBUF
C
C A call to PGEBUF marks the end of a batch of graphical output begun
C with the last call of PGBBUF.  PGBBUF and PGEBUF calls should always
C be paired. Each call to PGBBUF increments a counter, while each call
C to PGEBUF decrements the counter. When the counter reaches 0, the
C batch of output is written on the output device.
C
C Arguments: none
C--
C 21-Nov-1985 - new routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      LOGICAL PGNOTO
C
      IF (.NOT.PGNOTO('PGEBUF')) THEN
          PGBLEV(PGID) = MAX(0, PGBLEV(PGID) - 1)
          IF (PGBLEV(PGID).EQ.0) CALL GRTERM
      END IF
      END
#<

#>            pgend.dc2
Name:         PGEND

Purpose:      close all open graphics devices

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGEND
      
       Close and release any open graphics devices. All devices must be
       closed by calling either PGCLOS (for each device) or PGEND before
       the program terminates. If a device is not closed properly, some
       or all of the graphical output may be lost.
      
       Arguments: none

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgend.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGEND -- close all open graphics devices
C%void cpgend(void);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgend(  )
*

C+
      SUBROUTINE PGEND
C
C Close and release any open graphics devices. All devices must be
C closed by calling either PGCLOS (for each device) or PGEND before
C the program terminates. If a device is not closed properly, some
C or all of the graphical output may be lost.
C
C Arguments: none
C--
C 22-Dec-1995 [TJP] - revised to call PGCLOS for each open device.
C 25-Feb-1997 [TJP] - revised description.
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      INTEGER I
C
      DO 10 I=1,PGMAXD
         IF (PGDEVS(I).EQ.1) THEN
            CALL PGSLCT(I)
            CALL PGCLOS
         END IF
 10   CONTINUE
      END
#<

#>            pgenv.dc2
Name:         PGENV

Purpose:      set window and viewport and draw labeled frame

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGENV (XMIN, XMAX, YMIN, YMAX, JUST, AXIS)
            REAL XMIN, XMAX, YMIN, YMAX
            INTEGER JUST, AXIS
      
       Set PGPLOT "Plotter Environment".  PGENV establishes the scaling
       for subsequent calls to PGPT, PGLINE, etc.  The plotter is
       advanced to a new page or panel, clearing the screen if necessary.
       If the "prompt state" is ON (see PGASK), confirmation
       is requested from the user before clearing the screen.
       If requested, a box, axes, labels, etc. are drawn according to
       the setting of argument AXIS.
      
       Arguments:
        XMIN   (input)  : the world x-coordinate at the bottom left corner
                          of the viewport.
        XMAX   (input)  : the world x-coordinate at the top right corner
                          of the viewport (note XMAX may be less than XMIN).
        YMIN   (input)  : the world y-coordinate at the bottom left corner
                          of the viewport.
        YMAX   (input)  : the world y-coordinate at the top right corner
                          of the viewport (note YMAX may be less than YMIN).
        JUST   (input)  : if JUST=1, the scales of the x and y axes (in
                          world coordinates per inch) will be equal,
                          otherwise they will be scaled independently.
        AXIS   (input)  : controls the plotting of axes, tick marks, etc:
            AXIS = -2 : draw no box, axes or labels;
            AXIS = -1 : draw box only;
            AXIS =  0 : draw box and label it with coordinates;
            AXIS =  1 : same as AXIS=0, but also draw the
                        coordinate axes (X=0, Y=0);
            AXIS =  2 : same as AXIS=1, but also draw grid lines
                        at major increments of the coordinates;
            AXIS = 10 : draw box and label X-axis logarithmically;
            AXIS = 20 : draw box and label Y-axis logarithmically;
            AXIS = 30 : draw box and label both axes logarithmically.
      
       For other axis options, use routine PGBOX. PGENV can be persuaded to
       call PGBOX with additional axis options by defining an environment
       parameter PGPLOT_ENVOPT containing the required option codes. 
       Examples:
         PGPLOT_ENVOPT=P      ! draw Projecting tick marks
         PGPLOT_ENVOPT=I      ! Invert the tick marks
         PGPLOT_ENVOPT=IV     ! Invert tick marks and label y Vertically

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgenv.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGENV -- set window and viewport and draw labeled frame
C%void cpgenv(float xmin, float xmax, float ymin, float ymax, \
C% int just, int axis);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgenv( real, real, real, real, integer, integer )
*

C+
      SUBROUTINE PGENV (XMIN, XMAX, YMIN, YMAX, JUST, AXIS)
      REAL XMIN, XMAX, YMIN, YMAX
      INTEGER JUST, AXIS
C
C Set PGPLOT "Plotter Environment".  PGENV establishes the scaling
C for subsequent calls to PGPT, PGLINE, etc.  The plotter is
C advanced to a new page or panel, clearing the screen if necessary.
C If the "prompt state" is ON (see PGASK), confirmation
C is requested from the user before clearing the screen.
C If requested, a box, axes, labels, etc. are drawn according to
C the setting of argument AXIS.
C
C Arguments:
C  XMIN   (input)  : the world x-coordinate at the bottom left corner
C                    of the viewport.
C  XMAX   (input)  : the world x-coordinate at the top right corner
C                    of the viewport (note XMAX may be less than XMIN).
C  YMIN   (input)  : the world y-coordinate at the bottom left corner
C                    of the viewport.
C  YMAX   (input)  : the world y-coordinate at the top right corner
C                    of the viewport (note YMAX may be less than YMIN).
C  JUST   (input)  : if JUST=1, the scales of the x and y axes (in
C                    world coordinates per inch) will be equal,
C                    otherwise they will be scaled independently.
C  AXIS   (input)  : controls the plotting of axes, tick marks, etc:
C      AXIS = -2 : draw no box, axes or labels;
C      AXIS = -1 : draw box only;
C      AXIS =  0 : draw box and label it with coordinates;
C      AXIS =  1 : same as AXIS=0, but also draw the
C                  coordinate axes (X=0, Y=0);
C      AXIS =  2 : same as AXIS=1, but also draw grid lines
C                  at major increments of the coordinates;
C      AXIS = 10 : draw box and label X-axis logarithmically;
C      AXIS = 20 : draw box and label Y-axis logarithmically;
C      AXIS = 30 : draw box and label both axes logarithmically.
C
C For other axis options, use routine PGBOX. PGENV can be persuaded to
C call PGBOX with additional axis options by defining an environment
C parameter PGPLOT_ENVOPT containing the required option codes. 
C Examples:
C   PGPLOT_ENVOPT=P      ! draw Projecting tick marks
C   PGPLOT_ENVOPT=I      ! Invert the tick marks
C   PGPLOT_ENVOPT=IV     ! Invert tick marks and label y Vertically
C--
C  1-May-1983
C 25-Sep-1985 [TJP] - change to use PGWNAD.
C 23-Nov-1985 [TJP] - add PGPLOT_ENVOPT option.
C 31-Dec-1985 [TJP] - remove automatic PGBEG call.
C 29-Aug-1989 [TJP] - remove common block; no longer needed.
C-----------------------------------------------------------------------
      INTEGER      L
      LOGICAL      PGNOTO
      CHARACTER*10 XOPTS, YOPTS, ENVOPT, TEMP
C
      IF (PGNOTO('PGENV')) RETURN
C
C Start a new picture: move to a new panel or page as necessary.
C
      CALL PGPAGE
C
C Redefine the standard viewport.
C
      CALL PGVSTD
C
C If invalid arguments are specified, issue warning and leave window
C unchanged.
C
      IF (XMIN.EQ.XMAX) THEN
          CALL GRWARN('invalid x limits in PGENV: XMIN = XMAX.')
          RETURN
      ELSE IF (YMIN.EQ.YMAX) THEN
          CALL GRWARN('invalid y limits in PGENV: YMIN = YMAX.')
          RETURN
      END IF
C
C Call PGSWIN to define the window.
C If equal-scales requested, adjust viewport.
C
      IF (JUST.EQ.1) THEN
          CALL PGWNAD(XMIN,XMAX,YMIN,YMAX)
      ELSE
          CALL PGSWIN(XMIN,XMAX,YMIN,YMAX)
      END IF
C
C Call PGBOX to draw and label frame around viewport.
C
      YOPTS = '*'
      IF (AXIS.EQ.-2) THEN
          XOPTS = ' '
      ELSE IF (AXIS.EQ.-1) THEN
          XOPTS = 'BC'
      ELSE IF (AXIS.EQ.0) THEN
          XOPTS = 'BCNST'
      ELSE IF (AXIS.EQ.1) THEN
          XOPTS = 'ABCNST'
      ELSE IF (AXIS.EQ.2) THEN
          XOPTS = 'ABCGNST'
      ELSE IF (AXIS.EQ.10) THEN
          XOPTS = 'BCNSTL'
          YOPTS = 'BCNST'
      ELSE IF (AXIS.EQ.20) THEN
          XOPTS = 'BCNST'
          YOPTS = 'BCNSTL'
      ELSE IF (AXIS.EQ.30) THEN
          XOPTS = 'BCNSTL'
          YOPTS = 'BCNSTL'
      ELSE
          CALL GRWARN('PGENV: illegal AXIS argument.')
          XOPTS = 'BCNST'
      END IF
      IF (YOPTS.EQ.'*') YOPTS = XOPTS
C
C Additional PGBOX options from PGPLOT_ENVOPT.
C
      CALL GRGENV('ENVOPT', ENVOPT, L)
      IF (L.GT.0 .AND. AXIS.GE.0) THEN
          TEMP = XOPTS
          XOPTS = ENVOPT(1:L)//TEMP
          TEMP = YOPTS
          YOPTS = ENVOPT(1:L)//TEMP
      END IF
      CALL PGBOX(XOPTS, 0.0, 0, YOPTS, 0.0, 0)
C
      END
#<

#>            pgeras.dc2
Name:         PGERAS

Purpose:      erase all graphics from current page

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGERAS
      
       Erase all graphics from the current page (or current panel, if
       the view surface has been divided into panels with PGSUBP).
      
       Arguments: none

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgeras.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGERAS -- erase all graphics from current page
C%void cpgeras(void);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgeras(  )
*

C+
      SUBROUTINE PGERAS
C
C Erase all graphics from the current page (or current panel, if
C the view surface has been divided into panels with PGSUBP).
C
C Arguments: none
C--
C 24-Jun-1994
C-----------------------------------------------------------------------
      INTEGER CI, FS
      REAL XV1, XV2, YV1, YV2, XW1, XW2, YW1, YW2
      CALL PGBBUF
      CALL PGQCI(CI)
      CALL PGQFS(FS)
      CALL PGSCI(0)
      CALL PGSFS(1)
      CALL PGQWIN(XW1, XW2, YW1, YW2)
      CALL PGQVP(0, XV1, XV2, YV1, YV2)
      CALL PGSVP(0.0, 1.0, 0.0, 1.0)
      CALL PGRECT(XW1, XW2, YW1, YW2)
      CALL PGSVP(XV1, XV2, YV1, YV2)
      CALL PGSCI(CI)
      CALL PGSFS(FS)
      CALL PGEBUF
      END
#<

#>            pgerr1.dc2
Name:         PGERR1

Purpose:      horizontal or vertical error bar

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGERR1 (DIR, X, Y, E, T)
            INTEGER DIR
            REAL X, Y, E
            REAL T
      
       Plot a single error bar in the direction specified by DIR.
       This routine draws an error bar only; to mark the data point at
       the start of the error bar, an additional call to PGPT is required.
       To plot many error bars, use PGERRB.
      
       Arguments:
        DIR    (input)  : direction to plot the error bar relative to
                          the data point. 
                          One-sided error bar:
                            DIR is 1 for +X (X to X+E);
                                   2 for +Y (Y to Y+E);
                                   3 for -X (X to X-E);
                                   4 for -Y (Y to Y-E).
                          Two-sided error bar:
                            DIR is 5 for +/-X (X-E to X+E); 
                                   6 for +/-Y (Y-E to Y+E).
        X      (input)  : world x-coordinate of the data.
        Y      (input)  : world y-coordinate of the data.
        E      (input)  : value of error bar distance to be added to the
                          data position in world coordinates.
        T      (input)  : length of terminals to be drawn at the ends
                          of the error bar, as a multiple of the default
                          length; if T = 0.0, no terminals will be drawn.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgerr1.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGERR1 -- horizontal or vertical error bar
C%void cpgerr1(int dir, float x, float y, float e, float t);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgerr1( integer, real, real, real, real )
*

C+
      SUBROUTINE PGERR1 (DIR, X, Y, E, T)
      INTEGER DIR
      REAL X, Y, E
      REAL T
C
C Plot a single error bar in the direction specified by DIR.
C This routine draws an error bar only; to mark the data point at
C the start of the error bar, an additional call to PGPT is required.
C To plot many error bars, use PGERRB.
C
C Arguments:
C  DIR    (input)  : direction to plot the error bar relative to
C                    the data point. 
C                    One-sided error bar:
C                      DIR is 1 for +X (X to X+E);
C                             2 for +Y (Y to Y+E);
C                             3 for -X (X to X-E);
C                             4 for -Y (Y to Y-E).
C                    Two-sided error bar:
C                      DIR is 5 for +/-X (X-E to X+E); 
C                             6 for +/-Y (Y-E to Y+E).
C  X      (input)  : world x-coordinate of the data.
C  Y      (input)  : world y-coordinate of the data.
C  E      (input)  : value of error bar distance to be added to the
C                    data position in world coordinates.
C  T      (input)  : length of terminals to be drawn at the ends
C                    of the error bar, as a multiple of the default
C                    length; if T = 0.0, no terminals will be drawn.
C--
C 31-Mar-1997 - new routine [TJP].
C-----------------------------------------------------------------------
      LOGICAL  PGNOTO
      REAL     XTIK, YTIK, XX, YY
C
      IF (PGNOTO('PGERR1')) RETURN
      IF (DIR.LT.1 .OR. DIR.GT.6) RETURN
      CALL PGBBUF
C
C Determine terminal length.
C
      CALL PGTIKL(T, XTIK, YTIK)
C
C Draw terminal at starting point if required.
C
      IF (DIR.EQ.5) THEN
         XX = X-E
         YY = Y
      ELSE IF (DIR.EQ.6) THEN
         XX = X
         YY = Y-E
      ELSE
         XX = X
         YY = Y
      END IF
      IF (T.NE.0.0) THEN
         IF (DIR.EQ.5) THEN
            CALL GRMOVA(XX,YY-YTIK)
            CALL GRLINA(XX,YY+YTIK)
         ELSE IF (DIR.EQ.6) THEN
            CALL GRMOVA(XX-XTIK,YY)
            CALL GRLINA(XX+XTIK,YY)
         END IF
      END IF
C
C Draw the error bar itself.
C
      CALL GRMOVA(XX,YY)
      IF (DIR.EQ.1 .OR. DIR.EQ.5) THEN
         XX = X+E
         YY = Y
      ELSE IF (DIR.EQ.2 .OR. DIR.EQ.6) THEN
         XX = X
         YY = Y+E
      ELSE IF (DIR.EQ.3) THEN
         XX = X-E
         YY = Y
      ELSE IF (DIR.EQ.4) THEN
         XX = X
         YY = Y-E
      END IF
      CALL GRLINA(XX,YY)
C
C Draw terminal at end point.
C
      IF (T.NE.0.0) THEN
         IF (MOD(DIR,2).EQ.1) THEN
            CALL GRMOVA(XX,YY-YTIK)
            CALL GRLINA(XX,YY+YTIK)
         ELSE
            CALL GRMOVA(XX-XTIK,YY)
            CALL GRLINA(XX+XTIK,YY)
         END IF
      END IF
C
      CALL PGEBUF
      END
#<

#>            pgerrb.dc2
Name:         PGERRB

Purpose:      horizontal or vertical error bar

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGERRB (DIR, N, X, Y, E, T)
            INTEGER DIR, N
            REAL X(*), Y(*), E(*)
            REAL T
      
       Plot error bars in the direction specified by DIR.
       This routine draws an error bar only; to mark the data point at
       the start of the error bar, an additional call to PGPT is required.
      
       Arguments:
        DIR    (input)  : direction to plot the error bar relative to
                          the data point. 
                          One-sided error bar:
                            DIR is 1 for +X (X to X+E);
                                   2 for +Y (Y to Y+E);
                                   3 for -X (X to X-E);
                                   4 for -Y (Y to Y-E).
                          Two-sided error bar:
                            DIR is 5 for +/-X (X-E to X+E); 
                                   6 for +/-Y (Y-E to Y+E).
        N      (input)  : number of error bars to plot.
        X      (input)  : world x-coordinates of the data.
        Y      (input)  : world y-coordinates of the data.
        E      (input)  : value of error bar distance to be added to the
                          data position in world coordinates.
        T      (input)  : length of terminals to be drawn at the ends
                          of the error bar, as a multiple of the default
                          length; if T = 0.0, no terminals will be drawn.
      
       Note: the dimension of arrays X, Y, and E must be greater
       than or equal to N. If N is 1, X, Y, and E may be scalar
       variables, or expressions.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgerrb.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGERRB -- horizontal or vertical error bar
C%void cpgerrb(int dir, int n, const float *x, const float *y, \
C% const float *e, float t);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgerrb( integer, integer, real, real, real, real )
*

C+
      SUBROUTINE PGERRB (DIR, N, X, Y, E, T)
      INTEGER DIR, N
      REAL X(*), Y(*), E(*)
      REAL T
C
C Plot error bars in the direction specified by DIR.
C This routine draws an error bar only; to mark the data point at
C the start of the error bar, an additional call to PGPT is required.
C
C Arguments:
C  DIR    (input)  : direction to plot the error bar relative to
C                    the data point. 
C                    One-sided error bar:
C                      DIR is 1 for +X (X to X+E);
C                             2 for +Y (Y to Y+E);
C                             3 for -X (X to X-E);
C                             4 for -Y (Y to Y-E).
C                    Two-sided error bar:
C                      DIR is 5 for +/-X (X-E to X+E); 
C                             6 for +/-Y (Y-E to Y+E).
C  N      (input)  : number of error bars to plot.
C  X      (input)  : world x-coordinates of the data.
C  Y      (input)  : world y-coordinates of the data.
C  E      (input)  : value of error bar distance to be added to the
C                    data position in world coordinates.
C  T      (input)  : length of terminals to be drawn at the ends
C                    of the error bar, as a multiple of the default
C                    length; if T = 0.0, no terminals will be drawn.
C
C Note: the dimension of arrays X, Y, and E must be greater
C than or equal to N. If N is 1, X, Y, and E may be scalar
C variables, or expressions.
C--
C  1-Mar-1991 - new routine [JM].
C 20-Apr-1992 - correct bug [ALF, TJP].
C 28-Mar-1995 - add options DIR = 5 or 6 [TJP].
C 31-Mar-1997 - use pgtikl [TJP].
C-----------------------------------------------------------------------
      INTEGER  I
      LOGICAL  PGNOTO
      REAL     XTIK, YTIK, XX, YY
C
      IF (PGNOTO('PGERRB')) RETURN
      IF (N.LT.1) RETURN
      IF (DIR.LT.1 .OR. DIR.GT.6) RETURN
      CALL PGBBUF
C
C Determine terminal length.
C
      CALL PGTIKL(T, XTIK, YTIK)
C
C Loop through points.
C
      DO 10 I=1,N
C
C Draw terminal at starting point if required.
C
         IF (DIR.EQ.5) THEN
            XX = X(I)-E(I)
            YY = Y(I)
         ELSE IF (DIR.EQ.6) THEN
            XX = X(I)
            YY = Y(I)-E(I)
         ELSE
            XX = X(I)
            YY = Y(I)
         END IF
         IF (T.NE.0.0) THEN
            IF (DIR.EQ.5) THEN
               CALL GRMOVA(XX,YY-YTIK)
               CALL GRLINA(XX,YY+YTIK)
            ELSE IF (DIR.EQ.6) THEN
               CALL GRMOVA(XX-XTIK,YY)
               CALL GRLINA(XX+XTIK,YY)
            END IF
         END IF
C
C Draw the error bar itself.
C
         CALL GRMOVA(XX,YY)
         IF (DIR.EQ.1 .OR. DIR.EQ.5) THEN
            XX = X(I)+E(I)
            YY = Y(I)
         ELSE IF (DIR.EQ.2 .OR. DIR.EQ.6) THEN
            XX = X(I)
            YY = Y(I)+E(I)
         ELSE IF (DIR.EQ.3) THEN
            XX = X(I)-E(I)
            YY = Y(I)
         ELSE IF (DIR.EQ.4) THEN
            XX = X(I)
            YY = Y(I)-E(I)
         END IF
         CALL GRLINA(XX,YY)
C
C Draw terminal at end point.
C
         IF (T.NE.0.0) THEN
            IF (MOD(DIR,2).EQ.1) THEN
               CALL GRMOVA(XX,YY-YTIK)
               CALL GRLINA(XX,YY+YTIK)
            ELSE
               CALL GRMOVA(XX-XTIK,YY)
               CALL GRLINA(XX+XTIK,YY)
            END IF
         END IF
C
 10   CONTINUE
      CALL PGEBUF
      END
#<

#>            pgerrx.dc2
Name:         PGERRX

Purpose:      horizontal error bar

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGERRX (N, X1, X2, Y, T)
            INTEGER N
            REAL X1(*), X2(*), Y(*)
            REAL T
      
       Plot horizontal error bars.
       This routine draws an error bar only; to mark the data point in
       the middle of the error bar, an additional call to PGPT or
       PGERRY is required.
      
       Arguments:
        N      (input)  : number of error bars to plot.
        X1     (input)  : world x-coordinates of lower end of the
                          error bars.
        X2     (input)  : world x-coordinates of upper end of the
                          error bars.
        Y      (input)  : world y-coordinates of the data.
        T      (input)  : length of terminals to be drawn at the ends
                          of the error bar, as a multiple of the default
                          length; if T = 0.0, no terminals will be drawn.
      
       Note: the dimension of arrays X1, X2, and Y must be greater
       than or equal to N. If N is 1, X1, X2, and Y may be scalar
       variables, or expressions, eg:
             CALL PGERRX(1,X-SIGMA,X+SIGMA,Y)

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgerrx.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGERRX -- horizontal error bar
C%void cpgerrx(int n, const float *x1, const float *x2, \
C% const float *y, float t);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgerrx( integer, real, real, real, real )
*

C+
      SUBROUTINE PGERRX (N, X1, X2, Y, T)
      INTEGER N
      REAL X1(*), X2(*), Y(*)
      REAL T
C
C Plot horizontal error bars.
C This routine draws an error bar only; to mark the data point in
C the middle of the error bar, an additional call to PGPT or
C PGERRY is required.
C
C Arguments:
C  N      (input)  : number of error bars to plot.
C  X1     (input)  : world x-coordinates of lower end of the
C                    error bars.
C  X2     (input)  : world x-coordinates of upper end of the
C                    error bars.
C  Y      (input)  : world y-coordinates of the data.
C  T      (input)  : length of terminals to be drawn at the ends
C                    of the error bar, as a multiple of the default
C                    length; if T = 0.0, no terminals will be drawn.
C
C Note: the dimension of arrays X1, X2, and Y must be greater
C than or equal to N. If N is 1, X1, X2, and Y may be scalar
C variables, or expressions, eg:
C       CALL PGERRX(1,X-SIGMA,X+SIGMA,Y)
C--
C (6-Oct-1983)
C 31-Mar-1997 - use pgtikl [TJP[.
C-----------------------------------------------------------------------
      INTEGER  I
      LOGICAL  PGNOTO
      REAL     XTIK, YTIK
C
      IF (PGNOTO('PGERRX')) RETURN
      IF (N.LT.1) RETURN
      CALL PGBBUF
C
      CALL PGTIKL(T, XTIK, YTIK)
      DO 10 I=1,N
          IF (T.NE.0.0) THEN
              CALL GRMOVA(X1(I),Y(I)-YTIK)
              CALL GRLINA(X1(I),Y(I)+YTIK)
          END IF
          CALL GRMOVA(X1(I),Y(I))
          CALL GRLINA(X2(I),Y(I))
          IF (T.NE.0.0) THEN
              CALL GRMOVA(X2(I),Y(I)-YTIK)
              CALL GRLINA(X2(I),Y(I)+YTIK)
          END IF
   10 CONTINUE
      CALL PGEBUF
      END
#<

#>            pgerry.dc2
Name:         PGERRY

Purpose:      vertical error bar

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGERRY (N, X, Y1, Y2, T)
            INTEGER N
            REAL X(*), Y1(*), Y2(*)
            REAL T
      
       Plot vertical error bars.
       This routine draws an error bar only; to mark the data point in
       the middle of the error bar, an additional call to PGPT or
       PGERRX is required.
      
       Arguments:
        N      (input)  : number of error bars to plot.
        X      (input)  : world x-coordinates of the data.
        Y1     (input)  : world y-coordinates of top end of the
                          error bars.
        Y2     (input)  : world y-coordinates of bottom end of the
                          error bars.
        T      (input)  : length of terminals to be drawn at the ends
                          of the error bar, as a multiple of the default
                          length; if T = 0.0, no terminals will be drawn.
      
       Note: the dimension of arrays X, Y1, and Y2 must be greater
       than or equal to N. If N is 1, X, Y1, and Y2 may be scalar
       variables or expressions, eg:
             CALL PGERRY(1,X,Y+SIGMA,Y-SIGMA)

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgerry.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGERRY -- vertical error bar
C%void cpgerry(int n, const float *x, const float *y1, \
C% const float *y2, float t);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgerry( integer, real, real, real, real )
*

C+
      SUBROUTINE PGERRY (N, X, Y1, Y2, T)
      INTEGER N
      REAL X(*), Y1(*), Y2(*)
      REAL T
C
C Plot vertical error bars.
C This routine draws an error bar only; to mark the data point in
C the middle of the error bar, an additional call to PGPT or
C PGERRX is required.
C
C Arguments:
C  N      (input)  : number of error bars to plot.
C  X      (input)  : world x-coordinates of the data.
C  Y1     (input)  : world y-coordinates of top end of the
C                    error bars.
C  Y2     (input)  : world y-coordinates of bottom end of the
C                    error bars.
C  T      (input)  : length of terminals to be drawn at the ends
C                    of the error bar, as a multiple of the default
C                    length; if T = 0.0, no terminals will be drawn.
C
C Note: the dimension of arrays X, Y1, and Y2 must be greater
C than or equal to N. If N is 1, X, Y1, and Y2 may be scalar
C variables or expressions, eg:
C       CALL PGERRY(1,X,Y+SIGMA,Y-SIGMA)
C--
C (6-Oct-1983)
C 31-Mar-1997 - use pgtikl [TJP].
C-----------------------------------------------------------------------
      INTEGER  I
      LOGICAL  PGNOTO
      REAL     XTIK, YTIK
C
      IF (PGNOTO('PGERRY')) RETURN
      IF (N.LT.1) RETURN
      CALL PGBBUF
C
      CALL PGTIKL(T, XTIK, YTIK)
      DO 10 I=1,N
          IF (T.NE.0.0) THEN
              CALL GRMOVA(X(I)-XTIK,Y1(I))
              CALL GRLINA(X(I)+XTIK,Y1(I))
          END IF
          CALL GRMOVA(X(I),Y1(I))
          CALL GRLINA(X(I),Y2(I))
          IF (T.NE.0.0) THEN
              CALL GRMOVA(X(I)-XTIK,Y2(I))
              CALL GRLINA(X(I)+XTIK,Y2(I))
          END IF
   10 CONTINUE
      CALL PGEBUF
      END
#<

#>            pgetxt.dc2
Name:         PGETXT

Purpose:      erase text from graphics display

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGETXT
      
       Some graphics terminals display text (the normal interactive dialog)
       on the same screen as graphics. This routine erases the text from the
       view surface without affecting the graphics. It does nothing on
       devices which do not display text on the graphics screen, and on
       devices which do not have this capability.
      
       Arguments:
        None

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgetxt.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGETXT -- erase text from graphics display
C%void cpgetxt(void);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgetxt(  )
*

C+
      SUBROUTINE PGETXT
C
C Some graphics terminals display text (the normal interactive dialog)
C on the same screen as graphics. This routine erases the text from the
C view surface without affecting the graphics. It does nothing on
C devices which do not display text on the graphics screen, and on
C devices which do not have this capability.
C
C Arguments:
C  None
C--
C 18-Feb-1988
C-----------------------------------------------------------------------
      CALL GRETXT
      END
#<

#>            pgexist.dc2
Function:     PGEXIST

Purpose:      Test whether a Hershey symbol, with index between
              1..3000, exists

Category:     GRAPHICS

File:         pgplot.src

Author:       M.G.R. Vogelaar

Use:          INTEGER PGEXIST( N )         Input      INTEGER

Description:  PGPLOT uses Hershey symbols for two `primitive' operations:
              graph markers and text.  The Hershey symbol set includes 
              several hundred different symbols in a digitized form that 
              allows them to be drawn with a series of vectors (polylines).
              The routine PGEXIST has an integer argument between 1 and
              3000. It returns 1 if the symbol exists and 0 if it does
              not exist.

Updates:      Dec 23, 1994: VOG Document created.
              Oct 12, 2001: JPT Fixed common block layout.
#<

#>            pgexist.f
* GIPSY-private
*

C pgexist.f
C
C       Copyright (c) Kapteyn Laboratorium Groningen 1994
C       All Rights Reserved.
C
C
C  Fortran to C interface:
C@ integer function pgexist( integer )
C
C
C  PGPLOT uses the Hershey symbols for two `primitive' operations:
C  graph markers and text.  The Hershey symbol set includes several
C  hundred different symbols in a digitized form that allows them to
C  be drawn with a series of vectors (polylines).
C  INDEX is an integer array of 3000 elements. Not all symbols 
C  1...3000 have a representation; if INDEX(N) = 0, the symbol is 
C  undefined.
C
C
C  The digital representation of all the symbols is stored in common
C  block /GRSYMB/
C-----------------------------------------------------------------------
      INTEGER  FUNCTION PGEXIST( N )
      INTEGER*2  BUFFER(27000)
      INTEGER  N, INDEX(3000), NC1, NC2
      COMMON   /GRSYMB/ NC1, NC2, INDEX, BUFFER

      INCLUDE 'grpckg1.inc'

      IF ((N.LT.1) .OR. (N.GT.3000)) THEN
         PGEXIST = 0
      ELSE
         PGEXIST = INDEX( N )
      END IF
      RETURN
      END
#<

#>            pgfunt.dc2
Name:         PGFUNT

Purpose:      function defined by X = F(T), Y = G(T)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGFUNT (FX, FY, N, TMIN, TMAX, PGFLAG)
            REAL FX, FY
            EXTERNAL FX, FY
            INTEGER N
            REAL TMIN, TMAX
            INTEGER PGFLAG
      
       Draw a curve defined by parametric equations X = FX(T), Y = FY(T).
      
       Arguments:
        FX     (external real function): supplied by the user, evaluates
                          X-coordinate.
        FY     (external real function): supplied by the user, evaluates
                          Y-coordinate.
        N      (input)  : the number of points required to define the
                          curve. The functions FX and FY will each be
                          called N+1 times.
        TMIN   (input)  : the minimum value for the parameter T.
        TMAX   (input)  : the maximum value for the parameter T.
        PGFLAG (input)  : if PGFLAG = 1, the curve is plotted in the
                          current window and viewport; if PGFLAG = 0,
                          PGENV is called automatically by PGFUNT to
                          start a new plot with automatic scaling.
      
       Note: The functions FX and FY must be declared EXTERNAL in the
       Fortran program unit that calls PGFUNT.

Note:         This subroutine is only callable from Fortran, not from C.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgfunt.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGFUNT -- function defined by X = F(T), Y = G(T)
C+
      SUBROUTINE PGFUNT (FX, FY, N, TMIN, TMAX, PGFLAG)
      REAL FX, FY
      EXTERNAL FX, FY
      INTEGER N
      REAL TMIN, TMAX
      INTEGER PGFLAG
C
C Draw a curve defined by parametric equations X = FX(T), Y = FY(T).
C
C Arguments:
C  FX     (external real function): supplied by the user, evaluates
C                    X-coordinate.
C  FY     (external real function): supplied by the user, evaluates
C                    Y-coordinate.
C  N      (input)  : the number of points required to define the
C                    curve. The functions FX and FY will each be
C                    called N+1 times.
C  TMIN   (input)  : the minimum value for the parameter T.
C  TMAX   (input)  : the maximum value for the parameter T.
C  PGFLAG (input)  : if PGFLAG = 1, the curve is plotted in the
C                    current window and viewport; if PGFLAG = 0,
C                    PGENV is called automatically by PGFUNT to
C                    start a new plot with automatic scaling.
C
C Note: The functions FX and FY must be declared EXTERNAL in the
C Fortran program unit that calls PGFUNT.
C--
C  5-Oct-1983
C 11-May-1990 - remove unnecessary include [TJP].
C 13-Dec-1990 - make errors non-fatal [TJP].
C-----------------------------------------------------------------------
      INTEGER MAXP
      PARAMETER (MAXP=1000)
      INTEGER  I
      REAL     X(0:MAXP), Y(0:MAXP), DT
      REAL     XMIN, XMAX, YMIN, YMAX
C
      IF (N.LT.1 .OR. N.GT.MAXP) THEN
          CALL GRWARN('PGFUNT: invalid arguments')
          RETURN
      END IF
      CALL PGBBUF
C
C Evaluate function.
C
      DT = (TMAX-TMIN)/N
      X(0) = FX(TMIN)
      Y(0) = FY(TMIN)
      XMIN = X(0)
      XMAX = X(0)
      YMIN = Y(0)
      YMAX = Y(0)
      DO 10 I=1,N
          X(I) = FX(TMIN+DT*I)
          Y(I) = FY(TMIN+DT*I)
          XMIN = MIN(XMIN,X(I))
          XMAX = MAX(XMAX,X(I))
          YMIN = MIN(YMIN,Y(I))
          YMAX = MAX(YMAX,Y(I))
   10 CONTINUE
      DT = 0.05*(XMAX-XMIN)
      IF (DT.EQ.0.0) THEN
          XMIN = XMIN - 1.0
          XMAX = XMAX + 1.0
      ELSE
          XMIN = XMIN - DT
          XMAX = XMAX + DT
      END IF
      DT = 0.05*(YMAX-YMIN)
      IF (DT.EQ.0.0) THEN
          YMIN = YMIN - 1.0
          YMAX = YMAX + 1.0
      ELSE
          YMIN = YMIN - DT
          YMAX = YMAX + DT
      END IF
C
C Define environment if necessary.
C
      IF (PGFLAG.EQ.0) CALL PGENV(XMIN,XMAX,YMIN,YMAX,0,0)
C
C Draw curve.
C
      CALL PGMOVE(X(0),Y(0))
      DO 20 I=1,N
          CALL PGDRAW(X(I),Y(I))
   20 CONTINUE
C
      CALL PGEBUF
      END
#<

#>            pgfunx.dc2
Name:         PGFUNX

Purpose:      function defined by Y = F(X)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGFUNX (FY, N, XMIN, XMAX, PGFLAG)
            REAL FY
            EXTERNAL FY
            INTEGER N
            REAL XMIN, XMAX
            INTEGER PGFLAG
      
       Draw a curve defined by the equation Y = FY(X), where FY is a
       user-supplied subroutine.
      
       Arguments:
        FY     (external real function): supplied by the user, evaluates
                          Y value at a given X-coordinate.
        N      (input)  : the number of points required to define the
                          curve. The function FY will be called N+1 times.
                          If PGFLAG=0 and N is greater than 1000, 1000
                          will be used instead.  If N is less than 1,
                          nothing will be drawn.
        XMIN   (input)  : the minimum value of X.
        XMAX   (input)  : the maximum value of X.
        PGFLAG (input)  : if PGFLAG = 1, the curve is plotted in the
                          current window and viewport; if PGFLAG = 0,
                          PGENV is called automatically by PGFUNX to
                          start a new plot with X limits (XMIN, XMAX)
                          and automatic scaling in Y.
      
       Note: The function FY must be declared EXTERNAL in the Fortran
       program unit that calls PGFUNX.  It has one argument, the
       x-coordinate at which the y value is required, e.g.
         REAL FUNCTION FY(X)
         REAL X
         FY = .....
         END

Note:         This subroutine is only callable from Fortran, not from C.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgfunx.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGFUNX -- function defined by Y = F(X)
C+
      SUBROUTINE PGFUNX (FY, N, XMIN, XMAX, PGFLAG)
      REAL FY
      EXTERNAL FY
      INTEGER N
      REAL XMIN, XMAX
      INTEGER PGFLAG
C
C Draw a curve defined by the equation Y = FY(X), where FY is a
C user-supplied subroutine.
C
C Arguments:
C  FY     (external real function): supplied by the user, evaluates
C                    Y value at a given X-coordinate.
C  N      (input)  : the number of points required to define the
C                    curve. The function FY will be called N+1 times.
C                    If PGFLAG=0 and N is greater than 1000, 1000
C                    will be used instead.  If N is less than 1,
C                    nothing will be drawn.
C  XMIN   (input)  : the minimum value of X.
C  XMAX   (input)  : the maximum value of X.
C  PGFLAG (input)  : if PGFLAG = 1, the curve is plotted in the
C                    current window and viewport; if PGFLAG = 0,
C                    PGENV is called automatically by PGFUNX to
C                    start a new plot with X limits (XMIN, XMAX)
C                    and automatic scaling in Y.
C
C Note: The function FY must be declared EXTERNAL in the Fortran
C program unit that calls PGFUNX.  It has one argument, the
C x-coordinate at which the y value is required, e.g.
C   REAL FUNCTION FY(X)
C   REAL X
C   FY = .....
C   END
C--
C  6-Oct-1983 - TJP.
C  6-May-1985 - fix Y(0) bug - TJP.
C 11-May-1990 - remove unnecessary include - TJP.
C-----------------------------------------------------------------------
      INTEGER MAXP
      PARAMETER (MAXP=1000)
      INTEGER  I, NN
      REAL     Y(0:MAXP), DT, DY
      REAL     YMIN, YMAX
C
C Check N > 1, and find parameter increment.
C
      IF (N.LT.1) RETURN
      DT = (XMAX-XMIN)/N
      CALL PGBBUF
C
C Case 1: we do not have to find limits.
C
      IF (PGFLAG.NE.0) THEN
          CALL PGMOVE(XMIN,FY(XMIN))
          DO 10 I=1,N
              CALL PGDRAW(XMIN+I*DT,FY(XMIN+I*DT))
   10     CONTINUE
C
C Case 2: find limits and scale plot; function values must be stored
C in an array.
C
      ELSE
          NN = MIN(N,MAXP)
          Y(0) = FY(XMIN)
          YMIN = Y(0)
          YMAX = Y(0)
          DO 20 I=1,NN
              Y(I) = FY(XMIN+DT*I)
              YMIN = MIN(YMIN,Y(I))
              YMAX = MAX(YMAX,Y(I))
   20     CONTINUE
          DY = 0.05*(YMAX-YMIN)
          IF (DY.EQ.0.0) THEN
              YMIN = YMIN - 1.0
              YMAX = YMAX + 1.0
          ELSE
              YMIN = YMIN - DY
              YMAX = YMAX + DY
          END IF
          CALL PGENV(XMIN,XMAX,YMIN,YMAX,0,0)
          CALL PGMOVE(XMIN,Y(0))
          DO 30 I=1,NN
              CALL PGDRAW(XMIN+DT*I,Y(I))
   30     CONTINUE
      END IF
C
      CALL PGEBUF
      END
#<

#>            pgfuny.dc2
Name:         PGFUNY

Purpose:      function defined by X = F(Y)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGFUNY (FX, N, YMIN, YMAX, PGFLAG)
            REAL    FX
            EXTERNAL FX
            INTEGER N
            REAL    YMIN, YMAX
            INTEGER PGFLAG
      
       Draw a curve defined by the equation X = FX(Y), where FY is a
       user-supplied subroutine.
      
       Arguments:
        FX     (external real function): supplied by the user, evaluates
                          X value at a given Y-coordinate.
        N      (input)  : the number of points required to define the
                          curve. The function FX will be called N+1 times.
                          If PGFLAG=0 and N is greater than 1000, 1000
                          will be used instead.  If N is less than 1,
                          nothing will be drawn.
        YMIN   (input)  : the minimum value of Y.
        YMAX   (input)  : the maximum value of Y.
        PGFLAG (input)  : if PGFLAG = 1, the curve is plotted in the
                          current window and viewport; if PGFLAG = 0,
                          PGENV is called automatically by PGFUNY to
                          start a new plot with Y limits (YMIN, YMAX)
                          and automatic scaling in X.
      
       Note: The function FX must be declared EXTERNAL in the Fortran
       program unit that calls PGFUNY.  It has one argument, the
       y-coordinate at which the x value is required, e.g.
         REAL FUNCTION FX(Y)
         REAL Y
         FX = .....
         END

Note:         This subroutine is only callable from Fortran, not from C.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgfuny.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGFUNY -- function defined by X = F(Y)
C+
      SUBROUTINE PGFUNY (FX, N, YMIN, YMAX, PGFLAG)
      REAL    FX
      EXTERNAL FX
      INTEGER N
      REAL    YMIN, YMAX
      INTEGER PGFLAG
C
C Draw a curve defined by the equation X = FX(Y), where FY is a
C user-supplied subroutine.
C
C Arguments:
C  FX     (external real function): supplied by the user, evaluates
C                    X value at a given Y-coordinate.
C  N      (input)  : the number of points required to define the
C                    curve. The function FX will be called N+1 times.
C                    If PGFLAG=0 and N is greater than 1000, 1000
C                    will be used instead.  If N is less than 1,
C                    nothing will be drawn.
C  YMIN   (input)  : the minimum value of Y.
C  YMAX   (input)  : the maximum value of Y.
C  PGFLAG (input)  : if PGFLAG = 1, the curve is plotted in the
C                    current window and viewport; if PGFLAG = 0,
C                    PGENV is called automatically by PGFUNY to
C                    start a new plot with Y limits (YMIN, YMAX)
C                    and automatic scaling in X.
C
C Note: The function FX must be declared EXTERNAL in the Fortran
C program unit that calls PGFUNY.  It has one argument, the
C y-coordinate at which the x value is required, e.g.
C   REAL FUNCTION FX(Y)
C   REAL Y
C   FX = .....
C   END
C--
C  5-Oct-1983
C 11-May-1990 - remove unnecessary include [TJP].
C 13-DEc-1990 - make errors non-fatal [TJP].
C-----------------------------------------------------------------------
      INTEGER MAXP
      PARAMETER (MAXP=1000)
      INTEGER  I
      REAL     X(0:MAXP), Y(0:MAXP), DT
      REAL     XMIN, XMAX
C
      IF (N.LT.1 .OR. N.GT.MAXP) THEN
          CALL GRWARN('PGFUNY: invalid arguments')
          RETURN
      END IF
      CALL PGBBUF
C
C Evaluate function.
C
      DT = (YMAX-YMIN)/N
      X(0) = FX(YMIN)
      Y(0) = YMIN
      XMIN = X(0)
      XMAX = X(0)
      DO 10 I=1,N
          X(I) = FX(YMIN+DT*I)
          Y(I) = YMIN + DT*I
          XMIN = MIN(XMIN,X(I))
          XMAX = MAX(XMAX,X(I))
   10 CONTINUE
      DT = 0.05*(XMAX-XMIN)
      IF (DT.EQ.0.0) THEN
          XMIN = XMIN - 1.0
          XMAX = XMAX + 1.0
      ELSE
          XMIN = XMIN - DT
          XMAX = XMAX + DT
      END IF
C
C Define environment if necessary.
C
      IF (PGFLAG.EQ.0) CALL PGENV(XMIN,XMAX,YMIN,YMAX,0,0)
C
C Draw curve.
C
      CALL PGMOVE(X(0),Y(0))
      DO 20 I=1,N
          CALL PGDRAW(X(I),Y(I))
   20 CONTINUE
C
      CALL PGEBUF
      END
#<

#>            pggray.dc2
Name:         PGGRAY

Purpose:      gray-scale map of a 2D data array

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGGRAY (A, IDIM, JDIM, I1, I2, J1, J2,
           1                   FG, BG, TR)
            INTEGER IDIM, JDIM, I1, I2, J1, J2
            REAL    A(IDIM,JDIM), FG, BG, TR(6)
      
       Draw gray-scale map of an array in current window. The subsection
       of the array A defined by indices (I1:I2, J1:J2) is mapped onto
       the view surface world-coordinate system by the transformation
       matrix TR. The resulting quadrilateral region is clipped at the edge
       of the window and shaded with the shade at each point determined
       by the corresponding array value.  The shade is a number in the
       range 0 to 1 obtained by linear interpolation between the background
       level (BG) and the foreground level (FG), i.e.,
      
         shade = [A(i,j) - BG] / [FG - BG]
      
       The background level BG can be either less than or greater than the
       foreground level FG.  Points in the array that are outside the range
       BG to FG are assigned shade 0 or 1 as appropriate.
      
       PGGRAY uses two different algorithms, depending how many color
       indices are available in the color index range specified for images.
       (This range is set with routine PGSCIR, and the current or default
       range can be queried by calling routine PGQCIR).
      
       If 16 or more color indices are available, PGGRAY first assigns
       color representations to these color indices to give a linear ramp
       between the background color (color index 0) and the foreground color
       (color index 1), and then calls PGIMAG to draw the image using these
       color indices. In this mode, the shaded region is "opaque": every
       pixel is assigned a color.
      
       If less than 16 color indices are available, PGGRAY uses only
       color index 1, and uses  a "dithering" algorithm to fill in pixels,
       with the shade (computed as above) determining the faction of pixels
       that are filled. In this mode the shaded region is "transparent" and
       allows previously-drawn graphics to show through.
      
       The transformation matrix TR is used to calculate the world
       coordinates of the center of the "cell" that represents each
       array element. The world coordinates of the center of the cell
       corresponding to array element A(I,J) are given by:
      
                X = TR(1) + TR(2)*I + TR(3)*J
                Y = TR(4) + TR(5)*I + TR(6)*J
      
       Usually TR(3) and TR(5) are zero -- unless the coordinate
       transformation involves a rotation or shear.  The corners of the
       quadrilateral region that is shaded by PGGRAY are given by
       applying this transformation to (I1-0.5,J1-0.5), (I2+0.5, J2+0.5).
      
       Arguments:
        A      (input)  : the array to be plotted.
        IDIM   (input)  : the first dimension of array A.
        JDIM   (input)  : the second dimension of array A.
        I1, I2 (input)  : the inclusive range of the first index
                          (I) to be plotted.
        J1, J2 (input)  : the inclusive range of the second
                          index (J) to be plotted.
        FG     (input)  : the array value which is to appear with the
                          foreground color (corresponding to color index 1).
        BG     (input)  : the array value which is to appear with the
                          background color (corresponding to color index 0).
        TR     (input)  : transformation matrix between array grid and
                          world coordinates.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pggray.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGGRAY -- gray-scale map of a 2D data array
C%void cpggray(const float *a, int idim, int jdim, int i1, int i2, \
C% int j1, int j2, float fg, float bg, const float *tr);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pggray( real, integer, integer, integer, integer, integer, integer, real, real, real )
*

C+
      SUBROUTINE PGGRAY (A, IDIM, JDIM, I1, I2, J1, J2,
     1                   FG, BG, TR)
      INTEGER IDIM, JDIM, I1, I2, J1, J2
      REAL    A(IDIM,JDIM), FG, BG, TR(6)
C
C Draw gray-scale map of an array in current window. The subsection
C of the array A defined by indices (I1:I2, J1:J2) is mapped onto
C the view surface world-coordinate system by the transformation
C matrix TR. The resulting quadrilateral region is clipped at the edge
C of the window and shaded with the shade at each point determined
C by the corresponding array value.  The shade is a number in the
C range 0 to 1 obtained by linear interpolation between the background
C level (BG) and the foreground level (FG), i.e.,
C
C   shade = [A(i,j) - BG] / [FG - BG]
C
C The background level BG can be either less than or greater than the
C foreground level FG.  Points in the array that are outside the range
C BG to FG are assigned shade 0 or 1 as appropriate.
C
C PGGRAY uses two different algorithms, depending how many color
C indices are available in the color index range specified for images.
C (This range is set with routine PGSCIR, and the current or default
C range can be queried by calling routine PGQCIR).
C
C If 16 or more color indices are available, PGGRAY first assigns
C color representations to these color indices to give a linear ramp
C between the background color (color index 0) and the foreground color
C (color index 1), and then calls PGIMAG to draw the image using these
C color indices. In this mode, the shaded region is "opaque": every
C pixel is assigned a color.
C
C If less than 16 color indices are available, PGGRAY uses only
C color index 1, and uses  a "dithering" algorithm to fill in pixels,
C with the shade (computed as above) determining the faction of pixels
C that are filled. In this mode the shaded region is "transparent" and
C allows previously-drawn graphics to show through.
C
C The transformation matrix TR is used to calculate the world
C coordinates of the center of the "cell" that represents each
C array element. The world coordinates of the center of the cell
C corresponding to array element A(I,J) are given by:
C
C          X = TR(1) + TR(2)*I + TR(3)*J
C          Y = TR(4) + TR(5)*I + TR(6)*J
C
C Usually TR(3) and TR(5) are zero -- unless the coordinate
C transformation involves a rotation or shear.  The corners of the
C quadrilateral region that is shaded by PGGRAY are given by
C applying this transformation to (I1-0.5,J1-0.5), (I2+0.5, J2+0.5).
C
C Arguments:
C  A      (input)  : the array to be plotted.
C  IDIM   (input)  : the first dimension of array A.
C  JDIM   (input)  : the second dimension of array A.
C  I1, I2 (input)  : the inclusive range of the first index
C                    (I) to be plotted.
C  J1, J2 (input)  : the inclusive range of the second
C                    index (J) to be plotted.
C  FG     (input)  : the array value which is to appear with the
C                    foreground color (corresponding to color index 1).
C  BG     (input)  : the array value which is to appear with the
C                    background color (corresponding to color index 0).
C  TR     (input)  : transformation matrix between array grid and
C                    world coordinates.
C--
C  2-Sep-1987: remove device-dependent code to routine GRGRAY (TJP).
C  7-Jun-1988: change documentation and argument names (TJP).
C 31-May-1989: allow 1-pixel wide arrays to be plotted (TJP).
C 17-Mar-1994: pass PG scaling info to lower routines (TJP).
C 15-Sep-1994: use PGITF attribute (TJP).
C  8-Feb-1995: use color ramp based on current foreground and background
C              colors (TJP).
C  6-May-1996: allow multiple devives (TJP).
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
      REAL PA(6)
      LOGICAL PGNOTO
C
C Check inputs.
C
      IF (PGNOTO('PGGRAY')) RETURN
      IF (I1.LT.1 .OR. I2.GT.IDIM .OR. I1.GT.I2 .OR.
     1    J1.LT.1 .OR. J2.GT.JDIM .OR. J1.GT.J2) THEN
          CALL GRWARN('PGGRAY: invalid range I1:I2, J1:J2')
      ELSE IF (FG.EQ.BG) THEN
          CALL GRWARN('PGGRAY: foreground level = background level')
      ELSE
C
C Call lower-level routine to do the work.
C
          CALL PGBBUF
          CALL PGSAVE
          CALL PGSCI(1)
          PA(1) = TR(1)*PGXSCL(PGID) + PGXORG(PGID)
          PA(2) = TR(2)*PGXSCL(PGID)
          PA(3) = TR(3)*PGXSCL(PGID)
          PA(4) = TR(4)*PGYSCL(PGID) + PGYORG(PGID)
          PA(5) = TR(5)*PGYSCL(PGID)
          PA(6) = TR(6)*PGYSCL(PGID)
          CALL GRGRAY(A, IDIM, JDIM, I1, I2, J1, J2, FG, BG, PA,
     :                PGMNCI(PGID), PGMXCI(PGID), PGITF(PGID))
          CALL PGEBUF
          CALL PGUNSA
      END IF
C-----------------------------------------------------------------------
      END

#<

#>            pghi2d.dc2
Name:         PGHI2D

Purpose:      cross-sections through a 2D data array

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGHI2D (DATA, NXV, NYV, IX1, IX2, IY1, IY2, X, IOFF,
           1                   BIAS, CENTER, YLIMS)
            INTEGER NXV, NYV, IX1, IX2, IY1, IY2
            REAL    DATA(NXV,NYV)
            REAL    X(IX2-IX1+1), YLIMS(IX2-IX1+1)
            INTEGER IOFF
            REAL    BIAS
            LOGICAL CENTER
      
       Plot a series of cross-sections through a 2D data array.
       Each cross-section is plotted as a hidden line histogram.  The plot
       can be slanted to give a pseudo-3D effect - if this is done, the
       call to PGENV may have to be changed to allow for the increased X
       range that will be needed.
      
       Arguments:
        DATA   (input)  : the data array to be plotted.
        NXV    (input)  : the first dimension of DATA.
        NYV    (input)  : the second dimension of DATA.
        IX1    (input)
        IX2    (input)
        IY1    (input)
        IY2    (input)  : PGHI2D plots a subset of the input array DATA.
                          This subset is delimited in the first (x)
                          dimension by IX1 and IX2 and the 2nd (y) by IY1
                          and IY2, inclusively. Note: IY2 < IY1 is
                          permitted, resulting in a plot with the
                          cross-sections plotted in reverse Y order.
                          However, IX2 must be => IX1.
        X      (input)  : the abscissae of the bins to be plotted. That is,
                          X(1) should be the X value for DATA(IX1,IY1), and
                          X should have (IX2-IX1+1) elements.  The program
                          has to assume that the X value for DATA(x,y) is
                          the same for all y.
        IOFF   (input)  : an offset in array elements applied to successive
                          cross-sections to produce a slanted effect.  A
                          plot with IOFF > 0 slants to the right, one with
                          IOFF < 0 slants left.
        BIAS   (input)  : a bias value applied to each successive cross-
                          section in order to raise it above the previous
                          cross-section.  This is in the same units as the
                          data.
        CENTER (input)  : if .true., the X values denote the center of the
                          bins; if .false. the X values denote the lower
                          edges (in X) of the bins.
        YLIMS  (input)  : workspace.  Should be an array of at least
                          (IX2-IX1+1) elements.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pghi2d.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGHI2D -- cross-sections through a 2D data array
C%void cpghi2d(const float *data, int nxv, int nyv, int ix1, \
C% int ix2, int iy1, int iy2, const float *x, int ioff, float bias, \
C% Logical center, float *ylims);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pghi2d( real, integer, integer, integer, integer, integer, integer, real, integer, real, logical, real )
*

C+
      SUBROUTINE PGHI2D (DATA, NXV, NYV, IX1, IX2, IY1, IY2, X, IOFF,
     1                   BIAS, CENTER, YLIMS)
      INTEGER NXV, NYV, IX1, IX2, IY1, IY2
      REAL    DATA(NXV,NYV)
      REAL    X(IX2-IX1+1), YLIMS(IX2-IX1+1)
      INTEGER IOFF
      REAL    BIAS
      LOGICAL CENTER
C
C Plot a series of cross-sections through a 2D data array.
C Each cross-section is plotted as a hidden line histogram.  The plot
C can be slanted to give a pseudo-3D effect - if this is done, the
C call to PGENV may have to be changed to allow for the increased X
C range that will be needed.
C
C Arguments:
C  DATA   (input)  : the data array to be plotted.
C  NXV    (input)  : the first dimension of DATA.
C  NYV    (input)  : the second dimension of DATA.
C  IX1    (input)
C  IX2    (input)
C  IY1    (input)
C  IY2    (input)  : PGHI2D plots a subset of the input array DATA.
C                    This subset is delimited in the first (x)
C                    dimension by IX1 and IX2 and the 2nd (y) by IY1
C                    and IY2, inclusively. Note: IY2 < IY1 is
C                    permitted, resulting in a plot with the
C                    cross-sections plotted in reverse Y order.
C                    However, IX2 must be => IX1.
C  X      (input)  : the abscissae of the bins to be plotted. That is,
C                    X(1) should be the X value for DATA(IX1,IY1), and
C                    X should have (IX2-IX1+1) elements.  The program
C                    has to assume that the X value for DATA(x,y) is
C                    the same for all y.
C  IOFF   (input)  : an offset in array elements applied to successive
C                    cross-sections to produce a slanted effect.  A
C                    plot with IOFF > 0 slants to the right, one with
C                    IOFF < 0 slants left.
C  BIAS   (input)  : a bias value applied to each successive cross-
C                    section in order to raise it above the previous
C                    cross-section.  This is in the same units as the
C                    data.
C  CENTER (input)  : if .true., the X values denote the center of the
C                    bins; if .false. the X values denote the lower
C                    edges (in X) of the bins.
C  YLIMS  (input)  : workspace.  Should be an array of at least
C                    (IX2-IX1+1) elements.
C--
C 21-Feb-1984 - Keith Shortridge.
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      LOGICAL FIRST,PENDOW,HPLOT,VPLOT
      INTEGER IY,INC,IX,NELMX,IXPT,NOFF
      REAL CBIAS,YNWAS,XNWAS,YN,XN,VTO,VFROM,YLIMWS,YLIM
      REAL PGHIS1
      LOGICAL PGNOTO
C
C Check arguments.
C
      IF (IX1.GT.IX2) RETURN
      IF (PGNOTO('PGHI2D')) RETURN
      CALL PGBBUF
C
C Check Y order.
C
      IF (IY1.GT.IY2) THEN
         INC = -1
      ELSE
         INC = 1
      END IF
C
C Clear limits array.
C
      NELMX = IX2 - IX1 + 1
      DO 10 IX=1,NELMX
         YLIMS(IX) = PGYBLC(PGID)
 10   CONTINUE
C
C Loop through Y values.
C
      NOFF = 0
      CBIAS = 0.
      DO 200 IY=IY1,IY2,INC
         YNWAS = CBIAS
         YLIMWS = YNWAS
         XNWAS = PGHIS1(X,NELMX,CENTER,1+NOFF)
         PENDOW = .FALSE.
         FIRST = .TRUE.
         IXPT = 1
C
C Draw histogram for this Y value.
C
         DO 100 IX=IX1,IX2
            YN = DATA(IX,IY) + CBIAS
            XN = PGHIS1(X,NELMX,CENTER,IXPT+NOFF+1)
            YLIM = YLIMS(IXPT)
C
C Given X and Y old and new values, and limits, see which parts of the
C lines are to be drawn.
C
            IF (YN.GT.YLIM) THEN
               YLIMS(IXPT) = YN
               HPLOT = .TRUE.
               VPLOT = .TRUE.
               VTO = YN
               VFROM = YLIM
               IF (YNWAS.GT.YLIMWS) VFROM = YNWAS
            ELSE
               HPLOT = .FALSE.
               IF (YNWAS.GT.YLIMWS) THEN
                  VPLOT = .TRUE.
                  VFROM = YNWAS
                  VTO = YLIM
               ELSE
                  VPLOT = .FALSE.
               END IF
            END IF
C
C Plot the bin.
C
            IF (VPLOT) THEN
               IF (.NOT.PENDOW) THEN
                  IF (FIRST) THEN
                     CALL GRMOVA(XNWAS,MAX(VTO,CBIAS))
                     FIRST = .FALSE.
                  ELSE
                     CALL GRMOVA(XNWAS,VFROM)
                  END IF
               END IF
               CALL GRLINA(XNWAS,VTO)
               IF (HPLOT) THEN
                  CALL GRLINA(XN,YN)
               END IF
            END IF
            PENDOW = HPLOT
            YLIMWS = YLIM
            YNWAS = YN
            XNWAS = XN
            IXPT = IXPT + 1
 100     CONTINUE
         IF (PENDOW) CALL GRLINA(XN,MAX(YLIM,CBIAS))
C
C If any offset in operation, shift limits array to compensate for it.
C
         IF (IOFF.GT.0) THEN
            DO 110 IX=1,NELMX-IOFF
               YLIMS(IX) = YLIMS(IX+IOFF)
 110        CONTINUE
            DO 120 IX=NELMX-IOFF+1,NELMX
               YLIMS(IX) = PGYBLC(PGID)
 120        CONTINUE
         ELSE IF (IOFF.LT.0) THEN
            DO 130 IX=NELMX,1-IOFF,-1
               YLIMS(IX) = YLIMS(IX+IOFF)
 130        CONTINUE
            DO 140 IX=1,-IOFF
               YLIMS(IX) = PGYBLC(PGID)
 140        CONTINUE
         END IF
         CBIAS = CBIAS + BIAS
         NOFF = NOFF + IOFF
 200  CONTINUE
C
      CALL PGEBUF
      END
#<

#>            pghis1.dc3
Name:         pghis1

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Oct 16, 1998: JPT automatically generated.
#<

#>            pghis1.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

      REAL FUNCTION PGHIS1 (X, NELMX, CENTER, IXV)
      LOGICAL CENTER
      INTEGER NELMX, IXV
      REAL X(NELMX)
C
C PGPLOT Internal routine used by PGHI2D.  Calculates the X-value for
C the left hand edge of a given element of the array being plotted.
C
C Arguments -
C
C X (input, real array): abscissae of bins
C NELMX (input, integer): number of bins
C CENTER (Input, logical): if .true., X values denote the center of
C       the bin; if .false., the X values denote the lower edge (in X)
C       of the bin.
C IXV (input, integer): the bin number in question.  Note IXV may be
C       outside the range 1..NELMX, in which case an interpolated
C       value is returned.
C
C 21-Feb-1984 - Keith Shortridge.
C  6-Sep-1989 - Changes for standard Fortran-77 [TJP].
C-----------------------------------------------------------------------
      REAL XN
      INTRINSIC REAL
C
      IF (CENTER) THEN
          IF ((IXV.GT.1).AND.(IXV.LE.NELMX)) THEN
            XN = ( X(IXV-1) + X(IXV) ) * .5
          ELSE IF (IXV.LE.1) THEN
            XN = X(1) - .5 * (X(2) - X(1)) * REAL(3 - 2 * IXV)
          ELSE IF (IXV.GT.NELMX) THEN
            XN = X(NELMX) +.5*(X(NELMX)-X(NELMX-1))*
     1           REAL((IXV-NELMX)*2-1)
          END IF
      ELSE
          IF ((IXV.GE.1).AND.(IXV.LE.NELMX)) THEN
            XN = X(IXV)
          ELSE IF (IXV.LT.1) THEN
            XN = X(1) - ( X(2) - X(1) ) * REAL( 1 - IXV )
          ELSE IF (IXV.GT.NELMX) THEN
            XN = X(NELMX) + ( X(NELMX) - X(NELMX-1)) *
     1           REAL(IXV - NELMX)
          END IF
      END IF
C
      PGHIS1 = XN
      END
#<

#>            pghist.dc2
Name:         PGHIST

Purpose:      histogram of unbinned data

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGHIST(N, DATA, DATMIN, DATMAX, NBIN, PGFLAG)
            INTEGER N
            REAL    DATA(*)
            REAL    DATMIN, DATMAX
            INTEGER NBIN, PGFLAG
      
       Draw a histogram of N values of a variable in array
       DATA(1...N) in the range DATMIN to DATMAX using NBIN bins.  Note
       that array elements which fall exactly on the boundary between
       two bins will be counted in the higher bin rather than the
       lower one; and array elements whose value is less than DATMIN or
       greater than or equal to DATMAX will not be counted at all.
      
       Arguments:
        N      (input)  : the number of data values.
        DATA   (input)  : the data values. Note: the dimension of array
                          DATA must be greater than or equal to N. The
                          first N elements of the array are used.
        DATMIN (input)  : the minimum data value for the histogram.
        DATMAX (input)  : the maximum data value for the histogram.
        NBIN   (input)  : the number of bins to use: the range DATMIN to
                          DATMAX is divided into NBIN equal bins and
                          the number of DATA values in each bin is
                          determined by PGHIST.  NBIN may not exceed 200.
        PGFLAG (input)  : if PGFLAG = 1, the histogram is plotted in the
                          current window and viewport; if PGFLAG = 0,
                          PGENV is called automatically by PGHIST to start
                          a new plot (the x-limits of the window will be
                          DATMIN and DATMAX; the y-limits will be chosen
                          automatically.
                          IF PGFLAG = 2,3 the histogram will be in the same
                          window and viewport but with a filled area style.
                          If pgflag=4,5 as for pgflag = 0,1, but simple
                          line drawn as for PGBIN
      

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pghist.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGHIST -- histogram of unbinned data
C%void cpghist(int n, const float *data, float datmin, float datmax, \
C% int nbin, int pgflag);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pghist( integer, real, real, real, integer, integer )
*

C+
      SUBROUTINE PGHIST(N, DATA, DATMIN, DATMAX, NBIN, PGFLAG)
      INTEGER N
      REAL    DATA(*)
      REAL    DATMIN, DATMAX
      INTEGER NBIN, PGFLAG
C
C Draw a histogram of N values of a variable in array
C DATA(1...N) in the range DATMIN to DATMAX using NBIN bins.  Note
C that array elements which fall exactly on the boundary between
C two bins will be counted in the higher bin rather than the
C lower one; and array elements whose value is less than DATMIN or
C greater than or equal to DATMAX will not be counted at all.
C
C Arguments:
C  N      (input)  : the number of data values.
C  DATA   (input)  : the data values. Note: the dimension of array
C                    DATA must be greater than or equal to N. The
C                    first N elements of the array are used.
C  DATMIN (input)  : the minimum data value for the histogram.
C  DATMAX (input)  : the maximum data value for the histogram.
C  NBIN   (input)  : the number of bins to use: the range DATMIN to
C                    DATMAX is divided into NBIN equal bins and
C                    the number of DATA values in each bin is
C                    determined by PGHIST.  NBIN may not exceed 200.
C  PGFLAG (input)  : if PGFLAG = 1, the histogram is plotted in the
C                    current window and viewport; if PGFLAG = 0,
C                    PGENV is called automatically by PGHIST to start
C                    a new plot (the x-limits of the window will be
C                    DATMIN and DATMAX; the y-limits will be chosen
C                    automatically.
C                    IF PGFLAG = 2,3 the histogram will be in the same
C                    window and viewport but with a filled area style.
C                    If pgflag=4,5 as for pgflag = 0,1, but simple
C                    line drawn as for PGBIN
C
C--
C Side effects:
C
C The pen position is changed to (DATMAX,0.0) in world coordinates.
C--
C  6-Sep-83:
C 11-Feb-92: fill options added.
C-----------------------------------------------------------------------
      INTEGER  MAXBIN
      PARAMETER (MAXBIN=200)
      INTEGER  I, IBIN, NUM(MAXBIN), NUMMAX, JUNK
      REAL     BINSIZ, PGRND
      REAL     CUR, PREV, XLO, XHI, YLO, YHI
      LOGICAL  PGNOTO
C
      IF (N.LT.1 .OR. DATMAX.LE.DATMIN .OR. NBIN.LT.1 .OR.
     1    NBIN.GT.MAXBIN) THEN
          CALL GRWARN('PGHIST: invalid arguments')
          RETURN
      END IF
      IF (PGNOTO('PGHIST')) RETURN
      CALL PGBBUF
C
C How many values in each bin?
C
      DO 10 IBIN=1,NBIN
          NUM(IBIN) = 0
   10 CONTINUE
      DO 20 I=1,N
          IBIN = (DATA(I)-DATMIN)/(DATMAX-DATMIN)*NBIN+1
          IF (IBIN.GE.1 .AND. IBIN.LE.NBIN) NUM(IBIN) = NUM(IBIN)+1
   20 CONTINUE
      NUMMAX = 0
      DO 30 IBIN=1,NBIN
          NUMMAX = MAX(NUMMAX,NUM(IBIN))
   30 CONTINUE
      BINSIZ = (DATMAX-DATMIN)/NBIN
C
C Boundaries of plot.
C
      XLO = DATMIN
      XHI = DATMAX
      YLO = 0.0
      YHI = PGRND(1.01*NUMMAX,JUNK)
C
C Define environment if necessary.
C
      IF (MOD(PGFLAG,2).EQ.0) THEN
         CALL PGENV(XLO,XHI,YLO,YHI,0,0)
      END IF
C
C Draw Histogram.
C
      IF (PGFLAG/2.EQ.0) THEN
         PREV = 0.0
         XHI=DATMIN
         CALL GRMOVA(DATMIN,0.0)
         DO 40 IBIN=1,NBIN
            CUR = NUM(IBIN)
            XLO=XHI
            XHI = DATMIN + IBIN*BINSIZ
            IF (CUR.EQ.0.0) THEN
               CONTINUE
            ELSE IF (CUR.LE.PREV) THEN
               CALL GRMOVA(XLO,CUR)
               CALL GRLINA(XHI,CUR)
            ELSE
               CALL GRMOVA(XLO,PREV)
               CALL GRLINA(XLO,CUR)
               CALL GRLINA(XHI,CUR)
            END IF
            CALL GRLINA(XHI,0.0)
            PREV = CUR
 40      CONTINUE
      ELSE IF (PGFLAG/2.EQ.1) THEN
         PREV = 0.0
         XHI = DATMIN
         DO 50 IBIN=1,NBIN
            CUR = NUM(IBIN)
            XLO=XHI
            XHI = DATMIN + IBIN*BINSIZ
            IF (CUR.EQ.0.0) THEN
               CONTINUE
            ELSE
               CALL PGRECT(XLO,XHI,0.0,CUR)
            END IF
 50      CONTINUE
      ELSE IF (PGFLAG/2.EQ.2) THEN
         PREV = 0.0
         CALL GRMOVA(DATMIN,0.0)
         XHI=DATMIN
         DO 60 IBIN=1,NBIN
            CUR = NUM(IBIN)
            XLO = XHI
            XHI = DATMIN + IBIN*BINSIZ
            IF (CUR.EQ.0.0 .AND. PREV.EQ.0.0) THEN
               CALL GRMOVA(XHI,0.0)
            ELSE 
               CALL GRLINA(XLO,CUR)
               IF(CUR.NE.0.0) THEN
                  CALL GRLINA(XHI,CUR)
               ELSE
                  CALL GRMOVA(XHI,CUR)
               ENDIF
            END IF
            PREV = CUR
 60      CONTINUE
      END IF
C     
      CALL PGEBUF
      END
#<

#>            pghtch.dc3
Name:         pghtch

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Oct 16, 1998: JPT automatically generated.
#<

#>            pghtch.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C.PGHTCH -- hatch a polygonal area (internal routine)
C.
      SUBROUTINE PGHTCH(N, X, Y, DA)
      INTEGER N
      REAL X(*), Y(*), DA
C
C Hatch a polygonal area using equi-spaced parallel lines. The lines
C are drawn using the current line attributes: line style, line width,
C and color index. Cross-hatching can be achieved by calling this
C routine twice.
C
C Limitations: the hatching will not be done correctly if the
C polygon is so complex that a hatch line intersects more than
C 32 of its sides.
C
C Arguments:
C  N      (input)  : the number of vertices of the polygonal.
C  X,Y    (input)  : the (x,y) world-coordinates of the vertices
C                    (in order).
C  DA      (input) : 0.0 for normal hatching, 90.0 for perpendicular
C                    hatching.
C--
C Reference: I.O. Angel and G. Griffith "High-resolution computer
C graphics using Fortran 77", Halsted Press, 1987.
C
C 18-Feb-1995 [TJP].
C-----------------------------------------------------------------------
C
C MAXP is the maximum number of intersections any hatch line may make 
C with the sides of the polygon.
C
      INTEGER MAXP
      PARAMETER (MAXP=32)
      INTEGER NP(MAXP), I,J, II,JJ, NMIN,NMAX, NX, NI, NNP
      REAL ANGLE, SEPN, PHASE
      REAL RMU(MAXP), DX,DY, C, CMID,CMIN,CMAX, SX,SY, EX,EY, DELTA
      REAL QX,QY, R, RMU1, RMU2, XI,YI, BX,BY
      REAL DH, XS1, XS2, YS1, YS2, XL, XR, YT, YB, DINDX, DINDY
C
C Check arguments.
C
      IF (N.LT.3) RETURN
      CALL PGQHS(ANGLE, SEPN, PHASE)
      ANGLE = ANGLE + DA
      IF (SEPN.EQ.0.0) RETURN
C
C The unit spacing is 1 percent of the smaller of the height or
C width of the view surface. The line-spacing (DH), in inches, is
C obtained by multiplying this by argument SEPN.
C
      CALL PGQVSZ(1, XS1, XS2, YS1, YS2)
      DH = SEPN*MIN(ABS(XS2-XS1),ABS(YS2-YS1))/100.0
C
C DINDX and DINDY are the scales in inches per world-coordinate unit.
C
      CALL PGQVP(1, XS1, XS2, YS1, YS2)
      CALL PGQWIN(XL, XR, YB, YT)
      IF (XR.NE.XL .AND. YT.NE.YB) THEN
         DINDX = (XS2 - XS1) / (XR - XL)
         DINDY = (YS2 - YS1) / (YT - YB)
      ELSE
         RETURN
      END IF
C
C Initialize.
C
      CALL PGBBUF
C
C The vector (SX,SY) is a vector length DH perpendicular to
C the hatching lines, which have vector (DX,DY).
C
      DX = COS(ANGLE/57.29578)
      DY = SIN(ANGLE/57.29578)
      SX = (-DH)*DY
      SY = DH*DX
C
C The hatch lines are labelled by a parameter C, the distance from
C the coordinate origin. Calculate CMID, the C-value of the line
C that passes through the hatching reference point (BX,BY), and
C CMIN and CMAX, the range of C-values spanned by lines that intersect
C the polygon.
C
      BX = PHASE*SX
      BY = PHASE*SY
      CMID = DX*BY - DY*BX
      CMIN = DX*Y(1)*DINDY - DY*X(1)*DINDX
      CMAX = CMIN
      DO 10 I=2,N
         C = DX*Y(I)*DINDY - DY*X(I)*DINDX
         CMIN = MIN(C,CMIN)
         CMAX = MAX(C,CMAX)
 10   CONTINUE
C
C Compute integer labels for the hatch lines; N=0 is the line
C which passes through the reference point; NMIN and NMAX define
C the range of labels for lines that intersect the polygon.
C [Note that INT truncates towards zero; we need FLOOR and CEIL
C functions.]
C
      CMIN = (CMIN-CMID)/DH
      CMAX = (CMAX-CMID)/DH
      NMIN = INT(CMIN)
      IF (REAL(NMIN).LT.CMIN) NMIN = NMIN+1
      NMAX = INT(CMAX)
      IF (REAL(NMAX).GT.CMAX) NMAX = NMAX-1
C
C Each iteration of the following loop draws one hatch line.
C
      DO 60 J=NMIN,NMAX
C
C The parametric representation of this hatch line is
C (X,Y) = (QX,QY) + RMU*(DX,DY).
C
         QX = BX + REAL(J)*SX
         QY = BY + REAL(J)*SY
C
C Find the NX intersections of this line with the edges of the polygon.
C
         NX = 0
         NI = N
         DO 20 I=1,N
            EX = (X(I) - X(NI))*DINDX
            EY = (Y(I) - Y(NI))*DINDY
            DELTA = EX*DY - EY*DX
            IF (ABS(DELTA).LT.1E-5) THEN
C                 -- lines are parallel
            ELSE
C                 -- lines intersect in (XI,YI)
               R = ((QX-X(NI)*DINDX)*DY - (QY-Y(NI)*DINDY)*DX)/DELTA
               IF (R.GT.0.0 .AND. R.LE.1.0) THEN
                  IF (NX.LT.MAXP) NX = NX+1
                  NP(NX) = NX
                  IF (ABS(DX).GT.0.5) THEN
                     XI = X(NI)*DINDX + R*EX
                     RMU(NX) = (XI-QX)/DX
                  ELSE
                     YI = Y(NI)*DINDY + R*EY
                     RMU(NX) = (YI-QY)/DY
                  END IF
               END IF
            END IF
            NI = I
 20      CONTINUE
C     
C The RMU array now contains the intersections. Sort them into order.
C
         DO 40 II=1,NX-1
            DO 30 JJ=II+1,NX
               IF (RMU(NP(II)).LT.RMU(NP(JJ))) THEN
                  NNP = NP(II)
                  NP(II) = NP(JJ)
                  NP(JJ) = NNP
               END IF
 30         CONTINUE
 40      CONTINUE
C
C Join the intersections in pairs.
C
         NI = 1
C         -- do while NI < NX
 50      IF (NI .LT. NX) THEN
            RMU1 = RMU(NP(NI))
            RMU2 = RMU(NP(NI+1))
            CALL PGMOVE((QX+RMU1*DX)/DINDX, (QY+RMU1*DY)/DINDY)
            CALL PGDRAW((QX+RMU2*DX)/DINDX, (QY+RMU2*DY)/DINDY)
            NI = NI+2
            GOTO 50
         END IF
 60   CONTINUE
C
C Tidy up.
C
      CALL PGEBUF
C
      END
#<

#>            pgiden.dc2
Name:         PGIDEN

Purpose:      write username, date, and time at bottom of plot

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGIDEN
      
       Write username, date, and time at bottom of plot.
      
       Arguments: none.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgiden.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGIDEN -- write username, date, and time at bottom of plot
C%void cpgiden(void);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgiden(  )
*

C+
      SUBROUTINE PGIDEN
C
C Write username, date, and time at bottom of plot.
C
C Arguments: none.
C--
C  9-Feb-1988
C 10-Sep-1990 : adjust position of text [TJP]
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      INTEGER L, M, CF, CI, LW
      CHARACTER*64 TEXT
      REAL D, CH
C
      CALL PGBBUF
C
C Get information for annotation.
C
      CALL GRUSER(TEXT, L)
      TEXT(L+1:) = ' '
      CALL GRDATE(TEXT(L+2:), M)
      L = L+1+M
C
C Save current attributes.
C
      CALL PGQCF(CF)
      CALL PGQCI(CI)
      CALL PGQLW(LW)
      CALL PGQCH(CH)
C
C Change attributes and write text.
C
      CALL PGSCF(1)
      CALL PGSCI(1)
      CALL PGSLW(1)
      CALL PGSCH(0.6)
      CALL GRLEN(TEXT(1:L),D)
      CALL GRTEXT(.FALSE., 0.0, .TRUE., PGXSZ(PGID)-D-2.0,
     1            2.0+PGYSZ(PGID)/130.0, TEXT(1:L))
C
C Restore attributes.
C
      CALL PGSCF(CF)
      CALL PGSCI(CI)
      CALL PGSLW(LW)
      CALL PGSCH(CH)
      CALL PGEBUF
C
      END
#<

#>            pgimag.dc2
Name:         PGIMAG

Purpose:      color image from a 2D data array

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGIMAG (A, IDIM, JDIM, I1, I2, J1, J2,
           1                   A1, A2, TR)
            INTEGER IDIM, JDIM, I1, I2, J1, J2
            REAL    A(IDIM,JDIM), A1, A2, TR(6)
      
       Draw a color image of an array in current window. The subsection
       of the array A defined by indices (I1:I2, J1:J2) is mapped onto
       the view surface world-coordinate system by the transformation
       matrix TR. The resulting quadrilateral region is clipped at the edge
       of the window. Each element of the array is represented in the image
       by a small quadrilateral, which is filled with a color specified by
       the corresponding array value.
      
       The subroutine uses color indices in the range C1 to C2, which can
       be specified by calling PGSCIR before PGIMAG. The default values
       for C1 and C2 are device-dependent; these values can be determined by
       calling PGQCIR. Note that color representations should be assigned to
       color indices C1 to C2 by calling PGSCR before calling PGIMAG. On some
       devices (but not all), the color representation can be changed after
       the call to PGIMAG by calling PGSCR again.
      
       Array values in the range A1 to A2 are mapped on to the range of
       color indices C1 to C2, with array values <= A1 being given color
       index C1 and values >= A2 being given color index C2. The mapping
       function for intermediate array values can be specified by
       calling routine PGSITF before PGIMAG; the default is linear.
      
       On devices which have no available color indices (C1 > C2),
       PGIMAG will return without doing anything. On devices with only
       one color index (C1=C2), all array values map to the same color
       which is rather uninteresting. An image is always "opaque",
       i.e., it obscures all graphical elements previously drawn in
       the region.
      
       The transformation matrix TR is used to calculate the world
       coordinates of the center of the "cell" that represents each
       array element. The world coordinates of the center of the cell
       corresponding to array element A(I,J) are given by:
      
                X = TR(1) + TR(2)*I + TR(3)*J
                Y = TR(4) + TR(5)*I + TR(6)*J
      
       Usually TR(3) and TR(5) are zero -- unless the coordinate
       transformation involves a rotation or shear.  The corners of the
       quadrilateral region that is shaded by PGIMAG are given by
       applying this transformation to (I1-0.5,J1-0.5), (I2+0.5, J2+0.5).
      
       Arguments:
        A      (input)  : the array to be plotted.
        IDIM   (input)  : the first dimension of array A.
        JDIM   (input)  : the second dimension of array A.
        I1, I2 (input)  : the inclusive range of the first index
                          (I) to be plotted.
        J1, J2 (input)  : the inclusive range of the second
                          index (J) to be plotted.
        A1     (input)  : the array value which is to appear with shade C1.
        A2     (input)  : the array value which is to appear with shade C2.
        TR     (input)  : transformation matrix between array grid and
                          world coordinates.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgimag.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGIMAG -- color image from a 2D data array
C%void cpgimag(const float *a, int idim, int jdim, int i1, int i2, \
C% int j1, int j2, float a1, float a2, const float *tr);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgimag( real, integer, integer, integer, integer, integer, integer, real, real, real )
*

C+
      SUBROUTINE PGIMAG (A, IDIM, JDIM, I1, I2, J1, J2,
     1                   A1, A2, TR)
      INTEGER IDIM, JDIM, I1, I2, J1, J2
      REAL    A(IDIM,JDIM), A1, A2, TR(6)
C
C Draw a color image of an array in current window. The subsection
C of the array A defined by indices (I1:I2, J1:J2) is mapped onto
C the view surface world-coordinate system by the transformation
C matrix TR. The resulting quadrilateral region is clipped at the edge
C of the window. Each element of the array is represented in the image
C by a small quadrilateral, which is filled with a color specified by
C the corresponding array value.
C
C The subroutine uses color indices in the range C1 to C2, which can
C be specified by calling PGSCIR before PGIMAG. The default values
C for C1 and C2 are device-dependent; these values can be determined by
C calling PGQCIR. Note that color representations should be assigned to
C color indices C1 to C2 by calling PGSCR before calling PGIMAG. On some
C devices (but not all), the color representation can be changed after
C the call to PGIMAG by calling PGSCR again.
C
C Array values in the range A1 to A2 are mapped on to the range of
C color indices C1 to C2, with array values <= A1 being given color
C index C1 and values >= A2 being given color index C2. The mapping
C function for intermediate array values can be specified by
C calling routine PGSITF before PGIMAG; the default is linear.
C
C On devices which have no available color indices (C1 > C2),
C PGIMAG will return without doing anything. On devices with only
C one color index (C1=C2), all array values map to the same color
C which is rather uninteresting. An image is always "opaque",
C i.e., it obscures all graphical elements previously drawn in
C the region.
C
C The transformation matrix TR is used to calculate the world
C coordinates of the center of the "cell" that represents each
C array element. The world coordinates of the center of the cell
C corresponding to array element A(I,J) are given by:
C
C          X = TR(1) + TR(2)*I + TR(3)*J
C          Y = TR(4) + TR(5)*I + TR(6)*J
C
C Usually TR(3) and TR(5) are zero -- unless the coordinate
C transformation involves a rotation or shear.  The corners of the
C quadrilateral region that is shaded by PGIMAG are given by
C applying this transformation to (I1-0.5,J1-0.5), (I2+0.5, J2+0.5).
C
C Arguments:
C  A      (input)  : the array to be plotted.
C  IDIM   (input)  : the first dimension of array A.
C  JDIM   (input)  : the second dimension of array A.
C  I1, I2 (input)  : the inclusive range of the first index
C                    (I) to be plotted.
C  J1, J2 (input)  : the inclusive range of the second
C                    index (J) to be plotted.
C  A1     (input)  : the array value which is to appear with shade C1.
C  A2     (input)  : the array value which is to appear with shade C2.
C  TR     (input)  : transformation matrix between array grid and
C                    world coordinates.
C--
C 15-Sep-1994: new routine [TJP].
C 21-Jun-1995: minor change to header comments [TJP].
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
      REAL PA(6)
      LOGICAL PGNOTO
C
C Check inputs.
C
      IF (PGNOTO('PGIMAG')) RETURN
      IF (I1.LT.1 .OR. I2.GT.IDIM .OR. I1.GT.I2 .OR.
     1    J1.LT.1 .OR. J2.GT.JDIM .OR. J1.GT.J2) THEN
          CALL GRWARN('PGIMAG: invalid range I1:I2, J1:J2')
      ELSE IF (A1.EQ.A2) THEN
          CALL GRWARN('PGIMAG: foreground level = background level')
      ELSE IF (PGMNCI(PGID).GT.PGMXCI(PGID)) THEN
          CALL GRWARN('PGIMAG: not enough colors available')
      ELSE
C
C Call lower-level routine to do the work.
C
          CALL PGBBUF
          PA(1) = TR(1)*PGXSCL(PGID) + PGXORG(PGID)
          PA(2) = TR(2)*PGXSCL(PGID)
          PA(3) = TR(3)*PGXSCL(PGID)
          PA(4) = TR(4)*PGYSCL(PGID) + PGYORG(PGID)
          PA(5) = TR(5)*PGYSCL(PGID)
          PA(6) = TR(6)*PGYSCL(PGID)
          CALL GRIMG0(A, IDIM, JDIM, I1, I2, J1, J2, A1, A2, PA,
     :                PGMNCI(PGID), PGMXCI(PGID), PGITF(PGID))
          CALL PGEBUF
      END IF
C-----------------------------------------------------------------------
      END
#<

#>            pginit.dc3
Name:         pginit

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Oct 16, 1998: JPT automatically generated.
#<

#>            pginit.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C PGINIT -- initialize PGPLOT (internal routine)
C
      SUBROUTINE PGINIT
C
C Initialize PGPLOT. This routine should be called once during program
C execution, before any other PGPLOT routines.
C--
C Last modified: 1996 Apr 30 [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      INTEGER CALLED, I
      SAVE CALLED
      DATA CALLED /0/
C
      IF (CALLED.EQ.0) THEN
         PGID = 0
         DO 10 I=1,PGMAXD
            PGDEVS(I) = 0
 10      CONTINUE
         CALL GRINIT
         CALLED = 1
      END IF
C
      RETURN
      END
#<

#>            pglab.dc2
Name:         PGLAB

Purpose:      write labels for x-axis, y-axis, and top of plot

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGLAB (XLBL, YLBL, TOPLBL)
            CHARACTER*(*) XLBL, YLBL, TOPLBL
      
       Write labels outside the viewport. This routine is a simple
       interface to PGMTXT, which should be used if PGLAB is inadequate.
      
       Arguments:
        XLBL   (input) : a label for the x-axis (centered below the
                         viewport).
        YLBL   (input) : a label for the y-axis (centered to the left
                         of the viewport, drawn vertically).
        TOPLBL (input) : a label for the entire plot (centered above the
                         viewport).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
              Oct 21, 1998: JPT take Y-label length into account.
#<

#>            pglab.f
* GIPSY-modified
*
      
C*PGLAB -- write labels for x-axis, y-axis, and top of plot
C%void cpglab(const char *xlbl, const char *ylbl, const char *toplbl);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pglab( character, character, character )
*

C+
      SUBROUTINE PGLAB (XLBL, YLBL, TOPLBL)
      CHARACTER*(*) XLBL, YLBL, TOPLBL
C
C Write labels outside the viewport. This routine is a simple
C interface to PGMTXT, which should be used if PGLAB is inadequate.
C
C Arguments:
C  XLBL   (input) : a label for the x-axis (centered below the
C                   viewport).
C  YLBL   (input) : a label for the y-axis (centered to the left
C                   of the viewport, drawn vertically).
C  TOPLBL (input) : a label for the entire plot (centered above the
C                   viewport).
C--
C 11-May-1990 - remove unnecessary include - TJP.
C 21-Oct-1998 - Use Y-label length; include needed again - [JPT]
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
      REAL X1, X2, Y1, Y2
      REAL ANGLE, JUST
      REAL L
      REAL XL, YL
C
      CALL PGBBUF
      CALL PGMTXT('T', 2.0, 0.5, 0.5, TOPLBL)
      CALL PGMTXT('B', 3.2, 0.5, 0.5, XLBL)
      IF (PGLLEN(PGID).EQ.0.0) THEN
         CALL PGMTXT('L', 2.2, 0.5, 0.5, YLBL)
      ELSE
         CALL PGQWIN(X1, X2, Y1, Y2)
         CALL PGLEN(4, 'WWJ', XL, YL)
         L = PGLLEN(PGID) + XL
         IF (X2 .LT. X1) THEN
             L = -L
         END IF
         X1 = X1 - L
         Y1 = (Y2 + Y1) / 2.0
         ANGLE = 90.0
         JUST = 0.5
         CALL PGPTXT(X1, Y1, ANGLE, JUST, YLBL)
      END IF
      CALL PGEBUF
      END
#<

#>            pglab.f.orig
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGLAB -- write labels for x-axis, y-axis, and top of plot
C%void cpglab(const char *xlbl, const char *ylbl, const char *toplbl);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pglab( character, character, character )
*

C+
      SUBROUTINE PGLAB (XLBL, YLBL, TOPLBL)
      CHARACTER*(*) XLBL, YLBL, TOPLBL
C
C Write labels outside the viewport. This routine is a simple
C interface to PGMTXT, which should be used if PGLAB is inadequate.
C
C Arguments:
C  XLBL   (input) : a label for the x-axis (centered below the
C                   viewport).
C  YLBL   (input) : a label for the y-axis (centered to the left
C                   of the viewport, drawn vertically).
C  TOPLBL (input) : a label for the entire plot (centered above the
C                   viewport).
C--
C 11-May-1990 - remove unnecessary include - TJP.
C-----------------------------------------------------------------------
      CALL PGBBUF
      CALL PGMTXT('T', 2.0, 0.5, 0.5, TOPLBL)
      CALL PGMTXT('B', 3.2, 0.5, 0.5, XLBL)
      CALL PGMTXT('L', 2.2, 0.5, 0.5, YLBL)
      CALL PGEBUF
      END
#<

#>            pglabel.dc2
Name:         PGLABEL

Purpose:      non-standard alias for PGLAB

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGLABEL (XLBL, YLBL, TOPLBL)
            CHARACTER*(*) XLBL, YLBL, TOPLBL
      
       See description of PGLAB.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pglabel.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGLABEL -- non-standard alias for PGLAB
C+
      SUBROUTINE PGLABEL (XLBL, YLBL, TOPLBL)
      CHARACTER*(*) XLBL, YLBL, TOPLBL
C
C See description of PGLAB.
C--
      CALL PGLAB (XLBL, YLBL, TOPLBL)
      END
#<

#>            pglcur.dc2
Name:         PGLCUR

Purpose:      draw a line using the cursor

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGLCUR (MAXPT, NPT, X, Y)
            INTEGER MAXPT, NPT
            REAL    X(*), Y(*)
      
       Interactive routine for user to enter a polyline by use of
       the cursor.  Routine allows user to Add and Delete vertices;
       vertices are joined by straight-line segments.
      
       Arguments:
        MAXPT  (input)  : maximum number of points that may be accepted.
        NPT    (in/out) : number of points entered; should be zero on
                          first call.
        X      (in/out) : array of x-coordinates (dimension at least MAXPT).
        Y      (in/out) : array of y-coordinates (dimension at least MAXPT).
      
       Notes:
      
       (1) On return from the program, cursor points are returned in
       the order they were entered. Routine may be (re-)called with points
       already defined in X,Y (# in NPT), and they will be plotted
       first, before editing.
      
       (2) User commands: the user types single-character commands
       after positioning the cursor: the following are accepted:
         A (Add)    - add point at current cursor location.
         D (Delete) - delete last-entered point.
         X (eXit)   - leave subroutine.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pglcur.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGLCUR -- draw a line using the cursor
C%void cpglcur(int maxpt, int *npt, float *x, float *y);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pglcur( integer, integer, real, real )
*

C+
      SUBROUTINE PGLCUR (MAXPT, NPT, X, Y)
      INTEGER MAXPT, NPT
      REAL    X(*), Y(*)
C
C Interactive routine for user to enter a polyline by use of
C the cursor.  Routine allows user to Add and Delete vertices;
C vertices are joined by straight-line segments.
C
C Arguments:
C  MAXPT  (input)  : maximum number of points that may be accepted.
C  NPT    (in/out) : number of points entered; should be zero on
C                    first call.
C  X      (in/out) : array of x-coordinates (dimension at least MAXPT).
C  Y      (in/out) : array of y-coordinates (dimension at least MAXPT).
C
C Notes:
C
C (1) On return from the program, cursor points are returned in
C the order they were entered. Routine may be (re-)called with points
C already defined in X,Y (# in NPT), and they will be plotted
C first, before editing.
C
C (2) User commands: the user types single-character commands
C after positioning the cursor: the following are accepted:
C   A (Add)    - add point at current cursor location.
C   D (Delete) - delete last-entered point.
C   X (eXit)   - leave subroutine.
C--
C  5-Aug-1984 - new routine [TJP].
C 16-Jul-1988 - correct error in delete operation [TJP].
C 13-Dec-1990 - change warnings to messages [TJP].
C  3-Sep-1992 - fixed erase first point bug under Add option [JM/TJP].
C  7-Sep-1994 - use PGBAND [TJP].
C  2-Aug-1995 - remove dependence on common block [TJP].
C-----------------------------------------------------------------------
      LOGICAL  PGNOTO
      CHARACTER*1 LETTER
      INTEGER  PGBAND, I, SAVCOL, MODE
      REAL     XP, YP, XREF, YREF
      REAL     XBLC, XTRC, YBLC, YTRC
C
C Check that PGPLOT is in the correct state.
C
      IF (PGNOTO('PGLCUR')) RETURN
C
C Save current color.
C
      CALL GRQCI(SAVCOL)
C
C Put current line-segments on screen.
C
      IF (NPT.EQ.1) THEN
          CALL PGPT(1,X(1),Y(1),1)
      END IF
      IF (NPT.GT.0) THEN
          CALL GRMOVA(X(1),Y(1))
          DO 10 I=2,NPT
              CALL GRLINA(X(I),Y(I))
   10     CONTINUE
      END IF
C
C Start with the cursor in the middle of the box,
C unless lines have already been drawn.
C
      CALL PGQWIN(XBLC, XTRC, YBLC, YTRC)
      IF (NPT.GT.0) THEN
          XP = X(NPT)
          YP = Y(NPT)
      ELSE
          XP = 0.5*(XBLC+XTRC)
          YP = 0.5*(YBLC+YTRC)
      END IF
C
C Loop over cursor inputs.
C
      MODE = 0
  100 XREF = XP
      YREF = YP
      IF (PGBAND(MODE,1,XREF,YREF,XP,YP,LETTER).NE.1) RETURN
      CALL GRTOUP(LETTER,LETTER)
      MODE = 1
C
C A (ADD) command:
C
      IF (LETTER .EQ. 'A') THEN
          IF (NPT.GE.MAXPT) THEN
            CALL GRMSG('ADD ignored (too many points).')
              GOTO 100
          END IF
          NPT = NPT+1
          X(NPT) = XP
          Y(NPT) = YP
          IF (NPT.EQ.1) THEN
C           -- first point: draw a dot
            CALL GRMOVA(X(NPT),Y(NPT))
            CALL PGPT(1,X(NPT),Y(NPT),1)
          ELSE
C           -- nth point: draw from (n-1) to (n)
            CALL GRLINA(X(NPT),Y(NPT))
          END IF
          CALL GRTERM
C
C D (DELETE) command:
C
      ELSE IF (LETTER.EQ.'D') THEN
          IF (NPT.LE.0) THEN
            CALL GRMSG('DELETE ignored (there are no points left).')
            GOTO 100
          END IF
          IF (NPT.GT.1) THEN
C           -- delete nth point: erase from (n-1) to (n)
            CALL GRMOVA(X(NPT-1),Y(NPT-1))
            CALL GRSCI(0)
            CALL GRLINA(X(NPT),Y(NPT))
            CALL GRSCI(SAVCOL)
            CALL GRMOVA(X(NPT-1),Y(NPT-1))
            CALL GRTERM
          ELSE IF (NPT.EQ.1) THEN
C           -- delete first point: erase dot
            CALL GRSCI(0)
            CALL PGPT(1,X(NPT),Y(NPT),1)
            CALL GRSCI(SAVCOL)
          END IF
          NPT = NPT-1
          IF (NPT.EQ.0) THEN
            XP = 0.5*(XBLC+XTRC)
            YP = 0.5*(YBLC+YTRC)
          ELSE
            XP = X(NPT)
            YP = Y(NPT)
          END IF
          IF (NPT.EQ.1) THEN
C           -- delete 2nd point: redraw dot at first point
            CALL PGPT(1,X(1),Y(1),1)
          END IF
C
C X (EXIT) command:
C
      ELSE IF (LETTER.EQ.'X') THEN
          CALL GRETXT
          RETURN
C
C Illegal command:
C
      ELSE
          CALL GRMSG('Commands are A (add), D (delete), X (exit).')
      END IF
C
      GOTO 100
      END
#<

#>            pgldev.dc2
Name:         PGLDEV

Purpose:      list available device types on standard output

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGLDEV
      
       Writes (to standard output) a list of all device types available in
       the current PGPLOT installation.
      
       Arguments: none.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
              Oct 22, 1998: JPT revert to simple GIPSY implementation.
#<

#>            pgldev.f
* GIPSY-modified
*

C*PGLDEV -- list available device types on standard output
C%void cpgldev(void);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgldev(  )
*

C+
      SUBROUTINE PGLDEV
C
C Writes (to standard output) a list of all device types available in
C the current PGPLOT installation.
C
C Arguments: none.
C--
C 5-Aug-1986 - [AFT].
C 1-Aug-1988 - add version number [TJP].
C 24-Apr-1989 - add copyright notice [TJP].
C 13-Dec-1990 - changed warnings to messages [TJP].
C 26-Feb-1997 - revised description [TJP].
C 18-Mar-1997 - revised [TJP].
C-----------------------------------------------------------------------
      CHARACTER*16 GVER
      INTEGER L
C
C Initialize PGPLOT if necessary.
C
      CALL PGINIT
C
C Report version and copyright.
C
      CALL PGQINF('VERSION', GVER, L)
      CALL GRMSG('PGPLOT '//GVER(:L)//
     1           ' Copyright 1997 California Institute of Technology')
      CALL GRLDEV
      END
#<

#>            pgldev.f.orig
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGLDEV -- list available device types on standard output
C%void cpgldev(void);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgldev(  )
*

C+
      SUBROUTINE PGLDEV
C
C Writes (to standard output) a list of all device types available in
C the current PGPLOT installation.
C
C Arguments: none.
C--
C 5-Aug-1986 - [AFT].
C 1-Aug-1988 - add version number [TJP].
C 24-Apr-1989 - add copyright notice [TJP].
C 13-Dec-1990 - changed warnings to messages [TJP].
C 26-Feb-1997 - revised description [TJP].
C 18-Mar-1997 - revised [TJP].
C-----------------------------------------------------------------------
      CHARACTER*16 GVER
      INTEGER L
      CHARACTER*10 T
      CHARACTER*64 D
      INTEGER I, N, TLEN, DLEN, INTER
C
C Initialize PGPLOT if necessary.
C
      CALL PGINIT
C
C Report version and copyright.
C
      CALL PGQINF('VERSION', GVER, L)
      CALL GRMSG('PGPLOT '//GVER(:L)//
     1           ' Copyright 1997 California Institute of Technology')
C
C Find number of device types.
C
      CALL PGQNDT(N)
C
C Loop through device-type list (twice).

      CALL GRMSG('Interactive devices:')
      DO 10 I=1,N
         CALL PGQDT(I, T, TLEN, D, DLEN, INTER)
         IF (TLEN.GT.0 .AND. INTER.EQ.1)
     :        CALL GRMSG('   '//T//' '//D(1:DLEN))
 10   CONTINUE
      CALL GRMSG('Non-interactive file formats:')
      DO 20 I=1,N
         CALL PGQDT(I, T, TLEN, D, DLEN, INTER)
         IF (TLEN.GT.0 .AND. INTER.EQ.0)
     :        CALL GRMSG('   '//T//' '//D(1:DLEN))
 20   CONTINUE
C
      END
#<

#>            pglen.dc2
Name:         PGLEN

Purpose:      find length of a string in a variety of units

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGLEN (UNITS, STRING, XL, YL)
            REAL XL, YL
            INTEGER UNITS
            CHARACTER*(*) STRING
      
       Work out length of a string in x and y directions 
      
       Input
        UNITS    :  0 => answer in normalized device coordinates
                    1 => answer in inches
                    2 => answer in mm
                    3 => answer in absolute device coordinates (dots)
                    4 => answer in world coordinates
                    5 => answer as a fraction of the current viewport size
      
        STRING   :  String of interest
       Output
        XL       :  Length of string in x direction
        YL       :  Length of string in y direction
      

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pglen.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGLEN -- find length of a string in a variety of units
C%void cpglen(int units, const char *string, float *xl, float *yl);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pglen( integer, character, real, real )
*

C+
      SUBROUTINE PGLEN (UNITS, STRING, XL, YL)
      REAL XL, YL
      INTEGER UNITS
      CHARACTER*(*) STRING
C
C Work out length of a string in x and y directions 
C
C Input
C  UNITS    :  0 => answer in normalized device coordinates
C              1 => answer in inches
C              2 => answer in mm
C              3 => answer in absolute device coordinates (dots)
C              4 => answer in world coordinates
C              5 => answer as a fraction of the current viewport size
C
C  STRING   :  String of interest
C Output
C  XL       :  Length of string in x direction
C  YL       :  Length of string in y direction
C
C--
C 15-Sep-1989 - new routine (Neil Killeen)
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      LOGICAL PGNOTO
      REAL    D
C
      IF (PGNOTO('PGLEN')) RETURN
C
C   Work out length of a string in absolute device coordinates (dots)
C   and then convert
C
      CALL GRLEN (STRING, D)
C
      IF (UNITS.EQ.0) THEN
        XL = D / PGXSZ(PGID)
        YL = D / PGYSZ(PGID)
      ELSE IF (UNITS.EQ.1) THEN
        XL = D / PGXPIN(PGID)
        YL = D / PGYPIN(PGID)
      ELSE IF (UNITS.EQ.2) THEN
        XL = 25.4 * D / PGXPIN(PGID)
        YL = 25.4 * D / PGYPIN(PGID)
      ELSE IF (UNITS.EQ.3) THEN
        XL = D
        YL = D
      ELSE IF (UNITS.EQ.4) THEN
        XL = D / ABS(PGXSCL(PGID))
        YL = D / ABS(PGYSCL(PGID))
      ELSE IF (UNITS.EQ.5) THEN
        XL = D / PGXLEN(PGID)
        YL = D / PGYLEN(PGID)
      ELSE
        CALL GRWARN('Illegal value for UNITS in routine PGLEN')
      END IF
C
      RETURN
      END
#<

#>            pgline.dc2
Name:         PGLINE

Purpose:      draw a polyline (curve defined by line-segments)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGLINE (N, XPTS, YPTS)
            INTEGER  N
            REAL     XPTS(*), YPTS(*)
      
       Primitive routine to draw a Polyline. A polyline is one or more
       connected straight-line segments.  The polyline is drawn using
       the current setting of attributes color-index, line-style, and
       line-width. The polyline is clipped at the edge of the window.
       Points of which either the XPTS or the YPTS value is BLANK, will
       be skipped.
      
       Arguments:
        N      (input)  : number of points defining the line; the line
                          consists of (N-1) straight-line segments.
                          N should be greater than 1 (if it is 1 or less,
                          nothing will be drawn).
        XPTS   (input)  : world x-coordinates of the points.
        YPTS   (input)  : world y-coordinates of the points.
      
       The dimension of arrays X and Y must be greater than or equal to N.
       The "pen position" is changed to (X(N),Y(N)) in world coordinates
       (if N > 1).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
              Mar  7, 2000: JPT  modified for skipping BLANK coordinates.

#<

#>            pgline.f
* GIPSY-modified
*

C*PGLINE -- draw a polyline (curve defined by line-segments)
C%void cpgline(int n, const float *xpts, const float *ypts);

* GIPSY Fortran to C interface:
*
*@ subroutine pgline( integer, real, real )
*

C+
      SUBROUTINE PGLINE (N, XPTS, YPTS)
      INTEGER  N
      REAL     XPTS(*), YPTS(*)
C
C Primitive routine to draw a Polyline. A polyline is one or more
C connected straight-line segments.  The polyline is drawn using
C the current setting of attributes color-index, line-style, and
C line-width. The polyline is clipped at the edge of the window.
C
C Arguments:
C  N      (input)  : number of points defining the line; the line
C                    consists of (N-1) straight-line segments.
C                    N should be greater than 1 (if it is 1 or less,
C                    nothing will be drawn).
C  XPTS   (input)  : world x-coordinates of the points.
C  YPTS   (input)  : world y-coordinates of the points.
C
C The dimension of arrays X and Y must be greater than or equal to N.
C The "pen position" is changed to (X(N),Y(N)) in world coordinates
C (if N > 1).
C--
C 27-Nov-1986
C 07-Mar-2000 - modified for skipping BLANK coordinates [JPT]
C-----------------------------------------------------------------------
      INTEGER  I
      REAL     BLANK, X, Y
      LOGICAL PGNOTO, MOVE
C
      IF (PGNOTO('PGLINE')) RETURN
      IF (N.LT.2) RETURN
C
      CALL SETFBLANK(BLANK)
      CALL PGBBUF
      MOVE = .TRUE.
      DO 10 I=1,N
         X = XPTS(I)
         Y = YPTS(I)
         IF (X.NE.BLANK .AND. Y.NE.BLANK) THEN
            IF (MOVE) THEN
               CALL GRMOVA(X,Y)
               MOVE = .FALSE.
            ELSE
               CALL GRLINA(X,Y)
            ENDIF
         ELSE
            MOVE = .TRUE.
         ENDIF
 10   CONTINUE
      CALL PGEBUF
      END
#<

#>            pgline.f.orig
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGLINE -- draw a polyline (curve defined by line-segments)
C%void cpgline(int n, const float *xpts, const float *ypts);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgline( integer, real, real )
*

C+
      SUBROUTINE PGLINE (N, XPTS, YPTS)
      INTEGER  N
      REAL     XPTS(*), YPTS(*)
C
C Primitive routine to draw a Polyline. A polyline is one or more
C connected straight-line segments.  The polyline is drawn using
C the current setting of attributes color-index, line-style, and
C line-width. The polyline is clipped at the edge of the window.
C
C Arguments:
C  N      (input)  : number of points defining the line; the line
C                    consists of (N-1) straight-line segments.
C                    N should be greater than 1 (if it is 1 or less,
C                    nothing will be drawn).
C  XPTS   (input)  : world x-coordinates of the points.
C  YPTS   (input)  : world y-coordinates of the points.
C
C The dimension of arrays X and Y must be greater than or equal to N.
C The "pen position" is changed to (X(N),Y(N)) in world coordinates
C (if N > 1).
C--
C 27-Nov-1986
C-----------------------------------------------------------------------
      INTEGER  I
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGLINE')) RETURN
      IF (N.LT.2) RETURN
C
      CALL PGBBUF
      CALL GRMOVA(XPTS(1),YPTS(1))
      DO 10 I=2,N
         CALL GRLINA(XPTS(I),YPTS(I))
 10   CONTINUE
      CALL PGEBUF
      END
#<

#>            pgmove.dc2
Name:         PGMOVE

Purpose:      move pen (change current pen position)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGMOVE (X, Y)
            REAL X, Y
      
       Primitive routine to move the "pen" to the point with world
       coordinates (X,Y). No line is drawn.
      
       Arguments:
        X      (input)  : world x-coordinate of the new pen position.
        Y      (input)  : world y-coordinate of the new pen position.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgmove.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGMOVE -- move pen (change current pen position)
C%void cpgmove(float x, float y);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgmove( real, real )
*

C+
      SUBROUTINE PGMOVE (X, Y)
      REAL X, Y
C
C Primitive routine to move the "pen" to the point with world
C coordinates (X,Y). No line is drawn.
C
C Arguments:
C  X      (input)  : world x-coordinate of the new pen position.
C  Y      (input)  : world y-coordinate of the new pen position.
C--
C (29-Dec-1983)
C-----------------------------------------------------------------------
      CALL GRMOVA(X,Y)
      END
#<

#>            pgmtext.dc2
Name:         PGMTEXT

Purpose:      non-standard alias for PGMTXT

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGMTEXT (SIDE, DISP, COORD, FJUST, TEXT)
            CHARACTER*(*) SIDE, TEXT
            REAL DISP, COORD, FJUST
      
       See description of PGMTXT.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgmtext.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGMTEXT -- non-standard alias for PGMTXT
C+
      SUBROUTINE PGMTEXT (SIDE, DISP, COORD, FJUST, TEXT)
      CHARACTER*(*) SIDE, TEXT
      REAL DISP, COORD, FJUST
C
C See description of PGMTXT.
C--
      CALL PGMTXT (SIDE, DISP, COORD, FJUST, TEXT)
      END
#<

#>            pgmtxt.dc2
Name:         PGMTXT

Purpose:      write text at position relative to viewport

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGMTXT (SIDE, DISP, COORD, FJUST, TEXT)
            CHARACTER*(*) SIDE, TEXT
            REAL DISP, COORD, FJUST
      
       Write text at a position specified relative to the viewport (outside
       or inside).  This routine is useful for annotating graphs. It is used
       by routine PGLAB.  The text is written using the current values of
       attributes color-index, line-width, character-height, and
       character-font.
      
       Arguments:
        SIDE   (input)  : must include one of the characters 'B', 'L', 'T',
                          or 'R' signifying the Bottom, Left, Top, or Right
                          margin of the viewport. If it includes 'LV' or
                          'RV', the string is written perpendicular to the
                          frame rather than parallel to it.
        DISP   (input)  : the displacement of the character string from the
                          specified edge of the viewport, measured outwards
                          from the viewport in units of the character
                          height. Use a negative value to write inside the
                          viewport, a positive value to write outside.
        COORD  (input)  : the location of the character string along the
                          specified edge of the viewport, as a fraction of
                          the length of the edge.
        FJUST  (input)  : controls justification of the string parallel to
                          the specified edge of the viewport. If
                          FJUST = 0.0, the left-hand end of the string will
                          be placed at COORD; if JUST = 0.5, the center of
                          the string will be placed at COORD; if JUST = 1.0,
                          the right-hand end of the string will be placed at
                          at COORD. Other values between 0 and 1 give inter-
                          mediate placing, but they are not very useful.
        TEXT   (input) :  the text string to be plotted. Trailing spaces are
                          ignored when justifying the string, but leading
                          spaces are significant.
      

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgmtxt.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGMTXT -- write text at position relative to viewport
C%void cpgmtxt(const char *side, float disp, float coord, \
C% float fjust, const char *text);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgmtxt( character, real, real, real, character )
*

C+
      SUBROUTINE PGMTXT (SIDE, DISP, COORD, FJUST, TEXT)
      CHARACTER*(*) SIDE, TEXT
      REAL DISP, COORD, FJUST
C
C Write text at a position specified relative to the viewport (outside
C or inside).  This routine is useful for annotating graphs. It is used
C by routine PGLAB.  The text is written using the current values of
C attributes color-index, line-width, character-height, and
C character-font.
C
C Arguments:
C  SIDE   (input)  : must include one of the characters 'B', 'L', 'T',
C                    or 'R' signifying the Bottom, Left, Top, or Right
C                    margin of the viewport. If it includes 'LV' or
C                    'RV', the string is written perpendicular to the
C                    frame rather than parallel to it.
C  DISP   (input)  : the displacement of the character string from the
C                    specified edge of the viewport, measured outwards
C                    from the viewport in units of the character
C                    height. Use a negative value to write inside the
C                    viewport, a positive value to write outside.
C  COORD  (input)  : the location of the character string along the
C                    specified edge of the viewport, as a fraction of
C                    the length of the edge.
C  FJUST  (input)  : controls justification of the string parallel to
C                    the specified edge of the viewport. If
C                    FJUST = 0.0, the left-hand end of the string will
C                    be placed at COORD; if JUST = 0.5, the center of
C                    the string will be placed at COORD; if JUST = 1.0,
C                    the right-hand end of the string will be placed at
C                    at COORD. Other values between 0 and 1 give inter-
C                    mediate placing, but they are not very useful.
C  TEXT   (input) :  the text string to be plotted. Trailing spaces are
C                    ignored when justifying the string, but leading
C                    spaces are significant.
C
C--
C 18-Apr-1983
C 15-Aug-1987 - fix BBUF/EBUF error.
C 27-Aug-1987 - fix justification error if XPERIN.ne.YPERIN.
C 05-Sep-1989 - change so that DISP has some effect for 'RV' and 
C               'LV' options [nebk]
C 16-Oct-1993 - erase background of opaque text.
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      LOGICAL PGNOTO
      REAL ANGLE, D, X, Y, RATIO, XBOX(4), YBOX(4)
      INTEGER CI, I, L, GRTRIM
      CHARACTER*20 TEST
C
      IF (PGNOTO('PGMTXT')) RETURN
C
      L = GRTRIM(TEXT)
      IF (L.LT.1) RETURN
      D = 0.0
      IF (FJUST.NE.0.0) CALL GRLEN(TEXT(1:L),D)
      D = D*FJUST
      RATIO = PGYPIN(PGID)/PGXPIN(PGID)
      CALL GRTOUP(TEST,SIDE)
      IF (INDEX(TEST,'B').NE.0) THEN
          ANGLE = 0.0
          X = PGXOFF(PGID) + COORD*PGXLEN(PGID) - D
          Y = PGYOFF(PGID) - PGYSP(PGID)*DISP
      ELSE IF (INDEX(TEST,'LV').NE.0) THEN
          ANGLE = 0.0
          X = PGXOFF(PGID) - PGYSP(PGID)*DISP - D
          Y = PGYOFF(PGID) + COORD*PGYLEN(PGID) - 0.3*PGYSP(PGID)
      ELSE IF (INDEX(TEST,'L').NE.0) THEN
          ANGLE = 90.0
          X = PGXOFF(PGID) - PGYSP(PGID)*DISP
          Y = PGYOFF(PGID) + COORD*PGYLEN(PGID) - D*RATIO
      ELSE IF (INDEX(TEST,'T').NE.0) THEN
          ANGLE = 0.0
          X = PGXOFF(PGID) + COORD*PGXLEN(PGID) - D
          Y = PGYOFF(PGID) + PGYLEN(PGID) + PGYSP(PGID)*DISP
      ELSE IF (INDEX(TEST,'RV').NE.0) THEN
          ANGLE = 0.0
          X = PGXOFF(PGID) + PGXLEN(PGID) + PGYSP(PGID)*DISP - D
          Y = PGYOFF(PGID) + COORD*PGYLEN(PGID) - 0.3*PGYSP(PGID)
      ELSE IF (INDEX(TEST,'R').NE.0) THEN
          ANGLE = 90.0
          X = PGXOFF(PGID) + PGXLEN(PGID) + PGYSP(PGID)*DISP
          Y = PGYOFF(PGID) + COORD*PGYLEN(PGID) - D*RATIO
      ELSE
          CALL GRWARN('Invalid "SIDE" argument in PGMTXT.')
          RETURN
      END IF
      CALL PGBBUF
      IF (PGTBCI(PGID).GE.0) THEN
          CALL GRQTXT (ANGLE, X, Y, TEXT(1:L), XBOX, YBOX)
          DO 25 I=1,4
              XBOX(I) = (XBOX(I)-PGXORG(PGID))/PGXSCL(PGID)
              YBOX(I) = (YBOX(I)-PGYORG(PGID))/PGYSCL(PGID)
   25     CONTINUE
          CALL PGQCI(CI)
          CALL PGSCI(PGTBCI(PGID))
          CALL GRFA(4, XBOX, YBOX)
          CALL PGSCI(CI)
      END IF
      CALL GRTEXT(.FALSE.,ANGLE,.TRUE., X, Y, TEXT(1:L))
      CALL PGEBUF
      END
#<

#>            pgncur.dc2
Name:         PGNCUR

Purpose:      mark a set of points using the cursor

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGNCUR (MAXPT, NPT, X, Y, SYMBOL)
            INTEGER MAXPT, NPT
            REAL    X(*), Y(*)
            INTEGER SYMBOL
      
       Interactive routine for user to enter data points by use of
       the cursor.  Routine allows user to Add and Delete points.  The
       points are returned in order of increasing x-coordinate, not in the
       order they were entered.
      
       Arguments:
        MAXPT  (input)  : maximum number of points that may be accepted.
        NPT    (in/out) : number of points entered; should be zero on
                          first call.
        X      (in/out) : array of x-coordinates.
        Y      (in/out) : array of y-coordinates.
        SYMBOL (input)  : code number of symbol to use for marking
                          entered points (see PGPT).
      
       Note (1): The dimension of arrays X and Y must be greater than or
       equal to MAXPT.
      
       Note (2): On return from the program, cursor points are returned in
       increasing order of X. Routine may be (re-)called with points
       already defined in X,Y (number in NPT), and they will be plotted
       first, before editing.
      
       Note (3): User commands: the user types single-character commands
       after positioning the cursor: the following are accepted:
       A (Add)    - add point at current cursor location.
       D (Delete) - delete nearest point to cursor.
       X (eXit)   - leave subroutine.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgncur.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGNCUR -- mark a set of points using the cursor
C%void cpgncur(int maxpt, int *npt, float *x, float *y, int symbol);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgncur( integer, integer, real, real, integer )
*

C+
      SUBROUTINE PGNCUR (MAXPT, NPT, X, Y, SYMBOL)
      INTEGER MAXPT, NPT
      REAL    X(*), Y(*)
      INTEGER SYMBOL
C
C Interactive routine for user to enter data points by use of
C the cursor.  Routine allows user to Add and Delete points.  The
C points are returned in order of increasing x-coordinate, not in the
C order they were entered.
C
C Arguments:
C  MAXPT  (input)  : maximum number of points that may be accepted.
C  NPT    (in/out) : number of points entered; should be zero on
C                    first call.
C  X      (in/out) : array of x-coordinates.
C  Y      (in/out) : array of y-coordinates.
C  SYMBOL (input)  : code number of symbol to use for marking
C                    entered points (see PGPT).
C
C Note (1): The dimension of arrays X and Y must be greater than or
C equal to MAXPT.
C
C Note (2): On return from the program, cursor points are returned in
C increasing order of X. Routine may be (re-)called with points
C already defined in X,Y (number in NPT), and they will be plotted
C first, before editing.
C
C Note (3): User commands: the user types single-character commands
C after positioning the cursor: the following are accepted:
C A (Add)    - add point at current cursor location.
C D (Delete) - delete nearest point to cursor.
C X (eXit)   - leave subroutine.
C--
C 27-Nov-1983
C  9-Jul-1983 - modified to use GRSCI instead of GRSETLI [TJP].
C 13-Dec-1990 - changed warnings to messages [TJP].
C  2-Aug-1995 - [TJP].
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
      CHARACTER*1 LETTER
      LOGICAL  PGNOTO
      INTEGER  PGCURS, I, J, SAVCOL
      REAL     DELTA, XP, YP, XPHYS, YPHYS
      REAL     XMIN, XIP, YIP
      REAL     XBLC, XTRC, YBLC, YTRC
C
C Check that PGPLOT is in the correct state.
C
      IF (PGNOTO('PGNCUR')) RETURN
C
C Save current color.
C
      CALL GRQCI(SAVCOL)
C
C Put current points on screen.
C
      IF (NPT.NE.0) CALL PGPT(NPT,X,Y,SYMBOL)
C
C Start with the cursor in the middle of the viewport.
C
      CALL PGQWIN(XBLC, XTRC, YBLC, YTRC)
      XP = 0.5*(XBLC+XTRC)
      YP = 0.5*(YBLC+YTRC)
C
C Loop over cursor inputs.
C
  100 IF (PGCURS(XP,YP,LETTER).NE.1) RETURN
      IF (LETTER.EQ.CHAR(0)) RETURN
      CALL GRTOUP(LETTER,LETTER)
C
C A (ADD) command:
C
      IF (LETTER .EQ. 'A') THEN
          IF (NPT.GE.MAXPT) THEN
              CALL GRMSG('ADD ignored (too many points).')
              GOTO 100
          END IF
C         ! Find what current points new point is between.
          DO 120 J=1,NPT
              IF (XP.LT.X(J)) GOTO 122
  120     CONTINUE
          J = NPT + 1
C         ! New point is beyond last current
  122     CONTINUE
C         ! J is vector location where new point should be included.
          DO 140 I=NPT,J,-1
              X(I+1) = X(I)
              Y(I+1) = Y(I)
  140     CONTINUE
          NPT = NPT + 1
C         ! Add new point to point array.
          X(J) = XP
          Y(J) = YP
          CALL PGPT(1,X(J),Y(J),SYMBOL)
          CALL GRTERM
C
C D (DELETE) command:
C
      ELSE IF (LETTER.EQ.'D') THEN
          IF (NPT.LE.0) THEN
              CALL GRMSG('DELETE ignored (there are no points left).')
              GOTO 100
          END IF
          XMIN = 1.E+08
C         ! Look for point closest in radius.
C         ! Convert cursor points to physical.
          XPHYS = PGXORG(PGID) + XP*PGXSCL(PGID)
          YPHYS = PGYORG(PGID) + YP*PGYSCL(PGID)
          DO 220 I=1,NPT
C             ! Convert array points to physical.
              XIP = PGXORG(PGID) + X(I)*PGXSCL(PGID)
              YIP = PGYORG(PGID) + Y(I)*PGYSCL(PGID)
              DELTA = SQRT( (XIP-XPHYS)**2 + (YIP-YPHYS)**2 )
              IF (DELTA.LT.XMIN) THEN
                 XMIN = DELTA
                 J = I
              END IF
  220     CONTINUE
C         ! Remove point from screen by writing in background color.
          CALL GRSCI(0)
          CALL PGPT(1,X(J),Y(J),SYMBOL)
          CALL GRSCI(SAVCOL)
          CALL GRTERM
C         ! Remove point from cursor array.
          NPT = NPT-1
          DO 240 I=J,NPT
              X(I) = X(I+1)
              Y(I) = Y(I+1)
  240     CONTINUE
C
C X (EXIT) command:
C
      ELSE IF (LETTER.EQ.'X') THEN
          CALL GRETXT
          RETURN
C
C Illegal command:
C
      ELSE
          CALL GRMSG('Commands are A (add), D (delete), X (exit).')
      END IF
C
      GOTO 100
      END
#<

#>            pgncurse.dc2
Name:         PGNCURSE

Purpose:      non-standard alias for PGNCUR

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGNCURSE (MAXPT, NPT, X, Y, SYMBOL)
            INTEGER MAXPT, NPT
            REAL    X(*), Y(*)
            INTEGER SYMBOL
      
       See description of PGNCUR.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgncurse.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGNCURSE -- non-standard alias for PGNCUR
C+
      SUBROUTINE PGNCURSE (MAXPT, NPT, X, Y, SYMBOL)
      INTEGER MAXPT, NPT
      REAL    X(*), Y(*)
      INTEGER SYMBOL
C
C See description of PGNCUR.
C--
      CALL PGNCUR (MAXPT, NPT, X, Y, SYMBOL)
      END
#<

#>            pgnoto.dc3
Name:         pgnoto

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Oct 16, 1998: JPT automatically generated.
#<

#>            pgnoto.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C
      LOGICAL FUNCTION PGNOTO (RTN)
      CHARACTER*(*) RTN
C
C PGPLOT (internal routine): Test whether a PGPLOT device is open and
C print a message if not. Usage:
C     LOGICAL PGNOTO
C     IF (PGNOTO('routine')) RETURN
C
C Arguments:
C
C RTN (input, character): routine name to be include in message.
C
C Returns:
C     .TRUE. if PGPLOT is not open.
C--
C 11-Nov-1994
C 21-Dec-1995 - revised for multiple devices.
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
      CHARACTER*80 TEXT
C
      CALL PGINIT
      PGNOTO = .FALSE.
      IF (PGID.LT.1 .OR. PGID.GT.PGMAXD) THEN
         PGNOTO = .TRUE.
         TEXT = RTN//': no graphics device has been selected'
         CALL GRWARN(TEXT)
      ELSE IF (PGDEVS(PGID).NE.1) THEN
         PGNOTO = .TRUE.
         TEXT = RTN//': selected graphics device is not open'
         CALL GRWARN(TEXT)
      END IF
      RETURN
      END
#<

#>            pgnpl.dc3
Name:         pgnpl

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Oct 16, 1998: JPT automatically generated.
#<

#>            pgnpl.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.


C
C.PGNPL -- Work out how many numerals there are in an integer
C.
      SUBROUTINE PGNPL (NMAX, N, NPL)
C
      INTEGER NMAX, N, NPL
C
C     Work out how many numerals there are in an integer for use with 
C     format statements.   
C     e.g.  N=280 => NPL=3,   N=-3 => NPL=2
C
C     Input:
C       NMAX   :   If > 0, issue a warning that N is going to
C                  exceed the format statement field size if NPL 
C                  exceeds NMAX
C       N      :   Integer of interest
C     Output:
C       NPL    :   Number of numerals
C
C-
C  20-Apr-1991 -- new routine (Neil Killeen)
C-------------------------------------------------------------------------
      IF (N.EQ.0) THEN
        NPL = 1
      ELSE
        NPL = INT(LOG10(REAL(ABS(N)))) + 1
      END IF
      IF (N.LT.0) NPL = NPL + 1
C
      IF (NMAX.GT.0 .AND. NPL.GT.NMAX) 
     *  CALL GRWARN ('PGNPL: output conversion error likely; '
     *               //'number too big for format')
C
      RETURN
      END
#<

#>            pgnumb.dc2
Name:         PGNUMB

Purpose:      convert a number into a plottable character string

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGNUMB (MM, PP, FORM, STRING, NC)
            INTEGER MM, PP, FORM
            CHARACTER*(*) STRING
            INTEGER NC
      
       This routine converts a number into a decimal character
       representation. To avoid problems of floating-point roundoff, the
       number must be provided as an integer (MM) multiplied by a power of 10
       (10**PP).  The output string retains only significant digits of MM,
       and will be in either integer format (123), decimal format (0.0123),
       or exponential format (1.23x10**5). Standard escape sequences \u, \d 
       raise the exponent and \x is used for the multiplication sign.
       This routine is used by PGBOX to create numeric labels for a plot.
      
       Formatting rules:
         (a) Decimal notation (FORM=1):
             - Trailing zeros to the right of the decimal sign are
               omitted
             - The decimal sign is omitted if there are no digits
               to the right of it
             - When the decimal sign is placed before the first digit
               of the number, a zero is placed before the decimal sign
             - The decimal sign is a period (.)
             - No spaces are placed between digits (ie digits are not
               grouped in threes as they should be)
             - A leading minus (-) is added if the number is negative
         (b) Exponential notation (FORM=2):
             - The exponent is adjusted to put just one (non-zero)
               digit before the decimal sign
             - The mantissa is formatted as in (a), unless its value is
               1 in which case it and the multiplication sign are omitted
             - If the power of 10 is not zero and the mantissa is not
               zero, an exponent of the form \x10\u[-]nnn is appended,
               where \x is a multiplication sign (cross), \u is an escape
               sequence to raise the exponent, and as many digits nnn
               are used as needed
         (c) Automatic choice (FORM=0):
               Decimal notation is used if the absolute value of the
               number is less than 10000 or greater than or equal to
               0.01. Otherwise exponential notation is used.
      
       Arguments:
        MM     (input)
        PP     (input)  : the value to be formatted is MM*10**PP.
        FORM   (input)  : controls how the number is formatted:
                          FORM = 0 -- use either decimal or exponential
                          FORM = 1 -- use decimal notation
                          FORM = 2 -- use exponential notation
        STRING (output) : the formatted character string, left justified.
                          If the length of STRING is insufficient, a single
                          asterisk is returned, and NC=1.
        NC     (output) : the number of characters used in STRING:
                          the string to be printed is STRING(1:NC).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgnumb.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGNUMB -- convert a number into a plottable character string
C%void cpgnumb(int mm, int pp, int form, char *string, \
C% int *string_length);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgnumb( integer, integer, integer, character, integer )
*

C+
      SUBROUTINE PGNUMB (MM, PP, FORM, STRING, NC)
      INTEGER MM, PP, FORM
      CHARACTER*(*) STRING
      INTEGER NC
C
C This routine converts a number into a decimal character
C representation. To avoid problems of floating-point roundoff, the
C number must be provided as an integer (MM) multiplied by a power of 10
C (10**PP).  The output string retains only significant digits of MM,
C and will be in either integer format (123), decimal format (0.0123),
C or exponential format (1.23x10**5). Standard escape sequences \u, \d 
C raise the exponent and \x is used for the multiplication sign.
C This routine is used by PGBOX to create numeric labels for a plot.
C
C Formatting rules:
C   (a) Decimal notation (FORM=1):
C       - Trailing zeros to the right of the decimal sign are
C         omitted
C       - The decimal sign is omitted if there are no digits
C         to the right of it
C       - When the decimal sign is placed before the first digit
C         of the number, a zero is placed before the decimal sign
C       - The decimal sign is a period (.)
C       - No spaces are placed between digits (ie digits are not
C         grouped in threes as they should be)
C       - A leading minus (-) is added if the number is negative
C   (b) Exponential notation (FORM=2):
C       - The exponent is adjusted to put just one (non-zero)
C         digit before the decimal sign
C       - The mantissa is formatted as in (a), unless its value is
C         1 in which case it and the multiplication sign are omitted
C       - If the power of 10 is not zero and the mantissa is not
C         zero, an exponent of the form \x10\u[-]nnn is appended,
C         where \x is a multiplication sign (cross), \u is an escape
C         sequence to raise the exponent, and as many digits nnn
C         are used as needed
C   (c) Automatic choice (FORM=0):
C         Decimal notation is used if the absolute value of the
C         number is less than 10000 or greater than or equal to
C         0.01. Otherwise exponential notation is used.
C
C Arguments:
C  MM     (input)
C  PP     (input)  : the value to be formatted is MM*10**PP.
C  FORM   (input)  : controls how the number is formatted:
C                    FORM = 0 -- use either decimal or exponential
C                    FORM = 1 -- use decimal notation
C                    FORM = 2 -- use exponential notation
C  STRING (output) : the formatted character string, left justified.
C                    If the length of STRING is insufficient, a single
C                    asterisk is returned, and NC=1.
C  NC     (output) : the number of characters used in STRING:
C                    the string to be printed is STRING(1:NC).
C--
C 23-Nov-1983
C  9-Feb-1988 [TJP] - Use temporary variable to avoid illegal character
C                     assignments; remove non-standard DO loops.
C 15-Dec-1988 [TJP] - More corrections of the same sort.
C 27-Nov-1991 [TJP] - Change code for multiplication sign.
C 23-Jun-1994 [TJP] - Partial implementation of FORM=1 and 2.
C-----------------------------------------------------------------------
      CHARACTER*1 BSLASH
      CHARACTER*2 TIMES, UP, DOWN
      CHARACTER*20 WORK, WEXP, TEMP
      INTEGER M, P, ND, I, J, K, NBP
      LOGICAL MINUS
C
C Define backslash (escape) character and escape sequences.
C
      BSLASH = CHAR(92)
      TIMES  = BSLASH//'x'
      UP     = BSLASH//'u'
      DOWN   = BSLASH//'d'
C
C Zero is always printed as "0".
C
      IF (MM.EQ.0) THEN
          STRING = '0'
          NC = 1
          RETURN
      END IF
C
C If negative, make a note of that fact.
C
      MINUS = MM.LT.0
      M = ABS(MM)
      P = PP
C
C Convert M to a left-justified digit string in WORK. As M is a
C positive integer, it cannot use more than 10 digits (2147483647).
C
      J = 10
   10 IF (M.NE.0) THEN
          K = MOD(M,10)
          M = M/10
          WORK(J:J) = CHAR(ICHAR('0')+K)
          J = J-1
       GOTO 10
      END IF
      TEMP = WORK(J+1:)
      WORK = TEMP
      ND = 10-J
C
C Remove right-hand zeros, and increment P for each one removed.
C ND is the final number of significant digits in WORK, and P the
C power of 10 to be applied. Number of digits before decimal point
C is NBP.
C
   20 IF (WORK(ND:ND).EQ.'0') THEN
          ND = ND-1
          P = P+1
       GOTO 20
      END IF
      NBP = ND+MIN(P,0)
C
C Integral numbers of 4 or less digits are formatted as such.
C
      IF ((P.GE.0) .AND. ((FORM.EQ.0 .AND. P+ND.LE.4) .OR.
     :                    (FORM.EQ.1 .AND. P+ND.LE.10))) THEN
          DO 30 I=1,P
              ND = ND+1
              WORK(ND:ND) = '0'
   30     CONTINUE
          P = 0
C
C If NBP is 4 or less, simply insert a decimal point in the right place.
C
      ELSE IF (FORM.NE.2.AND.NBP.GE.1.AND.NBP.LE.4.AND.NBP.LT.ND) THEN
          TEMP = WORK(NBP+1:ND)
          WORK(NBP+2:ND+1) = TEMP
          WORK(NBP+1:NBP+1) = '.'
          ND = ND+1
          P = 0
C
C Otherwise insert a decimal point after the first digit, and adjust P.
C
      ELSE
          P = P + ND - 1
          IF (FORM.NE.2 .AND. P.EQ.-1) THEN
              TEMP = WORK
              WORK = '0'//TEMP
              ND = ND+1
              P = 0
          ELSE IF (FORM.NE.2 .AND. P.EQ.-2) THEN
              TEMP = WORK
              WORK = '00'//TEMP
              ND = ND+2
              P = 0
          END IF
          IF (ND.GT.1) THEN
              TEMP = WORK(2:ND)
              WORK(3:ND+1) = TEMP
              WORK(2:2) = '.'
              ND = ND + 1
          END IF
      END IF
C
C Add exponent if necessary.
C
      IF (P.NE.0) THEN
          WORK(ND+1:ND+6) = TIMES//'10'//UP
          ND = ND+6
          IF (P.LT.0) THEN
              P = -P
              ND = ND+1
              WORK(ND:ND) = '-'
          END IF
          J = 10
   40     IF (P.NE.0) THEN
              K = MOD(P,10)
              P = P/10
              WEXP(J:J) = CHAR(ICHAR('0')+K)
              J = J-1
           GOTO 40
          END IF
          WORK(ND+1:) = WEXP(J+1:10)
          ND = ND+10-J
          IF (WORK(1:3).EQ.'1'//TIMES) THEN
              TEMP = WORK(4:)
              WORK = TEMP
              ND = ND-3
          END IF
          WORK(ND+1:ND+2) = DOWN
          ND = ND+2
      END IF
C
C Add minus sign if necessary and move result to output.
C
      IF (MINUS) THEN
         TEMP = WORK(1:ND)
         STRING = '-'//TEMP
         NC = ND+1
      ELSE
         STRING = WORK(1:ND)
         NC = ND
      END IF
C
C Check result fits.
C
      IF (NC.GT.LEN(STRING)) THEN
          STRING = '*'
          NC = 1
      END IF
      END
#<

#>            pgolin.dc2
Name:         PGOLIN

Purpose:      mark a set of points using the cursor

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGOLIN (MAXPT, NPT, X, Y, SYMBOL)
            INTEGER MAXPT, NPT
            REAL    X(*), Y(*)
            INTEGER SYMBOL
      
       Interactive routine for user to enter data points by use of
       the cursor.  Routine allows user to Add and Delete points.  The
       points are returned in the order that they were entered (unlike
       PGNCUR).
      
       Arguments:
        MAXPT  (input)  : maximum number of points that may be accepted.
        NPT    (in/out) : number of points entered; should be zero on
                          first call.
        X      (in/out) : array of x-coordinates.
        Y      (in/out) : array of y-coordinates.
        SYMBOL (input)  : code number of symbol to use for marking
                          entered points (see PGPT).
      
       Note (1): The dimension of arrays X and Y must be greater than or
       equal to MAXPT.
      
       Note (2): On return from the program, cursor points are returned in
       the order they were entered. Routine may be (re-)called with points
       already defined in X,Y (number in NPT), and they will be plotted
       first, before editing.
      
       Note (3): User commands: the user types single-character commands
       after positioning the cursor: the following are accepted:
       A (Add)    - add point at current cursor location.
       D (Delete) - delete the last point entered.
       X (eXit)   - leave subroutine.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgolin.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGOLIN -- mark a set of points using the cursor
C%void cpgolin(int maxpt, int *npt, float *x, float *y, int symbol);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgolin( integer, integer, real, real, integer )
*

C+
      SUBROUTINE PGOLIN (MAXPT, NPT, X, Y, SYMBOL)
      INTEGER MAXPT, NPT
      REAL    X(*), Y(*)
      INTEGER SYMBOL
C
C Interactive routine for user to enter data points by use of
C the cursor.  Routine allows user to Add and Delete points.  The
C points are returned in the order that they were entered (unlike
C PGNCUR).
C
C Arguments:
C  MAXPT  (input)  : maximum number of points that may be accepted.
C  NPT    (in/out) : number of points entered; should be zero on
C                    first call.
C  X      (in/out) : array of x-coordinates.
C  Y      (in/out) : array of y-coordinates.
C  SYMBOL (input)  : code number of symbol to use for marking
C                    entered points (see PGPT).
C
C Note (1): The dimension of arrays X and Y must be greater than or
C equal to MAXPT.
C
C Note (2): On return from the program, cursor points are returned in
C the order they were entered. Routine may be (re-)called with points
C already defined in X,Y (number in NPT), and they will be plotted
C first, before editing.
C
C Note (3): User commands: the user types single-character commands
C after positioning the cursor: the following are accepted:
C A (Add)    - add point at current cursor location.
C D (Delete) - delete the last point entered.
C X (eXit)   - leave subroutine.
C--
C  4-Nov-1985 - new routine (adapted from PGNCUR) - TJP.
C 13-Dec-1990 - change warnings to messages [TJP].
C  7-Sep-1994 - use PGBAND [TJP].
C  2-Aug-1995 - remove dependence on common block [TJP].
C-----------------------------------------------------------------------
      LOGICAL  PGNOTO
      CHARACTER*1 LETTER
      INTEGER  PGBAND, SAVCOL
      REAL     XP, YP, XREF, YREF
      REAL     XBLC, XTRC, YBLC, YTRC
C
C Check that PGPLOT is in the correct state.
C
      IF (PGNOTO('PGOLIN')) RETURN
C
C Save current color.
C
      CALL GRQCI(SAVCOL)
C
C Put current points on screen.  Position cursor on last point,
C or in middle viewport if there are no current points.
C
      CALL PGQWIN(XBLC, XTRC, YBLC, YTRC)
      IF (NPT.NE.0) THEN
          CALL PGPT(NPT,X,Y,SYMBOL)
          XP = X(NPT)
          YP = Y(NPT)
      ELSE
          XP = 0.5*(XBLC+XTRC)
          YP = 0.5*(YBLC+YTRC)
      END IF
C
C Loop over cursor inputs.
C
  100 XREF = XP
      YREF = YP
      IF (PGBAND(0,1,XREF,YREF,XP,YP,LETTER).NE.1) RETURN
      IF (LETTER.EQ.CHAR(0)) RETURN
      CALL GRTOUP(LETTER,LETTER)
C
C A (ADD) command:
C
      IF (LETTER .EQ. 'A') THEN
          IF (NPT.GE.MAXPT) THEN
              CALL GRMSG('ADD ignored (too many points).')
          ELSE
              NPT = NPT + 1
              X(NPT) = XP
              Y(NPT) = YP
              CALL PGPT(1,X(NPT),Y(NPT),SYMBOL)
              CALL GRTERM
          END IF
C
C D (DELETE) command:
C
      ELSE IF (LETTER.EQ.'D') THEN
          IF (NPT.LE.0) THEN
              CALL GRMSG('DELETE ignored (there are no points left).')
          ELSE
              CALL GRSCI(0)
              CALL PGPT(1,X(NPT),Y(NPT),SYMBOL)
              XP = X(NPT)
              YP = Y(NPT)
              CALL GRSCI(SAVCOL)
              CALL GRTERM
              NPT = NPT-1
          END IF
C
C X (EXIT) command:
C
      ELSE IF (LETTER.EQ.'X') THEN
          CALL GRETXT
          RETURN
C
C Illegal command:
C
      ELSE
          CALL GRMSG('Commands are A (add), D (delete), X (exit).')
      END IF
C
      GOTO 100
      END
#<

#>            pgopen.dc2
Name:         PGOPEN

Purpose:      open a graphics device

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            INTEGER FUNCTION PGOPEN (DEVICE)
            CHARACTER*(*) DEVICE
      
       Open a graphics device for PGPLOT output. If the device is
       opened successfully, it becomes the selected device to which
       graphics output is directed until another device is selected
       with PGSLCT or the device is closed with PGCLOS.
      
       The value returned by PGOPEN should be tested to ensure that
       the device was opened successfully, e.g.,
      
             ISTAT = PGOPEN('LCPSFILE')
             IF (ISTAT .LE. 0 ) STOP
      
       Note that PGOPEN must be declared INTEGER in the calling program.
      
       The DEVICE argument is a character constant or variable, which must
       be a known GIPSY graphics device, i.e. it must be listed in
       $gip_loc/grdevices.

       [This routine was added to PGPLOT in Version 5.1.0. Older programs
       use PGBEG instead.]
      
       Returns:
        PGOPEN          : returns either a positive value, the
                          identifier of the graphics device for use with
                          PGSLCT, or a 0 or negative value indicating an
                          error. In the event of error a message is
                          written on the standard error unit.
       Arguments:
        DEVICE  (input) : the 'device specification' for the plot device
                          (see above).

Updates:      Oct 16, 1998: JPT extracted from source; modified for GIPSY.
              Dec  3, 1998: JPT call REJECT for invalid device input.
              Apr  7, 2000: JPT initialize image interpolation mode.
#<

#>            pgopen.f
* GIPSY-modified
*

C%int cpgopen(const char *device);
*
* GIPSY Fortran to C interface:
*
*@ integer function pgopen( character )
*

      INTEGER FUNCTION PGOPEN (DEVICE)
      CHARACTER*(*) DEVICE

C 22-Dec-1995 - new routine [TJP].
C 14-May-1996 - device '? ' should not give a blank prompt [TJP].
C 16-Oct-1998 - modified for use within GIPSY [JPT].

C-----------------------------------------------------------------------
      INCLUDE       'pgplot.inc'
      INTEGER       DEFTYP,GRDTYP,GROPEN,L,LR,IC1
      INTEGER       USERCHAR, NELC
      CHARACTER*29  INP(4)
      INTEGER       UNIT, ISTAT
      REAL          DUMMY,DUMMY2,XCSZ, XSZ, YSZ
      CHARACTER*20  DEFSTR
      CHARACTER*256 REQ
      LOGICAL JUNK
C
C Initialize PGPLOT if necessary.
C
      CALL PGINIT
C
C Open the plot file; default type is given by environment variable
C PGPLOT_TYPE.
C
      CALL GRGENV('TYPE', DEFSTR, L)
      IF (L.EQ.0) THEN
          DEFTYP = 0
      ELSE
          CALL GRTOUP(DEFSTR, DEFSTR)
          DEFTYP = GRDTYP(DEFSTR(1:L))
      END IF

      IF (DEVICE(1:1).EQ.'?') THEN
   10     LR = USERCHAR(INP,4,1,'GRDEVICE=',
     1         'Graphics device [list of all graphics devices]')
          REQ = INP(1)
          IF (LR.EQ.0) THEN
              CALL PGLDEV
              CALL CANCEL('GRDEVICE=')
              GOTO 10
          END IF
          DO 20 L=2, LR
              REQ=REQ(:NELC(REQ))//'/"'//INP(L)(:NELC(INP(L)))//'"'
   20     CONTINUE
         ISTAT = GROPEN(DEFTYP,UNIT,REQ,PGID)
         IF (ISTAT.NE.1) THEN
            CALL REJECT('GRDEVICE=', 'Invalid graphics device')
            GOTO 10
         END IF
      ELSE
          ISTAT = GROPEN(DEFTYP,UNIT,DEVICE,PGID)
      END IF
C
C Failed to open plot file?
C
      IF (ISTAT.NE.1) THEN
         PGOPEN = - 1
         RETURN
      END IF
C
C Success: determine device characteristics.
C
      IF (PGID.LT.0 .OR. PGID.GT.PGMAXD) CALL
     1       GRWARN('Something terribly wrong in PGOPEN')
      PGDEVS(PGID) = 1
      PGADVS(PGID) = 0
      PGPFIX(PGID) = .FALSE.
      CALL GRSIZE(PGID,XSZ,YSZ,DUMMY,DUMMY2,
     1            PGXPIN(PGID),PGYPIN(PGID))
      CALL GRCHSZ(PGID,XCSZ,DUMMY,PGXSP(PGID),PGYSP(PGID))
      PGROWS(PGID)= .TRUE.
      PGNX(PGID)  = 1
      PGNY(PGID)  = 1
      PGXSZ(PGID) = XSZ
      PGYSZ(PGID) = YSZ
      PGNXC(PGID) = 1
      PGNYC(PGID) = 1
      CALL GRQTYP(DEFSTR,JUNK)
C
C Set the prompt state to ON, so that terminal devices pause between
C pages; this can be changed with PGASK.
C
      CALL PGASK(.TRUE.)
C
C If environment variable PGPLOT_BUFFER is defined (any value),
C start buffering output.
C
      PGBLEV(PGID) = 0
      CALL GRGENV('BUFFER', DEFSTR, L)
      IF (L.GT.0) CALL PGBBUF
C
C Set background and foreground colors if requested.
C
      CALL GRGENV('BACKGROUND', DEFSTR, L)
      IF (L.GT.0) CALL PGSCRN(0, DEFSTR(1:L), IER)
      CALL GRGENV('FOREGROUND', DEFSTR, L)
      IF (L.GT.0) CALL PGSCRN(1, DEFSTR(1:L), IER)
C
C Set default attributes.
C
      CALL PGSCI(1)
      CALL PGSLS(1)
      CALL PGSLW(1)
      CALL PGSCH(1.0)
      CALL PGSCF(1)
      CALL PGSFS(1)
      CALL PGSAH(1, 45.0, 0.3)
      CALL PGSTBG(-1)
      CALL PGSHS(45.0, 1.0, 0.0)
      CALL PGSCLP(1)
      CALL PGSIMI(0)
C
C Set the default range of color indices available for images (16 to
C device maximum, if device maximum >= 16; otherwise not possible).
C Select linear transfer function.
C
      CALL GRQCOL(IC1, PGMXCI(PGID))
      PGMNCI(PGID) = 16
      IF (PGMXCI(PGID).LT.16) PGMXCI(PGID) = 0
      PGITF(PGID) = 0
C
C Set the default window (unit square).
C
      PGXBLC(PGID) = 0.0
      PGXTRC(PGID) = 1.0
      PGYBLC(PGID) = 0.0
      PGYTRC(PGID) = 1.0
C
C Set the default viewport.
C
      CALL PGVSTD
C
      PGOPEN = PGID
      RETURN
      END
#<

#>            pgopen.f.orig
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGOPEN -- open a graphics device
C%int cpgopen(const char *device);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ integer function pgopen( character )
*

C+
      INTEGER FUNCTION PGOPEN (DEVICE)
      CHARACTER*(*) DEVICE
C
C Open a graphics device for PGPLOT output. If the device is
C opened successfully, it becomes the selected device to which
C graphics output is directed until another device is selected
C with PGSLCT or the device is closed with PGCLOS.
C
C The value returned by PGOPEN should be tested to ensure that
C the device was opened successfully, e.g.,
C
C       ISTAT = PGOPEN('plot.ps/PS')
C       IF (ISTAT .LE. 0 ) STOP
C
C Note that PGOPEN must be declared INTEGER in the calling program.
C
C The DEVICE argument is a character constant or variable; its value
C should be one of the following:
C
C (1) A complete device specification of the form 'device/type' or
C     'file/type', where 'type' is one of the allowed PGPLOT device
C     types (installation-dependent) and 'device' or 'file' is the 
C     name of a graphics device or disk file appropriate for this type.
C     The 'device' or 'file' may contain '/' characters; the final
C     '/' delimits the 'type'. If necessary to avoid ambiguity,
C     the 'device' part of the string may be enclosed in double
C     quotation marks.
C (2) A device specification of the form '/type', where 'type' is one
C     of the allowed PGPLOT device types. PGPLOT supplies a default
C     file or device name appropriate for this device type.
C (3) A device specification with '/type' omitted; in this case
C     the type is taken from the environment variable PGPLOT_TYPE,
C     if defined (e.g., setenv PGPLOT_TYPE PS). Because of possible
C     confusion with '/' in file-names, omitting the device type
C     in this way is not recommended.
C (4) A blank string (' '); in this case, PGOPEN will use the value
C     of environment variable PGPLOT_DEV as the device specification,
C     or '/NULL' if the environment variable is undefined.
C (5) A single question mark, with optional trailing spaces ('?'); in
C     this case, PGPLOT will prompt the user to supply the device
C     specification, with a prompt string of the form
C         'Graphics device/type (? to see list, default XXX):'
C     where 'XXX' is the default (value of environment variable
C     PGPLOT_DEV).
C (6) A non-blank string in which the first character is a question
C     mark (e.g., '?Device: '); in this case, PGPLOT will prompt the
C     user to supply the device specification, using the supplied
C     string as the prompt (without the leading question mark but
C     including any trailing spaces).
C
C In cases (5) and (6), the device specification is read from the
C standard input. The user should respond to the prompt with a device
C specification of the form (1), (2), or (3). If the user types a 
C question-mark in response to the prompt, a list of available device
C types is displayed and the prompt is re-issued. If the user supplies
C an invalid device specification, the prompt is re-issued. If the user
C responds with an end-of-file character, e.g., ctrl-D in UNIX, program
C execution is aborted; this  avoids the possibility of an infinite
C prompting loop.  A programmer should avoid use of PGPLOT-prompting
C if this behavior is not desirable.
C
C The device type is case-insensitive (e.g., '/ps' and '/PS' are 
C equivalent). The device or file name may be case-sensitive in some
C operating systems.
C
C Examples of valid DEVICE arguments:
C
C (1)  'plot.ps/ps', 'dir/plot.ps/ps', '"dir/plot.ps"/ps', 
C      'user:[tjp.plots]plot.ps/PS'
C (2)  '/ps'      (PGPLOT interprets this as 'pgplot.ps/ps')
C (3)  'plot.ps'  (if PGPLOT_TYPE is defined as 'ps', PGPLOT
C                  interprets this as 'plot.ps/ps')
C (4)  '   '      (if PGPLOT_DEV is defined)
C (5)  '?  '
C (6)  '?Device specification for PGPLOT: '
C
C [This routine was added to PGPLOT in Version 5.1.0. Older programs
C use PGBEG instead.]
C
C Returns:
C  PGOPEN          : returns either a positive value, the
C                    identifier of the graphics device for use with
C                    PGSLCT, or a 0 or negative value indicating an
C                    error. In the event of error a message is
C                    written on the standard error unit.
C Arguments:
C  DEVICE  (input) : the 'device specification' for the plot device
C                    (see above).
C--
C 22-Dec-1995 - new routine [TJP].
C 14-May-1996 - device '? ' should not give a blank prompt [TJP].
C-----------------------------------------------------------------------
      INCLUDE       'pgplot.inc'
      INTEGER       DEFTYP,GRDTYP,GROPEN,L,LR,IC1, LPROMP
      INTEGER       GRGCOM, IER, LDEFDE, UNIT, ISTAT
      REAL          DUMMY,DUMMY2,XCSZ, XSZ, YSZ
      CHARACTER*128 DEFDEV, PROMPT
      CHARACTER*20  DEFSTR
      CHARACTER*256 REQ
      LOGICAL JUNK
C
C Initialize PGPLOT if necessary.
C
      CALL PGINIT
C
C Get the default device/type (environment variable PGPLOT_DEV).
C
      CALL GRGENV('DEV', DEFDEV, LDEFDE)
      IF (LDEFDE.EQ.0) THEN
         DEFDEV = '/NULL'
         LDEFDE = 5
      END IF
C
C Open the plot file; default type is given by environment variable
C PGPLOT_TYPE.
C
      CALL GRGENV('TYPE', DEFSTR, L)
      IF (L.EQ.0) THEN
          DEFTYP = 0
      ELSE
          CALL GRTOUP(DEFSTR, DEFSTR)
          DEFTYP = GRDTYP(DEFSTR(1:L))
      END IF
      IF (DEVICE.EQ.' ') THEN
C        -- Blank device string: use default device and type.
         ISTAT = GROPEN(DEFTYP,UNIT,DEFDEV(1:LDEFDE),PGID)
      ELSE IF (DEVICE(1:1).EQ.'?') THEN
         IF (DEVICE.EQ.'?') THEN
C           -- Device string is a ingle question mark: prompt user
C           -- for device/type
            PROMPT = 'Graphics device/type (? to see list, default '
     :           //DEFDEV(1:LDEFDE)//'): '
            LPROMP = LDEFDE + 48
         ELSE
C           -- Device string starts with a question mark: use it
C           -- as a prompt
            PROMPT = DEVICE(2:)
            LPROMP = LEN(DEVICE)-1
         END IF
   10    IER = GRGCOM(REQ, PROMPT(1:LPROMP), LR)
         IF (IER.NE.1) THEN
            CALL GRWARN('Error reading device specification')
            PGOPEN = -1
            RETURN
         END IF
         IF (LR.LT.1 .OR. REQ.EQ.' ') THEN
            REQ = DEFDEV(1:LDEFDE)
         ELSE IF (REQ(1:1).EQ.'?') THEN
            CALL PGLDEV
            GOTO 10
         END IF
         ISTAT = GROPEN(DEFTYP,UNIT,REQ,PGID)
         IF (ISTAT.NE.1) GOTO 10
      ELSE
          ISTAT = GROPEN(DEFTYP,UNIT,DEVICE,PGID)
      END IF
C
C Failed to open plot file?
C
      IF (ISTAT.NE.1) THEN
         PGOPEN = - 1
         RETURN
      END IF
C
C Success: determine device characteristics.
C
      IF (PGID.LT.0 .OR. PGID.GT.PGMAXD) CALL
     1       GRWARN('Something terribly wrong in PGOPEN')
      PGDEVS(PGID) = 1
      PGADVS(PGID) = 0
      PGPFIX(PGID) = .FALSE.
      CALL GRSIZE(PGID,XSZ,YSZ,DUMMY,DUMMY2,
     1            PGXPIN(PGID),PGYPIN(PGID))
      CALL GRCHSZ(PGID,XCSZ,DUMMY,PGXSP(PGID),PGYSP(PGID))
      PGROWS(PGID)= .TRUE.
      PGNX(PGID)  = 1
      PGNY(PGID)  = 1
      PGXSZ(PGID) = XSZ
      PGYSZ(PGID) = YSZ
      PGNXC(PGID) = 1
      PGNYC(PGID) = 1
      CALL GRQTYP(DEFSTR,JUNK)
C
C Set the prompt state to ON, so that terminal devices pause between
C pages; this can be changed with PGASK.
C
      CALL PGASK(.TRUE.)
C
C If environment variable PGPLOT_BUFFER is defined (any value),
C start buffering output.
C
      PGBLEV(PGID) = 0
      CALL GRGENV('BUFFER', DEFSTR, L)
      IF (L.GT.0) CALL PGBBUF
C
C Set background and foreground colors if requested.
C
      CALL GRGENV('BACKGROUND', DEFSTR, L)
      IF (L.GT.0) CALL PGSCRN(0, DEFSTR(1:L), IER)
      CALL GRGENV('FOREGROUND', DEFSTR, L)
      IF (L.GT.0) CALL PGSCRN(1, DEFSTR(1:L), IER)
C
C Set default attributes.
C
      CALL PGSCI(1)
      CALL PGSLS(1)
      CALL PGSLW(1)
      CALL PGSCH(1.0)
      CALL PGSCF(1)
      CALL PGSFS(1)
      CALL PGSAH(1, 45.0, 0.3)
      CALL PGSTBG(-1)
      CALL PGSHS(45.0, 1.0, 0.0)
      CALL PGSCLP(1)
C
C Set the default range of color indices available for images (16 to
C device maximum, if device maximum >= 16; otherwise not possible).
C Select linear transfer function.
C
      CALL GRQCOL(IC1, PGMXCI(PGID))
      PGMNCI(PGID) = 16
      IF (PGMXCI(PGID).LT.16) PGMXCI(PGID) = 0
      PGITF(PGID) = 0
C
C Set the default window (unit square).
C
      PGXBLC(PGID) = 0.0
      PGXTRC(PGID) = 1.0
      PGYBLC(PGID) = 0.0
      PGYTRC(PGID) = 1.0
C
C Set the default viewport.
C
      CALL PGVSTD
C
      PGOPEN = PGID
      RETURN
      END
#<

#>            pgpage.dc2
Name:         PGPAGE

Purpose:      advance to new page

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGPAGE
      
       Advance plotter to a new page or panel, clearing the screen if
       necessary. If the "prompt state" is ON (see PGASK), confirmation is
       requested from the user before clearing the screen. If the view
       surface has been subdivided into panels with PGBEG or PGSUBP, then
       PGPAGE advances to the next panel, and if the current panel is the
       last on the page, PGPAGE clears the screen or starts a new sheet of
       paper.  PGPAGE does not change the PGPLOT window or the viewport
       (in normalized device coordinates); but note that if the size of the
       view-surface is changed externally (e.g., by a workstation window
       manager) the size of the viewport is changed in proportion.
      
       Arguments: none

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgpage.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGPAGE -- advance to new page
C%void cpgpage(void);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgpage(  )
*

C+
      SUBROUTINE PGPAGE
C
C Advance plotter to a new page or panel, clearing the screen if
C necessary. If the "prompt state" is ON (see PGASK), confirmation is
C requested from the user before clearing the screen. If the view
C surface has been subdivided into panels with PGBEG or PGSUBP, then
C PGPAGE advances to the next panel, and if the current panel is the
C last on the page, PGPAGE clears the screen or starts a new sheet of
C paper.  PGPAGE does not change the PGPLOT window or the viewport
C (in normalized device coordinates); but note that if the size of the
C view-surface is changed externally (e.g., by a workstation window
C manager) the size of the viewport is changed in proportion.
C
C Arguments: none
C--
C  7-Feb-1983
C 23-Sep-1984 - correct bug: call GRTERM at end (if flush mode set).
C 31-Jan-1985 - make closer to Fortran-77.
C 19-Nov-1987 - explicitly clear the screen if device is interactive;
C               this restores the behavior obtained with older versions
C               of GRPCKG.
C  9-Feb-1988 - move prompting into routine GRPROM.
C 11-Apr-1989 - change name to PGPAGE.
C 10-Sep-1990 - add identification labelling.
C 11-Feb-1992 - check if device size has changed.
C  3-Sep-1992 - allow column ordering of panels.
C 17-Nov-1994 - move identification to drivers.
C 23-Nov-1994 - fix bug: character size not getting reset.
C 23-Jan-1995 - rescale viewport if size of view surface  has changed.
C  4-Feb-1997 - bug fix; character size was not correctly indexed by
C               device ID.
C-----------------------------------------------------------------------
      INCLUDE      'pgplot.inc'
      CHARACTER*16 STR
      LOGICAL      INTER, PGNOTO
      REAL DUM1, DUM2, XS, YS, XVP1, XVP2, YVP1, YVP2
C
      IF (PGNOTO('PGPAGE')) RETURN
C
      IF (PGROWS(PGID)) THEN
        PGNXC(PGID) = PGNXC(PGID) + 1
        IF (PGNXC(PGID).GT.PGNX(PGID)) THEN
          PGNXC(PGID) = 1
          PGNYC(PGID) = PGNYC(PGID) + 1
          IF (PGNYC(PGID).GT.PGNY(PGID)) PGNYC(PGID) = 1
        END IF
      ELSE
        PGNYC(PGID) = PGNYC(PGID) + 1
        IF (PGNYC(PGID).GT.PGNY(PGID)) THEN
          PGNYC(PGID) = 1
          PGNXC(PGID) = PGNXC(PGID) + 1
          IF (PGNXC(PGID).GT.PGNX(PGID)) PGNXC(PGID) = 1
        END IF
      END IF
      IF (PGNXC(PGID).EQ.1 .AND. PGNYC(PGID).EQ.1) THEN
          IF (PGADVS(PGID).EQ.1 .AND. PGPRMP(PGID)) THEN
              CALL GRTERM
              CALL GRPROM
          END IF
          CALL GRPAGE
          IF (.NOT.PGPFIX(PGID)) THEN
C             -- Get current viewport in NDC.
              CALL PGQVP(0, XVP1, XVP2, YVP1, YVP2)
C             -- Reset view surface size if it has changed
              CALL GRSIZE(PGID, XS,YS, DUM1,DUM2,
     1                    PGXPIN(PGID), PGYPIN(PGID))
              PGXSZ(PGID) = XS/PGNX(PGID)
              PGYSZ(PGID) = YS/PGNY(PGID)
C             -- and character size
              CALL PGSCH(PGCHSZ(PGID))
C             -- and viewport
              CALL PGSVP(XVP1, XVP2, YVP1, YVP2)
          END IF
C
C If the device is interactive, call GRBPIC to clear the page.
C (If the device is not interactive, GRBPIC will be called
C automatically before the first output; omitting the call here
C ensures that a blank page is not output.)
C
          CALL GRQTYP(STR,INTER)
          IF (INTER) CALL GRBPIC
      END IF
      PGXOFF(PGID) = PGXVP(PGID) + (PGNXC(PGID)-1)*PGXSZ(PGID)
      PGYOFF(PGID) = PGYVP(PGID) + 
     1               (PGNY(PGID)-PGNYC(PGID))*PGYSZ(PGID)
C
C Window the plot in the new viewport.
C
      CALL PGVW
      PGADVS(PGID) = 1
      CALL GRTERM
      END
#<

#>            pgpanl.dc2
Name:         PGPANL

Purpose:      switch to a different panel on the view surface

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGPANL(IX, IY)
            INTEGER IX, IY
      
       Start plotting in a different panel. If the view surface has been
       divided into panels by PGBEG or PGSUBP, this routine can be used to
       move to a different panel. Note that PGPLOT does not remember what
       viewport and window were in use in each panel; these should be reset
       if necessary after calling PGPANL. Nor does PGPLOT clear the panel:
       call PGERAS after calling PGPANL to do this.
      
       Arguments:
        IX     (input)  : the horizontal index of the panel (in the range
                          1 <= IX <= number of panels in horizontal
                          direction).
        IY     (input)  : the vertical index of the panel (in the range
                          1 <= IY <= number of panels in horizontal
                          direction).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgpanl.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGPANL -- switch to a different panel on the view surface
C%void cpgpanl(int nxc, int nyc);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgpanl( integer, integer )
*

C+
      SUBROUTINE PGPANL(IX, IY)
      INTEGER IX, IY
C
C Start plotting in a different panel. If the view surface has been
C divided into panels by PGBEG or PGSUBP, this routine can be used to
C move to a different panel. Note that PGPLOT does not remember what
C viewport and window were in use in each panel; these should be reset
C if necessary after calling PGPANL. Nor does PGPLOT clear the panel:
C call PGERAS after calling PGPANL to do this.
C
C Arguments:
C  IX     (input)  : the horizontal index of the panel (in the range
C                    1 <= IX <= number of panels in horizontal
C                    direction).
C  IY     (input)  : the vertical index of the panel (in the range
C                    1 <= IY <= number of panels in horizontal
C                    direction).
C--
C  1-Dec-1994 - new routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE      'pgplot.inc'
      LOGICAL PGNOTO
C
C Check that a device is open.
C
      IF (PGNOTO('PGPANL')) RETURN
C
C Check arguments.
C
      IF (IX.LT.1 .OR. IX.GT.PGNX(PGID) .OR.
     :    IY.LT.1 .OR. IY.GT.PGNY(PGID)) THEN
         CALL GRWARN('PGPANL: the requested panel does not exist')
C
C Adjust the viewport to the new panel and window the plot
C in the new viewport.
C
      ELSE
         PGNXC(PGID)  = IX
         PGNYC(PGID)  = IY
         PGXOFF(PGID) = PGXVP(PGID) + (IX-1)*PGXSZ(PGID)
         PGYOFF(PGID) = PGYVP(PGID) + (PGNY(PGID)-IY)*PGYSZ(PGID)
         CALL PGVW
      END IF
C
      END
#<

#>            pgpap.dc2
Name:         PGPAP

Purpose:      change the size of the view surface 

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGPAP (WIDTH, ASPECT)
            REAL WIDTH, ASPECT
      
       This routine changes the size of the view surface ("paper size") to a
       specified width and aspect ratio (height/width), in so far as this is
       possible on the specific device. It is always possible to obtain a
       view surface smaller than the default size; on some devices (e.g.,
       printers that print on roll or fan-feed paper) it is possible to 
       obtain a view surface larger than the default.
       
       This routine should be called either immediately after PGBEG or
       immediately before PGPAGE. The new size applies to all subsequent
       images until the next call to PGPAP.
      
       Arguments:
        WIDTH  (input)  : the requested width of the view surface in inches;
                          if WIDTH=0.0, PGPAP will obtain the largest view
                          surface available consistent with argument ASPECT.
                          (1 inch = 25.4 mm.)
        ASPECT (input)  : the aspect ratio (height/width) of the view
                          surface; e.g., ASPECT=1.0 gives a square view
                          surface, ASPECT=0.618 gives a horizontal
                          rectangle, ASPECT=1.618 gives a vertical rectangle.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgpap.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGPAP -- change the size of the view surface 
C%void cpgpap(float width, float aspect);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgpap( real, real )
*

C+
      SUBROUTINE PGPAP (WIDTH, ASPECT)
      REAL WIDTH, ASPECT
C
C This routine changes the size of the view surface ("paper size") to a
C specified width and aspect ratio (height/width), in so far as this is
C possible on the specific device. It is always possible to obtain a
C view surface smaller than the default size; on some devices (e.g.,
C printers that print on roll or fan-feed paper) it is possible to 
C obtain a view surface larger than the default.
C 
C This routine should be called either immediately after PGBEG or
C immediately before PGPAGE. The new size applies to all subsequent
C images until the next call to PGPAP.
C
C Arguments:
C  WIDTH  (input)  : the requested width of the view surface in inches;
C                    if WIDTH=0.0, PGPAP will obtain the largest view
C                    surface available consistent with argument ASPECT.
C                    (1 inch = 25.4 mm.)
C  ASPECT (input)  : the aspect ratio (height/width) of the view
C                    surface; e.g., ASPECT=1.0 gives a square view
C                    surface, ASPECT=0.618 gives a horizontal
C                    rectangle, ASPECT=1.618 gives a vertical rectangle.
C--
C (22-Apr-1983; bug fixed 7-Jun-1988)
C  6-Oct-1990 Modified to work correctly on interactive devices.
C 13-Dec-1990 Make errors non-fatal [TJP].
C 14-Sep-1994 Fix bug to do with drivers changing view surface size.
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
      LOGICAL  PGNOTO
      REAL     HDEF, HMAX, HREQ, WDEF, WMAX, WREQ
      REAL     XSMAX, YSMAX, XSZ, YSZ
C
      IF (PGNOTO('PGPAP'))  RETURN
      IF (WIDTH.LT.0.0 .OR. ASPECT.LE.0.0) THEN
          CALL GRWARN('PGPAP ignored: invalid arguments')
          RETURN
      END IF
C
      PGPFIX(PGID) = .TRUE.
C     -- Find default size WDEF, HDEF and maximum size WMAX, HMAX
C        of view surface (inches)
      CALL GRSIZE(PGID,XSZ,YSZ,XSMAX,YSMAX,
     1            PGXPIN(PGID),PGYPIN(PGID))
      WDEF = XSZ/PGXPIN(PGID)
      HDEF = YSZ/PGYPIN(PGID)
      WMAX = XSMAX/PGXPIN(PGID)
      HMAX = YSMAX/PGYPIN(PGID)
C     -- Find desired size WREQ, HREQ of view surface (inches)
      IF (WIDTH.NE.0.0) THEN
          WREQ = WIDTH
          HREQ = WIDTH*ASPECT
      ELSE
          WREQ = WDEF
          HREQ = WDEF*ASPECT
          IF (HREQ.GT.HDEF) THEN
              WREQ = HDEF/ASPECT
              HREQ = HDEF
          END IF
      END IF
C     -- Scale the requested view surface to fit the maximum
C        dimensions
      IF (WMAX.GT.0.0 .AND. WREQ.GT.WMAX) THEN
          WREQ = WMAX
          HREQ = WMAX*ASPECT
      END IF
      IF (HMAX.GT.0.0 .AND. HREQ.GT.HMAX) THEN
          WREQ = HMAX/ASPECT
          HREQ = HMAX
      END IF
C     -- Establish the new view surface dimensions
      XSZ = WREQ*PGXPIN(PGID)
      YSZ = HREQ*PGYPIN(PGID)
      CALL GRSETS(PGID,XSZ,YSZ)
      PGXSZ(PGID) = XSZ/PGNX(PGID)
      PGYSZ(PGID) = YSZ/PGNY(PGID)
      PGNXC(PGID) = PGNX(PGID)
      PGNYC(PGID) = PGNY(PGID)
      CALL PGSCH(1.0)
      CALL PGVSTD
      END
#<

#>            pgpaper.dc2
Name:         PGPAPER

Purpose:      non-standard alias for PGPAP

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGPAPER (WIDTH, ASPECT)
            REAL WIDTH, ASPECT
      
       See description of PGPAP.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgpaper.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGPAPER -- non-standard alias for PGPAP
C+
      SUBROUTINE PGPAPER (WIDTH, ASPECT)
      REAL WIDTH, ASPECT
C
C See description of PGPAP.
C--
      CALL PGPAP (WIDTH, ASPECT)
      END
#<

#>            pgpat.dc2
Function:     PGPAT

Purpose:      Set line style according to input pattern.

Category:     GRAPHICS

File:         pgplot.src

Author:       M.G.R. Vogelaar

Use:          CALL PGPAT( PAT )     Input     REAL ARRAY

              PAT   The line-style pattern for subsequent plotting
                    (8 floating point numbers).

Description:  Set the line style for subsequent plotting. This
              attribute affects line primitives only; it does not affect
              graph markers, text, or area fill.
              The array PAT contains 8 reals. The pattern is set by
              each pair of two numbers. The first number in a pair sets
              the number of dots that must be plotted and the second
              number sets the number of dots that must be skipped.

              Known patterns:
              dashed: PAT = 10.0 10.0 10.0 10.0 10.0 10.0 10.0 10.0 
              dot-dash-dot-dash: PAT = 8.0 6.0 1.0 6.0 8.0 6.0 1.0 6.0
              dotted: PAT = 1.0 6.0 1.0 6.0  1.0 6.0 1.0 6.0
              dash-dot-dot-dot: PAT = 8.0 6.0 1.0 6.0 1.0 6.0 1.0 6.0

Updates:      Apr 10, 1995: VOG Document created.
#<

#>            pgpat.f
* GIPSY-private
*

C pgpat.f
C
C	Copyright (c) Kapteyn Laboratorium Groningen 1995
C	All Rights Reserved.
C
C
C Fortran to C interface:
C
C@ subroutine pgpat( real )
C
C*PGPAT -- set line style according to pattern
C+
      SUBROUTINE PGPAT (PAT)
      REAL PAT(8)
C
C
C Argument:
C
C PAT (input, real(8)): the line-style pattern 
C--
C-----------------------------------------------------------------------
      INCLUDE 'grpckg1.inc'
      INTEGER L, NBUF,LCHR
      REAL    RBUF(6),TMP
      CHARACTER*10 CHR
C
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRSLS - no graphics device is active.')
          RETURN
      END IF
C
C Set up for software dash.
C
      GRDASH(GRCIDE) = .TRUE.
      GRIPAT(GRCIDE) = 1
      GRPOFF(GRCIDE) = 0.0
      CALL GREXEC(GRGTYP, 6,RBUF,NBUF,CHR,LCHR)
      TMP=RBUF(4)/1000.
      DO 10 L=1,8
          GRPATN(GRCIDE,L) = PAT(L)*TMP
   10 CONTINUE
      END

#<

#>            pgpixl.dc2
Name:         PGPIXL

Purpose:      draw pixels

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGPIXL (IA, IDIM, JDIM, I1, I2, J1, J2, 
           1                   X1, X2, Y1, Y2)
            INTEGER IDIM, JDIM, I1, I2, J1, J2
            INTEGER IA(IDIM,JDIM)
            REAL    X1, X2, Y1, Y2
      
       Draw lots of solid-filled (tiny) rectangles aligned with the
       coordinate axes. Best performance is achieved when output is
       directed to a pixel-oriented device and the rectangles coincide
       with the pixels on the device. In other cases, pixel output is
       emulated.
      
       The subsection of the array IA defined by indices (I1:I2, J1:J2)
       is mapped onto world-coordinate rectangle defined by X1, X2, Y1
       and Y2. This rectangle is divided into (I2 - I1 + 1) * (J2 - J1 + 1)
       small rectangles. Each of these small rectangles is solid-filled
       with the color index specified by the corresponding element of 
       IA.
      
       On most devices, the output region is "opaque", i.e., it obscures
       all graphical elements previously drawn in the region. But on
       devices that do not have erase capability, the background shade
       is "transparent" and allows previously-drawn graphics to show
       through.
      
       Arguments:
        IA     (input)  : the array to be plotted.
        IDIM   (input)  : the first dimension of array A.
        JDIM   (input)  : the second dimension of array A.
        I1, I2 (input)  : the inclusive range of the first index
                          (I) to be plotted.
        J1, J2 (input)  : the inclusive range of the second
                          index (J) to be plotted.
        X1, Y1 (input)  : world coordinates of one corner of the output
                          region
        X2, Y2 (input)  : world coordinates of the opposite corner of the
                          output region

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgpixl.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGPIXL -- draw pixels
C%void cpgpixl(const int *ia, int idim, int jdim, int i1, int i2, \
C% int j1, int j2, float x1, float x2, float y1, float y2);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgpixl( integer, integer, integer, integer, integer, integer, integer, real, real, real, real )
*

C+
      SUBROUTINE PGPIXL (IA, IDIM, JDIM, I1, I2, J1, J2, 
     1                   X1, X2, Y1, Y2)
      INTEGER IDIM, JDIM, I1, I2, J1, J2
      INTEGER IA(IDIM,JDIM)
      REAL    X1, X2, Y1, Y2
C
C Draw lots of solid-filled (tiny) rectangles aligned with the
C coordinate axes. Best performance is achieved when output is
C directed to a pixel-oriented device and the rectangles coincide
C with the pixels on the device. In other cases, pixel output is
C emulated.
C
C The subsection of the array IA defined by indices (I1:I2, J1:J2)
C is mapped onto world-coordinate rectangle defined by X1, X2, Y1
C and Y2. This rectangle is divided into (I2 - I1 + 1) * (J2 - J1 + 1)
C small rectangles. Each of these small rectangles is solid-filled
C with the color index specified by the corresponding element of 
C IA.
C
C On most devices, the output region is "opaque", i.e., it obscures
C all graphical elements previously drawn in the region. But on
C devices that do not have erase capability, the background shade
C is "transparent" and allows previously-drawn graphics to show
C through.
C
C Arguments:
C  IA     (input)  : the array to be plotted.
C  IDIM   (input)  : the first dimension of array A.
C  JDIM   (input)  : the second dimension of array A.
C  I1, I2 (input)  : the inclusive range of the first index
C                    (I) to be plotted.
C  J1, J2 (input)  : the inclusive range of the second
C                    index (J) to be plotted.
C  X1, Y1 (input)  : world coordinates of one corner of the output
C                    region
C  X2, Y2 (input)  : world coordinates of the opposite corner of the
C                    output region
C--
C 16-Jan-1991 - [GvG]
C-----------------------------------------------------------------------
      LOGICAL PGNOTO
C
C Check inputs.
C
      IF (PGNOTO('PGPIXL')) RETURN
      IF (I1.LT.1 .OR. I2.GT.IDIM .OR. I1.GT.I2 .OR.
     1    J1.LT.1 .OR. J2.GT.JDIM .OR. J1.GT.J2) THEN
         CALL GRWARN('PGPIXL: invalid range I1:I2, J1:J2')
      ELSE
C
C Call lower-level routine to do the work.
C
         CALL PGBBUF
         CALL GRPIXL(IA, IDIM, JDIM, I1, I2, J1, J2, X1, X2, Y1, Y2)
         CALL PGEBUF
      END IF
C-----------------------------------------------------------------------
      END
#<

#>            pgplot.dc3
Source:       PGPLOT

Purpose:      GIPSY version of PGPLOT

Category:     GRAPHICS

File:         pgplot.src

Author:       J. P. Terlouw

Use:          The PGPLOT routines with a dc2 document may be called
              by an application program (see pg*.dc2).
              All other routines are called by these PGPLOT routines
              and are of no interest for the application programmer.

              For a complete installation of PGPLOT in GIPSY it is
              necessary to install pgdriv.src also. This contains
              all drivers which are site specific (see pgdriv.dc3).

              The PGPLOT fonts are installed at the GIPSY installation
              and are stored in $gip_lib/grfont.dat by $gip_sys/pgpack.f.

Description:  Some PGPLOT routines were modified for use within GIPSY.
              For the application programmer the following changes may
              be of interest.
               
              PGBEG    -   device name must be a GIPSY device name.
              PGOPEN   -   device name must be a GIPSY device name.

              Extra routines:

              GGIXOR   -   non-destructive drawing for Ggi plot fields.
              PGCOLIM  -   color image with user supplied look up table.
              PGCOTIC  -   contour map, with blanking and ticks.
              PGGRAY1  -   temporary alternative for PGGRAY.
              PGGRAY2  -   gray-scale map with user supplied levels.
              PGPAT    -   set line style according to input pattern.
              PGSNCR   -   modify range of color indices.
              PGSBCI   -   set color index to be used for BLANK.
              PGQBCI   -   query color index to be used for BLANK.

              All modified routines have the text "GIPSY-modified" in
              the first line of the source, added routines have the
              text "GIPSY-private". The original source code of
              modified routines is kept in files with extension '.orig'.

              The subroutines PGCONX, PGFUNT, PGFUNX and PGFUNY are only
              callable from Fortran, not from C, because one or two
              arguments are external functions, a feature not supported
              by our f2cvv interface.

              The source contains the following maintenance utilities:
              allincludes.pl -- create the all-encompassing pgplot.h file.
              togipsy.pl     -- useful for installing new PGPLOT versions.
              Makefile.uti   -- makefile for packing the source.

Updates:      Oct 10, 1991: WZ  Document created.
              Nov  9, 1998: JPT Complete new installation of version 5.2.0.
              Dec  3, 1998: JPT Removed obsolete routines, fixed PGOPEN bug.
              Sep  3, 1999: JPT Added PGSNCR.
              Sep 30, 1999: JPT Added PGSBCI and PGQBCI.
              Mar  7, 2000: JPT Modified PGLINE for skipping BLANKs.
              Apr 18, 2000: JPT Implemented interpolating PGIMAG
#<

#>            pgplot.h
/* pgplot.h */
#if !defined(_pgplot_h_)
#define _pgplot_h_
extern bool ggixor_c(bool *);
extern void pgarro_c(float *,float *,float *,float *);
extern void pgask_c(bool *);
extern void pgaxis_c(fchar,float *,float *,float *,float *,float *,float *,float *,fint *,float *,float *,float *,float *,float *);
extern fint pgband_c(fint *,fint *,float *,float *,float *,float *,fchar);
extern void pgbbuf_c(void);
extern fint pgbeg_c(fint *,fchar,fint *,fint *);
extern void pgbin_c(fint *,float *,float *,bool *);
extern void pgbox_c(fchar,float *,fint *,fchar,float *,fint *);
extern void pgcirc_c(float *,float *,float *);
extern void pgclos_c(void);
extern void pgconb_c(float *,fint *,fint *,fint *,fint *,fint *,fint *,float *,fint *,float *,float *);
extern void pgconf_c(float *,fint *,fint *,fint *,fint *,fint *,fint *,float *,float *,float *);
extern void pgconl_c(float *,fint *,fint *,fint *,fint *,fint *,fint *,float *,float *,fchar,fint *,fint *);
extern void pgcons_c(float *,fint *,fint *,fint *,fint *,fint *,fint *,float *,fint *,float *);
extern void pgcont_c(float *,fint *,fint *,fint *,fint *,fint *,fint *,float *,fint *,float *);
extern void pgcotic_c(float *,fint *,fint *,fint *,fint *,fint *,fint *,float *,fint *,float *,float *,float *,fint *);
extern void pgctab_c(float *,float *,float *,float *,fint *,float *,float *);
extern fint pgcurs_c(float *,float *,fchar);
extern void pgdraw_c(float *,float *);
extern void pgebuf_c(void);
extern void pgend_c(void);
extern void pgenv_c(float *,float *,float *,float *,fint *,fint *);
extern void pgeras_c(void);
extern void pgerr1_c(fint *,float *,float *,float *,float *);
extern void pgerrb_c(fint *,fint *,float *,float *,float *,float *);
extern void pgerrx_c(fint *,float *,float *,float *,float *);
extern void pgerry_c(fint *,float *,float *,float *,float *);
extern void pgetxt_c(void);
extern fint pgexist_c(fint *);
extern void pggray_c(float *,fint *,fint *,fint *,fint *,fint *,fint *,float *,float *,float *);
extern void pghi2d_c(float *,fint *,fint *,fint *,fint *,fint *,fint *,float *,fint *,float *,bool *,float *);
extern void pghist_c(fint *,float *,float *,float *,fint *,fint *);
extern void pgiden_c(void);
extern void pgimag_c(float *,fint *,fint *,fint *,fint *,fint *,fint *,float *,float *,float *);
extern void pglab_c(fchar,fchar,fchar);
extern void pglcur_c(fint *,fint *,float *,float *);
extern void pgldev_c(void);
extern void pglen_c(fint *,fchar,float *,float *);
extern void pgline_c(fint *,float *,float *);
extern void pgmove_c(float *,float *);
extern void pgmtxt_c(fchar,float *,float *,float *,fchar);
extern void pgncur_c(fint *,fint *,float *,float *,fint *);
extern void pgnumb_c(fint *,fint *,fint *,fchar,fint *);
extern void pgolin_c(fint *,fint *,float *,float *,fint *);
extern fint pgopen_c(fchar);
extern void pgpage_c(void);
extern void pgpanl_c(fint *,fint *);
extern void pgpap_c(float *,float *);
extern void pgpat_c(float *);
extern void pgpixl_c(fint *,fint *,fint *,fint *,fint *,fint *,fint *,float *,float *,float *,float *);
extern void pgpnts_c(fint *,float *,float *,fint *,fint *);
extern void pgpoly_c(fint *,float *,float *);
extern void pgpt_c(fint *,float *,float *,fint *);
extern void pgpt1_c(float *,float *,fint *);
extern void pgptxt_c(float *,float *,float *,float *,fchar);
extern void pgqah_c(fint *,float *,float *);
extern void pgqbci_c(fint *);
extern void pgqcf_c(fint *);
extern void pgqch_c(float *);
extern void pgqci_c(fint *);
extern void pgqcir_c(fint *,fint *);
extern void pgqclp_c(fint *);
extern void pgqcol_c(fint *,fint *);
extern void pgqcr_c(fint *,float *,float *,float *);
extern void pgqcs_c(fint *,float *,float *);
extern void pgqdt_c(fint *,fchar,fint *,fchar,fint *,fint *);
extern void pgqfs_c(fint *);
extern void pgqhs_c(float *,float *);
extern void pgqid_c(fint *);
extern void pgqimi_c(fint *);
extern void pgqinf_c(fchar,fchar,fint *);
extern void pgqitf_c(fint *);
extern void pgqls_c(fint *);
extern void pgqlw_c(fint *);
extern void pgqndt_c(fint *);
extern void pgqpos_c(float *,float *);
extern void pgqtbg_c(fint *);
extern void pgqtxt_c(float *,float *,float *,float *,fchar,float *,float *);
extern void pgqvp_c(fint *,float *,float *,float *,float *);
extern void pgqvsz_c(fint *,float *,float *,float *,float *);
extern void pgqwin_c(float *,float *,float *,float *);
extern void pgrect_c(float *,float *,float *,float *);
extern float pgrnd_c(float *,fint *);
extern void pgrnge_c(float *,float *,float *,float *);
extern void pgsah_c(fint *,float *,float *);
extern void pgsave_c(void);
extern void pgsbci_c(fint *);
extern void pgscf_c(fint *);
extern void pgsch_c(float *);
extern void pgsci_c(fint *);
extern void pgscir_c(fint *,fint *);
extern void pgsclp_c(fint *);
extern void pgscr_c(fint *,float *,float *,float *);
extern void pgscrl_c(float *,float *);
extern void pgscrn_c(fint *,fchar,fint *);
extern void pgsfs_c(fint *);
extern void pgshls_c(fint *,float *,float *,float *);
extern void pgshs_c(float *,float *,float *);
extern void pgsimi_c(fint *);
extern void pgsitf_c(fint *);
extern void pgslct_c(fint *);
extern void pgsls_c(fint *);
extern void pgslw_c(fint *);
extern void pgsncr_c(fint *,float *,float *,float *,fint *);
extern void pgstbg_c(fint *);
extern void pgsubp_c(fint *,fint *);
extern void pgsvp_c(float *,float *,float *,float *);
extern void pgswin_c(float *,float *,float *,float *);
extern void pgtbox_c(fchar,float *,fint *,fchar,float *,fint *);
extern void pgtext_c(float *,float *,fchar);
extern void pgtick_c(float *,float *,float *,float *,float *,float *,float *,float *,float *,fchar);
extern void pgunsa_c(void);
extern void pgupdt_c(void);
extern void pgvect_c(float *,float *,fint *,fint *,fint *,fint *,fint *,fint *,float *,fint *,float *,float *);
extern void pgvsiz_c(float *,float *,float *,float *);
extern void pgvstd_c(void);
extern void pgwedg_c(fchar,float *,float *,float *,float *,fchar);
extern void pgwnad_c(float *,float *,float *,float *);
#endif
#<

#>            pgplot.inc
* GIPSY-modified
*

C-----------------------------------------------------------------------
C PGPLOT: common block definition.
C-----------------------------------------------------------------------
C Maximum number of concurrent devices (should match GRIMAX).
C-----------------------------------------------------------------------
      INTEGER PGMAXD
      PARAMETER (PGMAXD=16)
C-----------------------------------------------------------------------
C Indentifier of currently selected device.
C-----------------------------------------------------------------------
      INTEGER PGID
C-----------------------------------------------------------------------
C Device status (indexed by device identifier).
C-----------------------------------------------------------------------
C PGDEVS  =0 if device is not open; 1 if device is open.
C PGADVS  Set to 0 by PGBEGIN, set to 1 by PGPAGE; used to suppress
C         the prompt for the first page.
C PROMPT  If .TRUE., ask user before clearing page; set by PGASK
C         and (indirectly) by PGBEGIN, used in PGENV.
C PGBLEV  Buffering level: incremented by PGBBUF, decremented by
C         PGEBUF.
C PGPFIX  TRUE if PGPAP has been called, FALSE otherwise.
C
      INTEGER PGDEVS(PGMAXD), PGADVS(PGMAXD), PGBLEV(PGMAXD)
      LOGICAL PGPRMP(PGMAXD), PGPFIX(PGMAXD)
C-----------------------------------------------------------------------
C Panel parameters (indexed by device identification).
C-----------------------------------------------------------------------
C NX      Number of panels in x direction
C NY      Number of panels in y direction
C NXC     Ordinal number of current X panel
C NYC     Ordinal number of current Y panel
C XSZ     X dimension of panel (device units)
C YSZ     Y dimension of panel (device units)
C PGROWS  TRUE if panels are used in row order, FALSE for column
C         order.
C
      INTEGER PGNX  (PGMAXD), PGNY  (PGMAXD)
      INTEGER PGNXC (PGMAXD), PGNYC (PGMAXD)
      REAL    PGXSZ (PGMAXD), PGYSZ (PGMAXD)
      LOGICAL PGROWS(PGMAXD)
C-----------------------------------------------------------------------
C Attributes (indexed by device identification).
C-----------------------------------------------------------------------
C PGCLP   clipping enabled/disabed
C PGFAS   fill-area style
C PGCHSZ  character height
C PGAHS   arrow-head fill style
C PGAHA   arrow-head angle
C PGAHV   arrow-head vent
C PGTBCI  text background color index
C PGMNCI  lower range of color indices available to PGGRAY/PGIMAG
C PGMXCI  upper range of color indices available to PGGRAY/PGIMAG
C PGITF   type of transfer function used by PGGRAY/PGIMAG
C PGHSA   hatching line angle
C PGHSS   hatching line separation
C PGHSP   hatching line phase
C PGLLEN  label length for y-title (GIPSY - used by pgbox and pglab)
C
      INTEGER PGCLP (PGMAXD)
      INTEGER PGFAS (PGMAXD)
      REAL    PGCHSZ(PGMAXD)
      INTEGER PGAHS (PGMAXD)
      REAL    PGAHA (PGMAXD)
      REAL    PGAHV (PGMAXD)
      INTEGER PGTBCI(PGMAXD)
      INTEGER PGMNCI(PGMAXD)
      INTEGER PGMXCI(PGMAXD)
      INTEGER PGITF (PGMAXD)
      REAL    PGHSA (PGMAXD)
      REAL    PGHSS (PGMAXD)
      REAL    PGHSP (PGMAXD)
      REAL    PGLLEN(PGMAXD)
C-----------------------------------------------------------------------
C Viewport parameters (indexed by device identification); all are device
C coordinates:
C-----------------------------------------------------------------------
C PGXOFF  X coordinate of blc of viewport.
C PGYOFF  Y coordinate of blc of viewport.
C PGXVP   X coordinate of blc of viewport, relative to blc of subpage.
C PGYVP   Y coordinate of blc of viewport, relative to blc of subpage.
C PGXLEN  Width of viewport. 
C PGYLEN  Height of viewport.
C
      REAL   PGXOFF(PGMAXD), PGYOFF(PGMAXD)
      REAL   PGXVP (PGMAXD), PGYVP (PGMAXD)
      REAL   PGXLEN(PGMAXD), PGYLEN(PGMAXD)
C-----------------------------------------------------------------------
C Scaling parameters (indexed by device identification):
C-----------------------------------------------------------------------
C PGXORG  device coordinate value corresponding to world X=0
C PGYORG  device coordinate value corresponding to world Y=0
C PGXSCL  scale in x (device units per world coordinate unit)
C PGYSCL  scale in y (device units per world coordinate unit)
C PGXPIN  device x scale in device units/inch
C PGYPIN  device y scale in device units/inch
C PGXSP   Character X spacing (device units)
C PGYSP   Character Y spacing (device units)
C
      REAL   PGXORG(PGMAXD), PGYORG(PGMAXD)
      REAL   PGXSCL(PGMAXD), PGYSCL(PGMAXD)
      REAL   PGXPIN(PGMAXD), PGYPIN(PGMAXD)
      REAL   PGXSP (PGMAXD), PGYSP (PGMAXD)
C-----------------------------------------------------------------------
C Window parameters (indexed by device identification); all are world
C coordinate values:
C-----------------------------------------------------------------------
C PGXBLC  world X at bottom left corner of window
C PGXTRC  world X at top right corner of window
C PGYBLC  world Y at bottom left corner of window
C PGYTRC  world Y at top right corner of window
C
      REAL    PGXBLC(PGMAXD), PGXTRC(PGMAXD)
      REAL    PGYBLC(PGMAXD), PGYTRC(PGMAXD)
C-----------------------------------------------------------------------
C The following parameters are used in the contouring routines to pass
C information to the action routine. They do not need to be indexed.
C-----------------------------------------------------------------------
C TRANS   Transformation matrix for contour plots; copied
C         from argument list by PGCONT and used by PGCP.
C
      INTEGER PGCINT, PGCMIN
      REAL    TRANS(6)
      CHARACTER*32 PGCLAB
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
      COMMON  /PGPLT1/ PGID,PGDEVS,PGADVS,PGNX,  PGNY,  PGNXC, PGNYC ,
     1        PGXPIN,PGYPIN,PGXSP, PGYSP, PGXSZ, PGYSZ,
     2        PGXOFF,PGYOFF,PGXVP, PGYVP, PGXLEN,PGYLEN,PGXORG,PGYORG,
     3        PGXSCL,PGYSCL,PGXBLC,PGXTRC,PGYBLC,PGYTRC,TRANS,
     4        PGPRMP,PGCLP, PGFAS, PGCHSZ,PGBLEV,PGROWS,
     5        PGAHS, PGAHA, PGAHV, PGTBCI,PGMNCI,PGMXCI,PGCINT,PGCMIN,
     6        PGPFIX,PGITF, PGHSA, PGHSS, PGHSP, PGLLEN
      COMMON  /PGPLT2/ PGCLAB
      SAVE    /PGPLT1/
      SAVE    /PGPLT2/
C-----------------------------------------------------------------------
#<

#>            pgplot.inc.orig
C-----------------------------------------------------------------------
C PGPLOT: common block definition.
C-----------------------------------------------------------------------
C Maximum number of concurrent devices (should match GRIMAX).
C-----------------------------------------------------------------------
      INTEGER PGMAXD
      PARAMETER (PGMAXD=8)
C-----------------------------------------------------------------------
C Indentifier of currently selected device.
C-----------------------------------------------------------------------
      INTEGER PGID
C-----------------------------------------------------------------------
C Device status (indexed by device identifier).
C-----------------------------------------------------------------------
C PGDEVS  =0 if device is not open; 1 if device is open.
C PGADVS  Set to 0 by PGBEGIN, set to 1 by PGPAGE; used to suppress
C         the prompt for the first page.
C PROMPT  If .TRUE., ask user before clearing page; set by PGASK
C         and (indirectly) by PGBEGIN, used in PGENV.
C PGBLEV  Buffering level: incremented by PGBBUF, decremented by
C         PGEBUF.
C PGPFIX  TRUE if PGPAP has been called, FALSE otherwise.
C
      INTEGER PGDEVS(PGMAXD), PGADVS(PGMAXD), PGBLEV(PGMAXD)
      LOGICAL PGPRMP(PGMAXD), PGPFIX(PGMAXD)
C-----------------------------------------------------------------------
C Panel parameters (indexed by device identification).
C-----------------------------------------------------------------------
C NX      Number of panels in x direction
C NY      Number of panels in y direction
C NXC     Ordinal number of current X panel
C NYC     Ordinal number of current Y panel
C XSZ     X dimension of panel (device units)
C YSZ     Y dimension of panel (device units)
C PGROWS  TRUE if panels are used in row order, FALSE for column
C         order.
C
      INTEGER PGNX  (PGMAXD), PGNY  (PGMAXD)
      INTEGER PGNXC (PGMAXD), PGNYC (PGMAXD)
      REAL    PGXSZ (PGMAXD), PGYSZ (PGMAXD)
      LOGICAL PGROWS(PGMAXD)
C-----------------------------------------------------------------------
C Attributes (indexed by device identification).
C-----------------------------------------------------------------------
C PGCLP   clipping enabled/disabed
C PGFAS   fill-area style
C PGCHSZ  character height
C PGAHS   arrow-head fill style
C PGAHA   arrow-head angle
C PGAHV   arrow-head vent
C PGTBCI  text background color index
C PGMNCI  lower range of color indices available to PGGRAY/PGIMAG
C PGMXCI  upper range of color indices available to PGGRAY/PGIMAG
C PGITF   type of transfer function used by PGGRAY/PGIMAG
C PGHSA   hatching line angle
C PGHSS   hatching line separation
C PGHSP   hatching line phase
C
      INTEGER PGCLP (PGMAXD)
      INTEGER PGFAS (PGMAXD)
      REAL    PGCHSZ(PGMAXD)
      INTEGER PGAHS (PGMAXD)
      REAL    PGAHA (PGMAXD)
      REAL    PGAHV (PGMAXD)
      INTEGER PGTBCI(PGMAXD)
      INTEGER PGMNCI(PGMAXD)
      INTEGER PGMXCI(PGMAXD)
      INTEGER PGITF (PGMAXD)
      REAL    PGHSA (PGMAXD)
      REAL    PGHSS (PGMAXD)
      REAL    PGHSP (PGMAXD)
C-----------------------------------------------------------------------
C Viewport parameters (indexed by device identification); all are device
C coordinates:
C-----------------------------------------------------------------------
C PGXOFF  X coordinate of blc of viewport.
C PGYOFF  Y coordinate of blc of viewport.
C PGXVP   X coordinate of blc of viewport, relative to blc of subpage.
C PGYVP   Y coordinate of blc of viewport, relative to blc of subpage.
C PGXLEN  Width of viewport. 
C PGYLEN  Height of viewport.
C
      REAL   PGXOFF(PGMAXD), PGYOFF(PGMAXD)
      REAL   PGXVP (PGMAXD), PGYVP (PGMAXD)
      REAL   PGXLEN(PGMAXD), PGYLEN(PGMAXD)
C-----------------------------------------------------------------------
C Scaling parameters (indexed by device identification):
C-----------------------------------------------------------------------
C PGXORG  device coordinate value corresponding to world X=0
C PGYORG  device coordinate value corresponding to world Y=0
C PGXSCL  scale in x (device units per world coordinate unit)
C PGYSCL  scale in y (device units per world coordinate unit)
C PGXPIN  device x scale in device units/inch
C PGYPIN  device y scale in device units/inch
C PGXSP   Character X spacing (device units)
C PGYSP   Character Y spacing (device units)
C
      REAL   PGXORG(PGMAXD), PGYORG(PGMAXD)
      REAL   PGXSCL(PGMAXD), PGYSCL(PGMAXD)
      REAL   PGXPIN(PGMAXD), PGYPIN(PGMAXD)
      REAL   PGXSP (PGMAXD), PGYSP (PGMAXD)
C-----------------------------------------------------------------------
C Window parameters (indexed by device identification); all are world
C coordinate values:
C-----------------------------------------------------------------------
C PGXBLC  world X at bottom left corner of window
C PGXTRC  world X at top right corner of window
C PGYBLC  world Y at bottom left corner of window
C PGYTRC  world Y at top right corner of window
C
      REAL    PGXBLC(PGMAXD), PGXTRC(PGMAXD)
      REAL    PGYBLC(PGMAXD), PGYTRC(PGMAXD)
C-----------------------------------------------------------------------
C The following parameters are used in the contouring routines to pass
C information to the action routine. They do not need to be indexed.
C-----------------------------------------------------------------------
C TRANS   Transformation matrix for contour plots; copied
C         from argument list by PGCONT and used by PGCP.
C
      INTEGER PGCINT, PGCMIN
      REAL    TRANS(6)
      CHARACTER*32 PGCLAB
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
      COMMON  /PGPLT1/ PGID,PGDEVS,PGADVS,PGNX,  PGNY,  PGNXC, PGNYC ,
     1        PGXPIN,PGYPIN,PGXSP, PGYSP, PGXSZ, PGYSZ,
     2        PGXOFF,PGYOFF,PGXVP, PGYVP, PGXLEN,PGYLEN,PGXORG,PGYORG,
     3        PGXSCL,PGYSCL,PGXBLC,PGXTRC,PGYBLC,PGYTRC,TRANS,
     4        PGPRMP,PGCLP, PGFAS, PGCHSZ,PGBLEV,PGROWS,
     5        PGAHS, PGAHA, PGAHV, PGTBCI,PGMNCI,PGMXCI,PGCINT,PGCMIN,
     6        PGPFIX,PGITF, PGHSA, PGHSS, PGHSP
      COMMON  /PGPLT2/ PGCLAB
      SAVE    /PGPLT1/
      SAVE    /PGPLT2/
C-----------------------------------------------------------------------
#<

#>            pgpnts.dc2
Name:         PGPNTS

Purpose:      draw several graph markers, not all the same

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGPNTS (N, X, Y, SYMBOL, NS)
            INTEGER N, NS
            REAL X(*), Y(*)
            INTEGER SYMBOL(*)
      
       Draw Graph Markers. Unlike PGPT, this routine can draw a different
       symbol at each point. The markers are drawn using the current values
       of attributes color-index, line-width, and character-height
       (character-font applies if the symbol number is >31).  If the point
       to be marked lies outside the window, no marker is drawn.  The "pen 
       position" is changed to (XPTS(N),YPTS(N)) in world coordinates
       (if N > 0).
      
       Arguments:
        N      (input)  : number of points to mark.
        X      (input)  : world x-coordinate of the points.
        Y      (input)  : world y-coordinate of the points.
        SYMBOL (input)  : code number of the symbol to be plotted at each
                          point (see PGPT).
        NS     (input)  : number of values in the SYMBOL array.  If NS <= N,
                          then the first NS points are drawn using the value
                          of SYMBOL(I) at (X(I), Y(I)) and SYMBOL(1) for all
                          the values of (X(I), Y(I)) where I > NS.
      
       Note: the dimension of arrays X and Y must be greater than or equal
       to N and the dimension of the array SYMBOL must be greater than or
       equal to NS.  If N is 1, X and Y may be scalars (constants or
       variables).  If NS is 1, then SYMBOL may be a scalar.  If N is
       less than 1, nothing is drawn.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgpnts.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGPNTS -- draw several graph markers, not all the same
C%void cpgpnts(int n, const float *x, const float *y, \
C% const int *symbol, int ns);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgpnts( integer, real, real, integer, integer )
*

C+
      SUBROUTINE PGPNTS (N, X, Y, SYMBOL, NS)
      INTEGER N, NS
      REAL X(*), Y(*)
      INTEGER SYMBOL(*)
C
C Draw Graph Markers. Unlike PGPT, this routine can draw a different
C symbol at each point. The markers are drawn using the current values
C of attributes color-index, line-width, and character-height
C (character-font applies if the symbol number is >31).  If the point
C to be marked lies outside the window, no marker is drawn.  The "pen 
C position" is changed to (XPTS(N),YPTS(N)) in world coordinates
C (if N > 0).
C
C Arguments:
C  N      (input)  : number of points to mark.
C  X      (input)  : world x-coordinate of the points.
C  Y      (input)  : world y-coordinate of the points.
C  SYMBOL (input)  : code number of the symbol to be plotted at each
C                    point (see PGPT).
C  NS     (input)  : number of values in the SYMBOL array.  If NS <= N,
C                    then the first NS points are drawn using the value
C                    of SYMBOL(I) at (X(I), Y(I)) and SYMBOL(1) for all
C                    the values of (X(I), Y(I)) where I > NS.
C
C Note: the dimension of arrays X and Y must be greater than or equal
C to N and the dimension of the array SYMBOL must be greater than or
C equal to NS.  If N is 1, X and Y may be scalars (constants or
C variables).  If NS is 1, then SYMBOL may be a scalar.  If N is
C less than 1, nothing is drawn.
C--
C 11-Mar-1991 - new routine [JM].
C 26-Feb-1997 - revised to use PGPT1 [TJP].
C-----------------------------------------------------------------------
      INTEGER I, SYMB
C
      IF (N.LT.1) RETURN
      CALL PGBBUF
      DO 10 I=1,N
          IF (I .LE. NS) THEN
              SYMB = SYMBOL(I)
          ELSE
              SYMB = SYMBOL(1)
          END IF
          CALL PGPT1(X(I), Y(I), SYMB)
   10 CONTINUE
      CALL PGEBUF
      END
#<

#>            pgpoint.dc2
Name:         PGPOINT

Purpose:      non-standard alias for PGPT

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGPOINT (N, XPTS, YPTS, SYMBOL)
            INTEGER N
            REAL XPTS(*), YPTS(*)
            INTEGER SYMBOL
      
       See description of PGPT.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgpoint.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGPOINT -- non-standard alias for PGPT
C+
      SUBROUTINE PGPOINT (N, XPTS, YPTS, SYMBOL)
      INTEGER N
      REAL XPTS(*), YPTS(*)
      INTEGER SYMBOL
C
C See description of PGPT.
C--
      CALL PGPT (N, XPTS, YPTS, SYMBOL)
      END
#<

#>            pgpoly.dc2
Name:         PGPOLY

Purpose:      draw a polygon, using fill-area attributes

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGPOLY (N, XPTS, YPTS)
            INTEGER N
            REAL XPTS(*), YPTS(*)
      
       Fill-area primitive routine: shade the interior of a closed
       polygon in the current window.  The action of this routine depends
       on the setting of the Fill-Area Style attribute (see PGSFS).
       The polygon is clipped at the edge of the
       window. The pen position is changed to (XPTS(1),YPTS(1)) in world
       coordinates (if N > 1).  If the polygon is not convex, a point is
       assumed to lie inside the polygon if a straight line drawn to
       infinity intersects and odd number of the polygon's edges.
      
       Arguments:
        N      (input)  : number of points defining the polygon; the
                          line consists of N straight-line segments,
                          joining points 1 to 2, 2 to 3,... N-1 to N, N to 1.
                          N should be greater than 2 (if it is 2 or less,
                          nothing will be drawn).
        XPTS   (input)  : world x-coordinates of the vertices.
        YPTS   (input)  : world y-coordinates of the vertices.
                          Note: the dimension of arrays XPTS and YPTS must be
                          greater than or equal to N.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgpoly.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGPOLY -- draw a polygon, using fill-area attributes
C%void cpgpoly(int n, const float *xpts, const float *ypts);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgpoly( integer, real, real )
*

C+
      SUBROUTINE PGPOLY (N, XPTS, YPTS)
      INTEGER N
      REAL XPTS(*), YPTS(*)
C
C Fill-area primitive routine: shade the interior of a closed
C polygon in the current window.  The action of this routine depends
C on the setting of the Fill-Area Style attribute (see PGSFS).
C The polygon is clipped at the edge of the
C window. The pen position is changed to (XPTS(1),YPTS(1)) in world
C coordinates (if N > 1).  If the polygon is not convex, a point is
C assumed to lie inside the polygon if a straight line drawn to
C infinity intersects and odd number of the polygon's edges.
C
C Arguments:
C  N      (input)  : number of points defining the polygon; the
C                    line consists of N straight-line segments,
C                    joining points 1 to 2, 2 to 3,... N-1 to N, N to 1.
C                    N should be greater than 2 (if it is 2 or less,
C                    nothing will be drawn).
C  XPTS   (input)  : world x-coordinates of the vertices.
C  YPTS   (input)  : world y-coordinates of the vertices.
C                    Note: the dimension of arrays XPTS and YPTS must be
C                    greater than or equal to N.
C--
C 21-Nov-1983 - [TJP].
C 16-Jul-1984 - revised to shade polygon with GRFA [TJP].
C 21-Oct-1985 - test PGFAS [TJP].
C 25-Nov-1994 - implement clipping [TJP].
C 13-Jan-1994 - fix bug in clipping [TJP].
C  6-Mar-1995 - add support for fill styles 3 and 4 [TJP].
C 12-Sep-1995 - fix another bug in clipping [TJP].
C-----------------------------------------------------------------------
      INTEGER MAXOUT
      PARAMETER (MAXOUT=1000)
      LOGICAL CLIP
      INTEGER I, N1, N2, N3, N4
      REAL    QX(MAXOUT), QY(MAXOUT), RX(MAXOUT), RY(MAXOUT)
      REAL    XL, XH, YL, YH
      LOGICAL PGNOTO
      INCLUDE 'pgplot.inc'
C
      IF (PGNOTO('PGPOLY')) RETURN
      IF (N.LT.1) RETURN
C
C Outline style, or polygon of less than 3 vertices.
C
      IF (PGFAS(PGID).EQ.2 .OR. N.LT.3) THEN
         CALL PGBBUF
         CALL GRMOVA(XPTS(N),YPTS(N))
         DO 10 I=1,N
            CALL GRLINA(XPTS(I),YPTS(I))
 10      CONTINUE
C
C Hatched style.
C
      ELSE IF (PGFAS(PGID).EQ.3) THEN
         CALL PGBBUF
         CALL PGHTCH(N, XPTS, YPTS, 0.0)
      ELSE IF (PGFAS(PGID).EQ.4) THEN
         CALL PGBBUF
         CALL PGHTCH(N, XPTS, YPTS, 0.0)
         CALL PGHTCH(N, XPTS, YPTS, 90.0)
      ELSE
C     
C Test whether polygon lies completely in the window.
C     
         CLIP = .FALSE.
         XL = MIN(PGXBLC(PGID),PGXTRC(PGID))
         XH = MAX(PGXBLC(PGID),PGXTRC(PGID))
         YL = MIN(PGYBLC(PGID),PGYTRC(PGID))
         YH = MAX(PGYBLC(PGID),PGYTRC(PGID))
         DO 20 I=1,N
            IF (XPTS(I).LT.XL .OR. XPTS(I).GT.XH .OR.
     :           YPTS(I).LT.YL .OR. YPTS(I).GT.YH) THEN
               CLIP = .TRUE.
               GOTO 30
            END IF
 20      CONTINUE
 30      CONTINUE
C     
C Filled style, no clipping required.
C     
         CALL PGBBUF
         IF (.NOT.CLIP) THEN
            CALL GRFA(N,XPTS,YPTS)
C     
C Filled style, clipping required: the vertices of the clipped
C polygon are put in temporary arrays QX,QY, RX, RY.
C     
         ELSE
            CALL GRPOCL(N,  XPTS, YPTS, 1, XL, MAXOUT, N1, QX, QY)
            IF (N1.GT.MAXOUT) GOTO 40
            IF (N1.LT.3) GOTO 50
            CALL GRPOCL(N1, QX,   QY,   2, XH, MAXOUT, N2, RX, RY)
            IF (N2.GT.MAXOUT) GOTO 40
            IF (N2.LT.3) GOTO 50
            CALL GRPOCL(N2, RX,   RY,   3, YL, MAXOUT, N3, QX, QY)
            IF (N3.GT.MAXOUT) GOTO 40
            IF (N3.LT.3) GOTO 50
            CALL GRPOCL(N3, QX,   QY,   4, YH, MAXOUT, N4, RX, RY)
            IF (N4.GT.MAXOUT) GOTO 40
            IF (N4.GT.0) CALL GRFA(N4,RX,RY)
            GOTO 50
 40         CALL GRWARN('PGPOLY: polygon is too complex')
 50         CONTINUE
         END IF
      END IF
C
C Set the current pen position.
C
      CALL GRMOVA(XPTS(1),YPTS(1))
      CALL PGEBUF
C
      END
#<

#>            pgpt.dc2
Name:         PGPT

Purpose:      draw several graph markers

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGPT (N, XPTS, YPTS, SYMBOL)
            INTEGER N
            REAL XPTS(*), YPTS(*)
            INTEGER SYMBOL
      
       Primitive routine to draw Graph Markers (polymarker). The markers
       are drawn using the current values of attributes color-index,
       line-width, and character-height (character-font applies if the symbol
       number is >31).  If the point to be marked lies outside the window,
       no marker is drawn.  The "pen position" is changed to
       (XPTS(N),YPTS(N)) in world coordinates (if N > 0).
      
       Arguments:
        N      (input)  : number of points to mark.
        XPTS   (input)  : world x-coordinates of the points.
        YPTS   (input)  : world y-coordinates of the points.
        SYMBOL (input)  : code number of the symbol to be drawn at each 
                          point:
                          -1, -2  : a single dot (diameter = current
                                    line width).
                          -3..-31 : a regular polygon with ABS(SYMBOL)
                                    edges (style set by current fill style).
                          0..31   : standard marker symbols.
                          32..127 : ASCII characters (in current font).
                                    e.g. to use letter F as a marker, let
                                    SYMBOL = ICHAR('F'). 
                          > 127  :  a Hershey symbol number.
      
       Note: the dimension of arrays X and Y must be greater than or equal
       to N. If N is 1, X and Y may be scalars (constants or variables). If
       N is less than 1, nothing is drawn.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgpt.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGPT -- draw several graph markers
C%void cpgpt(int n, const float *xpts, const float *ypts, int symbol);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgpt( integer, real, real, integer )
*

C+
      SUBROUTINE PGPT (N, XPTS, YPTS, SYMBOL)
      INTEGER N
      REAL XPTS(*), YPTS(*)
      INTEGER SYMBOL
C
C Primitive routine to draw Graph Markers (polymarker). The markers
C are drawn using the current values of attributes color-index,
C line-width, and character-height (character-font applies if the symbol
C number is >31).  If the point to be marked lies outside the window,
C no marker is drawn.  The "pen position" is changed to
C (XPTS(N),YPTS(N)) in world coordinates (if N > 0).
C
C Arguments:
C  N      (input)  : number of points to mark.
C  XPTS   (input)  : world x-coordinates of the points.
C  YPTS   (input)  : world y-coordinates of the points.
C  SYMBOL (input)  : code number of the symbol to be drawn at each 
C                    point:
C                    -1, -2  : a single dot (diameter = current
C                              line width).
C                    -3..-31 : a regular polygon with ABS(SYMBOL)
C                              edges (style set by current fill style).
C                    0..31   : standard marker symbols.
C                    32..127 : ASCII characters (in current font).
C                              e.g. to use letter F as a marker, let
C                              SYMBOL = ICHAR('F'). 
C                    > 127  :  a Hershey symbol number.
C
C Note: the dimension of arrays X and Y must be greater than or equal
C to N. If N is 1, X and Y may be scalars (constants or variables). If
C N is less than 1, nothing is drawn.
C--
C 27-Nov-1986
C 17-Dec-1990 - add polygons [PAH].
C 14-Mar-1997 - optimization: use GRDOT1 [TJP].
C-----------------------------------------------------------------------
      LOGICAL PGNOTO
C
      IF (N.LT.1) RETURN
      IF (PGNOTO('PGPT')) RETURN
C
      CALL PGBBUF
      IF (SYMBOL.GE.0 .OR. SYMBOL.LE.-3) THEN
          CALL GRMKER(SYMBOL,.FALSE.,N,XPTS,YPTS)
      ELSE
          CALL GRDOT1(N,XPTS,YPTS)
      END IF
      CALL PGEBUF
      END
#<

#>            pgpt1.dc2
Name:         PGPT1

Purpose:      draw one graph marker

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGPT1 (XPT, YPT, SYMBOL)
            REAL XPT, YPT
            INTEGER SYMBOL
      
       Primitive routine to draw a single Graph Marker at a specified point.
       The marker is drawn using the current values of attributes
       color-index, line-width, and character-height (character-font applies
       if the symbol number is >31).  If the point to be marked lies outside
       the window, no marker is drawn.  The "pen position" is changed to
       (XPT,YPT) in world coordinates.
      
       To draw several markers with coordinates specified by X and Y
       arrays, use routine PGPT.
      
       Arguments:
        XPT    (input)  : world x-coordinate of the point.
        YPT    (input)  : world y-coordinate of the point.
        SYMBOL (input)  : code number of the symbol to be drawn:
                          -1, -2  : a single dot (diameter = current
                                    line width).
                          -3..-31 : a regular polygon with ABS(SYMBOL)
                                    edges (style set by current fill style).
                          0..31   : standard marker symbols.
                          32..127 : ASCII characters (in current font).
                                    e.g. to use letter F as a marker, let
                                    SYMBOL = ICHAR('F'). 
                          > 127  :  a Hershey symbol number.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgpt1.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGPT1 -- draw one graph marker
C%void cpgpt1(float xpt, float ypt, int symbol);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgpt1( real, real, integer )
*

C+
      SUBROUTINE PGPT1 (XPT, YPT, SYMBOL)
      REAL XPT, YPT
      INTEGER SYMBOL
C
C Primitive routine to draw a single Graph Marker at a specified point.
C The marker is drawn using the current values of attributes
C color-index, line-width, and character-height (character-font applies
C if the symbol number is >31).  If the point to be marked lies outside
C the window, no marker is drawn.  The "pen position" is changed to
C (XPT,YPT) in world coordinates.
C
C To draw several markers with coordinates specified by X and Y
C arrays, use routine PGPT.
C
C Arguments:
C  XPT    (input)  : world x-coordinate of the point.
C  YPT    (input)  : world y-coordinate of the point.
C  SYMBOL (input)  : code number of the symbol to be drawn:
C                    -1, -2  : a single dot (diameter = current
C                              line width).
C                    -3..-31 : a regular polygon with ABS(SYMBOL)
C                              edges (style set by current fill style).
C                    0..31   : standard marker symbols.
C                    32..127 : ASCII characters (in current font).
C                              e.g. to use letter F as a marker, let
C                              SYMBOL = ICHAR('F'). 
C                    > 127  :  a Hershey symbol number.
C--
C  4-Feb-1997 - new routine [TJP].
C-----------------------------------------------------------------------
      LOGICAL PGNOTO
      REAL XPTS(1), YPTS(1)
C
      IF (PGNOTO('PGPT1')) RETURN
      XPTS(1) = XPT
      YPTS(1) = YPT
      CALL PGPT(1, XPTS, YPTS, SYMBOL)
      END
#<

#>            pgptext.dc2
Name:         PGPTEXT

Purpose:      non-standard alias for PGPTXT

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGPTEXT (X, Y, ANGLE, FJUST, TEXT)
            REAL X, Y, ANGLE, FJUST
            CHARACTER*(*) TEXT
      
       See description of PGPTXT.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgptext.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGPTEXT -- non-standard alias for PGPTXT
C+
      SUBROUTINE PGPTEXT (X, Y, ANGLE, FJUST, TEXT)
      REAL X, Y, ANGLE, FJUST
      CHARACTER*(*) TEXT
C
C See description of PGPTXT.
C--
      CALL PGPTXT (X, Y, ANGLE, FJUST, TEXT)
      END
#<

#>            pgptxt.dc2
Name:         PGPTXT

Purpose:      write text at arbitrary position and angle

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGPTXT (X, Y, ANGLE, FJUST, TEXT)
            REAL X, Y, ANGLE, FJUST
            CHARACTER*(*) TEXT
      
       Primitive routine for drawing text. The text may be drawn at any
       angle with the horizontal, and may be centered or left- or right-
       justified at a specified position.  Routine PGTEXT provides a
       simple interface to PGPTXT for horizontal strings. Text is drawn
       using the current values of attributes color-index, line-width,
       character-height, and character-font.  Text is NOT subject to
       clipping at the edge of the window.
      
       Arguments:
        X      (input)  : world x-coordinate.
        Y      (input)  : world y-coordinate. The string is drawn with the
                          baseline of all the characters passing through
                          point (X,Y); the positioning of the string along
                          this line is controlled by argument FJUST.
        ANGLE  (input)  : angle, in degrees, that the baseline is to make
                          with the horizontal, increasing counter-clockwise
                          (0.0 is horizontal).
        FJUST  (input)  : controls horizontal justification of the string.
                          If FJUST = 0.0, the string will be left-justified
                          at the point (X,Y); if FJUST = 0.5, it will be
                          centered, and if FJUST = 1.0, it will be right
                          justified. [Other values of FJUST give other
                          justifications.]
        TEXT   (input)  : the character string to be plotted.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgptxt.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGPTXT -- write text at arbitrary position and angle
C%void cpgptxt(float x, float y, float angle, float fjust, \
C% const char *text);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgptxt( real, real, real, real, character )
*

C+
      SUBROUTINE PGPTXT (X, Y, ANGLE, FJUST, TEXT)
      REAL X, Y, ANGLE, FJUST
      CHARACTER*(*) TEXT
C
C Primitive routine for drawing text. The text may be drawn at any
C angle with the horizontal, and may be centered or left- or right-
C justified at a specified position.  Routine PGTEXT provides a
C simple interface to PGPTXT for horizontal strings. Text is drawn
C using the current values of attributes color-index, line-width,
C character-height, and character-font.  Text is NOT subject to
C clipping at the edge of the window.
C
C Arguments:
C  X      (input)  : world x-coordinate.
C  Y      (input)  : world y-coordinate. The string is drawn with the
C                    baseline of all the characters passing through
C                    point (X,Y); the positioning of the string along
C                    this line is controlled by argument FJUST.
C  ANGLE  (input)  : angle, in degrees, that the baseline is to make
C                    with the horizontal, increasing counter-clockwise
C                    (0.0 is horizontal).
C  FJUST  (input)  : controls horizontal justification of the string.
C                    If FJUST = 0.0, the string will be left-justified
C                    at the point (X,Y); if FJUST = 0.5, it will be
C                    centered, and if FJUST = 1.0, it will be right
C                    justified. [Other values of FJUST give other
C                    justifications.]
C  TEXT   (input)  : the character string to be plotted.
C--
C (2-May-1983)
C 31-Jan-1985 - convert to Fortran-77 standard...
C 13-Feb-1988 - correct a PGBBUF/PGEBUF mismatch if string is blank.
C 16-Oct-1993 - erase background of opaque text.
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      INTEGER CI, I, L, GRTRIM
      REAL D, XP, YP
      REAL XBOX(4), YBOX(4)
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGPTXT')) RETURN
      CALL PGBBUF
C
      L = GRTRIM(TEXT)
      D = 0.0
      IF (FJUST.NE.0.0) CALL GRLEN(TEXT(1:L),D)
      XP = PGXORG(PGID)+X*PGXSCL(PGID) - D*FJUST*COS(ANGLE/57.29578)
      YP = PGYORG(PGID)+Y*PGYSCL(PGID) - D*FJUST*SIN(ANGLE/57.29578)
      IF (PGTBCI(PGID).GE.0) THEN
          CALL GRQTXT (ANGLE, XP, YP, TEXT(1:L), XBOX, YBOX)
          DO 25 I=1,4
              XBOX(I) = (XBOX(I)-PGXORG(PGID))/PGXSCL(PGID)
              YBOX(I) = (YBOX(I)-PGYORG(PGID))/PGYSCL(PGID)
   25     CONTINUE
          CALL PGQCI(CI)
          CALL PGSCI(PGTBCI(PGID))
          CALL GRFA(4, XBOX, YBOX)
          CALL PGSCI(CI)
      END IF
      CALL GRTEXT(.TRUE. ,ANGLE, .TRUE., XP, YP, TEXT(1:L))
   30 CALL PGEBUF
      END
#<

#>            pgqah.dc2
Name:         PGQAH

Purpose:      inquire arrow-head style

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQAH (FS, ANGLE, BARB)
            INTEGER  FS
            REAL ANGLE, BARB
      
       Query the style to be used for arrowheads drawn with routine PGARRO.
      
       Argument:
        FS     (output) : FS = 1 => filled; FS = 2 => outline.
        ANGLE  (output) : the acute angle of the arrow point, in degrees.
        BARB   (output) : the fraction of the triangular arrow-head that
                          is cut away from the back. 

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqah.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQAH -- inquire arrow-head style
C%void cpgqah(int *fs, float *angle, float *barb);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqah( integer, real, real )
*

C+
      SUBROUTINE PGQAH (FS, ANGLE, BARB)
      INTEGER  FS
      REAL ANGLE, BARB
C
C Query the style to be used for arrowheads drawn with routine PGARRO.
C
C Argument:
C  FS     (output) : FS = 1 => filled; FS = 2 => outline.
C  ANGLE  (output) : the acute angle of the arrow point, in degrees.
C  BARB   (output) : the fraction of the triangular arrow-head that
C                    is cut away from the back. 
C--
C 13-Oct-1992 - new routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
C
      FS = PGAHS(PGID)
      ANGLE = PGAHA(PGID)
      BARB = PGAHV(PGID)
C
      END
#<

#>            pgqbci.dc2
Subroutine:   PGQBCI

Purpose:      Query color index for displaying BLANKs by PGIMAG.

Category:     GRAPHICS

File:         pgplot.src

Author:       J.P. Terlouw

Use:          CALL PGQBCI(CI)

Updates:      Sep 30, 1999: JPT Document created.
#<

#>            pgqbci.f
* GIPSY-private
*

*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqbci( integer )
*

      SUBROUTINE PGQBCI (CI)
      INTEGER CI
      LOGICAL PGNOTO

      IF (PGNOTO('PGQBCI')) THEN
         CI = 0
      ELSE
         CALL GRQBCI(CI)
      END IF
      END
#<

#>            pgqcf.dc2
Name:         PGQCF

Purpose:      inquire character font

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQCF (FONT)
            INTEGER  FONT
      
       Query the current Character Font (set by routine PGSCF).
      
       Argument:
        FONT   (output)   : the current font number (in range 1-4).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqcf.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQCF -- inquire character font
C%void cpgqcf(int *font);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqcf( integer )
*

C+
      SUBROUTINE PGQCF (FONT)
      INTEGER  FONT
C
C Query the current Character Font (set by routine PGSCF).
C
C Argument:
C  FONT   (output)   : the current font number (in range 1-4).
C--
C  5-Nov-1985 - new routine [TJP].
C 25-OCT-1993 - changed name of argument [TJP].
C-----------------------------------------------------------------------
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGQCF')) THEN
         FONT = 1
      ELSE
         CALL GRQFNT(FONT)
      END IF
      END
#<

#>            pgqch.dc2
Name:         PGQCH

Purpose:      inquire character height

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQCH (SIZE)
            REAL SIZE
      
       Query the Character Size attribute (set by routine PGSCH).
      
       Argument:
        SIZE   (output) : current character size (dimensionless multiple of
                          the default size).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqch.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQCH -- inquire character height
C%void cpgqch(float *size);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqch( real )
*

C+
      SUBROUTINE PGQCH (SIZE)
      REAL SIZE
C
C Query the Character Size attribute (set by routine PGSCH).
C
C Argument:
C  SIZE   (output) : current character size (dimensionless multiple of
C                    the default size).
C--
C  5-Nov-1985 - new routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
      LOGICAL  PGNOTO
C
      IF (PGNOTO('PGQCH')) THEN
          SIZE = 1.0
      ELSE
          SIZE = PGCHSZ(PGID)
      END IF
      END
#<

#>            pgqci.dc2
Name:         PGQCI

Purpose:      inquire color index

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQCI (CI)
            INTEGER  CI
      
       Query the Color Index attribute (set by routine PGSCI).
      
       Argument:
        CI     (output) : the current color index (in range 0-max). This is
                          the color index actually in use, and may differ
                          from the color index last requested by PGSCI if
                          that index is not available on the output device.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqci.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQCI -- inquire color index
C%void cpgqci(int *ci);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqci( integer )
*

C+
      SUBROUTINE PGQCI (CI)
      INTEGER  CI
C
C Query the Color Index attribute (set by routine PGSCI).
C
C Argument:
C  CI     (output) : the current color index (in range 0-max). This is
C                    the color index actually in use, and may differ
C                    from the color index last requested by PGSCI if
C                    that index is not available on the output device.
C--
C  5-Nov-1985 - new routine [TJP].
C-----------------------------------------------------------------------
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGQCI')) THEN
         CI = 1
      ELSE
         CALL GRQCI(CI)
      END IF
      END
#<

#>            pgqcir.dc2
Name:         PGQCIR

Purpose:      inquire color index range

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQCIR(ICILO, ICIHI)
            INTEGER   ICILO, ICIHI
      
       Query the color index range to be used for producing images with
       PGGRAY or PGIMAG, as set by routine PGSCIR or by device default.
      
       Arguments:
        ICILO  (output) : the lowest color index to use for images
        ICIHI  (output) : the highest color index to use for images

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqcir.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQCIR -- inquire color index range
C%void cpgqcir(int *icilo, int *icihi);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqcir( integer, integer )
*

C+
      SUBROUTINE PGQCIR(ICILO, ICIHI)
      INTEGER   ICILO, ICIHI
C
C Query the color index range to be used for producing images with
C PGGRAY or PGIMAG, as set by routine PGSCIR or by device default.
C
C Arguments:
C  ICILO  (output) : the lowest color index to use for images
C  ICIHI  (output) : the highest color index to use for images
C--
C 1994-Mar-17 : new routine [AFT/TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
C---
      ICILO = PGMNCI(PGID)
      ICIHI = PGMXCI(PGID)
C
      END
#<

#>            pgqclp.dc2
Name:         PGQCLP

Purpose:      inquire clipping status

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQCLP(STATE)
            INTEGER  STATE
      
       Query the current clipping status (set by routine PGSCLP).
      
       Argument:
        STATE  (output) : receives the clipping status (0 => disabled,
                          1 => enabled).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqclp.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQCLP -- inquire clipping status
C%void cpgqclp(int *state);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqclp( integer )
*

C+
      SUBROUTINE PGQCLP(STATE)
      INTEGER  STATE
C
C Query the current clipping status (set by routine PGSCLP).
C
C Argument:
C  STATE  (output) : receives the clipping status (0 => disabled,
C                    1 => enabled).
C--
C 25-Feb-1997 [TJP] - new routine.
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGQCLP')) THEN
         STATE = 1
      ELSE
         STATE = PGCLP(PGID)
      END IF
      END
#<

#>            pgqcol.dc2
Name:         PGQCOL

Purpose:      inquire color capability

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQCOL (CI1, CI2)
            INTEGER  CI1, CI2
      
       Query the range of color indices available on the current device.
      
       Argument:
        CI1    (output) : the minimum available color index. This will be
                          either 0 if the device can write in the
                          background color, or 1 if not.
        CI2    (output) : the maximum available color index. This will be
                          1 if the device has no color capability, or a
                          larger number (e.g., 3, 7, 15, 255).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqcol.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQCOL -- inquire color capability
C%void cpgqcol(int *ci1, int *ci2);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqcol( integer, integer )
*

C+
      SUBROUTINE PGQCOL (CI1, CI2)
      INTEGER  CI1, CI2
C
C Query the range of color indices available on the current device.
C
C Argument:
C  CI1    (output) : the minimum available color index. This will be
C                    either 0 if the device can write in the
C                    background color, or 1 if not.
C  CI2    (output) : the maximum available color index. This will be
C                    1 if the device has no color capability, or a
C                    larger number (e.g., 3, 7, 15, 255).
C--
C 31-May-1989 - new routine [TJP].
C-----------------------------------------------------------------------
      CALL GRQCOL(CI1, CI2)
      END
#<

#>            pgqcr.dc2
Name:         PGQCR

Purpose:      inquire color representation

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQCR (CI, CR, CG, CB)
            INTEGER CI
            REAL    CR, CG, CB
      
       Query the RGB colors associated with a color index.
      
       Arguments:
        CI  (input)  : color index
        CR  (output) : red, green and blue intensities
        CG  (output)   in the range 0.0 to 1.0
        CB  (output)

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqcr.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQCR  -- inquire color representation
C%void cpgqcr(int ci, float *cr, float *cg, float *cb);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqcr( integer, real, real, real )
*

C+
      SUBROUTINE PGQCR (CI, CR, CG, CB)
      INTEGER CI
      REAL    CR, CG, CB
C
C Query the RGB colors associated with a color index.
C
C Arguments:
C  CI  (input)  : color index
C  CR  (output) : red, green and blue intensities
C  CG  (output)   in the range 0.0 to 1.0
C  CB  (output)
C--
C 7-Apr-1992 - new routine [DLT]
C-----------------------------------------------------------------------
      CALL GRQCR(CI, CR, CG, CB)
      END
#<

#>            pgqcs.dc2
Name:         PGQCS

Purpose:      inquire character height in a variety of units

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQCS(UNITS, XCH, YCH)
            INTEGER UNITS
            REAL XCH, YCH
      
       Return the current PGPLOT character height in a variety of units.
       This routine provides facilities that are not available via PGQCH.
       Use PGQCS if the character height is required in units other than
       those used in PGSCH.
      
       The PGPLOT "character height" is a dimension that scales with the
       size of the view surface and with the scale-factor specified with
       routine PGSCH. The default value is 1/40th of the height or width
       of the view surface (whichever is less); this value is then
       multiplied by the scale-factor supplied with PGSCH. Note that it
       is a nominal height only; the actual character size depends on the
       font and is usually somewhat smaller.
      
       Arguments:
        UNITS  (input)  : Used to specify the units of the output value:
                          UNITS = 0 : normalized device coordinates
                          UNITS = 1 : inches
                          UNITS = 2 : millimeters
                          UNITS = 3 : pixels
                          UNITS = 4 : world coordinates
                          Other values give an error message, and are
                          treated as 0.
        XCH    (output) : The character height for text written with a
                          vertical baseline.
        YCH    (output) : The character height for text written with
                          a horizontal baseline (the usual case).
      
       The character height is returned in both XCH and YCH.
      
       If UNITS=1 or UNITS=2, XCH and YCH both receive the same value.
      
       If UNITS=3, XCH receives the height in horizontal pixel units, and YCH
       receives the height in vertical pixel units; on devices for which the
       pixels are not square, XCH and YCH will be different.
      
       If UNITS=4, XCH receives the height in horizontal world coordinates
       (as used for the x-axis), and YCH receives the height in vertical
       world coordinates (as used for the y-axis). Unless special care has
       been taken to achive equal world-coordinate scales on both axes, the
       values of XCH and YCH will be different.
      
       If UNITS=0, XCH receives the character height as a fraction of the
       horizontal dimension of the view surface, and YCH receives the
       character height as a fraction of the vertical dimension of the view
       surface.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqcs.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQCS  -- inquire character height in a variety of units
C%void cpgqcs(int units, float *xch, float *ych);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqcs( integer, real, real )
*

C+
      SUBROUTINE PGQCS(UNITS, XCH, YCH)
      INTEGER UNITS
      REAL XCH, YCH
C
C Return the current PGPLOT character height in a variety of units.
C This routine provides facilities that are not available via PGQCH.
C Use PGQCS if the character height is required in units other than
C those used in PGSCH.
C
C The PGPLOT "character height" is a dimension that scales with the
C size of the view surface and with the scale-factor specified with
C routine PGSCH. The default value is 1/40th of the height or width
C of the view surface (whichever is less); this value is then
C multiplied by the scale-factor supplied with PGSCH. Note that it
C is a nominal height only; the actual character size depends on the
C font and is usually somewhat smaller.
C
C Arguments:
C  UNITS  (input)  : Used to specify the units of the output value:
C                    UNITS = 0 : normalized device coordinates
C                    UNITS = 1 : inches
C                    UNITS = 2 : millimeters
C                    UNITS = 3 : pixels
C                    UNITS = 4 : world coordinates
C                    Other values give an error message, and are
C                    treated as 0.
C  XCH    (output) : The character height for text written with a
C                    vertical baseline.
C  YCH    (output) : The character height for text written with
C                    a horizontal baseline (the usual case).
C
C The character height is returned in both XCH and YCH.
C
C If UNITS=1 or UNITS=2, XCH and YCH both receive the same value.
C
C If UNITS=3, XCH receives the height in horizontal pixel units, and YCH
C receives the height in vertical pixel units; on devices for which the
C pixels are not square, XCH and YCH will be different.
C
C If UNITS=4, XCH receives the height in horizontal world coordinates
C (as used for the x-axis), and YCH receives the height in vertical
C world coordinates (as used for the y-axis). Unless special care has
C been taken to achive equal world-coordinate scales on both axes, the
C values of XCH and YCH will be different.
C
C If UNITS=0, XCH receives the character height as a fraction of the
C horizontal dimension of the view surface, and YCH receives the
C character height as a fraction of the vertical dimension of the view
C surface.
C--
C 15-Oct-1992 - new routine [MCS].
C  4-Dec-1992 - added more explanation [TJP].
C  5-Sep-1995 - add UNITS=4; correct error for non-square pixels [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      LOGICAL PGNOTO
      REAL RATIO
C                                        Conversion factor inches -> mm
      REAL INTOMM
      PARAMETER (INTOMM=25.4)
C-----------------------------------------------------------------------
      IF (PGNOTO('PGQCS')) RETURN
      RATIO = PGYPIN(PGID)/PGXPIN(PGID)
C
C Return the character height in the required units.
C
C                                        Inches.
      IF (UNITS.EQ.1) THEN
        XCH = PGYSP(PGID)/PGXPIN(PGID)
        YCH = XCH
C                                        Millimeters.
      ELSE IF (UNITS.EQ.2) THEN
        XCH = PGYSP(PGID)/PGXPIN(PGID) * INTOMM
        YCH = XCH
C                                        Pixels.
      ELSE IF (UNITS.EQ.3) THEN
        XCH = PGYSP(PGID)
        YCH = PGYSP(PGID)*RATIO
C                                        World coordinates.
      ELSE IF (UNITS.EQ.4) THEN
         XCH = PGYSP(PGID)/PGXSCL(PGID)
         YCH = PGYSP(PGID)*RATIO/PGYSCL(PGID)
C                                        Normalized device coords, or
C                                        unknown.
      ELSE
        XCH = PGYSP(PGID)/PGXSZ(PGID)
        YCH = PGYSP(PGID)*RATIO/PGYSZ(PGID)
        IF (UNITS.NE.0)
     :       CALL GRWARN('Invalid "UNITS" argument in PGQCS.')
      END IF
      END
#<

#>            pgqdt.dc2
Name:         PGQDT

Purpose:      inquire name of nth available device type

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQDT(N, TYPE, TLEN, DESCR, DLEN, INTER)
            INTEGER N
            CHARACTER*(*) TYPE, DESCR
            INTEGER TLEN, DLEN, INTER
      
       Return the name of the Nth available device type as a character
       string. The number of available types can be determined by calling
       PGQNDT. If the value of N supplied is outside the range from 1 to
       the number of available types, the routine returns DLEN=TLEN=0.
      
       Arguments:
        N      (input)  : the number of the device type (1..maximum).
        TYPE   (output) : receives the character device-type code of the
                          Nth device type. The argument supplied should be
                          large enough for at least 8 characters. The first
                          character in the string is a '/' character.
        TLEN   (output) : receives the number of characters in TYPE,
                          excluding trailing blanks.
        DESCR  (output) : receives a description of the device type. The
                          argument supplied should be large enough for at
                          least 64 characters.
        DLEN   (output) : receives the number of characters in DESCR,
                          excluding trailing blanks.
        INTER  (output) : receives 1 if the device type is an interactive
                          one, 0 otherwise.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqdt.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQDT -- inquire name of nth available device type
C%void cpgqdt(int n, char *type, int *type_length, char *descr, \
C% int *descr_length, int *inter);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqdt( integer, character, integer, character, integer, integer )
*

C+
      SUBROUTINE PGQDT(N, TYPE, TLEN, DESCR, DLEN, INTER)
      INTEGER N
      CHARACTER*(*) TYPE, DESCR
      INTEGER TLEN, DLEN, INTER
C
C Return the name of the Nth available device type as a character
C string. The number of available types can be determined by calling
C PGQNDT. If the value of N supplied is outside the range from 1 to
C the number of available types, the routine returns DLEN=TLEN=0.
C
C Arguments:
C  N      (input)  : the number of the device type (1..maximum).
C  TYPE   (output) : receives the character device-type code of the
C                    Nth device type. The argument supplied should be
C                    large enough for at least 8 characters. The first
C                    character in the string is a '/' character.
C  TLEN   (output) : receives the number of characters in TYPE,
C                    excluding trailing blanks.
C  DESCR  (output) : receives a description of the device type. The
C                    argument supplied should be large enough for at
C                    least 64 characters.
C  DLEN   (output) : receives the number of characters in DESCR,
C                    excluding trailing blanks.
C  INTER  (output) : receives 1 if the device type is an interactive
C                    one, 0 otherwise.
C--
C 17-Mar-1997 - new routine [TJP].
C-----------------------------------------------------------------------
      INTEGER NDEV, NBUF, LCHR, L1, L2
      REAL RBUF
      CHARACTER*80 CHR
C
C Initialize PGPLOT if necessary.
C
      CALL PGINIT
C
      TYPE = 'error'
      TLEN = 0
      DESCR = ' '
      DLEN = 0
      INTER = 1
      CALL PGQNDT(NDEV)
      IF (N.GE.1 .AND. N.LE.NDEV) THEN
         NBUF = 0
         CALL GREXEC(N, 1, RBUF, NBUF, CHR, LCHR)
         IF (LCHR.GT.0) THEN
            L1 = INDEX(CHR(1:LCHR), ' ')
            IF (L1.GT.1) THEN
               TYPE(1:1) = '/'
               IF (LEN(TYPE).GT.1) TYPE(2:) = CHR(1:L1-1)
               TLEN = MIN(L1,LEN(TYPE))
            END IF
            L2 = INDEX(CHR(1:LCHR), '(')
            IF (L2.GT.0) DESCR = CHR(L2:LCHR)
            DLEN = MIN(LCHR-L2+1,LEN(DESCR))
            CALL GREXEC(N, 4, RBUF, NBUF, CHR, LCHR)
            IF (CHR(1:1).EQ.'H') INTER = 0
         END IF
      END IF
C
      END
#<

#>            pgqfs.dc2
Name:         PGQFS

Purpose:      inquire fill-area style

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQFS (FS)
            INTEGER  FS
      
       Query the current Fill-Area Style attribute (set by routine
       PGSFS).
      
       Argument:
        FS     (output) : the current fill-area style:
                            FS = 1 => solid (default)
                            FS = 2 => outline
                            FS = 3 => hatched
                            FS = 4 => cross-hatched

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqfs.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQFS -- inquire fill-area style
C%void cpgqfs(int *fs);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqfs( integer )
*

C+
      SUBROUTINE PGQFS (FS)
      INTEGER  FS
C
C Query the current Fill-Area Style attribute (set by routine
C PGSFS).
C
C Argument:
C  FS     (output) : the current fill-area style:
C                      FS = 1 => solid (default)
C                      FS = 2 => outline
C                      FS = 3 => hatched
C                      FS = 4 => cross-hatched
C--
C  5-Nov-1985 - new routine [TJP].
C  6-Mar-1995 - add styles 3 and 4 [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGQFS')) THEN
          FS = 1
      ELSE
          FS = PGFAS(PGID)
      END IF
      END
#<

#>            pgqhs.dc2
Name:         PGQHS

Purpose:      inquire hatching style

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQHS (ANGLE, SEPN, PHASE)
            REAL ANGLE, SEPN, PHASE
      
       Query the style to be used hatching (fill area with fill-style 3).
      
       Arguments:
        ANGLE  (output) : the angle the hatch lines make with the
                          horizontal, in degrees, increasing 
                          counterclockwise (this is an angle on the
                          view surface, not in world-coordinate space).
        SEPN   (output) : the spacing of the hatch lines. The unit spacing
                          is 1 percent of the smaller of the height or
                          width of the view surface.
        PHASE  (output) : a real number between 0 and 1; the hatch lines
                          are displaced by this fraction of SEPN from a
                          fixed reference.  Adjacent regions hatched with the
                          same PHASE have contiguous hatch lines.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqhs.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQHS -- inquire hatching style
C%void cpgqhs(float *angle, float *sepn, float* phase);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqhs( real, real )
*

C+
      SUBROUTINE PGQHS (ANGLE, SEPN, PHASE)
      REAL ANGLE, SEPN, PHASE
C
C Query the style to be used hatching (fill area with fill-style 3).
C
C Arguments:
C  ANGLE  (output) : the angle the hatch lines make with the
C                    horizontal, in degrees, increasing 
C                    counterclockwise (this is an angle on the
C                    view surface, not in world-coordinate space).
C  SEPN   (output) : the spacing of the hatch lines. The unit spacing
C                    is 1 percent of the smaller of the height or
C                    width of the view surface.
C  PHASE  (output) : a real number between 0 and 1; the hatch lines
C                    are displaced by this fraction of SEPN from a
C                    fixed reference.  Adjacent regions hatched with the
C                    same PHASE have contiguous hatch lines.
C--
C 26-Feb-1995 - new routine [TJP].
C 19-Jun-1995 - correct synopsis [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
C
      ANGLE = PGHSA(PGID)
      SEPN  = PGHSS(PGID)
      PHASE = PGHSP(PGID)
C
      END
#<

#>            pgqid.dc2
Name:         PGQID

Purpose:      inquire current device identifier

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQID (ID)
            INTEGER  ID
      
       This subroutine returns the identifier of the currently
       selected device, or 0 if no device is selected.  The identifier is
       assigned when PGOPEN is called to open the device, and may be used
       as an argument to PGSLCT.  Each open device has a different
       identifier.
      
       [This routine was added to PGPLOT in Version 5.1.0.]
      
       Argument:
        ID     (output) : the identifier of the current device, or 0 if
                          no device is currently selected.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqid.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQID -- inquire current device identifier
C%void cpgqid(int *id);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqid( integer )
*

C+
      SUBROUTINE PGQID (ID)
      INTEGER  ID
C
C This subroutine returns the identifier of the currently
C selected device, or 0 if no device is selected.  The identifier is
C assigned when PGOPEN is called to open the device, and may be used
C as an argument to PGSLCT.  Each open device has a different
C identifier.
C
C [This routine was added to PGPLOT in Version 5.1.0.]
C
C Argument:
C  ID     (output) : the identifier of the current device, or 0 if
C                    no device is currently selected.
C--
C 22-Dec-1995 - new routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
C
      ID = PGID
      END
#<

#>            pgqinf.dc2
Name:         PGQINF

Purpose:      inquire PGPLOT general information

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQINF (ITEM, VALUE, LENGTH)
            CHARACTER*(*) ITEM, VALUE
            INTEGER LENGTH
      
       This routine can be used to obtain miscellaneous information about
       the PGPLOT environment. Input is a character string defining the
       information required, and output is a character string containing the
       requested information.
      
       The following item codes are accepted (note that the strings must
       match exactly, except for case, but only the first 8 characters are
       significant). For items marked *, PGPLOT must be in the OPEN state
       for the inquiry to succeed. If the inquiry is unsuccessful, either
       because the item code is not recognized or because the information
       is not available, a question mark ('?') is returned.
      
         'VERSION'     - version of PGPLOT software in use.
         'STATE'       - status of PGPLOT ('OPEN' if a graphics device
                         is open for output, 'CLOSED' otherwise).
         'USER'        - the username associated with the calling program.
         'NOW'         - current date and time (e.g., '17-FEB-1986 10:04').
         'DEVICE'    * - current PGPLOT device or file.
         'FILE'      * - current PGPLOT device or file.
         'TYPE'      * - device-type of the current PGPLOT device.
         'DEV/TYPE'  * - current PGPLOT device and type, in a form which
                         is acceptable as an argument for PGBEG.
         'HARDCOPY'  * - is the current device a hardcopy device? ('YES' or
                         'NO').
         'TERMINAL'  * - is the current device the user's interactive
                         terminal? ('YES' or 'NO').
         'CURSOR'    * - does the current device have a graphics cursor?
                         ('YES' or 'NO').
         'SCROLL'    * - does current device have rectangle-scroll
                         capability ('YES' or 'NO'); see PGSCRL.
      
       Arguments:
        ITEM  (input)  : character string defining the information to
                         be returned; see above for a list of possible
                         values.
        VALUE (output) : returns a character-string containing the
                         requested information, truncated to the length 
                         of the supplied string or padded on the right with 
                         spaces if necessary.
        LENGTH (output): the number of characters returned in VALUE
                         (excluding trailing blanks).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqinf.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQINF -- inquire PGPLOT general information
C%void cpgqinf(const char *item, char *value, int *value_length);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqinf( character, character, integer )
*

C+
      SUBROUTINE PGQINF (ITEM, VALUE, LENGTH)
      CHARACTER*(*) ITEM, VALUE
      INTEGER LENGTH
C
C This routine can be used to obtain miscellaneous information about
C the PGPLOT environment. Input is a character string defining the
C information required, and output is a character string containing the
C requested information.
C
C The following item codes are accepted (note that the strings must
C match exactly, except for case, but only the first 8 characters are
C significant). For items marked *, PGPLOT must be in the OPEN state
C for the inquiry to succeed. If the inquiry is unsuccessful, either
C because the item code is not recognized or because the information
C is not available, a question mark ('?') is returned.
C
C   'VERSION'     - version of PGPLOT software in use.
C   'STATE'       - status of PGPLOT ('OPEN' if a graphics device
C                   is open for output, 'CLOSED' otherwise).
C   'USER'        - the username associated with the calling program.
C   'NOW'         - current date and time (e.g., '17-FEB-1986 10:04').
C   'DEVICE'    * - current PGPLOT device or file.
C   'FILE'      * - current PGPLOT device or file.
C   'TYPE'      * - device-type of the current PGPLOT device.
C   'DEV/TYPE'  * - current PGPLOT device and type, in a form which
C                   is acceptable as an argument for PGBEG.
C   'HARDCOPY'  * - is the current device a hardcopy device? ('YES' or
C                   'NO').
C   'TERMINAL'  * - is the current device the user's interactive
C                   terminal? ('YES' or 'NO').
C   'CURSOR'    * - does the current device have a graphics cursor?
C                   ('YES' or 'NO').
C   'SCROLL'    * - does current device have rectangle-scroll
C                   capability ('YES' or 'NO'); see PGSCRL.
C
C Arguments:
C  ITEM  (input)  : character string defining the information to
C                   be returned; see above for a list of possible
C                   values.
C  VALUE (output) : returns a character-string containing the
C                   requested information, truncated to the length 
C                   of the supplied string or padded on the right with 
C                   spaces if necessary.
C  LENGTH (output): the number of characters returned in VALUE
C                   (excluding trailing blanks).
C--
C 18-Feb-1988 - [TJP].
C 30-Aug-1988 - remove pseudo logical use of IER.
C 12-Mar-1992 - change comments for clarity.
C 17-Apr-1995 - clean up some zero-length string problems [TJP].
C  7-Jul-1995 - get cursor information directly from driver [TJP].
C 24-Feb-1997 - add SCROLL request.
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      INTEGER IER, L1, GRTRIM
      LOGICAL INTER, SAME
      CHARACTER*8 TEST
      CHARACTER*64 DEV1
C
C Initialize PGPLOT if necessary.
C
      CALL PGINIT
C
      CALL GRTOUP(TEST,ITEM)
      IF (TEST.EQ.'USER') THEN
          CALL GRUSER(VALUE, LENGTH)
          IER = 1
      ELSE IF (TEST.EQ.'NOW') THEN
          CALL GRDATE(VALUE, LENGTH)
          IER = 1
      ELSE IF (TEST.EQ.'VERSION') THEN
          VALUE = 'v5.2.0'
          LENGTH = 6
          IER = 1
      ELSE IF (TEST.EQ.'STATE') THEN
          IF (PGID.LT.1 .OR. PGID.GT.PGMAXD) THEN
             VALUE = 'CLOSED'
             LENGTH = 6
          ELSE IF (PGDEVS(PGID).EQ.0) THEN
             VALUE = 'CLOSED'
             LENGTH = 6
          ELSE
             VALUE = 'OPEN'
             LENGTH = 4
          END IF
          IER = 1
      ELSE IF (PGID.LT.1 .OR. PGID.GT.PGMAXD) THEN
          IER = 0
      ELSE IF (PGDEVS(PGID).EQ.0) THEN
          IER = 0
      ELSE IF (TEST.EQ.'DEV/TYPE') THEN
          CALL GRQDT(VALUE)
          LENGTH = GRTRIM(VALUE)
          IER = 0
          IF (LENGTH.GT.0) IER = 1
      ELSE IF (TEST.EQ.'DEVICE' .OR. TEST.EQ.'FILE') THEN
          CALL GRQDEV(VALUE, LENGTH)
          IER = 1
      ELSE IF (TEST.EQ.'TERMINAL') THEN
          CALL GRQDEV(DEV1, L1)
          IF (L1.GE.1) THEN
             CALL GRTTER(DEV1(1:L1), SAME)
          ELSE
             SAME = .FALSE.
          END IF
          IF (SAME) THEN
              VALUE = 'YES'
              LENGTH = 3
          ELSE
              VALUE = 'NO'
              LENGTH = 2
          END IF
          IER = 1
      ELSE IF (TEST.EQ.'TYPE') THEN
          CALL GRQTYP(VALUE,INTER)
          LENGTH = GRTRIM(VALUE)
          IER = 0
          IF (LENGTH.GT.0) IER = 1
      ELSE IF (TEST.EQ.'HARDCOPY') THEN
          CALL GRQTYP(VALUE,INTER)
          IF (INTER) THEN
              VALUE = 'NO'
              LENGTH = 2
          ELSE
              VALUE = 'YES'
              LENGTH = 3
          END IF
          IER = 1
      ELSE IF (TEST.EQ.'CURSOR') THEN
          CALL GRQCAP(DEV1)
          IF (DEV1(2:2).EQ.'N') THEN
              VALUE = 'NO'
              LENGTH = 2
          ELSE
              VALUE = 'YES'
              LENGTH = 3
          END IF
          IER = 1
      ELSE IF (TEST.EQ.'SCROLL') THEN
          CALL GRQCAP(DEV1)
          IF (DEV1(11:11).NE.'S') THEN
              VALUE = 'NO'
              LENGTH = 2
          ELSE
              VALUE = 'YES'
              LENGTH = 3
          END IF
          IER = 1
      ELSE
          IER = 0
      END IF
      IF (IER.NE.1) THEN
         VALUE = '?'
         LENGTH = 1
      ELSE IF (LENGTH.LT.1) THEN
         LENGTH = 1
         VALUE = ' '
      END IF
      END
#<

#>            pgqimi.dc2
Subroutine:   PGQIMI

Purpose:      Query the interpolation used by PGIMAG.

Category:     GRAPHICS

File:         pgplot.src

Author:       J.P. Terlouw

Use:          CALL PGQIMI(INTP)

              INTP    The interpolation mode (INTEGER).

                        0 - no interpolation is performed
                        1 - bilinear interpolation

Updates:      Apr  7, 2000: JPT Document created.
#<

#>            pgqitf.dc2
Name:         PGQITF

Purpose:      inquire image transfer function

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQITF (ITF)
            INTEGER  ITF
      
       Return the Image Transfer Function as set by default or by a previous
       call to PGSITF. The Image Transfer Function is used by routines
       PGIMAG, PGGRAY, and PGWEDG.
      
       Argument:
        ITF    (output) : type of transfer function (see PGSITF)

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqitf.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQITF -- inquire image transfer function
C%void cpgqitf(int *itf);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqitf( integer )
*

C+
      SUBROUTINE PGQITF (ITF)
      INTEGER  ITF
C
C Return the Image Transfer Function as set by default or by a previous
C call to PGSITF. The Image Transfer Function is used by routines
C PGIMAG, PGGRAY, and PGWEDG.
C
C Argument:
C  ITF    (output) : type of transfer function (see PGSITF)
C--
C 15-Sep-1994 - new routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGQITF')) THEN
          ITF = 0
      ELSE
          ITF = PGITF(PGID)
      END IF
      END
#<

#>            pgqls.dc2
Name:         PGQLS

Purpose:      inquire line style

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQLS (LS)
            INTEGER  LS
      
       Query the current Line Style attribute (set by routine PGSLS).
      
       Argument:
        LS     (output) : the current line-style attribute (in range 1-5).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqls.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQLS -- inquire line style
C%void cpgqls(int *ls);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqls( integer )
*

C+
      SUBROUTINE PGQLS (LS)
      INTEGER  LS
C
C Query the current Line Style attribute (set by routine PGSLS).
C
C Argument:
C  LS     (output) : the current line-style attribute (in range 1-5).
C--
C  5-Nov-1985 - new routine [TJP].
C-----------------------------------------------------------------------
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGQLS')) THEN
         LS = 1
      ELSE
         CALL GRQLS(LS)
      END IF
      END
#<

#>            pgqlw.dc2
Name:         PGQLW

Purpose:      inquire line width

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQLW (LW)
            INTEGER  LW
      
       Query the current Line-Width attribute (set by routine PGSLW).
      
       Argument:
        LW     (output)  : the line-width (in range 1-201).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqlw.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQLW -- inquire line width
C%void cpgqlw(int *lw);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqlw( integer )
*

C+
      SUBROUTINE PGQLW (LW)
      INTEGER  LW
C
C Query the current Line-Width attribute (set by routine PGSLW).
C
C Argument:
C  LW     (output)  : the line-width (in range 1-201).
C--
C  5-Nov-1985 - new routine [TJP].
C-----------------------------------------------------------------------
      LOGICAL PGNOTO
C     
      IF (PGNOTO('PGQLW')) THEN
         LW = 1
      ELSE
         CALL GRQLW(LW)
      END IF
      END
#<

#>            pgqndt.dc2
Name:         PGQNDT

Purpose:      inquire number of available device types

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQNDT(N)
            INTEGER N
      
       Return the number of available device types. This routine is
       usually used in conjunction with PGQDT to get a list of the
       available device types.
      
       Arguments:
        N      (output) : the number of available device types.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqndt.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQNDT -- inquire number of available device types
C%void cpgqndt(int *n);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqndt( integer )
*

C+
      SUBROUTINE PGQNDT(N)
      INTEGER N
C
C Return the number of available device types. This routine is
C usually used in conjunction with PGQDT to get a list of the
C available device types.
C
C Arguments:
C  N      (output) : the number of available device types.
C--
C 17-Mar-1997 - new routine [TJP].
C-----------------------------------------------------------------------
      INTEGER NBUF, LCHR
      REAL RBUF(2)
      CHARACTER CHR
C
C Initialize PGPLOT if necessary.
C
      CALL PGINIT
C
C Find number of device types.
C
      CALL GREXEC(0, 0, RBUF, NBUF, CHR, LCHR)
      N = NINT(RBUF(1))
C
      END
#<

#>            pgqpos.dc2
Name:         PGQPOS

Purpose:      inquire current pen position

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQPOS (X, Y)
            REAL X, Y
      
       Query the current "pen" position in world C coordinates (X,Y).
      
       Arguments:
        X      (output)  : world x-coordinate of the pen position.
        Y      (output)  : world y-coordinate of the pen position.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqpos.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQPOS -- inquire current pen position
C%void cpgqpos(float *x, float *y);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqpos( real, real )
*

C+
      SUBROUTINE PGQPOS (X, Y)
      REAL X, Y
C
C Query the current "pen" position in world C coordinates (X,Y).
C
C Arguments:
C  X      (output)  : world x-coordinate of the pen position.
C  Y      (output)  : world y-coordinate of the pen position.
C--
C  1-Mar-1991 - new routine [JM].
C-----------------------------------------------------------------------
      CALL GRQPOS(X,Y)
      END
#<

#>            pgqtbg.dc2
Name:         PGQTBG

Purpose:      inquire text background color index

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQTBG (TBCI)
            INTEGER  TBCI
      
       Query the current Text Background Color Index (set by routine
       PGSTBG).
      
       Argument:
        TBCI   (output) : receives the current text background color index.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqtbg.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQTBG -- inquire text background color index
C%void cpgqtbg(int *tbci);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqtbg( integer )
*

C+
      SUBROUTINE PGQTBG (TBCI)
      INTEGER  TBCI
C
C Query the current Text Background Color Index (set by routine
C PGSTBG).
C
C Argument:
C  TBCI   (output) : receives the current text background color index.
C--
C 16-Oct-1993 - new routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGQTBG')) THEN
          TBCI = 0
      ELSE
          TBCI = PGTBCI(PGID)
      END IF
      END
#<

#>            pgqtxt.dc2
Name:         PGQTXT

Purpose:      find bounding box of text string

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQTXT (X, Y, ANGLE, FJUST, TEXT, XBOX, YBOX)
            REAL X, Y, ANGLE, FJUST
            CHARACTER*(*) TEXT
            REAL XBOX(4), YBOX(4)
      
       This routine returns a bounding box for a text string. Instead
       of drawing the string as routine PGPTXT does, it returns in XBOX
       and YBOX the coordinates of the corners of a rectangle parallel
       to the string baseline that just encloses the string. The four
       corners are in the order: lower left, upper left, upper right,
       lower right (where left and right refer to the first and last
       characters in the string).
      
       If the string is blank or contains no drawable characters, all
       four elements of XBOX and YBOX are assigned the starting point
       of the string, (X,Y).
      
       Arguments:
        X, Y, ANGLE, FJUST, TEXT (input) : these arguments are the same as
                          the corrresponding arguments in PGPTXT.
        XBOX, YBOX (output) : arrays of dimension 4; on output, they
                          contain the world coordinates of the bounding
                          box in (XBOX(1), YBOX(1)), ..., (XBOX(4), YBOX(4)).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqtxt.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQTXT -- find bounding box of text string
C%void cpgqtxt(float x, float y, float angle, float fjust, \
C% const char *text, float *xbox, float *ybox);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqtxt( real, real, real, real, character, real, real )
*

C+
      SUBROUTINE PGQTXT (X, Y, ANGLE, FJUST, TEXT, XBOX, YBOX)
      REAL X, Y, ANGLE, FJUST
      CHARACTER*(*) TEXT
      REAL XBOX(4), YBOX(4)
C
C This routine returns a bounding box for a text string. Instead
C of drawing the string as routine PGPTXT does, it returns in XBOX
C and YBOX the coordinates of the corners of a rectangle parallel
C to the string baseline that just encloses the string. The four
C corners are in the order: lower left, upper left, upper right,
C lower right (where left and right refer to the first and last
C characters in the string).
C
C If the string is blank or contains no drawable characters, all
C four elements of XBOX and YBOX are assigned the starting point
C of the string, (X,Y).
C
C Arguments:
C  X, Y, ANGLE, FJUST, TEXT (input) : these arguments are the same as
C                    the corrresponding arguments in PGPTXT.
C  XBOX, YBOX (output) : arrays of dimension 4; on output, they
C                    contain the world coordinates of the bounding
C                    box in (XBOX(1), YBOX(1)), ..., (XBOX(4), YBOX(4)).
C--
C 12-Sep-1993 - new routine [TJP].
C  8-Nov-1994 - return something for blank string [TJP].
C 14-Jan-1997 - additional explanation [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      LOGICAL PGNOTO
      INTEGER I, L, GRTRIM
      REAL D, XP, YP, XPBOX(4), YPBOX(4), XOFFS, YOFFS
C
      IF (PGNOTO('PGQTXT')) RETURN
C
      L = GRTRIM(TEXT)
      IF (L.LE.0) THEN
         DO 15 I=1,4
            XBOX(I) = X
            YBOX(I) = Y
 15      CONTINUE
      ELSE
         D = 0.0
         IF (FJUST.NE.0.0) CALL GRLEN(TEXT(1:L),D)
         XOFFS = PGXORG(PGID) - D*FJUST*COS(ANGLE/57.29578)
         YOFFS = PGYORG(PGID) - D*FJUST*SIN(ANGLE/57.29578)
         XP = X*PGXSCL(PGID) + XOFFS
         YP = Y*PGYSCL(PGID) + YOFFS
         CALL GRQTXT(ANGLE, XP, YP, TEXT(1:L), XPBOX, YPBOX)
         DO 25 I=1,4
            XBOX(I) = (XPBOX(I) - PGXORG(PGID))/PGXSCL(PGID)
            YBOX(I) = (YPBOX(I) - PGYORG(PGID))/PGYSCL(PGID)
 25      CONTINUE
      END IF
      END
#<

#>            pgqvp.dc2
Name:         PGQVP

Purpose:      inquire viewport size and position

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQVP (UNITS, X1, X2, Y1, Y2)
            INTEGER UNITS
            REAL    X1, X2, Y1, Y2
      
       Inquiry routine to determine the current viewport setting.
       The values returned may be normalized device coordinates, inches, mm,
       or pixels, depending on the value of the input parameter CFLAG.
      
       Arguments:
        UNITS  (input)  : used to specify the units of the output parameters:
                          UNITS = 0 : normalized device coordinates
                          UNITS = 1 : inches
                          UNITS = 2 : millimeters
                          UNITS = 3 : pixels
                          Other values give an error message, and are
                          treated as 0.
        X1     (output) : the x-coordinate of the bottom left corner of the
                          viewport.
        X2     (output) : the x-coordinate of the top right corner of the
                          viewport.
        Y1     (output) : the y-coordinate of the bottom left corner of the
                          viewport.
        Y2     (output) : the y-coordinate of the top right corner of the
                          viewport.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqvp.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQVP -- inquire viewport size and position
C%void cpgqvp(int units, float *x1, float *x2, float *y1, float *y2);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqvp( integer, real, real, real, real )
*

C+
      SUBROUTINE PGQVP (UNITS, X1, X2, Y1, Y2)
      INTEGER UNITS
      REAL    X1, X2, Y1, Y2
C
C Inquiry routine to determine the current viewport setting.
C The values returned may be normalized device coordinates, inches, mm,
C or pixels, depending on the value of the input parameter CFLAG.
C
C Arguments:
C  UNITS  (input)  : used to specify the units of the output parameters:
C                    UNITS = 0 : normalized device coordinates
C                    UNITS = 1 : inches
C                    UNITS = 2 : millimeters
C                    UNITS = 3 : pixels
C                    Other values give an error message, and are
C                    treated as 0.
C  X1     (output) : the x-coordinate of the bottom left corner of the
C                    viewport.
C  X2     (output) : the x-coordinate of the top right corner of the
C                    viewport.
C  Y1     (output) : the y-coordinate of the bottom left corner of the
C                    viewport.
C  Y2     (output) : the y-coordinate of the top right corner of the
C                    viewport.
C--
C 26-Sep-1985 - new routine (TJP).
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      REAL SX, SY
C
      IF (UNITS.EQ.0) THEN
          SX = PGXSZ(PGID)
          SY = PGYSZ(PGID)
      ELSE IF (UNITS.EQ.1) THEN
          SX = PGXPIN(PGID)
          SY = PGYPIN(PGID)
      ELSE IF (UNITS.EQ.2) THEN
          SX = (PGXPIN(PGID)/25.4)
          SY = (PGYPIN(PGID)/25.4)
      ELSE IF (UNITS.EQ.3) THEN
          SX = 1.0
          SY = 1.0
      ELSE
          CALL GRWARN(
     1        'Illegal value for parameter UNITS in routine PGQVP')
          SX = PGXSZ(PGID)
          SY = PGYSZ(PGID)
      END IF
      X1 = PGXVP(PGID)/SX
      X2 = (PGXVP(PGID)+PGXLEN(PGID))/SX
      Y1 = PGYVP(PGID)/SY
      Y2 = (PGYVP(PGID)+PGYLEN(PGID))/SY
      END
#<

#>            pgqvsz.dc2
Name:         PGQVSZ

Purpose:      inquire size of view surface

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQVSZ (UNITS, X1, X2, Y1, Y2)
            INTEGER UNITS
            REAL X1, X2, Y1, Y2
      
       This routine returns the dimensions of the view surface (the maximum
       plottable area) of the currently selected graphics device, in 
       a variety of units. The size of the view surface is device-dependent
       and is established when the graphics device is opened. On some 
       devices, it can be changed by calling PGPAP before starting a new
       page with PGPAGE. On some devices, the size can be changed (e.g.,
       by a workstation window manager) outside PGPLOT, and PGPLOT detects
       the change when PGPAGE is used. Call this routine after PGPAGE to 
       find the current size.
      
       Note 1: the width and the height of the view surface in normalized
       device coordinates are both always equal to 1.0.
      
       Note 2: when the device is divided into panels (see PGSUBP), the
       view surface is a single panel.
      
       Arguments:
        UNITS  (input)  : 0,1,2,3 for output in normalized device coords, 
                          inches, mm, or device units (pixels)
        X1     (output) : always returns 0.0
        X2     (output) : width of view surface
        Y1     (output) : always returns 0.0
        Y2     (output) : height of view surface

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqvsz.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQVSZ -- inquire size of view surface
C%void cpgqvsz(int units, float *x1, float *x2, float *y1, float *y2);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqvsz( integer, real, real, real, real )
*

C+
      SUBROUTINE PGQVSZ (UNITS, X1, X2, Y1, Y2)
      INTEGER UNITS
      REAL X1, X2, Y1, Y2
C
C This routine returns the dimensions of the view surface (the maximum
C plottable area) of the currently selected graphics device, in 
C a variety of units. The size of the view surface is device-dependent
C and is established when the graphics device is opened. On some 
C devices, it can be changed by calling PGPAP before starting a new
C page with PGPAGE. On some devices, the size can be changed (e.g.,
C by a workstation window manager) outside PGPLOT, and PGPLOT detects
C the change when PGPAGE is used. Call this routine after PGPAGE to 
C find the current size.
C
C Note 1: the width and the height of the view surface in normalized
C device coordinates are both always equal to 1.0.
C
C Note 2: when the device is divided into panels (see PGSUBP), the
C view surface is a single panel.
C
C Arguments:
C  UNITS  (input)  : 0,1,2,3 for output in normalized device coords, 
C                    inches, mm, or device units (pixels)
C  X1     (output) : always returns 0.0
C  X2     (output) : width of view surface
C  Y1     (output) : always returns 0.0
C  Y2     (output) : height of view surface
C--
C 28-Aug-1992 - new routine [Neil Killeen].
C  2-Dec-1992 - changed to avoid resetting the viewport [TJP].
C 26-Feb-1997 - revised description [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      LOGICAL PGNOTO
      REAL SX, SY
C
      IF (PGNOTO('PGQVSZ')) THEN
         X1 = 0.0
         X2 = 0.0
         Y1 = 0.0
         Y2 = 0.0
         RETURN
      END IF
C
      IF (UNITS.EQ.0) THEN
          SX = PGXSZ(PGID)
          SY = PGYSZ(PGID)
      ELSE IF (UNITS.EQ.1) THEN
          SX = PGXPIN(PGID)
          SY = PGYPIN(PGID)
      ELSE IF (UNITS.EQ.2) THEN
          SX = (PGXPIN(PGID)/25.4)
          SY = (PGYPIN(PGID)/25.4)
      ELSE IF (UNITS.EQ.3) THEN
          SX = 1.0
          SY = 1.0
      ELSE
          CALL GRWARN(
     1        'Illegal value for parameter UNITS in routine PGQVSZ')
          SX = PGXSZ(PGID)
          SY = PGYSZ(PGID)
      END IF
      X1 = 0.0
      X2 = PGXSZ(PGID)/SX
      Y1 = 0.0
      Y2 = PGYSZ(PGID)/SY
      END
#<

#>            pgqwin.dc2
Name:         PGQWIN

Purpose:      inquire window boundary coordinates

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGQWIN (X1, X2, Y1, Y2)
            REAL X1, X2, Y1, Y2
      
       Inquiry routine to determine the current window setting.
       The values returned are world coordinates.
      
       Arguments:
        X1     (output) : the x-coordinate of the bottom left corner
                          of the window.
        X2     (output) : the x-coordinate of the top right corner
                          of the window.
        Y1     (output) : the y-coordinate of the bottom left corner
                          of the window.
        Y2     (output) : the y-coordinate of the top right corner
                          of the window.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgqwin.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGQWIN -- inquire window boundary coordinates
C%void cpgqwin(float *x1, float *x2, float *y1, float *y2);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqwin( real, real, real, real )
*

C+
      SUBROUTINE PGQWIN (X1, X2, Y1, Y2)
      REAL X1, X2, Y1, Y2
C
C Inquiry routine to determine the current window setting.
C The values returned are world coordinates.
C
C Arguments:
C  X1     (output) : the x-coordinate of the bottom left corner
C                    of the window.
C  X2     (output) : the x-coordinate of the top right corner
C                    of the window.
C  Y1     (output) : the y-coordinate of the bottom left corner
C                    of the window.
C  Y2     (output) : the y-coordinate of the top right corner
C                    of the window.
C--
C 26-Sep-1985 - new routine (TJP).
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
C
      X1 = PGXBLC(PGID)
      X2 = PGXTRC(PGID)
      Y1 = PGYBLC(PGID)
      Y2 = PGYTRC(PGID)
      END
#<

#>            pgrect.dc2
Name:         PGRECT

Purpose:      draw a rectangle, using fill-area attributes

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGRECT (X1, X2, Y1, Y2)
            REAL X1, X2, Y1, Y2
      
       This routine can be used instead of PGPOLY for the special case of
       drawing a rectangle aligned with the coordinate axes; only two
       vertices need be specified instead of four.  On most devices, it is
       faster to use PGRECT than PGPOLY for drawing rectangles.  The
       rectangle has vertices at (X1,Y1), (X1,Y2), (X2,Y2), and (X2,Y1).
      
       Arguments:
        X1, X2 (input) : the horizontal range of the rectangle.
        Y1, Y2 (input) : the vertical range of the rectangle.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgrect.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGRECT -- draw a rectangle, using fill-area attributes
C%void cpgrect(float x1, float x2, float y1, float y2);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgrect( real, real, real, real )
*

C+
      SUBROUTINE PGRECT (X1, X2, Y1, Y2)
      REAL X1, X2, Y1, Y2
C
C This routine can be used instead of PGPOLY for the special case of
C drawing a rectangle aligned with the coordinate axes; only two
C vertices need be specified instead of four.  On most devices, it is
C faster to use PGRECT than PGPOLY for drawing rectangles.  The
C rectangle has vertices at (X1,Y1), (X1,Y2), (X2,Y2), and (X2,Y1).
C
C Arguments:
C  X1, X2 (input) : the horizontal range of the rectangle.
C  Y1, Y2 (input) : the vertical range of the rectangle.
C--
C 21-Nov-1986 - [TJP].
C 22-Mar-1988 - use GRRECT for fill [TJP].
C  6-Mar-1995 - add hatching (by calling PGHTCH) [TJP].
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
      REAL XP(4), YP(4)
C
      CALL PGBBUF
C
C Outline only.
C
      IF (PGFAS(PGID).EQ.2) THEN
         CALL GRMOVA(X1,Y1)
         CALL GRLINA(X1,Y2)
         CALL GRLINA(X2,Y2)
         CALL GRLINA(X2,Y1)
         CALL GRLINA(X1,Y1)
C
C Hatching.
C
      ELSE IF (PGFAS(PGID).EQ.3 .OR. PGFAS(PGID).EQ.4) THEN
         XP(1) = X1
         XP(2) = X1
         XP(3) = X2
         XP(4) = X2
         YP(1) = Y1
         YP(2) = Y2
         YP(3) = Y2
         YP(4) = Y1
         CALL PGHTCH(4, XP, YP, 0.0)
         IF (PGFAS(PGID).EQ.4) CALL PGHTCH(4, XP, YP, 90.0)
C
C Solid fill.
C
      ELSE
          CALL GRRECT(X1,Y1,X2,Y2)
          CALL GRMOVA(X1,Y1)
      END IF
      CALL PGEBUF
      END
#<

#>            pgrnd.dc2
Name:         PGRND

Purpose:      find the smallest `round' number greater than x

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            REAL FUNCTION PGRND (X, NSUB)
            REAL X
            INTEGER NSUB
      
       Routine to find the smallest "round" number larger than x, a
       "round" number being 1, 2 or 5 times a power of 10. If X is negative,
       PGRND(X) = -PGRND(ABS(X)). eg PGRND(8.7) = 10.0,
       PGRND(-0.4) = -0.5.  If X is zero, the value returned is zero.
       This routine is used by PGBOX for choosing  tick intervals.
      
       Returns:
        PGRND         : the "round" number.
       Arguments:
        X      (input)  : the number to be rounded.
        NSUB   (output) : a suitable number of subdivisions for
                          subdividing the "nice" number: 2 or 5.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgrnd.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Thu Oct 22, 1998 at 12:40:55. The Fortran code is unmodified.

C*PGRND -- find the smallest `round' number greater than x
C%float cpgrnd(float x, int *nsub);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ real function pgrnd( real, integer )
*

C+
      REAL FUNCTION PGRND (X, NSUB)
      REAL X
      INTEGER NSUB
C
C Routine to find the smallest "round" number larger than x, a
C "round" number being 1, 2 or 5 times a power of 10. If X is negative,
C PGRND(X) = -PGRND(ABS(X)). eg PGRND(8.7) = 10.0,
C PGRND(-0.4) = -0.5.  If X is zero, the value returned is zero.
C This routine is used by PGBOX for choosing  tick intervals.
C
C Returns:
C  PGRND         : the "round" number.
C Arguments:
C  X      (input)  : the number to be rounded.
C  NSUB   (output) : a suitable number of subdivisions for
C                    subdividing the "nice" number: 2 or 5.
C--
C  6-Sep-1989 - Changes for standard Fortran-77 [TJP].
C  2-Dec-1991 - Fix for bug found on Fujitsu [TJP].
C-----------------------------------------------------------------------
      INTEGER  I,ILOG
      REAL     FRAC,NICE(3),PWR,XLOG,XX
      INTRINSIC ABS, LOG10, SIGN
      DATA     NICE/2.0,5.0,10.0/
C
      IF (X.EQ.0.0) THEN
          PGRND = 0.0
          NSUB = 2
          RETURN
      END IF
      XX   = ABS(X)
      XLOG = LOG10(XX)
      ILOG = XLOG
      IF (XLOG.LT.0) ILOG=ILOG-1
      PWR  = 10.0**ILOG
      FRAC = XX/PWR
      I = 3
      IF (FRAC.LE.NICE(2)) I = 2
      IF (FRAC.LE.NICE(1)) I = 1
      PGRND = SIGN(PWR*NICE(I),X)
      NSUB = 5
      IF (I.EQ.1) NSUB = 2
      END
#<

#>            pgrnge.dc2
Name:         PGRNGE

Purpose:      choose axis limits

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGRNGE (X1, X2, XLO, XHI)
            REAL X1, X2, XLO, XHI
      
       Choose plotting limits XLO and XHI which encompass the data
       range X1 to X2.
      
       Arguments:
        X1, X2 (input)  : the data range (X1<X2), ie, the min and max values
                          to be plotted.
        XLO, XHI (output) : suitable values to use as the extremes of a graph
                          axis (XLO <= X1, XHI >= X2).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgrnge.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGRNGE -- choose axis limits
C%void cpgrnge(float x1, float x2, float *xlo, float *xhi);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgrnge( real, real, real, real )
*

C+
      SUBROUTINE PGRNGE (X1, X2, XLO, XHI)
      REAL X1, X2, XLO, XHI
C
C Choose plotting limits XLO and XHI which encompass the data
C range X1 to X2.
C
C Arguments:
C  X1, X2 (input)  : the data range (X1<X2), ie, the min and max values
C                    to be plotted.
C  XLO, XHI (output) : suitable values to use as the extremes of a graph
C                    axis (XLO <= X1, XHI >= X2).
C--
C 10-Nov-1985 - new routine [TJP].
C-----------------------------------------------------------------------
      XLO = X1 - 0.1*(X2-X1)
      XHI = X2 + 0.1*(X2-X1)
      IF (XLO.LT.0.0 .AND. X1.GE.0.0) XLO = 0.0
      IF (XHI.GT.0.0 .AND. X2.LE.0.0) XHI = 0.0
      END
#<

#>            pgsah.dc2
Name:         PGSAH

Purpose:      set arrow-head style

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSAH (FS, ANGLE, BARB)
            INTEGER  FS
            REAL ANGLE, BARB
      
       Set the style to be used for arrowheads drawn with routine PGARRO.
      
       Argument:
        FS     (input)  : FS = 1 => filled; FS = 2 => outline.
                          Other values are treated as 2. Default 1.
        ANGLE  (input)  : the acute angle of the arrow point, in degrees;
                          angles in the range 20.0 to 90.0 give reasonable
                          results. Default 45.0.
        BARB   (input)  : the fraction of the triangular arrow-head that
                          is cut away from the back. 0.0 gives a triangular
                          wedge arrow-head; 1.0 gives an open >. Values 0.3
                          to 0.7 give reasonable results. Default 0.3.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgsah.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSAH -- set arrow-head style
C%void cpgsah(int fs, float angle, float barb);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgsah( integer, real, real )
*

C+
      SUBROUTINE PGSAH (FS, ANGLE, BARB)
      INTEGER  FS
      REAL ANGLE, BARB
C
C Set the style to be used for arrowheads drawn with routine PGARRO.
C
C Argument:
C  FS     (input)  : FS = 1 => filled; FS = 2 => outline.
C                    Other values are treated as 2. Default 1.
C  ANGLE  (input)  : the acute angle of the arrow point, in degrees;
C                    angles in the range 20.0 to 90.0 give reasonable
C                    results. Default 45.0.
C  BARB   (input)  : the fraction of the triangular arrow-head that
C                    is cut away from the back. 0.0 gives a triangular
C                    wedge arrow-head; 1.0 gives an open >. Values 0.3
C                    to 0.7 give reasonable results. Default 0.3.
C--
C 13-Oct-1992 - new routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
C
      PGAHS(PGID) = FS
      IF (PGAHS(PGID).NE.1) PGAHS(PGID) = 2
      PGAHA(PGID) = ANGLE
      PGAHV(PGID) = BARB
C
      END
#<

#>            pgsave.dc2
Name:         PGSAVE

Purpose:      save PGPLOT attributes

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSAVE
      
       This routine saves the current PGPLOT attributes in a private storage
       area. They can be restored by calling PGUNSA (unsave). Attributes
       saved are: character font, character height, color index, fill-area
       style, line style, line width, pen position, arrow-head style, 
       hatching style, and clipping state. Color representation is not saved.
      
       Calls to PGSAVE and PGUNSA should always be paired. Up to 20 copies
       of the attributes may be saved. PGUNSA always retrieves the last-saved
       values (last-in first-out stack).
      
       Note that when multiple devices are in use, PGUNSA retrieves the
       values saved by the last PGSAVE call, even if they were for a
       different device.
      
       Arguments: none

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgsave.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSAVE -- save PGPLOT attributes
C%void cpgsave(void);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgsave(  )
*

C+
      SUBROUTINE PGSAVE
C
C This routine saves the current PGPLOT attributes in a private storage
C area. They can be restored by calling PGUNSA (unsave). Attributes
C saved are: character font, character height, color index, fill-area
C style, line style, line width, pen position, arrow-head style, 
C hatching style, and clipping state. Color representation is not saved.
C
C Calls to PGSAVE and PGUNSA should always be paired. Up to 20 copies
C of the attributes may be saved. PGUNSA always retrieves the last-saved
C values (last-in first-out stack).
C
C Note that when multiple devices are in use, PGUNSA retrieves the
C values saved by the last PGSAVE call, even if they were for a
C different device.
C
C Arguments: none
C--
C 20-Apr-1992 - new routine [TJP].
C 27-Nov-1992 - add arrowhead style [TJP].
C  6-Oct-1993 - add text opacity [TJP].
C 28-Feb-1994 - correct bug (variable not saved) [TJP].
C 26-Feb-1995 - add hatching attributes.
C 19-Jun-1996 - correction in header comments [TJP].
C 26-Feb-1997 - add clipping state [TJP].
C-----------------------------------------------------------------------
      INTEGER MAXS
      PARAMETER (MAXS=20)
C
      INTEGER LEV
      INTEGER CF(MAXS), CI(MAXS), FS(MAXS), LS(MAXS), LW(MAXS)
      INTEGER AHFS(MAXS), TBG(MAXS), CLP(MAXS)
      REAL    CH(MAXS), POS(2,MAXS)
      REAL    AHANG(MAXS), AHBARB(MAXS), HSA(MAXS), HSS(MAXS), HSP(MAXS)
      SAVE    LEV, CF, CI, FS, LS, LW, AHFS, TBG, CH, POS
      SAVE    AHANG, AHBARB, HSA, HSS, HSP, CLP
      DATA    LEV /0/
C
      IF (LEV.GE.MAXS) THEN
          CALL GRWARN('Too many unmatched calls to PGSAVE')
      ELSE
          LEV = LEV+1
          CALL PGQCF(CF(LEV))
          CALL PGQCH(CH(LEV))
          CALL PGQCI(CI(LEV))
          CALL PGQFS(FS(LEV))
          CALL PGQLS(LS(LEV))
          CALL PGQLW(LW(LEV))
C          CALL PGQVP(0, VP(1,LEV), VP(2,LEV), VP(3,LEV), VP(4,LEV))
C          CALL PGQWIN(WIN(1,LEV), WIN(2,LEV), WIN(3,LEV), WIN(4,LEV))
          CALL PGQPOS(POS(1,LEV), POS(2,LEV))
          CALL PGQAH(AHFS(LEV), AHANG(LEV), AHBARB(LEV))
          CALL PGQTBG(TBG(LEV))
          CALL PGQHS(HSA(LEV), HSS(LEV), HSP(LEV))
          CALL PGQCLP(CLP(LEV))
      END IF
      RETURN     
C
C*PGUNSA -- restore PGPLOT attributes
C%void cpgunsa(void);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgunsa(  )
*

C+
      ENTRY PGUNSA
C
C This routine restores the PGPLOT attributes saved in the last call to
C PGSAVE. Usage: CALL PGUNSA (no arguments). See PGSAVE.
C
C Arguments: none
C-----------------------------------------------------------------------
      IF (LEV.LE.0) THEN
          CALL GRWARN('PGUNSA: nothing has been saved')
      ELSE
          CALL PGSCF(CF(LEV))
          CALL PGSCH(CH(LEV))
          CALL PGSCI(CI(LEV))
          CALL PGSFS(FS(LEV))
          CALL PGSLS(LS(LEV))
          CALL PGSLW(LW(LEV))
C          CALL PGSVP(VP(1,LEV), VP(2,LEV), VP(3,LEV), VP(4,LEV))
C          CALL PGSWIN(WIN(1,LEV), WIN(2,LEV), WIN(3,LEV), WIN(4,LEV))
          CALL PGMOVE(POS(1,LEV), POS(2,LEV))
          CALL PGSAH(AHFS(LEV), AHANG(LEV), AHBARB(LEV))
          CALL PGSTBG(TBG(LEV))
          CALL PGSHS(HSA(LEV), HSS(LEV), HSP(LEV))
          CALL PGSCLP(CLP(LEV))
          LEV = LEV-1
      END IF
      RETURN     
      END
#<

#>            pgsbci.dc2
Subroutine:   PGSBCI

Purpose:      Specify color index for displaying BLANKs by PGIMAG.

Category:     GRAPHICS

File:         pgplot.src

Author:       J.P. Terlouw

Use:          CALL PGSBCI(CI)

Updates:      Sep 30, 1999: JPT Document created.
#<

#>            pgsbci.f
* GIPSY-private
*
      SUBROUTINE PGSBCI (CI)
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgsbci( integer )
*
      INTEGER CI
      LOGICAL PGNOTO

      IF (PGNOTO('PGSBCI')) RETURN
      CALL GRSBCI(CI)
      END
#<

#>            pgscf.dc2
Name:         PGSCF

Purpose:      set character font

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSCF (FONT)
            INTEGER  FONT
      
       Set the Character Font for subsequent text plotting. Four different
       fonts are available:
         1: (default) a simple single-stroke font ("normal" font)
         2: roman font
         3: italic font
         4: script font
       This call determines which font is in effect at the beginning of
       each text string. The font can be changed (temporarily) within a text
       string by using the escape sequences \fn, \fr, \fi, and \fs for fonts
       1, 2, 3, and 4, respectively.
      
       Argument:
        FONT   (input)  : the font number to be used for subsequent text
                          plotting (in range 1-4).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgscf.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSCF -- set character font
C%void cpgscf(int font);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgscf( integer )
*

C+
      SUBROUTINE PGSCF (FONT)
      INTEGER  FONT
C
C Set the Character Font for subsequent text plotting. Four different
C fonts are available:
C   1: (default) a simple single-stroke font ("normal" font)
C   2: roman font
C   3: italic font
C   4: script font
C This call determines which font is in effect at the beginning of
C each text string. The font can be changed (temporarily) within a text
C string by using the escape sequences \fn, \fr, \fi, and \fs for fonts
C 1, 2, 3, and 4, respectively.
C
C Argument:
C  FONT   (input)  : the font number to be used for subsequent text
C                    plotting (in range 1-4).
C--
C 26-Sep-1985 - new routine [TJP].
C 25-OCT-1993 - changed name of argument [TJP].
C-----------------------------------------------------------------------
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGSCF')) RETURN
      CALL GRSFNT(FONT)
      END
#<

#>            pgsch.dc2
Name:         PGSCH

Purpose:      set character height

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSCH (SIZE)
            REAL SIZE
      
       Set the character size attribute. The size affects all text and graph
       markers drawn later in the program. The default character size is
       1.0, corresponding to a character height about 1/40 the height of
       the view surface.  Changing the character size also scales the length
       of tick marks drawn by PGBOX and terminals drawn by PGERRX and PGERRY.
      
       Argument:
        SIZE   (input)  : new character size (dimensionless multiple of
                          the default size).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgsch.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSCH -- set character height
C%void cpgsch(float size);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgsch( real )
*

C+
      SUBROUTINE PGSCH (SIZE)
      REAL SIZE
C
C Set the character size attribute. The size affects all text and graph
C markers drawn later in the program. The default character size is
C 1.0, corresponding to a character height about 1/40 the height of
C the view surface.  Changing the character size also scales the length
C of tick marks drawn by PGBOX and terminals drawn by PGERRX and PGERRY.
C
C Argument:
C  SIZE   (input)  : new character size (dimensionless multiple of
C                    the default size).
C--
C (1-Mar-1983)
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
      LOGICAL  PGNOTO
      REAL     XC, XCNEW, YC, XS, YS
C
      IF (PGNOTO('PGSCH')) RETURN
C
      CALL GRCHSZ(PGID, XC, YC, XS, YS)
      IF (PGXSZ(PGID)/PGXPIN(PGID) .GT.
     1    PGYSZ(PGID)/PGYPIN(PGID)) THEN
          XCNEW = SIZE*XC*PGYSZ(PGID)/YS/40.0
      ELSE
          XCNEW = SIZE*XC*(PGXSZ(PGID)*PGYPIN(PGID)/PGXPIN(PGID))
     1            /YS/40.0
      END IF
      CALL GRSETC(PGID,XCNEW)
      PGXSP(PGID) = XS*XCNEW/XC
      PGYSP(PGID) = YS*XCNEW/XC
      PGCHSZ(PGID) = SIZE
      END
#<

#>            pgsci.dc2
Name:         PGSCI

Purpose:      set color index

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSCI (CI)
            INTEGER  CI
      
       Set the Color Index for subsequent plotting, if the output device
       permits this. The default color index is 1, usually white on a black
       background for video displays or black on a white background for
       printer plots. The color index is an integer in the range 0 to a
       device-dependent maximum. Color index 0 corresponds to the background
       color; lines may be "erased" by overwriting them with color index 0
       (if the device permits this).
      
       If the requested color index is not available on the selected device,
       color index 1 will be substituted.
      
       The assignment of colors to color indices can be changed with
       subroutine PGSCR (set color representation).  Color indices 0-15
       have predefined color representations (see the PGPLOT manual), but
       these may be changed with PGSCR.  Color indices above 15  have no
       predefined representations: if these indices are used, PGSCR must
       be called to define the representation.
      
       Argument:
        CI     (input)  : the color index to be used for subsequent plotting
                          on the current device (in range 0-max). If the
                          index exceeds the device-dependent maximum, the
                          default color index (1) is used.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgsci.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSCI -- set color index
C%void cpgsci(int ci);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgsci( integer )
*

C+
      SUBROUTINE PGSCI (CI)
      INTEGER  CI
C
C Set the Color Index for subsequent plotting, if the output device
C permits this. The default color index is 1, usually white on a black
C background for video displays or black on a white background for
C printer plots. The color index is an integer in the range 0 to a
C device-dependent maximum. Color index 0 corresponds to the background
C color; lines may be "erased" by overwriting them with color index 0
C (if the device permits this).
C
C If the requested color index is not available on the selected device,
C color index 1 will be substituted.
C
C The assignment of colors to color indices can be changed with
C subroutine PGSCR (set color representation).  Color indices 0-15
C have predefined color representations (see the PGPLOT manual), but
C these may be changed with PGSCR.  Color indices above 15  have no
C predefined representations: if these indices are used, PGSCR must
C be called to define the representation.
C
C Argument:
C  CI     (input)  : the color index to be used for subsequent plotting
C                    on the current device (in range 0-max). If the
C                    index exceeds the device-dependent maximum, the
C                    default color index (1) is used.
C--
C 26-Sep-1985 - new routine [TJP].
C-----------------------------------------------------------------------
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGSCI')) RETURN
      CALL GRSCI(CI)
      END
#<

#>            pgscir.dc2
Name:         PGSCIR

Purpose:      set color index range

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSCIR(ICILO, ICIHI)
            INTEGER   ICILO, ICIHI
      
       Set the color index range to be used for producing images with
       PGGRAY or PGIMAG. If the range is not all within the range supported
       by the device, a smaller range will be used. The number of
       different colors available for images is ICIHI-ICILO+1.
      
       Arguments:
        ICILO  (input)  : the lowest color index to use for images
        ICIHI  (input)  : the highest color index to use for images

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgscir.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSCIR -- set color index range
C%void cpgscir(int icilo, int icihi);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgscir( integer, integer )
*

C+
      SUBROUTINE PGSCIR(ICILO, ICIHI)
      INTEGER   ICILO, ICIHI
C
C Set the color index range to be used for producing images with
C PGGRAY or PGIMAG. If the range is not all within the range supported
C by the device, a smaller range will be used. The number of
C different colors available for images is ICIHI-ICILO+1.
C
C Arguments:
C  ICILO  (input)  : the lowest color index to use for images
C  ICIHI  (input)  : the highest color index to use for images
C--
C 1994-Mar-17 : new routine [AFT/TJP].
C---
      INCLUDE 'pgplot.inc'
      INTEGER IC1, IC2
C---
      CALL GRQCOL(IC1,IC2)
      PGMNCI(PGID) = MIN(IC2,MAX(IC1,ICILO))
      PGMXCI(PGID) = MIN(IC2,MAX(IC1,ICIHI))
C
      END
#<

#>            pgsclp.dc2
Name:         PGSCLP

Purpose:      enable or disable clipping at edge of viewport

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSCLP(STATE)
            INTEGER STATE
      
       Normally all PGPLOT primitives except text are ``clipped'' at the
       edge of the viewport: parts of the primitives that lie outside
       the viewport are not drawn. If clipping is disabled by calling this
       routine, primitives are visible wherever they lie on the view
       surface. The default (clipping enabled) is appropriate for almost
       all applications.
      
       Argument:
        STATE  (input)  : 0 to disable clipping, or 1 to enable clipping.
       
       25-Feb-1997 [TJP] - new routine.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgsclp.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSCLP -- enable or disable clipping at edge of viewport
C%void cpgsclp(int state);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgsclp( integer )
*

C+
      SUBROUTINE PGSCLP(STATE)
      INTEGER STATE
C
C Normally all PGPLOT primitives except text are ``clipped'' at the
C edge of the viewport: parts of the primitives that lie outside
C the viewport are not drawn. If clipping is disabled by calling this
C routine, primitives are visible wherever they lie on the view
C surface. The default (clipping enabled) is appropriate for almost
C all applications.
C
C Argument:
C  STATE  (input)  : 0 to disable clipping, or 1 to enable clipping.
C 
C 25-Feb-1997 [TJP] - new routine.
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGSCLP')) RETURN
C
C Disable clipping.
C
      IF (STATE.EQ.0) THEN
         CALL GRAREA(PGID,0.,0.,-1.,-1.)
         PGCLP(PGID) = 0
C
C Enable clipping.
C
      ELSE
         CALL GRAREA(PGID,PGXOFF(PGID),PGYOFF(PGID),
     :               PGXLEN(PGID),PGYLEN(PGID))
         PGCLP(PGID) = 1
      END IF
      END
#<

#>            pgscr.dc2
Name:         PGSCR

Purpose:      set color representation

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSCR (CI, CR, CG, CB)
            INTEGER CI
            REAL    CR, CG, CB
      
       Set color representation: i.e., define the color to be
       associated with a color index.  Ignored for devices which do not
       support variable color or intensity.  Color indices 0-15
       have predefined color representations (see the PGPLOT manual), but
       these may be changed with PGSCR.  Color indices 16-maximum have no
       predefined representations: if these indices are used, PGSCR must
       be called to define the representation. On monochrome output
       devices (e.g. VT125 terminals with monochrome monitors), the
       monochrome intensity is computed from the specified Red, Green, Blue
       intensities as 0.30*R + 0.59*G + 0.11*B, as in US color television
       systems, NTSC encoding.  Note that most devices do not have an
       infinite range of colors or monochrome intensities available;
       the nearest available color is used.  Examples: for black,
       set CR=CG=CB=0.0; for white, set CR=CG=CB=1.0; for medium gray,
       set CR=CG=CB=0.5; for medium yellow, set CR=CG=0.5, CB=0.0.
      
       Argument:
        CI     (input)  : the color index to be defined, in the range 0-max.
                          If the color index greater than the device
                          maximum is specified, the call is ignored. Color
                          index 0 applies to the background color.
        CR     (input)  : red, green, and blue intensities,
        CG     (input)    in range 0.0 to 1.0.
        CB     (input)

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgscr.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSCR -- set color representation
C%void cpgscr(int ci, float cr, float cg, float cb);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgscr( integer, real, real, real )
*

C+
      SUBROUTINE PGSCR (CI, CR, CG, CB)
      INTEGER CI
      REAL    CR, CG, CB
C
C Set color representation: i.e., define the color to be
C associated with a color index.  Ignored for devices which do not
C support variable color or intensity.  Color indices 0-15
C have predefined color representations (see the PGPLOT manual), but
C these may be changed with PGSCR.  Color indices 16-maximum have no
C predefined representations: if these indices are used, PGSCR must
C be called to define the representation. On monochrome output
C devices (e.g. VT125 terminals with monochrome monitors), the
C monochrome intensity is computed from the specified Red, Green, Blue
C intensities as 0.30*R + 0.59*G + 0.11*B, as in US color television
C systems, NTSC encoding.  Note that most devices do not have an
C infinite range of colors or monochrome intensities available;
C the nearest available color is used.  Examples: for black,
C set CR=CG=CB=0.0; for white, set CR=CG=CB=1.0; for medium gray,
C set CR=CG=CB=0.5; for medium yellow, set CR=CG=0.5, CB=0.0.
C
C Argument:
C  CI     (input)  : the color index to be defined, in the range 0-max.
C                    If the color index greater than the device
C                    maximum is specified, the call is ignored. Color
C                    index 0 applies to the background color.
C  CR     (input)  : red, green, and blue intensities,
C  CG     (input)    in range 0.0 to 1.0.
C  CB     (input)
C--
C 5-Nov-1985 - new routine [TJP].
C-----------------------------------------------------------------------
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGSCR')) RETURN
      CALL GRSCR(CI,CR,CG,CB)
      END
#<

#>            pgscrl.dc2
Name:         PGSCRL

Purpose:      scroll window

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSCRL (DX, DY)
            REAL DX, DY
      
       This routine moves the window in world-coordinate space while
       leaving the viewport unchanged. On devices that have the
       capability, the pixels within the viewport are scrolled
       horizontally, vertically or both in such a way that graphics
       previously drawn in the window are shifted so that their world
       coordinates are unchanged.
      
       If the old window coordinate range was (X1, X2, Y1, Y2), the new
       coordinate range will be approximately (X1+DX, X2+DX, Y1+DY, Y2+DY).
       The size and scale of the window are unchanged.
      
       Thee window can only be shifted by a whole number of pixels
       (device coordinates). If DX and DY do not correspond to integral
       numbers of pixels, the shift will be slightly different from that
       requested. The new window-coordinate range, and hence the exact
       amount of the shift, can be determined by calling PGQWIN after this
       routine.
      
       Pixels that are moved out of the viewport by this operation are
       lost completely; they cannot be recovered by scrolling back.
       Pixels that are ``scrolled into'' the viewport are filled with
       the background color (color index 0).
      
       If the absolute value of DX is bigger than the width of the window,
       or the aboslute value of DY is bigger than the height of the window,
       the effect will be the same as zeroing all the pixels in the
       viewport.
      
       Not all devices have the capability to support this routine.
       It is only available on some interactive devices that have discrete
       pixels. To determine whether the current device has scroll capability,
       call PGQINF.
      
       Arguments:
        DX     (input)  : distance (in world coordinates) to shift the
                          window horizontally (positive shifts window to the
                          right and scrolls to the left).
        DY     (input)  : distance (in world coordinates) to shift the
                          window vertically (positive shifts window up and
                          scrolls down).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgscrl.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSCRL -- scroll window
C%void cpgscrl(float dx, float dy);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgscrl( real, real )
*

C+
      SUBROUTINE PGSCRL (DX, DY)
      REAL DX, DY
C
C This routine moves the window in world-coordinate space while
C leaving the viewport unchanged. On devices that have the
C capability, the pixels within the viewport are scrolled
C horizontally, vertically or both in such a way that graphics
C previously drawn in the window are shifted so that their world
C coordinates are unchanged.
C
C If the old window coordinate range was (X1, X2, Y1, Y2), the new
C coordinate range will be approximately (X1+DX, X2+DX, Y1+DY, Y2+DY).
C The size and scale of the window are unchanged.
C
C Thee window can only be shifted by a whole number of pixels
C (device coordinates). If DX and DY do not correspond to integral
C numbers of pixels, the shift will be slightly different from that
C requested. The new window-coordinate range, and hence the exact
C amount of the shift, can be determined by calling PGQWIN after this
C routine.
C
C Pixels that are moved out of the viewport by this operation are
C lost completely; they cannot be recovered by scrolling back.
C Pixels that are ``scrolled into'' the viewport are filled with
C the background color (color index 0).
C
C If the absolute value of DX is bigger than the width of the window,
C or the aboslute value of DY is bigger than the height of the window,
C the effect will be the same as zeroing all the pixels in the
C viewport.
C
C Not all devices have the capability to support this routine.
C It is only available on some interactive devices that have discrete
C pixels. To determine whether the current device has scroll capability,
C call PGQINF.
C
C Arguments:
C  DX     (input)  : distance (in world coordinates) to shift the
C                    window horizontally (positive shifts window to the
C                    right and scrolls to the left).
C  DY     (input)  : distance (in world coordinates) to shift the
C                    window vertically (positive shifts window up and
C                    scrolls down).
C--
C 25-Feb-97: new routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      LOGICAL PGNOTO
      REAL X1, X2, Y1, Y2, DDX, DDY
      INTEGER NDX, NDY
C
      IF (PGNOTO('PGSCRL')) RETURN
C
C Shift must be a whole number of pixels.
C
      NDX = NINT(DX*PGXSCL(PGID))
      NDY = NINT(DY*PGYSCL(PGID))
C
      IF (NDX.NE.0 .OR. NDY.NE.0) THEN
         CALL PGBBUF
         DDX = NDX/PGXSCL(PGID)
         DDY = NDY/PGYSCL(PGID)
C
C        -- Set new world-ccordinate window.
C
         X1 = PGXBLC(PGID)
         X2 = PGXTRC(PGID)
         Y1 = PGYBLC(PGID)
         Y2 = PGYTRC(PGID)
         PGXBLC(PGID) = X1+DDX
         PGXTRC(PGID) = X2+DDX
         PGYBLC(PGID) = Y1+DDY
         PGYTRC(PGID) = Y2+DDY
         CALL PGVW
C
C        -- Do hardware scroll.
C
         CALL GRSCRL(NDX, NDY)
         CALL PGEBUF
      END IF
      END
#<

#>            pgscrn.dc2
Name:         PGSCRN

Purpose:      set color representation by name

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSCRN(CI, NAME, IER)
            INTEGER CI
            CHARACTER*(*) NAME
            INTEGER IER
      
       Set color representation: i.e., define the color to be
       associated with a color index.  Ignored for devices which do not
       support variable color or intensity.  This is an alternative to
       routine PGSCR. The color representation is defined by name instead
       of (R,G,B) components.
      
       Color names are defined in an external file which is read the first
       time that PGSCRN is called. The name of the external file is
       found as follows:
       1. if environment variable (logical name) PGPLOT_RGB is defined,
          its value is used as the file name;
       2. otherwise, if environment variable PGPLOT_DIR is defined, a
          file "rgb.txt" in the directory named by this environment
          variable is used;
       3. otherwise, file "rgb.txt" in the current directory is used.
       If all of these fail to find a file, an error is reported and
       the routine does nothing.
      
       Each line of the file
       defines one color, with four blank- or tab-separated fields per
       line. The first three fields are the R, G, B components, which
       are integers in the range 0 (zero intensity) to 255 (maximum
       intensity). The fourth field is the color name. The color name
       may include embedded blanks. Example:
      
       255   0   0 red
       255 105 180 hot pink
       255 255 255 white
         0   0   0 black
      
       Arguments:
        CI     (input)  : the color index to be defined, in the range 0-max.
                          If the color index greater than the device
                          maximum is specified, the call is ignored. Color
                          index 0 applies to the background color.
        NAME   (input)  : the name of the color to be associated with
                          this color index. This name must be in the
                          external file. The names are not case-sensitive.
                          If the color is not listed in the file, the
                          color representation is not changed.
        IER    (output) : returns 0 if the routine was successful, 1
                          if an error occurred (either the external file
                          could not be read, or the requested color was
                          not defined in the file).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgscrn.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSCRN -- set color representation by name
C%void cpgscrn(int ci, const char *name, int *ier);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgscrn( integer, character, integer )
*

C+
      SUBROUTINE PGSCRN(CI, NAME, IER)
      INTEGER CI
      CHARACTER*(*) NAME
      INTEGER IER
C
C Set color representation: i.e., define the color to be
C associated with a color index.  Ignored for devices which do not
C support variable color or intensity.  This is an alternative to
C routine PGSCR. The color representation is defined by name instead
C of (R,G,B) components.
C
C Color names are defined in an external file which is read the first
C time that PGSCRN is called. The name of the external file is
C found as follows:
C 1. if environment variable (logical name) PGPLOT_RGB is defined,
C    its value is used as the file name;
C 2. otherwise, if environment variable PGPLOT_DIR is defined, a
C    file "rgb.txt" in the directory named by this environment
C    variable is used;
C 3. otherwise, file "rgb.txt" in the current directory is used.
C If all of these fail to find a file, an error is reported and
C the routine does nothing.
C
C Each line of the file
C defines one color, with four blank- or tab-separated fields per
C line. The first three fields are the R, G, B components, which
C are integers in the range 0 (zero intensity) to 255 (maximum
C intensity). The fourth field is the color name. The color name
C may include embedded blanks. Example:
C
C 255   0   0 red
C 255 105 180 hot pink
C 255 255 255 white
C   0   0   0 black
C
C Arguments:
C  CI     (input)  : the color index to be defined, in the range 0-max.
C                    If the color index greater than the device
C                    maximum is specified, the call is ignored. Color
C                    index 0 applies to the background color.
C  NAME   (input)  : the name of the color to be associated with
C                    this color index. This name must be in the
C                    external file. The names are not case-sensitive.
C                    If the color is not listed in the file, the
C                    color representation is not changed.
C  IER    (output) : returns 0 if the routine was successful, 1
C                    if an error occurred (either the external file
C                    could not be read, or the requested color was
C                    not defined in the file).
C--
C 12-Oct-1992 [TJP]
C 31-May-1993 [TJP] use GROPTX to open file.
C  7-Nov-1994 [TJP] better error messages.
C-----------------------------------------------------------------------
      INTEGER MAXCOL
      PARAMETER (MAXCOL=1000)
      INTEGER I, IR, IG, IB, J, L, NCOL, UNIT, IOS
      INTEGER GRCTOI, GROPTX, GRTRIM
      REAL RR(MAXCOL), RG(MAXCOL), RB(MAXCOL)
      CHARACTER*20 CREQ, CNAME(MAXCOL)
      CHARACTER*255 TEXT
      SAVE NCOL, CNAME, RR, RG, RB
      DATA NCOL/0/
C
C On first call, read the database.
C
      IF (NCOL.EQ.0) THEN
          CALL GRGFIL('RGB', TEXT)
          L = GRTRIM(TEXT)
          IF (L.LT.1) L = 1
          CALL GRGLUN(UNIT)
          IOS = GROPTX(UNIT, TEXT(1:L), 'rgb.txt', 0)
          IF (IOS.NE.0) GOTO 40
          DO 10 I=1,MAXCOL
              READ (UNIT, '(A)', ERR=15, END=15) TEXT
              J = 1
              CALL GRSKPB(TEXT, J)
              IR = GRCTOI(TEXT, J)
              CALL GRSKPB(TEXT, J)
              IG = GRCTOI(TEXT, J)
              CALL GRSKPB(TEXT, J)
              IB = GRCTOI(TEXT, J)
              CALL GRSKPB(TEXT, J)
              NCOL = NCOL+1
              CALL GRTOUP(CNAME(NCOL), TEXT(J:))
              RR(NCOL) = IR/255.0
              RG(NCOL) = IG/255.0
              RB(NCOL) = IB/255.0
   10     CONTINUE
   15     CLOSE (UNIT)
          CALL GRFLUN(UNIT)
      END IF
C
C Look up requested color and set color representation if found.
C
      CALL GRTOUP(CREQ, NAME)
      DO 20 I=1,NCOL
          IF (CREQ.EQ.CNAME(I)) THEN
              CALL PGSCR(CI, RR(I), RG(I), RB(I))
              IER = 0
              RETURN
          END IF
   20 CONTINUE
C
C Color not found.
C
      IER = 1
      TEXT = 'Color not found: '//NAME
      CALL GRWARN(TEXT)
      RETURN
C
C Database not found.
C
   40 IER = 1
      NCOL = -1
      CALL GRFLUN(UNIT)
      CALL GRWARN('Unable to read color file: '//TEXT(1:L))
      CALL GRWARN('Use environment variable PGPLOT_RGB to specify '//
     :            'the location of the PGPLOT rgb.txt file.')
      RETURN
      END
#<

#>            pgsetc.dc3
Name:         pgsetc

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Oct 16, 1998: JPT automatically generated.
#<

#>            pgsetc.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C
      SUBROUTINE PGSETC (SIZE)
      REAL SIZE
      CALL PGSCH(SIZE)
      END
#<

#>            pgsfs.dc2
Name:         PGSFS

Purpose:      set fill-area style

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSFS (FS)
            INTEGER  FS
      
       Set the Fill-Area Style attribute for subsequent area-fill by
       PGPOLY, PGRECT, or PGCIRC.  Four different styles are available: 
       solid (fill polygon with solid color of the current color-index), 
       outline (draw outline of polygon only, using current line attributes),
       hatched (shade interior of polygon with parallel lines, using
       current line attributes), or cross-hatched. The orientation and
       spacing of hatch lines can be specified with routine PGSHS (set
       hatch style).
      
       Argument:
        FS     (input)  : the fill-area style to be used for subsequent
                          plotting:
                            FS = 1 => solid (default)
                            FS = 2 => outline
                            FS = 3 => hatched
                            FS = 4 => cross-hatched
                          Other values give an error message and are
                          treated as 2.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgsfs.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSFS -- set fill-area style
C%void cpgsfs(int fs);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgsfs( integer )
*

C+
      SUBROUTINE PGSFS (FS)
      INTEGER  FS
C
C Set the Fill-Area Style attribute for subsequent area-fill by
C PGPOLY, PGRECT, or PGCIRC.  Four different styles are available: 
C solid (fill polygon with solid color of the current color-index), 
C outline (draw outline of polygon only, using current line attributes),
C hatched (shade interior of polygon with parallel lines, using
C current line attributes), or cross-hatched. The orientation and
C spacing of hatch lines can be specified with routine PGSHS (set
C hatch style).
C
C Argument:
C  FS     (input)  : the fill-area style to be used for subsequent
C                    plotting:
C                      FS = 1 => solid (default)
C                      FS = 2 => outline
C                      FS = 3 => hatched
C                      FS = 4 => cross-hatched
C                    Other values give an error message and are
C                    treated as 2.
C--
C 21-Oct-1985 - new routine [TJP].
C 17-Dec-1990 - pass to GR level [TJP].
C  6-Mar-1995 - add styles 3 and 4 [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGSFS')) RETURN
      IF (FS.LT.1 .OR. FS.GT.4) THEN
          CALL GRWARN('illegal fill-area style requested')
          PGFAS(PGID) = 2
      ELSE
          PGFAS(PGID) = FS
      END IF
      END
#<

#>            pgshls.dc2
Name:         PGSHLS

Purpose:      set color representation using HLS system

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSHLS (CI, CH, CL, CS)
            INTEGER CI
            REAL    CH, CL, CS
      
       Set color representation: i.e., define the color to be
       associated with a color index.  This routine is equivalent to
       PGSCR, but the color is defined in the Hue-Lightness-Saturation
       model instead of the Red-Green-Blue model. Hue is represented
       by an angle in degrees, with red at 120, green at 240,
       and blue at 0 (or 360). Lightness ranges from 0.0 to 1.0, with black
       at lightness 0.0 and white at lightness 1.0. Saturation ranges from
       0.0 (gray) to 1.0 (pure color). Hue is irrelevant when saturation
       is 0.0.
      
       Examples:           H     L     S        R     G     B
           black          any   0.0   0.0      0.0   0.0   0.0
           white          any   1.0   0.0      1.0   1.0   1.0
           medium gray    any   0.5   0.0      0.5   0.5   0.5
           red            120   0.5   1.0      1.0   0.0   0.0
           yellow         180   0.5   1.0      1.0   1.0   0.0
           pink           120   0.7   0.8      0.94  0.46  0.46
      
       Reference: SIGGRAPH Status Report of the Graphic Standards Planning
       Committee, Computer Graphics, Vol.13, No.3, Association for
       Computing Machinery, New York, NY, 1979. See also: J. D. Foley et al,
       ``Computer Graphics: Principles and Practice'', second edition,
       Addison-Wesley, 1990, section 13.3.5.
      
       Argument:
        CI     (input)  : the color index to be defined, in the range 0-max.
                          If the color index greater than the device
                          maximum is specified, the call is ignored. Color
                          index 0 applies to the background color.
        CH     (input)  : hue, in range 0.0 to 360.0.
        CL     (input)  : lightness, in range 0.0 to 1.0.
        CS     (input)  : saturation, in range 0.0 to 1.0.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgshls.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSHLS -- set color representation using HLS system
C%void cpgshls(int ci, float ch, float cl, float cs);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgshls( integer, real, real, real )
*

C+
      SUBROUTINE PGSHLS (CI, CH, CL, CS)
      INTEGER CI
      REAL    CH, CL, CS
C
C Set color representation: i.e., define the color to be
C associated with a color index.  This routine is equivalent to
C PGSCR, but the color is defined in the Hue-Lightness-Saturation
C model instead of the Red-Green-Blue model. Hue is represented
C by an angle in degrees, with red at 120, green at 240,
C and blue at 0 (or 360). Lightness ranges from 0.0 to 1.0, with black
C at lightness 0.0 and white at lightness 1.0. Saturation ranges from
C 0.0 (gray) to 1.0 (pure color). Hue is irrelevant when saturation
C is 0.0.
C
C Examples:           H     L     S        R     G     B
C     black          any   0.0   0.0      0.0   0.0   0.0
C     white          any   1.0   0.0      1.0   1.0   1.0
C     medium gray    any   0.5   0.0      0.5   0.5   0.5
C     red            120   0.5   1.0      1.0   0.0   0.0
C     yellow         180   0.5   1.0      1.0   1.0   0.0
C     pink           120   0.7   0.8      0.94  0.46  0.46
C
C Reference: SIGGRAPH Status Report of the Graphic Standards Planning
C Committee, Computer Graphics, Vol.13, No.3, Association for
C Computing Machinery, New York, NY, 1979. See also: J. D. Foley et al,
C ``Computer Graphics: Principles and Practice'', second edition,
C Addison-Wesley, 1990, section 13.3.5.
C
C Argument:
C  CI     (input)  : the color index to be defined, in the range 0-max.
C                    If the color index greater than the device
C                    maximum is specified, the call is ignored. Color
C                    index 0 applies to the background color.
C  CH     (input)  : hue, in range 0.0 to 360.0.
C  CL     (input)  : lightness, in range 0.0 to 1.0.
C  CS     (input)  : saturation, in range 0.0 to 1.0.
C--
C 9-May-1988 - new routine [TJP].
C-----------------------------------------------------------------------
      REAL CR, CG, CB
      CALL GRXRGB (CH,CL,CS,CR,CG,CB)
      CALL GRSCR(CI,CR,CG,CB)
      END
#<

#>            pgshs.dc2
Name:         PGSHS

Purpose:      set hatching style

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSHS (ANGLE, SEPN, PHASE)
            REAL ANGLE, SEPN, PHASE
      
       Set the style to be used for hatching (fill area with fill-style 3).
       The default style is ANGLE=45.0, SEPN=1.0, PHASE=0.0.
      
       Arguments:
        ANGLE  (input)  : the angle the hatch lines make with the
                          horizontal, in degrees, increasing 
                          counterclockwise (this is an angle on the
                          view surface, not in world-coordinate space).
        SEPN   (input)  : the spacing of the hatch lines. The unit spacing
                          is 1 percent of the smaller of the height or
                          width of the view surface. This should not be
                          zero.
        PHASE  (input)  : a real number between 0 and 1; the hatch lines
                          are displaced by this fraction of SEPN from a
                          fixed reference.  Adjacent regions hatched with the
                          same PHASE have contiguous hatch lines. To hatch
                          a region with alternating lines of two colors,
                          fill the area twice, with PHASE=0.0 for one color
                          and PHASE=0.5 for the other color.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgshs.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSHS -- set hatching style
C%void cpgshs(float angle, float sepn, float phase);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgshs( real, real, real )
*

C+
      SUBROUTINE PGSHS (ANGLE, SEPN, PHASE)
      REAL ANGLE, SEPN, PHASE
C
C Set the style to be used for hatching (fill area with fill-style 3).
C The default style is ANGLE=45.0, SEPN=1.0, PHASE=0.0.
C
C Arguments:
C  ANGLE  (input)  : the angle the hatch lines make with the
C                    horizontal, in degrees, increasing 
C                    counterclockwise (this is an angle on the
C                    view surface, not in world-coordinate space).
C  SEPN   (input)  : the spacing of the hatch lines. The unit spacing
C                    is 1 percent of the smaller of the height or
C                    width of the view surface. This should not be
C                    zero.
C  PHASE  (input)  : a real number between 0 and 1; the hatch lines
C                    are displaced by this fraction of SEPN from a
C                    fixed reference.  Adjacent regions hatched with the
C                    same PHASE have contiguous hatch lines. To hatch
C                    a region with alternating lines of two colors,
C                    fill the area twice, with PHASE=0.0 for one color
C                    and PHASE=0.5 for the other color.
C--
C 26-Feb-1995 - new routine [TJP].
C 12-Feb-1996 - check for zero spacing [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGSHS')) RETURN
      PGHSA(PGID) = ANGLE
      IF (SEPN.EQ.0.0) THEN
         CALL GRWARN('PGSHS: zero hatch line spacing requested')
         PGHSS(PGID) = 1.0
      ELSE
         PGHSS(PGID) = SEPN
      END IF
      IF (PHASE.LT.0.0 .OR. PHASE.GT.1.0) THEN
         CALL GRWARN('PGSHS: hatching phase must be in (0.0,1.0)')
      END IF
      PGHSP(PGID) = PHASE
C
      END
#<

#>            pgsimi.dc2
Subroutine:   PGSIMI

Purpose:      Specify the interpolation to be used by PGIMAG.

Category:     GRAPHICS

File:         pgplot.src

Author:       J.P. Terlouw

Use:          CALL PGSIMI(INTP)

              INTP    The interpolation mode (INTEGER).

                        0 - no interpolation is performed
                        1 - bilinear interpolation

              Both pixel devices (e.g. the Ggi plot device) and PostScript
              image devices are supported. In the case of PostScript
              devices, interpolation is implemented in the PostScript
              language, which is not in all cases optimal. E.g. when
              a color map with discontinuities is used, or when BLANKs
              are present, results will be different.

Updates:      Apr 18, 2000: JPT Document created.
#<

#>            pgsimi.f
* GIPSY-private
*
      SUBROUTINE PGSIMI(INTP)
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgsimi( integer )
*
      INCLUDE 'grpckg1.inc'
      INTEGER INTP
C
C Error if no workstation is open.
C
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRSIMI - no graphics device is active.')
          RETURN
      END IF

      GRIMIP(GRCIDE) = INTP
      RETURN

      ENTRY PGQIMI(INTP)
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgqimi( integer )
*

C
C Error if no workstation is open.
C 
      IF (GRCIDE.LT.1) THEN
          CALL GRWARN('GRQIMI - no graphics device is active.')
          RETURN
      END IF

      INTP = GRIMIP(GRCIDE)
      RETURN

      END
#<

#>            pgsitf.dc2
Name:         PGSITF

Purpose:      set image transfer function

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSITF (ITF)
            INTEGER  ITF
      
       Set the Image Transfer Function for subsequent images drawn by
       PGIMAG, PGGRAY, or PGWEDG. The Image Transfer Function is used
       to map array values into the available range of color indices
       specified with routine PGSCIR or (for PGGRAY on some devices)
       into dot density.
      
       Argument:
        ITF    (input)  : type of transfer function:
                            ITF = 0 : linear
                            ITF = 1 : logarithmic
                            ITF = 2 : square-root

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgsitf.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSITF -- set image transfer function
C%void cpgsitf(int itf);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgsitf( integer )
*

C+
      SUBROUTINE PGSITF (ITF)
      INTEGER  ITF
C
C Set the Image Transfer Function for subsequent images drawn by
C PGIMAG, PGGRAY, or PGWEDG. The Image Transfer Function is used
C to map array values into the available range of color indices
C specified with routine PGSCIR or (for PGGRAY on some devices)
C into dot density.
C
C Argument:
C  ITF    (input)  : type of transfer function:
C                      ITF = 0 : linear
C                      ITF = 1 : logarithmic
C                      ITF = 2 : square-root
C--
C 15-Sep-1994 - new routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGSITF')) RETURN
      IF (ITF.LT.0 .OR. ITF.GT.2) THEN
          PGITF(PGID) = 0
          CALL GRWARN('PGSITF: argument must be 0, 1, or 2')
      ELSE
          PGITF(PGID) = ITF
      END IF
      END
#<

#>            pgsize.dc3
Name:         pgsize

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Oct 16, 1998: JPT automatically generated.
#<

#>            pgsize.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C
      SUBROUTINE PGSIZE (WIDTH, HEIGHT, SHIFTX, SHIFTY, DUMMY)
C
C PGPLOT (obsolete routine; use PGVSIZ in preference): Change the
C size and position of the viewport.
C
C Arguments:
C
C WIDTH (input, real) : width of viewport in inches.
C HEIGHT (input, real) : height of viewport in inches.
C SHIFTX (input, real) : horizontal offset of bottom left corner
C       from blc of page or panel, in inches.
C SHIFTY (input, real) : vertical offset of bottom left corner
C       from blc of page or panel, in inches.
C DUMMY (input, real) : reserved for future use (must be 0.0).
C--
C 13-Dec-1990  Make errors non-fatal [TJP].
C-----------------------------------------------------------------------
      REAL     WIDTH,HEIGHT,SHIFTX,SHIFTY,DUMMY
C
      IF (WIDTH.LE.0.0 .OR. HEIGHT.LE.0.0 .OR. DUMMY.NE.0.0) THEN
          CALL GRWARN('PGSIZE ignored: invalid arguments')
          RETURN
      END IF
C
      CALL PGVSIZ(SHIFTX, SHIFTX+WIDTH, SHIFTY, SHIFTY+HEIGHT)
      END
#<

#>            pgslct.dc2
Name:         PGSLCT

Purpose:      select an open graphics device

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSLCT(ID)
            INTEGER ID
      
       Select one of the open graphics devices and direct subsequent
       plotting to it. The argument is the device identifier returned by
       PGOPEN when the device was opened. If the supplied argument is not a
       valid identifier of an open graphics device, a warning message is
       issued and the current selection is unchanged.
      
       [This routine was added to PGPLOT in Version 5.1.0.]
      
       Arguments:
      
       ID (input, integer): identifier of the device to be selected.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgslct.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSLCT -- select an open graphics device
C%void cpgslct(int id);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgslct( integer )
*

C+
      SUBROUTINE PGSLCT(ID)
      INTEGER ID
C
C Select one of the open graphics devices and direct subsequent
C plotting to it. The argument is the device identifier returned by
C PGOPEN when the device was opened. If the supplied argument is not a
C valid identifier of an open graphics device, a warning message is
C issued and the current selection is unchanged.
C
C [This routine was added to PGPLOT in Version 5.1.0.]
C
C Arguments:
C
C ID (input, integer): identifier of the device to be selected.
C--
C 22-Dec-1995 - new routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
C
      IF (ID.LT.1 .OR. ID.GT.PGMAXD) THEN
         CALL GRWARN('PGSLCT: invalid argument')
      ELSE IF (PGDEVS(ID).NE.1) THEN
         CALL GRWARN('PGSLCT: requested device is not open')
      ELSE
C        -- Select the new device
         PGID = ID
         CALL GRSLCT(PGID)
      END IF
C
      END
#<

#>            pgsls.dc2
Name:         PGSLS

Purpose:      set line style

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSLS (LS)
            INTEGER  LS
      
       Set the line style attribute for subsequent plotting. This
       attribute affects line primitives only; it does not affect graph
       markers, text, or area fill.
       Five different line styles are available, with the following codes:
       1 (full line), 2 (dashed), 3 (dot-dash-dot-dash), 4 (dotted),
       5 (dash-dot-dot-dot). The default is 1 (normal full line).
      
       Argument:
        LS     (input)  : the line-style code for subsequent plotting
                          (in range 1-5).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgsls.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSLS -- set line style
C%void cpgsls(int ls);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgsls( integer )
*

C+
      SUBROUTINE PGSLS (LS)
      INTEGER  LS
C
C Set the line style attribute for subsequent plotting. This
C attribute affects line primitives only; it does not affect graph
C markers, text, or area fill.
C Five different line styles are available, with the following codes:
C 1 (full line), 2 (dashed), 3 (dot-dash-dot-dash), 4 (dotted),
C 5 (dash-dot-dot-dot). The default is 1 (normal full line).
C
C Argument:
C  LS     (input)  : the line-style code for subsequent plotting
C                    (in range 1-5).
C--
C  8-Aug-1985 - new routine, equivalent to GRSLS [TJP].
C  3-Jun-1984 - add GMFILE device [TJP].
C-----------------------------------------------------------------------
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGSLS')) RETURN
      CALL GRSLS(LS)
      END
#<

#>            pgslw.dc2
Name:         PGSLW

Purpose:      set line width

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSLW (LW)
            INTEGER  LW
      
       Set the line-width attribute. This attribute affects lines, graph
       markers, and text. The line width is specified in units of 1/200 
       (0.005) inch (about 0.13 mm) and must be an integer in the range
       1-201. On some devices, thick lines are generated by tracing each
       line with multiple strokes offset in the direction perpendicular to
       the line.
      
       Argument:
        LW     (input)  : width of line, in units of 0.005 inch (0.13 mm)
                          in range 1-201.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgslw.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSLW -- set line width
C%void cpgslw(int lw);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgslw( integer )
*

C+
      SUBROUTINE PGSLW (LW)
      INTEGER  LW
C
C Set the line-width attribute. This attribute affects lines, graph
C markers, and text. The line width is specified in units of 1/200 
C (0.005) inch (about 0.13 mm) and must be an integer in the range
C 1-201. On some devices, thick lines are generated by tracing each
C line with multiple strokes offset in the direction perpendicular to
C the line.
C
C Argument:
C  LW     (input)  : width of line, in units of 0.005 inch (0.13 mm)
C                    in range 1-201.
C--
C  8-Aug-1985 - new routine, equivalent to GRSLW [TJP].
C  1-Feb-1995 - change comment [TJP].
C-----------------------------------------------------------------------
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGSLW')) RETURN
      CALL GRSLW(LW)
      END
#<

#>            pgsncr.dc2
Name:         PGSNCR

Purpose:      set multiple color representations

Category:     GRAPHICS

File:         pgplot.src

Author:       J. P. Terlouw

Use:          see description below.

Description:

            SUBROUTINE PGSCR (CI, CR, CG, CB, N)
            INTEGER CI, N
            REAL    CR(N), CG(N), CB(N)
      
       Set color representations: i.e., define the colors to be
       associated with a range of color indices. Ignored for devices which
       do not support variable color or intensity.  Color indices 0-15
       have predefined color representations (see the PGPLOT manual), but
       these may be changed.  Color indices 16-maximum have no
       predefined representations: if these indices are used, PGSNCR can
       be called to define the representation. On monochrome output
       devices (e.g. VT125 terminals with monochrome monitors), the
       monochrome intensity is computed from the specified Red, Green, Blue
       intensities as 0.30*R + 0.59*G + 0.11*B, as in US color television
       systems, NTSC encoding.  Note that most devices do not have an
       infinite range of colors or monochrome intensities available;
       the nearest available color is used.  Examples: for black,
       set CR=CG=CB=0.0; for white, set CR=CG=CB=1.0; for medium gray,
       set CR=CG=CB=0.5; for medium yellow, set CR=CG=0.5, CB=0.0.
      
       Argument:
        CI     (input)  : first colour index. If any colour index is
                          is outside the range available on the device,
                          the call is ignored. Color index 0 applies to
                          the background color.
        CR     (input)  : arrays of red, green, and blue intensities,
        CG     (input)    in range 0.0 to 1.0.
        CB     (input)
        N      (input)  : number of colour indices to be modified.

       This subroutine is an extension of PGSCR, which allows one
       color index to be modified.

Updates:      Sep  3, 1999: JPT document created.
#<

#>            pgsncr.f
* GIPSY-private
*
* GIPSY Fortran to C interface:
*
*@ subroutine pgsncr( integer, real, real, real, integer )
*

      SUBROUTINE PGSNCR (CI, CR, CG, CB, N)
      INTEGER CI, N
      REAL    CR(N), CG(N), CB(N)
      LOGICAL PGNOTO
      CHARACTER DEVTYP*14
      LOGICAL   DEVINT
C
      IF (PGNOTO('PGSNCR')) RETURN
      CALL GRQTYP (DEVTYP, DEVINT)
      IF (DEVTYP.EQ.'GGI') THEN
         CALL GRSNCR(CI,CR,CG,CB,N)
      ELSE
         DO 1 I=1,N
         CALL GRSCR(CI+I-1, CR(I), CG(I), CB(I) )
    1    CONTINUE
      END IF
      END
#<

#>            pgstbg.dc2
Name:         PGSTBG

Purpose:      set text background color index

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSTBG (TBCI)
            INTEGER  TBCI
      
       Set the Text Background Color Index for subsequent text. By default
       text does not obscure underlying graphics. If the text background
       color index is positive, however, text is opaque: the bounding box
       of the text is filled with the color specified by PGSTBG before
       drawing the text characters in the current color index set by PGSCI.
       Use color index 0 to erase underlying graphics before drawing text.
      
       Argument:
        TBCI   (input)  : the color index to be used for the background
                          for subsequent text plotting:
                            TBCI < 0  => transparent (default)
                            TBCI >= 0 => text will be drawn on an opaque
                          background with color index TBCI.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgstbg.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSTBG -- set text background color index
C%void cpgstbg(int tbci);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgstbg( integer )
*

C+
      SUBROUTINE PGSTBG (TBCI)
      INTEGER  TBCI
C
C Set the Text Background Color Index for subsequent text. By default
C text does not obscure underlying graphics. If the text background
C color index is positive, however, text is opaque: the bounding box
C of the text is filled with the color specified by PGSTBG before
C drawing the text characters in the current color index set by PGSCI.
C Use color index 0 to erase underlying graphics before drawing text.
C
C Argument:
C  TBCI   (input)  : the color index to be used for the background
C                    for subsequent text plotting:
C                      TBCI < 0  => transparent (default)
C                      TBCI >= 0 => text will be drawn on an opaque
C                    background with color index TBCI.
C--
C 16-Oct-1993 - new routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGSTBG')) RETURN
      IF (TBCI.LT.0) THEN
          PGTBCI(PGID) = -1
      ELSE
          PGTBCI(PGID) = TBCI
      END IF
      END
#<

#>            pgsubp.dc2
Name:         PGSUBP

Purpose:      subdivide view surface into panels

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSUBP (NXSUB, NYSUB)
            INTEGER NXSUB, NYSUB
      
       PGPLOT divides the physical surface of the plotting device (screen,
       window, or sheet of paper) into NXSUB x NYSUB `panels'. When the 
       view surface is sub-divided in this way, PGPAGE moves to the next
       panel, not the next physical page. The initial subdivision of the
       view surface is set in the call to PGBEG. When PGSUBP is called,
       it forces the next call to PGPAGE to start a new physical page,
       subdivided in the manner indicated. No plotting should be done
       between a call of PGSUBP and a call of PGPAGE (or PGENV, which calls
       PGPAGE).
      
       If NXSUB > 0, PGPLOT uses the panels in row order; if <0, 
       PGPLOT uses them in column order, e.g.,
            
        NXSUB=3, NYSUB=2            NXSUB=-3, NYSUB=2   
                                                      
       +-----+-----+-----+         +-----+-----+-----+
       |  1  |  2  |  3  |         |  1  |  3  |  5  |
       +-----+-----+-----+         +-----+-----+-----+
       |  4  |  5  |  6  |         |  2  |  4  |  6  |
       +-----+-----+-----+         +-----+-----+-----+
      
       PGPLOT advances from one panels to the next when PGPAGE is called,
       clearing the screen or starting a new page when the last panel has
       been used. It is also possible to jump from one panel to another
       in random order by calling PGPANL.
       
       Arguments:
        NXSUB  (input)  : the number of subdivisions of the view surface in
                          X (>0 or <0).
        NYSUB  (input)  : the number of subdivisions of the view surface in
                          Y (>0).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgsubp.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSUBP -- subdivide view surface into panels
C%void cpgsubp(int nxsub, int nysub);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgsubp( integer, integer )
*

C+
      SUBROUTINE PGSUBP (NXSUB, NYSUB)
      INTEGER NXSUB, NYSUB
C
C PGPLOT divides the physical surface of the plotting device (screen,
C window, or sheet of paper) into NXSUB x NYSUB `panels'. When the 
C view surface is sub-divided in this way, PGPAGE moves to the next
C panel, not the next physical page. The initial subdivision of the
C view surface is set in the call to PGBEG. When PGSUBP is called,
C it forces the next call to PGPAGE to start a new physical page,
C subdivided in the manner indicated. No plotting should be done
C between a call of PGSUBP and a call of PGPAGE (or PGENV, which calls
C PGPAGE).
C
C If NXSUB > 0, PGPLOT uses the panels in row order; if <0, 
C PGPLOT uses them in column order, e.g.,
C      
C  NXSUB=3, NYSUB=2            NXSUB=-3, NYSUB=2   
C                                                
C +-----+-----+-----+         +-----+-----+-----+
C |  1  |  2  |  3  |         |  1  |  3  |  5  |
C +-----+-----+-----+         +-----+-----+-----+
C |  4  |  5  |  6  |         |  2  |  4  |  6  |
C +-----+-----+-----+         +-----+-----+-----+
C
C PGPLOT advances from one panels to the next when PGPAGE is called,
C clearing the screen or starting a new page when the last panel has
C been used. It is also possible to jump from one panel to another
C in random order by calling PGPANL.
C 
C Arguments:
C  NXSUB  (input)  : the number of subdivisions of the view surface in
C                    X (>0 or <0).
C  NYSUB  (input)  : the number of subdivisions of the view surface in
C                    Y (>0).
C--
C 15-Nov-1993 [TJP] - new routine.
C 19-Feb-1994 [TJP] - rescale viewport when panel size changes.
C 23-Sep-1996 [TJP] - correct bug in assignment of PGROWS.
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
      REAL     CH, XFSZ, YFSZ
      LOGICAL  PGNOTO
      REAL     XVP1, XVP2, YVP1, YVP2

C
      IF (PGNOTO('PGSUBP')) RETURN
C
C Find current character size and viewport (NDC).
C
      CALL PGQCH(CH)
      CALL PGQVP(0, XVP1, XVP2, YVP1, YVP2)
C
C Set the subdivisions.
C
      XFSZ = PGNX(PGID)*PGXSZ(PGID)
      YFSZ = PGNY(PGID)*PGYSZ(PGID)
      PGROWS(PGID) = (NXSUB.GE.0)
      PGNX(PGID) = MAX(ABS(NXSUB),1)
      PGNY(PGID) = MAX(ABS(NYSUB),1)
      PGXSZ(PGID) = XFSZ/PGNX(PGID)
      PGYSZ(PGID) = YFSZ/PGNY(PGID)
C
C The current panel is the last on the physical page, to force
C a new physical page at next PGPAGE.
C
      PGNXC(PGID) = PGNX(PGID)
      PGNYC(PGID) = PGNY(PGID)
C
C Rescale the character size and viewport to the new panel size.
C
      CALL PGSCH(CH)
      CALL PGSVP(XVP1, XVP2, YVP1, YVP2)
C
      END
#<

#>            pgsvp.dc2
Name:         PGSVP

Purpose:      set viewport (normalized device coordinates)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSVP (XLEFT, XRIGHT, YBOT, YTOP)
            REAL XLEFT, XRIGHT, YBOT, YTOP
      
       Change the size and position of the viewport, specifying
       the viewport in normalized device coordinates.  Normalized
       device coordinates run from 0 to 1 in each dimension. The
       viewport is the rectangle on the view surface "through"
       which one views the graph.  All the PG routines which plot lines
       etc. plot them within the viewport, and lines are truncated at
       the edge of the viewport (except for axes, labels etc drawn with
       PGBOX or PGLAB).  The region of world space (the coordinate
       space of the graph) which is visible through the viewport is
       specified by a call to PGSWIN.  It is legal to request a
       viewport larger than the view surface; only the part which
       appears on the view surface will be plotted.
      
       Arguments:
        XLEFT  (input)  : x-coordinate of left hand edge of viewport, in NDC.
        XRIGHT (input)  : x-coordinate of right hand edge of viewport,
                          in NDC.
        YBOT   (input)  : y-coordinate of bottom edge of viewport, in NDC.
        YTOP   (input)  : y-coordinate of top  edge of viewport, in NDC.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgsvp.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSVP -- set viewport (normalized device coordinates)
C%void cpgsvp(float xleft, float xright, float ybot, float ytop);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgsvp( real, real, real, real )
*

C+
      SUBROUTINE PGSVP (XLEFT, XRIGHT, YBOT, YTOP)
      REAL XLEFT, XRIGHT, YBOT, YTOP
C
C Change the size and position of the viewport, specifying
C the viewport in normalized device coordinates.  Normalized
C device coordinates run from 0 to 1 in each dimension. The
C viewport is the rectangle on the view surface "through"
C which one views the graph.  All the PG routines which plot lines
C etc. plot them within the viewport, and lines are truncated at
C the edge of the viewport (except for axes, labels etc drawn with
C PGBOX or PGLAB).  The region of world space (the coordinate
C space of the graph) which is visible through the viewport is
C specified by a call to PGSWIN.  It is legal to request a
C viewport larger than the view surface; only the part which
C appears on the view surface will be plotted.
C
C Arguments:
C  XLEFT  (input)  : x-coordinate of left hand edge of viewport, in NDC.
C  XRIGHT (input)  : x-coordinate of right hand edge of viewport,
C                    in NDC.
C  YBOT   (input)  : y-coordinate of bottom edge of viewport, in NDC.
C  YTOP   (input)  : y-coordinate of top  edge of viewport, in NDC.
C--
C 13-Dec-1990  Make errors non-fatal [TJP].
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
      LOGICAL  PGNOTO
      REAL     XS, YS
C
      IF (PGNOTO('PGSVP'))  RETURN
      IF (XLEFT.GE.XRIGHT .OR. YBOT.GE.YTOP) THEN
          CALL GRWARN('PGSVP ignored: invalid arguments')
          RETURN
      END IF
C
      XS = PGXSZ(PGID)/PGXPIN(PGID)
      YS = PGYSZ(PGID)/PGYPIN(PGID)
      CALL PGVSIZ(XLEFT*XS, XRIGHT*XS, YBOT*YS, YTOP*YS)
      END
#<

#>            pgswin.dc2
Name:         PGSWIN

Purpose:      set window

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGSWIN (X1, X2, Y1, Y2)
            REAL X1, X2, Y1, Y2
      
       Change the window in world coordinate space that is to be mapped on
       to the viewport.  Usually PGSWIN is called automatically by PGENV,
       but it may be called directly by the user.
      
       Arguments:
        X1     (input)  : the x-coordinate of the bottom left corner
                          of the viewport.
        X2     (input)  : the x-coordinate of the top right corner
                          of the viewport (note X2 may be less than X1).
        Y1     (input)  : the y-coordinate of the bottom left corner
                          of the viewport.
        Y2     (input)  : the y-coordinate of the top right corner
                          of the viewport (note Y2 may be less than Y1).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgswin.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGSWIN -- set window
C%void cpgswin(float x1, float x2, float y1, float y2);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgswin( real, real, real, real )
*

C+
      SUBROUTINE PGSWIN (X1, X2, Y1, Y2)
      REAL X1, X2, Y1, Y2
C
C Change the window in world coordinate space that is to be mapped on
C to the viewport.  Usually PGSWIN is called automatically by PGENV,
C but it may be called directly by the user.
C
C Arguments:
C  X1     (input)  : the x-coordinate of the bottom left corner
C                    of the viewport.
C  X2     (input)  : the x-coordinate of the top right corner
C                    of the viewport (note X2 may be less than X1).
C  Y1     (input)  : the y-coordinate of the bottom left corner
C                    of the viewport.
C  Y2     (input)  : the y-coordinate of the top right corner
C                    of the viewport (note Y2 may be less than Y1).
C--
C 15-Nov-95: check arguments to prevent divide-by-zero [TJP].
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGSWIN')) RETURN
C
C If invalid arguments are specified, issue warning and leave window
C unchanged.
C
      IF (X1.EQ.X2) THEN
         CALL GRWARN('invalid x limits in PGSWIN: X1 = X2.')
      ELSE IF (Y1.EQ.Y2) THEN
         CALL GRWARN('invalid y limits in PGSWIN: Y1 = Y2.')
      ELSE
         PGXBLC(PGID) = X1
         PGXTRC(PGID) = X2
         PGYBLC(PGID) = Y1
         PGYTRC(PGID) = Y2
         CALL PGVW
      END IF
      END
#<

#>            pgtbox.dc2
Name:         PGTBOX

Purpose:      draw frame and write (DD) HH MM SS.S labelling

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGTBOX (XOPT, XTICK, NXSUB, YOPT, YTICK, NYSUB)
      
            REAL XTICK, YTICK
            INTEGER NXSUB, NYSUB
            CHARACTER XOPT*(*), YOPT*(*)
      
       Draw a box and optionally label one or both axes with (DD) HH MM SS 
       style numeric labels (useful for time or RA - DEC plots).   If this 
       style of labelling is desired, then PGSWIN should have been called
       previously with the extrema in SECONDS of time.
      
       In the seconds field, you can have at most 3 places after the decimal
       point, so that 1 ms is the smallest time interval you can time label.
      
       Large numbers are coped with by fields of 6 characters long.  Thus 
       you could have times with days or hours as big as 999999.  However, 
       in practice, you might have trouble with labels overwriting  themselves
       with such large numbers unless you a) use a small time INTERVAL, 
       b) use a small character size or c) choose your own sparse ticks in 
       the call to PGTBOX.  
      
       PGTBOX will attempt, when choosing its own ticks, not to overwrite
       the labels, but this algorithm is not very bright and may fail.
      
       Note that small intervals but large absolute times such as
       TMIN = 200000.0 s and TMAX=200000.1 s will cause the algorithm
       to fail.  This is inherent in PGPLOT's use of single precision
       and cannot be avoided.  In such cases, you should use relative
       times if possible.
      
       PGTBOX's labelling philosophy is that the left-most or bottom tick of
       the axis contains a full label.  Thereafter, only changing fields are
       labelled.  Negative fields are given a '-' label, positive fields
       have none.   Axes that have the DD (or HH if the day field is not
       used) field on each major tick carry the sign on each field.  If the
       axis crosses zero, the zero tick will carry a full label and sign.
      
       This labelling style can cause a little confusion with some special
       cases, but as long as you know its philosophy, the truth can be divined.
       Consider an axis with TMIN=20s, TMAX=-20s.   The labels will look like
      
              +----------+----------+----------+----------+
           0h0m20s      10s      -0h0m0s      10s        20s
      
       Knowing that the left field always has a full label and that
       positive fields are unsigned, informs that time is decreasing
       from left to right, not vice versa.   This can become very 
       unclear if you have used the 'F' option, but that is your problem !
      
       Exceptions to this labelling philosophy are when the finest time
       increment being displayed is hours (with option 'Y') or days.  
       Then all fields carry a label.  For example,
      
              +----------+----------+----------+----------+
            -10h        -8h        -6h        -4h        -2h
      
      
       PGTBOX can be used in place of PGBOX; it calls PGBOX and only invokes 
       time labelling if requested. Other options are passed intact to PGBOX.
      
       Inputs:
        XOPT   :  X-options for PGTBOX.  Same as for PGBOX plus 
      
                   'Z' for (DD) HH MM SS.S time labelling
                   'Y' means don't include the day field so that labels
                       are HH MM SS.S rather than DD HH MM SS.S   The hours
                       will accumulate beyond 24 if necessary in this case.
                   'X' label the HH field as modulo 24.  Thus, a label
                       such as 25h 10m would come out as 1h 10m
                   'H' means superscript numbers with d, h, m, & s  symbols
                   'D' means superscript numbers with    o, ', & '' symbols 
                   'F' causes the first label (left- or bottom-most) to
                       be omitted. Useful for sub-panels that abut each other.
                       Care is needed because first label carries sign as well.
                   'O' means omit leading zeros in numbers < 10
                       E.g.  3h 3m 1.2s rather than 03h 03m 01.2s  Useful
                       to help save space on X-axes. The day field does not 
                       use this facility.
      
        YOPT   :  Y-options for PGTBOX.  See above.
        XTICK  :  X-axis major tick increment.  0.0 for default. 
        YTICK  :  Y-axis major tick increment.  0.0 for default. 
                  If the 'Z' option is used then XTICK and/or YTICK must
                  be in seconds.
        NXSUB  :  Number of intervals for minor ticks on X-axis. 0 for default
        NYSUB  :  Number of intervals for minor ticks on Y-axis. 0 for default
      
        The regular XOPT and YOPT axis options for PGBOX are
      
        A : draw Axis (X axis is horizontal line Y=0, Y axis is vertical
            line X=0).
        B : draw bottom (X) or left (Y) edge of frame.
        C : draw top (X) or right (Y) edge of frame.
        G : draw Grid of vertical (X) or horizontal (Y) lines.
        I : Invert the tick marks; ie draw them outside the viewport
            instead of inside.
        L : label axis Logarithmically (see below).
        N : write Numeric labels in the conventional location below the
            viewport (X) or to the left of the viewport (Y).
        P : extend ("Project") major tick marks outside the box (ignored if
            option I is specified).
        M : write numeric labels in the unconventional location above the
            viewport (X) or to the right of the viewport (Y).
        T : draw major Tick marks at the major coordinate interval.
        S : draw minor tick marks (Subticks).
        V : orient numeric labels Vertically. This is only applicable to Y.
            The default is to write Y-labels parallel to the axis.
        1 : force decimal labelling, instead of automatic choice (see PGNUMB).
        2 : force exponential labelling, instead of automatic.
      
            The default is to write Y-labels parallel to the axis
        
      
              ******************        EXCEPTIONS       *******************
      
              Note that 
                1) PGBOX option 'L' (log labels) is ignored with option 'Z'
                2) The 'O' option will be ignored for the 'V' option as it 
                   makes it impossible to align the labels nicely
                3) Option 'Y' is forced with option 'D'
      
              ***************************************************************
      
      

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgtbox.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGTBOX -- draw frame and write (DD) HH MM SS.S labelling
C%void cpgtbox(const char *xopt, float xtick, int nxsub, \
C% const char *yopt, float ytick, int nysub);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgtbox( character, real, integer, character, real, integer )
*

C+
      SUBROUTINE PGTBOX (XOPT, XTICK, NXSUB, YOPT, YTICK, NYSUB)
C
      REAL XTICK, YTICK
      INTEGER NXSUB, NYSUB
      CHARACTER XOPT*(*), YOPT*(*)
C
C Draw a box and optionally label one or both axes with (DD) HH MM SS 
C style numeric labels (useful for time or RA - DEC plots).   If this 
C style of labelling is desired, then PGSWIN should have been called
C previously with the extrema in SECONDS of time.
C
C In the seconds field, you can have at most 3 places after the decimal
C point, so that 1 ms is the smallest time interval you can time label.
C
C Large numbers are coped with by fields of 6 characters long.  Thus 
C you could have times with days or hours as big as 999999.  However, 
C in practice, you might have trouble with labels overwriting  themselves
C with such large numbers unless you a) use a small time INTERVAL, 
C b) use a small character size or c) choose your own sparse ticks in 
C the call to PGTBOX.  
C
C PGTBOX will attempt, when choosing its own ticks, not to overwrite
C the labels, but this algorithm is not very bright and may fail.
C
C Note that small intervals but large absolute times such as
C TMIN = 200000.0 s and TMAX=200000.1 s will cause the algorithm
C to fail.  This is inherent in PGPLOT's use of single precision
C and cannot be avoided.  In such cases, you should use relative
C times if possible.
C
C PGTBOX's labelling philosophy is that the left-most or bottom tick of
C the axis contains a full label.  Thereafter, only changing fields are
C labelled.  Negative fields are given a '-' label, positive fields
C have none.   Axes that have the DD (or HH if the day field is not
C used) field on each major tick carry the sign on each field.  If the
C axis crosses zero, the zero tick will carry a full label and sign.
C
C This labelling style can cause a little confusion with some special
C cases, but as long as you know its philosophy, the truth can be divined.
C Consider an axis with TMIN=20s, TMAX=-20s.   The labels will look like
C
C        +----------+----------+----------+----------+
C     0h0m20s      10s      -0h0m0s      10s        20s
C
C Knowing that the left field always has a full label and that
C positive fields are unsigned, informs that time is decreasing
C from left to right, not vice versa.   This can become very 
C unclear if you have used the 'F' option, but that is your problem !
C
C Exceptions to this labelling philosophy are when the finest time
C increment being displayed is hours (with option 'Y') or days.  
C Then all fields carry a label.  For example,
C
C        +----------+----------+----------+----------+
C      -10h        -8h        -6h        -4h        -2h
C
C
C PGTBOX can be used in place of PGBOX; it calls PGBOX and only invokes 
C time labelling if requested. Other options are passed intact to PGBOX.
C
C Inputs:
C  XOPT   :  X-options for PGTBOX.  Same as for PGBOX plus 
C
C             'Z' for (DD) HH MM SS.S time labelling
C             'Y' means don't include the day field so that labels
C                 are HH MM SS.S rather than DD HH MM SS.S   The hours
C                 will accumulate beyond 24 if necessary in this case.
C             'X' label the HH field as modulo 24.  Thus, a label
C                 such as 25h 10m would come out as 1h 10m
C             'H' means superscript numbers with d, h, m, & s  symbols
C             'D' means superscript numbers with    o, ', & '' symbols 
C             'F' causes the first label (left- or bottom-most) to
C                 be omitted. Useful for sub-panels that abut each other.
C                 Care is needed because first label carries sign as well.
C             'O' means omit leading zeros in numbers < 10
C                 E.g.  3h 3m 1.2s rather than 03h 03m 01.2s  Useful
C                 to help save space on X-axes. The day field does not 
C                 use this facility.
C
C  YOPT   :  Y-options for PGTBOX.  See above.
C  XTICK  :  X-axis major tick increment.  0.0 for default. 
C  YTICK  :  Y-axis major tick increment.  0.0 for default. 
C            If the 'Z' option is used then XTICK and/or YTICK must
C            be in seconds.
C  NXSUB  :  Number of intervals for minor ticks on X-axis. 0 for default
C  NYSUB  :  Number of intervals for minor ticks on Y-axis. 0 for default
C
C  The regular XOPT and YOPT axis options for PGBOX are
C
C  A : draw Axis (X axis is horizontal line Y=0, Y axis is vertical
C      line X=0).
C  B : draw bottom (X) or left (Y) edge of frame.
C  C : draw top (X) or right (Y) edge of frame.
C  G : draw Grid of vertical (X) or horizontal (Y) lines.
C  I : Invert the tick marks; ie draw them outside the viewport
C      instead of inside.
C  L : label axis Logarithmically (see below).
C  N : write Numeric labels in the conventional location below the
C      viewport (X) or to the left of the viewport (Y).
C  P : extend ("Project") major tick marks outside the box (ignored if
C      option I is specified).
C  M : write numeric labels in the unconventional location above the
C      viewport (X) or to the right of the viewport (Y).
C  T : draw major Tick marks at the major coordinate interval.
C  S : draw minor tick marks (Subticks).
C  V : orient numeric labels Vertically. This is only applicable to Y.
C      The default is to write Y-labels parallel to the axis.
C  1 : force decimal labelling, instead of automatic choice (see PGNUMB).
C  2 : force exponential labelling, instead of automatic.
C
C      The default is to write Y-labels parallel to the axis
C  
C
C        ******************        EXCEPTIONS       *******************
C
C        Note that 
C          1) PGBOX option 'L' (log labels) is ignored with option 'Z'
C          2) The 'O' option will be ignored for the 'V' option as it 
C             makes it impossible to align the labels nicely
C          3) Option 'Y' is forced with option 'D'
C
C        ***************************************************************
C
C
C--
C 05-Sep-1988 - new routine (Neil Killeen)
C 20-Apr-1991 - add support for new DD (day) field and implement
C               labelling on any axis (bottom,top,left,right) [nebk]
C 10-Jun-1993 - add option 'O' for leading zeros, correctly deal with 
C               user ticks, fully support 'V' and 'NM' options, modify
C               slightly meaning of 'F' option [nebk]
C 16-Jan-1995 - add option 'X' [nebk]
C 16-Aug-1996 - Bring axis labelling displacements more in line with 
C               those of pgbox.f [nebk]
C-----------------------------------------------------------------------
      REAL XTICKD, YTICKD, XMIN, XMAX, YMIN, YMAX
      INTEGER IPT, TSCALX, TSCALY, NXSUBD, NYSUBD
      CHARACTER XXOPT*15, YYOPT*15, SUPTYP*4
      LOGICAL XTIME, YTIME, FIRST, DODAYX, DODAYY, DO2, DOPARA, MOD24
C------------------------------------------------------------------------
C
C  Copy inputs
C
      XTICKD = XTICK
      YTICKD = YTICK
      NXSUBD = NXSUB
      NYSUBD = NYSUB
C
C  Get window in world coordinates
C 
      CALL PGQWIN (XMIN, XMAX, YMIN, YMAX)
C
C  X-axis first
C
      CALL GRTOUP (XXOPT, XOPT)
      XTIME = .FALSE.
      IF (INDEX(XXOPT,'Z').NE.0) THEN
C
C  Work out units for labelling and find the tick increments.
C
        IF (ABS(XMAX-XMIN).LT.0.001) THEN
          CALL GRWARN ('PGTBOX: X-axis time interval too small '//
     *                 '(< 1 ms) for time labels')
        ELSE
          XTIME = .TRUE.
          DODAYX = .TRUE.
          IF (INDEX(XXOPT,'Y').NE.0 .OR. INDEX(XXOPT,'D').NE.0) 
     *        DODAYX = .FALSE.
C
          DOPARA = .TRUE.
          CALL PGTBX1 ('X', DODAYX, DOPARA, XMIN, XMAX, XTICKD, 
     *                 NXSUBD, TSCALX)
        END IF
      END IF
C
C  Same again for Y-axis
C
      CALL GRTOUP (YYOPT, YOPT)
      YTIME = .FALSE.
      IF (INDEX(YYOPT,'Z').NE.0) THEN
        IF (ABS(YMAX-YMIN).LT.0.001) THEN
          CALL GRWARN ('PGTBOX: Y-axis time interval too small '//
     *                 '(< 1ms) for time labels')
        ELSE
          YTIME = .TRUE.
          DODAYY = .TRUE.
          IF (INDEX(YYOPT,'Y').NE.0 .OR. INDEX(YYOPT,'D').NE.0)
     *        DODAYY = .FALSE.
C
          DOPARA = .TRUE.
          IF (INDEX(YYOPT,'V').NE.0) DOPARA = .FALSE.
C
          CALL PGTBX1 ('Y', DODAYY, DOPARA, YMIN, YMAX, YTICKD, 
     *                 NYSUBD, TSCALY)
        END IF
      END IF
C
C  Parse options list.  For call to PGBOX when doing time labelling, we 
C  don't want L (log), N or M (write numeric labels). 
C
      IF (XTIME) THEN
        IPT = INDEX(XXOPT,'L')
        IF (IPT.NE.0) XXOPT(IPT:IPT) = ' '
        IPT = INDEX(XXOPT,'N')
        IF (IPT.NE.0) XXOPT(IPT:IPT) = ' '
        IPT = INDEX(XXOPT,'M')
        IF (IPT.NE.0) XXOPT(IPT:IPT) = ' '
      END IF
C
      IF (YTIME) THEN
        IPT = INDEX(YYOPT,'L')
        IF (IPT.NE.0) YYOPT(IPT:IPT) = ' '
        IPT = INDEX(YYOPT,'N')
        IF (IPT.NE.0) YYOPT(IPT:IPT) = ' '
        IPT = INDEX(YYOPT,'M')
        IF (IPT.NE.0) YYOPT(IPT:IPT) = ' '
      END IF
C
C  Draw box and ticks
C
      CALL PGBOX (XXOPT, XTICKD, NXSUBD, YYOPT, YTICKD, NYSUBD)
C
C  Add (DD) HH MM SS labels if desired.  Go back to the original user
C  specified options list.
C
      XXOPT = ' '
      CALL GRTOUP (XXOPT, XOPT)
      IF (XTIME .AND. (INDEX(XXOPT,'N').NE.0 .OR.
     *                 INDEX(XXOPT,'M').NE.0)) THEN
        FIRST = .TRUE.
        IF (INDEX(XXOPT,'F').NE.0) FIRST = .FALSE.
C
        SUPTYP = 'NONE'
        IF (INDEX(XXOPT,'D').NE.0) SUPTYP = ' DMS'
        IF (INDEX(XXOPT,'H').NE.0) SUPTYP = 'DHMS'
C
        DO2 = .TRUE.
        IF (INDEX(XXOPT,'O').NE.0) DO2 = .FALSE.
C
        DOPARA = .TRUE.
C
        MOD24 = .FALSE.
        IF (INDEX(XXOPT,'X').NE.0) MOD24 = .TRUE.
C
        IF (INDEX(XXOPT,'N').NE.0)
     *    CALL PGTBX4 (DODAYX, SUPTYP, 'X', .TRUE., FIRST, 
     *      XMIN, XMAX, TSCALX, XTICKD, DO2, DOPARA, MOD24)
C
        IF (INDEX(XXOPT,'M').NE.0)
     *    CALL PGTBX4 (DODAYX, SUPTYP, 'X', .FALSE., FIRST, 
     *       XMIN, XMAX, TSCALX, XTICKD, DO2, DOPARA, MOD24)
      END IF
C
      YYOPT = ' '
      CALL GRTOUP (YYOPT, YOPT)
      IF (YTIME .AND. (INDEX(YYOPT,'N').NE.0 .OR.
     *                 INDEX(YYOPT,'M').NE.0)) THEN
        FIRST = .TRUE.
        IF (INDEX(YYOPT,'F').NE.0) FIRST = .FALSE.
C
        SUPTYP = 'NONE'
        IF (INDEX(YYOPT,'D').NE.0) SUPTYP = ' DMS'
        IF (INDEX(YYOPT,'H').NE.0) SUPTYP = 'DHMS'
C
        DOPARA = .TRUE.
        IF (INDEX(YYOPT,'V').NE.0) DOPARA = .FALSE.
C
        DO2 = .TRUE.
        IF (DOPARA .AND. INDEX(YYOPT,'O').NE.0) DO2 = .FALSE.
C
        MOD24 = .FALSE.
        IF (INDEX(YYOPT,'X').NE.0) MOD24 = .TRUE.
C
        IF (INDEX(YYOPT,'N').NE.0)
     *    CALL PGTBX4 (DODAYY, SUPTYP, 'Y', .TRUE., FIRST, 
     *       YMIN, YMAX, TSCALY, YTICKD, DO2, DOPARA, MOD24)
C
        IF (INDEX(YYOPT,'M').NE.0)
     *    CALL PGTBX4 (DODAYY, SUPTYP, 'Y', .FALSE., FIRST, 
     *       YMIN, YMAX, TSCALY, YTICKD, DO2, DOPARA, MOD24)
C
      END IF
C
      RETURN
      END
C PGTBX1 -- support routine for PGTBOX
C
      SUBROUTINE PGTBX1 (AXIS, DODAY, DOPARA, TMIN, TMAX, TICK, 
     *                   NSUB, TSCALE)
C
      REAL TMIN, TMAX, TICK
      INTEGER NSUB, TSCALE
      LOGICAL DODAY, DOPARA
      CHARACTER AXIS*1
C
C Work out what the finest units the time labels will be in and
C return the tick increments if the user does not set them.
C
C This is a support routine for PGTBOX and should not 
C be called by the user.
C
C Input:
C  AXIS   :  'X' or 'Y' for use in determining if labels overwrite
C  TMIN   :  Start time in seconds 
C  TMAX   :  End   time in seconds
C  DOPARA :  True if label to be parallel to axis, else perpendicular
C Input/output:
C  DODAY  :  Write labels as DD HH MM SS.S else HH MM SS.S with
C            hours ranging above 24.  Useful for declination labels
C  TICK   :  Major tick interval in seconds.  If 0.0 on input, will 
C            be set here.
C  NSUB   :  Number of minor ticks between major ticks. If 0 on input
C            will be set here.
C Outputs:
C  TSCALE :  Determines finest unit of labelling 
C            (1 => ss, 60 => mm, 3600 => hh, 3600*24 => dd)
C
C 05-Sep-1988 - new routine (Neil Killeen)
C 08-Apr-1991 - correctly work out HH MM SS when the time > 60 h [nebk]
C 20-Apr-1991 - revise to add support for new DD (day) field and
C               do lots of work on tick algorithm [nebk]
C 10-Jun-1993 - deal with user given ticks & rename from PGTIME [nebk/jm]
C-----------------------------------------------------------------------
      INTEGER NLIST1, NLIST2, NLIST3, NLIST4, NTICMX
      PARAMETER (NLIST1 = 19, NLIST2 = 10, NLIST3 = 6, NLIST4 = 8,
     *           NTICMX = 8)
C
      REAL TICKS1(NLIST1), TICKS2(NLIST2), TICKS3(NLIST3), 
     *TICKS4(NLIST4), TOCK, TOCK2, TINT, TINTS, TMINS, TMAXS
      INTEGER NSUBS1(NLIST1), NSUBS2(NLIST2), NSUBS3(NLIST3), 
     *NSUBS4(NLIST4), NPL, NTICK, ITICK, STRLEN
      CHARACTER STR*15
C
      SAVE TICKS1, TICKS2, TICKS3, TICKS4
      SAVE NSUBS1, NSUBS2, NSUBS3, NSUBS4
C
      DATA TICKS1 /0.001,  0.002,                 0.005,
     *             0.01,   0.02,                  0.05,  
     *             0.1,    0.2,                   0.5,  
     *             1.0,    2.0,   3.0,    4.0,    5.0,
     *             6.0,   10.0,  15.0,   20.0,   30.0/
      DATA NSUBS1 / 4,      4,                     2,    
     *              4,      4,                     2,    
     *              4,      4,                     2,    
     *              4,      4,     3,      4,      5,
     *              3,      2,     3,      2,      3/
C
      DATA TICKS2 /1.0,    2.0,   3.0,    4.0,    5.0,
     *             6.0,   10.0,  15.0,   20.0,   30.0/
      DATA NSUBS2 / 4,      4,     3,      4,      5,
     *              3,      2,     3,      2,      3/
C
      DATA TICKS3 /1.0,    2.0,   3.0,    4.0,    6.0,   12.0/
      DATA NSUBS3 / 4,      4,     3,      4,      3,      2/
C
      DATA TICKS4 /1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 8.0, 9.0/
      DATA NSUBS4 / 4,   4,   3,   4,   5,   3,   4,   3 /
C----------------------------------------------------------------------
C
C  Turn off DD (day) field if it has been unnecessarily asked for
C
      IF ((ABS(TMIN).LT.24.0*3600.0) .AND. (ABS(TMAX).LT.24.0*3600.0))
     *   DODAY = .FALSE.
C
C  If a tick size is provided, use it to determine TSCALE
C
      TINT = ABS(TMAX - TMIN)
      TICK = ABS(TICK)
      IF (TICK.NE.0.0) THEN
        IF (TICK.GE.TINT) THEN
          CALL GRWARN ('PGTBX1: user given tick bigger than time '
     *                 //'interval; will auto-tick')
          TICK = 0.0
        ELSE IF (TICK.LT.0.001) THEN
          CALL GRWARN ('PGTBX1: user given tick too small (< 1 ms); '
     *                 //'will auto-tick')
          TICK = 0.0
        ELSE 
          IF (MOD(TICK, 60.0) .NE. 0.0) THEN
            TSCALE = 1
          ELSE IF (MOD(TICK, 3600.0).NE.0.0) THEN
            TSCALE = 60
          ELSE IF (.NOT.DODAY) THEN
            TSCALE = 3600
          ELSE IF (MOD(TICK,(24.0*3600.0)).NE.0.0) THEN
            TSCALE = 3600
          ELSE
            TSCALE = 24 * 3600
          ENDIF
C
C  Make a simple default for the number of minor ticks and bug out
C
          IF (NSUB.EQ.0) NSUB = 2
          RETURN
        END IF
      END IF
C
C  Work out label units depending on time interval if user 
C  wants auto-ticking
C
      IF (TINT.LE.5*60) THEN
        TSCALE = 1
      ELSE IF (TINT.LE.5*3600) THEN
        TSCALE = 60
      ELSE 
        IF (.NOT.DODAY) THEN
          TSCALE = 3600
        ELSE
          IF (TINT.LE.5*24*3600) THEN
            TSCALE = 3600
          ELSE
            TSCALE = 3600*24
          END IF
        END IF
      END IF
C
CCCCC
C  Divide interval into NTICK major ticks and NSUB minor intervals
C  The tick choosing algorithm is not very robust, so watch out
C  if you fiddle anything. 
CCCCC
C
      TINTS = TINT / TSCALE
      IF (TSCALE.EQ.1) THEN
C
C  Time in seconds.  If the time interval is very small, may need to 
C  label with up to 3 decimal places.  Have less ticks to help prevent
C  label overwrite. STR is a dummy tick label to assess label 
C  overwrite potential
C
        IF (DOPARA) THEN
          IF (TINTS.LE.0.01) THEN
            NTICK = 4
            STR = '60.423'
            STRLEN = 6
          ELSE IF (TINTS.LE.0.1) THEN
            NTICK = 5
            STR = '60.42'
            STRLEN = 5
          ELSE IF (TINTS.LE.1.0) THEN
            NTICK = 6
            STR = '60.4'
            STRLEN = 4
          ELSE
            NTICK = 6
            STR = '60s'
            STRLEN = 3
          END IF
        ELSE
          NTICK = 6
          STR = ' '
          STRLEN = 1
        END IF
        TOCK = TINTS / NTICK
C
C  Select nearest tick to TOCK from list.
C
        CALL PGTBX2 (TOCK, NLIST1, TICKS1, NSUBS1, TICK, NSUB, ITICK)
C
C  Check label overwrite and/or too many ticks.
C
        CALL PGTBX3 (DODAY, 0, TSCALE, TINTS, NTICMX, NLIST1, TICKS1,
     *               NSUBS1, ITICK, AXIS, DOPARA, STR(1:STRLEN),
     *               TICK, NSUB)
      ELSE IF (TSCALE.EQ.60) THEN
C
C  Time in minutes 
C
        NTICK = 6
        TOCK = TINTS / NTICK
C
C  Select nearest tick from list
C
        CALL PGTBX2 (TOCK, NLIST2, TICKS2, NSUBS2, TICK, NSUB, ITICK)
C
C  Check label overwrite and/or too many ticks.
C
        IF (DOPARA) THEN
          STR = '42m'
          STRLEN = 3
        ELSE
          STR = ' '
          STRLEN = 1
        END IF
        CALL PGTBX3 (DODAY, 0, TSCALE, TINTS, NTICMX, NLIST2, TICKS2,
     *               NSUBS2, ITICK, AXIS, DOPARA, STR(1:STRLEN),
     *               TICK, NSUB)
      ELSE 
        IF (TSCALE.EQ.3600 .AND. DODAY) THEN
C
C  Time in hours with the day field 
C
          NTICK = 6
          TOCK = TINTS / NTICK
C
C  Select nearest tick from list
C
          CALL PGTBX2 (TOCK, NLIST3, TICKS3, NSUBS3, TICK, NSUB, ITICK)
C
C   Check label overwrite and/or too many ticks.
C
          IF (DOPARA) THEN
            STR = '42h'
            STRLEN = 3
          ELSE
            STR = ' '
            STRLEN = 1
          END IF
          CALL PGTBX3 (DODAY, 0, TSCALE, TINTS, NTICMX, NLIST3, TICKS3,
     *                 NSUBS3, ITICK, AXIS, DOPARA, STR(1:STRLEN),
     *                 TICK, NSUB)
        ELSE
C
C  Time in hours with no day field or time in days. Have less
C  ticks for big numbers or the parallel labels will overwrite.

          IF (DOPARA) THEN
            TMINS = ABS(TMIN) / TSCALE
            TMAXS = ABS(TMAX) / TSCALE            
            CALL PGNPL (-1, NINT(MAX(TINTS,TMINS,TMAXS)), NPL)
            IF (NPL.LE.3) THEN
              NTICK = 6
            ELSE IF (NPL.EQ.4) THEN
              NTICK = 5
            ELSE
              NTICK = 4
            END IF
            STR = '345678912'
            STR(NPL+1:) = 'd'
            STRLEN = NPL + 1
          ELSE
            STR = ' '
            STRLEN = 1
            NTICK = 6
          END IF
          TOCK = TINTS / NTICK
C
C   Select nearest tick from list; 1 choose nearest nice integer 
C   scaled by the appropriate power of 10
C
          CALL PGNPL (-1, NINT(TOCK), NPL)
          TOCK2 = TOCK / 10**(NPL-1)
C
          CALL PGTBX2 (TOCK2, NLIST4, TICKS4, NSUBS4, TICK, NSUB, ITICK)
          TICK = TICK * 10**(NPL-1)
C
C  Check label overwrite and/or too many ticks.
C
          CALL PGTBX3 (DODAY, NPL, TSCALE, TINTS, NTICMX, NLIST4, 
     *                 TICKS4, NSUBS4, ITICK, AXIS, DOPARA,
     *                 STR(1:STRLEN), TICK, NSUB)
        END IF
      END IF
C
C  Convert tick to seconds
C
      TICK = TICK * TSCALE
C
      RETURN
      END
C PGTBX2 -- support routine for PGTBOX
C
      SUBROUTINE PGTBX2 (TOCK, NTICKS, TICKS, NSUBS, TICK, NSUB, ITICK)
C
      INTEGER NTICKS, NSUBS(NTICKS), NSUB, ITICK
      REAL TOCK, TICKS(NTICKS), TICK
C
C Find the nearest tick in a list to a given value.
C
C This is a support routine for PGTBOX and should not be called
C by the user.
C
C Input:
C  TOCK   :  Try to find the nearest tick in the list to TOCK
C  NTICKS :  Number of ticks in list
C  TICKS  :  List of ticks
C  NSUBS  :  List of number of minor ticks between ticks to go with TICKS
C Output:
C  TICK   :  The selected tick
C  ITICK  :  The index of the selected tick from the list TICKS
C Input/output
C  NSUB   :  Number of minor ticks between major ticks. If 0 on input
C            will be set here.
C
C 10-Jun-1993 - new routine [nebk]
C-----------------------------------------------------------------------
      INTEGER I, NSUBD
      REAL DMIN, DIFF
C----------------------------------------------------------------------
      NSUBD = NSUB
      DMIN = 1.0E30
      DO 100 I = 1, NTICKS
        DIFF = ABS(TOCK - TICKS(I))
        IF (DIFF.LT.DMIN) THEN
          TICK = TICKS(I)
          IF (NSUBD.EQ.0) NSUB = NSUBS(I)
          ITICK = I
C
          DMIN = DIFF
        END IF
 100  CONTINUE
C
      RETURN
      END
C PGTBX3 -- support routine for PGTBOX
C
      SUBROUTINE PGTBX3 (DODAY, NPL, TSCALE, TINTS, NTICMX, NTICKS,
     *                   TICKS, NSUBS, ITICK, AXIS, DOPARA, STR,
     *                   TICK, NSUB)
C
      INTEGER TSCALE, NTICMX, NTICKS, ITICK, NSUB, NSUBS(NTICKS), NPL
      REAL TINTS, TICKS(NTICKS), TICK
      CHARACTER AXIS*1, STR*(*)
      LOGICAL DODAY, DOPARA
C
C Try to see if label overwrite is going to occur with this tick 
C selection, or if there are going to be more than a reasonable
C number of ticks in the displayed time range.  If so, choose, 
C if available, the next tick (bigger separation) up in the list.
C If the overwrite requires that we would need to go up to the bext
C TSCALE, give up.  They will need to choose a smaller character size
C
C This is a support routine for PGTBOX and should not 
C be called by the user.
C
C Input:
C  DODAY  :  True if day field being used
C  NPL    :  Number of characters needed to format TICK on input
C  TSCALE :  Dictates what the finest units of the labelling are.
C            1 = sec, 60 = min, 3600 = hr, 24*3600 = days
C  TINTS  :  Absolute time interval in units of TSCALE
C  NTICMX :  Max. reasonable number of ticks to allow in the time range
C  NTICKS :  Number of ticks in list of ticks to choose from
C  TICKS  :  List of ticks from which the current tick was chosen
C  NSUBS  :  List of number of minor ticks/major tick to choose NSUB from
C  ITICK  :  Index of chosen tick in list TICKS
C  AXIS   :  'X' or 'Y' axis
C  DOPARA :  Labels parallel or perpendicualr to axis
C  STR    :  A typical formatted string used for checking overwrite
C Input/output:
C  TICK   :  Current major tick interval in units of TSCALE. May be 
C            made larger if possible if overwrite likely.
C  NSUB   :  Number of minor ticks between major ticks. 
C
C 10-Jun-1993 - new routine [nebk]
C-----------------------------------------------------------------------
      INTEGER NTICK
      REAL LENS, LENX, LENY
C----------------------------------------------------------------------
      CALL PGLEN (4, STR, LENX, LENY)
      LENS = LENX
      IF ( (DOPARA .AND. AXIS.EQ.'Y') .OR.
     *     (.NOT.DOPARA .AND. AXIS.EQ.'X') ) LENS = LENY
C
      IF (TSCALE.EQ.1 .OR. TSCALE.EQ.60 .OR.
     *    (TSCALE.EQ.3600 .AND. DODAY)) THEN
C
C  Time in seconds or minutes, or in hours with a day field
C
        NTICK = INT(TINTS / TICK)
        IF ( (ITICK.LT.NTICKS)  .AND. 
     *       ((DOPARA .AND. (LENS/TSCALE).GT.0.9*TICK) .OR. 
     *       (NTICK.GT.NTICMX)) ) THEN
          IF (TICKS(ITICK+1).LT.TINTS) THEN
            NSUB = NSUBS(ITICK+1)
            TICK = TICKS(ITICK+1)
          END IF
        END IF
      ELSE
C
C  Time in hours and no day field or time in days
C
        NTICK = INT(TINTS / TICK)
        IF ( (DOPARA .AND. (LENS/TSCALE).GT.0.9*TICK) .OR. 
     *       (NTICK.GT.NTICMX) ) THEN
          IF (ITICK.LT.NTICKS) THEN
            IF (TICKS(ITICK+1)*10**(NPL-1).LT.TINTS) THEN
              NSUB = NSUBS(ITICK+1)
              TICK = TICKS(ITICK+1) * 10**(NPL-1)
            END IF
          ELSE
            IF (TICKS(1)*10**NPL.LT.TINTS) THEN
              NSUB = NSUBS(1)
              TICK = TICKS(1) * 10**NPL
            END IF
          END IF
        END IF
      END IF
C
      RETURN
      END
C PGTBX4 -- support routine for PGTBOX
C
      SUBROUTINE PGTBX4 (DODAY, SUPTYP, AXIS, CONVTL, FIRST, TMIN,
     *                   TMAX, TSCALE, TICK, DO2, DOPARA, MOD24)
C
      REAL TMIN, TMAX, TICK
      INTEGER TSCALE
      CHARACTER AXIS*(*), SUPTYP*(*)
      LOGICAL FIRST, DODAY, CONVTL, DO2, DOPARA, MOD24
C
C Label an axis in (DD) HH MM SS.S style.    This is the main 
C workhorse of the PGTBOX routines.
C
C This is a support subroutine for PGTBOX and should not be 
C called by the user. 
C
C Inputs:
C  DODAY  :  Write labels as DD HH MM SS.S else HH MM SS.S with
C            hours ranging above 24.  Useful for declination labels
C  SUPTYP :  If 'DHMS' then superscript the fields with d, h, m, & s
C            If ' DMS' then superscript the fields with    o, '  & '' 
C              Good for declination plots.  You should obviously not 
C              ask for the day field for this to do anything sensible. 
C            If '    ' then no superscripting is done.
C  AXIS   :  'X' for x-axis, 'Y' for y-axis
C  CONVTL :  If .true., write the labels in the conventional axis 
C            locations (bottom and left for 'X' and 'Y').  Otherwise
C            write them on the top and right axes ('X' and 'Y')
C  FIRST  :  If .false. then omit the first label.
C  TMIN   :  Start time (seconds)
C  TMAX   :  End time (seconds)
C  TSCALE :  Determines finest units of axis
C              1 => ss, 60 => mm, 3600 => hh, 3600*24 => dd
C  TICK   :  Major tick interval in seconds
C  DO2    :  If .true., write labels less than 10 with a leading zero.
C  DOPARA :  Y axis label parallel to axis, else perpendicular
C  MOD24  :  HH field labelled as modulo 24
C
C 05-Sep-1988 - new routine (Neil Killeen)
C 20-Apr-1991 - add support for new DD (day) field [nebk]
C 10-Jun-1993 - complete rewrite & rename from PGTLAB. Fixes user given 
C               ticks bug too [nebk]
C 15-Jan-1995 - Add argument MOD24
C-----------------------------------------------------------------------
      INTEGER MAXTIK
      LOGICAL T, F
      PARAMETER (MAXTIK = 1000, T = .TRUE., F = .FALSE.)
C
      REAL SS(MAXTIK), TFRAC(MAXTIK)
      INTEGER DD(MAXTIK), HH(MAXTIK), MM(MAXTIK)
      CHARACTER*1 ASIGN(MAXTIK), ASIGNL
C
      REAL TIME, XLEN, YLEN, COORD, FJUST, RVAL, SSL, DISP,
     *XLEN2, YLEN2
      INTEGER IS, SD, NT, IZERO, IPOS, INEG, IT, I, J, K, SPREC,
     *JST(2), JEND(2), TLEN, LAST, IVAL(3), IVALO(3), IVALZ(3),
     *IVALF(3), IVALL(3), NPASS, INC, DDL, HHL, MML
      CHARACTER SIGNF*1, TEXT*80, AXLOC*2
      LOGICAL WRIT(4)
C-----------------------------------------------------------------------
      CALL PGBBUF
C
C  Direction signs
C
      SD = 1
      IF (TMAX.LT.TMIN) SD = -1
      IS = 1
      IF (TMIN.LT.0.0) IS = -1
C
C  Find first tick.  Return if none.
C
      NT = TMIN / TICK
      IF (IS*SD.EQ.1 .AND. ABS(TMIN).GT.ABS(NT)*TICK) NT = NT + SD
      TIME = NT * TICK
      IF ( (SD.EQ. 1.AND.(TIME.LT.TMIN.OR.TIME.GT.TMAX)) .OR.
     *     (SD.EQ.-1.AND.(TIME.GT.TMIN.OR.TIME.LT.TMAX)) ) RETURN
C
C  Now step through time range in TICK increments and convert
C  times in seconds at each tick to  +/- (DD) HH MM SS.S
C
      IZERO = 0
      IT = 1
 100  IF ( (SD.EQ.1  .AND. TIME.GT.(TMAX+1.0E-5)) .OR.
     *     (SD.EQ.-1 .AND. TIME.LT.(TMAX-1.0E-5)) ) GOTO 200
        IF (IT.GT.MAXTIK) THEN
          CALL GRWARN ('PGTBX4: storage exhausted -- you have'
     *                 //'asked for far too many ticks')
          GOTO 200
        END IF
C
C  Convert to (DD) HH MM SS.S and find fraction of window that this
C  tick falls at
C
        CALL PGTBX5 (DODAY, TIME, ASIGN(IT), DD(IT), HH(IT),
     *               MM(IT), SS(IT))
        TFRAC(IT) = (TIME - TMIN) / (TMAX - TMIN)
C
C  Note zero tick
C
        IF (NT.EQ.0) IZERO = IT
C
C  Increment time
C
        NT = NT + SD
        TIME = NT * TICK
        IT = IT + 1
C
        GOTO 100
 200  CONTINUE
      IT = IT - 1
C
C   Work out the precision with which to write fractional seconds 
C   labels into the SS.S field.   All other fields have integer labels.
C
      SPREC = 0
      IF (TSCALE.EQ.1) THEN
        IF (TICK.LT.0.01) THEN
          SPREC = 3
        ELSE IF (TICK.LT.0.1) THEN
          SPREC = 2
        ELSE IF (TICK.LT.1.0) THEN
          SPREC = 1
        END IF
      END IF
C
C  Label special case of first tick.  Prepare fields and label
C
      CALL PGTBX6 (DODAY, MOD24, TSCALE, DD(1), HH(1), MM(1), 
     *             SS(1), IVALF, RVAL, WRIT)
      SIGNF = 'H'
      IF (DODAY) SIGNF = 'D'
      CALL PGTBX7 (SUPTYP, SIGNF, ASIGN(1), IVALF, RVAL, WRIT,
     *             SPREC, DO2, TEXT, TLEN, LAST)
C
C   Set label displacements from axes.  This is messy for labels oriented
C   perpendicularly on the right hand axis as we need to know how long
C   the longest string we are going to write is before we write any 
C   labels as they are right justified.
C
      IF (AXIS.EQ.'X') THEN
        IF (CONVTL) THEN
          AXLOC = 'B'
          IF (SUPTYP.NE.'NONE') THEN
            DISP = 1.4
          ELSE
            DISP = 1.2
          END IF
        ELSE
          AXLOC = 'T'
          DISP = 0.7
        END IF
      ELSE IF (AXIS.EQ.'Y') THEN
        IF (CONVTL) THEN
          AXLOC = 'LV'
          IF (DOPARA) AXLOC = 'L'
          DISP = 0.7
        ELSE
          IF (DOPARA) THEN
            AXLOC = 'R'
            IF (SUPTYP.NE.'NONE') THEN
              DISP = 1.7
            ELSE
              DISP = 1.9
            END IF
          ELSE
C
C  Work out number of characters in first label
C
            AXLOC = 'RV'
            IF (ASIGN(1).NE.'-' .AND. TMIN*TMAX.LT.0.0) THEN
              CALL PGLEN (2, ' -'//TEXT(1:TLEN), XLEN, YLEN)
            ELSE
              CALL PGLEN (2, ' '//TEXT(1:TLEN), XLEN, YLEN)
            END IF
            CALL PGQCS (2, XLEN2, YLEN2)
            DISP = (XLEN/XLEN2)
          END IF
        END IF
      END IF
C
C  Now write the label to the plot.  The X-axis label for the first tick is
C  centred such that the last field of the label is centred on the tick
C
      IF (FIRST) THEN
        CALL PGLEN (5, TEXT(LAST:TLEN), XLEN, YLEN)
C
        IF (AXIS.EQ.'X') THEN
          COORD = TFRAC(1) + XLEN / 2.0
          FJUST = 1.0
        ELSE IF (AXIS.EQ.'Y') THEN
          IF (DOPARA) THEN
            COORD = TFRAC(1) + YLEN / 2.0
            FJUST = 1.0
          ELSE
            FJUST = 1.0
            COORD = TFRAC(1)
          END IF
        END IF
        CALL PGMTXT (AXLOC, DISP, COORD, FJUST, TEXT(1:TLEN))
      END IF
      IF (IT.EQ.1) RETURN
C
C   Designate which field out of DD or HH will carry the sign, depending
C   on whether you want the day field or not for the rest of the ticks
C
      SIGNF = 'H'
      IF (DODAY) SIGNF = 'D'
C
C  Set up labelling justifications for the rest of the labels
C
      IF (AXIS.EQ.'X') THEN
        FJUST = 0.5
      ELSE IF (AXIS.EQ.'Y') THEN
        IF (DOPARA) THEN
          FJUST = 0.5
        ELSE
          FJUST = 1.0
        END IF
      END IF
C
C  Note zero crossings; IPOS is the first positive tick and
C  INEG is the first negative tick on either side of 0
C
      IPOS = 0
      INEG = 0
C
      IF (IZERO.NE.0) THEN
        J = IZERO - 1
        IF (J.GE.1) THEN
          IF (ASIGN(J).EQ.'-') THEN
            INEG = J
          ELSE IF (ASIGN(J).EQ.' ') THEN
            IPOS = J
          END IF
        END IF
        J = IZERO + 1
        IF (J.LE.IT) THEN
          IF (ASIGN(J).EQ.'-') THEN
            INEG = J
          ELSE IF (ASIGN(J).EQ.' ') THEN
            IPOS = J
          END IF
        END IF
      END IF
C
C  Now label special case of zero tick. It carries the sign change
C  when going from positive to negative time, left to right.
C
      IF (IZERO.NE.0 .AND. IZERO.NE.1) THEN
        CALL PGTBX6 (DODAY, MOD24, TSCALE, DD(IZERO), HH(IZERO), 
     *               MM(IZERO), SS(IZERO), IVALZ, RVAL, WRIT)
C
        IF (ASIGN(IZERO-1).EQ.' ') ASIGN(IZERO) = '-'
        CALL PGTBX7 (SUPTYP, SIGNF, ASIGN(IZERO), IVALZ, RVAL, WRIT,
     *               SPREC, DO2, TEXT, TLEN, LAST)
C
        COORD = TFRAC(IZERO)
        CALL PGMTXT (AXLOC, DISP, COORD, FJUST, TEXT(1:TLEN))
      END IF
C
C   We may need an extra "virtual" tick if there is no zero crossing
C   and SD=-1 & IS=1 or SD=1 & IS=-1.  It is used to work out which
C   fields to label on the right most tick which is labelled first.
C
      IF (IZERO.EQ.0) THEN
        IF (SD*IS.EQ.-1) THEN 
          IF ( (SD.EQ.-1 .AND. TIME.LE.0.0) .OR.
     *         (SD.EQ. 1 .AND. TIME.GE.0.0) ) TIME = 0.0
          CALL PGTBX5 (DODAY, TIME, ASIGNL, DDL, HHL, MML, SSL)
          CALL PGTBX6 (DODAY, MOD24, TSCALE, DDL, HHL, MML, SSL,
     *                 IVALL, RVAL, WRIT)
        END IF
      END IF
C
C  We want to label in the direction(s) away from zero, so we may  need
C  two passes. Determine the start and end ticks for each required pass.
C
      JST(2) = 0
      JEND(2) = 0
      NPASS = 1
      IF (IZERO.EQ.0) THEN
        IF (IS*SD.EQ.1) THEN
          JST(1) = 1
          JEND(1) = IT
        ELSE
          JST(1) = IT
          JEND(1) = 1
        END IF
      ELSE
        IF (INEG.EQ.0 .OR. IPOS.EQ.0) THEN
          JST(1) = IZERO
          JEND(1) = IT
          IF (IZERO.EQ.IT) JEND(1) = 1
        ELSE
          NPASS = 2
          JST(1) = IZERO
          JEND(1) = 1
          JST(2) = IZERO
          JEND(2) = IT
        END IF
      END IF
C
C  Now label the rest of the ticks.  Always label away from 0
C
      DO 400 I = 1, NPASS
C
C  Initialize previous tick values.  Use virtual tick if labelling
C  left to right without a zero (one pass)
C
        DO 250 K = 1, 3
          IVALO(K) = IVALZ(K)
          IF (IZERO.EQ.0) THEN
            IVALO(K) = IVALL(K)
            IF (JST(I).EQ.1) IVALO(K) = IVALF(K)
          END IF
  250   CONTINUE
C
        INC = 1
        IF (JEND(I).LT.JST(I)) INC = -1
        DO 300 J = JST(I), JEND(I), INC
C
C  First and zero tick already labelled
C
          IF (J.NE.1 .AND. J.NE.IZERO) THEN
C
C  Prepare fields
C
            CALL PGTBX6 (DODAY, MOD24, TSCALE, DD(J), HH(J), MM(J),
     *                   SS(J), IVAL, RVAL, WRIT)
C
C  Don't write unchanging fields
C
            DO 275 K = 1, 3
              IF (IVAL(K).EQ.IVALO(K)) WRIT(K) = F
 275        CONTINUE
C
C  Prepare label
C
            CALL PGTBX7 (SUPTYP, SIGNF, ASIGN(J), IVAL, RVAL, WRIT,
     *                   SPREC, DO2, TEXT, TLEN, LAST)
C
C  Write label
C
            COORD = TFRAC(J)
            CALL PGMTXT (AXLOC, DISP, COORD, FJUST, TEXT(1:TLEN))
C
C  Update old values
C
            DO 280 K = 1, 3
              IVALO(K) = IVAL(K)
  280       CONTINUE
          END IF
 300    CONTINUE
 400  CONTINUE
      CALL PGEBUF
C 
      RETURN
      END
C PGTBX5 -- support routine for PGTBOX
C
      SUBROUTINE PGTBX5 (DODAY, TSEC, ASIGN, D, H, M, S)
C      
      REAL S, TSEC
      INTEGER  D, H, M
      LOGICAL DODAY
      CHARACTER*1 ASIGN
C
C  Convert time in seconds to (DD) HH MM SS.S
C
C Input
C  DODAY  :  Use day field if true, else hours accumulates beyond 24
C  TSEC   :  Time in seconds (signed)
C Output
C  ASIGN  :  Sign, ' ' or '-'
C  D,H,M  :  DD, HH, MM (unsigned)
C  S      :  SS.S       (unsigned)
C
C 10-Jun-1993 - new routine [nebk]
C-----------------------------------------------------------------------
      INTEGER IT
C----------------------------------------------------------------------
      ASIGN = ' '
      IF (TSEC.LT.0.0) ASIGN = '-'
C
      S = MOD(ABS(TSEC),60.0)
C
      IT = NINT(ABS(TSEC)-S) / 60
      M = MOD(IT,60)
C
      IT = (IT - M) / 60
      IF (DODAY) THEN
        H = MOD(IT,24)
        D = (IT-H) / 24
      ELSE
        H = IT
        D = 0
      END IF
C
      RETURN
      END
C PGTBX6 -- support routine for PGTBOX
C
      SUBROUTINE PGTBX6 (DODAY, MOD24, TSCALE, DD, HH, MM, SS, IVAL, 
     *                   RVAL, WRIT)
C
      INTEGER TSCALE, IVAL(3), DD, HH, MM
      REAL SS, RVAL
      LOGICAL WRIT(4), DODAY, MOD24
C
C   Find out which of the DD HH MM SS.S fields we want to write
C   into the label according to TSCALE and make a round off
C   error check.
C
C  Input:
C    DODAY  :  Use day field if true else hours accrue beyond 24
C    MOD24  :  HH field labelled as modulo 24
C    TSCALE :  Dictates which fields appear in labels
C    DD     :  Day of time  (will be 0 if DODAY=F and HH will compensate)
C    HH     :  Hour of time
C    MM     :  Minute of time
C    SS     :  Second of time
C  Output:
C    IVAL(3):  DD HH MM to write into label
C    RVAL   :  SS.S to write into label
C    WRIT(4):  T or F if DD,HH,MM,SS are to be written into the label
C              or not.  IVAL and RVAL fields are set explicitly to
C              zero if the corresponding WRIT field is false.
C              This really is overkill.
C
C  10-Jun-1993 - New routine [nebk]
C  16-Jan-1995 - Add argument MOD24
C-----------------------------------------------------------------------
      LOGICAL T, F
      PARAMETER (T = .TRUE., F = .FALSE.)
      INTEGER WM
C-----------------------------------------------------------------------
      IVAL(1) = DD
      IVAL(2) = HH
      IVAL(3) = MM
      RVAL    = SS
C
C  SS should be 0.0; round off may get us 59.999 or the like but
C  not 60.001 (see PGTBX5)
C
      IF (TSCALE.GT.1) THEN
        WM = NINT(SS/60.0)
        IVAL(3) = IVAL(3) + WM
        IF (IVAL(3).EQ.60) THEN
          IVAL(3) = 0
          IVAL(2) = IVAL(2) + 1
          IF (DODAY .AND. IVAL(2).EQ.24) THEN
            IVAL(2) = 0
            IVAL(1) = IVAL(1) + 1
          END IF
        END IF
      END IF
C
C Make HH field modulo 24 if desired
C
      IF (MOD24) IVAL(2) = MOD(IVAL(2),24)
C
      IF (TSCALE.EQ.1) THEN
C
C  Label contains (DD) HH MM SS.S
C
        WRIT(1) = DODAY
        WRIT(2) = T
        WRIT(3) = T
        WRIT(4) = T
      ELSE IF (TSCALE.EQ.60) THEN
C
C  Label contains (DD) HH MM
C
        WRIT(1) = DODAY
        WRIT(2) = T
        WRIT(3) = T
C        
        RVAL    = 0.0
        WRIT(4) = F
      ELSE IF (TSCALE.EQ.3600) THEN
C
C  Label contains (DD) HH
C
        WRIT(1) = DODAY
        WRIT(2) = T
C
        IVAL(3) = 0
        WRIT(3) = F
C  
        RVAL    = 0.0
        WRIT(4) = F
      ELSE IF (TSCALE.EQ.3600*24) THEN
C
C  Label contains DD
C
        WRIT(1) = T
C
        IVAL(2) = 0
        WRIT(2) = F
C
        IVAL(3) = 0
        WRIT(3) = F
C
        RVAL    = 0.0
        WRIT(4) = F
      END IF
C
      RETURN
      END
      SUBROUTINE PGTBX7 (SUPTYP, SIGNF, ASIGN, IVAL, RVAL, WRIT,
     *                   SPREC, DO2, TEXT, TLEN, LAST)
C
      REAL RVAL
      INTEGER IVAL(3), TLEN, SPREC, LAST
      CHARACTER ASIGN*1, TEXT*(*), SIGNF*1, SUPTYP*4
      LOGICAL WRIT(4), DO2
C
C Write (DD) HH MM SS.S time labels into a string
C
C This is a support routine for PGTBOX and should not be
C called by the user
C
C Inputs
C  SUPTYP :  '    ', 'DHMS', or ' DMS' for no superscript labelling,
C            d,h,m,s   or   o,','' superscripting
C  SIGNF  :  Tells which field the sign is associated with.  
C            One of 'D', 'H', 'M', or 'S'    
C  ASIGN  :  ' ' or '-' for positive or negative times
C  IVAL(3):  Day, hour, minutes of time
C  RVAL   :  Seconds of time
C  WRIT(4):  If .true. then write DD, HH, MM, SS  into label
C  SPREC  :  Number of places after the decimal to write seconds 
C            string to.  Must be in the range 0-3
C  DO2    :  If true, add a leading zero to numbers < 10
C Outputs
C  TEXT   :  Label
C  TLEN   :  Length of label
C  LAST   :  Is the location of the start character of the last 
C            field written into TEXT
C
C  05-Sep-1989 -- New routine (Neil Killeen)
C  20-Apr-1991 -- Complete rewrite; support for new DD (day) field and 
C                 superscripted labels [nebk]
C  14-May-1991 -- Removed BSL as a parameter (Char(92)) and made it
C                 a variable to appease Cray compiler [mjs/nebk]
C  10-Jun-1993 -- Rename from PGTLB1, add code to label superscript 
C                 seconds above the '.' and add DO2 option [nebk/jm]
C-----------------------------------------------------------------------
      INTEGER FLEN, FST, FMAX, TRLEN(3), SUPPNT, TMPNT, TLEN2, 
     *IR1, IR2, IP
      CHARACTER FIELD*30, FRMAT2(3)*2, SUPER(4,3)*11, TMP*100, 
     *BSL*1, FRMAT*30
C
      SAVE FRMAT2
      SAVE TRLEN
C
      DATA FRMAT2 /'I1', 'I2', 'I3'/
      DATA TRLEN /5, 11, 5/
C-----------------------------------------------------------------------
C
C   Initialize
C
      BSL = CHAR(92)
      TLEN = 0
      TEXT = ' '
C
C   Assign superscripting strings.  Use CHAR(92) for backslash as the
C   latter must be escaped on SUNs thus requiring preprocessing.  The
C   concatenator operator precludes the use of a data statement
C
      SUPER(1,1) = BSL//'ud'//BSL//'d'
      SUPER(2,1) = BSL//'uh'//BSL//'d'
      SUPER(3,1) = BSL//'um'//BSL//'d'
      SUPER(4,1) = BSL//'us'//BSL//'d'
C
      SUPER(1,2) = BSL//'u'//BSL//'(2199)'//BSL//'d'
      SUPER(2,2) = BSL//'u'//BSL//'(2729)'//BSL//'d'
      SUPER(3,2) = BSL//'u'//BSL//'(2727)'//BSL//'d'
      SUPER(4,2) = BSL//'u'//BSL//'(2728)'//BSL//'d'
C      
      SUPER(1,3) = BSL//'u'//' '//BSL//'d'
      SUPER(2,3) = BSL//'u'//' '//BSL//'d'
      SUPER(3,3) = BSL//'u'//' '//BSL//'d'
      SUPER(4,3) = BSL//'u'//' '//BSL//'d'
C
C   Point at correct superscript strings
C
      IF (SUPTYP.EQ.'DHMS') THEN
        SUPPNT = 1
      ELSE IF (SUPTYP.EQ.' DMS') THEN
        SUPPNT = 2
      ELSE
        SUPPNT = 3
      END IF
C
CCCC
C   Days field
CCCC
C
      IF (WRIT(1)) THEN
        LAST = TLEN + 1
C
C   Write into temporary field
C
        FIELD = ' '
        CALL PGNPL (0, IVAL(1), FLEN)
        WRITE (FIELD, '(I6)') IVAL(1)
        FMAX = 6
        FST = FMAX - FLEN + 1
C
C   Write output text string with desired superscripting
C
        TMPNT = 2
        IF (SIGNF.EQ.'D' .AND. ASIGN.NE.' ') TMPNT = 1
C
        TMP = ASIGN//FIELD(FST:FMAX)//SUPER(1,SUPPNT)
        TLEN2 = (2 - TMPNT) + FLEN + TRLEN(SUPPNT)
C
        TEXT(TLEN+1:) = TMP(TMPNT:TMPNT+TLEN2-1)
        TLEN = TLEN + TLEN2
      END IF
C
CCCC 
C   Hours field
CCCC
C
      IF (WRIT(2)) THEN
        LAST = TLEN + 1
C
C   Write into temporary field
C
        FIELD = ' '
        CALL PGNPL (0, IVAL(2), FLEN)
        WRITE (FIELD, '(I6)') IVAL(2)
        FMAX = 6
        FST = FMAX - FLEN + 1
C
        IF (DO2 .AND. FLEN.EQ.1) THEN
          FLEN = FLEN + 1
          FST = FST - 1
          FIELD(FST:FST) = '0'
        END IF
C
C   Write output text string with desired superscripting
C
        TMPNT = 2
        IF (SIGNF.EQ.'H' .AND. ASIGN.NE.' ') TMPNT = 1
C
        TMP = ASIGN//FIELD(FST:FMAX)//SUPER(2,SUPPNT)
        TLEN2 = (2 - TMPNT) + FLEN + TRLEN(SUPPNT)
C
        TEXT(TLEN+1:) = TMP(TMPNT:TMPNT+TLEN2-1)
        TLEN = TLEN + TLEN2
      END IF
C
CCCC
C   Minutes field
CCCC
C
      IF (WRIT(3)) THEN
        LAST = TLEN + 1
C
C   Write into temporary field with desired superscripting
C
        FIELD = ' '
        WRITE (FIELD, '(I2, A)') IVAL(3), 
     *                           SUPER(3,SUPPNT)(1:TRLEN(SUPPNT))
        FMAX = 2 + TRLEN(SUPPNT)
C
        FST = 1
        IF (FIELD(FST:FST).EQ.' ') THEN
          IF (DO2) THEN
            FIELD(FST:FST) = '0'
          ELSE
            FST = FST + 1
          END IF
        END IF
        FLEN = FMAX - FST + 1
C
C   Write output text string
C
        TMPNT = 2
        IF (SIGNF.EQ.'M' .AND. ASIGN.NE.' ') TMPNT = 1
C
        TMP = ASIGN//FIELD(FST:FMAX)
        TLEN2 = (2 - TMPNT) + FLEN
C
        TEXT(TLEN+1:) = TMP(TMPNT:TMPNT+TLEN2-1)
        TLEN = TLEN + TLEN2
      END IF
C
CCCC
C   Seconds field
CCCC
C
      IF (WRIT(4)) THEN
        LAST = TLEN + 1
C
C   Write into temporary field
C 
        FIELD = ' '
        FST = 1
        IF (SPREC.GE.1) THEN
C
C   Fractional label.  Upto 3 places after the decimal point allowed
C   Muck around to get the superscript on top of the decimal point
C
          IR1 = INT(RVAL)
          IR2 = NINT((RVAL - IR1) * 10**SPREC)
          FRMAT = '(I2, A1, A, '//FRMAT2(SPREC)//')'
          WRITE (FIELD, FRMAT(1:15)) 
     *                       IR1, '.',
     *                       BSL//'b'//SUPER(4,SUPPNT)(1:TRLEN(SUPPNT)),
     *                       IR2
          IP = 5 + TRLEN(SUPPNT) + 1
          IF (FIELD(IP:IP).EQ.' ') FIELD(IP:IP) = '0'
          IF (FIELD(IP+1:IP+1).EQ.' ') FIELD(IP+1:IP+1) = '0'
          FMAX = 1 + 2 + SPREC
        ELSE
C
C   Integer label.  
C
          WRITE (FIELD, '(I2,A)') NINT(RVAL), 
     *                            SUPER(4,SUPPNT)(1:TRLEN(SUPPNT))
          FMAX = 0
        END IF
        FMAX = FMAX + 2 + TRLEN(SUPPNT)
C
        IF (FIELD(FST:FST).EQ.' ') THEN
          IF (DO2) THEN
            FIELD(FST:FST) = '0'
          ELSE
            FST = FST + 1
          END IF
        END IF
        FLEN = FMAX - FST + 1
C
C   Write output text string
C
        TMPNT = 2
        IF (SIGNF.EQ.'S' .AND. ASIGN.NE.' ') TMPNT = 1
        TMP = ASIGN//FIELD(FST:FMAX)
        TLEN2 = (3 - TMPNT) + FLEN
C
        TEXT(TLEN+1:) = TMP(TMPNT:TMPNT+TLEN2-1)
        TLEN = TLEN + TLEN2
      END IF
C  
C   A trailing blank will occur if no superscripting wanted
C
      IF (TLEN.GE.5 .AND. TEXT(TLEN-4:TLEN).EQ.BSL//'u'//' '//BSL//'d')
     *   TLEN = TLEN - 5
C      
      RETURN
      END
#<

#>            pgtbx1.dc3
Name:         pgtbx1

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Nov  9, 1998: JPT created document. 

#<

#>            pgtbx2.dc3
Name:         pgtbx2

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Nov  9, 1998: JPT created document. 

#<

#>            pgtbx3.dc3
Name:         pgtbx3

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Nov  9, 1998: JPT created document. 

#<

#>            pgtbx4.dc3
Name:         pgtbx4

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Nov  9, 1998: JPT created document. 

#<

#>            pgtbx5.dc3
Name:         pgtbx5

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Nov  9, 1998: JPT created document. 
#<

#>            pgtbx6.dc3
Name:         pgtbx6

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Nov  9, 1998: JPT created document. 
#<

#>            pgtbx7.dc3
Name:         pgtbx7

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Nov  9, 1998: JPT created document.
#<

#>            pgtext.dc2
Name:         PGTEXT

Purpose:      write text (horizontal, left-justified)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGTEXT (X, Y, TEXT)
            REAL X, Y
            CHARACTER*(*) TEXT
      
       Write text. The bottom left corner of the first character is placed
       at the specified position, and the text is written horizontally.
       This is a simplified interface to the primitive routine PGPTXT.
       For non-horizontal text, use PGPTXT.
      
       Arguments:
        X      (input)  : world x-coordinate of start of string.
        Y      (input)  : world y-coordinate of start of string.
        TEXT   (input)  : the character string to be plotted.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgtext.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGTEXT -- write text (horizontal, left-justified)
C%void cpgtext(float x, float y, const char *text);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgtext( real, real, character )
*

C+
      SUBROUTINE PGTEXT (X, Y, TEXT)
      REAL X, Y
      CHARACTER*(*) TEXT
C
C Write text. The bottom left corner of the first character is placed
C at the specified position, and the text is written horizontally.
C This is a simplified interface to the primitive routine PGPTXT.
C For non-horizontal text, use PGPTXT.
C
C Arguments:
C  X      (input)  : world x-coordinate of start of string.
C  Y      (input)  : world y-coordinate of start of string.
C  TEXT   (input)  : the character string to be plotted.
C--
C (2-May-1983)
C-----------------------------------------------------------------------
      CALL PGPTXT(X, Y, 0.0, 0.0, TEXT)
      END
#<

#>            pgtick.dc2
Name:         PGTICK

Purpose:      draw a single tick mark on an axis

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGTICK (X1, Y1, X2, Y2, V, TIKL, TIKR, DISP, 
           :                   ORIENT, STR)
            REAL X1, Y1, X2, Y2, V, TIKL, TIKR, DISP, ORIENT
            CHARACTER*(*) STR
      
       Draw and label single tick mark on a graph axis. The tick mark is
       a short line perpendicular to the direction of the axis (which is not
       drawn by this routine). The optional text label is drawn with its
       baseline parallel to the axis and reading in the same direction as
       the axis (from point 1 to point 2). Current line and text attributes
       are used.
      
       Arguments:
        X1, Y1 (input)  : world coordinates of one endpoint of the axis.
        X2, Y2 (input)  : world coordinates of the other endpoint of the axis.
        V      (input)  : draw the tick mark at fraction V (0<=V<=1) along
                          the line from (X1,Y1) to (X2,Y2).
        TIKL   (input)  : length of tick mark drawn to left of axis
                          (as seen looking from first endpoint to second), in
                          units of the character height.
        TIKR   (input)  : length of major tick marks drawn to right of axis,
                          in units of the character height.
        DISP   (input)  : displacement of label text to
                          right of axis, in units of the character height.
        ORIENT (input)  : orientation of label text, in degrees; angle between
                          baseline of text and direction of axis (0-360°).
        STR    (input)  : text of label (may be blank).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgtick.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGTICK -- draw a single tick mark on an axis
C%void cpgtick(float x1, float y1, float x2, float y2, float v, \
C% float tikl, float tikr, float disp, float orient, const char *str);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgtick( real, real, real, real, real, real, real, real, real, character )
*

C+
      SUBROUTINE PGTICK (X1, Y1, X2, Y2, V, TIKL, TIKR, DISP, 
     :                   ORIENT, STR)
      REAL X1, Y1, X2, Y2, V, TIKL, TIKR, DISP, ORIENT
      CHARACTER*(*) STR
C
C Draw and label single tick mark on a graph axis. The tick mark is
C a short line perpendicular to the direction of the axis (which is not
C drawn by this routine). The optional text label is drawn with its
C baseline parallel to the axis and reading in the same direction as
C the axis (from point 1 to point 2). Current line and text attributes
C are used.
C
C Arguments:
C  X1, Y1 (input)  : world coordinates of one endpoint of the axis.
C  X2, Y2 (input)  : world coordinates of the other endpoint of the axis.
C  V      (input)  : draw the tick mark at fraction V (0<=V<=1) along
C                    the line from (X1,Y1) to (X2,Y2).
C  TIKL   (input)  : length of tick mark drawn to left of axis
C                    (as seen looking from first endpoint to second), in
C                    units of the character height.
C  TIKR   (input)  : length of major tick marks drawn to right of axis,
C                    in units of the character height.
C  DISP   (input)  : displacement of label text to
C                    right of axis, in units of the character height.
C  ORIENT (input)  : orientation of label text, in degrees; angle between
C                    baseline of text and direction of axis (0-360°).
C  STR    (input)  : text of label (may be blank).
C--
C 25-Mar-1997 - new routine [TJP].
C-----------------------------------------------------------------------
      REAL X, Y, XV1, XV2, YV1, YV2, XW1, XW2, YW1, YW2
      REAL XPMM, YPMM, LENMM, ANGLE, XCH, YCH
      REAL TIKX, TIKY, FJUST, D, OR
C
C Check arguments.
C
      IF (X1.EQ.X2 .AND. Y1.EQ.Y2) RETURN
C
C Get current character height (mm) [note: XCH = YCH].
C
      CALL PGQCS(2, XCH, YCH)
C
C Get x and y scales (units per mm).
C
      CALL PGQVP(2, XV1, XV2, YV1, YV2)
      CALL PGQWIN(XW1, XW2, YW1, YW2)
      XPMM  = (XW2-XW1)/(XV2-XV1)
      YPMM  = (YW2-YW1)/(YV2-YV1)
C
C Length of axis in mm.
C
      LENMM = SQRT(((X2-X1)/XPMM)**2 + ((Y2-Y1)/YPMM)**2)
C
C Angle of axis to horizontal (device coordinates).
C
      ANGLE = ATAN2((Y2-Y1)/YPMM, (X2-X1)/XPMM)*57.29577951
C
C (x,y) displacement for 1 character height perpendicular to axis.
C
      TIKX = (Y1-Y2)*XCH*XPMM/(LENMM*YPMM)
      TIKY = (X2-X1)*XCH*YPMM/(LENMM*XPMM)
C
C Draw the tick mark at point (X,Y) on the axis.
C
      X = X1 + V*(X2-X1)
      Y = Y1 + V*(Y2-Y1)
      CALL PGMOVE(X - TIKR*TIKX, Y - TIKR*TIKY)
      CALL PGDRAW(X + TIKL*TIKX, Y + TIKL*TIKY)
C
C Label the tick mark.
C
      D = DISP
      IF (STR.EQ.' ') RETURN
      OR = MOD(ORIENT, 360.0)
      IF (OR.LT.0.0) OR=OR+360.0
      IF (OR.GT.45.0 .AND. OR.LE.135.0) THEN
         FJUST = 0.0
         IF (D.LT.0.0) FJUST = 1.0
      ELSE IF (OR.GT.135.0 .AND. OR.LE.225.0) THEN
         FJUST = 0.5
         IF (D.LT.0.0) D = D-1.0
      ELSE IF (OR.GT.225.0 .AND. OR.LE.315.0) THEN
         ANGLE = ANGLE+90.0
         FJUST = 1.0
         IF (D.LT.0.0) FJUST = 0.0
      ELSE
         FJUST = 0.5
         IF (D.GT.0.0) D = D+1.0
      END IF            
      CALL PGPTXT(X-D*TIKX, Y-D*TIKY, ANGLE-OR, FJUST, STR)
      END
#<

#>            pgtikl.dc3
Name:         pgtikl

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Oct 16, 1998: JPT automatically generated.
#<

#>            pgtikl.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C.PGTIKL -- length of error bar terminal
C
      SUBROUTINE PGTIKL (T, XL, YL)
      REAL T, XL, YL
C
C Return the length of the terminal of an error bar, in world
C coordinates.
C
C Arguments:
C  T      (input)  : terminal multiplier
C  XL     (output) : terminal lnegth in world x-coordinates
C  YL     (output) : terminal lnegth in world y-coordinates
C--
C 31-Mar-1997 - new routine [TJP].
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
C
      XL = T*PGXSP(PGID)*0.15/PGXSCL(PGID)
      YL = T*PGXSP(PGID)*0.15/PGYSCL(PGID)
C
      END
#<

#>            pgunsa.dc2
Name:         PGUNSA

Purpose:      restore PGPLOT attributes

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            ENTRY PGUNSA
      
       This routine restores the PGPLOT attributes saved in the last call to
       PGSAVE. Usage: CALL PGUNSA (no arguments). See PGSAVE.
      
       Arguments: none

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgupdt.dc2
Name:         PGUPDT

Purpose:      update display

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGUPDT
      
       Update the graphics display: flush any pending commands to the
       output device. This routine empties the buffer created by PGBBUF,
       but it does not alter the PGBBUF/PGEBUF counter. The routine should
       be called when it is essential that the display be completely up to
       date (before interaction with the user, for example) but it is not
       known if output is being buffered.
      
       Arguments: none

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgupdt.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGUPDT -- update display
C%void cpgupdt(void);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgupdt(  )
*

C+
      SUBROUTINE PGUPDT
C
C Update the graphics display: flush any pending commands to the
C output device. This routine empties the buffer created by PGBBUF,
C but it does not alter the PGBBUF/PGEBUF counter. The routine should
C be called when it is essential that the display be completely up to
C date (before interaction with the user, for example) but it is not
C known if output is being buffered.
C
C Arguments: none
C--
C 27-Nov-1986
C-----------------------------------------------------------------------
      LOGICAL PGNOTO
C
      IF (PGNOTO('PGUPDT')) RETURN
      CALL GRTERM
      END
#<

#>            pgvect.dc2
Name:         PGVECT

Purpose:      vector map of a 2D data array, with blanking

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGVECT (A, B, IDIM, JDIM, I1, I2, J1, J2, C, NC, TR,
           1                   BLANK)
            INTEGER IDIM, JDIM, I1, I2, J1, J2, NC
            REAL    A(IDIM,JDIM), B(IDIM, JDIM), TR(6), BLANK, C
      
       Draw a vector map of two arrays.  This routine is similar to
       PGCONB in that array elements that have the "magic value" defined by
       the argument BLANK are ignored, making gaps in the vector map.  The
       routine may be useful for data measured on most but not all of the
       points of a grid. Vectors are displayed as arrows; the style of the
       arrowhead can be set with routine PGSAH, and the the size of the
       arrowhead is determined by the current character size, set by PGSCH.
      
       Arguments:
        A      (input)  : horizontal component data array.
        B      (input)  : vertical component data array.
        IDIM   (input)  : first dimension of A and B.
        JDIM   (input)  : second dimension of A and B.
        I1,I2  (input)  : range of first index to be mapped (inclusive).
        J1,J2  (input)  : range of second index to be mapped (inclusive).
        C      (input)  : scale factor for vector lengths, if 0.0, C will be
                          set so that the longest vector is equal to the
                          smaller of TR(2)+TR(3) and TR(5)+TR(6).
        NC     (input)  : vector positioning code.
                          <0 vector head positioned on coordinates
                          >0 vector base positioned on coordinates
                          =0 vector centered on the coordinates
        TR     (input)  : array defining a transformation between the I,J
                          grid of the array and the world coordinates. The
                          world coordinates of the array point A(I,J) are
                          given by:
                            X = TR(1) + TR(2)*I + TR(3)*J
                            Y = TR(4) + TR(5)*I + TR(6)*J
                          Usually TR(3) and TR(5) are zero - unless the
                          coordinate transformation involves a rotation
                          or shear.
        BLANK   (input) : elements of arrays A or B that are exactly equal to
                          this value are ignored (blanked).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgvect.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGVECT -- vector map of a 2D data array, with blanking
C%void cpgvect(const float *a, const float *b, int idim, int jdim, \
C% int i1, int i2, int j1, int j2, float c, int nc, \
C% const float *tr, float blank);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgvect( real, real, integer, integer, integer, integer, integer, integer, real, integer, real, real )
*

C+
      SUBROUTINE PGVECT (A, B, IDIM, JDIM, I1, I2, J1, J2, C, NC, TR,
     1                   BLANK)
      INTEGER IDIM, JDIM, I1, I2, J1, J2, NC
      REAL    A(IDIM,JDIM), B(IDIM, JDIM), TR(6), BLANK, C
C
C Draw a vector map of two arrays.  This routine is similar to
C PGCONB in that array elements that have the "magic value" defined by
C the argument BLANK are ignored, making gaps in the vector map.  The
C routine may be useful for data measured on most but not all of the
C points of a grid. Vectors are displayed as arrows; the style of the
C arrowhead can be set with routine PGSAH, and the the size of the
C arrowhead is determined by the current character size, set by PGSCH.
C
C Arguments:
C  A      (input)  : horizontal component data array.
C  B      (input)  : vertical component data array.
C  IDIM   (input)  : first dimension of A and B.
C  JDIM   (input)  : second dimension of A and B.
C  I1,I2  (input)  : range of first index to be mapped (inclusive).
C  J1,J2  (input)  : range of second index to be mapped (inclusive).
C  C      (input)  : scale factor for vector lengths, if 0.0, C will be
C                    set so that the longest vector is equal to the
C                    smaller of TR(2)+TR(3) and TR(5)+TR(6).
C  NC     (input)  : vector positioning code.
C                    <0 vector head positioned on coordinates
C                    >0 vector base positioned on coordinates
C                    =0 vector centered on the coordinates
C  TR     (input)  : array defining a transformation between the I,J
C                    grid of the array and the world coordinates. The
C                    world coordinates of the array point A(I,J) are
C                    given by:
C                      X = TR(1) + TR(2)*I + TR(3)*J
C                      Y = TR(4) + TR(5)*I + TR(6)*J
C                    Usually TR(3) and TR(5) are zero - unless the
C                    coordinate transformation involves a rotation
C                    or shear.
C  BLANK   (input) : elements of arrays A or B that are exactly equal to
C                    this value are ignored (blanked).
C--
C  4-Sep-1992: derived from PGCONB [J. Crane].
C 26-Nov-1992: revised to use PGARRO [TJP].
C 25-Mar-1994: correct error for NC not =0 [G. Gonczi].
C  5-Oct-1996: correct error in computing max vector length [TJP;
C              thanks to David Singleton].
C-----------------------------------------------------------------------
      INTEGER  I, J
      REAL X, Y, X1, Y1, X2, Y2
      REAL CC
      INTRINSIC SQRT, MAX, MIN
C
C Define grid to world transformation
C
      X(I,J) = TR(1) + TR(2)*I + TR(3)*J
      Y(I,J) = TR(4) + TR(5)*I + TR(6)*J
C
C Check arguments.
C
      IF (I1.LT.1 .OR. I2.GT.IDIM .OR. I1.GE.I2 .OR.
     1    J1.LT.1 .OR. J2.GT.JDIM .OR. J1.GE.J2) THEN
C        CALL GRWARN('PGVECT: invalid range I1:I2, J1:J2')
         RETURN
      END IF
C
C Check for scale factor C.
C
      CC = C
      IF (CC.EQ.0.0) THEN
         DO 20 J=J1,J2
            DO 10 I=I1,I2
               IF (A(I,J).NE.BLANK .AND. B(I,J).NE.BLANK)
     1              CC = MAX(CC,SQRT(A(I,J)**2+B(I,J)**2))
 10         CONTINUE
 20      CONTINUE
         IF (CC.EQ.0.0) RETURN
         CC = SQRT(MIN(TR(2)**2+TR(3)**2,TR(5)**2+TR(6)**2))/CC
      END IF
C
      CALL PGBBUF
C
      DO 40 J=J1,J2
         DO 30 I=I1,I2
C
C Ignore vector if element of A and B are both equal to BLANK
C
            IF (.NOT.(A(I,J).EQ.BLANK .AND. B(I,J).EQ.BLANK)) THEN
 
C
C Define the vector starting and end points according to NC.
C
               IF (NC.LT.0) THEN
                  X2 = X(I,J)
                  Y2 = Y(I,J)
                  X1 = X2 - A(I,J)*CC
                  Y1 = Y2 - B(I,J)*CC
               ELSE IF (NC.EQ.0) THEN
                  X2 = X(I,J) + 0.5*A(I,J)*CC
                  Y2 = Y(I,J) + 0.5*B(I,J)*CC
                  X1 = X2 - A(I,J)*CC
                  Y1 = Y2 - B(I,J)*CC
               ELSE
                  X1 = X(I,J)
                  Y1 = Y(I,J)
                  X2 = X1 + A(I,J)*CC
                  Y2 = Y1 + B(I,J)*CC
               END IF
C     
C Draw vector.
C
               CALL PGARRO(X1, Y1, X2, Y2)
            END IF
 30      CONTINUE
 40   CONTINUE
C
      CALL PGEBUF
      END
#<

#>            pgvport.dc2
Name:         PGVPORT

Purpose:      non-standard alias for PGSVP

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGVPORT (XLEFT, XRIGHT, YBOT, YTOP)
            REAL XLEFT, XRIGHT, YBOT, YTOP
      
       See description of PGSVP.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgvport.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGVPORT -- non-standard alias for PGSVP
C+
      SUBROUTINE PGVPORT (XLEFT, XRIGHT, YBOT, YTOP)
      REAL XLEFT, XRIGHT, YBOT, YTOP
C
C See description of PGSVP.
C--
      CALL PGSVP (XLEFT, XRIGHT, YBOT, YTOP)
      END
#<

#>            pgvsiz.dc2
Name:         PGVSIZ

Purpose:      set viewport (inches)

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGVSIZ (XLEFT, XRIGHT, YBOT, YTOP)
            REAL XLEFT, XRIGHT, YBOT, YTOP
      
       Change the size and position of the viewport, specifying
       the viewport in physical device coordinates (inches).  The
       viewport is the rectangle on the view surface "through"
       which one views the graph.  All the PG routines which plot lines
       etc. plot them within the viewport, and lines are truncated at
       the edge of the viewport (except for axes, labels etc drawn with
       PGBOX or PGLAB).  The region of world space (the coordinate
       space of the graph) which is visible through the viewport is
       specified by a call to PGSWIN.  It is legal to request a
       viewport larger than the view surface; only the part which
       appears on the view surface will be plotted.
      
       Arguments:
        XLEFT  (input)  : x-coordinate of left hand edge of viewport, in
                          inches from left edge of view surface.
        XRIGHT (input)  : x-coordinate of right hand edge of viewport, in
                          inches from left edge of view surface.
        YBOT   (input)  : y-coordinate of bottom edge of viewport, in
                          inches from bottom of view surface.
        YTOP   (input)  : y-coordinate of top  edge of viewport, in inches
                          from bottom of view surface.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgvsiz.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGVSIZ -- set viewport (inches)
C%void cpgvsiz(float xleft, float xright, float ybot, float ytop);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgvsiz( real, real, real, real )
*

C+
      SUBROUTINE PGVSIZ (XLEFT, XRIGHT, YBOT, YTOP)
      REAL XLEFT, XRIGHT, YBOT, YTOP
C
C Change the size and position of the viewport, specifying
C the viewport in physical device coordinates (inches).  The
C viewport is the rectangle on the view surface "through"
C which one views the graph.  All the PG routines which plot lines
C etc. plot them within the viewport, and lines are truncated at
C the edge of the viewport (except for axes, labels etc drawn with
C PGBOX or PGLAB).  The region of world space (the coordinate
C space of the graph) which is visible through the viewport is
C specified by a call to PGSWIN.  It is legal to request a
C viewport larger than the view surface; only the part which
C appears on the view surface will be plotted.
C
C Arguments:
C  XLEFT  (input)  : x-coordinate of left hand edge of viewport, in
C                    inches from left edge of view surface.
C  XRIGHT (input)  : x-coordinate of right hand edge of viewport, in
C                    inches from left edge of view surface.
C  YBOT   (input)  : y-coordinate of bottom edge of viewport, in
C                    inches from bottom of view surface.
C  YTOP   (input)  : y-coordinate of top  edge of viewport, in inches
C                    from bottom of view surface.
C--
C 13-Dec-1990  Make errors non-fatal [TJP].
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
      LOGICAL  PGNOTO
C
      IF (PGNOTO('PGVSIZ'))  RETURN
      IF (XLEFT.GE.XRIGHT .OR. YBOT.GE.YTOP) THEN
          CALL GRWARN('PGVSIZ ignored: invalid arguments')
          RETURN
      END IF
C
      PGXLEN(PGID) = (XRIGHT-XLEFT)*PGXPIN(PGID)
      PGYLEN(PGID) = (YTOP-YBOT)*PGYPIN(PGID)
      PGXVP(PGID)  = XLEFT*PGXPIN(PGID)
      PGYVP(PGID)  = YBOT*PGYPIN(PGID)
      PGXOFF(PGID) = PGXVP(PGID) + (PGNXC(PGID)-1)*PGXSZ(PGID)
      PGYOFF(PGID) = PGYVP(PGID) + 
     1                (PGNY(PGID)-PGNYC(PGID))*PGYSZ(PGID)
      CALL PGVW
      END
#<

#>            pgvsize.dc2
Name:         PGVSIZE

Purpose:      non-standard alias for PGVSIZ

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGVSIZE (XLEFT, XRIGHT, YBOT, YTOP)
            REAL XLEFT, XRIGHT, YBOT, YTOP
      
       See description of PGVSIZ.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgvsize.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGVSIZE -- non-standard alias for PGVSIZ
C+
      SUBROUTINE PGVSIZE (XLEFT, XRIGHT, YBOT, YTOP)
      REAL XLEFT, XRIGHT, YBOT, YTOP
C
C See description of PGVSIZ.
C--
      CALL PGVSIZ (XLEFT, XRIGHT, YBOT, YTOP)
      END
#<

#>            pgvstand.dc2
Name:         PGVSTAND

Purpose:      non-standard alias for PGVSTD

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGVSTAND
      
       See description of PGVSTD.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgvstand.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGVSTAND -- non-standard alias for PGVSTD
C+
      SUBROUTINE PGVSTAND
C
C See description of PGVSTD.
C--
      CALL PGVSTD
      END
#<

#>            pgvstd.dc2
Name:         PGVSTD

Purpose:      set standard (default) viewport

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGVSTD
      
       Define the viewport to be the standard viewport.  The standard
       viewport is the full area of the view surface (or panel),
       less a margin of 4 character heights all round for labelling.
       It thus depends on the current character size, set by PGSCH.
      
       Arguments: none.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgvstd.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGVSTD -- set standard (default) viewport
C%void cpgvstd(void);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgvstd(  )
*

C+
      SUBROUTINE PGVSTD
C
C Define the viewport to be the standard viewport.  The standard
C viewport is the full area of the view surface (or panel),
C less a margin of 4 character heights all round for labelling.
C It thus depends on the current character size, set by PGSCH.
C
C Arguments: none.
C--
C 22-Apr-1983: [TJP].
C  2-Aug-1995: [TJP].
C-----------------------------------------------------------------------
      INCLUDE  'pgplot.inc'
      LOGICAL  PGNOTO
      REAL     XLEFT, XRIGHT, YBOT, YTOP, R
C
      IF (PGNOTO('PGVSIZ')) RETURN
C
      R = 4.0*PGYSP(PGID)
      XLEFT  = R/PGXPIN(PGID)
      XRIGHT = XLEFT + (PGXSZ(PGID)-2.0*R)/PGXPIN(PGID)
      YBOT   = R/PGYPIN(PGID)
      YTOP   = YBOT + (PGYSZ(PGID)-2.0*R)/PGYPIN(PGID)
      CALL PGVSIZ(XLEFT, XRIGHT, YBOT, YTOP)
      END
#<

#>            pgvw.dc3
Name:         pgvw

Purpose:      Undocumented PGPLOT routine

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see internal documentation.

Updates:      Oct 16, 1998: JPT automatically generated.
#<

#>            pgvw.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C
      SUBROUTINE PGVW
C
C PGPLOT (internal routine): set the GRPCKG scaling transformation
C and window appropriate for the current window and viewport. This
C routine is called whenever the viewport or window is changed.
C
C Arguments: none
C
C (11-Feb-1983)
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
C
C Scale plotter in world coordinates.
C
      PGXSCL(PGID) = PGXLEN(PGID)/ABS(PGXTRC(PGID)-PGXBLC(PGID))
      PGYSCL(PGID) = PGYLEN(PGID)/ABS(PGYTRC(PGID)-PGYBLC(PGID))
      IF (PGXBLC(PGID).GT.PGXTRC(PGID)) THEN
          PGXSCL(PGID) = -PGXSCL(PGID)
      END IF
      IF (PGYBLC(PGID).GT.PGYTRC(PGID)) THEN
          PGYSCL(PGID) = -PGYSCL(PGID)
      END IF
      PGXORG(PGID) = PGXOFF(PGID)-PGXBLC(PGID)*PGXSCL(PGID)
      PGYORG(PGID) = PGYOFF(PGID)-PGYBLC(PGID)*PGYSCL(PGID)
      CALL GRTRN0(PGXORG(PGID),PGYORG(PGID),
     1            PGXSCL(PGID),PGYSCL(PGID))
C
C Window plotter in viewport.
C
      CALL GRAREA(PGID,PGXOFF(PGID),PGYOFF(PGID),
     1            PGXLEN(PGID),PGYLEN(PGID))
      END
#<

#>            pgwedg.dc2
Name:         PGWEDG

Purpose:      annotate an image plot with a wedge

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGWEDG(SIDE, DISP, WIDTH, FG, BG, LABEL)
            CHARACTER *(*) SIDE,LABEL
            REAL DISP, WIDTH, FG, BG
      
       Plot an annotated grey-scale or color wedge parallel to a given axis
       of the the current viewport. This routine is designed to provide a
       brightness/color scale for an image drawn with PGIMAG or PGGRAY.
       The wedge will be drawn with the transfer function set by PGSITF
       and using the color index range set by PGSCIR.
      
       Arguments:
        SIDE   (input)  : The first character must be one of the characters
                          'B', 'L', 'T', or 'R' signifying the Bottom, Left,
                          Top, or Right edge of the viewport.
                          The second character should be 'I' to use PGIMAG
                          to draw the wedge, or 'G' to use PGGRAY.
        DISP   (input)  : the displacement of the wedge from the specified
                          edge of the viewport, measured outwards from the
                          viewport in units of the character height. Use a
                          negative value to write inside the viewport, a
                          positive value to write outside.
        WIDTH  (input)  : The total width of the wedge including annotation,
                          in units of the character height.
        FG     (input)  : The value which is to appear with shade
                          1 ("foreground"). Use the values of FG and BG
                          that were supplied to PGGRAY or PGIMAG.
        BG     (input)  : the value which is to appear with shade
                          0 ("background").
        LABEL  (input)  : Optional units label. If no label is required
                          use ' '.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgwedg.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGWEDG -- annotate an image plot with a wedge
C%void cpgwedg(const char *side, float disp, float width, \
C% float fg, float bg, const char *label);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgwedg( character, real, real, real, real, character )
*

C+
      SUBROUTINE PGWEDG(SIDE, DISP, WIDTH, FG, BG, LABEL)
      CHARACTER *(*) SIDE,LABEL
      REAL DISP, WIDTH, FG, BG
C
C Plot an annotated grey-scale or color wedge parallel to a given axis
C of the the current viewport. This routine is designed to provide a
C brightness/color scale for an image drawn with PGIMAG or PGGRAY.
C The wedge will be drawn with the transfer function set by PGSITF
C and using the color index range set by PGSCIR.
C
C Arguments:
C  SIDE   (input)  : The first character must be one of the characters
C                    'B', 'L', 'T', or 'R' signifying the Bottom, Left,
C                    Top, or Right edge of the viewport.
C                    The second character should be 'I' to use PGIMAG
C                    to draw the wedge, or 'G' to use PGGRAY.
C  DISP   (input)  : the displacement of the wedge from the specified
C                    edge of the viewport, measured outwards from the
C                    viewport in units of the character height. Use a
C                    negative value to write inside the viewport, a
C                    positive value to write outside.
C  WIDTH  (input)  : The total width of the wedge including annotation,
C                    in units of the character height.
C  FG     (input)  : The value which is to appear with shade
C                    1 ("foreground"). Use the values of FG and BG
C                    that were supplied to PGGRAY or PGIMAG.
C  BG     (input)  : the value which is to appear with shade
C                    0 ("background").
C  LABEL  (input)  : Optional units label. If no label is required
C                    use ' '.
C--
C  15-Oct-1992: New routine (MCS)
C   2-Aug-1995: no longer needs common (TJP).
C-----------------------------------------------------------------------
      LOGICAL PGNOTO
C                                        Temporary window coord storage.
      REAL WXA,WXB,WYA,WYB, XA,XB,YA,YB
C                                        Viewport coords of wedge.
      REAL VXA,VXB,VYA,VYB
C                          Original and anotation character heights.
      REAL OLDCH, NEWCH
C                          Size of unit character height (NDC units).
      REAL NDCSIZ
C                          True if wedge plotted horizontally.
      LOGICAL HORIZ
C                          Use PGIMAG (T) or PGGRAY (F).
      LOGICAL IMAGE
C                          Symbolic version of SIDE.
      INTEGER NSIDE,BOT,TOP,LFT,RGT
      PARAMETER (BOT=1,TOP=2,LFT=3,RGT=4)
      INTEGER I
      REAL WEDWID, WDGINC, VWIDTH, VDISP, XCH, YCH, LABWID, FG1, BG1
C                          Set the fraction of WIDTH used for anotation.
      REAL TXTFRC
      PARAMETER (TXTFRC=0.6)
C                          Char separation between numbers and LABEL.
      REAL TXTSEP
      PARAMETER (TXTSEP=2.2)
C                          Array to draw wedge in.
      INTEGER WDGPIX
      PARAMETER (WDGPIX=100)
      REAL WDGARR(WDGPIX)
C                          Define the coordinate-mapping function.
      REAL TR(6)
      SAVE TR
      DATA TR /0.0,1.0,0.0,0.0,0.0,1.0/
C-----------------------------------------------------------------------
      IF(PGNOTO('PGWEDG')) RETURN
C
C Get a numeric version of SIDE.
C
      IF(SIDE(1:1).EQ.'B' .OR. SIDE(1:1).EQ.'b') THEN
        NSIDE = BOT
        HORIZ = .TRUE.
      ELSE IF(SIDE(1:1).EQ.'T' .OR. SIDE(1:1).EQ.'t') THEN
        NSIDE = TOP
        HORIZ = .TRUE.
      ELSE IF(SIDE(1:1).EQ.'L' .OR. SIDE(1:1).EQ.'l') THEN
        NSIDE = LFT
        HORIZ = .FALSE.
      ELSE IF(SIDE(1:1).EQ.'R' .OR. SIDE(1:1).EQ.'r') THEN
        NSIDE = RGT
        HORIZ = .FALSE.
      ELSE
        CALL GRWARN('Invalid "SIDE" argument in PGWEDG.')
        RETURN
      END IF
C
C Determine which routine to use.
C
      IF (LEN(SIDE).LT.2) THEN
         IMAGE = .FALSE.
      ELSE IF(SIDE(2:2).EQ.'I' .OR. SIDE(2:2).EQ.'i') THEN
         IMAGE = .TRUE.
      ELSE IF(SIDE(2:2).EQ.'G' .OR. SIDE(2:2).EQ.'g') THEN
         IMAGE = .FALSE.
      ELSE
         CALL GRWARN('Invalid "SIDE" argument in PGWEDG.')
      END IF
C
      CALL PGBBUF
C
C Store the current world and viewport coords and the character height.
C
      CALL PGQWIN(WXA, WXB, WYA, WYB)
      CALL PGQVP(0, XA, XB, YA, YB)
      CALL PGQCH(OLDCH)
C
C Determine the unit character height in NDC coords.
C
      CALL PGSCH(1.0)
      CALL PGQCS(0, XCH, YCH)
      IF(HORIZ) THEN
        NDCSIZ = YCH
      ELSE
        NDCSIZ = XCH
      END IF
C
C Convert 'WIDTH' and 'DISP' into viewport units.
C
      VWIDTH = WIDTH * NDCSIZ * OLDCH
      VDISP  = DISP * NDCSIZ * OLDCH
C
C Determine the number of character heights required under the wedge.
C
      LABWID = TXTSEP
      IF(LABEL.NE.' ') LABWID = LABWID + 1.0
C
C Determine and set the character height required to fit the wedge
C anotation text within the area allowed for it.
C
      NEWCH = TXTFRC*VWIDTH / (LABWID*NDCSIZ)
      CALL PGSCH(NEWCH)
C
C Determine the width of the wedge part of the plot minus the anotation.
C (NDC units).
C
      WEDWID = VWIDTH * (1.0-TXTFRC)
C
C Use these to determine viewport coordinates for the wedge + annotation.
C
      VXA = XA
      VXB = XB
      VYA = YA
      VYB = YB
      IF(NSIDE.EQ.BOT) THEN
        VYB = YA - VDISP
        VYA = VYB - WEDWID
      ELSE IF(NSIDE.EQ.TOP) THEN
        VYA = YB + VDISP
        VYB = VYA + WEDWID
      ELSE IF(NSIDE.EQ.LFT) THEN
        VXB = XA - VDISP
        VXA = VXB - WEDWID
      ELSE IF(NSIDE.EQ.RGT) THEN
        VXA = XB + VDISP
        VXB = VXA + WEDWID
      END IF
C
C Set the viewport for the wedge.
C
      CALL PGSVP(VXA, VXB, VYA, VYB)
C
C Swap FG/BG if necessary to get axis direction right.
C
      FG1 = MAX(FG,BG)
      BG1 = MIN(FG,BG)
C
C Create a dummy wedge array to be plotted.
C
      WDGINC = (FG1-BG1)/(WDGPIX-1)
      DO 1 I=1,WDGPIX
        WDGARR(I) = BG1 + (I-1) * WDGINC
 1    CONTINUE
C
C Draw the wedge then change the world coordinates for labelling.
C
      IF (HORIZ) THEN
        CALL PGSWIN(1.0, REAL(WDGPIX), 0.9, 1.1)
        IF (IMAGE) THEN
           CALL PGIMAG(WDGARR, WDGPIX,1, 1,WDGPIX, 1,1, FG,BG, TR)
        ELSE
           CALL PGGRAY(WDGARR, WDGPIX,1, 1,WDGPIX, 1,1, FG,BG, TR)
        END IF
        CALL PGSWIN(BG1,FG1,0.0,1.0)
      ELSE
        CALL PGSWIN(0.9, 1.1, 1.0, REAL(WDGPIX))
        IF (IMAGE) THEN
           CALL PGIMAG(WDGARR, 1,WDGPIX, 1,1, 1,WDGPIX, FG,BG, TR)
        ELSE
           CALL PGGRAY(WDGARR, 1,WDGPIX, 1,1, 1,WDGPIX, FG,BG, TR)
        END IF
        CALL PGSWIN(0.0, 1.0, BG1, FG1)
      ENDIF
C
C Draw a labelled frame around the wedge.
C
      IF(NSIDE.EQ.BOT) THEN
        CALL PGBOX('BCNST',0.0,0,'BC',0.0,0)
      ELSE IF(NSIDE.EQ.TOP) THEN
        CALL PGBOX('BCMST',0.0,0,'BC',0.0,0)
      ELSE IF(NSIDE.EQ.LFT) THEN
        CALL PGBOX('BC',0.0,0,'BCNST',0.0,0)
      ELSE IF(NSIDE.EQ.RGT) THEN
        CALL PGBOX('BC',0.0,0,'BCMST',0.0,0)
      ENDIF
C
C Write the units label.
C
      IF(LABEL.NE.' ') THEN
        CALL PGMTXT(SIDE,TXTSEP,1.0,1.0,LABEL)
      END IF
C
C Reset the original viewport and world coordinates.
C
      CALL PGSVP(XA,XB,YA,YB)
      CALL PGSWIN(WXA,WXB,WYA,WYB)
      CALL PGSCH(OLDCH)
      CALL PGEBUF
      RETURN
      END
#<

#>            pgwindow.dc2
Name:         PGWINDOW

Purpose:      non-standard alias for PGSWIN

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGWINDOW (X1, X2, Y1, Y2)
            REAL X1, X2, Y1, Y2
      
       See description of PGSWIN.

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgwindow.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGWINDOW -- non-standard alias for PGSWIN
C+
      SUBROUTINE PGWINDOW (X1, X2, Y1, Y2)
      REAL X1, X2, Y1, Y2
C
C See description of PGSWIN.
C--
      CALL PGSWIN (X1, X2, Y1, Y2)
      END
#<

#>            pgwnad.dc2
Name:         PGWNAD

Purpose:      set window and adjust viewport to same aspect ratio

Category:     GRAPHICS

File:         pgplot.src

Author:       T.J. Pearson

Use:          see description below.

Description:

            SUBROUTINE PGWNAD (X1, X2, Y1, Y2)
            REAL X1, X2, Y1, Y2
      
       Change the window in world coordinate space that is to be mapped on
       to the viewport, and simultaneously adjust the viewport so that the
       world-coordinate scales are equal in x and y. The new viewport is
       the largest one that can fit within the previously set viewport
       while retaining the required aspect ratio.
      
       Arguments:
        X1     (input)  : the x-coordinate of the bottom left corner
                          of the viewport.
        X2     (input)  : the x-coordinate of the top right corner
                          of the viewport (note X2 may be less than X1).
        Y1     (input)  : the y-coordinate of the bottom left corner
                          of the viewport.
        Y2     (input)  : the y-coordinate of the top right corner of the
                          viewport (note Y2 may be less than Y1).

Updates:      Oct 16, 1998: JPT automatically extracted from source.
#<

#>            pgwnad.f
*                                                                  PGPLOT-GIPSY
*
*  Generated from the original source code by Perl script 'togipsy.pl'
*  on Wed Oct 14, 1998 at 19:53:59. The Fortran code is unmodified.

C*PGWNAD -- set window and adjust viewport to same aspect ratio
C%void cpgwnad(float x1, float x2, float y1, float y2);
*                                                                  PGPLOT-GIPSY
* GIPSY Fortran to C interface:
*
*@ subroutine pgwnad( real, real, real, real )
*

C+
      SUBROUTINE PGWNAD (X1, X2, Y1, Y2)
      REAL X1, X2, Y1, Y2
C
C Change the window in world coordinate space that is to be mapped on
C to the viewport, and simultaneously adjust the viewport so that the
C world-coordinate scales are equal in x and y. The new viewport is
C the largest one that can fit within the previously set viewport
C while retaining the required aspect ratio.
C
C Arguments:
C  X1     (input)  : the x-coordinate of the bottom left corner
C                    of the viewport.
C  X2     (input)  : the x-coordinate of the top right corner
C                    of the viewport (note X2 may be less than X1).
C  Y1     (input)  : the y-coordinate of the bottom left corner
C                    of the viewport.
C  Y2     (input)  : the y-coordinate of the top right corner of the
C                    viewport (note Y2 may be less than Y1).
C--
C 25-Sep-1985 - new routine (TJP).
C 31-May-1989 - correct error: XVP and YVP not set (TJP).
C-----------------------------------------------------------------------
      INCLUDE 'pgplot.inc'
      LOGICAL PGNOTO
      REAL SCALE,OXLEN,OYLEN
C
      IF (PGNOTO('PGWNAD')) RETURN
C
C If invalid arguments are specified, issue warning and leave window
C unchanged.
C
      IF (X1.EQ.X2) THEN
         CALL GRWARN('invalid x limits in PGWNAD: X1 = X2.')
      ELSE IF (Y1.EQ.Y2) THEN
         CALL GRWARN('invalid y limits in PGWNAD: Y1 = Y2.')
      ELSE
         SCALE = MIN(PGXLEN(PGID)/ABS(X2-X1)/PGXPIN(PGID), 
     1               PGYLEN(PGID)/ABS(Y2-Y1)/PGYPIN(PGID))
         PGXSCL(PGID) = SCALE*PGXPIN(PGID)
         PGYSCL(PGID) = SCALE*PGYPIN(PGID)
         OXLEN = PGXLEN(PGID)
         OYLEN = PGYLEN(PGID)
         PGXLEN(PGID) = PGXSCL(PGID)*ABS(X2-X1)
         PGYLEN(PGID) = PGYSCL(PGID)*ABS(Y2-Y1)
         PGXVP(PGID)  = PGXVP(PGID) + 0.5*(OXLEN-PGXLEN(PGID))
         PGYVP(PGID)  = PGYVP(PGID) + 0.5*(OYLEN-PGYLEN(PGID))
         PGXOFF(PGID) = PGXVP(PGID) + (PGNXC(PGID)-1)*PGXSZ(PGID)
         PGYOFF(PGID) = PGYVP(PGID) +
     1                   (PGNY(PGID)-PGNYC(PGID))*PGYSZ(PGID)
         CALL PGSWIN(X1, X2, Y1, Y2)
      END IF
      END
#<

#>            togipsy.pl
#!/usr/local/bin/perl

#  Program to convert the 'raw' PGPLOT source files to source files
#  suitable for incorporation in GIPSY.
#
#  Use: togipsy.pl [ dir ]
#       'dir' is an optional directory name into which the resulting
#       files will be put. Default: 'gipsy'.
#       If the directory already exists, the program exits with an error
#       message
#       The input files (*.f) should reside in the current directory.
#
#  The program does the following:
#  1.
#     It extracts the internal documentation and puts it in GIPSY format.
#     Documentation from PGxxx routines will be put into .dc2
#     Documentation from GRxxx and routines without a proper documentation
#     section will be put into .dc3.
#  2.
#     It attempts to convert the C% directives for PGPLOT's C binding
#     to C@ directives for GIPSY's f2cvv interface.
#

$gipmark = '*                                                                  PGPLOT-GIPSY';

%map = ('float',   'real',
        'double',  'double precision',
        'int',     'integer',
        'char',    'character',
        'Logical', 'logical');

$dir = $ARGV[0];
$dir = 'gipsy' if (!$dir);

mkdir($dir, 0777) || die "cannot create directory $dir -- $!\n";

@files = sort <*.f>;

$now = localtime(time);
($dname, $mname, $day, $time, $year) = split ' ', $now;
$upd = "$mname $day, $year: JPT";

foreach $file (@files) {
   ($name, $ext ) = split /\./, $file;
   open(SOURCE, $file) || die "cannot open $file\n";
   open(DEST, ">$dir/$file") || die "cannot create $dir/$file\n";
   print DEST "$gipmark\n*\n";
   print DEST "*  Generated from the original source code by Perl script 'togipsy.pl'\n";
   print DEST "*  on $dname $mname $day, $year at $time. ";
   print DEST "The Fortran code is unmodified.\n\n";
   $found = 0;
   $indoc = 0;
   while (<SOURCE>) {
      $f2c = '';
      while (/^C%/) {
         print DEST;
         s/C%//;
         s/\\//;
         chop;
         $f2c = "$f2c$_";
         $_ = <SOURCE>;
      }
      if ($f2c) {
         print DEST "$gipmark\n* GIPSY Fortran to C interface:\n*\n";
         ($ident,$args) = split /\(/, $f2c;
         $ident =~ s/void /subroutine /;
         $ident =~ s/int /integer function /;
         $ident =~ s/float /real function /;
         $ident =~ s/ cpg/ pg/;
         
         @args = split ' ', $args;
         print DEST "*\@ $ident( ";
         $count = 2;
         $comma ='';
         foreach $arg (@args) {
            $arg = $map{$arg};
            if ($arg) {
               $count++;
               if ($count == 100) {
                  print DEST "\n*\@  ";
                  $count = 0;
               }
               print DEST "$comma$arg";
               $comma = ', ';
            }
         }
         print DEST " )\n*\n\n";
      }
      print DEST;
      if (/^C\*/) {
         $rname = $_;
         $descr = $_;
         $rname =~ s/^C\*//;
         ($rname, $dummy) = split ' ', $rname, 2;
         $uname = $rname;
         $rname = lc $rname;
         $descr = s/^C\*.*- //;
         open(DOC, ">$dir/$rname.dcx");
         print DOC   "Name:         $uname\n";
         print DOC "\nPurpose:      $_";
         print DOC "\nCategory:     GRAPHICS\n";
         print DOC "\nFile:         pgplot.src\n";
         print DOC "\nAuthor:       T.J. Pearson\n";
         print DOC "\nUse:          see description below.\n";
         $found = 1;
         next;
      }
      if (/^C\+/ && $found) {
         print DOC "\nDescription:\n\n";
         $indoc = 1;
         next;
      } 
      if (/^C--/) {
         $indoc = 0;
         if ($found) {
            print DOC "\nUpdates:      $upd automatically extracted from source.\n";
            close(DOC);
            if ($rname =~ /^pg/) {
               rename "$dir/$rname.dcx", "$dir/$rname.dc2";
            } else {
               rename "$dir/$rname.dcx", "$dir/$rname.dc3";
            }
         }
         next;
      }
      if ($indoc) {
         $_ =~ s/^C//;
         print DOC "      $_";
      }
   }
   if (!$found) {
      open(DOC, ">$dir/$name.dcx");
      print DOC   "Name:         $name\n";
      print DOC "\nPurpose:      Undocumented PGPLOT routine\n";
      print DOC "\nCategory:     GRAPHICS\n";
      print DOC "\nFile:         pgplot.src\n";
      print DOC "\nAuthor:       T.J. Pearson\n";
      print DOC "\nUse:          see internal documentation.\n";
      print DOC "\nUpdates:      $upd automatically generated.\n";
      close(DOC);
      if ($name =~ /^pg/ && $found) {
         rename "$dir/$name.dcx", "$dir/$name.dc2";
      } else {
         rename "$dir/$name.dcx", "$dir/$name.dc3";
      }
   }
   close(SOURCE);
}
#<
