#line 1 ""
/*  -- translated by f2c (version 20200916).
   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"

#line 1 ""
/* Common Block Declarations */

struct all_1_ {
    integer noinow, iorig[24], noinst;
    logical insetup, replacing;
    integer instnum[24];
    logical botv[24];
    integer nvi[24], nsyst, nvnow;
};

#define all_1 (*(struct all_1_ *) &all_)

/* Initialized data */

struct {
    integer e_1;
    integer fill_2[24];
    integer e_3;
    integer fill_4[26];
    logical e_5[24];
    integer e_6[24];
    integer fill_7[2];
    } all_ = { 24, {0}, 24, {0}, FALSE_, FALSE_, FALSE_, FALSE_, FALSE_, 
	    FALSE_, FALSE_, FALSE_, FALSE_, FALSE_, FALSE_, FALSE_, FALSE_, 
	    FALSE_, FALSE_, FALSE_, FALSE_, FALSE_, FALSE_, FALSE_, FALSE_, 
	    FALSE_, FALSE_, FALSE_, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
	    1, 1, 1, 1, 1, 1, 1, 1, 1, 1 };


/* Table of constant values */

static integer c__9 = 9;
static integer c__1 = 1;
static integer c__27 = 27;
static integer c__2 = 2;
static integer c__128 = 128;
static integer c_n1 = -1;
static integer c__0 = 0;
static integer c__3 = 3;
static integer c__4 = 4;
static integer c__5 = 5;
static integer c__79 = 79;
static integer c__125 = 125;

/* ccccccccccccccccccccccccc */
/* c */
/* c  scor2prt 2/19/16 for PMX 2.74 */
/* ccccccccccccccccccccccccc */
/* This program, developed by Don Simons (dsimons@roadrunner.com), is */
/* part of the PMX distribution, PMX is a preprocessor for MusiXTeX. In concert */
/* with MusiXTeX and TeX, the purpose of PMX is to allow the user to create */
/* high-quality typeset musical scores by including a sequence of PMX commands */
/* in an ASCII input file. Scor2prt is an auxiliary program that creates PMX */
/* input files for individual parts from the PMX input file for the score. */

/* This program is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
/* the Free Software Foundation, either version 3 of the License, or */
/* (at your option) any later version. */

/* This program is distributed in the hope that it will be useful, */
/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the */
/* GNU General Public License for more details. */

/* You should have received a copy of the GNU General Public License */
/* along with this program.  If not, see <http://www.gnu.org/licenses/>. */

/* 2/19/16 */
/*   Exit gracefully when last input line is comment, with mods in */
/*     subroutine chkcom, adding logical argument goto999 */
/*     which is set to .true. in that case, causing input file to */
/*     be closed after exiting. */
/* 4/9/12 */
/*   Add logical declarations to subroutine dosetup */
/* 8/8/11 */
/*   Copy & mod Ki into parts when after beginning. */
/* 7/18/11 */
/*   Start to fix up for AS..., also Ki was done a little earlier. */
/* 7/5/10 */
/*   Modify Manual to explain extended hex numbering for part-specific comments */
/* 5/16/10 */
/*   Extend part-specific comments for up to 24 parts (subroutine chkcom) */
/*     Allow files 11-34 for parts */
/*     Change file 30 to 40 */
/* 6/1/08 es2p */
/*   noimax = 24 */

/* To do */
/*  Override fracindent, musicsize? */
/*  Deal with midbar R? */
/* 2/29/04 */
/*  Check for special character being in quoted string. */
/* 10/20/02 PMX 2.407 */
/*  Interpret AN[n]"[used-defined-part-file-name]" */
/* 1/21/02 */
/*  Deals with rm in multiple parts. */
/* s2p15 */
/*  Get right non-tex index even if there's "\" inside D"..." */
/* s2p14 */
/*  10/29/00 fix transfer to parts of negative mtrdnp */
/*  4/29/00 screen for "%%" followed by "T" */
/*  Restore change from "Version 2.1a, 21 Dec" */
/* s2p13 */
/*  Allow whole-bar double-whole rests. */
/*  Bypass MIDI commands "I..." achar(10)="I" */
/* s2p12 */
/*  Let %ablabla ... %cblabla represent pmx input for parts 10-12.  But %?blabla */
/*    only taken as such if ? represents a hex digit .le. noinst, otherwise it's */
/*    a simple comment.  This lessens incompatibility. */
/*  In subroutine mbrest, properly open parts 10-12 if needed */
/* s2p11 */
/*  Ignore leading blanks */
/*  Fix undefined linelength in mbrest at very end of comments. */
/* s2p10 */
/*  Fix non-transfer of P..c" " */
/*  Allow "%%" and "%"n anywhere */
/* Version 1.43 */
/*  Fix bug with P in TeX string. */
/*  Ignore shifted whole-bar rests when consolidating whole-bar rests */
/*  Copy type 4 TeX into all parts. */
/*  Deal with XB and XP. */
/*  Permit transfer of blank line into parts */
/*  Change staves/inst in 'M' command. */
/*  Arbitrary staves/inst. */
/*  Recognize m1/2/3/4 syntax. */
/*  Enable comment and one-voice syntax in instrument names */

/* Changes since 1.1 */
/*  Deal with saved macros. */
/*  Revise setup readin, to admit comments. */
/*  Do not copy 'X' into parts */

/* ccccccccccccccccccccccccccccccccccccccccccccccc */
/* Main program */ int MAIN__(void)
{
    /* Initialized data */

    static char achar[1*10] = "P" "m" "V" "R" "A" "h" "w" "K" "M" "I";

    /* System generated locals */
    address a__1[2], a__2[3];
    integer i__1, i__2, i__3[2], i__4[3];
    char ch__1[44], ch__2[31], ch__3[4], ch__4[1], ch__5[2], ch__6[131];
    cilist ci__1;
    icilist ici__1;
    olist o__1;
    cllist cl__1;
    alist al__1;
    inlist ioin__1;

    /* Builtin functions */
    integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), 
	    e_wsle(void), s_rsfe(cilist *), do_fio(integer *, char *, ftnlen),
	     e_rsfe(void);
    /* Subroutine */ int s_stop(char *, ftnlen);
    integer i_indx(char *, char *, ftnlen, ftnlen);
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
	     char **, integer *, integer *, ftnlen);
    integer f_inqu(inlist *), f_open(olist *), s_cmp(char *, char *, ftnlen, 
	    ftnlen), f_back(alist *), s_wsfe(cilist *), e_wsfe(void), s_rsfi(
	    icilist *), e_rsfi(void), f_clos(cllist *);

    /* Local variables */
    extern /* Subroutine */ int oddquotesbefore_(char *, integer *, logical *,
	     ftnlen);
    static logical clefpend;
    static real xmtrnum0;
    static char templine[128];
    extern /* Subroutine */ int allparts_(char *, integer *, ftnlen);
    static integer musicsize, ia, ib, ic, iv;
    static char sq[1];
    static integer nv, idxendname;
    static real fracindent;
    static integer ibb, len, ivq, iend, nchk, idxa, ljob;
    static char line[128];
    static integer isig, locp, idxq, ndxm, idxs, inst, idxq2, idxstartname;
    extern integer iargc_(void);
    static integer kvend;
    extern /* Subroutine */ int zapbl_(char *, integer *, ftnlen);
    static integer itemp, iinst, ntinx;
    static logical oneof2, goto999;
    extern doublereal readin_(char *, integer *, integer *, ftnlen);
    extern /* Subroutine */ int chkcom_(char *, logical *, ftnlen), getarg_(
	    integer *, char *, ftnlen);
    static integer npages;
    static char holdln[128];
    static integer iudpfn;
    static logical yesodd;
    static integer ludpfn[24];
    static char udpfnq[128*24];
    static integer iiinst;
    static logical fexist;
    static integer ivlast, mtrdnp;
    extern integer lenstr_(char *, integer *, ftnlen);
    static logical frstln;
    static integer insnow, ndxpmx, mtrnmp;
    static logical isachar;
    static char jobname[27];
    static integer lenhold, lenline;
    static char infileq[27];
    static logical gotname;
    static integer iccount, mtrdenl;
    extern integer ntindex_(char *, char *, ftnlen, ftnlen);
    static integer numargs;
    extern /* Subroutine */ int mbrests_(integer *, char *, integer *, 
	    integer *, char *, ftnlen, ftnlen);
    static logical termrpt;
    static integer mtrnuml;
    static char termsym[2], instrum[128*24];
    static integer kvstart;

    /* Fortran I/O blocks */
    static cilist io___6 = { 0, 6, 0, 0, 0 };
    static cilist io___8 = { 0, 6, 0, 0, 0 };
    static cilist io___9 = { 0, 6, 0, 0, 0 };
    static cilist io___10 = { 0, 5, 0, "(a)", 0 };
    static cilist io___13 = { 0, 6, 0, 0, 0 };
    static cilist io___17 = { 0, 6, 0, 0, 0 };
    static cilist io___20 = { 0, 10, 0, "(a)", 0 };
    static cilist io___23 = { 0, 10, 0, "(a)", 0 };
    static cilist io___24 = { 0, 10, 0, "(a)", 0 };
    static cilist io___39 = { 0, 6, 0, 0, 0 };
    static cilist io___40 = { 0, 6, 0, 0, 0 };
    static cilist io___41 = { 0, 6, 0, 0, 0 };
    static cilist io___42 = { 0, 10, 0, "(a)", 0 };
    static cilist io___43 = { 0, 10, 0, "(a)", 0 };
    static cilist io___45 = { 0, 10, 0, "(a)", 0 };
    static cilist io___47 = { 0, 10, 0, "(a)", 0 };
    static cilist io___49 = { 0, 6, 0, 0, 0 };
    static cilist io___50 = { 0, 0, 0, "(a)", 0 };
    static cilist io___51 = { 0, 10, 0, "(a)", 0 };
    static cilist io___52 = { 0, 10, 0, "(a)", 0 };
    static cilist io___56 = { 0, 10, 0, "(a)", 0 };
    static cilist io___58 = { 0, 0, 0, "(a2/a)", 0 };
    static cilist io___60 = { 0, 10, 1, "(a)", 0 };
    static cilist io___62 = { 0, 10, 0, "(a)", 0 };
    static cilist io___63 = { 0, 10, 0, "(a)", 0 };
    static cilist io___69 = { 0, 6, 0, 0, 0 };
    static cilist io___70 = { 0, 6, 0, 0, 0 };
    static cilist io___73 = { 0, 10, 0, "(a)", 0 };
    static cilist io___77 = { 0, 6, 0, 0, 0 };
    static cilist io___78 = { 0, 6, 0, 0, 0 };
    static cilist io___79 = { 0, 6, 0, 0, 0 };
    static cilist io___82 = { 0, 10, 0, "(a)", 0 };
    static cilist io___84 = { 0, 6, 0, 0, 0 };
    static cilist io___85 = { 0, 6, 0, 0, 0 };
    static icilist io___86 = { 0, line+2, 0, "(i1)", 1, 1 };
    static icilist io___89 = { 0, line+2, 0, "(i2)", 2, 1 };
    static cilist io___90 = { 0, 6, 0, 0, 0 };
    static cilist io___91 = { 0, 6, 0, 0, 0 };
    static cilist io___98 = { 0, 0, 0, "(a)", 0 };
    static cilist io___103 = { 0, 0, 0, "(a)", 0 };
    static cilist io___104 = { 0, 0, 0, "(a)", 0 };


#line 104 ""
    clefpend = FALSE_;
#line 105 ""
    all_1.insetup = TRUE_;
#line 106 ""
    all_1.replacing = FALSE_;
#line 107 ""
    frstln = TRUE_;
#line 108 ""
    lenhold = 0;
#line 109 ""
    *(unsigned char *)sq = '\\';
#line 110 ""
    s_wsle(&io___6);
#line 110 ""
    do_lio(&c__9, &c__1, "This is scor2prt for PMX 2.74, 19 February 2016", (
	    ftnlen)47);
#line 110 ""
    e_wsle();
#line 111 ""
    numargs = iargc_();
#line 112 ""
    if (numargs == 0) {
#line 113 ""
	s_wsle(&io___8);
#line 113 ""
	do_lio(&c__9, &c__1, "You could have entered a jobname on the comman"\
		"d line,", (ftnlen)53);
#line 113 ""
	e_wsle();
#line 114 ""
	s_wsle(&io___9);
#line 114 ""
	do_lio(&c__9, &c__1, "      but you may enter one now:", (ftnlen)32);
#line 114 ""
	e_wsle();
#line 115 ""
	s_rsfe(&io___10);
#line 115 ""
	do_fio(&c__1, jobname, (ftnlen)27);
#line 115 ""
	e_rsfe();
#line 116 ""
	numargs = 1;
#line 117 ""
    } else {
/*       call getarg(1,jobname,idum) ! May need to replace this w/ next line */
#line 119 ""
	getarg_(&c__1, jobname, (ftnlen)27);
#line 120 ""
    }
#line 121 ""
    ljob = lenstr_(jobname, &c__27, (ftnlen)27);
#line 122 ""
    if (ljob == 0) {
#line 123 ""
	s_wsle(&io___13);
#line 123 ""
	do_lio(&c__9, &c__1, "No was jobname entered. Restart and try again.",
		 (ftnlen)46);
#line 123 ""
	e_wsle();
#line 124 ""
	s_stop("", (ftnlen)0);
#line 125 ""
    }

/*  Strip ".pmx" if necessary */

/* Computing MAX */
#line 129 ""
    i__1 = i_indx(jobname, ".pmx", (ftnlen)27, (ftnlen)4), i__2 = i_indx(
	    jobname, ".PMX", (ftnlen)27, (ftnlen)4);
#line 129 ""
    ndxpmx = max(i__1,i__2);
#line 130 ""
    if (ndxpmx > 0) {
#line 131 ""
	s_copy(jobname, jobname, (ftnlen)27, ndxpmx - 1);
#line 132 ""
	ljob += -4;
#line 133 ""
    }

/*  Check for existence of input file */

/* Writing concatenation */
#line 137 ""
    i__3[0] = ljob, a__1[0] = jobname;
#line 137 ""
    i__3[1] = 4, a__1[1] = ".pmx";
#line 137 ""
    s_cat(infileq, a__1, i__3, &c__2, (ftnlen)27);
#line 138 ""
    ioin__1.inerr = 0;
#line 138 ""
    ioin__1.infilen = 27;
#line 138 ""
    ioin__1.infile = infileq;
#line 138 ""
    ioin__1.inex = &fexist;
#line 138 ""
    ioin__1.inopen = 0;
#line 138 ""
    ioin__1.innum = 0;
#line 138 ""
    ioin__1.innamed = 0;
#line 138 ""
    ioin__1.inname = 0;
#line 138 ""
    ioin__1.inacc = 0;
#line 138 ""
    ioin__1.inseq = 0;
#line 138 ""
    ioin__1.indir = 0;
#line 138 ""
    ioin__1.infmt = 0;
#line 138 ""
    ioin__1.inform = 0;
#line 138 ""
    ioin__1.inunf = 0;
#line 138 ""
    ioin__1.inrecl = 0;
#line 138 ""
    ioin__1.innrec = 0;
#line 138 ""
    ioin__1.inblank = 0;
#line 138 ""
    f_inqu(&ioin__1);
#line 139 ""
    if (! fexist) {
#line 140 ""
	s_wsle(&io___17);
/* Writing concatenation */
#line 140 ""
	i__3[0] = 17, a__1[0] = "Cannot find file ";
#line 140 ""
	i__3[1] = 27, a__1[1] = infileq;
#line 140 ""
	s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)44);
#line 140 ""
	do_lio(&c__9, &c__1, ch__1, (ftnlen)44);
#line 140 ""
	e_wsle();
#line 141 ""
	s_stop("", (ftnlen)0);
#line 142 ""
    }
#line 143 ""
    o__1.oerr = 0;
#line 143 ""
    o__1.ounit = 10;
#line 143 ""
    o__1.ofnmlen = ljob + 4;
/* Writing concatenation */
#line 143 ""
    i__3[0] = ljob, a__1[0] = jobname;
#line 143 ""
    i__3[1] = 4, a__1[1] = ".pmx";
#line 143 ""
    s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)31);
#line 143 ""
    o__1.ofnm = ch__2;
#line 143 ""
    o__1.orl = 0;
#line 143 ""
    o__1.osta = 0;
#line 143 ""
    o__1.oacc = 0;
#line 143 ""
    o__1.ofm = 0;
#line 143 ""
    o__1.oblnk = 0;
#line 143 ""
    f_open(&o__1);

/* Open all instrument files now for allparts stuff.  Later disgard those >nv */

#line 147 ""
    for (iv = 1; iv <= 24; ++iv) {
#line 148 ""
	all_1.iorig[iv - 1] = iv;
#line 149 ""
	o__1.oerr = 0;
#line 149 ""
	o__1.ounit = iv + 10;
#line 149 ""
	o__1.ofnm = 0;
#line 149 ""
	o__1.orl = 0;
#line 149 ""
	o__1.osta = "SCRATCH";
#line 149 ""
	o__1.oacc = 0;
#line 149 ""
	o__1.ofm = 0;
#line 149 ""
	o__1.oblnk = 0;
#line 149 ""
	f_open(&o__1);
#line 150 ""
	ludpfn[iv - 1] = 0;
#line 151 ""
/* L19: */
#line 151 ""
    }
#line 152 ""
    s_rsfe(&io___20);
#line 152 ""
    do_fio(&c__1, line, (ftnlen)128);
#line 152 ""
    e_rsfe();
#line 153 ""
    chkcom_(line, &goto999, (ftnlen)128);
#line 154 ""
    if (s_cmp(line, "---", (ftnlen)3, (ftnlen)3) == 0) {
#line 155 ""
	allparts_(line, &c__128, (ftnlen)128);
#line 156 ""
L31:
#line 156 ""
	s_rsfe(&io___23);
#line 156 ""
	do_fio(&c__1, line, (ftnlen)128);
#line 156 ""
	e_rsfe();
#line 157 ""
	if (s_cmp(line, "---", (ftnlen)3, (ftnlen)3) != 0) {
#line 158 ""
	    allparts_(line, &c__128, (ftnlen)128);
#line 159 ""
	    goto L31;
#line 160 ""
	}
#line 161 ""
	allparts_(line, &c__128, (ftnlen)128);
#line 162 ""
	s_rsfe(&io___24);
#line 162 ""
	do_fio(&c__1, line, (ftnlen)128);
#line 162 ""
	e_rsfe();
#line 163 ""
	chkcom_(line, &goto999, (ftnlen)128);
#line 164 ""
    }
#line 165 ""
    iccount = 0;
#line 166 ""
    nv = readin_(line, &iccount, &c__1, (ftnlen)128) + .1f;
#line 167 ""
    all_1.noinst = readin_(line, &iccount, &c__2, (ftnlen)128) + .1f;
#line 168 ""
    if (all_1.noinst > 0) {
#line 169 ""
	all_1.nvi[0] = nv - all_1.noinst + 1;
#line 170 ""
    } else {
#line 171 ""
	all_1.noinst = 1 - all_1.noinst;
#line 172 ""
	i__1 = all_1.noinst;
#line 172 ""
	for (iinst = 1; iinst <= i__1; ++iinst) {
#line 173 ""
	    all_1.nvi[iinst - 1] = readin_(line, &iccount, &c_n1, (ftnlen)128)
		     + .1f;
#line 174 ""
/* L21: */
#line 174 ""
	}
#line 175 ""
    }
#line 176 ""
    all_1.noinow = all_1.noinst;
#line 177 ""
    insnow = 1;

/*  ivlast is last iv in current inst.  instnum(iv) is iinst for current voice. */

#line 181 ""
    ivlast = all_1.nvi[0];
#line 182 ""
    i__1 = nv;
#line 182 ""
    for (iv = 1; iv <= i__1; ++iv) {
#line 183 ""
	all_1.instnum[iv - 1] = insnow;
#line 184 ""
	if (iv == ivlast) {
#line 185 ""
	    if (iv < nv) {
#line 185 ""
		all_1.botv[iv] = TRUE_;
#line 185 ""
	    }

/*  The previous stmt will set botv true only for bot voice of iinst>1.  It is */
/*  used when writing termrpts, but the one in voice one is handled differently, */
/*  so botv(1) is left .false. */

#line 191 ""
	    if (insnow < all_1.noinst) {
#line 192 ""
		++insnow;
#line 193 ""
		ivlast += all_1.nvi[insnow - 1];
#line 194 ""
	    }
#line 195 ""
	}
#line 196 ""
/* L22: */
#line 196 ""
    }
#line 197 ""
    mtrnuml = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f;
#line 198 ""
    mtrdenl = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f;
#line 199 ""
    mtrnmp = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f;
#line 200 ""
    mtrdnp = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f;
#line 201 ""
    xmtrnum0 = readin_(line, &iccount, &c__0, (ftnlen)128);
#line 202 ""
    isig = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f;
#line 203 ""
    npages = readin_(line, &iccount, &c__3, (ftnlen)128) + .1f;
#line 204 ""
    all_1.nsyst = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f;
#line 205 ""
    musicsize = readin_(line, &iccount, &c__4, (ftnlen)128) + .1f;
#line 206 ""
    fracindent = readin_(line, &iccount, &c__5, (ftnlen)128);
#line 207 ""
    if (npages == 0) {
#line 208 ""
	s_wsle(&io___39);
#line 208 ""
	do_lio(&c__9, &c__1, "You entered npages=0, which means nsyst is not"\
		" the total number", (ftnlen)63);
#line 208 ""
	e_wsle();
#line 210 ""
	s_wsle(&io___40);
#line 210 ""
	do_lio(&c__9, &c__1, "of systems.  Scor2prt has to know the total nu"\
		"mber of systems.", (ftnlen)62);
#line 210 ""
	e_wsle();
#line 212 ""
	s_wsle(&io___41);
#line 212 ""
	do_lio(&c__9, &c__1, "Please set npages and nsyst to their real valu"\
		"es.", (ftnlen)49);
#line 212 ""
	e_wsle();
#line 214 ""
	s_stop("", (ftnlen)0);
#line 215 ""
    }

/*  Must leave insetup=.true. else could bypass ALL instrument names. */

#line 219 ""
    s_rsfe(&io___42);
#line 219 ""
    do_fio(&c__1, line, (ftnlen)128);
#line 219 ""
    e_rsfe();
#line 220 ""
    chkcom_(line, &goto999, (ftnlen)128);
#line 221 ""
    al__1.aerr = 0;
#line 221 ""
    al__1.aunit = 10;
#line 221 ""
    f_back(&al__1);

/*  Normally this puts pointer at start of line with 1st inst name */
/*  Check if prior line was "%%" */

#line 226 ""
    al__1.aerr = 0;
#line 226 ""
    al__1.aunit = 10;
#line 226 ""
    f_back(&al__1);
#line 227 ""
    s_rsfe(&io___43);
#line 227 ""
    do_fio(&c__1, line, (ftnlen)128);
#line 227 ""
    e_rsfe();
#line 228 ""
    if (s_cmp(line, "%%", (ftnlen)2, (ftnlen)2) == 0) {
#line 228 ""
	al__1.aerr = 0;
#line 228 ""
	al__1.aunit = 10;
#line 228 ""
	f_back(&al__1);
#line 228 ""
    }
#line 229 ""
    i__1 = all_1.noinst;
#line 229 ""
    for (iv = 1; iv <= i__1; ++iv) {
#line 230 ""
	gotname = FALSE_;
#line 231 ""
L16:
#line 231 ""
	s_rsfe(&io___45);
#line 231 ""
	do_fio(&c__1, instrum + (iv - 1 << 7), (ftnlen)128);
#line 231 ""
	e_rsfe();
#line 232 ""
	if (s_cmp(instrum + (iv - 1 << 7), "%%", (ftnlen)2, (ftnlen)2) == 0) {
#line 233 ""
	    s_rsfe(&io___47);
#line 233 ""
	    do_fio(&c__1, line, (ftnlen)128);
#line 233 ""
	    e_rsfe();
#line 234 ""
	    goto L16;
#line 235 ""
	} else if (*(unsigned char *)&instrum[(iv - 1) * 128] == '%') {
#line 236 ""
	    ivq = *(unsigned char *)&instrum[(iv - 1 << 7) + 1] - 48;
#line 237 ""
	    if (ivq != iv) {

/*  It's really a comment.  Copy to parts, then get another trial name. */

#line 241 ""
		allparts_(instrum + (iv - 1 << 7), &c__128, (ftnlen)128);
#line 242 ""
		goto L16;
#line 243 ""
	    } else {
#line 244 ""
		s_copy(line, instrum + ((iv - 1 << 7) + 2), (ftnlen)128, (
			ftnlen)126);
#line 245 ""
		s_copy(instrum + (iv - 1 << 7), line, (ftnlen)128, (ftnlen)
			128);
#line 246 ""
		gotname = TRUE_;
#line 247 ""
	    }
#line 248 ""
	} else {
#line 249 ""
	    gotname = TRUE_;
#line 250 ""
	}
/* c */
/* c  The following checks for macro that write original C-clef as part of */
/* c  instrument name.  See pmx.tex */
/* c */
/*        if (index(instrum(iv),'namewpc') .eq. 0) then */
/*          write(10+iv,'(a)')' ' */
/*        else */
/*          inm1 = index(instrum(iv),'{')+1 */
/*          inm2 = index(instrum(iv),'}')-1 */
/*          read(instrum(iv)(inm2+2:inm2+8),'(i1,4x,2i1)')ilev,iy1,iy2 */
/*          write(10+iv,'(a)')sq//'namewpc{}'//char(ilev+48)//'{20}'// */
/*     *      char(iy1+49)//char(iy2+49) */
/*          instrum(iv) = instrum(iv)(inm1:inm2) */
/*        end if */
#line 265 ""
	if (! gotname) {
#line 266 ""
	    s_wsle(&io___49);
#line 266 ""
	    do_lio(&c__9, &c__1, "You must provide a replacement instrument "\
		    "name", (ftnlen)46);
#line 266 ""
	    e_wsle();
#line 267 ""
	    s_stop("", (ftnlen)0);
#line 268 ""
	}
#line 269 ""
	io___50.ciunit = iv + 10;
#line 269 ""
	s_wsfe(&io___50);
#line 269 ""
	do_fio(&c__1, " ", (ftnlen)1);
#line 269 ""
	e_wsfe();
#line 270 ""
/* L14: */
#line 270 ""
    }
#line 271 ""
    all_1.replacing = FALSE_;
#line 272 ""
    all_1.nvnow = nv;

/*  Clef string:  Note insetup is still T, so "%%" will be treated specially */

#line 276 ""
    s_rsfe(&io___51);
#line 276 ""
    do_fio(&c__1, line, (ftnlen)128);
#line 276 ""
    e_rsfe();
#line 277 ""
    chkcom_(line, &goto999, (ftnlen)128);
#line 278 ""
    if (all_1.replacing) {

/*  If here, we have next line after "%%", containing score's clef string */
/*  Assume all clefs are handled with instrument comments. */

#line 283 ""
	s_rsfe(&io___52);
#line 283 ""
	do_fio(&c__1, line, (ftnlen)128);
#line 283 ""
	e_rsfe();
#line 284 ""
	chkcom_(line, &goto999, (ftnlen)128);
#line 285 ""
	al__1.aerr = 0;
#line 285 ""
	al__1.aunit = 10;
#line 285 ""
	f_back(&al__1);
#line 286 ""
    } else {

/*  If here, line has the clef string in it.  Handle the old way */

#line 290 ""
	kvstart = 1;
#line 291 ""
	kvend = all_1.nvi[0];
#line 292 ""
	i__1 = all_1.noinst;
#line 292 ""
	for (inst = 1; inst <= i__1; ++inst) {
#line 293 ""
	    ci__1.cierr = 0;
#line 293 ""
	    ci__1.ciunit = inst + 10;
/* Writing concatenation */
#line 293 ""
	    i__4[0] = 2, a__2[0] = "(a";
#line 293 ""
	    *(unsigned char *)&ch__4[0] = all_1.nvi[inst - 1] + 48;
#line 293 ""
	    i__4[1] = 1, a__2[1] = ch__4;
#line 293 ""
	    i__4[2] = 1, a__2[2] = ")";
#line 293 ""
	    ci__1.cifmt = (s_cat(ch__3, a__2, i__4, &c__3, (ftnlen)4), ch__3);
#line 293 ""
	    s_wsfe(&ci__1);
#line 293 ""
	    do_fio(&c__1, line + (kvstart - 1), kvend - (kvstart - 1));
#line 293 ""
	    e_wsfe();
#line 295 ""
	    if (inst < all_1.noinst) {
#line 296 ""
		kvstart = kvend + 1;
#line 297 ""
		kvend = kvstart + all_1.nvi[inst] - 1;
#line 298 ""
	    }
#line 299 ""
/* L2: */
#line 299 ""
	}
#line 300 ""
    }
#line 301 ""
    all_1.replacing = FALSE_;
#line 302 ""
    all_1.insetup = FALSE_;

/*  *****NOTE*****This comment applies to stuff done earlier! */
/*  Before starting the big loop, copy initial instnum and staffnum stuff */
/*  into working values.  Latter may change if noinst changes.  Also make */
/*  list of current inst nums relative to original ones.  In addition to those */
/*  below, must redo instnum(iv) and botv(iv) when we change noinst. */

/*  Path string:  ASSUME THIS WILL NEVER BE ALTERED IN PARTS! */

#line 312 ""
L18:
#line 312 ""
    s_rsfe(&io___56);
#line 312 ""
    do_fio(&c__1, line, (ftnlen)128);
#line 312 ""
    e_rsfe();
#line 313 ""
    if (*(unsigned char *)line == '%') {
#line 314 ""
	allparts_(line, &c__128, (ftnlen)128);
#line 315 ""
	goto L18;
#line 316 ""
    }
#line 317 ""
    allparts_(line, &c__128, (ftnlen)128);

/*  Write instrument names.  Will be blank if later part of a score. */

#line 321 ""
    if (*(unsigned char *)&instrum[0] != ' ') {
#line 322 ""
	i__1 = all_1.noinst;
#line 322 ""
	for (iv = 1; iv <= i__1; ++iv) {
#line 323 ""
	    len = lenstr_(instrum + (iv - 1 << 7), &c__79, (ftnlen)128);
#line 324 ""
	    io___58.ciunit = iv + 10;
#line 324 ""
	    s_wsfe(&io___58);
#line 324 ""
	    do_fio(&c__1, "Ti", (ftnlen)2);
#line 324 ""
	    do_fio(&c__1, instrum + (iv - 1 << 7), len);
#line 324 ""
	    e_wsfe();
#line 325 ""
/* L3: */
#line 325 ""
	}
#line 326 ""
    }

/*  The big loop.  Except for '%%', put all comment lines in all parts. */
/*  Unless preceeded by '%%', put all type 2 or 3 TeX Strings in all parts */
/*  If a line starts with %!, put the rest of it in each part. */
/*  If a line starts with %[n], put the rest of it in part [n]. */
/*  Check for Tt, Tc, Voltas, Repeats, headers, lower texts, meter changes. */
/*     Assume they only come at top of block, except terminal repeat needs */
/*     special handling. */
/*  Check for "P"; ignore in parts. */
/*  Check for consecutive full-bar rests; if found, replace with rm[nn] */

#line 338 ""
    iv = 1;
#line 339 ""
    iinst = 1;
#line 340 ""
    termrpt = FALSE_;
#line 341 ""
L4:
#line 342 ""
    i__1 = s_rsfe(&io___60);
#line 342 ""
    if (i__1 != 0) {
#line 342 ""
	goto L999;
#line 342 ""
    }
#line 342 ""
    i__1 = do_fio(&c__1, line, (ftnlen)128);
#line 342 ""
    if (i__1 != 0) {
#line 342 ""
	goto L999;
#line 342 ""
    }
#line 342 ""
    i__1 = e_rsfe();
#line 342 ""
    if (i__1 != 0) {
#line 342 ""
	goto L999;
#line 342 ""
    }
#line 343 ""
    lenline = lenstr_(line, &c__128, (ftnlen)128);
#line 344 ""
    if (lenline == 0) {
#line 344 ""
	goto L4;
#line 344 ""
    }
#line 345 ""
    zapbl_(line, &c__128, (ftnlen)128);
#line 346 ""
    chkcom_(line, &goto999, (ftnlen)128);
#line 347 ""
    if (goto999) {
#line 347 ""
	goto L999;
#line 347 ""
    }
#line 348 ""
    lenline = lenstr_(line, &c__128, (ftnlen)128);
#line 349 ""
    if (lenline == 0) {
#line 349 ""
	goto L4;
#line 349 ""
    }
#line 350 ""
    if (*(unsigned char *)line == 'T') {
#line 351 ""
	allparts_(line, &c__128, (ftnlen)128);
#line 352 ""
	s_rsfe(&io___62);
#line 352 ""
	do_fio(&c__1, line, (ftnlen)128);
#line 352 ""
	e_rsfe();
#line 353 ""
	allparts_(line, &c__128, (ftnlen)128);
#line 354 ""
	goto L4;
#line 355 ""
    } else /* if(complicated condition) */ {
/* Writing concatenation */
#line 355 ""
	i__3[0] = 1, a__1[0] = sq;
#line 355 ""
	i__3[1] = 1, a__1[1] = sq;
#line 355 ""
	s_cat(ch__5, a__1, i__3, &c__2, (ftnlen)2);
#line 355 ""
	if (s_cmp(line, ch__5, (ftnlen)2, (ftnlen)2) == 0) {
#line 356 ""
	    allparts_(line, &c__128, (ftnlen)128);
#line 357 ""
	    goto L4;
#line 358 ""
	} else if (i_indx("hl", line, (ftnlen)2, (ftnlen)1) > 0 && i_indx(
		" +-", line + 1, (ftnlen)3, (ftnlen)1) > 0) {
#line 360 ""
	    allparts_(line, &c__128, (ftnlen)128);
#line 361 ""
	    s_rsfe(&io___63);
#line 361 ""
	    do_fio(&c__1, line, (ftnlen)128);
#line 361 ""
	    e_rsfe();
#line 362 ""
	    allparts_(line, &c__128, (ftnlen)128);
#line 363 ""
	    goto L4;
#line 364 ""
	} else if (iv == 1) {
#line 365 ""
	    for (ia = 1; ia <= 10; ++ia) {
#line 366 ""
L24:
#line 367 ""
		idxa = ntindex_(line, achar + (ia - 1), (ftnlen)128, (ftnlen)
			1);
#line 368 ""
		isachar = idxa > 0;
#line 369 ""
		if (idxa > 1) {
#line 369 ""
		    i__1 = idxa - 2;
#line 369 ""
		    isachar = s_cmp(line + i__1, " ", idxa - 1 - i__1, (
			    ftnlen)1) == 0;
#line 369 ""
		}

/*                   1   2   3   4   5   6   7   8   9   10 */
/*      data achar /'P','m','V','R','A','h','w','K','M','I'/ */

#line 374 ""
		if (ia == 9) {
#line 374 ""
		    i__1 = idxa;
#line 374 ""
		    isachar = isachar && s_cmp(line + i__1, "S", idxa + 1 - 
			    i__1, (ftnlen)1) == 0;
#line 374 ""
		}
#line 376 ""
		if (isachar) {

/*  Check whether character is inside a quoted string by counting */
/*  how many quotes precede it in the line */

#line 382 ""
		    oddquotesbefore_(line, &idxa, &yesodd, (ftnlen)128);
#line 383 ""
		    if (yesodd) {
#line 383 ""
			isachar = FALSE_;
#line 383 ""
		    }
#line 384 ""
		}
#line 385 ""
		if (isachar) {

/*  Find next blank */

#line 389 ""
		    for (ib = idxa + 1; ib <= 128; ++ib) {
#line 390 ""
			if (*(unsigned char *)&line[ib - 1] == ' ') {
#line 390 ""
			    goto L7;
#line 390 ""
			}
#line 391 ""
/* L6: */
#line 391 ""
		    }
#line 392 ""
		    s_wsle(&io___69);
#line 392 ""
		    do_lio(&c__9, &c__1, "Problem with \"V,R,m,P,A,h,MS, o"\
			    "r w\"", (ftnlen)35);
#line 392 ""
		    e_wsle();
#line 393 ""
		    s_wsle(&io___70);
#line 393 ""
		    do_lio(&c__9, &c__1, "Send files to Dr. Don at dsimons a"\
			    "t roadrunner dot com", (ftnlen)54);
#line 393 ""
		    e_wsle();
#line 395 ""
		    s_stop("1", (ftnlen)1);
#line 396 ""
L7:

/*  Next blank is at position ib.  Later, if ia=1, must check for Pc"  " ; */
/*    i.e., look for '"' between P and blank */

#line 401 ""
		    if (ia == 4) {

/*  Check for terminal repeat.  Note if there's a term rpt, there can't be any */
/*  others.  Also, must process repeats LAST, after m's and 'V's */

#line 406 ""
			for (ic = ib + 1; ic <= 128; ++ic) {

/*  If any subsequent character on this line is neither blank nor "/", get out */

#line 410 ""
			    if (i_indx(" /", line + (ic - 1), (ftnlen)2, (
				    ftnlen)1) == 0) {
#line 410 ""
				goto L9;
#line 410 ""
			    }
#line 411 ""
			    if (*(unsigned char *)&line[ic - 1] == '/') {
#line 412 ""
				termrpt = TRUE_;
#line 413 ""
				i__1 = ib - 3;
#line 413 ""
				s_copy(termsym, line + i__1, (ftnlen)2, ib - 
					1 - i__1);

/*  Process the line as if there were no "R" */

#line 417 ""
				goto L10;
#line 418 ""
			    }
#line 419 ""
/* L8: */
#line 419 ""
			}

/* +++ 060812 */
/*  If here, all chars after "R" symbol are blanks, so process the line normally, */
/*    but only IF next line is not the M-Tx line " /" */

#line 425 ""
			s_rsfe(&io___73);
#line 425 ""
			do_fio(&c__1, templine, (ftnlen)128);
#line 425 ""
			e_rsfe();
#line 426 ""
			if (s_cmp(templine, " /", (ftnlen)2, (ftnlen)2) != 0) 
				{
#line 427 ""
			    al__1.aerr = 0;
#line 427 ""
			    al__1.aunit = 10;
#line 427 ""
			    f_back(&al__1);
/* and flow out */
#line 428 ""
			} else {

/*  We have the M-Tx case where one line ends with R? and next is " /". Add / to the line, */
/*    and proceed as above */

/* Writing concatenation */
#line 433 ""
			    i__3[0] = ib, a__1[0] = line;
#line 433 ""
			    i__3[1] = 1, a__1[1] = "/";
#line 433 ""
			    s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
#line 434 ""
			    lenline += 2;
#line 435 ""
			    termrpt = TRUE_;
#line 436 ""
			    i__1 = ib - 3;
#line 436 ""
			    s_copy(termsym, line + i__1, (ftnlen)2, ib - 1 - 
				    i__1);
#line 437 ""
			    goto L10;
#line 438 ""
			}
/* +++ 060812 */

#line 441 ""
		    } else if (ia == 1) {
#line 442 ""
			idxq = ntindex_(line, "\"", (ftnlen)128, (ftnlen)1);
#line 443 ""
			if (idxq > idxa && idxq < ib) {

/*  Quote is between P and next blank.  Find 2nd quote, starting at the blank. */

#line 447 ""
			    idxq2 = ib - 1 + ntindex_(line, "\"", (ftnlen)128,
				     (ftnlen)1);
#line 448 ""
			    i__1 = idxq2;
#line 448 ""
			    if (idxq == 0 || s_cmp(line + i__1, " ", idxq2 + 
				    1 - i__1, (ftnlen)1) != 0) {
#line 449 ""
				s_wsle(&io___77);
#line 449 ""
				e_wsle();
#line 450 ""
				s_wsle(&io___78);
#line 450 ""
				do_lio(&c__9, &c__1, "Error copying P with q"\
					"uotes, idxq2:", (ftnlen)35);
#line 450 ""
				do_lio(&c__3, &c__1, (char *)&idxq2, (ftnlen)
					sizeof(integer));
#line 450 ""
				e_wsle();
#line 451 ""
				s_wsle(&io___79);
#line 451 ""
				do_lio(&c__9, &c__1, line, (ftnlen)60);
#line 451 ""
				e_wsle();
#line 452 ""
				s_stop("1", (ftnlen)1);
#line 453 ""
			    }
#line 454 ""
			    ib = idxq2 + 1;
#line 455 ""
			}

/*  Do not transfer P into parts. */

#line 459 ""
			goto L12;
#line 460 ""
		    } else if (ia == 9) {

/*  Start Saving a macro. After leaving here, a symbol will be sent to all parts, */
/*  If all on this line, set ib to end and exit normally. */

#line 465 ""
			i__1 = ib;
#line 465 ""
			ndxm = i_indx(line + i__1, "M", 128 - i__1, (ftnlen)1)
				;
#line 466 ""
			i__1 = ib + ndxm - 2;
#line 466 ""
			if (ndxm > 0 && s_cmp(line + i__1, " ", ib + ndxm - 1 
				- i__1, (ftnlen)1) == 0) {

/*  Macro ends on this line */

#line 470 ""
			    ib = ib + ndxm + 1;
#line 471 ""
			} else {

/*  Save leading part of current line */

#line 475 ""
			    lenhold = idxa - 1;
#line 476 ""
			    if (lenhold > 0) {
#line 476 ""
				s_copy(holdln, line, (ftnlen)128, lenhold);
#line 476 ""
			    }

/*  Transfer rest of line */

#line 480 ""
			    i__1 = 129 - idxa;
#line 480 ""
			    allparts_(line + (idxa - 1), &i__1, 128 - (idxa - 
				    1));

/*  Read next line */

#line 484 ""
L20:
#line 484 ""
			    s_rsfe(&io___82);
#line 484 ""
			    do_fio(&c__1, line, (ftnlen)128);
#line 484 ""
			    e_rsfe();

/*  Check for comment, transfer and loop if so */

/*                if (line(1:1) .eq.'%') then */
#line 489 ""
L23:
#line 489 ""
			    if (*(unsigned char *)line == '%') {
/*                  call allparts(line,128) */
/*                  go to 20 */
#line 492 ""
				chkcom_(line, &goto999, (ftnlen)128);
#line 493 ""
				goto L23;
#line 494 ""
			    }

/*  Look for terminal ' M' */

#line 498 ""
			    if (*(unsigned char *)line == 'M') {
#line 499 ""
				ndxm = 1;
#line 500 ""
			    } else {
#line 501 ""
				ndxm = i_indx(line, " M", (ftnlen)128, (
					ftnlen)2);
#line 502 ""
				if (ndxm > 0) {
#line 502 ""
				    ++ndxm;
#line 502 ""
				}
#line 503 ""
			    }
#line 504 ""
			    if (ndxm > 0) {

/*  Set parameters, exit normally (but later check for leading part of 1st line */

#line 508 ""
				idxa = 1;
#line 509 ""
				ib = ndxm + 1;
#line 510 ""
			    } else {

/*  No "M", transfer entire line, loop */

#line 514 ""
				allparts_(line, &c__128, (ftnlen)128);
#line 515 ""
				goto L20;
#line 516 ""
			    }
#line 517 ""
			}
#line 518 ""
		    } else if (ia == 10) {

/*  Do not transfer MIDI command into parts */

#line 522 ""
			goto L12;
#line 523 ""
		    } else if (ia == 5) {

/*  First check for "AS", but S may come after other "A" options */

#line 527 ""
			i__1 = idxa;
#line 527 ""
			idxs = i_indx(line + i__1, "S", ib - i__1, (ftnlen)1);
#line 528 ""
			if (idxs > 0) {

/*  Get rid of the string. First check if that's all there is in A. */

#line 532 ""
			    if (ib - idxa == nv + 2) {
#line 532 ""
				goto L12;
#line 532 ""
			    }
#line 533 ""
			    i__1 = idxa + idxs + nv;
/* Writing concatenation */
#line 533 ""
			    i__3[0] = idxa + idxs - 1, a__1[0] = line;
#line 533 ""
			    i__3[1] = ib - i__1, a__1[1] = line + i__1;
#line 533 ""
			    s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
#line 534 ""
			}

/*  Check for user-defined part file name. Must start in column 1 and have */
/*    AN[n]"userfilename". */
/*    idxa is position of "A" */
/*    ib is position of the next blank after "A" */
/*    Don't allow any blanks in user */

#line 542 ""
			i__1 = idxa;
#line 542 ""
			if (s_cmp(line + i__1, "N", idxa + 1 - i__1, (ftnlen)
				1) != 0) {
#line 542 ""
			    goto L9;
#line 542 ""
			}
/* bail out */
#line 543 ""
			if (idxa != 1) {
#line 544 ""
			    s_wsle(&io___84);
#line 544 ""
			    e_wsle();
#line 545 ""
			    s_wsle(&io___85);
#line 545 ""
			    do_lio(&c__9, &c__1, "You entered \"AN...\" some"\
				    "where beyond first column; stopping.", (
				    ftnlen)60);
#line 545 ""
			    e_wsle();
#line 547 ""
			    s_stop("1", (ftnlen)1);
#line 548 ""
			}

/*  pmxa already checked for valid one- or 2-digit number, so get it */

#line 552 ""
			if (*(unsigned char *)&line[3] == '"') {

/*  Single digit instrument number */

#line 556 ""
			    s_rsfi(&io___86);
#line 556 ""
			    do_fio(&c__1, (char *)&iudpfn, (ftnlen)sizeof(
				    integer));
#line 556 ""
			    e_rsfi();
#line 557 ""
			    idxstartname = 5;
#line 558 ""
			} else {
#line 559 ""
			    s_rsfi(&io___89);
#line 559 ""
			    do_fio(&c__1, (char *)&iudpfn, (ftnlen)sizeof(
				    integer));
#line 559 ""
			    e_rsfi();
#line 560 ""
			    idxstartname = 6;
#line 561 ""
			}
#line 562 ""
			ludpfn[iudpfn - 1] = i_indx(line + (idxstartname - 1),
				 "\"", 128 - (idxstartname - 1), (ftnlen)1) - 
				1;
#line 563 ""
			if (ludpfn[iudpfn - 1] < 0) {
#line 564 ""
			    s_wsle(&io___90);
#line 564 ""
			    e_wsle();
#line 565 ""
			    s_wsle(&io___91);
#line 565 ""
			    do_lio(&c__9, &c__1, "User-defined part file nam"\
				    "e must be in quotes", (ftnlen)45);
#line 565 ""
			    e_wsle();
#line 566 ""
			    s_stop("1", (ftnlen)1);
#line 567 ""
			}
#line 568 ""
			idxendname = idxstartname + ludpfn[iudpfn - 1] - 1;
#line 569 ""
			s_copy(udpfnq + (iudpfn - 1 << 7), line + (
				idxstartname - 1), (ftnlen)128, idxendname - (
				idxstartname - 1));

/*  Get a new line! */

#line 573 ""
			goto L4;
#line 574 ""
		    } else if (ia == 8) {

/* Key change/transposition. */
/* If not instrument specific, copy to all parts */

#line 579 ""
			i__1 = idxa;
#line 579 ""
			if (s_cmp(line + i__1, "i", idxa + 1 - i__1, (ftnlen)
				1) != 0) {
#line 579 ""
			    goto L9;
#line 579 ""
			}

/* Instrument-wise key/transposition(s): Ki[nn][+/-][dd}[+/-][dd]... */

#line 583 ""
			ibb = idxa + 2;
/* Starts on digit after 'i' */
#line 584 ""
L40:
#line 585 ""
			ici__1.icierr = 0;
#line 585 ""
			ici__1.iciend = 0;
#line 585 ""
			ici__1.icirnum = 1;
#line 585 ""
			ici__1.icirlen = 1;
#line 585 ""
			ici__1.iciunit = line + (ibb - 1);
#line 585 ""
			ici__1.icifmt = "(i1)";
#line 585 ""
			s_rsfi(&ici__1);
#line 585 ""
			do_fio(&c__1, (char *)&iiinst, (ftnlen)sizeof(integer)
				);
#line 585 ""
			e_rsfi();
/* 1st digit of iinst */
#line 586 ""
			i__1 = ibb;
#line 586 ""
			itemp = i_indx("01234567890", line + i__1, (ftnlen)11,
				 ibb + 1 - i__1);
#line 587 ""
			if (itemp > 0) {
#line 588 ""
			    ++ibb;
#line 589 ""
			    iiinst = iiinst * 10 + itemp - 1;
#line 590 ""
			}
#line 591 ""
			++ibb;
/* now at first +/-. Need end of 2nd number */
#line 592 ""
			i__1 = ibb;
#line 592 ""
			itemp = i_indx(line + i__1, "i", ib - i__1, (ftnlen)1)
				;
/* Rel pos'n of next 'i' */
#line 593 ""
			if (itemp > 0) {
#line 594 ""
			    iend = ibb + itemp - 1;
#line 595 ""
			} else {
#line 596 ""
			    iend = ib - 1;
#line 597 ""
			}
#line 598 ""
			io___98.ciunit = all_1.iorig[iiinst - 1] + 10;
#line 598 ""
			s_wsfe(&io___98);
/* Writing concatenation */
#line 598 ""
			i__3[0] = 3, a__1[0] = "Ki1";
#line 598 ""
			i__3[1] = iend - (ibb - 1), a__1[1] = line + (ibb - 1)
				;
#line 598 ""
			s_cat(ch__6, a__1, i__3, &c__2, (ftnlen)131);
#line 598 ""
			do_fio(&c__1, ch__6, iend - (ibb - 1) + 3);
#line 598 ""
			e_wsfe();
#line 599 ""
			if (itemp > 0) {
#line 600 ""
			    ibb = iend + 2;
#line 601 ""
			    goto L40;
#line 602 ""
			}
#line 603 ""
			goto L12;
/* Remove K command from string, go to next ia */
#line 604 ""
		    }
#line 605 ""
L9:
#line 606 ""
		    i__1 = ib - idxa;
#line 606 ""
		    allparts_(line + (idxa - 1), &i__1, ib - 1 - (idxa - 1));
#line 607 ""
L12:

/*  Remove the string from line */

#line 611 ""
		    if (idxa == 1) {
#line 612 ""
			s_copy(line, line + (ib - 1), (ftnlen)128, 128 - (ib 
				- 1));
#line 613 ""
		    } else {
/* Writing concatenation */
#line 614 ""
			i__3[0] = idxa - 1, a__1[0] = line;
#line 614 ""
			i__3[1] = 128 - (ib - 1), a__1[1] = line + (ib - 1);
#line 614 ""
			s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
#line 615 ""
		    }
#line 616 ""
		    lenline = lenstr_(line, &c__128, (ftnlen)128);

/*  Loop if only blanks are left */

#line 620 ""
		    if (lenline == 0) {
#line 620 ""
			goto L4;
#line 620 ""
		    }

/*  Must check for multiple "I" commands, so go to just after start of ia loop */

#line 624 ""
		    if (ia == 10) {
#line 624 ""
			goto L24;
#line 624 ""
		    }

/*  Tack on front part from 1st line of saved macro */

#line 628 ""
		    if (lenhold > 0) {
/* Writing concatenation */
#line 629 ""
			i__4[0] = lenhold, a__2[0] = holdln;
#line 629 ""
			i__4[1] = 1, a__2[1] = " ";
#line 629 ""
			i__4[2] = lenline, a__2[2] = line;
#line 629 ""
			s_cat(line, a__2, i__4, &c__3, (ftnlen)128);
#line 630 ""
			lenhold = 0;
#line 631 ""
		    }
#line 632 ""
		}
#line 633 ""
/* L5: */
#line 633 ""
	    }
#line 634 ""
	}
#line 634 ""
    }

/*  Now a special loop to deal with 'X'.  If it was %[n]X..., will have been */
/*  copied into part [n] already.  If no "B" or "P", remove.  If "P", just */
/*  remove the "P" so pmxa/b will process.  If "B". do nothing. */

#line 640 ""
L10:
#line 641 ""
    nchk = 1;
#line 642 ""
L13:
#line 642 ""
    ntinx = nchk - 1 + ntindex_(line + (nchk - 1), "X", 128 - (nchk - 1), (
	    ftnlen)1);
#line 643 ""
    if (ntinx > nchk - 1) {

/*  There is a non-TeX 'X' at ntinx.  Loop if neither 1st nor after a blank. */

#line 647 ""
	if (ntinx > 1) {
#line 648 ""
	    i__1 = ntinx - 2;
#line 648 ""
	    if (s_cmp(line + i__1, " ", ntinx - 1 - i__1, (ftnlen)1) != 0) {

/*  The X is not 1st char of PMX command.  Advance starting point, loop. */

#line 652 ""
		nchk = ntinx + 1;
#line 653 ""
		goto L13;
#line 654 ""
	    }
#line 655 ""
	}

/*  We now know the X at ntinx starts a PMX command.  Find next blank */

#line 659 ""
	i__1 = ntinx;
#line 659 ""
	ib = ntinx + i_indx(line + i__1, " ", 128 - i__1, (ftnlen)1);

/*  There must be a blank to right of "X", so ib>ntinx */

/*        locp = nchk-1+index(line(nchk:ib),'P') */
#line 664 ""
	i__1 = ntinx;
#line 664 ""
	locp = ntinx + i_indx(line + i__1, "P", ib - i__1, (ftnlen)1);

/*  Did not need to use ntindex because we already know bounds of PMX command. */

/*        if (locp .gt. nchk-1) then */
#line 669 ""
	if (locp > ntinx) {

/*  Strip out the 'P' */

#line 673 ""
	    s_copy(templine, line, (ftnlen)128, locp - 1);
#line 674 ""
	    i__1 = locp;
/* Writing concatenation */
#line 674 ""
	    i__3[0] = locp - 1, a__1[0] = templine;
#line 674 ""
	    i__3[1] = lenline - i__1, a__1[1] = line + i__1;
#line 674 ""
	    s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
#line 675 ""
	    --lenline;
#line 676 ""
	    --ib;
#line 677 ""
	}
#line 678 ""
	if (i_indx(line + (ntinx - 1), ":", ib - (ntinx - 1), (ftnlen)1) > 0 
		|| i_indx(line + (ntinx - 1), "S", ib - (ntinx - 1), (ftnlen)
		1) > 0 || i_indx(line + (ntinx - 1), "B", ib - (ntinx - 1), (
		ftnlen)1) > 0 || locp > ntinx) {

/*  The X command is a shift, "Both", or "Part".  Do not remove. */

#line 684 ""
	    nchk = ib + 1;
#line 685 ""
	    goto L13;
#line 686 ""
	}

/*  Remove the X command. */

#line 690 ""
	if (ntinx == 1) {
#line 691 ""
	    if (ib < lenline) {
#line 692 ""
		i__1 = ib;
#line 692 ""
		s_copy(line, line + i__1, (ftnlen)128, lenline - i__1);
#line 693 ""
	    } else {

/*  line contains ONLY the "X" command, so get a new line */

#line 697 ""
		goto L4;
#line 698 ""
	    }
#line 699 ""
	} else {
#line 700 ""
	    s_copy(templine, line, (ftnlen)128, ntinx - 1);
#line 701 ""
	    if (ib < lenline) {
#line 702 ""
		i__1 = ib;
/* Writing concatenation */
#line 702 ""
		i__3[0] = ntinx - 1, a__1[0] = templine;
#line 702 ""
		i__3[1] = lenline - i__1, a__1[1] = line + i__1;
#line 702 ""
		s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
#line 703 ""
	    } else {
#line 704 ""
		s_copy(line, templine, (ftnlen)128, ntinx - 1);
#line 705 ""
	    }
#line 706 ""
	}

/*  Recompute lenline */

#line 710 ""
	lenline = lenstr_(line, &c__128, (ftnlen)128);

/*  Resume checking after location of removed command. */

#line 714 ""
	nchk = ntinx;
#line 715 ""
	goto L13;
#line 716 ""
    }

/*  End of loop for X-checks */

#line 720 ""
    oneof2 = ntindex_(line, "//", (ftnlen)128, (ftnlen)2) > 0;
#line 721 ""
    if (termrpt && all_1.botv[iv - 1] && frstln && *(unsigned char *)&line[
	    lenline - 1] == '/') {

/*  Must add a terminal repeat before the slash */

#line 726 ""
	if (oneof2) {
#line 726 ""
	    --lenline;
#line 726 ""
	}
#line 727 ""
	if (lenline > 1) {
#line 727 ""
	    io___103.ciunit = all_1.iorig[iinst - 1] + 10;
#line 727 ""
	    s_wsfe(&io___103);
#line 727 ""
	    do_fio(&c__1, line, lenline - 1);
#line 727 ""
	    e_wsfe();
#line 727 ""
	}
#line 728 ""
	if (! oneof2) {
/* Writing concatenation */
#line 729 ""
	    i__3[0] = 2, a__1[0] = termsym;
#line 729 ""
	    i__3[1] = 2, a__1[1] = " /";
#line 729 ""
	    s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
#line 730 ""
	    lenline = 4;
#line 731 ""
	} else {
/* Writing concatenation */
#line 732 ""
	    i__3[0] = 2, a__1[0] = termsym;
#line 732 ""
	    i__3[1] = 3, a__1[1] = " //";
#line 732 ""
	    s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
#line 733 ""
	    lenline = 5;
#line 734 ""
	}
#line 735 ""
    }
#line 736 ""
    if (termrpt && frstln && *(unsigned char *)&line[lenline - 1] == '/' && 
	    iv == all_1.nvnow) {
#line 736 ""
	termrpt = FALSE_;
#line 736 ""
    }
#line 738 ""
    io___104.ciunit = all_1.iorig[iinst - 1] + 10;
#line 738 ""
    s_wsfe(&io___104);
#line 738 ""
    do_fio(&c__1, line, lenline);
#line 738 ""
    e_wsfe();
#line 739 ""
    if (oneof2) {
#line 740 ""
	frstln = FALSE_;
#line 741 ""
    } else if (! frstln) {
#line 742 ""
	frstln = TRUE_;
#line 743 ""
    }
/*      if (ntindex(line,'/').gt.0 .and. index(line,'//').eq.0) then */
#line 745 ""
    if (ntindex_(line, "/", (ftnlen)128, (ftnlen)1) > 0 && ntindex_(line, 
	    "//", (ftnlen)128, (ftnlen)2) == 0) {
#line 746 ""
	iv = iv % all_1.nvnow + 1;
#line 747 ""
	iinst = all_1.instnum[iv - 1];
#line 748 ""
    }
#line 749 ""
    goto L4;
#line 750 ""
L999:
#line 751 ""
    cl__1.cerr = 0;
#line 751 ""
    cl__1.cunit = 10;
#line 751 ""
    cl__1.csta = 0;
#line 751 ""
    f_clos(&cl__1);

/*  In the mbrest checks, must run through ALL noinst files (not just noinow) */

#line 755 ""
    i__1 = all_1.noinst;
#line 755 ""
    for (iinst = 1; iinst <= i__1; ++iinst) {
/* cc+++ */
/* c */
/* c  Temporarily transfer entire scratch file to real file */
/* c */
/*        rewind(10+iinst) */
/*        open(40,file='s2pout'//char(48+iinst)//'.pmx') */
/*        do 50 m = 1 , 10000 */
/*          read(10+iinst,'(a)',end=51)line */
/*          lenline = lenstr(line,128) */
/*          if (lenline .ge. 1) then */
/*            write(40,'(a)')line(1:lenline) */
/*          else */
/*            write(40,'(a)')' ' */
/*          end if */
/* 50      continue */
/* 51      continue */
/*        close(40) */
/* cc+++ */
#line 774 ""
	if (all_1.nvi[iinst - 1] == 1) {
#line 775 ""
	    mbrests_(&iinst, jobname, &ljob, &ludpfn[iinst - 1], udpfnq + (
		    iinst - 1 << 7), (ftnlen)27, (ftnlen)128);
#line 776 ""
	} else {

/*  Send a signal with ljob to bypass most mbrest processing */

#line 780 ""
	    i__2 = -ljob;
#line 780 ""
	    mbrests_(&iinst, jobname, &i__2, &ludpfn[iinst - 1], udpfnq + (
		    iinst - 1 << 7), (ftnlen)27, (ftnlen)128);
#line 781 ""
	}
#line 782 ""
/* L11: */
#line 782 ""
    }
#line 783 ""
    return 0;
} /* MAIN__ */

integer lenstr_(char *string, integer *n, ftnlen string_len)
{
    /* System generated locals */
    integer ret_val;

#line 786 ""
    for (ret_val = *n; ret_val >= 1; --ret_val) {
#line 787 ""
	if (*(unsigned char *)&string[ret_val - 1] != ' ') {
#line 787 ""
	    return ret_val;
#line 787 ""
	}
#line 788 ""
/* L1: */
#line 788 ""
    }
#line 789 ""
    ret_val = 0;
#line 790 ""
    return ret_val;
} /* lenstr_ */

/* Subroutine */ int allparts_(char *string, integer *n, ftnlen string_len)
{
    /* System generated locals */
    integer i__1;

    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);

    /* Local variables */
    static integer len, iinst;
    extern integer lenstr_(char *, integer *, ftnlen);

    /* Fortran I/O blocks */
    static cilist io___107 = { 0, 0, 0, "(a)", 0 };


#line 798 ""
    len = lenstr_(string, n, string_len);
#line 799 ""
    if (len == 0) {
#line 800 ""
	len = 1;
#line 801 ""
	s_copy(string, " ", string_len, (ftnlen)1);
#line 802 ""
    }
#line 803 ""
    i__1 = all_1.noinow;
#line 803 ""
    for (iinst = 1; iinst <= i__1; ++iinst) {
#line 804 ""
	io___107.ciunit = all_1.iorig[iinst - 1] + 10;
#line 804 ""
	s_wsfe(&io___107);
#line 804 ""
	do_fio(&c__1, string, len);
#line 804 ""
	e_wsfe();
#line 805 ""
/* L1: */
#line 805 ""
    }
#line 806 ""
    return 0;
} /* allparts_ */

/* Subroutine */ int mbrests_(integer *iv, char *jobname, integer *ljob, 
	integer *ludpfn, char *udpfnq, ftnlen jobname_len, ftnlen udpfnq_len)
{
    /* System generated locals */
    address a__1[2], a__2[3];
    integer i__1[2], i__2[3], i__3, i__4;
    real r__1;
    char ch__1[1], ch__2[18], ch__3[132], ch__4[4], ch__5[2], ch__6[10];
    cilist ci__1;
    icilist ici__1;
    olist o__1;
    cllist cl__1;
    alist al__1;

    /* Builtin functions */
    integer f_rew(alist *);
    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
    integer f_open(olist *), s_rsfe(cilist *), do_fio(integer *, char *, 
	    ftnlen), e_rsfe(void), s_cmp(char *, char *, ftnlen, ftnlen), 
	    s_wsfe(cilist *), e_wsfe(void), s_wsle(cilist *), do_lio(integer *
	    , integer *, char *, ftnlen), e_wsle(void);
    /* Subroutine */ int s_stop(char *, ftnlen);
    integer i_indx(char *, char *, ftnlen, ftnlen), s_rsfi(icilist *), e_rsfi(
	    void);
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    double r_lg10(real *);
    integer f_clos(cllist *);

    /* Local variables */
    static integer i__, il, iw;
    static char sq[1];
    static integer ip1, ipc, ipe, len, idx;
    static char sym[80];
    static integer ndig;
    static char line[128*50];
    static integer idxb, nmbr, idxs, lsym;
    static char line1[128];
    static logical type4;
    static integer icden, iline, lpart;
    static char partq[2];
    static integer lwbrs, nwbrs, lenbar, ipenew, mtrden;
    static logical wbrest;
    extern integer lenstr_(char *, integer *, ftnlen);
    static logical newmtr;
    static integer lwbrsx, mtrnum;
    static char wbrsym[3*2];
    static integer lenbeat;
    static logical alldone;
    extern integer ifnodur_(integer *, char *, ftnlen), ntindex_(char *, char 
	    *, ftnlen, ftnlen);
    static integer lenmult;
    extern /* Subroutine */ int dosetup_(integer *, char *, integer *, 
	    integer *, ftnlen);
    static logical rpfirst;
    extern /* Subroutine */ int fwbrsym_(integer *, integer *, char *, 
	    integer *, ftnlen), nextsym_(char *, integer *, integer *, 
	    integer *, char *, integer *, ftnlen, ftnlen);

    /* Fortran I/O blocks */
    static cilist io___114 = { 0, 0, 0, "(a)", 0 };
    static cilist io___117 = { 0, 40, 0, "(a)", 0 };
    static cilist io___118 = { 0, 40, 0, "(a)", 0 };
    static cilist io___119 = { 0, 6, 0, 0, 0 };
    static cilist io___122 = { 0, 0, 1, "(a)", 0 };
    static cilist io___123 = { 0, 40, 0, "(a)", 0 };
    static cilist io___124 = { 0, 0, 0, "(a)", 0 };
    static cilist io___125 = { 0, 40, 0, "(a)", 0 };
    static cilist io___145 = { 0, 0, 1, "(a)", 0 };
    static cilist io___146 = { 0, 40, 0, "(a)", 0 };
    static cilist io___147 = { 0, 40, 0, "(a)", 0 };
    static cilist io___148 = { 0, 6, 0, 0, 0 };
    static cilist io___153 = { 0, 40, 0, "(a)", 0 };
    static cilist io___155 = { 0, 6, 0, 0, 0 };
    static cilist io___157 = { 0, 40, 0, "(a)", 0 };
    static cilist io___159 = { 0, 40, 0, "(a)", 0 };
    static cilist io___160 = { 0, 40, 0, "(a)", 0 };
    static cilist io___161 = { 0, 40, 0, "(a)", 0 };
    static cilist io___162 = { 0, 40, 0, "(a)", 0 };


#line 816 ""
    type4 = FALSE_;
#line 817 ""
    *(unsigned char *)sq = '\\';
#line 818 ""
    alldone = FALSE_;
#line 819 ""
    al__1.aerr = 0;
#line 819 ""
    al__1.aunit = *iv + 10;
#line 819 ""
    f_rew(&al__1);
#line 820 ""
    if (*iv < 10) {
#line 821 ""
	*(unsigned char *)partq = (char) (*iv + 48);
#line 822 ""
	lpart = 1;
#line 823 ""
    } else {
#line 824 ""
	lpart = 2;
#line 825 ""
	if (*iv < 20) {
/* Writing concatenation */
#line 826 ""
	    i__1[0] = 1, a__1[0] = "1";
#line 826 ""
	    *(unsigned char *)&ch__1[0] = *iv + 38;
#line 826 ""
	    i__1[1] = 1, a__1[1] = ch__1;
#line 826 ""
	    s_cat(partq, a__1, i__1, &c__2, (ftnlen)2);
#line 827 ""
	} else {
/* Writing concatenation */
#line 828 ""
	    i__1[0] = 1, a__1[0] = "2";
#line 828 ""
	    *(unsigned char *)&ch__1[0] = *iv + 28;
#line 828 ""
	    i__1[1] = 1, a__1[1] = ch__1;
#line 828 ""
	    s_cat(partq, a__1, i__1, &c__2, (ftnlen)2);
#line 829 ""
	}
#line 830 ""
    }
/* 130327 */
/*      open(40,file=jobname(1:abs(ljob))//partq(1:lpart)//'.pmx') */
#line 833 ""
    if (*ludpfn == 0) {
#line 834 ""
	o__1.oerr = 0;
#line 834 ""
	o__1.ounit = 40;
#line 834 ""
	o__1.ofnmlen = abs(*ljob) + lpart + 4;
/* Writing concatenation */
#line 834 ""
	i__2[0] = abs(*ljob), a__2[0] = jobname;
#line 834 ""
	i__2[1] = lpart, a__2[1] = partq;
#line 834 ""
	i__2[2] = 4, a__2[2] = ".pmx";
#line 834 ""
	s_cat(ch__2, a__2, i__2, &c__3, (ftnlen)18);
#line 834 ""
	o__1.ofnm = ch__2;
#line 834 ""
	o__1.orl = 0;
#line 834 ""
	o__1.osta = 0;
#line 834 ""
	o__1.oacc = 0;
#line 834 ""
	o__1.ofm = 0;
#line 834 ""
	o__1.oblnk = 0;
#line 834 ""
	f_open(&o__1);
#line 835 ""
    } else {
#line 836 ""
	o__1.oerr = 0;
#line 836 ""
	o__1.ounit = 40;
#line 836 ""
	o__1.ofnmlen = *ludpfn + 4;
/* Writing concatenation */
#line 836 ""
	i__1[0] = *ludpfn, a__1[0] = udpfnq;
#line 836 ""
	i__1[1] = 4, a__1[1] = ".pmx";
#line 836 ""
	s_cat(ch__3, a__1, i__1, &c__2, (ftnlen)132);
#line 836 ""
	o__1.ofnm = ch__3;
#line 836 ""
	o__1.orl = 0;
#line 836 ""
	o__1.osta = 0;
#line 836 ""
	o__1.oacc = 0;
#line 836 ""
	o__1.ofm = 0;
#line 836 ""
	o__1.oblnk = 0;
#line 836 ""
	f_open(&o__1);
#line 837 ""
    }
#line 838 ""
    for (i__ = 1; i__ <= 10000; ++i__) {
#line 839 ""
	io___114.ciunit = *iv + 10;
#line 839 ""
	s_rsfe(&io___114);
#line 839 ""
	do_fio(&c__1, line, (ftnlen)128);
#line 839 ""
	e_rsfe();
#line 840 ""
	if (*(unsigned char *)&line[0] == '%' || s_cmp(line, "---", (ftnlen)3,
		 (ftnlen)3) == 0 || type4) {
#line 842 ""
	    len = lenstr_(line, &c__128, (ftnlen)128);
#line 843 ""
	    if (len > 0) {
#line 844 ""
		s_wsfe(&io___117);
#line 844 ""
		do_fio(&c__1, line, len);
#line 844 ""
		e_wsfe();
#line 845 ""
	    } else {
#line 846 ""
		s_wsfe(&io___118);
#line 846 ""
		do_fio(&c__1, " ", (ftnlen)1);
#line 846 ""
		e_wsfe();
#line 847 ""
	    }
#line 848 ""
	    if (s_cmp(line, "---", (ftnlen)3, (ftnlen)3) == 0) {
#line 848 ""
		type4 = ! type4;
#line 848 ""
	    }
#line 849 ""
	} else {
#line 850 ""
	    goto L11;
#line 851 ""
	}
#line 852 ""
/* L10: */
#line 852 ""
    }
#line 853 ""
    s_wsle(&io___119);
#line 853 ""
    do_lio(&c__9, &c__1, "You should not be here in scor2prt.  Call Dr. Don", 
	    (ftnlen)49);
#line 853 ""
    e_wsle();
#line 854 ""
    s_stop("", (ftnlen)0);
#line 855 ""
L11:

/*  Finished reading opening type4 TeX and comments.  Next line to be read */
/*  will contain the first of the input numbers */

#line 860 ""
    dosetup_(iv, line, &mtrnum, &mtrden, (ftnlen)128);
#line 861 ""
    for (i__ = 1; i__ <= 10000; ++i__) {
#line 862 ""
L13:
#line 862 ""
	io___122.ciunit = *iv + 10;
#line 862 ""
	i__3 = s_rsfe(&io___122);
#line 862 ""
	if (i__3 != 0) {
#line 862 ""
	    goto L999;
#line 862 ""
	}
#line 862 ""
	i__3 = do_fio(&c__1, line, (ftnlen)128);
#line 862 ""
	if (i__3 != 0) {
#line 862 ""
	    goto L999;
#line 862 ""
	}
#line 862 ""
	i__3 = e_rsfe();
#line 862 ""
	if (i__3 != 0) {
#line 862 ""
	    goto L999;
#line 862 ""
	}
#line 863 ""
L7:
#line 863 ""
	len = lenstr_(line, &c__128, (ftnlen)128);

/*  Pass-through (and copy into part file) if instrumnet has >1 voice. */

#line 867 ""
	if (*ljob < 0) {
#line 867 ""
	    goto L2;
#line 867 ""
	}
#line 868 ""
	if (i_indx("TtTiTch+h-h l ", line, (ftnlen)14, (ftnlen)2) > 0) {

/*  Traps titles, instruments, composers, headers, lower strings.  Read 2 lines. */

#line 872 ""
	    s_wsfe(&io___123);
#line 872 ""
	    do_fio(&c__1, line, len);
#line 872 ""
	    e_wsfe();
#line 873 ""
	    io___124.ciunit = *iv + 10;
#line 873 ""
	    s_rsfe(&io___124);
#line 873 ""
	    do_fio(&c__1, line, (ftnlen)128);
#line 873 ""
	    e_rsfe();
#line 874 ""
	    len = lenstr_(line, &c__128, (ftnlen)128);
#line 875 ""
	    goto L2;
#line 876 ""
	}
#line 877 ""
	if (i__ == 1 || i__ > 5 && *(unsigned char *)&line[0] == 'm') {

/*  Either just starting, or a new meter is defined. */
/*  NOTE! The above test may be bogus. */

#line 882 ""
	    if (*(unsigned char *)&line[0] == '%') {
#line 883 ""
		s_wsfe(&io___125);
#line 883 ""
		do_fio(&c__1, line, len);
#line 883 ""
		e_wsfe();
#line 884 ""
		goto L13;
#line 885 ""
	    }
#line 886 ""
	    if (i__ != 1) {

/*  New meter. Check for slashes (new meter change syntax) */

#line 890 ""
		idxs = i_indx(line, "/", (ftnlen)128, (ftnlen)1);
#line 891 ""
		idxb = i_indx(line, " ", (ftnlen)128, (ftnlen)1);
#line 892 ""
		newmtr = idxs > 0 && (idxb == 0 || idxs < idxb);
#line 893 ""
		if (! newmtr) {

/*  Old way, no slashes, uses 'o' for lonesome '1' */

#line 897 ""
		    icden = 3;
#line 898 ""
		    if (*(unsigned char *)&line[1] == 'o') {
#line 899 ""
			mtrnum = 1;
#line 900 ""
		    } else {
#line 901 ""
			mtrnum = *(unsigned char *)&line[1] - 48;
#line 902 ""
			if (mtrnum == 1) {
#line 903 ""
			    icden = 4;
#line 904 ""
			    mtrnum = *(unsigned char *)&line[2] - 38;
#line 905 ""
			}
#line 906 ""
		    }
#line 907 ""
		    mtrden = *(unsigned char *)&line[icden - 1] - 48;
#line 908 ""
		} else {

/*  New way with slashes: idxs is index of 1st slash! */

#line 912 ""
		    ici__1.icierr = 0;
#line 912 ""
		    ici__1.iciend = 0;
#line 912 ""
		    ici__1.icirnum = 1;
#line 912 ""
		    ici__1.icirlen = idxs - 2;
#line 912 ""
		    ici__1.iciunit = line + 1;
/* Writing concatenation */
#line 912 ""
		    i__2[0] = 2, a__2[0] = "(i";
#line 912 ""
		    *(unsigned char *)&ch__1[0] = idxs + 46;
#line 912 ""
		    i__2[1] = 1, a__2[1] = ch__1;
#line 912 ""
		    i__2[2] = 1, a__2[2] = ")";
#line 912 ""
		    ici__1.icifmt = (s_cat(ch__4, a__2, i__2, &c__3, (ftnlen)
			    4), ch__4);
#line 912 ""
		    s_rsfi(&ici__1);
#line 912 ""
		    do_fio(&c__1, (char *)&mtrnum, (ftnlen)sizeof(integer));
#line 912 ""
		    e_rsfi();
#line 913 ""
		    i__3 = idxs;
#line 913 ""
		    idxb = i_indx(line + i__3, "/", 128 - i__3, (ftnlen)1);
#line 914 ""
		    i__3 = idxs;
#line 914 ""
		    ici__1.icierr = 0;
#line 914 ""
		    ici__1.iciend = 0;
#line 914 ""
		    ici__1.icirnum = 1;
#line 914 ""
		    ici__1.icirlen = idxs + idxb - 1 - i__3;
#line 914 ""
		    ici__1.iciunit = line + i__3;
/* Writing concatenation */
#line 914 ""
		    i__2[0] = 2, a__2[0] = "(i";
#line 914 ""
		    *(unsigned char *)&ch__1[0] = idxb + 47;
#line 914 ""
		    i__2[1] = 1, a__2[1] = ch__1;
#line 914 ""
		    i__2[2] = 1, a__2[2] = ")";
#line 914 ""
		    ici__1.icifmt = (s_cat(ch__4, a__2, i__2, &c__3, (ftnlen)
			    4), ch__4);
#line 914 ""
		    s_rsfi(&ici__1);
#line 914 ""
		    do_fio(&c__1, (char *)&mtrden, (ftnlen)sizeof(integer));
#line 914 ""
		    e_rsfi();
#line 916 ""
		}
#line 917 ""
	    }
#line 918 ""
	    lenbeat = ifnodur_(&mtrden, "x", (ftnlen)1);
#line 919 ""
	    lenmult = 1;
#line 920 ""
	    if (mtrden == 2) {
#line 921 ""
		lenbeat = 16;
#line 922 ""
		lenmult = 2;
#line 923 ""
	    }
#line 924 ""
	    lenbar = lenmult * mtrnum * lenbeat;
#line 925 ""
	    fwbrsym_(&lenbar, &nwbrs, wbrsym, &lwbrs, (ftnlen)3);
#line 926 ""
	}

/* Finished setting up meter stuff and defining whole-bar rest symbols */

#line 930 ""
	ip1 = 0;
#line 931 ""
	s_copy(line1, line, (ftnlen)128, (ftnlen)128);
#line 932 ""
	i__3 = nwbrs;
#line 932 ""
	for (iw = 0; iw <= i__3; ++iw) {
#line 933 ""
	    if (iw > 0) {
#line 934 ""
		idx = ntindex_(line1, wbrsym + (iw - 1) * 3, (ftnlen)128, 
			lwbrs);
#line 935 ""
		if (idx > 0) {

/*  Check for blank or shifted rest, discount it if it's there */

#line 939 ""
		    i__4 = idx + lwbrs - 1;
#line 939 ""
		    if (s_cmp(line1 + i__4, " ", idx + lwbrs - i__4, (ftnlen)
			    1) != 0) {
#line 939 ""
			idx = 0;
#line 939 ""
		    }
#line 940 ""
		}
#line 941 ""
	    } else {
#line 942 ""
		idx = ntindex_(line1, "rp", (ftnlen)128, (ftnlen)2);

/*  Check for raised rest */

#line 946 ""
		if (idx > 0) {
#line 947 ""
		    i__4 = idx + 1;
#line 947 ""
		    if (s_cmp(line1 + i__4, " ", idx + 2 - i__4, (ftnlen)1) !=
			     0) {
#line 947 ""
			idx = 0;
#line 947 ""
		    }
#line 948 ""
		}
#line 949 ""
	    }
#line 950 ""
	    if (idx > 0) {
#line 951 ""
		if (ip1 == 0) {
#line 952 ""
		    ip1 = idx;
#line 953 ""
		} else {
#line 954 ""
		    ip1 = min(ip1,idx);
/* Maybe allows e.g. r0 rp ... */
#line 955 ""
		}
#line 956 ""
	    }
#line 957 ""
/* L3: */
#line 957 ""
	}
/* Writing concatenation */
#line 958 ""
	i__1[0] = 1, a__1[0] = sq;
#line 958 ""
	i__1[1] = 1, a__1[1] = sq;
#line 958 ""
	s_cat(ch__5, a__1, i__1, &c__2, (ftnlen)2);
#line 958 ""
	if (i__ < 5 || *(unsigned char *)&line[0] == '%' || s_cmp(line, ch__5,
		 (ftnlen)2, (ftnlen)2) == 0 || ip1 == 0) {
#line 958 ""
	    goto L2;
#line 958 ""
	}

/*  Switch to multibar rest search mode!!!  Start forward in line(1) */

#line 963 ""
	rpfirst = s_cmp(line1 + (ip1 - 1), "rp", (ftnlen)2, (ftnlen)2) == 0;
#line 964 ""
	iline = 1;
#line 965 ""
	nmbr = 1;
#line 966 ""
	if (rpfirst) {
#line 967 ""
	    lwbrsx = 2;
#line 968 ""
	} else {
#line 969 ""
	    lwbrsx = lwbrs;
#line 970 ""
	}
#line 971 ""
	ipe = ip1 + lwbrsx - 1;
/* ip at end of 1st wbrsym */
#line 972 ""
L4:
#line 972 ""
	if (ipe == len) {

/*  Need a new line */

#line 976 ""
	    ++iline;
#line 977 ""
L6:
#line 977 ""
	    io___145.ciunit = *iv + 10;
#line 977 ""
	    i__3 = s_rsfe(&io___145);
#line 977 ""
	    if (i__3 != 0) {
#line 977 ""
		goto L998;
#line 977 ""
	    }
#line 977 ""
	    i__3 = do_fio(&c__1, line + (iline - 1 << 7), (ftnlen)128);
#line 977 ""
	    if (i__3 != 0) {
#line 977 ""
		goto L998;
#line 977 ""
	    }
#line 977 ""
	    i__3 = e_rsfe();
#line 977 ""
	    if (i__3 != 0) {
#line 977 ""
		goto L998;
#line 977 ""
	    }
#line 978 ""
	    len = lenstr_(line + (iline - 1 << 7), &c__128, (ftnlen)128);
#line 979 ""
	    if (*(unsigned char *)&line[(iline - 1) * 128] == '%') {
#line 980 ""
		s_wsfe(&io___146);
#line 980 ""
		do_fio(&c__1, "% Following comment has been moved forward", (
			ftnlen)42);
#line 980 ""
		e_wsfe();
#line 981 ""
		s_wsfe(&io___147);
#line 981 ""
		do_fio(&c__1, line + (iline - 1 << 7), len);
#line 981 ""
		e_wsfe();
#line 982 ""
		goto L6;
#line 983 ""
	    }
#line 984 ""
	    ipe = 0;
#line 985 ""
	    goto L4;
#line 986 ""
L998:

/*  No more input left */

#line 990 ""
	    s_wsle(&io___148);
#line 990 ""
	    do_lio(&c__9, &c__1, "All done!", (ftnlen)9);
#line 990 ""
	    e_wsle();
#line 991 ""
	    alldone = TRUE_;
#line 992 ""
	    ipe = 0;
#line 993 ""
	    --iline;
#line 994 ""
	    len = lenstr_(line + (iline - 1 << 7), &c__128, (ftnlen)128);
#line 995 ""
	    goto L4;
#line 996 ""
	} else {
#line 997 ""
	    if (alldone) {
#line 998 ""
		*(unsigned char *)sym = ' ';
#line 999 ""
	    } else {

/*  ipe<len here, so it's ok to get a symbol */

#line 1003 ""
		nextsym_(line + (iline - 1 << 7), &len, &ipe, &ipenew, sym, &
			lsym, (ftnlen)128, (ftnlen)80);
#line 1004 ""
	    }

/*  Check for end of block or bar line symbol */

#line 1008 ""
	    if (i_indx("/|", sym, (ftnlen)2, (ftnlen)1) > 0) {
#line 1009 ""
		ipe = ipenew;
#line 1010 ""
		goto L4;
#line 1011 ""
	    } else {
#line 1012 ""
		wbrest = FALSE_;
#line 1013 ""
		if (alldone) {
#line 1013 ""
		    goto L12;
#line 1013 ""
		}
#line 1014 ""
		i__3 = nwbrs;
#line 1014 ""
		for (iw = 1; iw <= i__3; ++iw) {
#line 1015 ""
		    wbrest = wbrest || s_cmp(sym, wbrsym + (iw - 1) * 3, lsym,
			     lwbrs) == 0;
#line 1016 ""
/* L5: */
#line 1016 ""
		}
#line 1017 ""
		wbrest = wbrest || s_cmp(sym, "r", lsym, (ftnlen)1) == 0 && 
			lwbrs == 2 || s_cmp(sym, "rd", lsym, (ftnlen)2) == 0 
			&& lwbrs == 3 || s_cmp(sym, "rp", lsym, (ftnlen)2) == 
			0 || s_cmp(sym, "r", lsym, (ftnlen)1) == 0 && rpfirst;
#line 1021 ""
L12:
#line 1021 ""
		if (wbrest) {
#line 1022 ""
		    ipe = ipenew;
#line 1023 ""
		    ++nmbr;
#line 1024 ""
		    goto L4;
#line 1025 ""
		} else {

/*  AHA! Failed prev. test, so last symbol was *not* mbr. */
/*  It must be saved, and its starting position is ipenew-lsym+1 */

#line 1030 ""
		    if (nmbr > 1) {

/*  Write stuff up to start of mbr */

#line 1034 ""
			if (ip1 > 1) {
#line 1034 ""
			    s_wsfe(&io___153);
#line 1034 ""
			    do_fio(&c__1, line, ip1 - 1);
#line 1034 ""
			    e_wsfe();
#line 1034 ""
			}

/*  Insert mbr symbol.  Always end with a slash just in case next sym must be */
/*  at start of block.  May think this causes undefined octaves, but */
/*  probably not since it's a single voice. */

#line 1040 ""
			r__1 = nmbr + .01f;
#line 1040 ""
			ndig = (integer) r_lg10(&r__1) + 1;
#line 1041 ""
			s_wsle(&io___155);
#line 1041 ""
			do_lio(&c__9, &c__1, "Inserting rm, iv,nmbr:", (
				ftnlen)22);
#line 1041 ""
			do_lio(&c__3, &c__1, (char *)&(*iv), (ftnlen)sizeof(
				integer));
#line 1041 ""
			do_lio(&c__3, &c__1, (char *)&nmbr, (ftnlen)sizeof(
				integer));
#line 1041 ""
			e_wsle();
#line 1042 ""
			ci__1.cierr = 0;
#line 1042 ""
			ci__1.ciunit = 40;
/* Writing concatenation */
#line 1042 ""
			i__2[0] = 5, a__2[0] = "(a2,i";
#line 1042 ""
			*(unsigned char *)&ch__1[0] = ndig + 48;
#line 1042 ""
			i__2[1] = 1, a__2[1] = ch__1;
#line 1042 ""
			i__2[2] = 4, a__2[2] = ",a2)";
#line 1042 ""
			ci__1.cifmt = (s_cat(ch__6, a__2, i__2, &c__3, (
				ftnlen)10), ch__6);
#line 1042 ""
			s_wsfe(&ci__1);
#line 1042 ""
			do_fio(&c__1, "rm", (ftnlen)2);
#line 1042 ""
			do_fio(&c__1, (char *)&nmbr, (ftnlen)sizeof(integer));
#line 1042 ""
			do_fio(&c__1, " /", (ftnlen)2);
#line 1042 ""
			e_wsfe();
#line 1043 ""
			if (alldone) {
#line 1043 ""
			    goto L999;
#line 1043 ""
			}
#line 1044 ""
			ipc = ipenew - lsym + 1;
#line 1045 ""
			s_copy(line, line + ((iline - 1 << 7) + (ipc - 1)), (
				ftnlen)128, len - (ipc - 1));
#line 1046 ""
		    } else {

/*  Write old stuff up to end of original lonesome wbr, save the rest. */
/*  4 cases:  (wbr /) , (wbr line-end) , (wbr followed by other non-/ symbols) , */
/*      alldone. */
/*  In 1st 2 will have gotten some other lines, so write all up to one b4 last */
/*  non-comment line; then revert to normal mode on that.  In 3rd case must */
/*  split line. */

#line 1055 ""
			if (alldone) {
#line 1056 ""
			    s_wsfe(&io___157);
#line 1056 ""
			    do_fio(&c__1, line, len);
#line 1056 ""
			    e_wsfe();
#line 1057 ""
			    goto L999;
#line 1058 ""
			} else if (iline > 1) {
#line 1059 ""
			    i__3 = iline - 1;
#line 1059 ""
			    for (il = 1; il <= i__3; ++il) {
#line 1060 ""
				len = lenstr_(line + (il - 1 << 7), &c__128, (
					ftnlen)128);
#line 1061 ""
				s_wsfe(&io___159);
#line 1061 ""
				do_fio(&c__1, line + (il - 1 << 7), len);
#line 1061 ""
				e_wsfe();
#line 1062 ""
/* L9: */
#line 1062 ""
			    }
#line 1063 ""
			    s_copy(line, line + (iline - 1 << 7), (ftnlen)128,
				     (ftnlen)128);
#line 1064 ""
			} else {

/*  Since iline = 1 the wbr is not the last sym, so must split */

#line 1068 ""
			    s_wsfe(&io___160);
#line 1068 ""
			    do_fio(&c__1, line, ip1 + lwbrsx - 1);
#line 1068 ""
			    e_wsfe();
#line 1069 ""
			    i__3 = ip1 + lwbrsx;
#line 1069 ""
			    s_copy(line, line + i__3, (ftnlen)128, len - i__3)
				    ;
#line 1070 ""
			}
#line 1071 ""
		    }

/*  Exit multibar mode */

#line 1075 ""
		    goto L7;
#line 1076 ""
		}
#line 1077 ""
	    }
#line 1078 ""
	}
#line 1079 ""
L2:
#line 1080 ""
	if (len > 0) {
#line 1081 ""
	    s_wsfe(&io___161);
#line 1081 ""
	    do_fio(&c__1, line, len);
#line 1081 ""
	    e_wsfe();
#line 1082 ""
	} else {
#line 1083 ""
	    s_wsfe(&io___162);
#line 1083 ""
	    do_fio(&c__1, " ", (ftnlen)1);
#line 1083 ""
	    e_wsfe();
#line 1084 ""
	}
#line 1085 ""
/* L1: */
#line 1085 ""
    }
#line 1086 ""
L999:
#line 1087 ""
    cl__1.cerr = 0;
#line 1087 ""
    cl__1.cunit = *iv + 10;
#line 1087 ""
    cl__1.csta = 0;
#line 1087 ""
    f_clos(&cl__1);
#line 1088 ""
    cl__1.cerr = 0;
#line 1088 ""
    cl__1.cunit = 40;
#line 1088 ""
    cl__1.csta = 0;
#line 1088 ""
    f_clos(&cl__1);
#line 1089 ""
    return 0;
} /* mbrests_ */

integer ifnodur_(integer *idur, char *dotq, ftnlen dotq_len)
{
    /* System generated locals */
    integer ret_val;

    /* Builtin functions */
    integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), 
	    e_wsle(void);
    /* Subroutine */ int s_stop(char *, ftnlen);

    /* Fortran I/O blocks */
    static cilist io___163 = { 0, 6, 0, 0, 0 };


#line 1093 ""
    if (*idur == 6) {
#line 1094 ""
	ret_val = 1;
#line 1095 ""
    } else if (*idur == 3) {
#line 1096 ""
	ret_val = 2;
#line 1097 ""
    } else if (*idur == 1 || *idur == 16) {
#line 1098 ""
	ret_val = 4;
#line 1099 ""
    } else if (*idur == 8) {
#line 1100 ""
	ret_val = 8;
#line 1101 ""
    } else if (*idur == 4) {
#line 1102 ""
	ret_val = 16;
#line 1103 ""
    } else if (*idur == 2) {
#line 1104 ""
	ret_val = 32;
#line 1105 ""
    } else if (*idur == 0) {
#line 1106 ""
	ret_val = 64;
#line 1107 ""
    } else {
#line 1108 ""
	s_wsle(&io___163);
#line 1108 ""
	do_lio(&c__9, &c__1, "You entered an invalid note-length value", (
		ftnlen)40);
#line 1108 ""
	e_wsle();
#line 1109 ""
	s_stop("", (ftnlen)0);
#line 1110 ""
    }
#line 1111 ""
    if (*(unsigned char *)dotq == 'd') {
#line 1111 ""
	ret_val = ret_val * 3 / 2;
#line 1111 ""
    }
#line 1112 ""
    return ret_val;
} /* ifnodur_ */

/* Subroutine */ int fwbrsym_(integer *lenbar, integer *nwbrs, char *wbrsym, 
	integer *lwbrs, ftnlen wbrsym_len)
{
    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);

    /* Fortran I/O blocks */
    static cilist io___164 = { 0, 6, 0, "(33H Any whole-bar rests of duratio"
	    "n ,i3,                  26H/64 will not be recognized)", 0 };


#line 1116 ""
    /* Parameter adjustments */
#line 1116 ""
    wbrsym -= 3;
#line 1116 ""

#line 1116 ""
    /* Function Body */
#line 1116 ""
    *nwbrs = 1;
#line 1117 ""
    *lwbrs = 2;
#line 1118 ""
    if (*lenbar == 16) {
#line 1119 ""
	s_copy(wbrsym + 3, "r4", (ftnlen)3, (ftnlen)2);
#line 1120 ""
    } else if (*lenbar == 32) {
#line 1121 ""
	s_copy(wbrsym + 3, "r2", (ftnlen)3, (ftnlen)2);
#line 1122 ""
    } else if (*lenbar == 64) {
#line 1123 ""
	s_copy(wbrsym + 3, "r0", (ftnlen)3, (ftnlen)2);
#line 1124 ""
    } else if (*lenbar == 8) {
#line 1125 ""
	s_copy(wbrsym + 3, "r8", (ftnlen)3, (ftnlen)2);
#line 1126 ""
    } else if (*lenbar == 128) {
#line 1127 ""
	s_copy(wbrsym + 3, "r9", (ftnlen)3, (ftnlen)2);
#line 1128 ""
    } else {
#line 1129 ""
	*nwbrs = 2;
#line 1130 ""
	*lwbrs = 3;
#line 1131 ""
	if (*lenbar == 24) {
#line 1132 ""
	    s_copy(wbrsym + 3, "rd4", (ftnlen)3, (ftnlen)3);
#line 1133 ""
	    s_copy(wbrsym + 6, "r4d", (ftnlen)3, (ftnlen)3);
#line 1134 ""
	} else if (*lenbar == 48) {
#line 1135 ""
	    s_copy(wbrsym + 3, "rd2", (ftnlen)3, (ftnlen)3);
#line 1136 ""
	    s_copy(wbrsym + 6, "r2d", (ftnlen)3, (ftnlen)3);
#line 1137 ""
	} else if (*lenbar == 96) {
#line 1138 ""
	    s_copy(wbrsym + 3, "rd0", (ftnlen)3, (ftnlen)3);
#line 1139 ""
	    s_copy(wbrsym + 6, "r0d", (ftnlen)3, (ftnlen)3);
#line 1140 ""
	} else {
#line 1141 ""
	    s_wsfe(&io___164);
#line 1141 ""
	    do_fio(&c__1, (char *)&(*lenbar), (ftnlen)sizeof(integer));
#line 1141 ""
	    e_wsfe();
#line 1143 ""
	}
#line 1144 ""
    }
#line 1145 ""
    return 0;
} /* fwbrsym_ */

/* Subroutine */ int nextsym_(char *line, integer *len, integer *ipeold, 
	integer *ipenew, char *sym, integer *lsym, ftnlen line_len, ftnlen 
	sym_len)
{
    /* System generated locals */
    integer i__1, i__2;

    /* Builtin functions */
    integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), 
	    e_wsle(void);
    /* Subroutine */ int s_stop(char *, ftnlen), s_copy(char *, char *, 
	    ftnlen, ftnlen);

    /* Local variables */
    static integer ip, iip;

    /* Fortran I/O blocks */
    static cilist io___165 = { 0, 6, 0, 0, 0 };
    static cilist io___166 = { 0, 6, 0, 0, 0 };
    static cilist io___169 = { 0, 6, 0, 0, 0 };



/*  Know its the last symbol if on return ipenew = len!.  So should never */
/*    be called when ipstart=len. */

#line 1154 ""
    if (*ipeold >= *len) {
#line 1155 ""
	s_wsle(&io___165);
#line 1155 ""
	do_lio(&c__9, &c__1, "Called nextsym with ipstart>=len ", (ftnlen)33);
#line 1155 ""
	e_wsle();
#line 1156 ""
	s_wsle(&io___166);
#line 1156 ""
	do_lio(&c__9, &c__1, "Send files to Dr. Don at dsimons@logicon.com", (
		ftnlen)44);
#line 1156 ""
	e_wsle();
#line 1157 ""
	s_stop("", (ftnlen)0);
#line 1158 ""
    }
#line 1159 ""
    i__1 = *len;
#line 1159 ""
    for (ip = *ipeold + 1; ip <= i__1; ++ip) {
#line 1160 ""
	if (*(unsigned char *)&line[ip - 1] != ' ') {

/*  symbol starts here (ip).  We're committed to exit the loop. */

#line 1164 ""
	    if (ip < *len) {
#line 1165 ""
		i__2 = *len;
#line 1165 ""
		for (iip = ip + 1; iip <= i__2; ++iip) {
#line 1166 ""
		    if (*(unsigned char *)&line[iip - 1] != ' ') {
#line 1166 ""
			goto L2;
#line 1166 ""
		    }

/*  iip is the space after the symbol */

#line 1170 ""
		    *ipenew = iip - 1;
#line 1171 ""
		    *lsym = *ipenew - ip + 1;
#line 1172 ""
		    s_copy(sym, line + (ip - 1), (ftnlen)80, *ipenew - (ip - 
			    1));
#line 1173 ""
		    return 0;
#line 1174 ""
L2:
#line 1174 ""
		    ;
#line 1174 ""
		}

/*  Have len>=2 and ends on len */

#line 1178 ""
		*ipenew = *len;
#line 1179 ""
		*lsym = *ipenew - ip + 1;
#line 1180 ""
		s_copy(sym, line + (ip - 1), (ftnlen)80, *ipenew - (ip - 1));
#line 1181 ""
		return 0;
#line 1182 ""
	    } else {

/*  ip = len */

#line 1186 ""
		*ipenew = *len;
#line 1187 ""
		*lsym = 1;
#line 1188 ""
		s_copy(sym, line + (ip - 1), (ftnlen)80, (ftnlen)1);
#line 1189 ""
		return 0;
#line 1190 ""
	    }
#line 1191 ""
	}
#line 1192 ""
/* L1: */
#line 1192 ""
    }
#line 1193 ""
    s_wsle(&io___169);
#line 1193 ""
    do_lio(&c__9, &c__1, "Error #3.  Send files to Dr. Don at dsimons@logico"\
	    "n.com", (ftnlen)55);
#line 1193 ""
    e_wsle();
#line 1194 ""
    return 0;
} /* nextsym_ */

integer ntindex_(char *line, char *s2q, ftnlen line_len, ftnlen s2q_len)
{
    /* System generated locals */
    address a__1[2];
    integer ret_val, i__1, i__2[2], i__3;

    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer i_indx(char *, char *, ftnlen, ftnlen), s_wsle(cilist *), do_lio(
	    integer *, integer *, char *, ftnlen), e_wsle(void);
    /* Subroutine */ int s_stop(char *, ftnlen), s_cat(char *, char **, 
	    integer *, integer *, ftnlen);
    integer s_cmp(char *, char *, ftnlen, ftnlen);

    /* Local variables */
    static integer ic, len, ndxs2;
    static char tline[128];
    static integer ndxbs;
    static logical intex;
    static integer ndxdq1, ndxdq2;
    extern integer lenstr_(char *, integer *, ftnlen);

    /* Fortran I/O blocks */
    static cilist io___175 = { 0, 6, 0, 0, 0 };



/*  Returns index(line,s2q) if NOT in TeX string, 0 otherwise */


/*     print*,'Starting ntindex.  s2q:',s2q,', line(1:79) is below' */
/*     print*,line(1:79) */


/*  Use a temporary string to store the input and test, so can zap D"..." */

#line 1209 ""
    s_copy(tline, line, (ftnlen)128, (ftnlen)128);
#line 1210 ""
    ndxs2 = i_indx(tline, s2q, (ftnlen)128, s2q_len);

/*  Return point below for rechecks after zapping D"  " */

#line 1214 ""
L2:
#line 1215 ""
    ndxbs = i_indx(tline, "\\", (ftnlen)128, (ftnlen)1);
#line 1216 ""
    if (ndxbs > 0) {

/* Special check in case \ is inside D"..." */

#line 1220 ""
	ndxdq1 = i_indx(tline, "D\"", (ftnlen)128, (ftnlen)2);

/* If the following test fails, flow out of if block; else loop up to 2. */

#line 1224 ""
	if (ndxdq1 > 0) {

/* Find end of D"..." */

#line 1228 ""
	    i__1 = ndxdq1 + 1;
#line 1228 ""
	    ndxdq2 = ndxdq1 + 1 + i_indx(tline + i__1, "\"", 128 - i__1, (
		    ftnlen)1);
#line 1229 ""
	    if (ndxdq2 == ndxdq1 + 1) {
#line 1230 ""
		s_wsle(&io___175);
#line 1230 ""
		do_lio(&c__9, &c__1, "Something is really wierd here", (
			ftnlen)30);
#line 1230 ""
		e_wsle();
#line 1231 ""
		s_stop("", (ftnlen)0);
#line 1232 ""
	    }
#line 1233 ""
	    s_copy(tline, tline, (ftnlen)128, ndxdq1 - 1);
#line 1234 ""
	    i__1 = ndxdq2;
#line 1234 ""
	    for (ic = ndxdq1; ic <= i__1; ++ic) {
/* Writing concatenation */
#line 1235 ""
		i__2[0] = ic - 1, a__1[0] = tline;
#line 1235 ""
		i__2[1] = 1, a__1[1] = " ";
#line 1235 ""
		s_cat(tline, a__1, i__2, &c__2, (ftnlen)128);
#line 1236 ""
/* L3: */
#line 1236 ""
	    }
#line 1237 ""
	    i__1 = ndxdq2;
/* Writing concatenation */
#line 1237 ""
	    i__2[0] = ndxdq2, a__1[0] = tline;
#line 1237 ""
	    i__2[1] = 128 - i__1, a__1[1] = line + i__1;
#line 1237 ""
	    s_cat(tline, a__1, i__2, &c__2, (ftnlen)128);
#line 1238 ""
	    goto L2;
#line 1239 ""
	}
#line 1240 ""
    }
#line 1241 ""
    if (ndxbs == 0 || ndxs2 < ndxbs) {
#line 1242 ""
	ret_val = ndxs2;
/*     print*,'No bs, or char is left of 1st bs, ntindex:',ntindex */
#line 1244 ""
    } else {

/*  There are both bs and s2q, and bs is to the left of sq2. So check bs's to */
/*  right of first: End is '\ ', start is ' \' */

#line 1249 ""
	len = lenstr_(tline, &c__128, (ftnlen)128);
#line 1250 ""
	intex = TRUE_;
/*     print*,'intex+>',intex */
#line 1252 ""
	i__1 = len;
#line 1252 ""
	for (ic = ndxbs + 1; ic <= i__1; ++ic) {
#line 1253 ""
	    if (ic == ndxs2) {
#line 1254 ""
		if (intex) {
#line 1255 ""
		    ret_val = 0;
#line 1256 ""
		    i__3 = ic;
#line 1256 ""
		    ndxs2 = i_indx(tline + i__3, s2q, len - i__3, s2q_len) + 
			    ic;
/*     print*,'ndxs2 =>',ndxs2 */
#line 1258 ""
		} else {
#line 1259 ""
		    ret_val = ndxs2;
#line 1260 ""
		    return ret_val;
#line 1261 ""
		}
/*     print*,'Internal exit, intex, ntindex:',intex,ntindex */
#line 1263 ""
	    } else /* if(complicated condition) */ {
#line 1263 ""
		i__3 = ic;
#line 1263 ""
		if (intex && s_cmp(tline + i__3, "\\ ", ic + 2 - i__3, (
			ftnlen)2) == 0) {
#line 1264 ""
		    intex = FALSE_;
/*     print*,'intex+>',intex */
#line 1266 ""
		} else /* if(complicated condition) */ {
#line 1266 ""
		    i__3 = ic;
#line 1266 ""
		    if (! intex && s_cmp(tline + i__3, " \\", ic + 2 - i__3, (
			    ftnlen)2) == 0) {
#line 1268 ""
			intex = TRUE_;
/*     print*,'intex+>',intex */
#line 1270 ""
		    }
#line 1270 ""
		}
#line 1270 ""
	    }
#line 1271 ""
/* L1: */
#line 1271 ""
	}
/*     print*,'Out end of loop 1' */
#line 1273 ""
    }
/*     print*,'Exiting ntindex at the end???' */
#line 1275 ""
    return ret_val;
} /* ntindex_ */

/* Subroutine */ int getchar_(char *line, integer *iccount, char *charq, 
	ftnlen line_len, ftnlen charq_len)
{
    /* Builtin functions */
    integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void);

    /* Fortran I/O blocks */
    static cilist io___179 = { 0, 10, 0, "(a)", 0 };



/*  Gets the next character out of line*128.  If pointer iccount=128 on entry, */
/*  then reads in a new line.  Resets iccount to position of the new character. */

#line 1284 ""
    if (*iccount == 128) {
#line 1285 ""
	s_rsfe(&io___179);
#line 1285 ""
	do_fio(&c__1, line, (ftnlen)128);
#line 1285 ""
	e_rsfe();
#line 1286 ""
	*iccount = 0;
#line 1287 ""
    }
#line 1288 ""
    ++(*iccount);
#line 1289 ""
    *(unsigned char *)charq = *(unsigned char *)&line[*iccount - 1];
#line 1290 ""
    return 0;
} /* getchar_ */

doublereal readin_(char *line, integer *iccount, integer *iread, ftnlen 
	line_len)
{
    /* System generated locals */
    address a__1[3];
    integer i__1[3], i__2;
    real ret_val;
    char ch__1[27], ch__2[6], ch__3[1];
    icilist ici__1;

    /* Builtin functions */
    integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void),
	     i_indx(char *, char *, ftnlen, ftnlen), s_wsle(cilist *);
    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
    integer do_lio(integer *, integer *, char *, ftnlen), e_wsle(void);
    /* Subroutine */ int s_stop(char *, ftnlen);
    integer s_rsfi(icilist *), e_rsfi(void);

    /* Local variables */
    extern /* Subroutine */ int allparts_(char *, integer *, ftnlen);
    static integer i1, i2, icf;
    static char durq[1];
    static logical goto999;
    extern /* Subroutine */ int chkcom_(char *, logical *, ftnlen), getchar_(
	    char *, integer *, char *, ftnlen, ftnlen);

    /* Fortran I/O blocks */
    static cilist io___180 = { 0, 10, 0, "(a)", 0 };
    static cilist io___185 = { 0, 6, 0, 0, 0 };
    static cilist io___187 = { 0, 6, 0, 0, 0 };



/*  Reads a piece of setup data from line, gets a new line from */
/*  file 10 (jobname.pmx) if needed, Transfers comment lines into all parts. */

/*  iread controls copying of values into scratch files for parts, but only */
/*  if not replacing. */

/*  iread input  value written */
/*   -1   nvi      nothing (only used when noinst<0 initially) */
/*   0   various   value read */
/*   1    nv       -1 , replace later with nvi(i) */
/*   2    noinst    1 */
/*   3    np       -2 , replace later with (nsyst-1)/12+1 */
/*   4  musicsize   20 */
/*   5  fracondent  0.05 */

#line 1315 ""
L4:
#line 1315 ""
    if (*iccount == 128) {
#line 1316 ""
	s_rsfe(&io___180);
#line 1316 ""
	do_fio(&c__1, line, (ftnlen)128);
#line 1316 ""
	e_rsfe();
#line 1317 ""
	if (all_1.replacing) {
#line 1317 ""
	    all_1.replacing = FALSE_;
#line 1317 ""
	}
#line 1318 ""
	chkcom_(line, &goto999, (ftnlen)128);
#line 1319 ""
	*iccount = 0;
#line 1320 ""
    }
#line 1321 ""
    ++(*iccount);

/*  Find next non-blank or end of line */

#line 1325 ""
    for (*iccount = *iccount; *iccount <= 127; ++(*iccount)) {
#line 1326 ""
	if (*(unsigned char *)&line[*iccount - 1] != ' ') {
#line 1326 ""
	    goto L3;
#line 1326 ""
	}
#line 1327 ""
/* L2: */
#line 1327 ""
    }

/*  If here, need to get a new line */

#line 1331 ""
    *iccount = 128;
#line 1332 ""
    goto L4;
#line 1333 ""
L3:

/*  iccount now points to start of number to read */

#line 1337 ""
    i1 = *iccount;
#line 1338 ""
L5:
#line 1338 ""
    getchar_(line, iccount, durq, (ftnlen)128, (ftnlen)1);

/*  Remember that getchar first increments iccount, *then* reads a character. */

#line 1342 ""
    if (i_indx("0123456789.-", durq, (ftnlen)12, (ftnlen)1) > 0) {
#line 1342 ""
	goto L5;
#line 1342 ""
    }
#line 1343 ""
    i2 = *iccount - 1;
#line 1344 ""
    if (i2 < i1) {
#line 1345 ""
	s_wsle(&io___185);
/* Writing concatenation */
#line 1345 ""
	i__1[0] = 7, a__1[0] = "Found \"";
#line 1345 ""
	i__1[1] = 1, a__1[1] = durq;
#line 1345 ""
	i__1[2] = 19, a__1[2] = "\" instead of number";
#line 1345 ""
	s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27);
#line 1345 ""
	do_lio(&c__9, &c__1, ch__1, (ftnlen)27);
#line 1345 ""
	e_wsle();
#line 1346 ""
	s_stop("1", (ftnlen)1);
#line 1347 ""
    }
#line 1348 ""
    icf = i2 - i1 + 49;
#line 1349 ""
    ici__1.icierr = 0;
#line 1349 ""
    ici__1.iciend = 0;
#line 1349 ""
    ici__1.icirnum = 1;
#line 1349 ""
    ici__1.icirlen = i2 - (i1 - 1);
#line 1349 ""
    ici__1.iciunit = line + (i1 - 1);
/* Writing concatenation */
#line 1349 ""
    i__1[0] = 2, a__1[0] = "(f";
#line 1349 ""
    *(unsigned char *)&ch__3[0] = icf;
#line 1349 ""
    i__1[1] = 1, a__1[1] = ch__3;
#line 1349 ""
    i__1[2] = 3, a__1[2] = ".0)";
#line 1349 ""
    ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2);
#line 1349 ""
    s_rsfi(&ici__1);
#line 1349 ""
    do_fio(&c__1, (char *)&ret_val, (ftnlen)sizeof(real));
#line 1349 ""
    e_rsfi();
#line 1350 ""
    if (! all_1.replacing) {
#line 1351 ""
	if (*iread == 0) {
#line 1352 ""
	    i__2 = i2 - i1 + 1;
#line 1352 ""
	    allparts_(line + (i1 - 1), &i__2, i2 - (i1 - 1));
#line 1353 ""
	} else if (*iread == 1) {
#line 1354 ""
	    allparts_("-999", &c__4, (ftnlen)4);
#line 1355 ""
	} else if (*iread == 2) {
#line 1356 ""
	    allparts_("1", &c__1, (ftnlen)1);
#line 1357 ""
	} else if (*iread == 3) {
#line 1358 ""
	    allparts_("-998", &c__4, (ftnlen)4);
#line 1359 ""
	} else if (*iread == 4) {
#line 1360 ""
	    allparts_("20", &c__2, (ftnlen)2);
#line 1361 ""
	} else if (*iread == 5) {
#line 1362 ""
	    allparts_(".05", &c__3, (ftnlen)3);
#line 1363 ""
	} else if (*iread != -1) {
#line 1364 ""
	    s_wsle(&io___187);
#line 1364 ""
	    do_lio(&c__9, &c__1, "Error with iread in readin", (ftnlen)26);
#line 1364 ""
	    e_wsle();
#line 1365 ""
	    s_stop("", (ftnlen)0);
#line 1366 ""
	}
#line 1367 ""
    }
#line 1368 ""
    return ret_val;
} /* readin_ */

/* Subroutine */ int chkcom_(char *line, logical *goto999, ftnlen line_len)
{
    /* System generated locals */
    integer i__1, i__2;

    /* Builtin functions */
    integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void),
	     i_indx(char *, char *, ftnlen, ftnlen), s_cmp(char *, char *, 
	    ftnlen, ftnlen), s_wsfe(cilist *), e_wsfe(void);

    /* Local variables */
    static logical clefpend;
    extern /* Subroutine */ int allparts_(char *, integer *, ftnlen);
    static integer j, k, ivq, idxb, idxl, idxm, idxn;
    extern /* Subroutine */ int zapbl_(char *, integer *, ftnlen);
    static integer iposc0;
    extern integer lenstr_(char *, integer *, ftnlen);
    static integer lenline;

    /* Fortran I/O blocks */
    static cilist io___188 = { 0, 10, 0, "(a)", 0 };
    static cilist io___197 = { 0, 10, 0, "(a)", 0 };
    static cilist io___200 = { 0, 0, 0, "(a)", 0 };
    static cilist io___201 = { 0, 0, 0, "(a)", 0 };
    static cilist io___202 = { 0, 10, 1, "(a)", 0 };



/*  Assume that line has just been read. No need to change iccount since we only */
/*  process full lines. */

#line 1380 ""
    *goto999 = FALSE_;
#line 1381 ""
L1:
#line 1381 ""
    if (*(unsigned char *)line != '%') {
#line 1381 ""
	return 0;
#line 1381 ""
    }

/*  If here, line has some sort of comment */

#line 1385 ""
    if (*(unsigned char *)&line[1] == '%') {
#line 1386 ""
	if (! all_1.insetup) {

/*  Suck up a line, then flow out of "if" block to get another and loop */

#line 1390 ""
	    s_rsfe(&io___188);
#line 1390 ""
	    do_fio(&c__1, line, (ftnlen)128);
#line 1390 ""
	    e_rsfe();
/* ++VV */

/*  UNLESS (a) it has a score-only "M" and changes # of inst's. */

#line 1396 ""
	    if (i_indx(line, "M", (ftnlen)128, (ftnlen)1) > 0) {
#line 1397 ""
		idxl = i_indx(line, "L", (ftnlen)128, (ftnlen)1);
#line 1398 ""
		idxm = i_indx(line, "M", (ftnlen)128, (ftnlen)1);
#line 1399 ""
		idxn = i_indx(line, "n", (ftnlen)128, (ftnlen)1);
#line 1400 ""
		idxb = i_indx(line, " ", (ftnlen)128, (ftnlen)1);
#line 1401 ""
		if (idxl < idxm && idxm < idxn && (idxb == 0 || idxn < idxb)) 
			{
#line 1403 ""
		    i__1 = idxn;
#line 1403 ""
		    all_1.noinow = *(unsigned char *)&line[i__1] - 48;
#line 1404 ""
		    clefpend = TRUE_;

/*  Next noinow digits are original inst. #'s of new inst. set.  Next noinow */
/*  char's after that are clefs */

#line 1409 ""
		    all_1.nvnow = 0;
#line 1410 ""
		    i__1 = all_1.noinow;
#line 1410 ""
		    for (j = 1; j <= i__1; ++j) {
#line 1411 ""
			i__2 = idxn + 1 + j - 1;
#line 1411 ""
			all_1.iorig[j - 1] = *(unsigned char *)&line[i__2] - 
				48;
#line 1412 ""
			iposc0 = idxn + 1 + all_1.noinow;
#line 1413 ""
			i__2 = all_1.nvi[all_1.iorig[j - 1] - 1];
#line 1413 ""
			for (k = 1; k <= i__2; ++k) {
#line 1414 ""
			    ++all_1.nvnow;
/*                  clefq(nvnow) = line(iposc0+nvnow:iposc0+nvnow) */
#line 1416 ""
			    all_1.instnum[all_1.nvnow - 1] = j;
#line 1417 ""
			    all_1.botv[all_1.nvnow - 1] = k == 1 && j != 1;
#line 1418 ""
/* L25: */
#line 1418 ""
			}
#line 1419 ""
/* L24: */
#line 1419 ""
		    }
#line 1420 ""
		}
#line 1421 ""
	    }

/*  or if it's "h" or "l", need to suck up one more line */

#line 1425 ""
	    if (*(unsigned char *)line == 'h' && i_indx("+- ", line + 1, (
		    ftnlen)3, (ftnlen)1) > 0 || *(unsigned char *)line == 'T' 
		    || s_cmp(line, "l ", (ftnlen)2, (ftnlen)2) == 0) {
#line 1425 ""
		s_rsfe(&io___197);
#line 1425 ""
		do_fio(&c__1, line, (ftnlen)128);
#line 1425 ""
		e_rsfe();
#line 1425 ""
	    }

/*  4/29/00 check for T string also */

#line 1431 ""
	} else {

/*  In setup mode. Set flag, flow out and do use following line */

#line 1435 ""
	    all_1.replacing = TRUE_;
#line 1436 ""
	}
#line 1437 ""
    } else if (*(unsigned char *)&line[1] == '!') {

/*  Copy to all parts */

#line 1441 ""
	allparts_(line + 2, &c__125, (ftnlen)126);
#line 1442 ""
    } else {

/*  Get value of hex integer 1,2,...,9,a,b,c in 2nd position, zero otherwise */
/* c  Get value of extended hex integer 1,2,...,9,a,b,c,...,o in 2nd position, zero otherwise */

#line 1447 ""
	ivq = i_indx("123456789abcdefghijklmno", line + 1, (ftnlen)24, (
		ftnlen)1);

/*  Only treat as part-specific pmx line if number .le. noinst */

#line 1451 ""
	if (ivq < 1 || ivq > all_1.noinst) {

/*  Simple comment. */

#line 1455 ""
	    allparts_(line, &c__128, (ftnlen)128);
#line 1456 ""
	} else {

/*  Instrument comment, copy only to part */

#line 1460 ""
	    lenline = lenstr_(line, &c__128, (ftnlen)128);
#line 1461 ""
	    if (lenline > 2) {
#line 1462 ""
		io___200.ciunit = ivq + 10;
#line 1462 ""
		s_wsfe(&io___200);
#line 1462 ""
		do_fio(&c__1, line + 2, lenline - 2);
#line 1462 ""
		e_wsfe();
#line 1463 ""
	    } else {

/*  Transferring blank line */

#line 1467 ""
		io___201.ciunit = ivq + 10;
#line 1467 ""
		s_wsfe(&io___201);
#line 1467 ""
		do_fio(&c__1, " ", (ftnlen)1);
#line 1467 ""
		e_wsfe();
#line 1468 ""
	    }
#line 1469 ""
	}
#line 1470 ""
    }
#line 1471 ""
    i__1 = s_rsfe(&io___202);
#line 1471 ""
    if (i__1 != 0) {
#line 1471 ""
	goto L2;
#line 1471 ""
    }
#line 1471 ""
    i__1 = do_fio(&c__1, line, (ftnlen)128);
#line 1471 ""
    if (i__1 != 0) {
#line 1471 ""
	goto L2;
#line 1471 ""
    }
#line 1471 ""
    i__1 = e_rsfe();
#line 1471 ""
    if (i__1 != 0) {
#line 1471 ""
	goto L2;
#line 1471 ""
    }
#line 1472 ""
    zapbl_(line, &c__128, (ftnlen)128);
#line 1473 ""
    goto L1;
#line 1474 ""
L2:
#line 1475 ""
    *goto999 = TRUE_;
#line 1476 ""
    return 0;
} /* chkcom_ */

/* Subroutine */ int dosetup_(integer *iv, char *line, integer *mtrnum, 
	integer *mtrden, ftnlen line_len)
{
    /* System generated locals */
    integer i__1, i__2;

    /* Builtin functions */
    integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void),
	     i_nint(real *);

    /* Local variables */
    static integer ioi, noi, iset;
    static real xdata;
    static integer iccount;
    extern /* Subroutine */ int partnum_(integer *, integer *, char *, real *,
	     ftnlen);

    /* Fortran I/O blocks */
    static cilist io___206 = { 0, 40, 0, "(i5)", 0 };
    static cilist io___208 = { 0, 40, 0, "(i5)", 0 };
    static cilist io___210 = { 0, 40, 0, "(i5)", 0 };
    static cilist io___211 = { 0, 40, 0, "(i5)", 0 };
    static cilist io___212 = { 0, 40, 0, "(i5)", 0 };
    static cilist io___213 = { 0, 40, 0, "(i5)", 0 };
    static cilist io___214 = { 0, 40, 0, "(f5.2)", 0 };



/*  Transfers setup data from scratch file to real one for one instrument */
/*  Data may be mixed with comments, but on entry 1st item is a number. */
/*  Write a comment when encountered, as it comes. */
/*  Write numbers one per line. */
/*  Three input data require special handling: */
/*    If not already replaced, i.e., if negative, then */
/*      iset(1) (nv) will be replaced with nvi(i) */
/*      iset(9) (npages) will be replaced with (nsyst-1)/12+1 */
/*    iset(2), if negative, will be followed by extra numbers to be transf. */

#line 1495 ""
    iccount = 0;
#line 1496 ""
    for (iset = 1; iset <= 12; ++iset) {
#line 1497 ""
	partnum_(iv, &iccount, line, &xdata, (ftnlen)128);
#line 1498 ""
	if (iset == 2) {
#line 1499 ""
	    if (xdata > 0.f) {
#line 1500 ""
		s_wsfe(&io___206);
#line 1500 ""
		i__1 = (integer) (xdata + .1f);
#line 1500 ""
		do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
#line 1500 ""
		e_wsfe();
#line 1501 ""
	    } else {
#line 1502 ""
		noi = -xdata + .1f;
#line 1503 ""
		s_wsfe(&io___208);
#line 1503 ""
		do_fio(&c__1, (char *)&noi, (ftnlen)sizeof(integer));
#line 1503 ""
		e_wsfe();
#line 1504 ""
		i__1 = noi;
#line 1504 ""
		for (ioi = 1; ioi <= i__1; ++ioi) {
#line 1505 ""
		    partnum_(iv, &iccount, line, &xdata, (ftnlen)128);
#line 1506 ""
		    s_wsfe(&io___210);
#line 1506 ""
		    i__2 = (integer) (xdata + .1f);
#line 1506 ""
		    do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
#line 1506 ""
		    e_wsfe();
#line 1507 ""
/* L2: */
#line 1507 ""
		}
#line 1508 ""
	    }
/*        else if (iset.ne.8 .and. xdata.lt.0) then */
#line 1510 ""
	} else if (iset != 8 && iset != 5 && xdata < 0.f) {

/*  Must be either nv or npages */

#line 1514 ""
	    if ((integer) (-xdata + .1f) == 999) {

/*  It's nv */

#line 1518 ""
		s_wsfe(&io___211);
#line 1518 ""
		do_fio(&c__1, (char *)&all_1.nvi[*iv - 1], (ftnlen)sizeof(
			integer));
#line 1518 ""
		e_wsfe();
#line 1519 ""
	    } else {

/*  npages must be computed */

#line 1523 ""
		s_wsfe(&io___212);
#line 1523 ""
		i__1 = (all_1.nsyst - 1) / 12 + 1;
#line 1523 ""
		do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
#line 1523 ""
		e_wsfe();
#line 1524 ""
	    }
#line 1525 ""
	} else if (iset != 7 && iset != 12) {

/*  write integer */

#line 1529 ""
	    s_wsfe(&io___213);
#line 1529 ""
	    i__1 = i_nint(&xdata);
#line 1529 ""
	    do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
#line 1529 ""
	    e_wsfe();
#line 1530 ""
	} else {

/*  write floating number */

#line 1534 ""
	    s_wsfe(&io___214);
#line 1534 ""
	    do_fio(&c__1, (char *)&xdata, (ftnlen)sizeof(real));
#line 1534 ""
	    e_wsfe();
#line 1535 ""
	}
#line 1536 ""
	if (iset == 3) {
#line 1537 ""
	    *mtrnum = i_nint(&xdata);
#line 1538 ""
	} else if (iset == 4) {
#line 1539 ""
	    *mtrden = i_nint(&xdata);
#line 1540 ""
	}
#line 1541 ""
/* L1: */
#line 1541 ""
    }
#line 1542 ""
    return 0;
} /* dosetup_ */

/* Subroutine */ int partnum_(integer *iv, integer *iccount, char *line, real 
	*xdata, ftnlen line_len)
{
    /* System generated locals */
    address a__1[3];
    integer i__1[3];
    char ch__1[27], ch__2[6], ch__3[1];
    icilist ici__1;

    /* Builtin functions */
    integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void),
	     s_wsfe(cilist *), e_wsfe(void), i_indx(char *, char *, ftnlen, 
	    ftnlen), s_wsle(cilist *);
    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
    integer do_lio(integer *, integer *, char *, ftnlen), e_wsle(void);
    /* Subroutine */ int s_stop(char *, ftnlen);
    integer s_rsfi(icilist *), e_rsfi(void);

    /* Local variables */
    static integer i1, i2, icf, len;
    static char durq[1];
    extern integer lenstr_(char *, integer *, ftnlen);
    extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen, 
	    ftnlen);

    /* Fortran I/O blocks */
    static cilist io___215 = { 0, 0, 0, "(a)", 0 };
    static cilist io___217 = { 0, 40, 0, "(a)", 0 };
    static cilist io___221 = { 0, 6, 0, 0, 0 };



/*  Simplified number parsing.  Only looks for comment lines and numbers. */

#line 1550 ""
L2:
#line 1550 ""
    if (*iccount == 128) {
#line 1551 ""
	io___215.ciunit = *iv + 10;
#line 1551 ""
	s_rsfe(&io___215);
#line 1551 ""
	do_fio(&c__1, line, (ftnlen)128);
#line 1551 ""
	e_rsfe();
#line 1552 ""
	if (*(unsigned char *)line == '%') {
#line 1553 ""
	    len = lenstr_(line, &c__128, (ftnlen)128);
#line 1554 ""
	    s_wsfe(&io___217);
#line 1554 ""
	    do_fio(&c__1, line, len);
#line 1554 ""
	    e_wsfe();
#line 1555 ""
	    goto L2;
#line 1556 ""
	}
#line 1557 ""
	*iccount = 0;
#line 1558 ""
    }
#line 1559 ""
    ++(*iccount);

/*  Find next non-blank or end of line */

#line 1563 ""
    for (*iccount = *iccount; *iccount <= 127; ++(*iccount)) {
#line 1564 ""
	if (*(unsigned char *)&line[*iccount - 1] != ' ') {
#line 1564 ""
	    goto L3;
#line 1564 ""
	}
#line 1565 ""
/* L4: */
#line 1565 ""
    }

/*  If here, iccount=128 and need to get a new line */

#line 1569 ""
    goto L2;
#line 1570 ""
L3:

/*  iccount now points to start of number to read */

#line 1574 ""
    i1 = *iccount;
#line 1575 ""
L5:
#line 1575 ""
    getchar_(line, iccount, durq, (ftnlen)128, (ftnlen)1);

/*  Remember that getchar first increments iccount, *then* reads a character. */

#line 1579 ""
    if (i_indx("0123456789.-", durq, (ftnlen)12, (ftnlen)1) > 0) {
#line 1579 ""
	goto L5;
#line 1579 ""
    }
#line 1580 ""
    i2 = *iccount - 1;
#line 1581 ""
    if (i2 < i1) {
#line 1582 ""
	s_wsle(&io___221);
/* Writing concatenation */
#line 1582 ""
	i__1[0] = 7, a__1[0] = "Found \"";
#line 1582 ""
	i__1[1] = 1, a__1[1] = durq;
#line 1582 ""
	i__1[2] = 19, a__1[2] = "\" instead of number";
#line 1582 ""
	s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27);
#line 1582 ""
	do_lio(&c__9, &c__1, ch__1, (ftnlen)27);
#line 1582 ""
	e_wsle();
#line 1583 ""
	s_stop("1", (ftnlen)1);
#line 1584 ""
    }
#line 1585 ""
    icf = i2 - i1 + 49;
#line 1586 ""
    ici__1.icierr = 0;
#line 1586 ""
    ici__1.iciend = 0;
#line 1586 ""
    ici__1.icirnum = 1;
#line 1586 ""
    ici__1.icirlen = i2 - (i1 - 1);
#line 1586 ""
    ici__1.iciunit = line + (i1 - 1);
/* Writing concatenation */
#line 1586 ""
    i__1[0] = 2, a__1[0] = "(f";
#line 1586 ""
    *(unsigned char *)&ch__3[0] = icf;
#line 1586 ""
    i__1[1] = 1, a__1[1] = ch__3;
#line 1586 ""
    i__1[2] = 3, a__1[2] = ".0)";
#line 1586 ""
    ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2);
#line 1586 ""
    s_rsfi(&ici__1);
#line 1586 ""
    do_fio(&c__1, (char *)&(*xdata), (ftnlen)sizeof(real));
#line 1586 ""
    e_rsfi();
#line 1587 ""
    return 0;
} /* partnum_ */


/* Subroutine */ int zapbl_(char *string, integer *len, ftnlen string_len)
{
    /* System generated locals */
    integer i__1;

    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);

    /* Local variables */
    static integer i__;

#line 1599 ""
    i__1 = *len;
#line 1599 ""
    for (i__ = 1; i__ <= i__1; ++i__) {
#line 1600 ""
	if (*(unsigned char *)&string[i__ - 1] == ' ') {
#line 1600 ""
	    goto L1;
#line 1600 ""
	}
#line 1601 ""
	if (i__ == 1) {
#line 1601 ""
	    return 0;
#line 1601 ""
	}
#line 1602 ""
	goto L2;
#line 1603 ""
L1:
#line 1603 ""
	;
#line 1603 ""
    }

/*  If line is all blank, leave it alone */

#line 1607 ""
    return 0;
#line 1608 ""
L2:
#line 1609 ""
    s_copy(string, string + (i__ - 1), string_len, *len - (i__ - 1));
#line 1610 ""
    return 0;
} /* zapbl_ */

/* Subroutine */ int oddquotesbefore_(char *lineq, integer *indx, logical *
	yesodd, ftnlen lineq_len)
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    static integer i__, numdqs;


/*  This counts number of double quotes in lineq up to position indx-1, then */
/*    sets yesodd according to whether number is odd or even */

#line 1619 ""
    numdqs = 0;
#line 1620 ""
    i__1 = *indx - 1;
#line 1620 ""
    for (i__ = 1; i__ <= i__1; ++i__) {
#line 1621 ""
	if (*(unsigned char *)&lineq[i__ - 1] == '"') {
#line 1621 ""
	    ++numdqs;
#line 1621 ""
	}
#line 1622 ""
/* L1: */
#line 1622 ""
    }
#line 1623 ""
    *yesodd = numdqs % 2 == 1;
#line 1624 ""
    return 0;
} /* oddquotesbefore_ */

