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.c3401
1 files changed, 1708 insertions, 1693 deletions
diff --git a/Build/source/utils/pmx/pmx-src/scor2prt.c b/Build/source/utils/pmx/pmx-src/scor2prt.c
index 3f69f41ad45..278ad1bd6c1 100644
--- a/Build/source/utils/pmx/pmx-src/scor2prt.c
+++ b/Build/source/utils/pmx/pmx-src/scor2prt.c
@@ -60,7 +60,7 @@ static integer c__125 = 125;
/* ccccccccccccccccccccccccc */
/* c */
-/* c scor2prt 7/24/11 for PMX 2.615 */
+/* 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 */
@@ -82,7 +82,11 @@ static integer c__125 = 125;
/* 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 */
@@ -191,10 +195,10 @@ static integer c__125 = 125;
static integer kvend;
extern /* Subroutine */ int zapbl_(char *, integer *, ftnlen);
static integer itemp, iinst, ntinx;
- static logical oneof2;
+ static logical oneof2, goto999;
extern doublereal readin_(char *, integer *, integer *, ftnlen);
- extern /* Subroutine */ int chkcom_(char *, ftnlen), getarg_(integer *,
- char *, ftnlen);
+ extern /* Subroutine */ int chkcom_(char *, logical *, ftnlen), getarg_(
+ integer *, char *, ftnlen);
static integer npages;
static char holdln[128];
static integer iudpfn;
@@ -230,501 +234,501 @@ static integer c__125 = 125;
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___22 = { 0, 10, 0, "(a)", 0 };
static cilist io___23 = { 0, 10, 0, "(a)", 0 };
- static cilist io___38 = { 0, 6, 0, 0, 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, 10, 0, "(a)", 0 };
+ static cilist io___41 = { 0, 6, 0, 0, 0 };
static cilist io___42 = { 0, 10, 0, "(a)", 0 };
- static cilist io___44 = { 0, 10, 0, "(a)", 0 };
- static cilist io___46 = { 0, 10, 0, "(a)", 0 };
- static cilist io___48 = { 0, 6, 0, 0, 0 };
- static cilist io___49 = { 0, 0, 0, "(a)", 0 };
- static cilist io___50 = { 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___55 = { 0, 10, 0, "(a)", 0 };
- static cilist io___57 = { 0, 0, 0, "(a2/a)", 0 };
- static cilist io___59 = { 0, 10, 1, "(a)", 0 };
- static cilist io___61 = { 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___68 = { 0, 6, 0, 0, 0 };
+ static cilist io___63 = { 0, 10, 0, "(a)", 0 };
static cilist io___69 = { 0, 6, 0, 0, 0 };
- static cilist io___72 = { 0, 10, 0, "(a)", 0 };
- static cilist io___76 = { 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___81 = { 0, 10, 0, "(a)", 0 };
- static cilist io___83 = { 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 icilist io___85 = { 0, line+2, 0, "(i1)", 1, 1 };
- static icilist io___88 = { 0, line+2, 0, "(i2)", 2, 1 };
- static cilist io___89 = { 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___97 = { 0, 0, 0, "(a)", 0 };
- static cilist io___102 = { 0, 0, 0, "(a)", 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 99 ""
+#line 104 ""
clefpend = FALSE_;
-#line 100 ""
+#line 105 ""
all_1.insetup = TRUE_;
-#line 101 ""
+#line 106 ""
all_1.replacing = FALSE_;
-#line 102 ""
+#line 107 ""
frstln = TRUE_;
-#line 103 ""
+#line 108 ""
lenhold = 0;
-#line 104 ""
+#line 109 ""
*(unsigned char *)sq = '\\';
-#line 105 ""
+#line 110 ""
s_wsle(&io___6);
-#line 105 ""
- do_lio(&c__9, &c__1, "This is scor2prt for PMX 2.7, 2 April 2013", (
- ftnlen)42);
-#line 105 ""
+#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 106 ""
+#line 111 ""
numargs = iargc_();
-#line 107 ""
+#line 112 ""
if (numargs == 0) {
-#line 108 ""
+#line 113 ""
s_wsle(&io___8);
-#line 108 ""
+#line 113 ""
do_lio(&c__9, &c__1, "You could have entered a jobname on the comman"\
"d line,", (ftnlen)53);
-#line 108 ""
+#line 113 ""
e_wsle();
-#line 109 ""
+#line 114 ""
s_wsle(&io___9);
-#line 109 ""
+#line 114 ""
do_lio(&c__9, &c__1, " but you may enter one now:", (ftnlen)32);
-#line 109 ""
+#line 114 ""
e_wsle();
-#line 110 ""
+#line 115 ""
s_rsfe(&io___10);
-#line 110 ""
+#line 115 ""
do_fio(&c__1, jobname, (ftnlen)27);
-#line 110 ""
+#line 115 ""
e_rsfe();
-#line 111 ""
+#line 116 ""
numargs = 1;
-#line 112 ""
+#line 117 ""
} else {
/* call getarg(1,jobname,idum) ! May need to replace this w/ next line */
-#line 114 ""
+#line 119 ""
getarg_(&c__1, jobname, (ftnlen)27);
-#line 115 ""
+#line 120 ""
}
-#line 116 ""
+#line 121 ""
ljob = lenstr_(jobname, &c__27, (ftnlen)27);
-#line 117 ""
+#line 122 ""
if (ljob == 0) {
-#line 118 ""
+#line 123 ""
s_wsle(&io___13);
-#line 118 ""
+#line 123 ""
do_lio(&c__9, &c__1, "No was jobname entered. Restart and try again.",
(ftnlen)46);
-#line 118 ""
+#line 123 ""
e_wsle();
-#line 119 ""
+#line 124 ""
s_stop("", (ftnlen)0);
-#line 120 ""
+#line 125 ""
}
/* Strip ".pmx" if necessary */
/* Computing MAX */
-#line 124 ""
+#line 129 ""
i__1 = i_indx(jobname, ".pmx", (ftnlen)27, (ftnlen)4), i__2 = i_indx(
jobname, ".PMX", (ftnlen)27, (ftnlen)4);
-#line 124 ""
+#line 129 ""
ndxpmx = max(i__1,i__2);
-#line 125 ""
+#line 130 ""
if (ndxpmx > 0) {
-#line 126 ""
+#line 131 ""
s_copy(jobname, jobname, (ftnlen)27, ndxpmx - 1);
-#line 127 ""
+#line 132 ""
ljob += -4;
-#line 128 ""
+#line 133 ""
}
/* Check for existence of input file */
/* Writing concatenation */
-#line 132 ""
+#line 137 ""
i__3[0] = ljob, a__1[0] = jobname;
-#line 132 ""
+#line 137 ""
i__3[1] = 4, a__1[1] = ".pmx";
-#line 132 ""
+#line 137 ""
s_cat(infileq, a__1, i__3, &c__2, (ftnlen)27);
-#line 133 ""
+#line 138 ""
ioin__1.inerr = 0;
-#line 133 ""
+#line 138 ""
ioin__1.infilen = 27;
-#line 133 ""
+#line 138 ""
ioin__1.infile = infileq;
-#line 133 ""
+#line 138 ""
ioin__1.inex = &fexist;
-#line 133 ""
+#line 138 ""
ioin__1.inopen = 0;
-#line 133 ""
+#line 138 ""
ioin__1.innum = 0;
-#line 133 ""
+#line 138 ""
ioin__1.innamed = 0;
-#line 133 ""
+#line 138 ""
ioin__1.inname = 0;
-#line 133 ""
+#line 138 ""
ioin__1.inacc = 0;
-#line 133 ""
+#line 138 ""
ioin__1.inseq = 0;
-#line 133 ""
+#line 138 ""
ioin__1.indir = 0;
-#line 133 ""
+#line 138 ""
ioin__1.infmt = 0;
-#line 133 ""
+#line 138 ""
ioin__1.inform = 0;
-#line 133 ""
+#line 138 ""
ioin__1.inunf = 0;
-#line 133 ""
+#line 138 ""
ioin__1.inrecl = 0;
-#line 133 ""
+#line 138 ""
ioin__1.innrec = 0;
-#line 133 ""
+#line 138 ""
ioin__1.inblank = 0;
-#line 133 ""
+#line 138 ""
f_inqu(&ioin__1);
-#line 134 ""
+#line 139 ""
if (! fexist) {
-#line 135 ""
+#line 140 ""
s_wsle(&io___17);
/* Writing concatenation */
-#line 135 ""
+#line 140 ""
i__3[0] = 17, a__1[0] = "Cannot find file ";
-#line 135 ""
+#line 140 ""
i__3[1] = 27, a__1[1] = infileq;
-#line 135 ""
+#line 140 ""
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)44);
-#line 135 ""
+#line 140 ""
do_lio(&c__9, &c__1, ch__1, (ftnlen)44);
-#line 135 ""
+#line 140 ""
e_wsle();
-#line 136 ""
+#line 141 ""
s_stop("", (ftnlen)0);
-#line 137 ""
+#line 142 ""
}
-#line 138 ""
+#line 143 ""
o__1.oerr = 0;
-#line 138 ""
+#line 143 ""
o__1.ounit = 10;
-#line 138 ""
+#line 143 ""
o__1.ofnmlen = ljob + 4;
/* Writing concatenation */
-#line 138 ""
+#line 143 ""
i__3[0] = ljob, a__1[0] = jobname;
-#line 138 ""
+#line 143 ""
i__3[1] = 4, a__1[1] = ".pmx";
-#line 138 ""
+#line 143 ""
s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)31);
-#line 138 ""
+#line 143 ""
o__1.ofnm = ch__2;
-#line 138 ""
+#line 143 ""
o__1.orl = 0;
-#line 138 ""
+#line 143 ""
o__1.osta = 0;
-#line 138 ""
+#line 143 ""
o__1.oacc = 0;
-#line 138 ""
+#line 143 ""
o__1.ofm = 0;
-#line 138 ""
+#line 143 ""
o__1.oblnk = 0;
-#line 138 ""
+#line 143 ""
f_open(&o__1);
/* Open all instrument files now for allparts stuff. Later disgard those >nv */
-#line 142 ""
+#line 147 ""
for (iv = 1; iv <= 24; ++iv) {
-#line 143 ""
+#line 148 ""
all_1.iorig[iv - 1] = iv;
-#line 144 ""
+#line 149 ""
o__1.oerr = 0;
-#line 144 ""
+#line 149 ""
o__1.ounit = iv + 10;
-#line 144 ""
+#line 149 ""
o__1.ofnm = 0;
-#line 144 ""
+#line 149 ""
o__1.orl = 0;
-#line 144 ""
+#line 149 ""
o__1.osta = "SCRATCH";
-#line 144 ""
+#line 149 ""
o__1.oacc = 0;
-#line 144 ""
+#line 149 ""
o__1.ofm = 0;
-#line 144 ""
+#line 149 ""
o__1.oblnk = 0;
-#line 144 ""
+#line 149 ""
f_open(&o__1);
-#line 145 ""
+#line 150 ""
ludpfn[iv - 1] = 0;
-#line 146 ""
+#line 151 ""
/* L19: */
-#line 146 ""
+#line 151 ""
}
-#line 147 ""
+#line 152 ""
s_rsfe(&io___20);
-#line 147 ""
+#line 152 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 147 ""
+#line 152 ""
e_rsfe();
-#line 148 ""
- chkcom_(line, (ftnlen)128);
-#line 149 ""
+#line 153 ""
+ chkcom_(line, &goto999, (ftnlen)128);
+#line 154 ""
if (s_cmp(line, "---", (ftnlen)3, (ftnlen)3) == 0) {
-#line 150 ""
+#line 155 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 151 ""
+#line 156 ""
L31:
-#line 151 ""
- s_rsfe(&io___22);
-#line 151 ""
+#line 156 ""
+ s_rsfe(&io___23);
+#line 156 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 151 ""
+#line 156 ""
e_rsfe();
-#line 152 ""
+#line 157 ""
if (s_cmp(line, "---", (ftnlen)3, (ftnlen)3) != 0) {
-#line 153 ""
+#line 158 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 154 ""
+#line 159 ""
goto L31;
-#line 155 ""
+#line 160 ""
}
-#line 156 ""
+#line 161 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 157 ""
- s_rsfe(&io___23);
-#line 157 ""
+#line 162 ""
+ s_rsfe(&io___24);
+#line 162 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 157 ""
+#line 162 ""
e_rsfe();
-#line 158 ""
- chkcom_(line, (ftnlen)128);
-#line 159 ""
+#line 163 ""
+ chkcom_(line, &goto999, (ftnlen)128);
+#line 164 ""
}
-#line 160 ""
+#line 165 ""
iccount = 0;
-#line 161 ""
+#line 166 ""
nv = readin_(line, &iccount, &c__1, (ftnlen)128) + .1f;
-#line 162 ""
+#line 167 ""
all_1.noinst = readin_(line, &iccount, &c__2, (ftnlen)128) + .1f;
-#line 163 ""
+#line 168 ""
if (all_1.noinst > 0) {
-#line 164 ""
+#line 169 ""
all_1.nvi[0] = nv - all_1.noinst + 1;
-#line 165 ""
+#line 170 ""
} else {
-#line 166 ""
+#line 171 ""
all_1.noinst = 1 - all_1.noinst;
-#line 167 ""
+#line 172 ""
i__1 = all_1.noinst;
-#line 167 ""
+#line 172 ""
for (iinst = 1; iinst <= i__1; ++iinst) {
-#line 168 ""
+#line 173 ""
all_1.nvi[iinst - 1] = readin_(line, &iccount, &c_n1, (ftnlen)128)
+ .1f;
-#line 169 ""
+#line 174 ""
/* L21: */
-#line 169 ""
+#line 174 ""
}
-#line 170 ""
+#line 175 ""
}
-#line 171 ""
+#line 176 ""
all_1.noinow = all_1.noinst;
-#line 172 ""
+#line 177 ""
insnow = 1;
/* ivlast is last iv in current inst. instnum(iv) is iinst for current voice. */
-#line 176 ""
+#line 181 ""
ivlast = all_1.nvi[0];
-#line 177 ""
+#line 182 ""
i__1 = nv;
-#line 177 ""
+#line 182 ""
for (iv = 1; iv <= i__1; ++iv) {
-#line 178 ""
+#line 183 ""
all_1.instnum[iv - 1] = insnow;
-#line 179 ""
+#line 184 ""
if (iv == ivlast) {
-#line 180 ""
+#line 185 ""
if (iv < nv) {
-#line 180 ""
+#line 185 ""
all_1.botv[iv] = TRUE_;
-#line 180 ""
+#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 186 ""
+#line 191 ""
if (insnow < all_1.noinst) {
-#line 187 ""
+#line 192 ""
++insnow;
-#line 188 ""
+#line 193 ""
ivlast += all_1.nvi[insnow - 1];
-#line 189 ""
+#line 194 ""
}
-#line 190 ""
+#line 195 ""
}
-#line 191 ""
+#line 196 ""
/* L22: */
-#line 191 ""
+#line 196 ""
}
-#line 192 ""
+#line 197 ""
mtrnuml = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f;
-#line 193 ""
+#line 198 ""
mtrdenl = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f;
-#line 194 ""
+#line 199 ""
mtrnmp = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f;
-#line 195 ""
+#line 200 ""
mtrdnp = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f;
-#line 196 ""
+#line 201 ""
xmtrnum0 = readin_(line, &iccount, &c__0, (ftnlen)128);
-#line 197 ""
+#line 202 ""
isig = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f;
-#line 198 ""
+#line 203 ""
npages = readin_(line, &iccount, &c__3, (ftnlen)128) + .1f;
-#line 199 ""
+#line 204 ""
all_1.nsyst = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f;
-#line 200 ""
+#line 205 ""
musicsize = readin_(line, &iccount, &c__4, (ftnlen)128) + .1f;
-#line 201 ""
+#line 206 ""
fracindent = readin_(line, &iccount, &c__5, (ftnlen)128);
-#line 202 ""
+#line 207 ""
if (npages == 0) {
-#line 203 ""
- s_wsle(&io___38);
-#line 203 ""
+#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 203 ""
+#line 208 ""
e_wsle();
-#line 205 ""
- s_wsle(&io___39);
-#line 205 ""
+#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 205 ""
+#line 210 ""
e_wsle();
-#line 207 ""
- s_wsle(&io___40);
-#line 207 ""
+#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 207 ""
+#line 212 ""
e_wsle();
-#line 209 ""
+#line 214 ""
s_stop("", (ftnlen)0);
-#line 210 ""
+#line 215 ""
}
/* Must leave insetup=.true. else could bypass ALL instrument names. */
-#line 214 ""
- s_rsfe(&io___41);
-#line 214 ""
+#line 219 ""
+ s_rsfe(&io___42);
+#line 219 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 214 ""
+#line 219 ""
e_rsfe();
-#line 215 ""
- chkcom_(line, (ftnlen)128);
-#line 216 ""
+#line 220 ""
+ chkcom_(line, &goto999, (ftnlen)128);
+#line 221 ""
al__1.aerr = 0;
-#line 216 ""
+#line 221 ""
al__1.aunit = 10;
-#line 216 ""
+#line 221 ""
f_back(&al__1);
/* Normally this puts pointer at start of line with 1st inst name */
/* Check if prior line was "%%" */
-#line 221 ""
+#line 226 ""
al__1.aerr = 0;
-#line 221 ""
+#line 226 ""
al__1.aunit = 10;
-#line 221 ""
+#line 226 ""
f_back(&al__1);
-#line 222 ""
- s_rsfe(&io___42);
-#line 222 ""
+#line 227 ""
+ s_rsfe(&io___43);
+#line 227 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 222 ""
+#line 227 ""
e_rsfe();
-#line 223 ""
+#line 228 ""
if (s_cmp(line, "%%", (ftnlen)2, (ftnlen)2) == 0) {
-#line 223 ""
+#line 228 ""
al__1.aerr = 0;
-#line 223 ""
+#line 228 ""
al__1.aunit = 10;
-#line 223 ""
+#line 228 ""
f_back(&al__1);
-#line 223 ""
+#line 228 ""
}
-#line 224 ""
+#line 229 ""
i__1 = all_1.noinst;
-#line 224 ""
+#line 229 ""
for (iv = 1; iv <= i__1; ++iv) {
-#line 225 ""
+#line 230 ""
gotname = FALSE_;
-#line 226 ""
+#line 231 ""
L16:
-#line 226 ""
- s_rsfe(&io___44);
-#line 226 ""
+#line 231 ""
+ s_rsfe(&io___45);
+#line 231 ""
do_fio(&c__1, instrum + (iv - 1 << 7), (ftnlen)128);
-#line 226 ""
+#line 231 ""
e_rsfe();
-#line 227 ""
+#line 232 ""
if (s_cmp(instrum + (iv - 1 << 7), "%%", (ftnlen)2, (ftnlen)2) == 0) {
-#line 228 ""
- s_rsfe(&io___46);
-#line 228 ""
+#line 233 ""
+ s_rsfe(&io___47);
+#line 233 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 228 ""
+#line 233 ""
e_rsfe();
-#line 229 ""
+#line 234 ""
goto L16;
-#line 230 ""
+#line 235 ""
} else if (*(unsigned char *)&instrum[(iv - 1) * 128] == '%') {
-#line 231 ""
+#line 236 ""
ivq = *(unsigned char *)&instrum[(iv - 1 << 7) + 1] - 48;
-#line 232 ""
+#line 237 ""
if (ivq != iv) {
/* It's really a comment. Copy to parts, then get another trial name. */
-#line 236 ""
+#line 241 ""
allparts_(instrum + (iv - 1 << 7), &c__128, (ftnlen)128);
-#line 237 ""
+#line 242 ""
goto L16;
-#line 238 ""
+#line 243 ""
} else {
-#line 239 ""
+#line 244 ""
s_copy(line, instrum + ((iv - 1 << 7) + 2), (ftnlen)128, (
ftnlen)126);
-#line 240 ""
+#line 245 ""
s_copy(instrum + (iv - 1 << 7), line, (ftnlen)128, (ftnlen)
128);
-#line 241 ""
+#line 246 ""
gotname = TRUE_;
-#line 242 ""
+#line 247 ""
}
-#line 243 ""
+#line 248 ""
} else {
-#line 244 ""
+#line 249 ""
gotname = TRUE_;
-#line 245 ""
+#line 250 ""
}
/* c */
/* c The following checks for macro that write original C-clef as part of */
@@ -740,117 +744,117 @@ L16:
/* * char(iy1+49)//char(iy2+49) */
/* instrum(iv) = instrum(iv)(inm1:inm2) */
/* end if */
-#line 260 ""
+#line 265 ""
if (! gotname) {
-#line 261 ""
- s_wsle(&io___48);
-#line 261 ""
+#line 266 ""
+ s_wsle(&io___49);
+#line 266 ""
do_lio(&c__9, &c__1, "You must provide a replacement instrument "\
"name", (ftnlen)46);
-#line 261 ""
+#line 266 ""
e_wsle();
-#line 262 ""
+#line 267 ""
s_stop("", (ftnlen)0);
-#line 263 ""
+#line 268 ""
}
-#line 264 ""
- io___49.ciunit = iv + 10;
-#line 264 ""
- s_wsfe(&io___49);
-#line 264 ""
+#line 269 ""
+ io___50.ciunit = iv + 10;
+#line 269 ""
+ s_wsfe(&io___50);
+#line 269 ""
do_fio(&c__1, " ", (ftnlen)1);
-#line 264 ""
+#line 269 ""
e_wsfe();
-#line 265 ""
+#line 270 ""
/* L14: */
-#line 265 ""
+#line 270 ""
}
-#line 266 ""
+#line 271 ""
all_1.replacing = FALSE_;
-#line 267 ""
+#line 272 ""
all_1.nvnow = nv;
/* Clef string: Note insetup is still T, so "%%" will be treated specially */
-#line 271 ""
- s_rsfe(&io___50);
-#line 271 ""
+#line 276 ""
+ s_rsfe(&io___51);
+#line 276 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 271 ""
+#line 276 ""
e_rsfe();
-#line 272 ""
- chkcom_(line, (ftnlen)128);
-#line 273 ""
+#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 278 ""
- s_rsfe(&io___51);
-#line 278 ""
+#line 283 ""
+ s_rsfe(&io___52);
+#line 283 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 278 ""
+#line 283 ""
e_rsfe();
-#line 279 ""
- chkcom_(line, (ftnlen)128);
-#line 280 ""
+#line 284 ""
+ chkcom_(line, &goto999, (ftnlen)128);
+#line 285 ""
al__1.aerr = 0;
-#line 280 ""
+#line 285 ""
al__1.aunit = 10;
-#line 280 ""
+#line 285 ""
f_back(&al__1);
-#line 281 ""
+#line 286 ""
} else {
/* If here, line has the clef string in it. Handle the old way */
-#line 285 ""
+#line 290 ""
kvstart = 1;
-#line 286 ""
+#line 291 ""
kvend = all_1.nvi[0];
-#line 287 ""
+#line 292 ""
i__1 = all_1.noinst;
-#line 287 ""
+#line 292 ""
for (inst = 1; inst <= i__1; ++inst) {
-#line 288 ""
+#line 293 ""
ci__1.cierr = 0;
-#line 288 ""
+#line 293 ""
ci__1.ciunit = inst + 10;
/* Writing concatenation */
-#line 288 ""
+#line 293 ""
i__4[0] = 2, a__2[0] = "(a";
-#line 288 ""
+#line 293 ""
*(unsigned char *)&ch__4[0] = all_1.nvi[inst - 1] + 48;
-#line 288 ""
+#line 293 ""
i__4[1] = 1, a__2[1] = ch__4;
-#line 288 ""
+#line 293 ""
i__4[2] = 1, a__2[2] = ")";
-#line 288 ""
+#line 293 ""
ci__1.cifmt = (s_cat(ch__3, a__2, i__4, &c__3, (ftnlen)4), ch__3);
-#line 288 ""
+#line 293 ""
s_wsfe(&ci__1);
-#line 288 ""
+#line 293 ""
do_fio(&c__1, line + (kvstart - 1), kvend - (kvstart - 1));
-#line 288 ""
+#line 293 ""
e_wsfe();
-#line 290 ""
+#line 295 ""
if (inst < all_1.noinst) {
-#line 291 ""
+#line 296 ""
kvstart = kvend + 1;
-#line 292 ""
+#line 297 ""
kvend = kvstart + all_1.nvi[inst] - 1;
-#line 293 ""
+#line 298 ""
}
-#line 294 ""
+#line 299 ""
/* L2: */
-#line 294 ""
+#line 299 ""
}
-#line 295 ""
+#line 300 ""
}
-#line 296 ""
+#line 301 ""
all_1.replacing = FALSE_;
-#line 297 ""
+#line 302 ""
all_1.insetup = FALSE_;
/* *****NOTE*****This comment applies to stuff done earlier! */
@@ -861,50 +865,50 @@ L16:
/* Path string: ASSUME THIS WILL NEVER BE ALTERED IN PARTS! */
-#line 307 ""
+#line 312 ""
L18:
-#line 307 ""
- s_rsfe(&io___55);
-#line 307 ""
+#line 312 ""
+ s_rsfe(&io___56);
+#line 312 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 307 ""
+#line 312 ""
e_rsfe();
-#line 308 ""
+#line 313 ""
if (*(unsigned char *)line == '%') {
-#line 309 ""
+#line 314 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 310 ""
+#line 315 ""
goto L18;
-#line 311 ""
+#line 316 ""
}
-#line 312 ""
+#line 317 ""
allparts_(line, &c__128, (ftnlen)128);
/* Write instrument names. Will be blank if later part of a score. */
-#line 316 ""
+#line 321 ""
if (*(unsigned char *)&instrum[0] != ' ') {
-#line 317 ""
+#line 322 ""
i__1 = all_1.noinst;
-#line 317 ""
+#line 322 ""
for (iv = 1; iv <= i__1; ++iv) {
-#line 318 ""
+#line 323 ""
len = lenstr_(instrum + (iv - 1 << 7), &c__79, (ftnlen)128);
-#line 319 ""
- io___57.ciunit = iv + 10;
-#line 319 ""
- s_wsfe(&io___57);
-#line 319 ""
+#line 324 ""
+ io___58.ciunit = iv + 10;
+#line 324 ""
+ s_wsfe(&io___58);
+#line 324 ""
do_fio(&c__1, "Ti", (ftnlen)2);
-#line 319 ""
+#line 324 ""
do_fio(&c__1, instrum + (iv - 1 << 7), len);
-#line 319 ""
+#line 324 ""
e_wsfe();
-#line 320 ""
+#line 325 ""
/* L3: */
-#line 320 ""
+#line 325 ""
}
-#line 321 ""
+#line 326 ""
}
/* The big loop. Except for '%%', put all comment lines in all parts. */
@@ -917,475 +921,481 @@ L18:
/* Check for "P"; ignore in parts. */
/* Check for consecutive full-bar rests; if found, replace with rm[nn] */
-#line 333 ""
+#line 338 ""
iv = 1;
-#line 334 ""
+#line 339 ""
iinst = 1;
-#line 335 ""
+#line 340 ""
termrpt = FALSE_;
-#line 336 ""
+#line 341 ""
L4:
-#line 336 ""
- i__1 = s_rsfe(&io___59);
-#line 336 ""
+#line 342 ""
+ i__1 = s_rsfe(&io___60);
+#line 342 ""
if (i__1 != 0) {
-#line 336 ""
+#line 342 ""
goto L999;
-#line 336 ""
+#line 342 ""
}
-#line 336 ""
+#line 342 ""
i__1 = do_fio(&c__1, line, (ftnlen)128);
-#line 336 ""
+#line 342 ""
if (i__1 != 0) {
-#line 336 ""
+#line 342 ""
goto L999;
-#line 336 ""
+#line 342 ""
}
-#line 336 ""
+#line 342 ""
i__1 = e_rsfe();
-#line 336 ""
+#line 342 ""
if (i__1 != 0) {
-#line 336 ""
+#line 342 ""
goto L999;
-#line 336 ""
+#line 342 ""
}
-#line 337 ""
+#line 343 ""
lenline = lenstr_(line, &c__128, (ftnlen)128);
-#line 338 ""
+#line 344 ""
if (lenline == 0) {
-#line 338 ""
+#line 344 ""
goto L4;
-#line 338 ""
+#line 344 ""
}
-#line 339 ""
+#line 345 ""
zapbl_(line, &c__128, (ftnlen)128);
-#line 340 ""
- chkcom_(line, (ftnlen)128);
-#line 341 ""
+#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 342 ""
+#line 349 ""
if (lenline == 0) {
-#line 342 ""
+#line 349 ""
goto L4;
-#line 342 ""
+#line 349 ""
}
-#line 343 ""
+#line 350 ""
if (*(unsigned char *)line == 'T') {
-#line 344 ""
+#line 351 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 345 ""
- s_rsfe(&io___61);
-#line 345 ""
+#line 352 ""
+ s_rsfe(&io___62);
+#line 352 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 345 ""
+#line 352 ""
e_rsfe();
-#line 346 ""
+#line 353 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 347 ""
+#line 354 ""
goto L4;
-#line 348 ""
+#line 355 ""
} else /* if(complicated condition) */ {
/* Writing concatenation */
-#line 348 ""
+#line 355 ""
i__3[0] = 1, a__1[0] = sq;
-#line 348 ""
+#line 355 ""
i__3[1] = 1, a__1[1] = sq;
-#line 348 ""
+#line 355 ""
s_cat(ch__5, a__1, i__3, &c__2, (ftnlen)2);
-#line 348 ""
+#line 355 ""
if (s_cmp(line, ch__5, (ftnlen)2, (ftnlen)2) == 0) {
-#line 349 ""
+#line 356 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 350 ""
+#line 357 ""
goto L4;
-#line 351 ""
+#line 358 ""
} else if (i_indx("hl", line, (ftnlen)2, (ftnlen)1) > 0 && i_indx(
" +-", line + 1, (ftnlen)3, (ftnlen)1) > 0) {
-#line 353 ""
+#line 360 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 354 ""
- s_rsfe(&io___62);
-#line 354 ""
+#line 361 ""
+ s_rsfe(&io___63);
+#line 361 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 354 ""
+#line 361 ""
e_rsfe();
-#line 355 ""
+#line 362 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 356 ""
+#line 363 ""
goto L4;
-#line 357 ""
+#line 364 ""
} else if (iv == 1) {
-#line 358 ""
+#line 365 ""
for (ia = 1; ia <= 10; ++ia) {
-#line 359 ""
+#line 366 ""
L24:
-#line 360 ""
+#line 367 ""
idxa = ntindex_(line, achar + (ia - 1), (ftnlen)128, (ftnlen)
1);
-#line 361 ""
+#line 368 ""
isachar = idxa > 0;
-#line 362 ""
+#line 369 ""
if (idxa > 1) {
-#line 362 ""
+#line 369 ""
i__1 = idxa - 2;
-#line 362 ""
+#line 369 ""
isachar = s_cmp(line + i__1, " ", idxa - 1 - i__1, (
ftnlen)1) == 0;
-#line 362 ""
+#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 367 ""
+#line 374 ""
if (ia == 9) {
-#line 367 ""
+#line 374 ""
i__1 = idxa;
-#line 367 ""
+#line 374 ""
isachar = isachar && s_cmp(line + i__1, "S", idxa + 1 -
i__1, (ftnlen)1) == 0;
-#line 367 ""
+#line 374 ""
}
-#line 369 ""
+#line 376 ""
if (isachar) {
/* Check whether character is inside a quoted string by counting */
/* how many quotes precede it in the line */
-#line 375 ""
+#line 382 ""
oddquotesbefore_(line, &idxa, &yesodd, (ftnlen)128);
-#line 376 ""
+#line 383 ""
if (yesodd) {
-#line 376 ""
+#line 383 ""
isachar = FALSE_;
-#line 376 ""
+#line 383 ""
}
-#line 377 ""
+#line 384 ""
}
-#line 378 ""
+#line 385 ""
if (isachar) {
/* Find next blank */
-#line 382 ""
+#line 389 ""
for (ib = idxa + 1; ib <= 128; ++ib) {
-#line 383 ""
+#line 390 ""
if (*(unsigned char *)&line[ib - 1] == ' ') {
-#line 383 ""
+#line 390 ""
goto L7;
-#line 383 ""
+#line 390 ""
}
-#line 384 ""
+#line 391 ""
/* L6: */
-#line 384 ""
+#line 391 ""
}
-#line 385 ""
- s_wsle(&io___68);
-#line 385 ""
+#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 385 ""
+#line 392 ""
e_wsle();
-#line 386 ""
- s_wsle(&io___69);
-#line 386 ""
+#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 386 ""
+#line 393 ""
e_wsle();
-#line 388 ""
+#line 395 ""
s_stop("1", (ftnlen)1);
-#line 389 ""
+#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 394 ""
+#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 399 ""
+#line 406 ""
for (ic = ib + 1; ic <= 128; ++ic) {
/* If any subsequent character on this line is neither blank nor "/", get out */
-#line 403 ""
+#line 410 ""
if (i_indx(" /", line + (ic - 1), (ftnlen)2, (
ftnlen)1) == 0) {
-#line 403 ""
+#line 410 ""
goto L9;
-#line 403 ""
+#line 410 ""
}
-#line 404 ""
+#line 411 ""
if (*(unsigned char *)&line[ic - 1] == '/') {
-#line 405 ""
+#line 412 ""
termrpt = TRUE_;
-#line 406 ""
+#line 413 ""
i__1 = ib - 3;
-#line 406 ""
+#line 413 ""
s_copy(termsym, line + i__1, (ftnlen)2, ib -
1 - i__1);
/* Process the line as if there were no "R" */
-#line 410 ""
+#line 417 ""
goto L10;
-#line 411 ""
+#line 418 ""
}
-#line 412 ""
+#line 419 ""
/* L8: */
-#line 412 ""
+#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 418 ""
- s_rsfe(&io___72);
-#line 418 ""
+#line 425 ""
+ s_rsfe(&io___73);
+#line 425 ""
do_fio(&c__1, templine, (ftnlen)128);
-#line 418 ""
+#line 425 ""
e_rsfe();
-#line 419 ""
+#line 426 ""
if (s_cmp(templine, " /", (ftnlen)2, (ftnlen)2) != 0)
{
-#line 420 ""
+#line 427 ""
al__1.aerr = 0;
-#line 420 ""
+#line 427 ""
al__1.aunit = 10;
-#line 420 ""
+#line 427 ""
f_back(&al__1);
/* and flow out */
-#line 421 ""
+#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 426 ""
+#line 433 ""
i__3[0] = ib, a__1[0] = line;
-#line 426 ""
+#line 433 ""
i__3[1] = 1, a__1[1] = "/";
-#line 426 ""
+#line 433 ""
s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
-#line 427 ""
+#line 434 ""
lenline += 2;
-#line 428 ""
+#line 435 ""
termrpt = TRUE_;
-#line 429 ""
+#line 436 ""
i__1 = ib - 3;
-#line 429 ""
+#line 436 ""
s_copy(termsym, line + i__1, (ftnlen)2, ib - 1 -
i__1);
-#line 430 ""
+#line 437 ""
goto L10;
-#line 431 ""
+#line 438 ""
}
/* +++ 060812 */
-#line 434 ""
+#line 441 ""
} else if (ia == 1) {
-#line 435 ""
+#line 442 ""
idxq = ntindex_(line, "\"", (ftnlen)128, (ftnlen)1);
-#line 436 ""
+#line 443 ""
if (idxq > idxa && idxq < ib) {
/* Quote is between P and next blank. Find 2nd quote, starting at the blank. */
-#line 440 ""
+#line 447 ""
idxq2 = ib - 1 + ntindex_(line, "\"", (ftnlen)128,
(ftnlen)1);
-#line 441 ""
+#line 448 ""
i__1 = idxq2;
-#line 441 ""
+#line 448 ""
if (idxq == 0 || s_cmp(line + i__1, " ", idxq2 +
1 - i__1, (ftnlen)1) != 0) {
-#line 442 ""
- s_wsle(&io___76);
-#line 442 ""
- e_wsle();
-#line 443 ""
+#line 449 ""
s_wsle(&io___77);
-#line 443 ""
+#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 443 ""
+#line 450 ""
do_lio(&c__3, &c__1, (char *)&idxq2, (ftnlen)
sizeof(integer));
-#line 443 ""
+#line 450 ""
e_wsle();
-#line 444 ""
- s_wsle(&io___78);
-#line 444 ""
+#line 451 ""
+ s_wsle(&io___79);
+#line 451 ""
do_lio(&c__9, &c__1, line, (ftnlen)60);
-#line 444 ""
+#line 451 ""
e_wsle();
-#line 445 ""
+#line 452 ""
s_stop("1", (ftnlen)1);
-#line 446 ""
+#line 453 ""
}
-#line 447 ""
+#line 454 ""
ib = idxq2 + 1;
-#line 448 ""
+#line 455 ""
}
/* Do not transfer P into parts. */
-#line 452 ""
+#line 459 ""
goto L12;
-#line 453 ""
+#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 458 ""
+#line 465 ""
i__1 = ib;
-#line 458 ""
+#line 465 ""
ndxm = i_indx(line + i__1, "M", 128 - i__1, (ftnlen)1)
;
-#line 459 ""
+#line 466 ""
i__1 = ib + ndxm - 2;
-#line 459 ""
+#line 466 ""
if (ndxm > 0 && s_cmp(line + i__1, " ", ib + ndxm - 1
- i__1, (ftnlen)1) == 0) {
/* Macro ends on this line */
-#line 463 ""
+#line 470 ""
ib = ib + ndxm + 1;
-#line 464 ""
+#line 471 ""
} else {
/* Save leading part of current line */
-#line 468 ""
+#line 475 ""
lenhold = idxa - 1;
-#line 469 ""
+#line 476 ""
if (lenhold > 0) {
-#line 469 ""
+#line 476 ""
s_copy(holdln, line, (ftnlen)128, lenhold);
-#line 469 ""
+#line 476 ""
}
/* Transfer rest of line */
-#line 473 ""
+#line 480 ""
i__1 = 129 - idxa;
-#line 473 ""
+#line 480 ""
allparts_(line + (idxa - 1), &i__1, 128 - (idxa -
1));
/* Read next line */
-#line 477 ""
+#line 484 ""
L20:
-#line 477 ""
- s_rsfe(&io___81);
-#line 477 ""
+#line 484 ""
+ s_rsfe(&io___82);
+#line 484 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 477 ""
+#line 484 ""
e_rsfe();
/* Check for comment, transfer and loop if so */
/* if (line(1:1) .eq.'%') then */
-#line 482 ""
+#line 489 ""
L23:
-#line 482 ""
+#line 489 ""
if (*(unsigned char *)line == '%') {
/* call allparts(line,128) */
/* go to 20 */
-#line 485 ""
- chkcom_(line, (ftnlen)128);
-#line 486 ""
+#line 492 ""
+ chkcom_(line, &goto999, (ftnlen)128);
+#line 493 ""
goto L23;
-#line 487 ""
+#line 494 ""
}
/* Look for terminal ' M' */
-#line 491 ""
+#line 498 ""
if (*(unsigned char *)line == 'M') {
-#line 492 ""
+#line 499 ""
ndxm = 1;
-#line 493 ""
+#line 500 ""
} else {
-#line 494 ""
+#line 501 ""
ndxm = i_indx(line, " M", (ftnlen)128, (
ftnlen)2);
-#line 495 ""
+#line 502 ""
if (ndxm > 0) {
-#line 495 ""
+#line 502 ""
++ndxm;
-#line 495 ""
+#line 502 ""
}
-#line 496 ""
+#line 503 ""
}
-#line 497 ""
+#line 504 ""
if (ndxm > 0) {
/* Set parameters, exit normally (but later check for leading part of 1st line */
-#line 501 ""
+#line 508 ""
idxa = 1;
-#line 502 ""
+#line 509 ""
ib = ndxm + 1;
-#line 503 ""
+#line 510 ""
} else {
/* No "M", transfer entire line, loop */
-#line 507 ""
+#line 514 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 508 ""
+#line 515 ""
goto L20;
-#line 509 ""
+#line 516 ""
}
-#line 510 ""
+#line 517 ""
}
-#line 511 ""
+#line 518 ""
} else if (ia == 10) {
/* Do not transfer MIDI command into parts */
-#line 515 ""
+#line 522 ""
goto L12;
-#line 516 ""
+#line 523 ""
} else if (ia == 5) {
/* First check for "AS", but S may come after other "A" options */
-#line 520 ""
+#line 527 ""
i__1 = idxa;
-#line 520 ""
+#line 527 ""
idxs = i_indx(line + i__1, "S", ib - i__1, (ftnlen)1);
-#line 521 ""
+#line 528 ""
if (idxs > 0) {
/* Get rid of the string. First check if that's all there is in A. */
-#line 525 ""
+#line 532 ""
if (ib - idxa == nv + 2) {
-#line 525 ""
+#line 532 ""
goto L12;
-#line 525 ""
+#line 532 ""
}
-#line 526 ""
+#line 533 ""
i__1 = idxa + idxs + nv;
/* Writing concatenation */
-#line 526 ""
+#line 533 ""
i__3[0] = idxa + idxs - 1, a__1[0] = line;
-#line 526 ""
+#line 533 ""
i__3[1] = ib - i__1, a__1[1] = line + i__1;
-#line 526 ""
+#line 533 ""
s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
-#line 527 ""
+#line 534 ""
}
/* Check for user-defined part file name. Must start in column 1 and have */
@@ -1394,353 +1404,353 @@ L23:
/* ib is position of the next blank after "A" */
/* Don't allow any blanks in user */
-#line 535 ""
+#line 542 ""
i__1 = idxa;
-#line 535 ""
+#line 542 ""
if (s_cmp(line + i__1, "N", idxa + 1 - i__1, (ftnlen)
1) != 0) {
-#line 535 ""
+#line 542 ""
goto L9;
-#line 535 ""
+#line 542 ""
}
/* bail out */
-#line 536 ""
+#line 543 ""
if (idxa != 1) {
-#line 537 ""
- s_wsle(&io___83);
-#line 537 ""
- e_wsle();
-#line 538 ""
+#line 544 ""
s_wsle(&io___84);
-#line 538 ""
+#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 538 ""
+#line 545 ""
e_wsle();
-#line 540 ""
+#line 547 ""
s_stop("1", (ftnlen)1);
-#line 541 ""
+#line 548 ""
}
/* pmxa already checked for valid one- or 2-digit number, so get it */
-#line 545 ""
+#line 552 ""
if (*(unsigned char *)&line[3] == '"') {
/* Single digit instrument number */
-#line 549 ""
- s_rsfi(&io___85);
-#line 549 ""
+#line 556 ""
+ s_rsfi(&io___86);
+#line 556 ""
do_fio(&c__1, (char *)&iudpfn, (ftnlen)sizeof(
integer));
-#line 549 ""
+#line 556 ""
e_rsfi();
-#line 550 ""
+#line 557 ""
idxstartname = 5;
-#line 551 ""
+#line 558 ""
} else {
-#line 552 ""
- s_rsfi(&io___88);
-#line 552 ""
+#line 559 ""
+ s_rsfi(&io___89);
+#line 559 ""
do_fio(&c__1, (char *)&iudpfn, (ftnlen)sizeof(
integer));
-#line 552 ""
+#line 559 ""
e_rsfi();
-#line 553 ""
+#line 560 ""
idxstartname = 6;
-#line 554 ""
+#line 561 ""
}
-#line 555 ""
+#line 562 ""
ludpfn[iudpfn - 1] = i_indx(line + (idxstartname - 1),
"\"", 128 - (idxstartname - 1), (ftnlen)1) -
1;
-#line 556 ""
+#line 563 ""
if (ludpfn[iudpfn - 1] < 0) {
-#line 557 ""
- s_wsle(&io___89);
-#line 557 ""
- e_wsle();
-#line 558 ""
+#line 564 ""
s_wsle(&io___90);
-#line 558 ""
+#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 558 ""
+#line 565 ""
e_wsle();
-#line 559 ""
+#line 566 ""
s_stop("1", (ftnlen)1);
-#line 560 ""
+#line 567 ""
}
-#line 561 ""
+#line 568 ""
idxendname = idxstartname + ludpfn[iudpfn - 1] - 1;
-#line 562 ""
+#line 569 ""
s_copy(udpfnq + (iudpfn - 1 << 7), line + (
idxstartname - 1), (ftnlen)128, idxendname - (
idxstartname - 1));
/* Get a new line! */
-#line 566 ""
+#line 573 ""
goto L4;
-#line 567 ""
+#line 574 ""
} else if (ia == 8) {
/* Key change/transposition. */
/* If not instrument specific, copy to all parts */
-#line 572 ""
+#line 579 ""
i__1 = idxa;
-#line 572 ""
+#line 579 ""
if (s_cmp(line + i__1, "i", idxa + 1 - i__1, (ftnlen)
1) != 0) {
-#line 572 ""
+#line 579 ""
goto L9;
-#line 572 ""
+#line 579 ""
}
/* Instrument-wise key/transposition(s): Ki[nn][+/-][dd}[+/-][dd]... */
-#line 576 ""
+#line 583 ""
ibb = idxa + 2;
/* Starts on digit after 'i' */
-#line 577 ""
+#line 584 ""
L40:
-#line 578 ""
+#line 585 ""
ici__1.icierr = 0;
-#line 578 ""
+#line 585 ""
ici__1.iciend = 0;
-#line 578 ""
+#line 585 ""
ici__1.icirnum = 1;
-#line 578 ""
+#line 585 ""
ici__1.icirlen = 1;
-#line 578 ""
+#line 585 ""
ici__1.iciunit = line + (ibb - 1);
-#line 578 ""
+#line 585 ""
ici__1.icifmt = "(i1)";
-#line 578 ""
+#line 585 ""
s_rsfi(&ici__1);
-#line 578 ""
+#line 585 ""
do_fio(&c__1, (char *)&iiinst, (ftnlen)sizeof(integer)
);
-#line 578 ""
+#line 585 ""
e_rsfi();
/* 1st digit of iinst */
-#line 579 ""
+#line 586 ""
i__1 = ibb;
-#line 579 ""
+#line 586 ""
itemp = i_indx("01234567890", line + i__1, (ftnlen)11,
ibb + 1 - i__1);
-#line 580 ""
+#line 587 ""
if (itemp > 0) {
-#line 581 ""
+#line 588 ""
++ibb;
-#line 582 ""
+#line 589 ""
iiinst = iiinst * 10 + itemp - 1;
-#line 583 ""
+#line 590 ""
}
-#line 584 ""
+#line 591 ""
++ibb;
/* now at first +/-. Need end of 2nd number */
-#line 585 ""
+#line 592 ""
i__1 = ibb;
-#line 585 ""
+#line 592 ""
itemp = i_indx(line + i__1, "i", ib - i__1, (ftnlen)1)
;
/* Rel pos'n of next 'i' */
-#line 586 ""
+#line 593 ""
if (itemp > 0) {
-#line 587 ""
+#line 594 ""
iend = ibb + itemp - 1;
-#line 588 ""
+#line 595 ""
} else {
-#line 589 ""
+#line 596 ""
iend = ib - 1;
-#line 590 ""
+#line 597 ""
}
-#line 591 ""
- io___97.ciunit = all_1.iorig[iiinst - 1] + 10;
-#line 591 ""
- s_wsfe(&io___97);
+#line 598 ""
+ io___98.ciunit = all_1.iorig[iiinst - 1] + 10;
+#line 598 ""
+ s_wsfe(&io___98);
/* Writing concatenation */
-#line 591 ""
+#line 598 ""
i__3[0] = 3, a__1[0] = "Ki1";
-#line 591 ""
+#line 598 ""
i__3[1] = iend - (ibb - 1), a__1[1] = line + (ibb - 1)
;
-#line 591 ""
+#line 598 ""
s_cat(ch__6, a__1, i__3, &c__2, (ftnlen)131);
-#line 591 ""
+#line 598 ""
do_fio(&c__1, ch__6, iend - (ibb - 1) + 3);
-#line 591 ""
+#line 598 ""
e_wsfe();
-#line 592 ""
+#line 599 ""
if (itemp > 0) {
-#line 593 ""
+#line 600 ""
ibb = iend + 2;
-#line 594 ""
+#line 601 ""
goto L40;
-#line 595 ""
+#line 602 ""
}
-#line 596 ""
+#line 603 ""
goto L12;
/* Remove K command from string, go to next ia */
-#line 597 ""
+#line 604 ""
}
-#line 598 ""
+#line 605 ""
L9:
-#line 599 ""
+#line 606 ""
i__1 = ib - idxa;
-#line 599 ""
+#line 606 ""
allparts_(line + (idxa - 1), &i__1, ib - 1 - (idxa - 1));
-#line 600 ""
+#line 607 ""
L12:
/* Remove the string from line */
-#line 604 ""
+#line 611 ""
if (idxa == 1) {
-#line 605 ""
+#line 612 ""
s_copy(line, line + (ib - 1), (ftnlen)128, 128 - (ib
- 1));
-#line 606 ""
+#line 613 ""
} else {
/* Writing concatenation */
-#line 607 ""
+#line 614 ""
i__3[0] = idxa - 1, a__1[0] = line;
-#line 607 ""
+#line 614 ""
i__3[1] = 128 - (ib - 1), a__1[1] = line + (ib - 1);
-#line 607 ""
+#line 614 ""
s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
-#line 608 ""
+#line 615 ""
}
-#line 609 ""
+#line 616 ""
lenline = lenstr_(line, &c__128, (ftnlen)128);
/* Loop if only blanks are left */
-#line 613 ""
+#line 620 ""
if (lenline == 0) {
-#line 613 ""
+#line 620 ""
goto L4;
-#line 613 ""
+#line 620 ""
}
/* Must check for multiple "I" commands, so go to just after start of ia loop */
-#line 617 ""
+#line 624 ""
if (ia == 10) {
-#line 617 ""
+#line 624 ""
goto L24;
-#line 617 ""
+#line 624 ""
}
/* Tack on front part from 1st line of saved macro */
-#line 621 ""
+#line 628 ""
if (lenhold > 0) {
/* Writing concatenation */
-#line 622 ""
+#line 629 ""
i__4[0] = lenhold, a__2[0] = holdln;
-#line 622 ""
+#line 629 ""
i__4[1] = 1, a__2[1] = " ";
-#line 622 ""
+#line 629 ""
i__4[2] = lenline, a__2[2] = line;
-#line 622 ""
+#line 629 ""
s_cat(line, a__2, i__4, &c__3, (ftnlen)128);
-#line 623 ""
+#line 630 ""
lenhold = 0;
-#line 624 ""
+#line 631 ""
}
-#line 625 ""
+#line 632 ""
}
-#line 626 ""
+#line 633 ""
/* L5: */
-#line 626 ""
+#line 633 ""
}
-#line 627 ""
+#line 634 ""
}
-#line 627 ""
+#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 633 ""
+#line 640 ""
L10:
-#line 634 ""
+#line 641 ""
nchk = 1;
-#line 635 ""
+#line 642 ""
L13:
-#line 635 ""
+#line 642 ""
ntinx = nchk - 1 + ntindex_(line + (nchk - 1), "X", 128 - (nchk - 1), (
ftnlen)1);
-#line 636 ""
+#line 643 ""
if (ntinx > nchk - 1) {
/* There is a non-TeX 'X' at ntinx. Loop if neither 1st nor after a blank. */
-#line 640 ""
+#line 647 ""
if (ntinx > 1) {
-#line 641 ""
+#line 648 ""
i__1 = ntinx - 2;
-#line 641 ""
+#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 645 ""
+#line 652 ""
nchk = ntinx + 1;
-#line 646 ""
+#line 653 ""
goto L13;
-#line 647 ""
+#line 654 ""
}
-#line 648 ""
+#line 655 ""
}
/* We now know the X at ntinx starts a PMX command. Find next blank */
-#line 652 ""
+#line 659 ""
i__1 = ntinx;
-#line 652 ""
+#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 657 ""
+#line 664 ""
i__1 = ntinx;
-#line 657 ""
+#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 662 ""
+#line 669 ""
if (locp > ntinx) {
/* Strip out the 'P' */
-#line 666 ""
+#line 673 ""
s_copy(templine, line, (ftnlen)128, locp - 1);
-#line 667 ""
+#line 674 ""
i__1 = locp;
/* Writing concatenation */
-#line 667 ""
+#line 674 ""
i__3[0] = locp - 1, a__1[0] = templine;
-#line 667 ""
+#line 674 ""
i__3[1] = lenline - i__1, a__1[1] = line + i__1;
-#line 667 ""
+#line 674 ""
s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
-#line 668 ""
+#line 675 ""
--lenline;
-#line 669 ""
+#line 676 ""
--ib;
-#line 670 ""
+#line 677 ""
}
-#line 671 ""
+#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), (
@@ -1748,177 +1758,177 @@ L13:
/* The X command is a shift, "Both", or "Part". Do not remove. */
-#line 677 ""
+#line 684 ""
nchk = ib + 1;
-#line 678 ""
+#line 685 ""
goto L13;
-#line 679 ""
+#line 686 ""
}
/* Remove the X command. */
-#line 683 ""
+#line 690 ""
if (ntinx == 1) {
-#line 684 ""
+#line 691 ""
if (ib < lenline) {
-#line 685 ""
+#line 692 ""
i__1 = ib;
-#line 685 ""
+#line 692 ""
s_copy(line, line + i__1, (ftnlen)128, lenline - i__1);
-#line 686 ""
+#line 693 ""
} else {
/* line contains ONLY the "X" command, so get a new line */
-#line 690 ""
+#line 697 ""
goto L4;
-#line 691 ""
+#line 698 ""
}
-#line 692 ""
+#line 699 ""
} else {
-#line 693 ""
+#line 700 ""
s_copy(templine, line, (ftnlen)128, ntinx - 1);
-#line 694 ""
+#line 701 ""
if (ib < lenline) {
-#line 695 ""
+#line 702 ""
i__1 = ib;
/* Writing concatenation */
-#line 695 ""
+#line 702 ""
i__3[0] = ntinx - 1, a__1[0] = templine;
-#line 695 ""
+#line 702 ""
i__3[1] = lenline - i__1, a__1[1] = line + i__1;
-#line 695 ""
+#line 702 ""
s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
-#line 696 ""
+#line 703 ""
} else {
-#line 697 ""
+#line 704 ""
s_copy(line, templine, (ftnlen)128, ntinx - 1);
-#line 698 ""
+#line 705 ""
}
-#line 699 ""
+#line 706 ""
}
/* Recompute lenline */
-#line 703 ""
+#line 710 ""
lenline = lenstr_(line, &c__128, (ftnlen)128);
/* Resume checking after location of removed command. */
-#line 707 ""
+#line 714 ""
nchk = ntinx;
-#line 708 ""
+#line 715 ""
goto L13;
-#line 709 ""
+#line 716 ""
}
/* End of loop for X-checks */
-#line 713 ""
+#line 720 ""
oneof2 = ntindex_(line, "//", (ftnlen)128, (ftnlen)2) > 0;
-#line 714 ""
+#line 721 ""
if (termrpt && all_1.botv[iv - 1] && frstln && *(unsigned char *)&line[
lenline - 1] == '/') {
/* Must add a terminal repeat before the slash */
-#line 719 ""
+#line 726 ""
if (oneof2) {
-#line 719 ""
+#line 726 ""
--lenline;
-#line 719 ""
+#line 726 ""
}
-#line 720 ""
+#line 727 ""
if (lenline > 1) {
-#line 720 ""
- io___102.ciunit = all_1.iorig[iinst - 1] + 10;
-#line 720 ""
- s_wsfe(&io___102);
-#line 720 ""
+#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 720 ""
+#line 727 ""
e_wsfe();
-#line 720 ""
+#line 727 ""
}
-#line 721 ""
+#line 728 ""
if (! oneof2) {
/* Writing concatenation */
-#line 722 ""
+#line 729 ""
i__3[0] = 2, a__1[0] = termsym;
-#line 722 ""
+#line 729 ""
i__3[1] = 2, a__1[1] = " /";
-#line 722 ""
+#line 729 ""
s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
-#line 723 ""
+#line 730 ""
lenline = 4;
-#line 724 ""
+#line 731 ""
} else {
/* Writing concatenation */
-#line 725 ""
+#line 732 ""
i__3[0] = 2, a__1[0] = termsym;
-#line 725 ""
+#line 732 ""
i__3[1] = 3, a__1[1] = " //";
-#line 725 ""
+#line 732 ""
s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
-#line 726 ""
+#line 733 ""
lenline = 5;
-#line 727 ""
+#line 734 ""
}
-#line 728 ""
+#line 735 ""
}
-#line 729 ""
+#line 736 ""
if (termrpt && frstln && *(unsigned char *)&line[lenline - 1] == '/' &&
iv == all_1.nvnow) {
-#line 729 ""
+#line 736 ""
termrpt = FALSE_;
-#line 729 ""
+#line 736 ""
}
-#line 731 ""
- io___103.ciunit = all_1.iorig[iinst - 1] + 10;
-#line 731 ""
- s_wsfe(&io___103);
-#line 731 ""
+#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 731 ""
+#line 738 ""
e_wsfe();
-#line 732 ""
+#line 739 ""
if (oneof2) {
-#line 733 ""
+#line 740 ""
frstln = FALSE_;
-#line 734 ""
+#line 741 ""
} else if (! frstln) {
-#line 735 ""
+#line 742 ""
frstln = TRUE_;
-#line 736 ""
+#line 743 ""
}
/* if (ntindex(line,'/').gt.0 .and. index(line,'//').eq.0) then */
-#line 738 ""
+#line 745 ""
if (ntindex_(line, "/", (ftnlen)128, (ftnlen)1) > 0 && ntindex_(line,
"//", (ftnlen)128, (ftnlen)2) == 0) {
-#line 739 ""
+#line 746 ""
iv = iv % all_1.nvnow + 1;
-#line 740 ""
+#line 747 ""
iinst = all_1.instnum[iv - 1];
-#line 741 ""
+#line 748 ""
}
-#line 742 ""
+#line 749 ""
goto L4;
-#line 743 ""
+#line 750 ""
L999:
-#line 744 ""
+#line 751 ""
cl__1.cerr = 0;
-#line 744 ""
+#line 751 ""
cl__1.cunit = 10;
-#line 744 ""
+#line 751 ""
cl__1.csta = 0;
-#line 744 ""
+#line 751 ""
f_clos(&cl__1);
/* In the mbrest checks, must run through ALL noinst files (not just noinow) */
-#line 748 ""
+#line 755 ""
i__1 = all_1.noinst;
-#line 748 ""
+#line 755 ""
for (iinst = 1; iinst <= i__1; ++iinst) {
/* cc+++ */
/* c */
@@ -1938,28 +1948,28 @@ L999:
/* 51 continue */
/* close(40) */
/* cc+++ */
-#line 767 ""
+#line 774 ""
if (all_1.nvi[iinst - 1] == 1) {
-#line 768 ""
+#line 775 ""
mbrests_(&iinst, jobname, &ljob, &ludpfn[iinst - 1], udpfnq + (
iinst - 1 << 7), (ftnlen)27, (ftnlen)128);
-#line 769 ""
+#line 776 ""
} else {
/* Send a signal with ljob to bypass most mbrest processing */
-#line 773 ""
+#line 780 ""
i__2 = -ljob;
-#line 773 ""
+#line 780 ""
mbrests_(&iinst, jobname, &i__2, &ludpfn[iinst - 1], udpfnq + (
iinst - 1 << 7), (ftnlen)27, (ftnlen)128);
-#line 774 ""
+#line 781 ""
}
-#line 775 ""
+#line 782 ""
/* L11: */
-#line 775 ""
+#line 782 ""
}
-#line 776 ""
+#line 783 ""
return 0;
} /* MAIN__ */
@@ -1968,21 +1978,21 @@ integer lenstr_(char *string, integer *n, ftnlen string_len)
/* System generated locals */
integer ret_val;
-#line 779 ""
+#line 786 ""
for (ret_val = *n; ret_val >= 1; --ret_val) {
-#line 780 ""
+#line 787 ""
if (*(unsigned char *)&string[ret_val - 1] != ' ') {
-#line 780 ""
+#line 787 ""
return ret_val;
-#line 780 ""
+#line 787 ""
}
-#line 781 ""
+#line 788 ""
/* L1: */
-#line 781 ""
+#line 788 ""
}
-#line 782 ""
+#line 789 ""
ret_val = 0;
-#line 783 ""
+#line 790 ""
return ret_val;
} /* lenstr_ */
@@ -2000,36 +2010,36 @@ integer lenstr_(char *string, integer *n, ftnlen string_len)
extern integer lenstr_(char *, integer *, ftnlen);
/* Fortran I/O blocks */
- static cilist io___106 = { 0, 0, 0, "(a)", 0 };
+ static cilist io___107 = { 0, 0, 0, "(a)", 0 };
-#line 791 ""
+#line 798 ""
len = lenstr_(string, n, string_len);
-#line 792 ""
+#line 799 ""
if (len == 0) {
-#line 793 ""
+#line 800 ""
len = 1;
-#line 794 ""
+#line 801 ""
s_copy(string, " ", string_len, (ftnlen)1);
-#line 795 ""
+#line 802 ""
}
-#line 796 ""
+#line 803 ""
i__1 = all_1.noinow;
-#line 796 ""
+#line 803 ""
for (iinst = 1; iinst <= i__1; ++iinst) {
-#line 797 ""
- io___106.ciunit = all_1.iorig[iinst - 1] + 10;
-#line 797 ""
- s_wsfe(&io___106);
-#line 797 ""
+#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 797 ""
+#line 804 ""
e_wsfe();
-#line 798 ""
+#line 805 ""
/* L1: */
-#line 798 ""
+#line 805 ""
}
-#line 799 ""
+#line 806 ""
return 0;
} /* allparts_ */
@@ -2092,752 +2102,752 @@ integer lenstr_(char *string, integer *n, ftnlen string_len)
integer *, char *, integer *, ftnlen, ftnlen);
/* Fortran I/O blocks */
- static cilist io___113 = { 0, 0, 0, "(a)", 0 };
- static cilist io___116 = { 0, 40, 0, "(a)", 0 };
+ static cilist io___114 = { 0, 0, 0, "(a)", 0 };
static cilist io___117 = { 0, 40, 0, "(a)", 0 };
- static cilist io___118 = { 0, 6, 0, 0, 0 };
- static cilist io___121 = { 0, 0, 1, "(a)", 0 };
- static cilist io___122 = { 0, 40, 0, "(a)", 0 };
- static cilist io___123 = { 0, 0, 0, "(a)", 0 };
- static cilist io___124 = { 0, 40, 0, "(a)", 0 };
- static cilist io___144 = { 0, 0, 1, "(a)", 0 };
- static cilist io___145 = { 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, 6, 0, 0, 0 };
- static cilist io___152 = { 0, 40, 0, "(a)", 0 };
- static cilist io___154 = { 0, 6, 0, 0, 0 };
- static cilist io___156 = { 0, 40, 0, "(a)", 0 };
- static cilist io___158 = { 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 809 ""
+#line 816 ""
type4 = FALSE_;
-#line 810 ""
+#line 817 ""
*(unsigned char *)sq = '\\';
-#line 811 ""
+#line 818 ""
alldone = FALSE_;
-#line 812 ""
+#line 819 ""
al__1.aerr = 0;
-#line 812 ""
+#line 819 ""
al__1.aunit = *iv + 10;
-#line 812 ""
+#line 819 ""
f_rew(&al__1);
-#line 813 ""
+#line 820 ""
if (*iv < 10) {
-#line 814 ""
+#line 821 ""
*(unsigned char *)partq = (char) (*iv + 48);
-#line 815 ""
+#line 822 ""
lpart = 1;
-#line 816 ""
+#line 823 ""
} else {
-#line 817 ""
+#line 824 ""
lpart = 2;
-#line 818 ""
+#line 825 ""
if (*iv < 20) {
/* Writing concatenation */
-#line 819 ""
+#line 826 ""
i__1[0] = 1, a__1[0] = "1";
-#line 819 ""
+#line 826 ""
*(unsigned char *)&ch__1[0] = *iv + 38;
-#line 819 ""
+#line 826 ""
i__1[1] = 1, a__1[1] = ch__1;
-#line 819 ""
+#line 826 ""
s_cat(partq, a__1, i__1, &c__2, (ftnlen)2);
-#line 820 ""
+#line 827 ""
} else {
/* Writing concatenation */
-#line 821 ""
+#line 828 ""
i__1[0] = 1, a__1[0] = "2";
-#line 821 ""
+#line 828 ""
*(unsigned char *)&ch__1[0] = *iv + 28;
-#line 821 ""
+#line 828 ""
i__1[1] = 1, a__1[1] = ch__1;
-#line 821 ""
+#line 828 ""
s_cat(partq, a__1, i__1, &c__2, (ftnlen)2);
-#line 822 ""
+#line 829 ""
}
-#line 823 ""
+#line 830 ""
}
/* 130327 */
/* open(40,file=jobname(1:abs(ljob))//partq(1:lpart)//'.pmx') */
-#line 826 ""
+#line 833 ""
if (*ludpfn == 0) {
-#line 827 ""
+#line 834 ""
o__1.oerr = 0;
-#line 827 ""
+#line 834 ""
o__1.ounit = 40;
-#line 827 ""
+#line 834 ""
o__1.ofnmlen = abs(*ljob) + lpart + 4;
/* Writing concatenation */
-#line 827 ""
+#line 834 ""
i__2[0] = abs(*ljob), a__2[0] = jobname;
-#line 827 ""
+#line 834 ""
i__2[1] = lpart, a__2[1] = partq;
-#line 827 ""
+#line 834 ""
i__2[2] = 4, a__2[2] = ".pmx";
-#line 827 ""
+#line 834 ""
s_cat(ch__2, a__2, i__2, &c__3, (ftnlen)18);
-#line 827 ""
+#line 834 ""
o__1.ofnm = ch__2;
-#line 827 ""
+#line 834 ""
o__1.orl = 0;
-#line 827 ""
+#line 834 ""
o__1.osta = 0;
-#line 827 ""
+#line 834 ""
o__1.oacc = 0;
-#line 827 ""
+#line 834 ""
o__1.ofm = 0;
-#line 827 ""
+#line 834 ""
o__1.oblnk = 0;
-#line 827 ""
+#line 834 ""
f_open(&o__1);
-#line 828 ""
+#line 835 ""
} else {
-#line 829 ""
+#line 836 ""
o__1.oerr = 0;
-#line 829 ""
+#line 836 ""
o__1.ounit = 40;
-#line 829 ""
+#line 836 ""
o__1.ofnmlen = *ludpfn + 4;
/* Writing concatenation */
-#line 829 ""
+#line 836 ""
i__1[0] = *ludpfn, a__1[0] = udpfnq;
-#line 829 ""
+#line 836 ""
i__1[1] = 4, a__1[1] = ".pmx";
-#line 829 ""
+#line 836 ""
s_cat(ch__3, a__1, i__1, &c__2, (ftnlen)132);
-#line 829 ""
+#line 836 ""
o__1.ofnm = ch__3;
-#line 829 ""
+#line 836 ""
o__1.orl = 0;
-#line 829 ""
+#line 836 ""
o__1.osta = 0;
-#line 829 ""
+#line 836 ""
o__1.oacc = 0;
-#line 829 ""
+#line 836 ""
o__1.ofm = 0;
-#line 829 ""
+#line 836 ""
o__1.oblnk = 0;
-#line 829 ""
+#line 836 ""
f_open(&o__1);
-#line 830 ""
+#line 837 ""
}
-#line 831 ""
+#line 838 ""
for (i__ = 1; i__ <= 10000; ++i__) {
-#line 832 ""
- io___113.ciunit = *iv + 10;
-#line 832 ""
- s_rsfe(&io___113);
-#line 832 ""
+#line 839 ""
+ io___114.ciunit = *iv + 10;
+#line 839 ""
+ s_rsfe(&io___114);
+#line 839 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 832 ""
+#line 839 ""
e_rsfe();
-#line 833 ""
+#line 840 ""
if (*(unsigned char *)&line[0] == '%' || s_cmp(line, "---", (ftnlen)3,
(ftnlen)3) == 0 || type4) {
-#line 835 ""
+#line 842 ""
len = lenstr_(line, &c__128, (ftnlen)128);
-#line 836 ""
+#line 843 ""
if (len > 0) {
-#line 837 ""
- s_wsfe(&io___116);
-#line 837 ""
+#line 844 ""
+ s_wsfe(&io___117);
+#line 844 ""
do_fio(&c__1, line, len);
-#line 837 ""
+#line 844 ""
e_wsfe();
-#line 838 ""
+#line 845 ""
} else {
-#line 839 ""
- s_wsfe(&io___117);
-#line 839 ""
+#line 846 ""
+ s_wsfe(&io___118);
+#line 846 ""
do_fio(&c__1, " ", (ftnlen)1);
-#line 839 ""
+#line 846 ""
e_wsfe();
-#line 840 ""
+#line 847 ""
}
-#line 841 ""
+#line 848 ""
if (s_cmp(line, "---", (ftnlen)3, (ftnlen)3) == 0) {
-#line 841 ""
+#line 848 ""
type4 = ! type4;
-#line 841 ""
+#line 848 ""
}
-#line 842 ""
+#line 849 ""
} else {
-#line 843 ""
+#line 850 ""
goto L11;
-#line 844 ""
+#line 851 ""
}
-#line 845 ""
+#line 852 ""
/* L10: */
-#line 845 ""
+#line 852 ""
}
-#line 846 ""
- s_wsle(&io___118);
-#line 846 ""
+#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 846 ""
+#line 853 ""
e_wsle();
-#line 847 ""
+#line 854 ""
s_stop("", (ftnlen)0);
-#line 848 ""
+#line 855 ""
L11:
/* Finished reading opening type4 TeX and comments. Next line to be read */
/* will contain the first of the input numbers */
-#line 853 ""
+#line 860 ""
dosetup_(iv, line, &mtrnum, &mtrden, (ftnlen)128);
-#line 854 ""
+#line 861 ""
for (i__ = 1; i__ <= 10000; ++i__) {
-#line 855 ""
+#line 862 ""
L13:
-#line 855 ""
- io___121.ciunit = *iv + 10;
-#line 855 ""
- i__3 = s_rsfe(&io___121);
-#line 855 ""
+#line 862 ""
+ io___122.ciunit = *iv + 10;
+#line 862 ""
+ i__3 = s_rsfe(&io___122);
+#line 862 ""
if (i__3 != 0) {
-#line 855 ""
+#line 862 ""
goto L999;
-#line 855 ""
+#line 862 ""
}
-#line 855 ""
+#line 862 ""
i__3 = do_fio(&c__1, line, (ftnlen)128);
-#line 855 ""
+#line 862 ""
if (i__3 != 0) {
-#line 855 ""
+#line 862 ""
goto L999;
-#line 855 ""
+#line 862 ""
}
-#line 855 ""
+#line 862 ""
i__3 = e_rsfe();
-#line 855 ""
+#line 862 ""
if (i__3 != 0) {
-#line 855 ""
+#line 862 ""
goto L999;
-#line 855 ""
+#line 862 ""
}
-#line 856 ""
+#line 863 ""
L7:
-#line 856 ""
+#line 863 ""
len = lenstr_(line, &c__128, (ftnlen)128);
/* Pass-through (and copy into part file) if instrumnet has >1 voice. */
-#line 860 ""
+#line 867 ""
if (*ljob < 0) {
-#line 860 ""
+#line 867 ""
goto L2;
-#line 860 ""
+#line 867 ""
}
-#line 861 ""
+#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 865 ""
- s_wsfe(&io___122);
-#line 865 ""
+#line 872 ""
+ s_wsfe(&io___123);
+#line 872 ""
do_fio(&c__1, line, len);
-#line 865 ""
+#line 872 ""
e_wsfe();
-#line 866 ""
- io___123.ciunit = *iv + 10;
-#line 866 ""
- s_rsfe(&io___123);
-#line 866 ""
+#line 873 ""
+ io___124.ciunit = *iv + 10;
+#line 873 ""
+ s_rsfe(&io___124);
+#line 873 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 866 ""
+#line 873 ""
e_rsfe();
-#line 867 ""
+#line 874 ""
len = lenstr_(line, &c__128, (ftnlen)128);
-#line 868 ""
+#line 875 ""
goto L2;
-#line 869 ""
+#line 876 ""
}
-#line 870 ""
+#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 875 ""
+#line 882 ""
if (*(unsigned char *)&line[0] == '%') {
-#line 876 ""
- s_wsfe(&io___124);
-#line 876 ""
+#line 883 ""
+ s_wsfe(&io___125);
+#line 883 ""
do_fio(&c__1, line, len);
-#line 876 ""
+#line 883 ""
e_wsfe();
-#line 877 ""
+#line 884 ""
goto L13;
-#line 878 ""
+#line 885 ""
}
-#line 879 ""
+#line 886 ""
if (i__ != 1) {
/* New meter. Check for slashes (new meter change syntax) */
-#line 883 ""
+#line 890 ""
idxs = i_indx(line, "/", (ftnlen)128, (ftnlen)1);
-#line 884 ""
+#line 891 ""
idxb = i_indx(line, " ", (ftnlen)128, (ftnlen)1);
-#line 885 ""
+#line 892 ""
newmtr = idxs > 0 && (idxb == 0 || idxs < idxb);
-#line 886 ""
+#line 893 ""
if (! newmtr) {
/* Old way, no slashes, uses 'o' for lonesome '1' */
-#line 890 ""
+#line 897 ""
icden = 3;
-#line 891 ""
+#line 898 ""
if (*(unsigned char *)&line[1] == 'o') {
-#line 892 ""
+#line 899 ""
mtrnum = 1;
-#line 893 ""
+#line 900 ""
} else {
-#line 894 ""
+#line 901 ""
mtrnum = *(unsigned char *)&line[1] - 48;
-#line 895 ""
+#line 902 ""
if (mtrnum == 1) {
-#line 896 ""
+#line 903 ""
icden = 4;
-#line 897 ""
+#line 904 ""
mtrnum = *(unsigned char *)&line[2] - 38;
-#line 898 ""
+#line 905 ""
}
-#line 899 ""
+#line 906 ""
}
-#line 900 ""
+#line 907 ""
mtrden = *(unsigned char *)&line[icden - 1] - 48;
-#line 901 ""
+#line 908 ""
} else {
/* New way with slashes: idxs is index of 1st slash! */
-#line 905 ""
+#line 912 ""
ici__1.icierr = 0;
-#line 905 ""
+#line 912 ""
ici__1.iciend = 0;
-#line 905 ""
+#line 912 ""
ici__1.icirnum = 1;
-#line 905 ""
+#line 912 ""
ici__1.icirlen = idxs - 2;
-#line 905 ""
+#line 912 ""
ici__1.iciunit = line + 1;
/* Writing concatenation */
-#line 905 ""
+#line 912 ""
i__2[0] = 2, a__2[0] = "(i";
-#line 905 ""
+#line 912 ""
*(unsigned char *)&ch__1[0] = idxs + 46;
-#line 905 ""
+#line 912 ""
i__2[1] = 1, a__2[1] = ch__1;
-#line 905 ""
+#line 912 ""
i__2[2] = 1, a__2[2] = ")";
-#line 905 ""
+#line 912 ""
ici__1.icifmt = (s_cat(ch__4, a__2, i__2, &c__3, (ftnlen)
4), ch__4);
-#line 905 ""
+#line 912 ""
s_rsfi(&ici__1);
-#line 905 ""
+#line 912 ""
do_fio(&c__1, (char *)&mtrnum, (ftnlen)sizeof(integer));
-#line 905 ""
+#line 912 ""
e_rsfi();
-#line 906 ""
+#line 913 ""
i__3 = idxs;
-#line 906 ""
+#line 913 ""
idxb = i_indx(line + i__3, "/", 128 - i__3, (ftnlen)1);
-#line 907 ""
+#line 914 ""
i__3 = idxs;
-#line 907 ""
+#line 914 ""
ici__1.icierr = 0;
-#line 907 ""
+#line 914 ""
ici__1.iciend = 0;
-#line 907 ""
+#line 914 ""
ici__1.icirnum = 1;
-#line 907 ""
+#line 914 ""
ici__1.icirlen = idxs + idxb - 1 - i__3;
-#line 907 ""
+#line 914 ""
ici__1.iciunit = line + i__3;
/* Writing concatenation */
-#line 907 ""
+#line 914 ""
i__2[0] = 2, a__2[0] = "(i";
-#line 907 ""
+#line 914 ""
*(unsigned char *)&ch__1[0] = idxb + 47;
-#line 907 ""
+#line 914 ""
i__2[1] = 1, a__2[1] = ch__1;
-#line 907 ""
+#line 914 ""
i__2[2] = 1, a__2[2] = ")";
-#line 907 ""
+#line 914 ""
ici__1.icifmt = (s_cat(ch__4, a__2, i__2, &c__3, (ftnlen)
4), ch__4);
-#line 907 ""
+#line 914 ""
s_rsfi(&ici__1);
-#line 907 ""
+#line 914 ""
do_fio(&c__1, (char *)&mtrden, (ftnlen)sizeof(integer));
-#line 907 ""
+#line 914 ""
e_rsfi();
-#line 909 ""
+#line 916 ""
}
-#line 910 ""
+#line 917 ""
}
-#line 911 ""
+#line 918 ""
lenbeat = ifnodur_(&mtrden, "x", (ftnlen)1);
-#line 912 ""
+#line 919 ""
lenmult = 1;
-#line 913 ""
+#line 920 ""
if (mtrden == 2) {
-#line 914 ""
+#line 921 ""
lenbeat = 16;
-#line 915 ""
+#line 922 ""
lenmult = 2;
-#line 916 ""
+#line 923 ""
}
-#line 917 ""
+#line 924 ""
lenbar = lenmult * mtrnum * lenbeat;
-#line 918 ""
+#line 925 ""
fwbrsym_(&lenbar, &nwbrs, wbrsym, &lwbrs, (ftnlen)3);
-#line 919 ""
+#line 926 ""
}
/* Finished setting up meter stuff and defining whole-bar rest symbols */
-#line 923 ""
+#line 930 ""
ip1 = 0;
-#line 924 ""
+#line 931 ""
s_copy(line1, line, (ftnlen)128, (ftnlen)128);
-#line 925 ""
+#line 932 ""
i__3 = nwbrs;
-#line 925 ""
+#line 932 ""
for (iw = 0; iw <= i__3; ++iw) {
-#line 926 ""
+#line 933 ""
if (iw > 0) {
-#line 927 ""
+#line 934 ""
idx = ntindex_(line1, wbrsym + (iw - 1) * 3, (ftnlen)128,
lwbrs);
-#line 928 ""
+#line 935 ""
if (idx > 0) {
/* Check for blank or shifted rest, discount it if it's there */
-#line 932 ""
+#line 939 ""
i__4 = idx + lwbrs - 1;
-#line 932 ""
+#line 939 ""
if (s_cmp(line1 + i__4, " ", idx + lwbrs - i__4, (ftnlen)
1) != 0) {
-#line 932 ""
+#line 939 ""
idx = 0;
-#line 932 ""
+#line 939 ""
}
-#line 933 ""
+#line 940 ""
}
-#line 934 ""
+#line 941 ""
} else {
-#line 935 ""
+#line 942 ""
idx = ntindex_(line1, "rp", (ftnlen)128, (ftnlen)2);
/* Check for raised rest */
-#line 939 ""
+#line 946 ""
if (idx > 0) {
-#line 940 ""
+#line 947 ""
i__4 = idx + 1;
-#line 940 ""
+#line 947 ""
if (s_cmp(line1 + i__4, " ", idx + 2 - i__4, (ftnlen)1) !=
0) {
-#line 940 ""
+#line 947 ""
idx = 0;
-#line 940 ""
+#line 947 ""
}
-#line 941 ""
+#line 948 ""
}
-#line 942 ""
+#line 949 ""
}
-#line 943 ""
+#line 950 ""
if (idx > 0) {
-#line 944 ""
+#line 951 ""
if (ip1 == 0) {
-#line 945 ""
+#line 952 ""
ip1 = idx;
-#line 946 ""
+#line 953 ""
} else {
-#line 947 ""
+#line 954 ""
ip1 = min(ip1,idx);
/* Maybe allows e.g. r0 rp ... */
-#line 948 ""
+#line 955 ""
}
-#line 949 ""
+#line 956 ""
}
-#line 950 ""
+#line 957 ""
/* L3: */
-#line 950 ""
+#line 957 ""
}
/* Writing concatenation */
-#line 951 ""
+#line 958 ""
i__1[0] = 1, a__1[0] = sq;
-#line 951 ""
+#line 958 ""
i__1[1] = 1, a__1[1] = sq;
-#line 951 ""
+#line 958 ""
s_cat(ch__5, a__1, i__1, &c__2, (ftnlen)2);
-#line 951 ""
+#line 958 ""
if (i__ < 5 || *(unsigned char *)&line[0] == '%' || s_cmp(line, ch__5,
(ftnlen)2, (ftnlen)2) == 0 || ip1 == 0) {
-#line 951 ""
+#line 958 ""
goto L2;
-#line 951 ""
+#line 958 ""
}
/* Switch to multibar rest search mode!!! Start forward in line(1) */
-#line 956 ""
+#line 963 ""
rpfirst = s_cmp(line1 + (ip1 - 1), "rp", (ftnlen)2, (ftnlen)2) == 0;
-#line 957 ""
+#line 964 ""
iline = 1;
-#line 958 ""
+#line 965 ""
nmbr = 1;
-#line 959 ""
+#line 966 ""
if (rpfirst) {
-#line 960 ""
+#line 967 ""
lwbrsx = 2;
-#line 961 ""
+#line 968 ""
} else {
-#line 962 ""
+#line 969 ""
lwbrsx = lwbrs;
-#line 963 ""
+#line 970 ""
}
-#line 964 ""
+#line 971 ""
ipe = ip1 + lwbrsx - 1;
/* ip at end of 1st wbrsym */
-#line 965 ""
+#line 972 ""
L4:
-#line 965 ""
+#line 972 ""
if (ipe == len) {
/* Need a new line */
-#line 969 ""
+#line 976 ""
++iline;
-#line 970 ""
+#line 977 ""
L6:
-#line 970 ""
- io___144.ciunit = *iv + 10;
-#line 970 ""
- i__3 = s_rsfe(&io___144);
-#line 970 ""
+#line 977 ""
+ io___145.ciunit = *iv + 10;
+#line 977 ""
+ i__3 = s_rsfe(&io___145);
+#line 977 ""
if (i__3 != 0) {
-#line 970 ""
+#line 977 ""
goto L998;
-#line 970 ""
+#line 977 ""
}
-#line 970 ""
+#line 977 ""
i__3 = do_fio(&c__1, line + (iline - 1 << 7), (ftnlen)128);
-#line 970 ""
+#line 977 ""
if (i__3 != 0) {
-#line 970 ""
+#line 977 ""
goto L998;
-#line 970 ""
+#line 977 ""
}
-#line 970 ""
+#line 977 ""
i__3 = e_rsfe();
-#line 970 ""
+#line 977 ""
if (i__3 != 0) {
-#line 970 ""
+#line 977 ""
goto L998;
-#line 970 ""
+#line 977 ""
}
-#line 971 ""
+#line 978 ""
len = lenstr_(line + (iline - 1 << 7), &c__128, (ftnlen)128);
-#line 972 ""
+#line 979 ""
if (*(unsigned char *)&line[(iline - 1) * 128] == '%') {
-#line 973 ""
- s_wsfe(&io___145);
-#line 973 ""
+#line 980 ""
+ s_wsfe(&io___146);
+#line 980 ""
do_fio(&c__1, "% Following comment has been moved forward", (
ftnlen)42);
-#line 973 ""
+#line 980 ""
e_wsfe();
-#line 974 ""
- s_wsfe(&io___146);
-#line 974 ""
+#line 981 ""
+ s_wsfe(&io___147);
+#line 981 ""
do_fio(&c__1, line + (iline - 1 << 7), len);
-#line 974 ""
+#line 981 ""
e_wsfe();
-#line 975 ""
+#line 982 ""
goto L6;
-#line 976 ""
+#line 983 ""
}
-#line 977 ""
+#line 984 ""
ipe = 0;
-#line 978 ""
+#line 985 ""
goto L4;
-#line 979 ""
+#line 986 ""
L998:
/* No more input left */
-#line 983 ""
- s_wsle(&io___147);
-#line 983 ""
+#line 990 ""
+ s_wsle(&io___148);
+#line 990 ""
do_lio(&c__9, &c__1, "All done!", (ftnlen)9);
-#line 983 ""
+#line 990 ""
e_wsle();
-#line 984 ""
+#line 991 ""
alldone = TRUE_;
-#line 985 ""
+#line 992 ""
ipe = 0;
-#line 986 ""
+#line 993 ""
--iline;
-#line 987 ""
+#line 994 ""
len = lenstr_(line + (iline - 1 << 7), &c__128, (ftnlen)128);
-#line 988 ""
+#line 995 ""
goto L4;
-#line 989 ""
+#line 996 ""
} else {
-#line 990 ""
+#line 997 ""
if (alldone) {
-#line 991 ""
+#line 998 ""
*(unsigned char *)sym = ' ';
-#line 992 ""
+#line 999 ""
} else {
/* ipe<len here, so it's ok to get a symbol */
-#line 996 ""
+#line 1003 ""
nextsym_(line + (iline - 1 << 7), &len, &ipe, &ipenew, sym, &
lsym, (ftnlen)128, (ftnlen)80);
-#line 997 ""
+#line 1004 ""
}
/* Check for end of block or bar line symbol */
-#line 1001 ""
+#line 1008 ""
if (i_indx("/|", sym, (ftnlen)2, (ftnlen)1) > 0) {
-#line 1002 ""
+#line 1009 ""
ipe = ipenew;
-#line 1003 ""
+#line 1010 ""
goto L4;
-#line 1004 ""
+#line 1011 ""
} else {
-#line 1005 ""
+#line 1012 ""
wbrest = FALSE_;
-#line 1006 ""
+#line 1013 ""
if (alldone) {
-#line 1006 ""
+#line 1013 ""
goto L12;
-#line 1006 ""
+#line 1013 ""
}
-#line 1007 ""
+#line 1014 ""
i__3 = nwbrs;
-#line 1007 ""
+#line 1014 ""
for (iw = 1; iw <= i__3; ++iw) {
-#line 1008 ""
+#line 1015 ""
wbrest = wbrest || s_cmp(sym, wbrsym + (iw - 1) * 3, lsym,
lwbrs) == 0;
-#line 1009 ""
+#line 1016 ""
/* L5: */
-#line 1009 ""
+#line 1016 ""
}
-#line 1010 ""
+#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 1014 ""
+#line 1021 ""
L12:
-#line 1014 ""
+#line 1021 ""
if (wbrest) {
-#line 1015 ""
+#line 1022 ""
ipe = ipenew;
-#line 1016 ""
+#line 1023 ""
++nmbr;
-#line 1017 ""
+#line 1024 ""
goto L4;
-#line 1018 ""
+#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 1023 ""
+#line 1030 ""
if (nmbr > 1) {
/* Write stuff up to start of mbr */
-#line 1027 ""
+#line 1034 ""
if (ip1 > 1) {
-#line 1027 ""
- s_wsfe(&io___152);
-#line 1027 ""
+#line 1034 ""
+ s_wsfe(&io___153);
+#line 1034 ""
do_fio(&c__1, line, ip1 - 1);
-#line 1027 ""
+#line 1034 ""
e_wsfe();
-#line 1027 ""
+#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 1033 ""
+#line 1040 ""
r__1 = nmbr + .01f;
-#line 1033 ""
+#line 1040 ""
ndig = (integer) r_lg10(&r__1) + 1;
-#line 1034 ""
- s_wsle(&io___154);
-#line 1034 ""
+#line 1041 ""
+ s_wsle(&io___155);
+#line 1041 ""
do_lio(&c__9, &c__1, "Inserting rm, iv,nmbr:", (
ftnlen)22);
-#line 1034 ""
+#line 1041 ""
do_lio(&c__3, &c__1, (char *)&(*iv), (ftnlen)sizeof(
integer));
-#line 1034 ""
+#line 1041 ""
do_lio(&c__3, &c__1, (char *)&nmbr, (ftnlen)sizeof(
integer));
-#line 1034 ""
+#line 1041 ""
e_wsle();
-#line 1035 ""
+#line 1042 ""
ci__1.cierr = 0;
-#line 1035 ""
+#line 1042 ""
ci__1.ciunit = 40;
/* Writing concatenation */
-#line 1035 ""
+#line 1042 ""
i__2[0] = 5, a__2[0] = "(a2,i";
-#line 1035 ""
+#line 1042 ""
*(unsigned char *)&ch__1[0] = ndig + 48;
-#line 1035 ""
+#line 1042 ""
i__2[1] = 1, a__2[1] = ch__1;
-#line 1035 ""
+#line 1042 ""
i__2[2] = 4, a__2[2] = ",a2)";
-#line 1035 ""
+#line 1042 ""
ci__1.cifmt = (s_cat(ch__6, a__2, i__2, &c__3, (
ftnlen)10), ch__6);
-#line 1035 ""
+#line 1042 ""
s_wsfe(&ci__1);
-#line 1035 ""
+#line 1042 ""
do_fio(&c__1, "rm", (ftnlen)2);
-#line 1035 ""
+#line 1042 ""
do_fio(&c__1, (char *)&nmbr, (ftnlen)sizeof(integer));
-#line 1035 ""
+#line 1042 ""
do_fio(&c__1, " /", (ftnlen)2);
-#line 1035 ""
+#line 1042 ""
e_wsfe();
-#line 1036 ""
+#line 1043 ""
if (alldone) {
-#line 1036 ""
+#line 1043 ""
goto L999;
-#line 1036 ""
+#line 1043 ""
}
-#line 1037 ""
+#line 1044 ""
ipc = ipenew - lsym + 1;
-#line 1038 ""
+#line 1045 ""
s_copy(line, line + ((iline - 1 << 7) + (ipc - 1)), (
ftnlen)128, len - (ipc - 1));
-#line 1039 ""
+#line 1046 ""
} else {
/* Write old stuff up to end of original lonesome wbr, save the rest. */
@@ -2847,112 +2857,112 @@ L12:
/* non-comment line; then revert to normal mode on that. In 3rd case must */
/* split line. */
-#line 1048 ""
+#line 1055 ""
if (alldone) {
-#line 1049 ""
- s_wsfe(&io___156);
-#line 1049 ""
+#line 1056 ""
+ s_wsfe(&io___157);
+#line 1056 ""
do_fio(&c__1, line, len);
-#line 1049 ""
+#line 1056 ""
e_wsfe();
-#line 1050 ""
+#line 1057 ""
goto L999;
-#line 1051 ""
+#line 1058 ""
} else if (iline > 1) {
-#line 1052 ""
+#line 1059 ""
i__3 = iline - 1;
-#line 1052 ""
+#line 1059 ""
for (il = 1; il <= i__3; ++il) {
-#line 1053 ""
+#line 1060 ""
len = lenstr_(line + (il - 1 << 7), &c__128, (
ftnlen)128);
-#line 1054 ""
- s_wsfe(&io___158);
-#line 1054 ""
+#line 1061 ""
+ s_wsfe(&io___159);
+#line 1061 ""
do_fio(&c__1, line + (il - 1 << 7), len);
-#line 1054 ""
+#line 1061 ""
e_wsfe();
-#line 1055 ""
+#line 1062 ""
/* L9: */
-#line 1055 ""
+#line 1062 ""
}
-#line 1056 ""
+#line 1063 ""
s_copy(line, line + (iline - 1 << 7), (ftnlen)128,
(ftnlen)128);
-#line 1057 ""
+#line 1064 ""
} else {
/* Since iline = 1 the wbr is not the last sym, so must split */
-#line 1061 ""
- s_wsfe(&io___159);
-#line 1061 ""
+#line 1068 ""
+ s_wsfe(&io___160);
+#line 1068 ""
do_fio(&c__1, line, ip1 + lwbrsx - 1);
-#line 1061 ""
+#line 1068 ""
e_wsfe();
-#line 1062 ""
+#line 1069 ""
i__3 = ip1 + lwbrsx;
-#line 1062 ""
+#line 1069 ""
s_copy(line, line + i__3, (ftnlen)128, len - i__3)
;
-#line 1063 ""
+#line 1070 ""
}
-#line 1064 ""
+#line 1071 ""
}
/* Exit multibar mode */
-#line 1068 ""
+#line 1075 ""
goto L7;
-#line 1069 ""
+#line 1076 ""
}
-#line 1070 ""
+#line 1077 ""
}
-#line 1071 ""
+#line 1078 ""
}
-#line 1072 ""
+#line 1079 ""
L2:
-#line 1073 ""
+#line 1080 ""
if (len > 0) {
-#line 1074 ""
- s_wsfe(&io___160);
-#line 1074 ""
+#line 1081 ""
+ s_wsfe(&io___161);
+#line 1081 ""
do_fio(&c__1, line, len);
-#line 1074 ""
+#line 1081 ""
e_wsfe();
-#line 1075 ""
+#line 1082 ""
} else {
-#line 1076 ""
- s_wsfe(&io___161);
-#line 1076 ""
+#line 1083 ""
+ s_wsfe(&io___162);
+#line 1083 ""
do_fio(&c__1, " ", (ftnlen)1);
-#line 1076 ""
+#line 1083 ""
e_wsfe();
-#line 1077 ""
+#line 1084 ""
}
-#line 1078 ""
+#line 1085 ""
/* L1: */
-#line 1078 ""
+#line 1085 ""
}
-#line 1079 ""
+#line 1086 ""
L999:
-#line 1080 ""
+#line 1087 ""
cl__1.cerr = 0;
-#line 1080 ""
+#line 1087 ""
cl__1.cunit = *iv + 10;
-#line 1080 ""
+#line 1087 ""
cl__1.csta = 0;
-#line 1080 ""
+#line 1087 ""
f_clos(&cl__1);
-#line 1081 ""
+#line 1088 ""
cl__1.cerr = 0;
-#line 1081 ""
+#line 1088 ""
cl__1.cunit = 40;
-#line 1081 ""
+#line 1088 ""
cl__1.csta = 0;
-#line 1081 ""
+#line 1088 ""
f_clos(&cl__1);
-#line 1082 ""
+#line 1089 ""
return 0;
} /* mbrests_ */
@@ -2967,57 +2977,57 @@ integer ifnodur_(integer *idur, char *dotq, ftnlen dotq_len)
/* Subroutine */ int s_stop(char *, ftnlen);
/* Fortran I/O blocks */
- static cilist io___162 = { 0, 6, 0, 0, 0 };
+ static cilist io___163 = { 0, 6, 0, 0, 0 };
-#line 1086 ""
+#line 1093 ""
if (*idur == 6) {
-#line 1087 ""
+#line 1094 ""
ret_val = 1;
-#line 1088 ""
+#line 1095 ""
} else if (*idur == 3) {
-#line 1089 ""
+#line 1096 ""
ret_val = 2;
-#line 1090 ""
+#line 1097 ""
} else if (*idur == 1 || *idur == 16) {
-#line 1091 ""
+#line 1098 ""
ret_val = 4;
-#line 1092 ""
+#line 1099 ""
} else if (*idur == 8) {
-#line 1093 ""
+#line 1100 ""
ret_val = 8;
-#line 1094 ""
+#line 1101 ""
} else if (*idur == 4) {
-#line 1095 ""
+#line 1102 ""
ret_val = 16;
-#line 1096 ""
+#line 1103 ""
} else if (*idur == 2) {
-#line 1097 ""
+#line 1104 ""
ret_val = 32;
-#line 1098 ""
+#line 1105 ""
} else if (*idur == 0) {
-#line 1099 ""
+#line 1106 ""
ret_val = 64;
-#line 1100 ""
+#line 1107 ""
} else {
-#line 1101 ""
- s_wsle(&io___162);
-#line 1101 ""
+#line 1108 ""
+ s_wsle(&io___163);
+#line 1108 ""
do_lio(&c__9, &c__1, "You entered an invalid note-length value", (
ftnlen)40);
-#line 1101 ""
+#line 1108 ""
e_wsle();
-#line 1102 ""
+#line 1109 ""
s_stop("", (ftnlen)0);
-#line 1103 ""
+#line 1110 ""
}
-#line 1104 ""
+#line 1111 ""
if (*(unsigned char *)dotq == 'd') {
-#line 1104 ""
+#line 1111 ""
ret_val = ret_val * 3 / 2;
-#line 1104 ""
+#line 1111 ""
}
-#line 1105 ""
+#line 1112 ""
return ret_val;
} /* ifnodur_ */
@@ -3029,79 +3039,79 @@ integer ifnodur_(integer *idur, char *dotq, ftnlen dotq_len)
integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
/* Fortran I/O blocks */
- static cilist io___163 = { 0, 6, 0, "(33H Any whole-bar rests of duratio"
+ static cilist io___164 = { 0, 6, 0, "(33H Any whole-bar rests of duratio"
"n ,i3, 26H/64 will not be recognized)", 0 };
-#line 1109 ""
+#line 1116 ""
/* Parameter adjustments */
-#line 1109 ""
+#line 1116 ""
wbrsym -= 3;
-#line 1109 ""
+#line 1116 ""
-#line 1109 ""
+#line 1116 ""
/* Function Body */
-#line 1109 ""
+#line 1116 ""
*nwbrs = 1;
-#line 1110 ""
+#line 1117 ""
*lwbrs = 2;
-#line 1111 ""
+#line 1118 ""
if (*lenbar == 16) {
-#line 1112 ""
+#line 1119 ""
s_copy(wbrsym + 3, "r4", (ftnlen)3, (ftnlen)2);
-#line 1113 ""
+#line 1120 ""
} else if (*lenbar == 32) {
-#line 1114 ""
+#line 1121 ""
s_copy(wbrsym + 3, "r2", (ftnlen)3, (ftnlen)2);
-#line 1115 ""
+#line 1122 ""
} else if (*lenbar == 64) {
-#line 1116 ""
+#line 1123 ""
s_copy(wbrsym + 3, "r0", (ftnlen)3, (ftnlen)2);
-#line 1117 ""
+#line 1124 ""
} else if (*lenbar == 8) {
-#line 1118 ""
+#line 1125 ""
s_copy(wbrsym + 3, "r8", (ftnlen)3, (ftnlen)2);
-#line 1119 ""
+#line 1126 ""
} else if (*lenbar == 128) {
-#line 1120 ""
+#line 1127 ""
s_copy(wbrsym + 3, "r9", (ftnlen)3, (ftnlen)2);
-#line 1121 ""
+#line 1128 ""
} else {
-#line 1122 ""
+#line 1129 ""
*nwbrs = 2;
-#line 1123 ""
+#line 1130 ""
*lwbrs = 3;
-#line 1124 ""
+#line 1131 ""
if (*lenbar == 24) {
-#line 1125 ""
+#line 1132 ""
s_copy(wbrsym + 3, "rd4", (ftnlen)3, (ftnlen)3);
-#line 1126 ""
+#line 1133 ""
s_copy(wbrsym + 6, "r4d", (ftnlen)3, (ftnlen)3);
-#line 1127 ""
+#line 1134 ""
} else if (*lenbar == 48) {
-#line 1128 ""
+#line 1135 ""
s_copy(wbrsym + 3, "rd2", (ftnlen)3, (ftnlen)3);
-#line 1129 ""
+#line 1136 ""
s_copy(wbrsym + 6, "r2d", (ftnlen)3, (ftnlen)3);
-#line 1130 ""
+#line 1137 ""
} else if (*lenbar == 96) {
-#line 1131 ""
+#line 1138 ""
s_copy(wbrsym + 3, "rd0", (ftnlen)3, (ftnlen)3);
-#line 1132 ""
+#line 1139 ""
s_copy(wbrsym + 6, "r0d", (ftnlen)3, (ftnlen)3);
-#line 1133 ""
+#line 1140 ""
} else {
-#line 1134 ""
- s_wsfe(&io___163);
-#line 1134 ""
+#line 1141 ""
+ s_wsfe(&io___164);
+#line 1141 ""
do_fio(&c__1, (char *)&(*lenbar), (ftnlen)sizeof(integer));
-#line 1134 ""
+#line 1141 ""
e_wsfe();
-#line 1136 ""
+#line 1143 ""
}
-#line 1137 ""
+#line 1144 ""
}
-#line 1138 ""
+#line 1145 ""
return 0;
} /* fwbrsym_ */
@@ -3122,113 +3132,113 @@ integer ifnodur_(integer *idur, char *dotq, ftnlen dotq_len)
static integer ip, iip;
/* Fortran I/O blocks */
- static cilist io___164 = { 0, 6, 0, 0, 0 };
static cilist io___165 = { 0, 6, 0, 0, 0 };
- static cilist io___168 = { 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 1147 ""
+#line 1154 ""
if (*ipeold >= *len) {
-#line 1148 ""
- s_wsle(&io___164);
-#line 1148 ""
+#line 1155 ""
+ s_wsle(&io___165);
+#line 1155 ""
do_lio(&c__9, &c__1, "Called nextsym with ipstart>=len ", (ftnlen)33);
-#line 1148 ""
+#line 1155 ""
e_wsle();
-#line 1149 ""
- s_wsle(&io___165);
-#line 1149 ""
+#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 1149 ""
+#line 1156 ""
e_wsle();
-#line 1150 ""
+#line 1157 ""
s_stop("", (ftnlen)0);
-#line 1151 ""
+#line 1158 ""
}
-#line 1152 ""
+#line 1159 ""
i__1 = *len;
-#line 1152 ""
+#line 1159 ""
for (ip = *ipeold + 1; ip <= i__1; ++ip) {
-#line 1153 ""
+#line 1160 ""
if (*(unsigned char *)&line[ip - 1] != ' ') {
/* symbol starts here (ip). We're committed to exit the loop. */
-#line 1157 ""
+#line 1164 ""
if (ip < *len) {
-#line 1158 ""
+#line 1165 ""
i__2 = *len;
-#line 1158 ""
+#line 1165 ""
for (iip = ip + 1; iip <= i__2; ++iip) {
-#line 1159 ""
+#line 1166 ""
if (*(unsigned char *)&line[iip - 1] != ' ') {
-#line 1159 ""
+#line 1166 ""
goto L2;
-#line 1159 ""
+#line 1166 ""
}
/* iip is the space after the symbol */
-#line 1163 ""
+#line 1170 ""
*ipenew = iip - 1;
-#line 1164 ""
+#line 1171 ""
*lsym = *ipenew - ip + 1;
-#line 1165 ""
+#line 1172 ""
s_copy(sym, line + (ip - 1), (ftnlen)80, *ipenew - (ip -
1));
-#line 1166 ""
+#line 1173 ""
return 0;
-#line 1167 ""
+#line 1174 ""
L2:
-#line 1167 ""
+#line 1174 ""
;
-#line 1167 ""
+#line 1174 ""
}
/* Have len>=2 and ends on len */
-#line 1171 ""
+#line 1178 ""
*ipenew = *len;
-#line 1172 ""
+#line 1179 ""
*lsym = *ipenew - ip + 1;
-#line 1173 ""
+#line 1180 ""
s_copy(sym, line + (ip - 1), (ftnlen)80, *ipenew - (ip - 1));
-#line 1174 ""
+#line 1181 ""
return 0;
-#line 1175 ""
+#line 1182 ""
} else {
/* ip = len */
-#line 1179 ""
+#line 1186 ""
*ipenew = *len;
-#line 1180 ""
+#line 1187 ""
*lsym = 1;
-#line 1181 ""
+#line 1188 ""
s_copy(sym, line + (ip - 1), (ftnlen)80, (ftnlen)1);
-#line 1182 ""
+#line 1189 ""
return 0;
-#line 1183 ""
+#line 1190 ""
}
-#line 1184 ""
+#line 1191 ""
}
-#line 1185 ""
+#line 1192 ""
/* L1: */
-#line 1185 ""
+#line 1192 ""
}
-#line 1186 ""
- s_wsle(&io___168);
-#line 1186 ""
+#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 1186 ""
+#line 1193 ""
e_wsle();
-#line 1187 ""
+#line 1194 ""
return 0;
} /* nextsym_ */
@@ -3255,7 +3265,7 @@ integer ntindex_(char *line, char *s2q, ftnlen line_len, ftnlen s2q_len)
extern integer lenstr_(char *, integer *, ftnlen);
/* Fortran I/O blocks */
- static cilist io___174 = { 0, 6, 0, 0, 0 };
+ static cilist io___175 = { 0, 6, 0, 0, 0 };
@@ -3268,158 +3278,158 @@ integer ntindex_(char *line, char *s2q, ftnlen line_len, ftnlen s2q_len)
/* Use a temporary string to store the input and test, so can zap D"..." */
-#line 1202 ""
+#line 1209 ""
s_copy(tline, line, (ftnlen)128, (ftnlen)128);
-#line 1203 ""
+#line 1210 ""
ndxs2 = i_indx(tline, s2q, (ftnlen)128, s2q_len);
/* Return point below for rechecks after zapping D" " */
-#line 1207 ""
+#line 1214 ""
L2:
-#line 1208 ""
+#line 1215 ""
ndxbs = i_indx(tline, "\\", (ftnlen)128, (ftnlen)1);
-#line 1209 ""
+#line 1216 ""
if (ndxbs > 0) {
/* Special check in case \ is inside D"..." */
-#line 1213 ""
+#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 1217 ""
+#line 1224 ""
if (ndxdq1 > 0) {
/* Find end of D"..." */
-#line 1221 ""
+#line 1228 ""
i__1 = ndxdq1 + 1;
-#line 1221 ""
+#line 1228 ""
ndxdq2 = ndxdq1 + 1 + i_indx(tline + i__1, "\"", 128 - i__1, (
ftnlen)1);
-#line 1222 ""
+#line 1229 ""
if (ndxdq2 == ndxdq1 + 1) {
-#line 1223 ""
- s_wsle(&io___174);
-#line 1223 ""
+#line 1230 ""
+ s_wsle(&io___175);
+#line 1230 ""
do_lio(&c__9, &c__1, "Something is really wierd here", (
ftnlen)30);
-#line 1223 ""
+#line 1230 ""
e_wsle();
-#line 1224 ""
+#line 1231 ""
s_stop("", (ftnlen)0);
-#line 1225 ""
+#line 1232 ""
}
-#line 1226 ""
+#line 1233 ""
s_copy(tline, tline, (ftnlen)128, ndxdq1 - 1);
-#line 1227 ""
+#line 1234 ""
i__1 = ndxdq2;
-#line 1227 ""
+#line 1234 ""
for (ic = ndxdq1; ic <= i__1; ++ic) {
/* Writing concatenation */
-#line 1228 ""
+#line 1235 ""
i__2[0] = ic - 1, a__1[0] = tline;
-#line 1228 ""
+#line 1235 ""
i__2[1] = 1, a__1[1] = " ";
-#line 1228 ""
+#line 1235 ""
s_cat(tline, a__1, i__2, &c__2, (ftnlen)128);
-#line 1229 ""
+#line 1236 ""
/* L3: */
-#line 1229 ""
+#line 1236 ""
}
-#line 1230 ""
+#line 1237 ""
i__1 = ndxdq2;
/* Writing concatenation */
-#line 1230 ""
+#line 1237 ""
i__2[0] = ndxdq2, a__1[0] = tline;
-#line 1230 ""
+#line 1237 ""
i__2[1] = 128 - i__1, a__1[1] = line + i__1;
-#line 1230 ""
+#line 1237 ""
s_cat(tline, a__1, i__2, &c__2, (ftnlen)128);
-#line 1231 ""
+#line 1238 ""
goto L2;
-#line 1232 ""
+#line 1239 ""
}
-#line 1233 ""
+#line 1240 ""
}
-#line 1234 ""
+#line 1241 ""
if (ndxbs == 0 || ndxs2 < ndxbs) {
-#line 1235 ""
+#line 1242 ""
ret_val = ndxs2;
/* print*,'No bs, or char is left of 1st bs, ntindex:',ntindex */
-#line 1237 ""
+#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 1242 ""
+#line 1249 ""
len = lenstr_(tline, &c__128, (ftnlen)128);
-#line 1243 ""
+#line 1250 ""
intex = TRUE_;
/* print*,'intex+>',intex */
-#line 1245 ""
+#line 1252 ""
i__1 = len;
-#line 1245 ""
+#line 1252 ""
for (ic = ndxbs + 1; ic <= i__1; ++ic) {
-#line 1246 ""
+#line 1253 ""
if (ic == ndxs2) {
-#line 1247 ""
+#line 1254 ""
if (intex) {
-#line 1248 ""
+#line 1255 ""
ret_val = 0;
-#line 1249 ""
+#line 1256 ""
i__3 = ic;
-#line 1249 ""
+#line 1256 ""
ndxs2 = i_indx(tline + i__3, s2q, len - i__3, s2q_len) +
ic;
/* print*,'ndxs2 =>',ndxs2 */
-#line 1251 ""
+#line 1258 ""
} else {
-#line 1252 ""
+#line 1259 ""
ret_val = ndxs2;
-#line 1253 ""
+#line 1260 ""
return ret_val;
-#line 1254 ""
+#line 1261 ""
}
/* print*,'Internal exit, intex, ntindex:',intex,ntindex */
-#line 1256 ""
+#line 1263 ""
} else /* if(complicated condition) */ {
-#line 1256 ""
+#line 1263 ""
i__3 = ic;
-#line 1256 ""
+#line 1263 ""
if (intex && s_cmp(tline + i__3, "\\ ", ic + 2 - i__3, (
ftnlen)2) == 0) {
-#line 1257 ""
+#line 1264 ""
intex = FALSE_;
/* print*,'intex+>',intex */
-#line 1259 ""
+#line 1266 ""
} else /* if(complicated condition) */ {
-#line 1259 ""
+#line 1266 ""
i__3 = ic;
-#line 1259 ""
+#line 1266 ""
if (! intex && s_cmp(tline + i__3, " \\", ic + 2 - i__3, (
ftnlen)2) == 0) {
-#line 1261 ""
+#line 1268 ""
intex = TRUE_;
/* print*,'intex+>',intex */
-#line 1263 ""
+#line 1270 ""
}
-#line 1263 ""
+#line 1270 ""
}
-#line 1263 ""
+#line 1270 ""
}
-#line 1264 ""
+#line 1271 ""
/* L1: */
-#line 1264 ""
+#line 1271 ""
}
/* print*,'Out end of loop 1' */
-#line 1266 ""
+#line 1273 ""
}
/* print*,'Exiting ntindex at the end???' */
-#line 1268 ""
+#line 1275 ""
return ret_val;
} /* ntindex_ */
@@ -3430,30 +3440,30 @@ L2:
integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void);
/* Fortran I/O blocks */
- static cilist io___178 = { 0, 10, 0, "(a)", 0 };
+ 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 1277 ""
+#line 1284 ""
if (*iccount == 128) {
-#line 1278 ""
- s_rsfe(&io___178);
-#line 1278 ""
+#line 1285 ""
+ s_rsfe(&io___179);
+#line 1285 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 1278 ""
+#line 1285 ""
e_rsfe();
-#line 1279 ""
+#line 1286 ""
*iccount = 0;
-#line 1280 ""
+#line 1287 ""
}
-#line 1281 ""
+#line 1288 ""
++(*iccount);
-#line 1282 ""
+#line 1289 ""
*(unsigned char *)charq = *(unsigned char *)&line[*iccount - 1];
-#line 1283 ""
+#line 1290 ""
return 0;
} /* getchar_ */
@@ -3479,13 +3489,14 @@ doublereal readin_(char *line, integer *iccount, integer *iread, ftnlen
extern /* Subroutine */ int allparts_(char *, integer *, ftnlen);
static integer i1, i2, icf;
static char durq[1];
- extern /* Subroutine */ int chkcom_(char *, ftnlen), getchar_(char *,
- integer *, char *, ftnlen, ftnlen);
+ static logical goto999;
+ extern /* Subroutine */ int chkcom_(char *, logical *, ftnlen), getchar_(
+ char *, integer *, char *, ftnlen, ftnlen);
/* Fortran I/O blocks */
- static cilist io___179 = { 0, 10, 0, "(a)", 0 };
- static cilist io___183 = { 0, 6, 0, 0, 0 };
+ 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 };
@@ -3504,171 +3515,171 @@ doublereal readin_(char *line, integer *iccount, integer *iread, ftnlen
/* 4 musicsize 20 */
/* 5 fracondent 0.05 */
-#line 1308 ""
+#line 1315 ""
L4:
-#line 1308 ""
+#line 1315 ""
if (*iccount == 128) {
-#line 1309 ""
- s_rsfe(&io___179);
-#line 1309 ""
+#line 1316 ""
+ s_rsfe(&io___180);
+#line 1316 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 1309 ""
+#line 1316 ""
e_rsfe();
-#line 1310 ""
+#line 1317 ""
if (all_1.replacing) {
-#line 1310 ""
+#line 1317 ""
all_1.replacing = FALSE_;
-#line 1310 ""
+#line 1317 ""
}
-#line 1311 ""
- chkcom_(line, (ftnlen)128);
-#line 1312 ""
+#line 1318 ""
+ chkcom_(line, &goto999, (ftnlen)128);
+#line 1319 ""
*iccount = 0;
-#line 1313 ""
+#line 1320 ""
}
-#line 1314 ""
+#line 1321 ""
++(*iccount);
/* Find next non-blank or end of line */
-#line 1318 ""
+#line 1325 ""
for (*iccount = *iccount; *iccount <= 127; ++(*iccount)) {
-#line 1319 ""
+#line 1326 ""
if (*(unsigned char *)&line[*iccount - 1] != ' ') {
-#line 1319 ""
+#line 1326 ""
goto L3;
-#line 1319 ""
+#line 1326 ""
}
-#line 1320 ""
+#line 1327 ""
/* L2: */
-#line 1320 ""
+#line 1327 ""
}
/* If here, need to get a new line */
-#line 1324 ""
+#line 1331 ""
*iccount = 128;
-#line 1325 ""
+#line 1332 ""
goto L4;
-#line 1326 ""
+#line 1333 ""
L3:
/* iccount now points to start of number to read */
-#line 1330 ""
+#line 1337 ""
i1 = *iccount;
-#line 1331 ""
+#line 1338 ""
L5:
-#line 1331 ""
+#line 1338 ""
getchar_(line, iccount, durq, (ftnlen)128, (ftnlen)1);
/* Remember that getchar first increments iccount, *then* reads a character. */
-#line 1335 ""
+#line 1342 ""
if (i_indx("0123456789.-", durq, (ftnlen)12, (ftnlen)1) > 0) {
-#line 1335 ""
+#line 1342 ""
goto L5;
-#line 1335 ""
+#line 1342 ""
}
-#line 1336 ""
+#line 1343 ""
i2 = *iccount - 1;
-#line 1337 ""
+#line 1344 ""
if (i2 < i1) {
-#line 1338 ""
- s_wsle(&io___183);
+#line 1345 ""
+ s_wsle(&io___185);
/* Writing concatenation */
-#line 1338 ""
+#line 1345 ""
i__1[0] = 7, a__1[0] = "Found \"";
-#line 1338 ""
+#line 1345 ""
i__1[1] = 1, a__1[1] = durq;
-#line 1338 ""
+#line 1345 ""
i__1[2] = 19, a__1[2] = "\" instead of number";
-#line 1338 ""
+#line 1345 ""
s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27);
-#line 1338 ""
+#line 1345 ""
do_lio(&c__9, &c__1, ch__1, (ftnlen)27);
-#line 1338 ""
+#line 1345 ""
e_wsle();
-#line 1339 ""
+#line 1346 ""
s_stop("1", (ftnlen)1);
-#line 1340 ""
+#line 1347 ""
}
-#line 1341 ""
+#line 1348 ""
icf = i2 - i1 + 49;
-#line 1342 ""
+#line 1349 ""
ici__1.icierr = 0;
-#line 1342 ""
+#line 1349 ""
ici__1.iciend = 0;
-#line 1342 ""
+#line 1349 ""
ici__1.icirnum = 1;
-#line 1342 ""
+#line 1349 ""
ici__1.icirlen = i2 - (i1 - 1);
-#line 1342 ""
+#line 1349 ""
ici__1.iciunit = line + (i1 - 1);
/* Writing concatenation */
-#line 1342 ""
+#line 1349 ""
i__1[0] = 2, a__1[0] = "(f";
-#line 1342 ""
+#line 1349 ""
*(unsigned char *)&ch__3[0] = icf;
-#line 1342 ""
+#line 1349 ""
i__1[1] = 1, a__1[1] = ch__3;
-#line 1342 ""
+#line 1349 ""
i__1[2] = 3, a__1[2] = ".0)";
-#line 1342 ""
+#line 1349 ""
ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2);
-#line 1342 ""
+#line 1349 ""
s_rsfi(&ici__1);
-#line 1342 ""
+#line 1349 ""
do_fio(&c__1, (char *)&ret_val, (ftnlen)sizeof(real));
-#line 1342 ""
+#line 1349 ""
e_rsfi();
-#line 1343 ""
+#line 1350 ""
if (! all_1.replacing) {
-#line 1344 ""
+#line 1351 ""
if (*iread == 0) {
-#line 1345 ""
+#line 1352 ""
i__2 = i2 - i1 + 1;
-#line 1345 ""
+#line 1352 ""
allparts_(line + (i1 - 1), &i__2, i2 - (i1 - 1));
-#line 1346 ""
+#line 1353 ""
} else if (*iread == 1) {
-#line 1347 ""
+#line 1354 ""
allparts_("-999", &c__4, (ftnlen)4);
-#line 1348 ""
+#line 1355 ""
} else if (*iread == 2) {
-#line 1349 ""
+#line 1356 ""
allparts_("1", &c__1, (ftnlen)1);
-#line 1350 ""
+#line 1357 ""
} else if (*iread == 3) {
-#line 1351 ""
+#line 1358 ""
allparts_("-998", &c__4, (ftnlen)4);
-#line 1352 ""
+#line 1359 ""
} else if (*iread == 4) {
-#line 1353 ""
+#line 1360 ""
allparts_("20", &c__2, (ftnlen)2);
-#line 1354 ""
+#line 1361 ""
} else if (*iread == 5) {
-#line 1355 ""
+#line 1362 ""
allparts_(".05", &c__3, (ftnlen)3);
-#line 1356 ""
+#line 1363 ""
} else if (*iread != -1) {
-#line 1357 ""
- s_wsle(&io___185);
-#line 1357 ""
+#line 1364 ""
+ s_wsle(&io___187);
+#line 1364 ""
do_lio(&c__9, &c__1, "Error with iread in readin", (ftnlen)26);
-#line 1357 ""
+#line 1364 ""
e_wsle();
-#line 1358 ""
+#line 1365 ""
s_stop("", (ftnlen)0);
-#line 1359 ""
+#line 1366 ""
}
-#line 1360 ""
+#line 1367 ""
}
-#line 1361 ""
+#line 1368 ""
return ret_val;
} /* readin_ */
-/* Subroutine */ int chkcom_(char *line, ftnlen line_len)
+/* Subroutine */ int chkcom_(char *line, logical *goto999, ftnlen line_len)
{
/* System generated locals */
integer i__1, i__2;
@@ -3688,224 +3699,228 @@ L5:
static integer lenline;
/* Fortran I/O blocks */
- static cilist io___186 = { 0, 10, 0, "(a)", 0 };
- static cilist io___195 = { 0, 10, 0, "(a)", 0 };
- static cilist io___198 = { 0, 0, 0, "(a)", 0 };
- static cilist io___199 = { 0, 0, 0, "(a)", 0 };
- static cilist io___200 = { 0, 10, 1, "(a)", 0 };
+ 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 1373 ""
+#line 1380 ""
+ *goto999 = FALSE_;
+#line 1381 ""
L1:
-#line 1373 ""
+#line 1381 ""
if (*(unsigned char *)line != '%') {
-#line 1373 ""
+#line 1381 ""
return 0;
-#line 1373 ""
+#line 1381 ""
}
/* If here, line has some sort of comment */
-#line 1377 ""
+#line 1385 ""
if (*(unsigned char *)&line[1] == '%') {
-#line 1378 ""
+#line 1386 ""
if (! all_1.insetup) {
/* Suck up a line, then flow out of "if" block to get another and loop */
-#line 1382 ""
- s_rsfe(&io___186);
-#line 1382 ""
+#line 1390 ""
+ s_rsfe(&io___188);
+#line 1390 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 1382 ""
+#line 1390 ""
e_rsfe();
/* ++VV */
/* UNLESS (a) it has a score-only "M" and changes # of inst's. */
-#line 1388 ""
+#line 1396 ""
if (i_indx(line, "M", (ftnlen)128, (ftnlen)1) > 0) {
-#line 1389 ""
+#line 1397 ""
idxl = i_indx(line, "L", (ftnlen)128, (ftnlen)1);
-#line 1390 ""
+#line 1398 ""
idxm = i_indx(line, "M", (ftnlen)128, (ftnlen)1);
-#line 1391 ""
+#line 1399 ""
idxn = i_indx(line, "n", (ftnlen)128, (ftnlen)1);
-#line 1392 ""
+#line 1400 ""
idxb = i_indx(line, " ", (ftnlen)128, (ftnlen)1);
-#line 1393 ""
+#line 1401 ""
if (idxl < idxm && idxm < idxn && (idxb == 0 || idxn < idxb))
{
-#line 1395 ""
+#line 1403 ""
i__1 = idxn;
-#line 1395 ""
+#line 1403 ""
all_1.noinow = *(unsigned char *)&line[i__1] - 48;
-#line 1396 ""
+#line 1404 ""
clefpend = TRUE_;
/* Next noinow digits are original inst. #'s of new inst. set. Next noinow */
/* char's after that are clefs */
-#line 1401 ""
+#line 1409 ""
all_1.nvnow = 0;
-#line 1402 ""
+#line 1410 ""
i__1 = all_1.noinow;
-#line 1402 ""
+#line 1410 ""
for (j = 1; j <= i__1; ++j) {
-#line 1403 ""
+#line 1411 ""
i__2 = idxn + 1 + j - 1;
-#line 1403 ""
+#line 1411 ""
all_1.iorig[j - 1] = *(unsigned char *)&line[i__2] -
48;
-#line 1404 ""
+#line 1412 ""
iposc0 = idxn + 1 + all_1.noinow;
-#line 1405 ""
+#line 1413 ""
i__2 = all_1.nvi[all_1.iorig[j - 1] - 1];
-#line 1405 ""
+#line 1413 ""
for (k = 1; k <= i__2; ++k) {
-#line 1406 ""
+#line 1414 ""
++all_1.nvnow;
/* clefq(nvnow) = line(iposc0+nvnow:iposc0+nvnow) */
-#line 1408 ""
+#line 1416 ""
all_1.instnum[all_1.nvnow - 1] = j;
-#line 1409 ""
+#line 1417 ""
all_1.botv[all_1.nvnow - 1] = k == 1 && j != 1;
-#line 1410 ""
+#line 1418 ""
/* L25: */
-#line 1410 ""
+#line 1418 ""
}
-#line 1411 ""
+#line 1419 ""
/* L24: */
-#line 1411 ""
+#line 1419 ""
}
-#line 1412 ""
+#line 1420 ""
}
-#line 1413 ""
+#line 1421 ""
}
/* or if it's "h" or "l", need to suck up one more line */
-#line 1417 ""
+#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 1417 ""
- s_rsfe(&io___195);
-#line 1417 ""
+#line 1425 ""
+ s_rsfe(&io___197);
+#line 1425 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 1417 ""
+#line 1425 ""
e_rsfe();
-#line 1417 ""
+#line 1425 ""
}
/* 4/29/00 check for T string also */
-#line 1423 ""
+#line 1431 ""
} else {
/* In setup mode. Set flag, flow out and do use following line */
-#line 1427 ""
+#line 1435 ""
all_1.replacing = TRUE_;
-#line 1428 ""
+#line 1436 ""
}
-#line 1429 ""
+#line 1437 ""
} else if (*(unsigned char *)&line[1] == '!') {
/* Copy to all parts */
-#line 1433 ""
+#line 1441 ""
allparts_(line + 2, &c__125, (ftnlen)126);
-#line 1434 ""
+#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 1439 ""
+#line 1447 ""
ivq = i_indx("123456789abcdefghijklmno", line + 1, (ftnlen)24, (
ftnlen)1);
/* Only treat as part-specific pmx line if number .le. noinst */
-#line 1443 ""
+#line 1451 ""
if (ivq < 1 || ivq > all_1.noinst) {
/* Simple comment. */
-#line 1447 ""
+#line 1455 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 1448 ""
+#line 1456 ""
} else {
/* Instrument comment, copy only to part */
-#line 1452 ""
+#line 1460 ""
lenline = lenstr_(line, &c__128, (ftnlen)128);
-#line 1453 ""
+#line 1461 ""
if (lenline > 2) {
-#line 1454 ""
- io___198.ciunit = ivq + 10;
-#line 1454 ""
- s_wsfe(&io___198);
-#line 1454 ""
+#line 1462 ""
+ io___200.ciunit = ivq + 10;
+#line 1462 ""
+ s_wsfe(&io___200);
+#line 1462 ""
do_fio(&c__1, line + 2, lenline - 2);
-#line 1454 ""
+#line 1462 ""
e_wsfe();
-#line 1455 ""
+#line 1463 ""
} else {
/* Transferring blank line */
-#line 1459 ""
- io___199.ciunit = ivq + 10;
-#line 1459 ""
- s_wsfe(&io___199);
-#line 1459 ""
+#line 1467 ""
+ io___201.ciunit = ivq + 10;
+#line 1467 ""
+ s_wsfe(&io___201);
+#line 1467 ""
do_fio(&c__1, " ", (ftnlen)1);
-#line 1459 ""
+#line 1467 ""
e_wsfe();
-#line 1460 ""
+#line 1468 ""
}
-#line 1461 ""
+#line 1469 ""
}
-#line 1462 ""
+#line 1470 ""
}
-#line 1463 ""
- i__1 = s_rsfe(&io___200);
-#line 1463 ""
+#line 1471 ""
+ i__1 = s_rsfe(&io___202);
+#line 1471 ""
if (i__1 != 0) {
-#line 1463 ""
+#line 1471 ""
goto L2;
-#line 1463 ""
+#line 1471 ""
}
-#line 1463 ""
+#line 1471 ""
i__1 = do_fio(&c__1, line, (ftnlen)128);
-#line 1463 ""
+#line 1471 ""
if (i__1 != 0) {
-#line 1463 ""
+#line 1471 ""
goto L2;
-#line 1463 ""
+#line 1471 ""
}
-#line 1463 ""
+#line 1471 ""
i__1 = e_rsfe();
-#line 1463 ""
+#line 1471 ""
if (i__1 != 0) {
-#line 1463 ""
+#line 1471 ""
goto L2;
-#line 1463 ""
+#line 1471 ""
}
-#line 1464 ""
+#line 1472 ""
zapbl_(line, &c__128, (ftnlen)128);
-#line 1465 ""
+#line 1473 ""
goto L1;
-#line 1466 ""
+#line 1474 ""
L2:
-#line 1467 ""
+#line 1475 ""
+ *goto999 = TRUE_;
+#line 1476 ""
return 0;
} /* chkcom_ */
@@ -3927,13 +3942,13 @@ L2:
ftnlen);
/* Fortran I/O blocks */
- static cilist io___204 = { 0, 40, 0, "(i5)", 0 };
static cilist io___206 = { 0, 40, 0, "(i5)", 0 };
static cilist io___208 = { 0, 40, 0, "(i5)", 0 };
- static cilist io___209 = { 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, "(f5.2)", 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 };
@@ -3947,128 +3962,128 @@ L2:
/* 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 1486 ""
+#line 1495 ""
iccount = 0;
-#line 1487 ""
+#line 1496 ""
for (iset = 1; iset <= 12; ++iset) {
-#line 1488 ""
+#line 1497 ""
partnum_(iv, &iccount, line, &xdata, (ftnlen)128);
-#line 1489 ""
+#line 1498 ""
if (iset == 2) {
-#line 1490 ""
+#line 1499 ""
if (xdata > 0.f) {
-#line 1491 ""
- s_wsfe(&io___204);
-#line 1491 ""
+#line 1500 ""
+ s_wsfe(&io___206);
+#line 1500 ""
i__1 = (integer) (xdata + .1f);
-#line 1491 ""
+#line 1500 ""
do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
-#line 1491 ""
+#line 1500 ""
e_wsfe();
-#line 1492 ""
+#line 1501 ""
} else {
-#line 1493 ""
+#line 1502 ""
noi = -xdata + .1f;
-#line 1494 ""
- s_wsfe(&io___206);
-#line 1494 ""
+#line 1503 ""
+ s_wsfe(&io___208);
+#line 1503 ""
do_fio(&c__1, (char *)&noi, (ftnlen)sizeof(integer));
-#line 1494 ""
+#line 1503 ""
e_wsfe();
-#line 1495 ""
+#line 1504 ""
i__1 = noi;
-#line 1495 ""
+#line 1504 ""
for (ioi = 1; ioi <= i__1; ++ioi) {
-#line 1496 ""
+#line 1505 ""
partnum_(iv, &iccount, line, &xdata, (ftnlen)128);
-#line 1497 ""
- s_wsfe(&io___208);
-#line 1497 ""
+#line 1506 ""
+ s_wsfe(&io___210);
+#line 1506 ""
i__2 = (integer) (xdata + .1f);
-#line 1497 ""
+#line 1506 ""
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
-#line 1497 ""
+#line 1506 ""
e_wsfe();
-#line 1498 ""
+#line 1507 ""
/* L2: */
-#line 1498 ""
+#line 1507 ""
}
-#line 1499 ""
+#line 1508 ""
}
/* else if (iset.ne.8 .and. xdata.lt.0) then */
-#line 1501 ""
+#line 1510 ""
} else if (iset != 8 && iset != 5 && xdata < 0.f) {
/* Must be either nv or npages */
-#line 1505 ""
+#line 1514 ""
if ((integer) (-xdata + .1f) == 999) {
/* It's nv */
-#line 1509 ""
- s_wsfe(&io___209);
-#line 1509 ""
+#line 1518 ""
+ s_wsfe(&io___211);
+#line 1518 ""
do_fio(&c__1, (char *)&all_1.nvi[*iv - 1], (ftnlen)sizeof(
integer));
-#line 1509 ""
+#line 1518 ""
e_wsfe();
-#line 1510 ""
+#line 1519 ""
} else {
/* npages must be computed */
-#line 1514 ""
- s_wsfe(&io___210);
-#line 1514 ""
+#line 1523 ""
+ s_wsfe(&io___212);
+#line 1523 ""
i__1 = (all_1.nsyst - 1) / 12 + 1;
-#line 1514 ""
+#line 1523 ""
do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
-#line 1514 ""
+#line 1523 ""
e_wsfe();
-#line 1515 ""
+#line 1524 ""
}
-#line 1516 ""
+#line 1525 ""
} else if (iset != 7 && iset != 12) {
/* write integer */
-#line 1520 ""
- s_wsfe(&io___211);
-#line 1520 ""
+#line 1529 ""
+ s_wsfe(&io___213);
+#line 1529 ""
i__1 = i_nint(&xdata);
-#line 1520 ""
+#line 1529 ""
do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
-#line 1520 ""
+#line 1529 ""
e_wsfe();
-#line 1521 ""
+#line 1530 ""
} else {
/* write floating number */
-#line 1525 ""
- s_wsfe(&io___212);
-#line 1525 ""
+#line 1534 ""
+ s_wsfe(&io___214);
+#line 1534 ""
do_fio(&c__1, (char *)&xdata, (ftnlen)sizeof(real));
-#line 1525 ""
+#line 1534 ""
e_wsfe();
-#line 1526 ""
+#line 1535 ""
}
-#line 1527 ""
+#line 1536 ""
if (iset == 3) {
-#line 1528 ""
+#line 1537 ""
*mtrnum = i_nint(&xdata);
-#line 1529 ""
+#line 1538 ""
} else if (iset == 4) {
-#line 1530 ""
+#line 1539 ""
*mtrden = i_nint(&xdata);
-#line 1531 ""
+#line 1540 ""
}
-#line 1532 ""
+#line 1541 ""
/* L1: */
-#line 1532 ""
+#line 1541 ""
}
-#line 1533 ""
+#line 1542 ""
return 0;
} /* dosetup_ */
@@ -4098,139 +4113,139 @@ L2:
ftnlen);
/* Fortran I/O blocks */
- static cilist io___213 = { 0, 0, 0, "(a)", 0 };
- static cilist io___215 = { 0, 40, 0, "(a)", 0 };
- static cilist io___219 = { 0, 6, 0, 0, 0 };
+ 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 1541 ""
+#line 1550 ""
L2:
-#line 1541 ""
+#line 1550 ""
if (*iccount == 128) {
-#line 1542 ""
- io___213.ciunit = *iv + 10;
-#line 1542 ""
- s_rsfe(&io___213);
-#line 1542 ""
+#line 1551 ""
+ io___215.ciunit = *iv + 10;
+#line 1551 ""
+ s_rsfe(&io___215);
+#line 1551 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 1542 ""
+#line 1551 ""
e_rsfe();
-#line 1543 ""
+#line 1552 ""
if (*(unsigned char *)line == '%') {
-#line 1544 ""
+#line 1553 ""
len = lenstr_(line, &c__128, (ftnlen)128);
-#line 1545 ""
- s_wsfe(&io___215);
-#line 1545 ""
+#line 1554 ""
+ s_wsfe(&io___217);
+#line 1554 ""
do_fio(&c__1, line, len);
-#line 1545 ""
+#line 1554 ""
e_wsfe();
-#line 1546 ""
+#line 1555 ""
goto L2;
-#line 1547 ""
+#line 1556 ""
}
-#line 1548 ""
+#line 1557 ""
*iccount = 0;
-#line 1549 ""
+#line 1558 ""
}
-#line 1550 ""
+#line 1559 ""
++(*iccount);
/* Find next non-blank or end of line */
-#line 1554 ""
+#line 1563 ""
for (*iccount = *iccount; *iccount <= 127; ++(*iccount)) {
-#line 1555 ""
+#line 1564 ""
if (*(unsigned char *)&line[*iccount - 1] != ' ') {
-#line 1555 ""
+#line 1564 ""
goto L3;
-#line 1555 ""
+#line 1564 ""
}
-#line 1556 ""
+#line 1565 ""
/* L4: */
-#line 1556 ""
+#line 1565 ""
}
/* If here, iccount=128 and need to get a new line */
-#line 1560 ""
+#line 1569 ""
goto L2;
-#line 1561 ""
+#line 1570 ""
L3:
/* iccount now points to start of number to read */
-#line 1565 ""
+#line 1574 ""
i1 = *iccount;
-#line 1566 ""
+#line 1575 ""
L5:
-#line 1566 ""
+#line 1575 ""
getchar_(line, iccount, durq, (ftnlen)128, (ftnlen)1);
/* Remember that getchar first increments iccount, *then* reads a character. */
-#line 1570 ""
+#line 1579 ""
if (i_indx("0123456789.-", durq, (ftnlen)12, (ftnlen)1) > 0) {
-#line 1570 ""
+#line 1579 ""
goto L5;
-#line 1570 ""
+#line 1579 ""
}
-#line 1571 ""
+#line 1580 ""
i2 = *iccount - 1;
-#line 1572 ""
+#line 1581 ""
if (i2 < i1) {
-#line 1573 ""
- s_wsle(&io___219);
+#line 1582 ""
+ s_wsle(&io___221);
/* Writing concatenation */
-#line 1573 ""
+#line 1582 ""
i__1[0] = 7, a__1[0] = "Found \"";
-#line 1573 ""
+#line 1582 ""
i__1[1] = 1, a__1[1] = durq;
-#line 1573 ""
+#line 1582 ""
i__1[2] = 19, a__1[2] = "\" instead of number";
-#line 1573 ""
+#line 1582 ""
s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27);
-#line 1573 ""
+#line 1582 ""
do_lio(&c__9, &c__1, ch__1, (ftnlen)27);
-#line 1573 ""
+#line 1582 ""
e_wsle();
-#line 1574 ""
+#line 1583 ""
s_stop("1", (ftnlen)1);
-#line 1575 ""
+#line 1584 ""
}
-#line 1576 ""
+#line 1585 ""
icf = i2 - i1 + 49;
-#line 1577 ""
+#line 1586 ""
ici__1.icierr = 0;
-#line 1577 ""
+#line 1586 ""
ici__1.iciend = 0;
-#line 1577 ""
+#line 1586 ""
ici__1.icirnum = 1;
-#line 1577 ""
+#line 1586 ""
ici__1.icirlen = i2 - (i1 - 1);
-#line 1577 ""
+#line 1586 ""
ici__1.iciunit = line + (i1 - 1);
/* Writing concatenation */
-#line 1577 ""
+#line 1586 ""
i__1[0] = 2, a__1[0] = "(f";
-#line 1577 ""
+#line 1586 ""
*(unsigned char *)&ch__3[0] = icf;
-#line 1577 ""
+#line 1586 ""
i__1[1] = 1, a__1[1] = ch__3;
-#line 1577 ""
+#line 1586 ""
i__1[2] = 3, a__1[2] = ".0)";
-#line 1577 ""
+#line 1586 ""
ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2);
-#line 1577 ""
+#line 1586 ""
s_rsfi(&ici__1);
-#line 1577 ""
+#line 1586 ""
do_fio(&c__1, (char *)&(*xdata), (ftnlen)sizeof(real));
-#line 1577 ""
+#line 1586 ""
e_rsfi();
-#line 1578 ""
+#line 1587 ""
return 0;
} /* partnum_ */
@@ -4246,40 +4261,40 @@ L5:
/* Local variables */
static integer i__;
-#line 1590 ""
+#line 1599 ""
i__1 = *len;
-#line 1590 ""
+#line 1599 ""
for (i__ = 1; i__ <= i__1; ++i__) {
-#line 1591 ""
+#line 1600 ""
if (*(unsigned char *)&string[i__ - 1] == ' ') {
-#line 1591 ""
+#line 1600 ""
goto L1;
-#line 1591 ""
+#line 1600 ""
}
-#line 1592 ""
+#line 1601 ""
if (i__ == 1) {
-#line 1592 ""
+#line 1601 ""
return 0;
-#line 1592 ""
+#line 1601 ""
}
-#line 1593 ""
+#line 1602 ""
goto L2;
-#line 1594 ""
+#line 1603 ""
L1:
-#line 1594 ""
+#line 1603 ""
;
-#line 1594 ""
+#line 1603 ""
}
/* If line is all blank, leave it alone */
-#line 1598 ""
+#line 1607 ""
return 0;
-#line 1599 ""
+#line 1608 ""
L2:
-#line 1600 ""
+#line 1609 ""
s_copy(string, string + (i__ - 1), string_len, *len - (i__ - 1));
-#line 1601 ""
+#line 1610 ""
return 0;
} /* zapbl_ */
@@ -4296,25 +4311,25 @@ L2:
/* 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 1610 ""
+#line 1619 ""
numdqs = 0;
-#line 1611 ""
+#line 1620 ""
i__1 = *indx - 1;
-#line 1611 ""
+#line 1620 ""
for (i__ = 1; i__ <= i__1; ++i__) {
-#line 1612 ""
+#line 1621 ""
if (*(unsigned char *)&lineq[i__ - 1] == '"') {
-#line 1612 ""
+#line 1621 ""
++numdqs;
-#line 1612 ""
+#line 1621 ""
}
-#line 1613 ""
+#line 1622 ""
/* L1: */
-#line 1613 ""
+#line 1622 ""
}
-#line 1614 ""
+#line 1623 ""
*yesodd = numdqs % 2 == 1;
-#line 1615 ""
+#line 1624 ""
return 0;
} /* oddquotesbefore_ */