/* r3dtops.f -- translated by f2c (version 20061008).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Common Block Declarations */

struct {
    real xcent, ycent, scale, eyepos, sxcent, sycent, tmat[16]	/* was [4][4] 
	    */, tinv[16]	/* was [4][4] */, tinvt[16]	/* was [4][4] 
	    */, srot[16]	/* was [4][4] */, srtinv[16]	/* was [4][4] 
	    */, srtinvt[16]	/* was [4][4] */;
} matrices_;

#define matrices_1 matrices_

struct {
    real trulim[6]	/* was [3][2] */, zlim[2], frontclip, backclip;
    integer isolation;
} niceties_;

#define niceties_1 niceties_

struct {
    real fontscale, gamma, zoom;
    integer nscheme, shadowflag, xbg;
    shortint nax, nay, otmode, quality;
    shortlogical invert, lflag;
} options_;

#define options_1 options_

struct {
    integer lb;
} labels_;

#define labels_1 labels_

struct {
    integer noise;
    logical verbose;
} asscom_;

#define asscom_1 asscom_

/* Table of constant values */

static integer c__9 = 9;
static integer c__1 = 1;
static integer c__4 = 4;
static integer c_n1 = -1;
static real c_b190 = 10.f;

/* ****************************************************************************** */
/*               Support routines for PostScript labels                        * */
/* ****************************************************************************** */
/*     Version 2.7d */

/* EAM Dec 1996	- Initial version (called labels3d, later changed) */
/* EAM May 1999	- Updated to match V 2.4j as stand-alone program */
/* EAM Nov 1999	- V2.5 called from render.f as part of normal processing */
/* EAM Feb 2000	- iso-8859-1 encodings for */
/* 		  TeX-like syntax for greek, superscript, subscript */
/* 		  sub- and super- scripts use 0.8 * current font size */
/* EAM Sep 2000	- tweak RED values in work-around for ImageMagick bug */
/* EAM Jun 2001	- Tru64 f90 compiler barfs on '\\' as meaning a single \ */
/* 		  re-work pathway through ghostscript + ImageMagick 5.3.2 */
/* EAM Apr 2006	- Tweak for gfortran compatibility */
/* ****************************************************************************** */

/* These routines are called from render.f to handle object types 10, 11 and 12. */
/* The PostScript file describes a canvas with the same dimension in pixels as */
/* the image created by render.  The PostScript canvas can be composited on top */
/* of the rendered image to produce a labeled figure. */

/* 	Object types 10 and 11 are used for specifying labels. */
/* 	Label object types are */
/* 	  - type 10: Font_Name size alignment */
/* 	  - type 11: XYZ RGB on first line */
/* 		     label (ascii characters enclosed in quotes) on second line */
/* 	Object type 12 is reserved to go with this, as I have a nagging */
/* 	suspicion more information may turn out to be necessary. */

/* ****************************************************************************** */
/* Subroutine */ int lopen_0_(int n__, char *filename, real *pscale, real *
	bkgnd, char *title, integer *input, integer *intype, logical *matcol, 
	real *rgbmat, integer *keep, ftnlen filename_len, ftnlen title_len)
{
    /* Format strings */
    static char fmt_100[] = "(\002>>> Cannot open \002,a,\002 for writing la"
	    "bels\002)";
    static char fmt_600[] = "(a,1x,a,1x,a)";
    static char fmt_601[] = "(a,i6,a)";
    static char fmt_602[] = "(a,2i6,a)";
    static char fmt_603[] = "(a,f6.3,a)";
    static char fmt_604[] = "(3f6.3,a)";
    static char fmt_605[] = "(\002/\002,a,\002 findfont\002,f6.2,\002 FontSc"
	    "ale setfont\002)";
    static char fmt_606[] = "(\002/CurrentFont /\002,a,\002 def /CurrentSi"
	    "ze \002,f6.2,\002 def \002,a)";
    static char fmt_607[] = "((a))";
    static char fmt_802[] = "(3f6.3,\002 setrgbcolor\002,3(1x,f10.4),\002 XY"
	    "Zrmove\002)";
    static char fmt_801[] = "(3f6.3,\002 setrgbcolor\002,3(1x,f10.4),\002 XY"
	    "Zmove\002)";
    static char fmt_804[] = "(\002(\002,a,\002) \002,a)";
    static char fmt_803[] = "(\002(\002,a,\002) \002,a6,\002  show\002)";

    /* System generated locals */
    integer i__1;
    real r__1;
    char ch__1[1];
    olist o__1;
    cllist cl__1;

    /* Builtin functions */
    integer f_open(olist *), s_wsle(cilist *), do_lio(integer *, integer *, 
	    char *, ftnlen), e_wsle(void), s_wsfe(cilist *), do_fio(integer *,
	     char *, ftnlen), e_wsfe(void);
    double sqrt(doublereal);
    integer s_rsle(cilist *), e_rsle(void), s_rsfe(cilist *), e_rsfe(void), 
	    s_cmp(char *, char *, ftnlen, ftnlen);
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer f_clos(cllist *);

    /* Local variables */
    static char fontname[80];
    static real fontsize;
    static integer i__, j;
    static char backslash[1], fontalign[80], texstring[1];
    static real xa, ya, za, red;
    static integer len;
    static real blu, grn;
    static char labelstring[128];
    static integer ibeg;
    static real pfac;
    extern /* Subroutine */ int exit_(integer *);
    extern /* Character */ VOID ltex_(char *, ftnlen, char *, ftnlen);
    static integer level;
    extern doublereal persp_(real *);
    extern /* Subroutine */ int chkrgb_(real *, real *, real *, char *, 
	    ftnlen);
    static integer ialign;
    extern /* Subroutine */ int transf_(real *, real *, real *, real *);
    static real sssize, psscale;

    /* Fortran I/O blocks */
    static cilist io___3 = { 0, 0, 0, 0, 0 };
    static cilist io___4 = { 0, 0, 0, fmt_100, 0 };
    static cilist io___9 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___10 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___11 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___12 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___13 = { 0, 0, 0, fmt_602, 0 };
    static cilist io___14 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___15 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___16 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___17 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___18 = { 0, 0, 0, fmt_603, 0 };
    static cilist io___19 = { 0, 0, 0, fmt_601, 0 };
    static cilist io___20 = { 0, 0, 0, fmt_601, 0 };
    static cilist io___21 = { 0, 0, 0, fmt_607, 0 };
    static cilist io___22 = { 0, 0, 0, fmt_607, 0 };
    static cilist io___23 = { 0, 0, 0, fmt_604, 0 };
    static cilist io___24 = { 0, 0, 0, fmt_607, 0 };
    static cilist io___25 = { 0, 0, 0, fmt_607, 0 };
    static cilist io___26 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___27 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___28 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___29 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___30 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___31 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___32 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___33 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___34 = { 0, 0, 0, fmt_606, 0 };
    static cilist io___35 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___36 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___37 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___38 = { 0, 0, 1, 0, 0 };
    static cilist io___43 = { 0, 0, 0, fmt_606, 0 };
    static cilist io___44 = { 0, 0, 1, 0, 0 };
    static cilist io___48 = { 0, 0, 1, "(A)", 0 };
    static cilist io___52 = { 0, 0, 0, fmt_802, 0 };
    static cilist io___53 = { 0, 0, 0, fmt_801, 0 };
    static cilist io___54 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___59 = { 0, 0, 0, fmt_804, 0 };
    static cilist io___61 = { 0, 0, 0, fmt_605, 0 };
    static cilist io___62 = { 0, 0, 0, fmt_804, 0 };
    static cilist io___63 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___64 = { 0, 0, 0, fmt_804, 0 };
    static cilist io___65 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___66 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___67 = { 0, 0, 0, fmt_804, 0 };
    static cilist io___68 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___69 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___70 = { 0, 0, 0, fmt_804, 0 };
    static cilist io___71 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___72 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___73 = { 0, 0, 0, fmt_804, 0 };
    static cilist io___74 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___75 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___76 = { 0, 0, 0, fmt_804, 0 };
    static cilist io___77 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___78 = { 0, 0, 0, fmt_603, 0 };
    static cilist io___79 = { 0, 0, 0, fmt_803, 0 };
    static cilist io___80 = { 0, 0, 0, fmt_803, 0 };
    static cilist io___81 = { 0, 0, 0, fmt_803, 0 };
    static cilist io___82 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___83 = { 0, 0, 0, fmt_803, 0 };
    static cilist io___84 = { 0, 0, 0, fmt_803, 0 };
    static cilist io___85 = { 0, 0, 0, fmt_803, 0 };
    static cilist io___86 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___87 = { 0, 0, 0, fmt_803, 0 };
    static cilist io___88 = { 0, 0, 0, fmt_803, 0 };
    static cilist io___89 = { 0, 0, 0, fmt_803, 0 };
    static cilist io___90 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___91 = { 0, 0, 0, fmt_803, 0 };
    static cilist io___92 = { 0, 0, 0, fmt_803, 0 };
    static cilist io___93 = { 0, 0, 0, fmt_803, 0 };
    static cilist io___94 = { 0, 0, 0, 0, 0 };
    static cilist io___95 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___96 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___97 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___98 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___99 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___100 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___101 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___102 = { 0, 0, 0, fmt_600, 0 };
    static cilist io___103 = { 0, 0, 0, fmt_600, 0 };






/*     Input transformation */
/*     Transformation matrix, inverse, and transposed inverse */
/*     Shortest rotation from light source to +z axis */
/*     Distance (in +z) of viewing eye */



/*     Command line options */

/*     Stuff for labels */

/*     Copy of NOISE for ASSERT to see */

/*     Initial entry */
/*     Open file for PostScript output */

    /* Parameter adjustments */
    if (bkgnd) {
	--bkgnd;
	}
    if (rgbmat) {
	--rgbmat;
	}

    /* Function Body */
    switch(n__) {
	case 1: goto L_lsetup;
	case 2: goto L_linp;
	case 3: goto L_lclose;
	}

    for (i__ = 80; i__ >= 2; --i__) {
	if (*(unsigned char *)&filename[i__ - 1] == ' ') {
	    len = i__ - 1;
	}
    }
    o__1.oerr = 1;
    o__1.ounit = labels_1.lb;
    o__1.ofnmlen = len;
    o__1.ofnm = filename;
    o__1.orl = 0;
    o__1.osta = "UNKNOWN";
    o__1.oacc = 0;
    o__1.ofm = 0;
    o__1.oblnk = 0;
    i__1 = f_open(&o__1);
    if (i__1 != 0) {
	goto L99;
    }
    io___3.ciunit = asscom_1.noise;
    s_wsle(&io___3);
    do_lio(&c__9, &c__1, "Writing PostScript labels to file ", (ftnlen)34);
    do_lio(&c__9, &c__1, filename, len);
    do_lio(&c__9, &c__1, " with scale", (ftnlen)11);
    do_lio(&c__4, &c__1, (char *)&options_1.fontscale, (ftnlen)sizeof(real));
    e_wsle();
    return 0;
L99:
    io___4.ciunit = asscom_1.noise;
    s_wsfe(&io___4);
    do_fio(&c__1, filename, (ftnlen)80);
    e_wsfe();
    exit_(&c_n1);

/*     Don't write PostScript header until we've read R3D header */


L_lsetup:
    psscale = *pscale;
/*     For some reason ImageMagick messes up image composition if the */
/*     background is pure white or pure black. */
/*     Work-around is to tweak the background. (Abandoned this idea for 2.6) */
/* OLD	if (bkgnd(1).eq.1.0) bkgnd(1) = 0.9900 */
/* OLD	if (bkgnd(1).eq.0.0) bkgnd(1) = 0.0001 */
    red = sqrt(bkgnd[1]);
    grn = sqrt(bkgnd[2]);
    blu = sqrt(bkgnd[3]);


/*     Write out PostScript prolog records */
/* 	To be minimally-conforming, there should also be a */
/* 	%%DocumentFonts: (atend) */
/* 	record and record-keeping of all fonts used. */

/* L6: */
/* L600: */
/* L601: */
/* L602: */
/* L603: */
/* L604: */
/* L605: */
/* L606: */
/* L607: */
    io___9.ciunit = labels_1.lb;
    s_wsfe(&io___9);
    do_fio(&c__1, "%!PS-Adobe-3.0 EPSF-3.0", (ftnlen)23);
    e_wsfe();
    io___10.ciunit = labels_1.lb;
    s_wsfe(&io___10);
    do_fio(&c__1, "%%Creator: Raster3D", (ftnlen)19);
    do_fio(&c__1, "V2.7d   ", (ftnlen)8);
    do_fio(&c__1, "rendering program", (ftnlen)17);
    e_wsfe();
    io___11.ciunit = labels_1.lb;
    s_wsfe(&io___11);
    do_fio(&c__1, "%%Title:", (ftnlen)8);
    do_fio(&c__1, title, (ftnlen)80);
    e_wsfe();
    io___12.ciunit = labels_1.lb;
    s_wsfe(&io___12);
    do_fio(&c__1, "%%Pages: 1", (ftnlen)10);
    e_wsfe();
    io___13.ciunit = labels_1.lb;
    s_wsfe(&io___13);
    do_fio(&c__1, "%%BoundingBox: 0 0", (ftnlen)18);
    do_fio(&c__1, (char *)&options_1.nax, (ftnlen)sizeof(shortint));
    do_fio(&c__1, (char *)&options_1.nay, (ftnlen)sizeof(shortint));
    e_wsfe();
    io___14.ciunit = labels_1.lb;
    s_wsfe(&io___14);
    do_fio(&c__1, "%%DocumentFonts: (atend)", (ftnlen)24);
    e_wsfe();
    io___15.ciunit = labels_1.lb;
    s_wsfe(&io___15);
    do_fio(&c__1, "%%EndComments", (ftnlen)13);
    e_wsfe();
    io___16.ciunit = labels_1.lb;
    s_wsfe(&io___16);
    do_fio(&c__1, "%%BeginProlog", (ftnlen)13);
    e_wsfe();
    io___17.ciunit = labels_1.lb;
    s_wsfe(&io___17);
    do_fio(&c__1, "% These are the only control parameters", (ftnlen)39);
    e_wsfe();
    io___18.ciunit = labels_1.lb;
    s_wsfe(&io___18);
    do_fio(&c__1, "/FontSize ", (ftnlen)10);
    do_fio(&c__1, (char *)&options_1.fontscale, (ftnlen)sizeof(real));
    do_fio(&c__1, " def", (ftnlen)4);
    e_wsfe();
    io___19.ciunit = labels_1.lb;
    s_wsfe(&io___19);
    do_fio(&c__1, "/UnitHeight ", (ftnlen)12);
    i__1 = options_1.nay / 2;
    do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
    do_fio(&c__1, " def", (ftnlen)4);
    e_wsfe();
    io___20.ciunit = labels_1.lb;
    s_wsfe(&io___20);
    do_fio(&c__1, "/UnitWidth  ", (ftnlen)12);
    i__1 = options_1.nax / 2;
    do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
    do_fio(&c__1, " def", (ftnlen)4);
    e_wsfe();
    io___21.ciunit = labels_1.lb;
    s_wsfe(&io___21);
    do_fio(&c__1, "% ", (ftnlen)2);
    do_fio(&c__1, "% This should be dynamic, but how???", (ftnlen)36);
    do_fio(&c__1, "/FontHeight 30 def", (ftnlen)18);
    do_fio(&c__1, "/FontWidth  30 def", (ftnlen)18);
    do_fio(&c__1, "% ", (ftnlen)2);
    do_fio(&c__1, "/FontScale { FontSize mul scalefont } bind def", (ftnlen)
	    46);
    do_fio(&c__1, "/Center {", (ftnlen)9);
    do_fio(&c__1, " dup stringwidth exch -2 div exch -2 div rmoveto", (ftnlen)
	    48);
    do_fio(&c__1, " } bind def", (ftnlen)11);
    do_fio(&c__1, "/Right {", (ftnlen)8);
    do_fio(&c__1, " dup stringwidth exch -1 mul exch -1 mul rmoveto", (ftnlen)
	    48);
    do_fio(&c__1, " } bind def", (ftnlen)11);
    do_fio(&c__1, "/Skip { stringwidth 1.1 mul rmoveto } bind def", (ftnlen)
	    46);
    do_fio(&c__1, "/ShrinkFont {", (ftnlen)13);
    do_fio(&c__1, "  CurrentFont findfont CurrentSize 0.8 mul FontScale setf"
	    "ont", (ftnlen)60);
    do_fio(&c__1, " } bind def", (ftnlen)11);
    do_fio(&c__1, "/RestoreFont {", (ftnlen)14);
    do_fio(&c__1, "  CurrentFont findfont CurrentSize FontScale setfont", (
	    ftnlen)52);
    do_fio(&c__1, " } bind def", (ftnlen)11);
    do_fio(&c__1, "/XYZmove { pop moveto } bind def", (ftnlen)32);
    do_fio(&c__1, "/XYZrmove { pop rmoveto } bind def", (ftnlen)34);
    e_wsfe();
    io___22.ciunit = labels_1.lb;
    s_wsfe(&io___22);
    do_fio(&c__1, "/SetBackground { ", (ftnlen)17);
    e_wsfe();
    io___23.ciunit = labels_1.lb;
    s_wsfe(&io___23);
    do_fio(&c__1, (char *)&red, (ftnlen)sizeof(real));
    do_fio(&c__1, (char *)&grn, (ftnlen)sizeof(real));
    do_fio(&c__1, (char *)&blu, (ftnlen)sizeof(real));
    do_fio(&c__1, " setrgbcolor", (ftnlen)12);
    e_wsfe();
    io___24.ciunit = labels_1.lb;
    s_wsfe(&io___24);
    do_fio(&c__1, " } bind def", (ftnlen)11);
    e_wsfe();

/* This is one way to do it */

/*     WRITE(LB,607) */
/*    &      '%', */
/*    &      '% Add Angstrom sign to commonly used fonts', */
/*    &      '% using iso-8859-1 encoding (Å = 197,  305 octal)', */
/*    &      '%', */
/*    &      '/reencsmalldict 12 dict def', */
/*    &      '/ReEncodeSmall', */
/*    &      '  { reencsmalldict begin', */
/*    &      '    /newcodesandnames exch def ', */
/*    &      '    /newfontname exch def', */
/*    &      '    /basefontname exch def ', */
/*    &      '    /basefontdict basefontname findfont def', */
/*    &      '    /newfont basefontdict maxlength dict def', */
/*    &      '    basefontdict', */
/*    &      '      { exch dup /FID ne', */
/*    &      '	{ dup /Encoding eq', */
/*    &      '	  { exch dup length array copy newfont 3 1 roll put }', */
/*    &      '	  { exch newfont 3 1 roll put }', */
/*    &      '	  ifelse', */
/*    &      '        }', */
/*    &      '        { pop pop }', */
/*    &      '        ifelse', */
/*    &      '      } forall', */
/*    &      '    newfont /FontName newfontname put', */
/*    &      '    newcodesandnames aload pop', */
/*    &      '    newcodesandnames length 2 idiv', */
/*    &      '      { newfont /Encoding get 3 1 roll put }', */
/*    &      '      repeat', */
/*    &      '    newfontname newfont definefont pop', */
/*    &      '    end', */
/*    &      '  } def', */
/*    &      '/symbvec [', */
/*    &      '  8#305 /Aring', */
/*    &      '  ] def', */
/*    &      '/AddSymbs { dup symbvec ReEncodeSmall } def', */
/*    &      '/Times-Roman AddSymbs', */
/*    &      '/Times-Bold AddSymbs', */
/*    &      '/Times-Italic AddSymbs', */
/*    &      '/Times-BoldItalic AddSymbs', */
/*    &      '/Helvetica AddSymbs', */
/*    &      '/Helvetica-Bold AddSymbs', */
/*    &      '/Helvetica-Narrow AddSymbs', */
/*    &      '/Helvetica-Narrow-Bold AddSymbs', */
/*    &      '% End re-encoding' */

/* This is another way to do it */

    io___25.ciunit = labels_1.lb;
    s_wsfe(&io___25);
    do_fio(&c__1, "%", (ftnlen)1);
    do_fio(&c__1, "% Switch common fonts to iso-8859-1 encoding", (ftnlen)44);
    do_fio(&c__1, "%", (ftnlen)1);
    do_fio(&c__1, "/Latin1 {", (ftnlen)9);
    do_fio(&c__1, "  findfont dup length dict begin", (ftnlen)32);
    do_fio(&c__1, "    {1 index /FID ne {def} {pop pop} ifelse} forall", (
	    ftnlen)51);
    do_fio(&c__1, "    /Encoding ISOLatin1Encoding def", (ftnlen)35);
    do_fio(&c__1, "    currentdict", (ftnlen)15);
    do_fio(&c__1, "  end", (ftnlen)5);
    do_fio(&c__1, "} def", (ftnlen)5);
    do_fio(&c__1, "/Times-Roman           dup Latin1 definefont pop", (ftnlen)
	    48);
    do_fio(&c__1, "/Times-Bold            dup Latin1 definefont pop", (ftnlen)
	    48);
    do_fio(&c__1, "/Times-Italic          dup Latin1 definefont pop", (ftnlen)
	    48);
    do_fio(&c__1, "/Times-BoldItalic      dup Latin1 definefont pop", (ftnlen)
	    48);
    do_fio(&c__1, "/Helvetica             dup Latin1 definefont pop", (ftnlen)
	    48);
    do_fio(&c__1, "/Helvetica-Bold        dup Latin1 definefont pop", (ftnlen)
	    48);
    do_fio(&c__1, "/Helvetica-Narrow      dup Latin1 definefont pop", (ftnlen)
	    48);
    do_fio(&c__1, "/Helvetica-Narrow-Bold dup Latin1 definefont pop", (ftnlen)
	    48);
    do_fio(&c__1, "/Helvetica-Oblique     dup Latin1 definefont pop", (ftnlen)
	    48);
    do_fio(&c__1, "/Helvetica-BoldOblique dup Latin1 definefont pop", (ftnlen)
	    48);
    do_fio(&c__1, "% End Re-encoding", (ftnlen)17);
    do_fio(&c__1, "%", (ftnlen)1);
    e_wsfe();


    io___26.ciunit = labels_1.lb;
    s_wsfe(&io___26);
    do_fio(&c__1, "%%EndProlog", (ftnlen)11);
    e_wsfe();
    io___27.ciunit = labels_1.lb;
    s_wsfe(&io___27);
    do_fio(&c__1, "%%BeginSetup", (ftnlen)12);
    e_wsfe();
    io___28.ciunit = labels_1.lb;
    s_wsfe(&io___28);
    do_fio(&c__1, "gsave", (ftnlen)5);
    e_wsfe();
    io___29.ciunit = labels_1.lb;
    s_wsfe(&io___29);
    do_fio(&c__1, "UnitWidth UnitHeight translate", (ftnlen)30);
    e_wsfe();
    io___30.ciunit = labels_1.lb;
    s_wsfe(&io___30);
    do_fio(&c__1, "SetBackground", (ftnlen)13);
    e_wsfe();
    io___31.ciunit = labels_1.lb;
    s_wsfe(&io___31);
    do_fio(&c__1, "UnitWidth -1 mul dup UnitHeight -1 mul newpath moveto", (
	    ftnlen)53);
    e_wsfe();
    io___32.ciunit = labels_1.lb;
    s_wsfe(&io___32);
    do_fio(&c__1, "UnitWidth UnitHeight -1 mul lineto UnitWidth UnitHeight l"
	    "ineto", (ftnlen)62);
    e_wsfe();
    io___33.ciunit = labels_1.lb;
    s_wsfe(&io___33);
    do_fio(&c__1, "UnitHeight lineto closepath fill", (ftnlen)32);
    e_wsfe();
    io___34.ciunit = labels_1.lb;
    s_wsfe(&io___34);
    do_fio(&c__1, "Times-Bold", (ftnlen)10);
    do_fio(&c__1, (char *)&c_b190, (ftnlen)sizeof(real));
    do_fio(&c__1, "RestoreFont", (ftnlen)11);
    e_wsfe();
    io___35.ciunit = labels_1.lb;
    s_wsfe(&io___35);
    do_fio(&c__1, "/LabelStart gstate def", (ftnlen)22);
    e_wsfe();
    io___36.ciunit = labels_1.lb;
    s_wsfe(&io___36);
    do_fio(&c__1, "%%Endsetup", (ftnlen)10);
    e_wsfe();
    io___37.ciunit = labels_1.lb;
    s_wsfe(&io___37);
    do_fio(&c__1, "%%Page: 1 1", (ftnlen)11);
    e_wsfe();
    return 0;

L_linp:

/*     Read in next object */
    if (*intype == 10) {
	io___38.ciunit = *input;
	i__1 = s_rsle(&io___38);
	if (i__1 != 0) {
	    goto L50;
	}
	i__1 = do_lio(&c__9, &c__1, fontname, (ftnlen)80);
	if (i__1 != 0) {
	    goto L50;
	}
	i__1 = do_lio(&c__4, &c__1, (char *)&fontsize, (ftnlen)sizeof(real));
	if (i__1 != 0) {
	    goto L50;
	}
	i__1 = do_lio(&c__9, &c__1, fontalign, (ftnlen)80);
	if (i__1 != 0) {
	    goto L50;
	}
	i__1 = e_rsle();
	if (i__1 != 0) {
	    goto L50;
	}
	if (*(unsigned char *)fontalign == 'C') {
	    ialign = 1;
	} else if (*(unsigned char *)fontalign == 'R') {
	    ialign = 2;
	} else if (*(unsigned char *)fontalign == 'O') {
	    ialign = 3;
	} else {
	    ialign = 0;
	}

/* 	Here is where Perl would shine */

	for (i__ = 1; i__ <= 80; ++i__) {
	    if (*(unsigned char *)&fontname[i__ - 1] != ' ') {
		len = i__;
	    }
	}
	io___43.ciunit = labels_1.lb;
	s_wsfe(&io___43);
	do_fio(&c__1, fontname, len);
	do_fio(&c__1, (char *)&fontsize, (ftnlen)sizeof(real));
	do_fio(&c__1, "RestoreFont", (ftnlen)11);
	e_wsfe();
    } else if (*intype == 11) {
	io___44.ciunit = *input;
	i__1 = s_rsle(&io___44);
	if (i__1 != 0) {
	    goto L50;
	}
	i__1 = do_lio(&c__4, &c__1, (char *)&xa, (ftnlen)sizeof(real));
	if (i__1 != 0) {
	    goto L50;
	}
	i__1 = do_lio(&c__4, &c__1, (char *)&ya, (ftnlen)sizeof(real));
	if (i__1 != 0) {
	    goto L50;
	}
	i__1 = do_lio(&c__4, &c__1, (char *)&za, (ftnlen)sizeof(real));
	if (i__1 != 0) {
	    goto L50;
	}
	i__1 = do_lio(&c__4, &c__1, (char *)&red, (ftnlen)sizeof(real));
	if (i__1 != 0) {
	    goto L50;
	}
	i__1 = do_lio(&c__4, &c__1, (char *)&grn, (ftnlen)sizeof(real));
	if (i__1 != 0) {
	    goto L50;
	}
	i__1 = do_lio(&c__4, &c__1, (char *)&blu, (ftnlen)sizeof(real));
	if (i__1 != 0) {
	    goto L50;
	}
	i__1 = e_rsle();
	if (i__1 != 0) {
	    goto L50;
	}
	if (*matcol) {
	    red = rgbmat[1];
	    grn = rgbmat[2];
	    blu = rgbmat[3];
	}

/* 	Here is where Perl would shine */

	io___48.ciunit = *input;
	i__1 = s_rsfe(&io___48);
	if (i__1 != 0) {
	    goto L50;
	}
	i__1 = do_fio(&c__1, labelstring, (ftnlen)128);
	if (i__1 != 0) {
	    goto L50;
	}
	i__1 = e_rsfe();
	if (i__1 != 0) {
	    goto L50;
	}
	for (j = 128; j >= 1; --j) {
	    len = j;
	    if (*(unsigned char *)&labelstring[len - 1] != ' ') {
		goto L702;
	    }
	}
L702:

/*       Isolated objects not transformed by TMAT, but still subject to inversion. */
/*       Then again, PostScript y-axis convention is upside-down from screen coords. */
	if (niceties_1.isolation > 0) {
	    if (! options_1.invert) {
		ya = -ya;
	    }
	    if (niceties_1.isolation == 2) {
		if (matrices_1.xcent > matrices_1.ycent) {
		    xa = xa * matrices_1.xcent / matrices_1.ycent;
		}
		if (matrices_1.xcent < matrices_1.ycent) {
		    ya = ya * matrices_1.ycent / matrices_1.xcent;
		}
	    }
	} else {
/*         modify the input, as it were */
	    if (ialign != 3) {
		transf_(&xa, &ya, &za, matrices_1.tmat);
		ya = -ya;
	    }
	}
/*       perspective */
	if (matrices_1.eyepos > 0.f) {
	    pfac = persp_(&za);
	} else {
	    pfac = 1.f;
	}

	xa = xa * pfac * psscale;
	ya = ya * pfac * psscale;
	za = za * pfac * psscale;

	if (za * (matrices_1.scale / psscale) < niceties_1.backclip || za * (
		matrices_1.scale / psscale) > niceties_1.frontclip) {
	    return 0;
	}

	chkrgb_(&red, &grn, &blu, "invalid label color", (ftnlen)19);
	red = sqrt(red);
	grn = sqrt(grn);
	blu = sqrt(blu);

	if (ialign == 3) {
	    io___52.ciunit = labels_1.lb;
	    s_wsfe(&io___52);
	    do_fio(&c__1, (char *)&red, (ftnlen)sizeof(real));
	    do_fio(&c__1, (char *)&grn, (ftnlen)sizeof(real));
	    do_fio(&c__1, (char *)&blu, (ftnlen)sizeof(real));
	    do_fio(&c__1, (char *)&xa, (ftnlen)sizeof(real));
	    do_fio(&c__1, (char *)&ya, (ftnlen)sizeof(real));
	    do_fio(&c__1, (char *)&za, (ftnlen)sizeof(real));
	    e_wsfe();
	} else {
	    io___53.ciunit = labels_1.lb;
	    s_wsfe(&io___53);
	    do_fio(&c__1, (char *)&red, (ftnlen)sizeof(real));
	    do_fio(&c__1, (char *)&grn, (ftnlen)sizeof(real));
	    do_fio(&c__1, (char *)&blu, (ftnlen)sizeof(real));
	    do_fio(&c__1, (char *)&xa, (ftnlen)sizeof(real));
	    do_fio(&c__1, (char *)&ya, (ftnlen)sizeof(real));
	    do_fio(&c__1, (char *)&za, (ftnlen)sizeof(real));
	    e_wsfe();
	}

/* 	At this point I should loop over string looking for */
/* 	escape sequences, control characters, etc. */

	io___54.ciunit = labels_1.lb;
	s_wsfe(&io___54);
	do_fio(&c__1, "LabelStart currentgstate pop", (ftnlen)28);
	e_wsfe();
	level = 0;
	ibeg = 1;
L81:
	i__ = ibeg;
	if (i__ > len) {
	    return 0;
	}
L82:

/* 	27-Feb-2000 */
/* 	TeX-like escape sequence processing */
/* 	Unfortunately this is not easily made compatible with anything other */
/* 	that Left-Align. */
/* 	Possibly these problems can be fixed by additional PostScript code? */

	*(unsigned char *)backslash = '\\';
	if (*(unsigned char *)&labelstring[i__ - 1] == *(unsigned char *)
		backslash) {
	    j = i__;
L83:
	    ++j;
	    if (*(unsigned char *)&labelstring[j - 1] >= 'A' && *(unsigned 
		    char *)&labelstring[j - 1] <= 'Z') {
		goto L83;
	    }
	    if (*(unsigned char *)&labelstring[j - 1] >= 'a' && *(unsigned 
		    char *)&labelstring[j - 1] <= 'z') {
		goto L83;
	    }
	    if (j > i__ + 2 && j <= len + 1) {
		i__1 = i__;
		ltex_(ch__1, (ftnlen)1, labelstring + i__1, j - 1 - i__1);
		*(unsigned char *)texstring = *(unsigned char *)&ch__1[0];
		if (*(unsigned char *)texstring == '\0') {
		    goto L90;
		}
		if (ibeg < i__) {
		    io___59.ciunit = labels_1.lb;
		    s_wsfe(&io___59);
		    do_fio(&c__1, labelstring + (ibeg - 1), i__ - 1 - (ibeg - 
			    1));
		    do_fio(&c__1, "show", (ftnlen)4);
		    e_wsfe();
		}
		sssize = fontsize;
		if (level != 0) {
		    sssize *= .8f;
		}
		io___61.ciunit = labels_1.lb;
		s_wsfe(&io___61);
		do_fio(&c__1, "Symbol", (ftnlen)6);
		do_fio(&c__1, (char *)&sssize, (ftnlen)sizeof(real));
		e_wsfe();
		io___62.ciunit = labels_1.lb;
		s_wsfe(&io___62);
		do_fio(&c__1, texstring, (ftnlen)1);
		do_fio(&c__1, "show RestoreFont", (ftnlen)16);
		e_wsfe();
		if (level != 0) {
		    io___63.ciunit = labels_1.lb;
		    s_wsfe(&io___63);
		    do_fio(&c__1, "ShrinkFont", (ftnlen)10);
		    e_wsfe();
		}
		if (*(unsigned char *)&labelstring[j - 1] == ' ') {
		    ++j;
		}
		ibeg = j;
		goto L81;
	    }
	}
	if (*(unsigned char *)&labelstring[i__ - 1] == '_') {
	    if (ibeg < i__) {
		io___64.ciunit = labels_1.lb;
		s_wsfe(&io___64);
		do_fio(&c__1, labelstring + (ibeg - 1), i__ - 1 - (ibeg - 1));
		do_fio(&c__1, "show", (ftnlen)4);
		e_wsfe();
	    }
	    io___65.ciunit = labels_1.lb;
	    s_wsfe(&io___65);
	    do_fio(&c__1, "0 FontHeight -0.3 mul rmoveto", (ftnlen)29);
	    e_wsfe();
	    io___66.ciunit = labels_1.lb;
	    s_wsfe(&io___66);
	    do_fio(&c__1, "ShrinkFont", (ftnlen)10);
	    e_wsfe();
	    ++i__;
	    if (*(unsigned char *)&labelstring[i__ - 1] == '{') {
		level = -1;
		ibeg = i__ + 1;
		goto L81;
	    } else {
		if (*(unsigned char *)&labelstring[i__ - 1] == *(unsigned 
			char *)backslash) {
		    *(unsigned char *)&labelstring[i__ - 1] = '^';
		}
		io___67.ciunit = labels_1.lb;
		s_wsfe(&io___67);
		do_fio(&c__1, labelstring + (i__ - 1), (ftnlen)1);
		do_fio(&c__1, "show", (ftnlen)4);
		e_wsfe();
		io___68.ciunit = labels_1.lb;
		s_wsfe(&io___68);
		do_fio(&c__1, "RestoreFont", (ftnlen)11);
		e_wsfe();
		io___69.ciunit = labels_1.lb;
		s_wsfe(&io___69);
		do_fio(&c__1, "0 FontHeight 0.3 mul rmoveto", (ftnlen)28);
		e_wsfe();
		ibeg = i__ + 1;
		goto L81;
	    }
	}
	if (*(unsigned char *)&labelstring[i__ - 1] == '^') {
	    if (ibeg < i__) {
		io___70.ciunit = labels_1.lb;
		s_wsfe(&io___70);
		do_fio(&c__1, labelstring + (ibeg - 1), i__ - 1 - (ibeg - 1));
		do_fio(&c__1, "show", (ftnlen)4);
		e_wsfe();
	    }
	    io___71.ciunit = labels_1.lb;
	    s_wsfe(&io___71);
	    do_fio(&c__1, "0 FontHeight 0.3 mul rmoveto", (ftnlen)28);
	    e_wsfe();
	    io___72.ciunit = labels_1.lb;
	    s_wsfe(&io___72);
	    do_fio(&c__1, "ShrinkFont", (ftnlen)10);
	    e_wsfe();
	    ++i__;
	    if (*(unsigned char *)&labelstring[i__ - 1] == '{') {
		level = 1;
		ibeg = i__ + 1;
		goto L81;
	    } else {
		if (*(unsigned char *)&labelstring[i__ - 1] == *(unsigned 
			char *)backslash) {
		    *(unsigned char *)&labelstring[i__ - 1] = '^';
		}
		io___73.ciunit = labels_1.lb;
		s_wsfe(&io___73);
		do_fio(&c__1, labelstring + (i__ - 1), (ftnlen)1);
		do_fio(&c__1, "show", (ftnlen)4);
		e_wsfe();
		io___74.ciunit = labels_1.lb;
		s_wsfe(&io___74);
		do_fio(&c__1, "RestoreFont", (ftnlen)11);
		e_wsfe();
		io___75.ciunit = labels_1.lb;
		s_wsfe(&io___75);
		do_fio(&c__1, "0 FontHeight -0.3 mul rmoveto", (ftnlen)29);
		e_wsfe();
		ibeg = i__ + 1;
		goto L81;
	    }
	}
	if (*(unsigned char *)&labelstring[i__ - 1] == '}') {
	    if (ibeg < i__) {
		io___76.ciunit = labels_1.lb;
		s_wsfe(&io___76);
		do_fio(&c__1, labelstring + (ibeg - 1), i__ - 1 - (ibeg - 1));
		do_fio(&c__1, "show", (ftnlen)4);
		e_wsfe();
	    }
	    io___77.ciunit = labels_1.lb;
	    s_wsfe(&io___77);
	    do_fio(&c__1, "RestoreFont", (ftnlen)11);
	    e_wsfe();
	    io___78.ciunit = labels_1.lb;
	    s_wsfe(&io___78);
	    do_fio(&c__1, "0 FontHeight ", (ftnlen)13);
	    r__1 = level * -.3f;
	    do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
	    do_fio(&c__1, "  mul rmoveto", (ftnlen)13);
	    e_wsfe();
	    level = 0;
	    ibeg = i__ + 1;
	    goto L81;
	}

/* 	End of TeX-like escape processing */

L90:
	i__1 = i__;
	if (*(unsigned char *)&labelstring[i__ - 1] == *(unsigned char *)
		backslash && s_cmp(labelstring + i__1, "n", i__ + 1 - i__1, (
		ftnlen)1) == 0) {
	    if (ibeg < i__) {
		if (ialign == 1) {
		    io___79.ciunit = labels_1.lb;
		    s_wsfe(&io___79);
		    do_fio(&c__1, labelstring + (ibeg - 1), i__ - 1 - (ibeg - 
			    1));
		    do_fio(&c__1, "Center", (ftnlen)6);
		    e_wsfe();
		} else if (ialign == 2) {
		    io___80.ciunit = labels_1.lb;
		    s_wsfe(&io___80);
		    do_fio(&c__1, labelstring + (ibeg - 1), i__ - 1 - (ibeg - 
			    1));
		    do_fio(&c__1, "Right", (ftnlen)5);
		    e_wsfe();
		} else {
		    io___81.ciunit = labels_1.lb;
		    s_wsfe(&io___81);
		    do_fio(&c__1, labelstring + (ibeg - 1), i__ - 1 - (ibeg - 
			    1));
		    do_fio(&c__1, " ", (ftnlen)1);
		    e_wsfe();
		}
	    }
	    io___82.ciunit = labels_1.lb;
	    s_wsfe(&io___82);
	    do_fio(&c__1, "LabelStart setgstate", (ftnlen)20);
	    do_fio(&c__1, "0 FontHeight -1 mul rmoveto", (ftnlen)27);
	    do_fio(&c__1, "LabelStart currentgstate pop", (ftnlen)28);
	    e_wsfe();
	    ibeg = i__ + 2;
	    goto L81;
	}
	i__1 = i__;
	if (*(unsigned char *)&labelstring[i__ - 1] == *(unsigned char *)
		backslash && s_cmp(labelstring + i__1, "v", i__ + 1 - i__1, (
		ftnlen)1) == 0) {
	    if (ibeg < i__) {
		if (ialign == 1) {
		    io___83.ciunit = labels_1.lb;
		    s_wsfe(&io___83);
		    do_fio(&c__1, labelstring + (ibeg - 1), i__ - 1 - (ibeg - 
			    1));
		    do_fio(&c__1, "Center", (ftnlen)6);
		    e_wsfe();
		} else if (ialign == 2) {
		    io___84.ciunit = labels_1.lb;
		    s_wsfe(&io___84);
		    do_fio(&c__1, labelstring + (ibeg - 1), i__ - 1 - (ibeg - 
			    1));
		    do_fio(&c__1, "Right", (ftnlen)5);
		    e_wsfe();
		} else {
		    io___85.ciunit = labels_1.lb;
		    s_wsfe(&io___85);
		    do_fio(&c__1, labelstring + (ibeg - 1), i__ - 1 - (ibeg - 
			    1));
		    do_fio(&c__1, " ", (ftnlen)1);
		    e_wsfe();
		}
	    }
	    io___86.ciunit = labels_1.lb;
	    s_wsfe(&io___86);
	    do_fio(&c__1, "0 FontHeight 0.5 mul rmoveto", (ftnlen)28);
	    e_wsfe();
	    ibeg = i__ + 2;
	    goto L81;
	}
	i__1 = i__;
	if (*(unsigned char *)&labelstring[i__ - 1] == *(unsigned char *)
		backslash && s_cmp(labelstring + i__1, "b", i__ + 1 - i__1, (
		ftnlen)1) == 0) {
	    if (ibeg < i__) {
		if (ialign == 1) {
		    io___87.ciunit = labels_1.lb;
		    s_wsfe(&io___87);
		    do_fio(&c__1, labelstring + (ibeg - 1), i__ - 1 - (ibeg - 
			    1));
		    do_fio(&c__1, "Center", (ftnlen)6);
		    e_wsfe();
		} else if (ialign == 2) {
		    io___88.ciunit = labels_1.lb;
		    s_wsfe(&io___88);
		    do_fio(&c__1, labelstring + (ibeg - 1), i__ - 1 - (ibeg - 
			    1));
		    do_fio(&c__1, "Right", (ftnlen)5);
		    e_wsfe();
		} else {
		    io___89.ciunit = labels_1.lb;
		    s_wsfe(&io___89);
		    do_fio(&c__1, labelstring + (ibeg - 1), i__ - 1 - (ibeg - 
			    1));
		    do_fio(&c__1, " ", (ftnlen)1);
		    e_wsfe();
		}
	    }
	    io___90.ciunit = labels_1.lb;
	    s_wsfe(&io___90);
	    do_fio(&c__1, "FontWidth -0.5 mul 0 rmoveto", (ftnlen)28);
	    e_wsfe();
	    ibeg = i__ + 2;
	    goto L81;
	}
	i__1 = i__;
	if (*(unsigned char *)&labelstring[i__ - 1] == *(unsigned char *)
		backslash && s_cmp(labelstring + i__1, "A", i__ + 1 - i__1, (
		ftnlen)1) == 0) {
	    i__1 = i__;
	    s_copy(labelstring + i__1, "\305", i__ + 1 - i__1, (ftnlen)1);
	}
	++i__;
	if (i__ <= len) {
	    goto L82;
	}

/* 	End proposed escape interpretation loop */

	if (ialign == 1) {
	    io___91.ciunit = labels_1.lb;
	    s_wsfe(&io___91);
	    do_fio(&c__1, labelstring + (ibeg - 1), len - (ibeg - 1));
	    do_fio(&c__1, "Center", (ftnlen)6);
	    e_wsfe();
	} else if (ialign == 2) {
	    io___92.ciunit = labels_1.lb;
	    s_wsfe(&io___92);
	    do_fio(&c__1, labelstring + (ibeg - 1), len - (ibeg - 1));
	    do_fio(&c__1, "Right", (ftnlen)5);
	    e_wsfe();
	} else {
	    io___93.ciunit = labels_1.lb;
	    s_wsfe(&io___93);
	    do_fio(&c__1, labelstring + (ibeg - 1), len - (ibeg - 1));
	    do_fio(&c__1, " ", (ftnlen)1);
	    e_wsfe();
	}
    }
    return 0;

/* Error handling */

L50:
    io___94.ciunit = asscom_1.noise;
    s_wsle(&io___94);
    do_lio(&c__9, &c__1, ">>> Unrecognized label command", (ftnlen)30);
    e_wsle();
    return 0;

/* All done, finish off PostScript file and report success */


L_lclose:

/*     Make 100% sure that pixel[0,0] is background color so that */
/*     it can be used for auto-definition of matte */
    io___95.ciunit = labels_1.lb;
    s_wsfe(&io___95);
    do_fio(&c__1, "%Force pixel [0,0] to background color", (ftnlen)38);
    e_wsfe();
    io___96.ciunit = labels_1.lb;
    s_wsfe(&io___96);
    do_fio(&c__1, "SetBackground", (ftnlen)13);
    e_wsfe();
    io___97.ciunit = labels_1.lb;
    s_wsfe(&io___97);
    do_fio(&c__1, "newpath UnitWidth -1 mul UnitHeight moveto", (ftnlen)42);
    e_wsfe();
    io___98.ciunit = labels_1.lb;
    s_wsfe(&io___98);
    do_fio(&c__1, "1 0 rlineto 0 -1 rlineto -1 0 rlineto", (ftnlen)37);
    do_fio(&c__1, "closepath fill", (ftnlen)14);
    e_wsfe();

/*     Finish off PostScript output */
    io___99.ciunit = labels_1.lb;
    s_wsfe(&io___99);
    do_fio(&c__1, "%", (ftnlen)1);
    e_wsfe();
    io___100.ciunit = labels_1.lb;
    s_wsfe(&io___100);
    do_fio(&c__1, "showpage", (ftnlen)8);
    e_wsfe();
    io___101.ciunit = labels_1.lb;
    s_wsfe(&io___101);
    do_fio(&c__1, "%%Trailer", (ftnlen)9);
    e_wsfe();
    io___102.ciunit = labels_1.lb;
    s_wsfe(&io___102);
    do_fio(&c__1, "%%DocumentFonts: Times-Bold", (ftnlen)27);
    e_wsfe();
    io___103.ciunit = labels_1.lb;
    s_wsfe(&io___103);
    do_fio(&c__1, "%%EOF", (ftnlen)5);
    e_wsfe();
    if (*keep > 0) {
	cl__1.cerr = 0;
	cl__1.cunit = labels_1.lb;
	cl__1.csta = 0;
	f_clos(&cl__1);
    } else {
	cl__1.cerr = 0;
	cl__1.cunit = labels_1.lb;
	cl__1.csta = "DELETE";
	f_clos(&cl__1);
    }

    return 0;
} /* lopen_ */

/* Subroutine */ int lopen_(char *filename, ftnlen filename_len)
{
    return lopen_0_(0, filename, (real *)0, (real *)0, (char *)0, (integer *)
	    0, (integer *)0, (logical *)0, (real *)0, (integer *)0, 
	    filename_len, (ftnint)0);
    }

/* Subroutine */ int lsetup_(real *pscale, real *bkgnd, char *title, ftnlen 
	title_len)
{
    return lopen_0_(1, (char *)0, pscale, bkgnd, title, (integer *)0, (
	    integer *)0, (logical *)0, (real *)0, (integer *)0, (ftnint)0, 
	    title_len);
    }

/* Subroutine */ int linp_(integer *input, integer *intype, logical *matcol, 
	real *rgbmat)
{
    return lopen_0_(2, (char *)0, (real *)0, (real *)0, (char *)0, input, 
	    intype, matcol, rgbmat, (integer *)0, (ftnint)0, (ftnint)0);
    }

/* Subroutine */ int lclose_(integer *keep)
{
    return lopen_0_(3, (char *)0, (real *)0, (real *)0, (char *)0, (integer *)
	    0, (integer *)0, (logical *)0, (real *)0, keep, (ftnint)0, (
	    ftnint)0);
    }


/*     Map TeX escape sequences to the corresponding character in the */
/*     standard PostScript SYmbol font. */
/*     Most greek letters map to their own first letter, so we don't */
/*     need to explicitly search for them. */
/*     We explicitly map \nu to distinguish it from \n = newline, */
/*     and \beta to distinguish it from \b = backspace. */

/* Character */ VOID ltex_(char *ret_val, ftnlen ret_val_len, char *
	symbolstring, ftnlen symbolstring_len)
{
    /* Builtin functions */
    integer s_cmp(char *, char *, ftnlen, ftnlen);

    *(unsigned char *)ret_val = *(unsigned char *)symbolstring;

    if (*(unsigned char *)ret_val == 'b') {
	*(unsigned char *)ret_val = '\0';
    }
    if (*(unsigned char *)ret_val == 'n') {
	*(unsigned char *)ret_val = '\0';
    }
    if (*(unsigned char *)ret_val == 'v') {
	*(unsigned char *)ret_val = '\0';
    }

    if (s_cmp(symbolstring, "beta", symbolstring_len, (ftnlen)4) == 0) {
	*(unsigned char *)ret_val = 'b';
    } else if (s_cmp(symbolstring, "eta", symbolstring_len, (ftnlen)3) == 0) {
	*(unsigned char *)ret_val = 'h';
    } else if (s_cmp(symbolstring, "nu", symbolstring_len, (ftnlen)2) == 0) {
	*(unsigned char *)ret_val = 'n';
    } else if (s_cmp(symbolstring, "theta", symbolstring_len, (ftnlen)5) == 0)
	     {
	*(unsigned char *)ret_val = 'q';
    } else if (s_cmp(symbolstring, "phi", symbolstring_len, (ftnlen)3) == 0) {
	*(unsigned char *)ret_val = 'j';
    } else if (s_cmp(symbolstring, "psi", symbolstring_len, (ftnlen)3) == 0) {
	*(unsigned char *)ret_val = 'y';
    } else if (s_cmp(symbolstring, "omega", symbolstring_len, (ftnlen)5) == 0)
	     {
	*(unsigned char *)ret_val = 'w';
    } else if (s_cmp(symbolstring, "Eta", symbolstring_len, (ftnlen)3) == 0) {
	*(unsigned char *)ret_val = 'H';
    } else if (s_cmp(symbolstring, "Theta", symbolstring_len, (ftnlen)5) == 0)
	     {
	*(unsigned char *)ret_val = 'Q';
    } else if (s_cmp(symbolstring, "Phi", symbolstring_len, (ftnlen)3) == 0) {
	*(unsigned char *)ret_val = 'F';
    } else if (s_cmp(symbolstring, "Psi", symbolstring_len, (ftnlen)3) == 0) {
	*(unsigned char *)ret_val = 'Y';
    } else if (s_cmp(symbolstring, "Omega", symbolstring_len, (ftnlen)5) == 0)
	     {
	*(unsigned char *)ret_val = 'W';
    } else if (s_cmp(symbolstring, "infty", symbolstring_len, (ftnlen)5) == 0)
	     {
	*(unsigned char *)ret_val = 165;
/*         ltex = '¥' */
    } else if (s_cmp(symbolstring, "nabla", symbolstring_len, (ftnlen)5) == 0)
	     {
	*(unsigned char *)ret_val = 165;
/*         ltex = 'Ñ' */
    } else if (s_cmp(symbolstring, "ellipses", symbolstring_len, (ftnlen)8) ==
	     0) {
	*(unsigned char *)ret_val = 188;
/*         ltex = '¼' */
    } else if (s_cmp(symbolstring, "partial", symbolstring_len, (ftnlen)7) == 
	    0) {
	*(unsigned char *)ret_val = 182;
/*         ltex = '¶' */
    } else if (s_cmp(symbolstring, "degree", symbolstring_len, (ftnlen)6) == 
	    0) {
	*(unsigned char *)ret_val = 176;
/*         ltex = '°' */
    } else if (s_cmp(symbolstring, "func", symbolstring_len, (ftnlen)4) == 0) 
	    {
	*(unsigned char *)ret_val = 166;
/*         ltex = '¦' */
    } else if (s_cmp(symbolstring, "sqrt", symbolstring_len, (ftnlen)4) == 0) 
	    {
	*(unsigned char *)ret_val = 214;
/*         ltex = 'Ö' */
    } else if (s_cmp(symbolstring, "aleph", symbolstring_len, (ftnlen)5) == 0)
	     {
	*(unsigned char *)ret_val = 192;
/*         ltex = 'À' */
    }
    return ;
} /* ltex_ */