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