summaryrefslogtreecommitdiff
path: root/Build/source/utils/pmx/pmx-src/scor2prt.c
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/utils/pmx/pmx-src/scor2prt.c')
-rw-r--r--Build/source/utils/pmx/pmx-src/scor2prt.c4335
1 files changed, 4335 insertions, 0 deletions
diff --git a/Build/source/utils/pmx/pmx-src/scor2prt.c b/Build/source/utils/pmx/pmx-src/scor2prt.c
new file mode 100644
index 00000000000..4873c52314d
--- /dev/null
+++ b/Build/source/utils/pmx/pmx-src/scor2prt.c
@@ -0,0 +1,4335 @@
+#line 1 ""
+/* -- translated by f2c (version 20160102).
+ 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_ */
+