1 /*  -- translated by f2c (version 20031025).
2    You must link the resulting object file with libf2c:
3 	on Microsoft Windows system, link with libf2c.lib;
4 	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
5 	or, if you install libf2c.a in a standard place, with -lf2c -lm
6 	-- in that order, at the end of the command line, as in
7 		cc *.o -lf2c -lm
8 	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
9 
10 		http://www.netlib.org/f2c/libf2c.zip
11 */
12 
13 #include "f2c.h"
14 
15 /* Common Block Declarations */
16 
17 struct {
18     char versionc[5];
19 } comver_;
20 
21 #define comver_1 comver_
22 
23 struct {
24     integer miditime, lasttime;
25 } comevent_;
26 
27 #define comevent_1 comevent_
28 
29 struct {
30     integer levson[25], levsoff[25], imidso[25], naccbl[25], laccbl[250]
31 	    /* was [25][10] */, jaccbl[250]	/* was [25][10] */, nusebl;
32     logical slmon[25], dbltie;
33 } comslm_;
34 
35 #define comslm_1 comslm_
36 
37 struct {
38     integer imidi[25];
39     real trest[25];
40     integer mcpitch[20], mgap, iacclo[150]	/* was [25][6] */, iacchi[150]
41 	    	/* was [25][6] */, midinst[24], nmidcrd, midchan[48]	/*
42 	    was [24][2] */, numchan, naccim[25], laccim[250]	/* was [25][
43 	    10] */, jaccim[250]	/* was [25][10] */;
44     logical crdacc, notmain, restpend[25], relacc, twoline[24], ismidi;
45     shortint mmidi[614400]	/* was [25][24576] */;
46     logical debugmidi;
47 } commidi_;
48 
49 #define commidi_1 commidi_
50 
51 struct {
52     integer midivel[24], midvelc[25], midibal[24], midbc[25], miditran[24],
53 	    midtc[25], noinst;
54     shortint iinsiv[24];
55 } commvel_;
56 
57 #define commvel_1 commvel_
58 
59 struct {
60     integer ipbuf, ilbuf, nlbuf;
61     shortint lbuf[4000];
62     char bufq[65536];
63 } inbuff_;
64 
65 #define inbuff_1 inbuff_
66 
67 struct {
68     integer musize;
69     real whead20;
70 } commus_;
71 
72 #define commus_1 commus_
73 
74 union {
75     struct {
76 	integer iv, ivxo[600], ipo[600];
77 	real to[600], tno[600];
78 	integer nnl[24], nv, ibar, mtrnuml, nodur[4800]	/* was [24][200] */,
79 		lenbar, iccount, idum, itsofar[24], nib[360]	/* was [24][
80 		15] */, nn[24];
81 	logical rest[4800]	/* was [24][200] */;
82 	integer lenbr0, lenbr1;
83 	logical firstline, newmeter;
84     } _1;
85     struct {
86 	integer iv, ivxo[600], ipo[600];
87 	real to[600], tno[600];
88 	integer nnl[24], nv, ibar, mtrnuml, nodur[4800]	/* was [24][200] */,
89 		lenbar, iccount, nbars, itsofar[24], nib[360]	/* was [24][
90 		15] */, nn[24];
91 	logical rest[4800]	/* was [24][200] */;
92 	integer lenbr0, lenbr1;
93 	logical firstline, newmeter;
94     } _2;
95 } a1ll_;
96 
97 #define a1ll_1 (a1ll_._1)
98 #define a1ll_2 (a1ll_._2)
99 
100 struct {
101     integer n69[25], n34[25];
102 } comdiag_;
103 
104 #define comdiag_1 comdiag_
105 
106 struct {
107     integer mmacstrt[500]	/* was [25][20] */, mmacend[500]	/*
108 	    was [25][20] */, immac, mmactime[20], nmidsec, msecstrt[1500]
109 	    /* was [25][60] */, msecend[1500]	/* was [25][60] */;
110     logical mmacrec, gottempo;
111 } commmac_;
112 
113 #define commmac_1 commmac_
114 
115 struct {
116     integer linewcom[20000];
117 } truelinecount_;
118 
119 #define truelinecount_1 truelinecount_
120 
121 struct {
122     logical lastchar, fbon, issegno;
123     integer ihead;
124     logical isheadr;
125     integer nline;
126     logical isvolt;
127     real fracindent;
128     integer nsperi[24], linesinpmxmod, line1pmxmod, lenbuf0;
129 } c1omget_;
130 
131 #define c1omget_1 c1omget_
132 
133 struct {
134     integer naskb;
135     real task[40], wask[40], elask[40];
136 } comas1_;
137 
138 #define comas1_1 comas1_
139 
140 struct {
141     real udsp[50], tudsp[50];
142     integer nudsp;
143     real udoff[480]	/* was [24][20] */;
144     integer nudoff[24];
145 } comudsp_;
146 
147 #define comudsp_1 comudsp_
148 
149 struct comtol_1_ {
150     real tol;
151 };
152 
153 #define comtol_1 (*(struct comtol_1_ *) &comtol_)
154 
155 struct {
156     shortint ipslon[25], lusebl[10], jusebl[10];
157 } comips_;
158 
159 #define comips_1 comips_
160 
161 struct {
162     logical islast, usevshrink;
163 } comlast_;
164 
165 #define comlast_1 comlast_
166 
167 union {
168     struct {
169 	real space[80];
170 	integer nb;
171 	real prevtn[24], flgndv[24], flgndb, eskgnd, ptsgnd;
172 	integer ivmxsav[48]	/* was [24][2] */, nvmxsav[24];
173     } _1;
174     struct {
175 	real space[80];
176 	integer nb;
177 	real prevtn[24], flgndv[24];
178 	logical flgndb;
179 	real eskgnd, ptsgnd;
180 	integer ivmxsav[48]	/* was [24][2] */, nvmxsav[24];
181     } _2;
182 } comnsp_;
183 
184 #define comnsp_1 (comnsp_._1)
185 #define comnsp_2 (comnsp_._2)
186 
187 union {
188     struct {
189 	integer mult[4800]	/* was [24][200] */, iv, nnl[24], nv, ibar,
190 		ivxo[600], ipo[600];
191 	real to[600], tno[600], tnote[600], eskz[4800]	/* was [24][200] */;
192 	integer ipl[4800]	/* was [24][200] */, ibm1[216]	/* was [24][9]
193 		 */, ibm2[216]	/* was [24][9] */, nolev[4800]	/* was [24][
194 		200] */, ibmcnt[24], nodur[4800]	/* was [24][200] */,
195 		jn, lenbar, iccount, nbars, itsofar[24], nacc[4800]	/*
196 		was [24][200] */, nib[360]	/* was [24][15] */, nn[24],
197 		lenb0, lenb1;
198 	real slfac;
199 	integer musicsize;
200 	real stemmax, stemmin, stemlen;
201 	integer mtrnuml, mtrdenl, mtrnmp, mtrdnp, islur[4800]	/* was [24][
202 		200] */, ifigdr[250]	/* was [2][125] */, iline;
203 	logical figbass, figchk[2], firstgulp;
204 	integer irest[4800]	/* was [24][200] */, iornq[4824]	/*
205 		was [24][201] */, isdat1[202], isdat2[202], nsdat, isdat3[202]
206 		, isdat4[202];
207 	logical beamon[24], isfig[400]	/* was [2][200] */;
208 	char sepsymq[24], sq[1], ulq[216]	/* was [24][9] */;
209     } _1;
210     struct {
211 	integer mult[4800]	/* was [24][200] */, jv, nnl[24], nv, ibar,
212 		ivxo[600], ipo[600];
213 	real to[600], tno[600], tnote[600], eskz[4800]	/* was [24][200] */;
214 	integer ipl[4800]	/* was [24][200] */, ibm1[216]	/* was [24][9]
215 		 */, ibm2[216]	/* was [24][9] */, nolev[4800]	/* was [24][
216 		200] */, ibmcnt[24], nodur[4800]	/* was [24][200] */,
217 		jn, lenbar, iccount, nbars, itsofar[24], nacc[4800]	/*
218 		was [24][200] */, nib[360]	/* was [24][15] */, nn[24],
219 		lenb0, lenb1;
220 	real slfac;
221 	integer musicsize;
222 	real stemmax, stemmin, stemlen;
223 	integer mtrnuml, mtrdenl, mtrnmp, mtrdnp, islur[4800]	/* was [24][
224 		200] */, ifigdr[250]	/* was [2][125] */, iline;
225 	logical figbass, figchk[2], firstgulp;
226 	integer irest[4800]	/* was [24][200] */, iornq[4824]	/*
227 		was [24][201] */, isdat1[202], isdat2[202], nsdat, isdat3[202]
228 		, isdat4[202];
229 	logical beamon[24], isfig[400]	/* was [2][200] */;
230 	char sepsymq[24], sq[1], ulq[216]	/* was [24][9] */;
231     } _2;
232 } all_;
233 
234 #define all_1 (all_._1)
235 #define all_2 (all_._2)
236 
237 struct {
238     real eskz2[4800]	/* was [24][200] */;
239 } comeskz2_;
240 
241 #define comeskz2_1 comeskz2_
242 
243 struct {
244     integer ntot;
245 } comntot_;
246 
247 #define comntot_1 comntot_
248 
249 struct {
250     real hpttot[176];
251 } comhsp_;
252 
253 #define comhsp_1 comhsp_
254 
255 struct {
256     logical ispoi;
257 } compoi_;
258 
259 #define compoi_1 compoi_
260 
261 struct {
262     logical isbbm;
263 } combbm_;
264 
265 #define combbm_1 combbm_
266 
267 struct {
268     real ask[2500];
269     integer iask;
270     logical topmods;
271 } comas3_;
272 
273 #define comas3_1 comas3_
274 
275 struct {
276     integer ivbj1, ivbj2;
277     logical isbjmp, isbj2;
278 } combjmp_;
279 
280 #define combjmp_1 combjmp_
281 
282 struct {
283     integer noctup;
284 } comoct_;
285 
286 #define comoct_1 comoct_
287 
288 union {
289     struct {
290 	integer ixtup;
291 	logical vxtup[24];
292 	integer ntupv[216]	/* was [24][9] */, nolev1[24], mtupv[216]
293 		/* was [24][9] */, nxtinbm[24], islope[24];
294 	real xelsk[24], eloff[216]	/* was [24][9] */;
295 	integer nssb[24], issb[24], lev1ssb[480]	/* was [24][20] */;
296     } _1;
297     struct {
298 	integer ixtup;
299 	logical vxtup[24];
300 	integer ntupv[216]	/* was [24][9] */, nolev1[24], mtupv[216]
301 		/* was [24][9] */, nxtinbm[24], islope[24];
302 	real xels11[24], eloff[216]	/* was [24][9] */;
303 	integer nssb[24], issb[24], lev1ssb[480]	/* was [24][20] */;
304     } _2;
305 } comxtup_;
306 
307 #define comxtup_1 (comxtup_._1)
308 #define comxtup_2 (comxtup_._2)
309 
310 struct {
311     logical drawbm[24];
312 } comdraw_;
313 
314 #define comdraw_1 comdraw_
315 
316 struct {
317     integer nvmx[24], ivmx[48]	/* was [24][2] */, ivx;
318 } commvl_;
319 
320 #define commvl_1 commvl_
321 
322 struct {
323     integer ihnum3;
324     logical flipend[24];
325     integer ixrest[24];
326 } strtmid_;
327 
328 #define strtmid_1 strtmid_
329 
330 struct {
331     logical bar1syst;
332     real fixednew, scaldold, wheadpt, fbar, poenom;
333 } comask_;
334 
335 #define comask_1 comask_
336 
337 struct {
338     integer itopfacteur, ibotfacteur, interfacteur, isig0, isig, lastisig;
339     real fracindent, widthpt, height, hoffpt, voffpt;
340     integer idsig, lnam[24];
341     char inameq[1896];
342 } comtop_;
343 
344 #define comtop_1 comtop_
345 
346 struct {
347     integer ntrill, ivtrill[24], iptrill[24];
348     real xnsktr[24];
349     integer ncrd, icrdat[193], icrdot[193], icrdorn[193], nudorn, kudorn[63];
350     real ornhshft[63];
351     integer minlev, maxlev, icrd1, icrd2;
352 } comtrill_;
353 
354 #define comtrill_1 comtrill_
355 
356 struct {
357     integer nnb;
358     real sumx, sumy;
359     integer ipb[24];
360     real smed;
361 } comipb_;
362 
363 #define comipb_1 comipb_
364 
365 union {
366     struct {
367 	logical novshrinktop, cstuplet;
368     } _1;
369     struct {
370 	logical novshrinktop;
371 	real cstuplte;
372     } _2;
373 } comnvst_;
374 
375 #define comnvst_1 (comnvst_._1)
376 #define comnvst_2 (comnvst_._2)
377 
378 union {
379     struct {
380 	integer itfig[148]	/* was [2][74] */;
381 	char figq[1480]	/* was [2][74] */;
382 	integer ivupfig[148]	/* was [2][74] */, nfigs[2];
383 	real fullsize[24];
384 	integer ivxfig2;
385     } _1;
386     struct {
387 	integer itfig[148]	/* was [2][74] */;
388 	char figqq[1480]	/* was [2][74] */;
389 	integer ivupfig[148]	/* was [2][74] */, nfigs[2];
390 	real fullsize[24];
391 	integer ivxfig2;
392     } _2;
393 } comfig_;
394 
395 #define comfig_1 (comfig_._1)
396 #define comfig_2 (comfig_._2)
397 
398 struct comtrans_1_ {
399     char cheadq[60];
400 };
401 
402 #define comtrans_1 (*(struct comtrans_1_ *) &comtrans_)
403 
404 struct compage_1_ {
405     real widthpt, ptheight, hoffpt, voffpt;
406     integer nsyst, nflb, ibarflb[41], isysflb[41], npages, nfpb, ipagfpb[19],
407 	    isysfpb[19];
408     logical usefig;
409     real fintstf, gintstf, fracsys[30];
410     integer nmovbrk, isysmb[31], nistaff[41];
411 };
412 
413 #define compage_1 (*(struct compage_1_ *) &compage_)
414 
415 struct cblock_1_ {
416     real etatop, etabot, etait, etatc, etacs1, hgtin, hgtti, hgtco, xilbn,
417 	    xilbtc, xilhdr, xilfig, a, b;
418     integer inhnoh;
419 };
420 
421 #define cblock_1 (*(struct cblock_1_ *) &cblock_)
422 
423 struct cominbot_1_ {
424     integer inbothd;
425 };
426 
427 #define cominbot_1 (*(struct cominbot_1_ *) &cominbot_)
428 
429 struct comstart_1_ {
430     real facmtr;
431 };
432 
433 #define comstart_1 (*(struct comstart_1_ *) &comstart_)
434 
435 struct comtitl_1_ {
436     char instrq[120], titleq[120], compoq[120];
437     logical headlog;
438     integer inskip, ncskip, inhead;
439 };
440 
441 #define comtitl_1 (*(struct comtitl_1_ *) &comtitl_)
442 
443 struct spfacs_1_ {
444     real grafac, acgfac, accfac, xspfac, xb4fac, clefac, emgfac, flagfac,
445 	    dotfac, bacfac, agc1fac, gslfac, arpfac, rptfac;
446     integer lrrptfac;
447     real dbarfac, ddbarfac, dotsfac, upstmfac, rtshfac;
448 };
449 
450 #define spfacs_1 (*(struct spfacs_1_ *) &spfacs_)
451 
452 struct combmh_1_ {
453     real bmhgt, clefend;
454 };
455 
456 #define combmh_1 (*(struct combmh_1_ *) &combmh_)
457 
458 struct comdyn_1_ {
459     integer ndyn, idyndat[99], levdsav[24], ivowg[12];
460     real hoh1[12], hoh2[12], hoh2h1[2];
461     integer ntxtdyn, ivxiptxt[41];
462     char txtdynq[5248];
463     integer idynda2[99], levhssav[24], listcresc, listdecresc;
464 };
465 
466 #define comdyn_1 (*(struct comdyn_1_ *) &comdyn_)
467 
468 struct comkbdrests_1_ {
469     integer levbotr[8], levtopr[8];
470     logical kbdrests;
471 };
472 
473 #define comkbdrests_1 (*(struct comkbdrests_1_ *) &comkbdrests_)
474 
475 struct cominsttrans_1_ {
476     integer iinsttrans[24], itranskey[24], itransamt[24], instno[24],
477 	    ninsttrans;
478     logical earlytranson, laterinsttrans;
479 };
480 
481 #define cominsttrans_1 (*(struct cominsttrans_1_ *) &cominsttrans_)
482 
483 struct comsize_1_ {
484     integer isize[24];
485 };
486 
487 #define comsize_1 (*(struct comsize_1_ *) &comsize_)
488 
489 struct {
490     integer nnodur;
491     real wminnh[3999];
492     integer nnpd[4000];
493     real durb[4000];
494     integer iddot, nptr[3999], ibarcnt, mbrest, ibarmbr, ibaroff;
495     real udsp[3999], wheadpt;
496     logical gotclef;
497     real sqzb[4000];
498 } c1omnotes_;
499 
500 #define c1omnotes_1 c1omnotes_
501 
502 struct {
503     integer narp;
504     real tar[8];
505     integer ivar1[8], ipar1[8], levar1[8], ncmar1[8];
506     real xinsnow;
507     logical lowdot;
508 } comarp_;
509 
510 #define comarp_1 comarp_
511 
512 struct {
513     integer midisig;
514 } commidisig_;
515 
516 #define commidisig_1 commidisig_
517 
518 struct {
519     integer listslur;
520     logical upslur[48]	/* was [24][2] */;
521     integer ndxslur;
522     logical fontslur, wrotepsslurdefaults;
523     real slurcurve;
524 } comslur_;
525 
526 #define comslur_1 comslur_
527 
528 struct {
529     integer ivg[37], ipg[37], nolevg[74], itoff[148]	/* was [2][74] */;
530     real aftshft;
531     integer nng[37], ngstrt[37], ibarmbr, mbrest;
532     real xb4mbr;
533     integer noffseg, ngrace, nvolt, ivlit[83], iplit[83], nlit;
534     real graspace[37];
535     integer lenlit[83], multg[37];
536     logical upg[37], slurg[37], slashg[37];
537     integer naccg[74];
538     char voltxtq[120], litq[10624];
539 } comgrace_;
540 
541 #define comgrace_1 comgrace_
542 
543 struct {
544     integer is1n1, is2n1, irzbnd, isnx;
545 } comsln_;
546 
547 #define comsln_1 comsln_
548 
549 struct {
550     real eonk, ewmxk;
551 } comeon_;
552 
553 #define comeon_1 comeon_
554 
555 struct {
556     integer ipl2[4800]	/* was [24][200] */;
557 } comipl2_;
558 
559 #define comipl2_1 comipl2_
560 
561 struct {
562     integer ibmtyp;
563 } combeam_;
564 
565 #define combeam_1 combeam_
566 
567 struct {
568     integer macnum;
569     logical mrecord, mplay;
570     integer macuse, icchold;
571     char lnholdq[128];
572     logical endmac;
573 } commac_;
574 
575 #define commac_1 commac_
576 
577 struct {
578     integer nvmx[24], ivmx[48]	/* was [24][2] */, ivx;
579     real fbar;
580     integer nacc[4800]	/* was [24][200] */;
581 } c1ommvl_;
582 
583 #define c1ommvl_1 c1ommvl_
584 
585 union {
586     struct {
587 	integer nkeys, ibrkch[18], newkey[18];
588 	logical iskchb;
589 	integer idsig, isig1, mbrestsav;
590 	logical kchmid[18], ornrpt, shifton, barend;
591 	integer noinst;
592 	logical stickys;
593     } _1;
594     struct {
595 	integer nkeys, ibrkch[18], newkey[18];
596 	logical iskchb;
597 	integer idumm1, isig1, mbrestsav;
598 	logical kchmid[18], logdumm1, logdumm2, barend;
599 	integer noinst;
600 	logical logdumm3;
601     } _2;
602 } comkeys_;
603 
604 #define comkeys_1 (comkeys_._1)
605 #define comkeys_2 (comkeys_._2)
606 
607 struct {
608     logical isligfont;
609 } comligfont_;
610 
611 #define comligfont_1 comligfont_
612 
613 struct {
614     logical lastchar, rptnd1, sluron[48]	/* was [24][2] */, fbon,
615 	    ornrpt, stickys;
616     integer movbrk, movnmp, movdnp, movgap;
617     real parmov, fintstf, gintstf;
618     logical rptprev, equalize;
619     char rptfq1[1], rptfq2[1];
620 } comget_;
621 
622 #define comget_1 comget_
623 
624 struct {
625     logical ignorenats;
626 } comignorenats_;
627 
628 #define comignorenats_1 comignorenats_
629 
630 struct {
631     integer nnodur, lastlev, ndlev[48]	/* was [24][2] */;
632     logical shifton, setis, notcrd;
633     integer npreslur;
634     logical was2[24];
635     integer ninow;
636     logical nobar1;
637     integer nsystp[40], ipage;
638     logical optlinebreakties, headerspecial;
639 } comnotes_;
640 
641 #define comnotes_1 comnotes_
642 
643 struct {
644     integer ihdht;
645     logical lower;
646     char headrq[80], lowerq[80];
647     integer ihdvrt;
648 } comhead_;
649 
650 #define comhead_1 comhead_
651 
652 struct {
653     integer nfb[24];
654     real t1fb[960]	/* was [24][40] */, t2fb[960]	/* was [24][40] */;
655     char ulfbq[960]	/* was [24][40] */;
656     integer ifb;
657     real tautofb;
658     logical autofbon;
659     real t1autofb;
660 } comfb_;
661 
662 #define comfb_1 comfb_
663 
664 struct {
665     integer ncc[24];
666     real tcc[240]	/* was [24][10] */;
667     integer ncmidcc[240]	/* was [24][10] */, ndotmv[24];
668     real updot[480]	/* was [24][20] */, rtdot[480]	/* was [24][20] */;
669 } comcc_;
670 
671 #define comcc_1 comcc_
672 
673 struct {
674     logical bcspec;
675 } combc_;
676 
677 #define combc_1 combc_
678 
679 struct {
680     integer nsperi[24], nspern[24];
681     logical rename;
682     integer iiorig[24];
683 } comnvi_;
684 
685 #define comnvi_1 comnvi_
686 
687 struct {
688     integer ip1mac[20], il1mac[20], ip2mac[20], il2mac[20], ic1mac[20], ilmac,
689 	     iplmac;
690 } c1ommac_;
691 
692 #define c1ommac_1 c1ommac_
693 
694 struct {
695     char clefq[24];
696 } comclefq_;
697 
698 #define comclefq_1 comclefq_
699 
700 struct {
701     integer numarpshift, ivarpshift[20], iparpshift[20];
702     real arpshift[20];
703 } comarpshift_;
704 
705 #define comarpshift_1 comarpshift_
706 
707 struct {
708     integer ibarcnt;
709 } combibarcnt_;
710 
711 #define combibarcnt_1 combibarcnt_
712 
713 struct {
714     integer ivxudorn[63];
715 } comivxudorn_;
716 
717 #define comivxudorn_1 comivxudorn_
718 
719 struct {
720     integer nbc, ibcdata[36];
721 } comcb_;
722 
723 #define comcb_1 comcb_
724 
725 struct {
726     integer nasksys;
727     real wasksys[800], elasksys[800];
728 } comas2_;
729 
730 #define comas2_1 comas2_
731 
732 struct {
733     logical cwrferm[24];
734 } comcwrf_;
735 
736 #define comcwrf_1 comcwrf_
737 
738 struct {
739     real elskb, tnminb[3999];
740 } linecom_;
741 
742 #define linecom_1 linecom_
743 
744 /* Initialized data */
745 
746 struct {
747     char e_1[60];
748     } comtrans_ = { "                                                       "
749 	    "     " };
750 
751 struct {
752     real e_1[4];
753     integer fill_2[127];
754     real e_3[30];
755     integer fill_4[73];
756     } compage_ = { 524.f, 740.f, 0.f, 0.f, {0}, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f,
757 	    0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f,
758 	    0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f };
759 
760 struct {
761     real e_1[14];
762     integer e_2;
763     } cblock_ = { .5f, .25f, .4f, .4f, .2f, 12.f, 21.f, 12.f, 4.f, 1.6f, 5.f,
764 	    5.7f, 1.071f, 2.714f, 16 };
765 
766 struct {
767     integer e_1;
768     } cominbot_ = { 16 };
769 
770 struct {
771     real e_1;
772     } comstart_ = { .55f };
773 
774 struct {
775     char e_1[360];
776     logical e_2;
777     integer fill_3[3];
778     } comtitl_ = { "                                                        "
779 	    "                                                                "
780 	    "                                                                "
781 	    "                                                                "
782 	    "                                                                "
783 	    "                                                ", FALSE_ };
784 
785 struct {
786     real e_1[14];
787     integer e_2;
788     real e_3[5];
789     } spfacs_ = { 1.3333f, .4f, .7f, .3f, .2f, 2.f, 1.f, .7f, .7f, .9f, .5f,
790 	    9.f, 1.7f, 1.32f, 2, .47f, .83f, .17f, .5f, 1.f };
791 
792 struct {
793     real e_1[2];
794     } combmh_ = { 1.1f, 2.3f };
795 
796 struct {
797     integer fill_1[124];
798     integer e_2[12];
799     real e_3[26];
800     integer fill_4[1479];
801     } comdyn_ = { {0}, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 2.2f, 1.7f, 1.2f,
802 	    .7f, 1.3f, 1.3f, .4f, .8f, 1.2f, .8f, 1.2f, 1.6f, -2.7f, -2.2f,
803 	    -1.7f, -1.2f, -2.3f, -2.1f, -1.f, -1.7f, -2.1f, -1.6f, -1.9f,
804 	    -2.3f, -.3f, .3f };
805 
806 struct {
807     integer e_1[16];
808     logical e_2;
809     } comkbdrests_ = { 0, 0, 0, 2, 1, 4, 5, 4, 9, 7, 5, 5, 7, 5, 6, 6, FALSE_
810 	    };
811 
812 struct {
813     integer e_1[24];
814     integer fill_2[73];
815     logical e_3[2];
816     } cominsttrans_ = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
817 	    0, 0, 0, 0, 0, 0, {0}, FALSE_, FALSE_ };
818 
819 struct {
820     integer e_1[24];
821     } comsize_ = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
822 	     0, 0, 0, 0 };
823 
824 struct {
825     real e_1;
826     } comtol_ = { .001f };
827 
828 
829 /* Table of constant values */
830 
831 static integer c__9 = 9;
832 static integer c__1 = 1;
833 static integer c__44 = 44;
834 static integer c__2 = 2;
835 static integer c__4 = 4;
836 static integer c__128 = 128;
837 static integer c__3 = 3;
838 static logical c_true = TRUE_;
839 static logical c_false = FALSE_;
840 static integer c__92 = 92;
841 static integer c__11 = 11;
842 static integer c__12 = 12;
843 static integer c__17 = 17;
844 static integer c__14 = 14;
845 static integer c__129 = 129;
846 static integer c__5 = 5;
847 static integer c__22 = 22;
848 static integer c__0 = 0;
849 static integer c__6 = 6;
850 static integer c__27 = 27;
851 static integer c__7 = 7;
852 static integer c__10 = 10;
853 static integer c__20 = 20;
854 static real c_b761 = -2.f;
855 static real c_b762 = 0.f;
856 static real c_b807 = 1.f;
857 static integer c__8 = 8;
858 static integer c__16 = 16;
859 static integer c__23 = 23;
860 static integer c__39 = 39;
861 static integer c__96 = 96;
862 static integer c__21 = 21;
863 static integer c__19 = 19;
864 static integer c__24 = 24;
865 static integer c__13 = 13;
866 static integer c__28 = 28;
867 static integer c__18 = 18;
868 static real c_b1659 = 2.f;
869 static integer c__30 = 30;
870 static integer c__60 = 60;
871 static integer c__80 = 80;
872 static integer c__256 = 256;
873 static integer c__34 = 34;
874 static integer c__120 = 120;
875 static integer c__240 = 240;
876 static integer c__255 = 255;
877 static integer c__47 = 47;
878 
MAIN__(void)879 /* Main program */ int MAIN__(void)
880 {
881     /* Initialized data */
882 
883     static char date[9] = "3 Apr 13 ";
884     static char version[5] = "2.7  ";
885     static integer maxit = 200;
886     static integer ncalls = 0;
887     static logical isfirst = TRUE_;
888 
889     /* System generated locals */
890     address a__1[2], a__2[4], a__3[3];
891     integer i__1, i__2, i__3[2], i__4[4], i__5[3], i__6;
892     real r__1;
893     char ch__1[48], ch__2[64], ch__3[37], ch__4[55], ch__5[56];
894     olist o__1;
895     cllist cl__1;
896     inlist ioin__1;
897 
898     /* Builtin functions */
899     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
900     integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
901 	    e_wsle(void), s_rsfe(cilist *), do_fio(integer *, char *, ftnlen),
902 	     e_rsfe(void), s_cmp(char *, char *, ftnlen, ftnlen), i_indx(char
903 	    *, char *, ftnlen, ftnlen);
904     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
905     integer f_inqu(inlist *), f_open(olist *), f_clos(cllist *);
906     /* Subroutine */ int s_stop(char *, ftnlen);
907     integer s_wsfe(cilist *), e_wsfe(void);
908 
909     /* Local variables */
910     static real devnorm0;
911     static logical optimize;
912     extern /* Subroutine */ int poestats_(integer *, real *, real *, real *),
913 	    writemidi_(char *, integer *, ftnlen);
914     static integer ncomments, ip1, ilb, icm;
915     static real poe[125];
916     static integer ivt, ivx;
917     static real poe0[125];
918     static integer ljob, ipoe[125];
919     extern /* Subroutine */ int pmxa_(char *, integer *, logical *, integer *,
920 	     integer *, logical *, ftnlen), pmxb_(logical *, real *, integer *
921 	    , logical *);
922     static integer ivtt, isys, ljob4;
923     extern /* Subroutine */ int stop1_(void);
924     extern integer iargc_(void);
925     static integer nbari[125], nbars[125], iinst, isysd, numit, isyst, isysu,
926 	    nsyst, nbars0[125];
927     static real poebar;
928     extern /* Subroutine */ int getarg_(integer *, char *, ftnlen);
929     static integer idnord, iplast;
930     static logical fexist;
931     static real devpmx;
932     static integer iupord;
933     extern integer lenstr_(char *, integer *, ftnlen);
934     extern /* Subroutine */ int printl_(char *, ftnlen);
935     static integer ndxpmx;
936     static real poebar0;
937     static char jobname[44], infileq[47], lnholdq[128];
938     static real devnorm;
939     static integer numargs, nstaves;
940     extern /* Subroutine */ int sortpoe_(integer *, real *, integer *);
941 
942     /* Fortran I/O blocks */
943     static cilist io___10 = { 0, 6, 0, 0, 0 };
944     static cilist io___11 = { 0, 6, 0, 0, 0 };
945     static cilist io___12 = { 0, 5, 0, "(a)", 0 };
946     static cilist io___15 = { 0, 6, 0, 0, 0 };
947     static cilist io___16 = { 0, 6, 0, 0, 0 };
948     static cilist io___17 = { 0, 6, 0, 0, 0 };
949     static cilist io___21 = { 0, 6, 0, 0, 0 };
950     static cilist io___24 = { 0, 18, 1, "(a)", 0 };
951     static cilist io___26 = { 0, 6, 0, 0, 0 };
952     static cilist io___34 = { 0, 6, 0, 0, 0 };
953     static cilist io___35 = { 0, 15, 0, 0, 0 };
954     static cilist io___39 = { 0, 6, 0, 0, 0 };
955     static cilist io___40 = { 0, 15, 0, 0, 0 };
956     static cilist io___42 = { 0, 15, 0, 0, 0 };
957     static cilist io___51 = { 0, 6, 0, 0, 0 };
958     static cilist io___52 = { 0, 15, 0, 0, 0 };
959     static cilist io___60 = { 0, 6, 0, 0, 0 };
960     static cilist io___61 = { 0, 15, 0, 0, 0 };
961     static cilist io___62 = { 0, 6, 0, "(5x,20i3)", 0 };
962     static cilist io___63 = { 0, 15, 0, "(5x,20i3)", 0 };
963     static cilist io___64 = { 0, 6, 0, 0, 0 };
964     static cilist io___65 = { 0, 15, 0, 0, 0 };
965     static cilist io___66 = { 0, 6, 0, 0, 0 };
966     static cilist io___67 = { 0, 15, 0, 0, 0 };
967     static cilist io___68 = { 0, 6, 0, 0, 0 };
968     static cilist io___69 = { 0, 15, 0, 0, 0 };
969     static cilist io___70 = { 0, 6, 0, "(5x,20i3)", 0 };
970     static cilist io___71 = { 0, 15, 0, "(5x,20i3)", 0 };
971     static cilist io___72 = { 0, 6, 0, "(5x,20i3)", 0 };
972     static cilist io___73 = { 0, 15, 0, "(5x,20i3)", 0 };
973 
974 
975 
976 /* This program, PMX, developed by Don Simons */
977 /* (dsimons@roadrunner.com), is a preprocessor for MusiXTeX. In concert with */
978 /* MusiXTeX and TeX, its purpose is to allow the user to create high-quality */
979 /* typeset musical scores by including a sequence of PMX commands in an ASCII */
980 /* input file. */
981 
982 /* This program is free software: you can redistribute it and/or modify */
983 /* it under the terms of the GNU General Public License as published by */
984 /* the Free Software Foundation, either version 3 of the License, or */
985 /* (at your option) any later version. */
986 
987 /* This program is distributed in the hope that it will be useful, */
988 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
989 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the */
990 /* GNU General Public License for more details. */
991 
992 /* You should have received a copy of the GNU General Public License */
993 /* along with this program.  If not, see <http://www.gnu.org/licenses/>. */
994 
995 
996 
997 /* To compile with gfortran: */
998 /*   1. Merge all files using copy *.for epmx[nnnn].for */
999 /*   2. Search and replace all character*65536 with character*131072 */
1000 /*   3. Comment/uncomment getarg lines */
1001 /*   4. gfortran -O pmx[nnnn].for -o pmxab.exe */
1002 
1003 /* To do */
1004 /*   Correct Rainer's email address in manual */
1005 /*   Linesplit (\\) in h */
1006 /*   Tt at start of a movement. */
1007 /*   Toggle midi on or off; allow midi only. */
1008 /*   Page number printed on 1st page even if 1 system. */
1009 /*   Still need inserted space for chordal accidentals */
1010 /*   Voicewise transposition. */
1011 /*   better segno */
1012 /*   coda */
1013 /*   duevolte */
1014 /*   Fix xtup bracket direction in 2-line staves?? (maybe leave as is) */
1015 /*   Sticky ornaments with shifts. */
1016 /*   Deal with Werner's vertical spacing thing associated with title. */
1017 /*   Multiple ties in midi */
1018 /*   Werner's missing c in MIDI due to start/stop ties on same note. */
1019 /*   Beams with single 64ths */
1020 /*   128ths and/or dotted 64ths */
1021 /*   Close out MIDI with integral # of beats? */
1022 /*   Increase ast dimensions or redo logic. */
1023 /*   Does slur direction get set for user-defined single-note stem dir'ns? */
1024 /*   Transpose by sections. */
1025 /*   Optimization loop over sections only */
1026 /*   Command-line option to read nbarss in. Write out nbarss when optimizing. */
1027 /*     (or just read from .plg?) */
1028 /*   Beams over bar lines. */
1029 /*   2-digit figures */
1030 /*   A real coule (slanted line between notes in a chord) */
1031 /*   Dotted slurs for grace notes. */
1032 /*   Undotted chord notes with dotted main note. */
1033 /*   Forced line break without line number */
1034 /*   Fix dot moving when 2nds in chord get flipped */
1035 /*   To do: increase length on notexq in dodyn */
1036 /* 2.70 */
1037 /*   To do: coda */
1038 /*   To do: fix grace note spacing problem (partially done) */
1039 /* 2.622 */
1040 /*   Redefine midtc(..) and miditran(..); clean up all transpositions/key changes */
1041 /*   Kn[+/-...] \ignorenats at signature changes */
1042 /*   Fix tie checks in doslur() and dopsslur() to subtract iTransAmt from nolevs */
1043 /*     before checking and setting pitch levels levson() and levsoff() */
1044 /*   Define midisig separately from isig. Put in common commidisig. */
1045 /*     Use for explicit midi signature and for accid corrections to midi piches */
1046 /*     in addmidi. */
1047 /* 2.621 */
1048 /*   Make keyboard rest option work in xtuplets. Created subroutine */
1049 /*     chkkbdrests, modified make2bar to include calls to chkkbdrests as rqd. */
1050 /* 2.620 */
1051 /*   Allow user-defined rest height tweaks at start of beam. */
1052 /* 2.619 */
1053 /*   At movement break, change \nbinstruments in \newmovement macro; add */
1054 /*     3rd arg to \newmovement in pmx.tex; modify pmxb.for and getnote.for */
1055 /*     to remove call to newnoi and change call to \newmovement */
1056 /* 2.618 */
1057 /*   Add option Ac[l,4] to set vert and horiz size and offsets to properly */
1058 /*     center page for letter or a4 paper. */
1059 /* 2.617 */
1060 /*   In g1etnote, change if-check for note to use index(...) instead */
1061 /*     of ichar(charq) since it was messing up gfortran optimizer */
1062 /*   After pmxa, search for and remove penultimate line <blank><blank>/ */
1063 /*     because it was screwing up linux-compiled versions */
1064 /*   Bugfix: Increase dimension of kicrd from 7 to 10 in crdaccs(...) */
1065 /* 2.616 (111110) */
1066 /*   Allow hairpins to span multiple notes groups (gulps). */
1067 /* 2.615+ (110810) */
1068 /*   Fix midi when some instruments are transposed, by subtracting */
1069 /*     iTransAmt(instno(iv)) from pitch values sent to via addmidi in */
1070 /*     make2bar.for (for main notes) and docrd (for chord notes) */
1071 /* 2.615 (110725) */
1072 /*   Fig bug with size-setting (in topfile) when instrument has >1 staves */
1073 /* 2.615 (110724) */
1074 /*   Make AS[0|-|s|t]... really set sizes */
1075 /* 2.614 */
1076 /*   Mod notex.for to fix Terry's bug with raised dotted rests (caused */
1077 /*     by double-hboxing). */
1078 /* 2.613 */
1079 /*   Bugfix: In pmxa, change "do while" limit to keep from overwriting instno. */
1080 /* 2.612 */
1081 /*   Enhance AS to allow s or t for smallsize or tinysize */
1082 /* 2.611 */
1083 /*   Error trap for "D" before any notes in a block. */
1084 /* 2.610 */
1085 /*   Instrument-wise key changes and transposition (incomplete) */
1086 /* 2.603 */
1087 /*   101211 In getpmxmod.for, decreased nline by 2 to fix locating errors */
1088 /*     following reading in an include file. */
1089 /*   101121 Added some error messages in g1etset.for setup data */
1090 /* 2.602 */
1091 /*   Correct slur indexing in linebreakslurs. */
1092 /*   Account for comment lines in line count for error messages */
1093 /* 2.601 */
1094 /*   Bug fix: allow 24 slurs with graces */
1095 /* 2.60 Changes made make it really big */
1096 /*   increase mv (size of midi) ? Note: MIDI can't have >16 voices w/o */
1097 /*     major reprogramming, and 16 may also be a problem (icmm) */
1098 /*   nm=24 (voices) done */
1099 /*   24 slurs done */
1100 /*   24 simultaneous beams (Replace index 24 by 0, so get 0-23) */
1101 /*   bufq*131072 (gfortran only) */
1102 /*   getarg syntax (gfortran only) */
1103 /* 2.523+ */
1104 /*   Fix voice numbering for normal dynamics and text dynamics */
1105 /* 2.523 */
1106 /*   Version of bigpmx first posted to Hiroaki's web site. */
1107 /* 2.522 */
1108 /*   5/26/10 Replace ipl bits 0-7 with ipl2, add new common for it. */
1109 /*   With 2.521+ as starting version, incorporate bigpmx mods to allow 24 voices. */
1110 /*   5/13/10 Fix log2 function */
1111 /*   5/15/10 Fix bitwise storage for dynamics, fix segnoo string length. */
1112 /* 2.521+ */
1113 /*   091025 Enable dotting 2nd part of linebreak slur or tie. */
1114 /*   To adjust barno height due to linebreak slur, use \bnrs instead of */
1115 /*     explicitly redefining \raisebarno (pmxb) */
1116 /* 2.521 */
1117 /*   Bugfix */
1118 /* 2.520 */
1119 /*   090519 Enable ligfonts (special figured bass characters) */
1120 /* 2.519 */
1121 /*   Fix another bug which kept \sk from being output so misaligned some notes. */
1122 /* 2.518 */
1123 /*   Fix bugs: referencing fig data, char declaration for member of */
1124 /*      common/comfig/ */
1125 /* 2.517 */
1126 /*   Allow figures in voice 1 + any one other. */
1127 /* 2.516 */
1128 /*   Allow figures in voice #2 */
1129 /* 2.515+ to do: Change manual and activate rule against clef change in voice #2. */
1130 /* 2.515 */
1131 /*   071222 Changes in getnote to allow auto forced beams to start anywhere. */
1132 /*   071206 In make2bar, shift fermataup7 to left over centered pause. */
1133 /*   070901 In doslur, check for nolev <=2 in case slur ends on rest in 2-line */
1134 /*       staff (it was screwing up vertical justification). */
1135 /*   n34 for tweaks to midi durations of quarter note septuplets. */
1136 /*   To do: In ref250.tex, the tables where 's,t,)' is explained, the line */
1137 /*       [+,- i]   ... Vertical adjustment of the start of second segment */
1138 /*     should it be replaced by */
1139 /*       [s +,- i]   ... Vertical adjustment of the start of second segment */
1140 /* 2.514 */
1141 /*   Changes in make2bar to get horizontal spacing right when normal grace */
1142 /*     follows after grace */
1143 /*   Changes in dograce to get octaves right for any material entered inside */
1144 /*     \gaft, which shields transpose register changes from the outside world. */
1145 /* 2.513 */
1146 /*   In make1bar, near end, for forced beams starting with a rest, copy hgt and */
1147 /*     slope tweaks to ALL notes after first, not just the second one, so if */
1148 /*     there's more than one rest at start the tweaks are still observed. */
1149 /*   In beamid and beamend, add stand-alone triply-flagged notes for xtups. */
1150 /* 2.512 */
1151 /*   Near end of pmxb, fix error trap to allow redundant 'RD' */
1152 /*   Enable multiplicity down-up '][' within xtup. */
1153 /* 2.511 */
1154 /*   Introduce eskz2 for xtup #'s and bracket lengths, to remove bug caused by */
1155 /*     adjusteskz as in bar 7 of barsant. */
1156 /* 2.510a */
1157 /*   Test: remove restriction on tempo changes in MIDI macros */
1158 /*     Send to CM for beta testing. */
1159 /* 2.509+ */
1160 /*   To do: Correct manual on AS. "-" is for smaller staves. */
1161 /* 2.510 */
1162 /*   Forgot to declare litq, voltxtq as character in subroutine getgrace */
1163 /* 2.509 */
1164 /*   Corrected small bug in arpeggio shifting (ivx <= iv in call putarp) */
1165 /* 2.508 */
1166 /*   Allow graces in xtups. New subroutine getgrace. */
1167 /* 2.507 */
1168 /*   To do: Raise/lower figures. */
1169 /*   To do: Add 24, 29 to list of musicsizes in manual */
1170 /*   New sub adjusteskz to account for ask's when computing lengths of */
1171 /*     brackets for unbeamed xtups, slopes and horizontal posn's of number */
1172 /*   Bug fix: in beamn1, beamid, and beamend, allow unbeamed xtups w/ 2 flags */
1173 /*   Add look-left option for keyboard rests, "L" in rest command, set iornq(30) */
1174 /* 2.506 */
1175 /*   Fix bug with AK, when simultaneous rests have same duration, use defaults. */
1176 /* 2.505 */
1177 /*   Keyboard rests AK */
1178 /* 2.504 */
1179 /*   Space after normal grace: option X[n] */
1180 /*   Fixed og when nv .ne. noinst, by using sepsymq instead of '&' */
1181 /*   (To do) length of xtup bracket when there is added non-collision space. */
1182 /*   Trap musicsize if .ne. 16,20,24,29. */
1183 /* 2.503 */
1184 /*   Enable arpeggio left shift with ?-x */
1185 /*   To do: In manual, arpeggio over 2 staves. */
1186 /*   Allow musicsize of 24 and 29. Had to define meter font size explicitly, */
1187 /*     also change font size for text dynamics, but not much else so far. */
1188 /*   Bugfix in beamstrt, introduced in 2415, ip was changed before putxtn */
1189 /*     was called, causing error in printing replacement number. */
1190 /* 2.502 */
1191 /*   Incorporate Dirk Laurie's patch to use { , } , for ties. */
1192 /*   Figure height adjustment: append +[n] */
1193 /*   Change ec font stuff in pmx.tex per Olivier Vogel's comment (CM email?) */
1194 /* 2.501 */
1195 /*   Readjust horizontal offset back to .8 in LineBreakTies */
1196 /*   Fix zero-subscript (iudorn) in putorn */
1197 /* 2.50 */
1198 /*   Increase number of text-dynamics (dimension of txtdynq) per block */
1199 /*     from 12 to 41. */
1200 /*   Slur option n to override altered default curvature. */
1201 /*   Allow default ps slur curvature tweaks with Ap+/-c */
1202 /* 2.416 */
1203 /*   Increase length of textdynq from 24 to 128 */
1204 /*   (Todo) Add comment in manual about blank lines at end. */
1205 /*   Configuration file: Define subroutine getpmxmod, check path in environment */
1206 /*     variable pmxmoddir, check existence, read lines into bufq after setup. */
1207 /*   Increase dimension on idynn in dodyn from 4 to 10 for max number */
1208 /*     of marks in a bar */
1209 /*   Increase allowable # of lines from 2000 to 4000. */
1210 /*   (To do) Replace definition of \liftpausc per Olivier. */
1211 /*   (To do) Fix extraneous error message if RD is placed at very end. */
1212 /* 2.415 */
1213 /*   Fix "AT" option: replace putxtn,topfile,beamstrt,beamid to use \xnumt */
1214 /*     instead of redefining \xnum. Change font used to \smallfont (as for */
1215 /*     normal xtups, */
1216 /*   Allow slur to start on rest. */
1217 /* 2.414 */
1218 /*   Correct bug in crdacc when adding accidental to boundary causes number of */
1219 /*     segments to decrease */
1220 /*   Special rule for 3-accidental chords: If no 2nds, place them in order */
1221 /*     top, bottom, middle. */
1222 /* 2.413 */
1223 /*   Correct bugs in chordal accidentals, related to left-shifted noteheads */
1224 /*     (a) Special problems with downstem when main note needs shifting */
1225 /*     (b) Assign 0 rank to boundary segs due to left-shifted noteheads */
1226 /* 2.412 */
1227 /*   Change default horiz shift of start of seg 2 of linebreak slurs: */
1228 /*     -.7 for slurs, -1.2 for ties, */
1229 /*   Use height of start of seg 1 slur itself for end of 1 and start of 2. */
1230 /* 2.411 */
1231 /*   "Apl" activates special treatment of linebreak slur/tie's; breaks all in 2. */
1232 /*   "s" option in start of slur/tie as precursor to vert/horiz tweaks for end */
1233 /*      of seg 1. of linebreak slur/tie, 2nd "s" for start of seg2. */
1234 /*   With "Apl", curvature adjustments on starting slur command apply to seg 1, */
1235 /*      those on ending command to seg 2. */
1236 /* 2.410 */
1237 /*   "AT" to allow Col. S.'s tuplet option. Simply input tuplet.tex and redefine */
1238 /*      \xnum, \unbkt, \ovbkt. */
1239 /*   "s" option in main xtup input after "x": slope tweak for bracket. mult(4) is */
1240 /*      flag, mult(5-9) is tweak value+16 */
1241 /* 2.409 */
1242 /*   Bugfix in docrd for MIDI: Use original pitch in case main/chord were */
1243 /*     switched due to 2nds. */
1244 /*   Remove "o" from error message for "A" command. */
1245 /*   New syntax: optional instrument number separator ":" in movement */
1246 /*     break command to precede a 2-digit instrument. */
1247 /*   Conditional output formats for \setname at movement break to allow */
1248 /*     instrument numbers >9. */
1249 /*   Bugfix in coding to raise barno due to slur over line break (pmxb) */
1250 /*   Move date/version data statement in pmxab to a better place. */
1251 /* 2.408 */
1252 /*   Allow pnotes{x} when x>9.995 (mod is only to format stmt in make2bar). */
1253 /*   Bug fix in \liftPAusep in notex.for and in pmx.tex */
1254 /*   Character variables for version and date */
1255 /*   For up-stem single graces slurred to down-stem, shift slur start left by */
1256 /*     0.8 so slur doesn't get too short. */
1257 /*   Initialize and slide mult, same as other full-program variables in /all/. */
1258 /* 2.407 */
1259 /*   Allow AN[n]"[partname]" to be parsed by scor2prt as filename for part n, */
1260 /* 2.406 */
1261 /*   Alter PMX: put \dnstrut into \znotes in \starteq (for system spacing */
1262 /*     equalization). */
1263 /*   Put dimensions of double sharps and flats in crdacc (for chords). */
1264 /*   Bugfix: Use sepsymq in LineBreakTies(..) instead of '&' */
1265 /*   Use only first 4 bits of mult for multiplicity+8, so rest can be used */
1266 /*     for other stuff. */
1267 /*   Move stemlength stuff in nacc(27-30) to mult(27-30) to remove conflict. */
1268 /* 2.405: Not published but saved for safety. */
1269 /*   Option Aph to write \special{header=psslurs.pro} top of each page, so */
1270 /*     dviselec will work OK. */
1271 /* 2.404 */
1272 /*   Allow slur to end on rest, but not start on a rest.  Efaults height */
1273 /*     of ending is default height of start (before any automatic or user- */
1274 /*     defined djustments). User may adjust height as normal from default. */
1275 /* 2.403 */
1276 /*   Bugfix: turn off repeated beaming patterns.at end of non-last voice. */
1277 /* 2.402 */
1278 /*   Automatic repeated forced beams.  Start with "[:"  End with next explicit */
1279 /*     forced beam or end of input block. */
1280 /*   Increase # of forced beams per line of music per input block from 20 to 40 */
1281 /* 2.401 */
1282 /*   Optional K-Postscript Linebreak Ties, Apl. New subroutine LineBreakTies. */
1283 /*     Makes 1st part normal shape, and starts 2nd part a little further left. */
1284 /*   Enable arpeggios in xtuplets.  Had to make time itar(narp) a real. */
1285 /* 2.40 */
1286 /*   Set up WrotePsslurDefaults (logical) so only write defaults on 1st Ap. */
1287 /*   Fix non-ps-slur input to \midslur (third signed integer). Do not reverse */
1288 /*     sign for down-slurs. */
1289 /* 2.359 */
1290 /*   Add error exit subroutine stop1 to make exit status g77-compatible.. */
1291 /*   Absolute octave on xtup chord note was 2 octave too high, fixed in getnote */
1292 /*   Fermata on vertically shifted rest: special trap in putorn() to set height. */
1293 /*   Correct multiple grace note spacing for small staves (in dograce, */
1294 /*        define wheadpt1 depending on staff size) */
1295 /* 2.358 */
1296 /*   Allow curvature corrections at start of postscript slur, in dopsslur() */
1297 /*   Local slur options p[+|-][s|t] for [nos|s]luradjust,[not|t]ieadjust */
1298 /*   Options for [Nos|S]luradjust,[Not|T]ieadjust,[noh|h]alfties: Ap[+|-][s|t|h] */
1299 /*   Make t[ID] act like s[ID]t, most mods in spsslur(). */
1300 /*   Add spsslur() to read in data for ps slurs, call from getnote. */
1301 /*   In beamstrt, save args for SetupB in common comipb to save them for */
1302 /*      2nd call when xtup starts with rest */
1303 /*   Add spacing for ornament ")" as if it were accidental, in make2bar(). */
1304 /*   Horiz shift start and end of ps ties, dep. on stem dir'n, in dopsslur() */
1305 /*   Horiz. shift start of ps grace slur, 2 places in dograce(). */
1306 /*   Horiz shift end of grace slur in endslur() */
1307 /*   Make st slurs into postscript ties.  Separate subroutine dopsslur(), */
1308 /*   Non-beamed xtup: "a" in 1st note or rest, before "x" (sets drawbm=.false.) */
1309 /*   Allow two D"x" on same note. Introduced jtxtdyn1 in dodyn. */
1310 /* 2.357a */
1311 /*   Fix missing "end" in backfill.com, too-long lines in g1etnote, getnote */
1312 /* 2.357 */
1313 /*   Increase dimension for # of lit TeX strings from 52 to 83. */
1314 /*   Allow blank rest in middle of xtuplet. Only mods in g*etnote(). */
1315 /* 2.356 */
1316 /*   Increased some dimensions from 30 to 40 to allow up to 40 pages. */
1317 /*   In unbeamed xtups, "n" did not suppress bracket.  Fixed in beamstrt(). */
1318 /*   Fix parsing of "f,h,H,HH" in sslur. */
1319 /*   Fix bug with cdot, note-level for slur termination (in getnote) */
1320 /* 2.355 */
1321 /*   Midi transposition:  IT[+|-][n1][+|-][n2]...[+|-][n(noinst)], */
1322 /*      n=# of half-steps.  Restrict to mult. of 12 now, to avoid key-sig issues */
1323 /*   Make midi recognize ps ties in doslur. */
1324 /*   Correct ttieforsl so that it eats 2nd argument properly, using \zcharnote */
1325 /*      to get octave right. */
1326 /* 2.354 */
1327 /*   With postscript slurs, make t-slurs real ties by inserting replacement */
1328 /*     macros \tieforisu, etc, defined in pmx.tex */
1329 /*   Check for open cresc or decresc at end of input block, using list[de]cresc */
1330 /*   Hairpin syntax conditional on postscript slurs. Backup to fill in start */
1331 /*     level, using new backfill(...).  Separate height tweaks for */
1332 /*     start and finish. */
1333 /* 2.353 */
1334 /*   K-0+n to transpose by half step (rather than just change key) */
1335 /*   Allow "rm[n]" when nv>1.  Require it in all parts. Just write a stack of */
1336 /*     \mbrest's */
1337 /*   Enable "Rz"; define \setzalaligne in pmx.tex. Special treatment at end */
1338 /*     of input block before movement break, and at start of block after */
1339 /*     movement break, using \newmovement rather than \setzalaligne, since */
1340 /*     former already redefines \stoppiece. In second case, set rptfg2='z'. */
1341 /*   Make clefq(nm) common between pmxb and getnote; change references in */
1342 /*     getnote at 'M' to array elements, setting all new clefs as you go. */
1343 /* 2.352 */
1344 /*   Remove \parskip redefinition from pmx.tex; write it into TeX file when */
1345 /*     "Ae" is invoked. */
1346 /*   Ap to activate postscript slurs. Add macro \psforts to pmx.tex to redefine */
1347 /*     \tslur in case \midslur was used.  Allow slur inputs 'f','h','H','HH', */
1348 /*     translate them thru mapping to (1,4,5,6) as \midslur params, then let */
1349 /*     \psforts translate them back to ps slur macors. */
1350 /* 2.351 */
1351 /*   Number slurs from 0 up instead of 11 down, anticipating postscript slurs. */
1352 /*   Write "\eightrm" instead of "\cmr8" for \figfont with small baseline size. */
1353 /*   Increase length of basenameq to 44 characters everywhere. */
1354 /*   Increase dimension of mcpitch (midi-chord-pitch) to 20. */
1355 /*   Set default systems per page to 1 if nv>7 */
1356 /*   In pmxb, move place where isystpg is reset to 0, so that \eject gets */
1357 /*     written when there is just one system per page. */
1358 /* 2.35 */
1359 /*   Cautionary accidentals with 'c' anywhere in note symbol. */
1360 /*   NEW pmx.tex with \resetsize to set size to normal or small depending on */
1361 /*     current \internote.  Used with new coding in dograce() to get right */
1362 /*     new size in case user has \setsize'ed some lines to \smallvalue. For */
1363 /*     \smallvalue-sized staves, redefine \tinynotesize to give 11-pt font. */
1364 /*     Affects pmx.tex. */
1365 /*   Continuation figure with fractional length. May now mix with other figures. */
1366 /*     If another figure follow Cont-fig, separate with colon. */
1367 /* 2.342 */
1368 /*   Bugfix in getnote to recognize relative octave shift in grace at start of */
1369 /*     input block. */
1370 /*   In make2bar, initialize islhgt=0 earlier than before (possible solution */
1371 /*     to Suse g77 compile problem that I could not reproduce).. */
1372 /*   Bugfix in beamstrt & beamn1 for r2x6 c4D d d d */
1373 /* 2.341 */
1374 /*   Syntax check: Forced page break page number must be > than previous. */
1375 /*   Bugfix: Define ivx when "sliding down" breath/caesure data in pmxb. */
1376 /* 2.34 */
1377 /*   New pmx.tex with redefined liftpausc */
1378 /*   Bug fix with dotted, non-beamed xtups. */
1379 /* 2.332 */
1380 /*   Fix bugs in horizonal shifts, spacing, for accid's, graces, noteheads. */
1381 /*   Allow arbitrary pos. input to W in g1etnote and getnote. */
1382 /* 2.331 */
1383 /*   Bug-fix in dodyn(..): typo on length of arg of txtdyn */
1384 /* 2.33 */
1385 /*   Caesura (oc), breath (ob).  Set iornq(28), store rest of data in ibcdata() */
1386 /* 2.321 */
1387 /*   Rescale accidental shifts. Still use 7 bits but now map (0,127) */
1388 /*      onto (-1.,5.35) */
1389 /*   Fix ihornb bug in dodyn, seen with dynamics on lower-voice non-beamed xtups */
1390 /* 2.32 (Noticed after posting) */
1391 /*   Prohibit "/" as figure. */
1392 /* 2.32 (Posted) */
1393 /*   Tidied up accidentals in chords, do spacing. */
1394 /*   Still to do: */
1395 /*       check for "(" on chord notes in spacing algo */
1396 /*       small accids */
1397 /*       double accids */
1398 /*       autoshift slurs */
1399 /* 2.310 */
1400 /*   Extra call to precrd ahead of spacing chk, and single-note crd/acc */
1401 /*      shifts seem OK, but not multiple.  crd/acc shifts not recorded 1st time. */
1402 /* 2.309 */
1403 /*   Alternate algo for accid shifts in chords. */
1404 /* 2.308 */
1405 /*   Auto horiz. notehead shifting added to precrd. */
1406 /* 2.307 */
1407 /*   Auto shifting of multiple accidentals in chords. */
1408 /*   "Ao" in main chord note to keep accidentals in order. Set nacc(28). */
1409 /*   If there are any manual main or chord note shifts, then */
1410 /*      If any manual shift is preceded by "A" then */
1411 /*         1. Auto-shifting proceeds */
1412 /*         2. "A"-shifts add to autoshifts */
1413 /*         3. non-"A" shifts are ignored! */
1414 /*      Else (>0 man shifts, none has "A") */
1415 /*         No auto-ordering, No autoshifts, */
1416 /*      End if */
1417 /*   End if */
1418 /* 2.306 */
1419 /*   Initialize legacy note level to middle C in case user forgets to set */
1420 /*     octave. */
1421 /*   Shift xtup note? */
1422 /*   Shift in elemskips rather than noteheads? */
1423 /* 2.305 */
1424 /*   Stop pmxb from multiple endvolta's at start of new page. */
1425 /* 2.304 */
1426 /*   "Sx" in a note means shorten stemlength by x \internotes.  "Sx:" turn on */
1427 /*       for multiple notes in the voice, "S:" last shortened note. */
1428 /* 2.303 */
1429 /*   vshrink stuff all OK? Description is in pmxb. */
1430 /* 2.302 */
1431 /*   Toggle vshrink with "Av". vshrink normally kicks in when \interstaff */
1432 /*     hits 20. This still needs work. */
1433 /*   Add " /" to last line if last char is not % or /. */
1434 /* 2.301 */
1435 /*   Check in beamn1 for single note before multiplicity down-up. */
1436 /*   allow '.PMX' as well as '.pmx' */
1437 /* 2.299 */
1438 /*   Correct typo in pmxb involving PMXbarnotrue. */
1439 /*   Replacement printed number for xtup: Unsigned integer after 'n' after 'x' */
1440 /*   Minor upgrade parsing xtuplet options 'x...' */
1441 /*   Correct dimension of nxtinbm in make2bar. */
1442 /* 2.298 */
1443 /*   Account for doubled xtup notes in subroutine getx (user-defined spaces), */
1444 /*     by adding ndoub as an argument.. */
1445 /* 2.297 */
1446 /*   Created and solved compiler problem.  Put drawbm(NM) in its own common. */
1447 /*   Add new def'ns [\a|PA]usc, \lift[pa|PA]usc to pmx.tex, use them in make2bar */
1448 /*     when \centerbar is used. */
1449 /*   Modify \mbrest & \CenterBar in pmx.tex to use \volta@endcor etc.  Have PMX */
1450 /*     use right 2nd and 3rd args for \mbrest when key, meter, or clef changes. */
1451 /* 2.296 */
1452 /*   Correct printed numbers for forced beams with multiple xtups. For each beam */
1453 /*     make list in setupb by voice of eloff (h-offset) and mtupv (printed #) */
1454 /*   Increase lengths of jobname and infileq by 20 characters */
1455 /*   Enable whole notes and breves as 1st or last note of xtup in beamn1 and */
1456 /*     beamend, and wholes in beamid. */
1457 /* 2.295 */
1458 /*   Midi balance Ib[n1]:[n2]:...[nn] */
1459 /*   Single-slope beam groups [...]-[...] */
1460 /*   Trap "i" unless after accidental (main notes, xtups, chord notes) */
1461 /* 2.294 */
1462 /*   Unequal xtups with "D" to double a note in an xtup. */
1463 /*   As above, "F" will (a) increase multiplicity by 1 for marked note and next */
1464 /*     one and (b) add a dot to the first one. */
1465 /*   Fix bug with e.g. c84 [ .d e.f ] by checking whether forced beam is on */
1466 /*     when "." is encountered, then correcting beam start time.(end of getnote) */
1467 /*   MIDI velocity (volume) set: Iv[n1]:[n2]:[n3]... */
1468 /* 2.293 */
1469 /*   Check for single notes spanning bar lines. */
1470 /*   Correct various bugs with staff-jumping beams. (1) for 2nd segment, vxtup */
1471 /*     must be set in make2bar since beamstrt is not called, fixing problem with */
1472 /*     dot at end. (2) add ivjb2 to flag which voice has 2nd segment and fix */
1473 /*     problem when >2 staves. */
1474 /*   Add nodur to args of dodyn, so can check if stemless and avoid height tweak */
1475 /*   Correct bug in getdyn setting flag in idynda2(0) for manual horiz. tweak */
1476 /* 2.292a */
1477 /*   Undo syntax check for Type 2 or 3 TeX string starting in column 1. */
1478 /*     Meanwhile, Werner's problem with a mid-line Type 3 string has gone away?! */
1479 /* 2.292 */
1480 /*   Allow comments in xtuplets */
1481 /*   Enable multiple octave jumps in grace notes. */
1482 /*   Allow dynamics in xtuplets. */
1483 /*   Fix bug in getdyn searching for end of text string (correct length of lineq */
1484 /*     to 128) */
1485 /*   Fix bug in dodyn, must ignore horiz. interaction tweak for */
1486 /*     user-text (idno = 0) */
1487 /*   Syntax check for Type 2 or 3 TeX string starting in column 1 */
1488 /*     (NOTE: later undone!) */
1489 /*   Syntax check for page number > npages at forced line break. */
1490 /* 2.291 */
1491 /*   Fix error in AS command (accid spacing for small systems), making only */
1492 /*     one spec per staff, nv total. */
1493 /*   Stop using MIDI channel 10 */
1494 /* 2.29 */
1495 /*   Fix error in console output format for # of bytes used in MIDI file. */
1496 /*   Fix bug in dograce so no space is added between grace and main note when */
1497 /*       there is a MIDI-only accidental. */
1498 /*   Fix bug so oes?+4 works.  It was too ugly to explain. */
1499 /*     ...Different ways of storing accidental specs on input and output. */
1500 /*   No longer zap \writezbarno in special situations. */
1501 /*   Fix bug in dyntxt level on rest */
1502 /*   Line spacing equalization.  Add macros \starteq, \endeq, \spread, etc. */
1503 /*     Activate with Ae.  (Maybe later could input alternate values for */
1504 /*     \upamt, \dnamt, \parskip).  Put \starteq on 1st note in voice 1 */
1505 /*     in the page, and \endeq on 1st note of next-to-last line in page. */
1506 /* 2.28 */
1507 /*   Flip direction of forced beam "[f..." */
1508 /*   Fix beam numbering for staff jumping beams. Uses irest(23,24,29,30) */
1509 /*   Fix bug in sliding ip's for txtdyn's */
1510 /*   In dyn's allow vert. offsets +/-64, horiz +/-25.6 (store in idnyda2(1-99) */
1511 /* 2.27 */
1512 /*   Comment out lines in dodyn checking number of dynamic marks found.  Voice */
1513 /*     order may not be monotonic if two lines on a staff. */
1514 /*   Literal dynamic: D"[text]" */
1515 /* 2.26 */
1516 /*   Allow hairpin start-stop on same note by disabling auto-tweaks in dodyn, */
1517 /*     increasing dimension of idynn to 4 to allow 4 symbols on same note. */
1518 /*   Increase voltxtq length from 10 to 20. */
1519 /*   AS[-/0][-/0]...  to inform PMX that "-" voices are small, and rough */
1520 /*      accounting for ast's is done by defining effective headwidth */
1521 /*      whead1 in makebar2 to be 0.8*whead. */
1522 /* 2.25 */
1523 /*   Fix logic bug with sepsym's when # of instruments changes. */
1524 /*   Slight increases in default offsets for hairpin starts after "p" */
1525 /* 2.24 */
1526 /*   Hairpins D< or D> as toggle. */
1527 /*   Many automatic position tweaks for letter-group dynamics and hairpins. */
1528 /* 2.23 */
1529 /*   Continued rhythmic shortcuts: space followed by "." or "," */
1530 /* 2.22 */
1531 /*   In call to doslur, change tno(...) to tnote(...).  This was only */
1532 /*     used when checking to slurs per stem directions, and should have been */
1533 /*     the note duration all along. */
1534 /*   MIDI-only accidental, bit 17 in nacc, or 27 in icrdat. */
1535 /*       Use "i" anywhere in note symbol. */
1536 /* 2.21 */
1537 /*   Increase from 20 to 30 dimensions for movement breaks and midi sections. */
1538 /*   Fix out-of-order declarations per mutex comments */
1539 /*   Add "Bad error" and "Kluging" messages to log file. */
1540 /* 2.197 */
1541 /*   add /comips/ to save tie-check midi variables */
1542 /*   For spacing of clef changes at start of input block, changed integer time */
1543 /*     lastnodur to prevtn, so it works with xtups. Possible incompatibility! */
1544 /* 2.196 */
1545 /*   Fix Ickbug with time check in ncmid() */
1546 /*   Interchange \fermataup7 and \pausec to get proper alignment */
1547 /*   Enable French violin clef "f",  number 7 in PMX, but 9 in MusiXTeX. */
1548 /*   Add defn's of \hsp, \hspp to pmx.tex */
1549 /*   Fix pre-slurs on xtup chord notes. */
1550 /*   Fixed raised PAuse, define \liftPAuse */
1551 /*   Replace \zbreve\sk with \breve. */
1552 /*   Made "1" work as mtrdenl by doubling it and mtrnuml.  BUT WAIT...what */
1553 /*     about "o" and 1 as shorthand for 16???? Search for "Kluge" */
1554 /*   Added "vo" (voice) as MIDI instrument 55 */
1555 /*   Allow 3-digit page numbers (search for "toppageno") */
1556 /*   Fix bug caused by prior fix (cancelling accid after bar line was ignored). */
1557 /*   Fix double accids in chords */
1558 /* 2.194 */
1559 /*   Fix bug with accid/tie/barline/chord in addmidi by restructuring accid if */
1560 /*     block. */
1561 /*   Add meter to MIDI file with every pause */
1562 /*   Purify FORTRAN? */
1563 /* 2.193 */
1564 /*   Increased # of in-line TeX strings from 36 to 52. */
1565 /*   Fix entry of # of bytes in header of tempo/meter/key track to allow >255. */
1566 /* 2.191 */
1567 /*   Event track: Tempos, meters, keys all together.  Data in comevent */
1568 /* 2.15 */
1569 /*   Pretty good midi capability.  Still no attention to slurs on chord notes. */
1570 /* 2.11 */
1571 /*   11 Dec 99 c   rm1 */
1572 /*   11 Dec 99 "oes?", "oe?" */
1573 /*   11 Dec 99 Cancel slur horizontal tweaks with non-stemmed notes */
1574 /*   11 Dec 99 Error message for shifted, repeated ornaments. */
1575 /* 2.10 (Version 2.1) */
1576 /*   Fix bug with lowdot and xtuplets */
1577 /* 2.09 */
1578 /*   Fix bug with multiple ornament heights over beams, when one is . or _ */
1579 /*   Error message from pmxa if rest on last note of xtup. */
1580 /*   Enable 12 slurs. */
1581 /*   Reinstate multiple rests at start of xtup. */
1582 /* 2.07 */
1583 /*   Combine consecutive type-1 TeX strings. */
1584 /*   \midslur and \curve as 3rd signed digit in slur termination, + 2 opt.int's. */
1585 /*   Fixed breve chord notes in docrd */
1586 /*   Check irest(28) as well as vxtup when setting nodur for chord notes, since */
1587 /*     vxtup isn't set until 1st *main* note in xtup */
1588 /*   Vectorize nolev1, slope, ixrest.  Klug fix for xtups with variable spacing. */
1589 /* 2.06+ */
1590 /*   Make deterministic the beam slope calculation when there are an even # of */
1591 /*     slopes in list and middle two are equal magnitude but opposite sign. */
1592 /*   pmxa Trap for "o:" before 1st note in block */
1593 /*   Partial bug fix for 64th notes in xtuplets. */
1594 /*   Make ixrest a vector, since with new time scheme may not finish xtup in */
1595 /*     same notes block. */
1596 /*   Increase max # of pages from 20 to 30 (dimensions of nsystp,..., in pmxb) */
1597 /* 2.06 */
1598 /*   Account for changes in nv when computing \interstaff. Add a counter */
1599 /*     nistaff(iflb) = # of interstaff spaces per system = nv-1.  Set whenever */
1600 /*     setting isysflb(iflb). Note nv can only change at a forced line break. */
1601 /*     Note also, iflb starts at 0! */
1602 /* 2.05 */
1603 /*   Automatic start of new notes group with part 2 of staff-jump beam */
1604 /*     In make1bar, set irest bit 29 of lowest-voice note at same time, */
1605 /*     use as flag when making notes groups. */
1606 /*   For now, remove dummy blank line at end...it zaps terminal repeats. */
1607 /* 2.02 */
1608 /*   Fixed slur-counting bug for multiple, slurred, aftergraces. */
1609 /* 2.01 */
1610 /*  Increase to ask(1400) */
1611 /*  Increase max forced page breaks to 18 */
1612 /*  Define pausc for centered pause */
1613 /* 2.0a */
1614 /*  Insert dummy blank line at very end to handle input files w/o terminal CR-LF */
1615 /* pmx03r */
1616 /*   Option m[n] in S symbol to change musicsize (for parts) */
1617 /*   Double dotted rests now work. */
1618 /*   Write file name to log file */
1619 /*   Check existence of input file */
1620 /*   Allow 24-char jobname, may end with ".pmx" */
1621 /*   Comment out time stuff */
1622 /*   Replace 3-argument getarg with 2-argument + iargc */
1623 /*   Fix bug with negative noinst due to nint<=int replacement */
1624 /*   move lovation of iv in isdat1 to allow iv>7. */
1625 /*   Set nm=12 */
1626 /* pmx03q */
1627 /*   replace int(x+.001) with nint(x) */
1628 /*   Write TeX file name to screen and to pml. */
1629 /*   Replace char(...) with chax(...) to sovle msdev bug. */
1630 /*   Bug fix: macro terminations when M is on a line by itself. */
1631 /*   Bug fix: don't accumulate space for XS in pmxa. */
1632 /*   Streamline Macros: use pointers to bufq instead of scratch files */
1633 /* pmx03p */
1634 /*   Store input file in single character array bufq. */
1635 /*     lbuf(i)*2 is length of line i */
1636 /*     ipbuf is position just before next line to be read. */
1637 /* pmx03 */
1638 /*   Optimize read/writes */
1639 /* pmx02 */
1640 /*   Fix line count (for errors) when there are saved macros */
1641 /* pmx01 */
1642 /*   In optimize mode, open/close macros (Watch out for residual zz files!) */
1643 /*   Command line input */
1644 /*   Option Ao to optimize, otherwise normal processing */
1645 
1646 /* cccccc */
1647 
1648 /* Added 130302 only to get nsperi from g1etnote, for use in midi setup */
1649 
1650 
1651 /*  immac(i) is the index of i-th macro, i=1,nmac.  Also make a list containing */
1652 /*   nmidsec  section starts and stops based on PLAYING macros (not recording). */
1653 
1654 /* cccccccccccccccccccccccc */
1655 
1656 
1657 /* cccccccccccccccccccccccc */
1658 /*      itstart = mytime() */
1659     s_copy(comver_1.versionc, version, (ftnlen)5, (ftnlen)5);
1660 
1661 /*  Initialize midi parameters */
1662 
1663     commmac_1.gottempo = FALSE_;
1664     commidi_1.ismidi = FALSE_;
1665     commidi_1.debugmidi = FALSE_;
1666     commidi_1.relacc = FALSE_;
1667     commmac_1.mmacrec = FALSE_;
1668     commmac_1.nmidsec = 1;
1669     commidi_1.mgap = 10;
1670     comevent_1.miditime = 0;
1671     comevent_1.lasttime = 0;
1672     commidi_1.nmidcrd = 0;
1673     comslm_1.nusebl = 0;
1674     commidi_1.notmain = FALSE_;
1675     for (ivx = 1; ivx <= 24; ++ivx) {
1676 	commidi_1.twoline[ivx - 1] = FALSE_;
1677 	commidi_1.midinst[ivx - 1] = 6;
1678 	commvel_1.midivel[ivx - 1] = 127;
1679 	commvel_1.midibal[ivx - 1] = 64;
1680 	commvel_1.miditran[ivx - 1] = 0;
1681 /* L3: */
1682     }
1683     for (icm = 0; icm <= 24; ++icm) {
1684 	commidi_1.imidi[icm] = 0;
1685 	commidi_1.restpend[icm] = FALSE_;
1686 	commidi_1.trest[icm] = 0.f;
1687 	comslm_1.levson[icm] = 0;
1688 	comslm_1.levsoff[icm] = 0;
1689 	comslm_1.slmon[icm] = FALSE_;
1690 	comslm_1.naccbl[icm] = 0;
1691 	comdiag_1.n69[icm] = 0;
1692 	comdiag_1.n34[icm] = 0;
1693 	commmac_1.msecstrt[icm] = 1;
1694 /* L12: */
1695     }
1696 
1697 /*  End of midi parameter initialization */
1698 
1699     commus_1.musize = 0;
1700     optimize = FALSE_;
1701     numargs = iargc_();
1702     if (numargs == 0) {
1703 	s_wsle(&io___10);
1704 	do_lio(&c__9, &c__1, "You could have entered a jobname on the comman"
1705 		"d line,", (ftnlen)53);
1706 	e_wsle();
1707 	s_wsle(&io___11);
1708 	do_lio(&c__9, &c__1, "      but you may enter one now:", (ftnlen)32);
1709 	e_wsle();
1710 	s_rsfe(&io___12);
1711 	do_fio(&c__1, jobname, (ftnlen)44);
1712 	e_rsfe();
1713 	numargs = 1;
1714     } else {
1715 /*       call getarg(1,jobname,idum) ! May need to replace this w/ next line */
1716 	getarg_(&c__1, jobname, (ftnlen)44);
1717     }
1718 L10:
1719     ljob = lenstr_(jobname, &c__44, (ftnlen)44);
1720     if (ljob > 44) {
1721 	s_wsle(&io___15);
1722 	do_lio(&c__9, &c__1, "Jobname is too long. Try again.", (ftnlen)31);
1723 	e_wsle();
1724 	stop1_();
1725     } else if (ljob == 0) {
1726 	s_wsle(&io___16);
1727 	do_lio(&c__9, &c__1, "No was jobname entered. Try again.", (ftnlen)34)
1728 		;
1729 	e_wsle();
1730 	stop1_();
1731     } else if (numargs == 2) {
1732 	if (ljob == 2 && s_cmp(jobname, "-o", (ftnlen)2, (ftnlen)2) == 0) {
1733 	    optimize = TRUE_;
1734 /*         call getarg(2,jobname,idum) ! May need to replace this w/ next line */
1735 	    getarg_(&c__2, jobname, (ftnlen)44);
1736 	    numargs = 1;
1737 	    goto L10;
1738 	} else {
1739 	    s_wsle(&io___17);
1740 	    do_lio(&c__9, &c__1, "Illegal option on command line", (ftnlen)30)
1741 		    ;
1742 	    e_wsle();
1743 	    stop1_();
1744 	}
1745     }
1746 
1747 /*  Strip ".pmx" if necessary */
1748 
1749 /* Computing MAX */
1750     i__1 = i_indx(jobname, ".pmx", (ftnlen)44, (ftnlen)4), i__2 = i_indx(
1751 	    jobname, ".PMX", (ftnlen)44, (ftnlen)4);
1752     ndxpmx = max(i__1,i__2);
1753     if (ndxpmx > 0) {
1754 	s_copy(jobname, jobname, (ftnlen)44, ndxpmx - 1);
1755 	ljob += -4;
1756     }
1757 
1758 /*  Check for existence of input file */
1759 
1760 /* Writing concatenation */
1761     i__3[0] = ljob, a__1[0] = jobname;
1762     i__3[1] = 4, a__1[1] = ".pmx";
1763     s_cat(infileq, a__1, i__3, &c__2, (ftnlen)47);
1764     ioin__1.inerr = 0;
1765     ioin__1.infilen = 47;
1766     ioin__1.infile = infileq;
1767     ioin__1.inex = &fexist;
1768     ioin__1.inopen = 0;
1769     ioin__1.innum = 0;
1770     ioin__1.innamed = 0;
1771     ioin__1.inname = 0;
1772     ioin__1.inacc = 0;
1773     ioin__1.inseq = 0;
1774     ioin__1.indir = 0;
1775     ioin__1.infmt = 0;
1776     ioin__1.inform = 0;
1777     ioin__1.inunf = 0;
1778     ioin__1.inrecl = 0;
1779     ioin__1.innrec = 0;
1780     ioin__1.inblank = 0;
1781     f_inqu(&ioin__1);
1782     if (! fexist) {
1783 	ioin__1.inerr = 0;
1784 	ioin__1.infilen = ljob + 4;
1785 /* Writing concatenation */
1786 	i__3[0] = ljob, a__1[0] = jobname;
1787 	i__3[1] = 4, a__1[1] = ".PMX";
1788 	s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48);
1789 	ioin__1.infile = ch__1;
1790 	ioin__1.inex = &fexist;
1791 	ioin__1.inopen = 0;
1792 	ioin__1.innum = 0;
1793 	ioin__1.innamed = 0;
1794 	ioin__1.inname = 0;
1795 	ioin__1.inacc = 0;
1796 	ioin__1.inseq = 0;
1797 	ioin__1.indir = 0;
1798 	ioin__1.infmt = 0;
1799 	ioin__1.inform = 0;
1800 	ioin__1.inunf = 0;
1801 	ioin__1.inrecl = 0;
1802 	ioin__1.innrec = 0;
1803 	ioin__1.inblank = 0;
1804 	f_inqu(&ioin__1);
1805 	if (! fexist) {
1806 	    s_wsle(&io___21);
1807 /* Writing concatenation */
1808 	    i__3[0] = 17, a__1[0] = "Cannot find file ";
1809 	    i__3[1] = 47, a__1[1] = infileq;
1810 	    s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)64);
1811 	    do_lio(&c__9, &c__1, ch__2, (ftnlen)64);
1812 	    e_wsle();
1813 	    stop1_();
1814 	} else {
1815 /* Writing concatenation */
1816 	    i__3[0] = ljob, a__1[0] = jobname;
1817 	    i__3[1] = 4, a__1[1] = ".PMX";
1818 	    s_cat(infileq, a__1, i__3, &c__2, (ftnlen)47);
1819 	}
1820     }
1821 
1822 /*  Open a log file */
1823 
1824     o__1.oerr = 0;
1825     o__1.ounit = 15;
1826     o__1.ofnmlen = ljob + 4;
1827 /* Writing concatenation */
1828     i__3[0] = ljob, a__1[0] = jobname;
1829     i__3[1] = 4, a__1[1] = ".pml";
1830     s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48);
1831     o__1.ofnm = ch__1;
1832     o__1.orl = 0;
1833     o__1.osta = 0;
1834     o__1.oacc = 0;
1835     o__1.ofm = 0;
1836     o__1.oblnk = 0;
1837     f_open(&o__1);
1838 /* Writing concatenation */
1839     i__4[0] = 21, a__2[0] = "This is PMX, Version ";
1840     i__4[1] = 5, a__2[1] = version;
1841     i__4[2] = 2, a__2[2] = ", ";
1842     i__4[3] = 9, a__2[3] = date;
1843     s_cat(ch__3, a__2, i__4, &c__4, (ftnlen)37);
1844     printl_(ch__3, (ftnlen)37);
1845     ljob4 = ljob;
1846 /* Writing concatenation */
1847     i__3[0] = 8, a__1[0] = "Opening ";
1848     i__3[1] = 47, a__1[1] = infileq;
1849     s_cat(ch__4, a__1, i__3, &c__2, (ftnlen)55);
1850     printl_(ch__4, (ftnlen)55);
1851     o__1.oerr = 0;
1852     o__1.ounit = 18;
1853     o__1.ofnmlen = 47;
1854     o__1.ofnm = infileq;
1855     o__1.orl = 0;
1856     o__1.osta = 0;
1857     o__1.oacc = 0;
1858     o__1.ofm = 0;
1859     o__1.oblnk = 0;
1860     f_open(&o__1);
1861 
1862 /*  Copy input file into common buffer */
1863 
1864     inbuff_1.ipbuf = 0;
1865     truelinecount_1.linewcom[0] = 1;
1866     for (inbuff_1.ilbuf = 1; inbuff_1.ilbuf <= 4000; ++inbuff_1.ilbuf) {
1867 	ncomments = 0;
1868 L14:
1869 	i__1 = s_rsfe(&io___24);
1870 	if (i__1 != 0) {
1871 	    goto L9;
1872 	}
1873 	i__1 = do_fio(&c__1, lnholdq, (ftnlen)128);
1874 	if (i__1 != 0) {
1875 	    goto L9;
1876 	}
1877 	i__1 = e_rsfe();
1878 	if (i__1 != 0) {
1879 	    goto L9;
1880 	}
1881 	inbuff_1.lbuf[inbuff_1.ilbuf - 1] = (shortint) lenstr_(lnholdq, &
1882 		c__128, (ftnlen)128);
1883 	if (inbuff_1.lbuf[inbuff_1.ilbuf - 1] == 0) {
1884 
1885 /*  Blank line.  Make it a single blank with length 1 */
1886 
1887 	    inbuff_1.lbuf[inbuff_1.ilbuf - 1] = 1;
1888 	    s_copy(lnholdq, " ", (ftnlen)128, (ftnlen)1);
1889 	}
1890 
1891 /*  Now line has at least one non blank character. Check for comment */
1892 /*  As of Version 260, do not copy comments into bufq */
1893 /*  But need to count %'s for error messaging */
1894 /*        if (lnholdq(1:1).eq.'%') go to 14 */
1895 	if (*(unsigned char *)lnholdq == '%') {
1896 	    ++ncomments;
1897 	    goto L14;
1898 	}
1899 
1900 /*  When here, have counted all preceding comments and have a real line */
1901 
1902 	if (inbuff_1.ilbuf > 1) {
1903 	    truelinecount_1.linewcom[inbuff_1.ilbuf - 1] =
1904 		    truelinecount_1.linewcom[inbuff_1.ilbuf - 2] + 1 +
1905 		    ncomments;
1906 	} else {
1907 	    truelinecount_1.linewcom[0] = ncomments + 1;
1908 	}
1909 	if (inbuff_1.ipbuf + inbuff_1.lbuf[inbuff_1.ilbuf - 1] > 65536) {
1910 	    s_wsle(&io___26);
1911 	    do_lio(&c__9, &c__1, "Too many characters in file, stopping", (
1912 		    ftnlen)37);
1913 	    e_wsle();
1914 	    stop1_();
1915 	}
1916 	i__1 = inbuff_1.ipbuf;
1917 	s_copy(inbuff_1.bufq + i__1, lnholdq, inbuff_1.ipbuf + inbuff_1.lbuf[
1918 		inbuff_1.ilbuf - 1] - i__1, (ftnlen)128);
1919 	inbuff_1.ipbuf += inbuff_1.lbuf[inbuff_1.ilbuf - 1];
1920 /* L8: */
1921     }
1922     printl_("Too many lines in input file", (ftnlen)28);
1923     stop1_();
1924 L9:
1925 
1926 /*  Insert dummy line to handle input files w/o CR-LF at end. */
1927 
1928     inbuff_1.nlbuf = inbuff_1.ilbuf - 1;
1929 /*      nlbuf = ilbuf */
1930 /*      bufq(ipbuf+1:ipbuf+3) = ' / ' */
1931 /*      lbuf(nlbuf) = 3 */
1932     cl__1.cerr = 0;
1933     cl__1.cunit = 18;
1934     cl__1.csta = 0;
1935     f_clos(&cl__1);
1936     i__1 = maxit;
1937     for (numit = 1; numit <= i__1; ++numit) {
1938 	if (optimize) {
1939 	    printl_("Starting an iteration", (ftnlen)21);
1940 	}
1941 
1942 /*  When isfirst=.true., pmxa() generates linebreaks normally, output in nbars0. */
1943 /*    Otherwise, nbars0 is the input */
1944 /*  When islast=.false., pmxb only returns poe's, otherwise does whole job */
1945 
1946 	pmxa_(jobname, &ljob4, &isfirst, &nsyst, nbars0, &optimize, (ftnlen)
1947 		44);
1948 	if (! optimize) {
1949 	    if (commidi_1.ismidi) {
1950 
1951 /*  This was moved here from writemidi 130302 to allow midivel,bal,tran, to be */
1952 /*    set up here as functions of instrument rather than iv (staff). */
1953 /*  Count up staves(iv,nv) vs instruments.  Store instr# for iv in iinsiv(iv) */
1954 
1955 		nstaves = 0;
1956 		ivt = 0;
1957 		for (iinst = 1; iinst <= 24; ++iinst) {
1958 		    nstaves += c1omget_1.nsperi[iinst - 1];
1959 		    i__2 = c1omget_1.nsperi[iinst - 1];
1960 		    for (ivtt = 1; ivtt <= i__2; ++ivtt) {
1961 			++ivt;
1962 			commvel_1.iinsiv[ivt - 1] = (shortint) iinst;
1963 /* L17: */
1964 		    }
1965 		    if (nstaves == a1ll_1.nv) {
1966 			goto L18;
1967 		    }
1968 /* L16: */
1969 		}
1970 		s_wsle(&io___34);
1971 		do_lio(&c__9, &c__1, "Screwup!", (ftnlen)8);
1972 		e_wsle();
1973 		stop1_();
1974 L18:
1975 
1976 /*  Set up channel numbers for midi. */
1977 
1978 		commidi_1.numchan = 0;
1979 		for (a1ll_1.iv = a1ll_1.nv; a1ll_1.iv >= 1; --a1ll_1.iv) {
1980 		    if (commidi_1.twoline[a1ll_1.iv - 1]) {
1981 			commidi_1.midchan[a1ll_1.iv + 23] = commidi_1.numchan;
1982 			++commidi_1.numchan;
1983 		    }
1984 		    commidi_1.midchan[a1ll_1.iv - 1] = commidi_1.numchan;
1985 		    ++commidi_1.numchan;
1986 /* L11: */
1987 		}
1988 
1989 /*  numchan will now be the number of channels, but max channel # is numchan-1 */
1990 
1991 /*  Set up velocities, balances, and midi-transpositions */
1992 
1993 		for (a1ll_1.iv = a1ll_1.nv; a1ll_1.iv >= 1; --a1ll_1.iv) {
1994 		    if (commidi_1.twoline[a1ll_1.iv - 1]) {
1995 /*  130302 Make these functions of instrument rather than staff (iv) */
1996 /*                midvelc(midchan(iv,2)) = midivel(iv) */
1997 /*                midbc(midchan(iv,2)) = midibal(iv) */
1998 /*                midtc(midchan(iv,2)) = miditran(iv) */
1999 			commvel_1.midvelc[commidi_1.midchan[a1ll_1.iv + 23]] =
2000 				 commvel_1.midivel[commvel_1.iinsiv[a1ll_1.iv
2001 				- 1] - 1];
2002 			commvel_1.midbc[commidi_1.midchan[a1ll_1.iv + 23]] =
2003 				commvel_1.midibal[commvel_1.iinsiv[a1ll_1.iv
2004 				- 1] - 1];
2005 			commvel_1.midtc[commidi_1.midchan[a1ll_1.iv + 23]] =
2006 				commvel_1.miditran[commvel_1.iinsiv[a1ll_1.iv
2007 				- 1] - 1];
2008 		    }
2009 /*              midvelc(midchan(iv,1)) = midivel(iv) */
2010 /*              midbc(midchan(iv,1)) = midibal(iv) */
2011 /*              midtc(midchan(iv,1)) = miditran(iv) */
2012 		    commvel_1.midvelc[commidi_1.midchan[a1ll_1.iv - 1]] =
2013 			    commvel_1.midivel[commvel_1.iinsiv[a1ll_1.iv - 1]
2014 			    - 1];
2015 		    commvel_1.midbc[commidi_1.midchan[a1ll_1.iv - 1]] =
2016 			    commvel_1.midibal[commvel_1.iinsiv[a1ll_1.iv - 1]
2017 			    - 1];
2018 		    commvel_1.midtc[commidi_1.midchan[a1ll_1.iv - 1]] =
2019 			    commvel_1.miditran[commvel_1.iinsiv[a1ll_1.iv - 1]
2020 			     - 1];
2021 /* L13: */
2022 		}
2023 	    }
2024 
2025 /*  TEMPORARY!!! */
2026 
2027 	    s_wsle(&io___35);
2028 	    do_lio(&c__9, &c__1, "nlbuf: ", (ftnlen)7);
2029 	    do_lio(&c__3, &c__1, (char *)&inbuff_1.nlbuf, (ftnlen)sizeof(
2030 		    integer));
2031 	    e_wsle();
2032 	    ip1 = 1;
2033 	    i__2 = inbuff_1.nlbuf;
2034 	    for (ilb = 1; ilb <= i__2; ++ilb) {
2035 /*        write(15,'(2i5,a40,3i5)')ilb,lbuf(ilb), */
2036 /*     *     bufq(ip1:ip1+lbuf(ilb)-1), */
2037 /*     *     (ichar(bufq(ip1+lbuf(ilb)-k:ip1+lbuf(ilb)-k)), */
2038 /*     *      k=min(3,lbuf(ilb)),1,-1) */
2039 		ip1 += inbuff_1.lbuf[ilb - 1];
2040 /* L10000: */
2041 	    }
2042 	    iplast = ip1 - 1;
2043 
2044 /*  Check to see if (1) last line is "<blank><blank>/" and (2) next to last */
2045 /*    line is "/" */
2046 
2047 /*      print*,'iplast:',iplast */
2048 /*      print*,'Last line:' */
2049 /*      print*,bufq(iplast+1-lbuf(nlbuf):iplast) */
2050 /*      print*,'Last char of next to last line:' */
2051 /*      print*,bufq(iplast-lbuf(nlbuf):iplast-lbuf(nlbuf)) */
2052 	    i__2 = iplast + 1 - inbuff_1.lbuf[inbuff_1.nlbuf - 1] - 1;
2053 	    if (s_cmp(inbuff_1.bufq + i__2, "  /", iplast - i__2, (ftnlen)3)
2054 		    == 0) {
2055 		i__2 = iplast - inbuff_1.lbuf[inbuff_1.nlbuf - 1] - 1;
2056 		if (s_cmp(inbuff_1.bufq + i__2, "/", iplast - inbuff_1.lbuf[
2057 			inbuff_1.nlbuf - 1] - i__2, (ftnlen)1) == 0) {
2058 		    s_wsle(&io___39);
2059 		    do_lio(&c__9, &c__1, "Removing last line of \"<blank><bl"
2060 			    "ank>/\"", (ftnlen)39);
2061 		    e_wsle();
2062 		    s_wsle(&io___40);
2063 		    do_lio(&c__9, &c__1, "Removing last line of \"<blank><bl"
2064 			    "ank>/\"", (ftnlen)39);
2065 		    e_wsle();
2066 		    --inbuff_1.nlbuf;
2067 		}
2068 	    }
2069 
2070 	    pmxb_(&c_true, poe0, &ncalls, &optimize);
2071 	    if (commidi_1.ismidi) {
2072 
2073 /*  Write midi file */
2074 
2075 		o__1.oerr = 0;
2076 		o__1.ounit = 51;
2077 		o__1.ofnmlen = ljob + 4;
2078 /* Writing concatenation */
2079 		i__3[0] = ljob, a__1[0] = jobname;
2080 		i__3[1] = 4, a__1[1] = ".mid";
2081 		s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48);
2082 		o__1.ofnm = ch__1;
2083 		o__1.orl = 0;
2084 		o__1.osta = 0;
2085 		o__1.oacc = 0;
2086 		o__1.ofm = 0;
2087 		o__1.oblnk = 0;
2088 		f_open(&o__1);
2089 		if (commidi_1.debugmidi) {
2090 		    o__1.oerr = 0;
2091 		    o__1.ounit = 52;
2092 		    o__1.ofnmlen = ljob + 4;
2093 /* Writing concatenation */
2094 		    i__3[0] = ljob, a__1[0] = jobname;
2095 		    i__3[1] = 4, a__1[1] = ".dbm";
2096 		    s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48);
2097 		    o__1.ofnm = ch__1;
2098 		    o__1.orl = 0;
2099 		    o__1.osta = 0;
2100 		    o__1.oacc = 0;
2101 		    o__1.ofm = 0;
2102 		    o__1.oblnk = 0;
2103 		    f_open(&o__1);
2104 		}
2105 		printl_(" ", (ftnlen)1);
2106 /* Writing concatenation */
2107 		i__5[0] = 8, a__3[0] = "Writing ";
2108 		i__5[1] = ljob, a__3[1] = jobname;
2109 		i__5[2] = 4, a__3[2] = ".mid";
2110 		s_cat(ch__5, a__3, i__5, &c__3, (ftnlen)56);
2111 		printl_(ch__5, ljob + 12);
2112 		writemidi_(jobname, &ljob, (ftnlen)44);
2113 	    }
2114 	    cl__1.cerr = 0;
2115 	    cl__1.cunit = 15;
2116 	    cl__1.csta = 0;
2117 	    f_clos(&cl__1);
2118 	    s_stop("", (ftnlen)0);
2119 	}
2120 	s_wsle(&io___42);
2121 	do_lio(&c__9, &c__1, "nlbuf: ", (ftnlen)7);
2122 	do_lio(&c__3, &c__1, (char *)&inbuff_1.nlbuf, (ftnlen)sizeof(integer))
2123 		;
2124 	e_wsle();
2125 	ip1 = 1;
2126 	pmxb_(&c_false, poe0, &ncalls, &optimize);
2127 	poestats_(&nsyst, poe0, &poebar0, &devnorm0);
2128 
2129 /*  Save initial deviation and line breaks for later comparison */
2130 
2131 	if (numit == 1) {
2132 	    devpmx = devnorm0;
2133 	    i__2 = nsyst;
2134 	    for (isys = 1; isys <= i__2; ++isys) {
2135 		nbari[isys - 1] = nbars0[isys - 1];
2136 /* L20: */
2137 	    }
2138 	}
2139 	sortpoe_(&nsyst, poe0, ipoe);
2140 	for (iupord = nsyst; iupord >= 1; --iupord) {
2141 	    isysu = ipoe[iupord - 1];
2142 	    s_wsle(&io___51);
2143 	    do_lio(&c__9, &c__1, "isysu=", (ftnlen)6);
2144 	    do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(integer));
2145 	    e_wsle();
2146 	    s_wsle(&io___52);
2147 	    do_lio(&c__9, &c__1, "isysu=", (ftnlen)6);
2148 	    do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(integer));
2149 	    e_wsle();
2150 
2151 /*  Skip if system isysu has poe0 < avg or isysd has poe0 > avg */
2152 
2153 	    if (poe0[isysu - 1] < poebar0) {
2154 		goto L1;
2155 	    }
2156 	    i__2 = nsyst;
2157 	    for (idnord = 1; idnord <= i__2; ++idnord) {
2158 		isysd = ipoe[idnord - 1];
2159 		if (isysu == isysd || nbars0[isysd - 1] == 1 || poe0[isysd -
2160 			1] > poebar0) {
2161 		    goto L5;
2162 		}
2163 		i__6 = nsyst;
2164 		for (isyst = 1; isyst <= i__6; ++isyst) {
2165 		    nbars[isyst - 1] = nbars0[isyst - 1];
2166 		    if (isyst == isysu) {
2167 			++nbars[isyst - 1];
2168 		    } else if (isyst == isysd) {
2169 			--nbars[isyst - 1];
2170 		    }
2171 /* L2: */
2172 		}
2173 		pmxa_(jobname, &ljob4, &isfirst, &nsyst, nbars, &optimize, (
2174 			ftnlen)44);
2175 		pmxb_(&c_false, poe, &ncalls, &optimize);
2176 		poestats_(&nsyst, poe, &poebar, &devnorm);
2177 		if (devnorm < devnorm0) {
2178 		    devnorm0 = devnorm;
2179 		    poebar0 = poebar;
2180 		    i__6 = nsyst;
2181 		    for (isys = 1; isys <= i__6; ++isys) {
2182 			nbars0[isys - 1] = nbars[isys - 1];
2183 			poe0[isys - 1] = poe[isys - 1];
2184 /* L4: */
2185 		    }
2186 		    s_wsle(&io___60);
2187 		    do_lio(&c__9, &c__1, "Improved with iup,idown,devnorm:", (
2188 			    ftnlen)32);
2189 		    do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(
2190 			    integer));
2191 		    do_lio(&c__3, &c__1, (char *)&isysd, (ftnlen)sizeof(
2192 			    integer));
2193 		    do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(
2194 			    real));
2195 		    e_wsle();
2196 		    s_wsle(&io___61);
2197 		    do_lio(&c__9, &c__1, "Improved with iup,idown,devnorm:", (
2198 			    ftnlen)32);
2199 		    do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(
2200 			    integer));
2201 		    do_lio(&c__3, &c__1, (char *)&isysd, (ftnlen)sizeof(
2202 			    integer));
2203 		    do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(
2204 			    real));
2205 		    e_wsle();
2206 		    s_wsfe(&io___62);
2207 		    i__6 = nsyst;
2208 		    for (isys = 1; isys <= i__6; ++isys) {
2209 			do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)
2210 				sizeof(integer));
2211 		    }
2212 		    e_wsfe();
2213 		    s_wsfe(&io___63);
2214 		    i__6 = nsyst;
2215 		    for (isys = 1; isys <= i__6; ++isys) {
2216 			do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)
2217 				sizeof(integer));
2218 		    }
2219 		    e_wsfe();
2220 		    sortpoe_(&nsyst, poe0, ipoe);
2221 		    goto L6;
2222 		}
2223 L5:
2224 		;
2225 	    }
2226 L1:
2227 	    ;
2228 	}
2229 
2230 /*  If we get here, must have gone thru all switches and found nothing better, */
2231 /*  so done! */
2232 
2233 	goto L7;
2234 L6:
2235 	;
2236     }
2237 L7:
2238     s_wsle(&io___64);
2239     do_lio(&c__9, &c__1, "Optimum located, numit:", (ftnlen)23);
2240     do_lio(&c__3, &c__1, (char *)&numit, (ftnlen)sizeof(integer));
2241     do_lio(&c__9, &c__1, ",  ncalls:", (ftnlen)10);
2242     do_lio(&c__3, &c__1, (char *)&ncalls, (ftnlen)sizeof(integer));
2243     e_wsle();
2244     s_wsle(&io___65);
2245     do_lio(&c__9, &c__1, "Optimum located, numit:", (ftnlen)23);
2246     do_lio(&c__3, &c__1, (char *)&numit, (ftnlen)sizeof(integer));
2247     do_lio(&c__9, &c__1, ",  ncalls:", (ftnlen)10);
2248     do_lio(&c__3, &c__1, (char *)&ncalls, (ftnlen)sizeof(integer));
2249     e_wsle();
2250     s_wsle(&io___66);
2251     do_lio(&c__9, &c__1, "Final error:", (ftnlen)12);
2252     do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(real));
2253     do_lio(&c__9, &c__1, ", initial error:", (ftnlen)16);
2254     do_lio(&c__4, &c__1, (char *)&devpmx, (ftnlen)sizeof(real));
2255     e_wsle();
2256     s_wsle(&io___67);
2257     do_lio(&c__9, &c__1, "Final error:", (ftnlen)12);
2258     do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(real));
2259     do_lio(&c__9, &c__1, ", initial error:", (ftnlen)16);
2260     do_lio(&c__4, &c__1, (char *)&devpmx, (ftnlen)sizeof(real));
2261     e_wsle();
2262     s_wsle(&io___68);
2263     do_lio(&c__9, &c__1, "Percentage improvement:", (ftnlen)23);
2264     r__1 = (1 - devnorm0 / devpmx) * 100.f;
2265     do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real));
2266     e_wsle();
2267     s_wsle(&io___69);
2268     do_lio(&c__9, &c__1, "Percentage improvement:", (ftnlen)23);
2269     r__1 = (1 - devnorm0 / devpmx) * 100.f;
2270     do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real));
2271     e_wsle();
2272     printl_("Initial bars/system:", (ftnlen)20);
2273     s_wsfe(&io___70);
2274     i__1 = nsyst;
2275     for (isys = 1; isys <= i__1; ++isys) {
2276 	do_fio(&c__1, (char *)&nbari[isys - 1], (ftnlen)sizeof(integer));
2277     }
2278     e_wsfe();
2279     s_wsfe(&io___71);
2280     i__1 = nsyst;
2281     for (isys = 1; isys <= i__1; ++isys) {
2282 	do_fio(&c__1, (char *)&nbari[isys - 1], (ftnlen)sizeof(integer));
2283     }
2284     e_wsfe();
2285     printl_("Final bars/system:", (ftnlen)18);
2286     s_wsfe(&io___72);
2287     i__1 = nsyst;
2288     for (isys = 1; isys <= i__1; ++isys) {
2289 	do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)sizeof(integer));
2290     }
2291     e_wsfe();
2292     s_wsfe(&io___73);
2293     i__1 = nsyst;
2294     for (isys = 1; isys <= i__1; ++isys) {
2295 	do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)sizeof(integer));
2296     }
2297     e_wsfe();
2298     pmxa_(jobname, &ljob4, &c_false, &nsyst, nbars0, &optimize, (ftnlen)44);
2299     pmxb_(&c_true, poe0, &ncalls, &optimize);
2300 /*      itend = mytime() */
2301 /*      print*,'Elapsed time in ms:',itend-itstart */
2302 /*      write(15,*)'Elapsed time in ms:',itend-itstart */
2303     cl__1.cerr = 0;
2304     cl__1.cunit = 15;
2305     cl__1.csta = 0;
2306     f_clos(&cl__1);
2307     return 0;
2308 } /* MAIN__ */
2309 
accsym_(integer * nacc,char * acsymq,integer * lacc,ftnlen acsymq_len)2310 /* Subroutine */ int accsym_(integer *nacc, char *acsymq, integer *lacc,
2311 	ftnlen acsymq_len)
2312 {
2313     /* Builtin functions */
2314     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
2315     integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
2316 	    e_wsle(void);
2317 
2318     /* Local variables */
2319     static integer iacc;
2320 
2321     /* Fortran I/O blocks */
2322     static cilist io___75 = { 0, 6, 0, 0, 0 };
2323 
2324 
2325     iacc = *nacc & 7;
2326     if (iacc == 1) {
2327 	s_copy(acsymq, "fl", (ftnlen)3, (ftnlen)2);
2328 	*lacc = 2;
2329     } else if (iacc == 2) {
2330 	s_copy(acsymq, "sh", (ftnlen)3, (ftnlen)2);
2331 	*lacc = 2;
2332     } else if (iacc == 3) {
2333 	s_copy(acsymq, "na", (ftnlen)3, (ftnlen)2);
2334 	*lacc = 2;
2335     } else if (iacc == 5) {
2336 	s_copy(acsymq, "dfl", (ftnlen)3, (ftnlen)3);
2337 	*lacc = 3;
2338     } else if (iacc == 6) {
2339 	s_copy(acsymq, "dsh", (ftnlen)3, (ftnlen)3);
2340 	*lacc = 3;
2341     } else {
2342 	s_wsle(&io___75);
2343 	do_lio(&c__9, &c__1, "bad accidental: ", (ftnlen)16);
2344 	do_lio(&c__3, &c__1, (char *)&iacc, (ftnlen)sizeof(integer));
2345 	e_wsle();
2346     }
2347     return 0;
2348 } /* accsym_ */
2349 
addask_(real * taskn,real * waskn,real * elaskn,real * fixednew,real * scaldold,real * tglp1,logical * isudsp)2350 /* Subroutine */ int addask_(real *taskn, real *waskn, real *elaskn, real *
2351 	fixednew, real *scaldold, real *tglp1, logical *isudsp)
2352 {
2353     /* System generated locals */
2354     integer i__1;
2355     real r__1;
2356 
2357     /* Builtin functions */
2358     integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
2359 	    e_wsle(void);
2360 
2361     /* Local variables */
2362     static real oldelask;
2363     extern /* Subroutine */ int stop1_(void);
2364     static integer iudsp;
2365     static real oldwask;
2366 
2367     /* Fortran I/O blocks */
2368     static cilist io___77 = { 0, 6, 0, 0, 0 };
2369 
2370 
2371     if (*isudsp) {
2372 
2373 /*  Find which udsp we're dealing with */
2374 
2375 	i__1 = comudsp_1.nudsp;
2376 	for (iudsp = 1; iudsp <= i__1; ++iudsp) {
2377 	    if ((r__1 = *taskn + *tglp1 - comudsp_1.tudsp[iudsp - 1], dabs(
2378 		    r__1)) < comtol_1.tol) {
2379 		goto L2;
2380 	    }
2381 /* L1: */
2382 	}
2383 	s_wsle(&io___77);
2384 	do_lio(&c__9, &c__1, "You should note BEEE here in addask!", (ftnlen)
2385 		36);
2386 	e_wsle();
2387 	stop1_();
2388 L2:
2389 
2390 /*  Fixednew and scaldold must not be changed, since udsp's are already included */
2391 /*  in fsyst from pmxa, and udsp don't involve scaled space.. */
2392 
2393 	if (comas1_1.naskb > 0 && (r__1 = *taskn - comas1_1.task[max(1,
2394 		comas1_1.naskb) - 1], dabs(r__1)) < comtol_1.tol) {
2395 
2396 /*  Must add user-defined space to what's there already. */
2397 
2398 	    comas1_1.wask[comas1_1.naskb - 1] += comudsp_1.udsp[iudsp - 1];
2399 	} else {
2400 
2401 /*  This place has no other space. */
2402 
2403 	    ++comas1_1.naskb;
2404 	    comas1_1.task[comas1_1.naskb - 1] = *taskn;
2405 	    comas1_1.wask[comas1_1.naskb - 1] = comudsp_1.udsp[iudsp - 1];
2406 	    comas1_1.elask[comas1_1.naskb - 1] = 0.f;
2407 	}
2408     } else {
2409 /* 130330 start */
2410 	oldwask = 0.f;
2411 	oldelask = 0.f;
2412 /* 130330 end */
2413 
2414 /*  This is a normal space, no effect if smaller than existing space */
2415 
2416 	if (comas1_1.naskb > 0 && (r__1 = *taskn - comas1_1.task[max(1,
2417 		comas1_1.naskb) - 1], dabs(r__1)) < comtol_1.tol) {
2418 
2419 /*  We already put in some space at this time */
2420 /*  Check if new one needs more space than old one at same time */
2421 
2422 	    if (*waskn > comas1_1.wask[comas1_1.naskb - 1]) {
2423 
2424 /* 130330 We were double counting the larger space when it came 2nd */
2425 /* Need to fix but don't see how yet. Assume times came in order and */
2426 /* that last naskb defined spaces that need updating */
2427 
2428 		oldwask = comas1_1.wask[comas1_1.naskb - 1];
2429 		oldelask = comas1_1.elask[comas1_1.naskb - 1];
2430 /* End of 130330 insertions */
2431 		--comas1_1.naskb;
2432 	    } else {
2433 		return 0;
2434 	    }
2435 	}
2436 	++comas1_1.naskb;
2437 	comas1_1.task[comas1_1.naskb - 1] = *taskn;
2438 	comas1_1.wask[comas1_1.naskb - 1] = *waskn;
2439 	comas1_1.elask[comas1_1.naskb - 1] = *elaskn;
2440 /* 130330 start */
2441 /*        fixednew = fixednew+waskn */
2442 /*        scaldold = scaldold+elaskn */
2443 	*fixednew = *fixednew + *waskn - oldwask;
2444 	*scaldold = *scaldold + *elaskn - oldelask;
2445 /* 130330 end */
2446     }
2447     return 0;
2448 } /* addask_ */
2449 
addblank_(char * noteq,integer * lnoten,ftnlen noteq_len)2450 /* Subroutine */ int addblank_(char *noteq, integer *lnoten, ftnlen noteq_len)
2451 {
2452     /* System generated locals */
2453     address a__1[2];
2454     integer i__1[2];
2455 
2456     /* Builtin functions */
2457     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
2458 	     char **, integer *, integer *, ftnlen);
2459 
2460     /* Local variables */
2461     static char tchar[1];
2462 
2463     s_copy(tchar, noteq, (ftnlen)1, (ftnlen)8);
2464 /* Writing concatenation */
2465     i__1[0] = 1, a__1[0] = " ";
2466     i__1[1] = 1, a__1[1] = tchar;
2467     s_cat(noteq, a__1, i__1, &c__2, (ftnlen)8);
2468     *lnoten = 2;
2469     return 0;
2470 } /* addblank_ */
2471 
addfb_(integer * nfb,integer * iv,real * tnew,real * t1fb,real * t2fb,char * ulfbq,integer * ifbadd,ftnlen ulfbq_len)2472 /* Subroutine */ int addfb_(integer *nfb, integer *iv, real *tnew, real *t1fb,
2473 	 real *t2fb, char *ulfbq, integer *ifbadd, ftnlen ulfbq_len)
2474 {
2475     static integer ifb;
2476 
2477     /* Parameter adjustments */
2478     ulfbq -= 25;
2479     t2fb -= 25;
2480     t1fb -= 25;
2481     --nfb;
2482 
2483     /* Function Body */
2484     *ifbadd = 1;
2485     ++nfb[*iv];
2486     for (ifb = nfb[*iv] - 1; ifb >= 1; --ifb) {
2487 	if (*tnew < t1fb[*iv + ifb * 24] - comtol_1.tol) {
2488 	    t1fb[*iv + (ifb + 1) * 24] = t1fb[*iv + ifb * 24];
2489 	    t2fb[*iv + (ifb + 1) * 24] = t2fb[*iv + ifb * 24];
2490 	    *(unsigned char *)&ulfbq[*iv + (ifb + 1) * 24] = *(unsigned char *
2491 		    )&ulfbq[*iv + ifb * 24];
2492 	} else {
2493 	    *ifbadd = ifb + 1;
2494 	    goto L2;
2495 	}
2496 /* L1: */
2497     }
2498 L2:
2499     t1fb[*iv + *ifbadd * 24] = *tnew;
2500     *(unsigned char *)&ulfbq[*iv + *ifbadd * 24] = 'x';
2501     return 0;
2502 } /* addfb_ */
2503 
addmidi_(integer * icm,integer * nolev,integer * iacc,integer * midisig,real * time,logical * rest,logical * endrest)2504 /* Subroutine */ int addmidi_(integer *icm, integer *nolev, integer *iacc,
2505 	integer *midisig, real *time, logical *rest, logical *endrest)
2506 {
2507     /* Initialized data */
2508 
2509     static shortint icmm[16] = { 0,1,2,3,4,5,6,7,8,10,11,12,13,14,15,16 };
2510 
2511     /* System generated locals */
2512     integer i__1, i__2, i__3;
2513     real r__1;
2514 
2515     /* Builtin functions */
2516     integer i_nint(real *), s_wsle(cilist *), do_lio(integer *, integer *,
2517 	    char *, ftnlen), e_wsle(void), i_indx(char *, char *, ftnlen,
2518 	    ftnlen);
2519 
2520     /* Local variables */
2521     static logical it1found;
2522     static integer nsav4tie;
2523     extern /* Subroutine */ int chkimidi_(integer *);
2524     static char notenumq[1];
2525     static integer i__, j, it1;
2526     extern integer igetvarlen_(shortint *, integer *, integer *, integer *);
2527     static integer it2;
2528     extern integer isetvarlen_(integer *, integer *);
2529     static integer ion;
2530     static shortint itk[25];
2531     static integer jacc, kacc, macc, ioff, isav, idur, jsav, idur1;
2532     extern /* Subroutine */ int stop1_(void);
2533     static integer imidt, ipsav, ipsav0, nby2on;
2534     extern integer iashft_(integer *);
2535     static integer nbytes;
2536     extern /* Subroutine */ int printl_(char *, ftnlen);
2537     static integer nby2off;
2538     static logical eximacc;
2539     static integer itiesav[500]	/* was [5][100] */, idurvar;
2540 
2541     /* Fortran I/O blocks */
2542     static cilist io___87 = { 0, 6, 0, 0, 0 };
2543     static cilist io___99 = { 0, 6, 0, 0, 0 };
2544 
2545 
2546 /*      subroutine addmidi(icm,nolev,iacc,isig,time,rest,endrest) */
2547 /*      common /commidisig/ midisig(nm) */
2548 
2549 /*  Following variables are local but must be saved.  I hope they are. */
2550 /*  (3/18/00) With g77 they are not, so add a common block here. */
2551 
2552 /*      integer*2 ipslon(0:nm),lusebl(10),jusebl(10),icmm(0:12) */
2553 /*      data icmm /0,1,2,3,4,5,6,7,8,10,11,12,13/ */
2554 
2555 /*  Cancel out barline accidentals if there's a rest. */
2556 
2557     if (*rest) {
2558 	comslm_1.naccbl[(300 + (0 + (*icm - 0 << 2)) - 300) / 4] = 0;
2559     }
2560 
2561 /*  Special path to insert dummy rest at end of a section */
2562 
2563     if (*endrest) {
2564 	goto L20;
2565     }
2566 
2567     i__1 = commidi_1.nmidcrd;
2568     for (ion = 0; ion <= i__1; ++ion) {
2569 
2570 /*  check if this is only to get pitch of a chord note */
2571 
2572 	if (commidi_1.notmain) {
2573 	    goto L6;
2574 	}
2575 
2576 /*  check for rest */
2577 
2578 	if (*rest) {
2579 
2580 /*  Will not put in a note, but must update timing */
2581 
2582 	    if (! commidi_1.restpend[*icm]) {
2583 
2584 /*  First rest in sequence, save the time */
2585 
2586 		commidi_1.restpend[*icm] = TRUE_;
2587 		commidi_1.trest[*icm] = *time;
2588 	    } else {
2589 		commidi_1.trest[*icm] += *time;
2590 	    }
2591 
2592 /*  Note: code checkers don't like the above due to calling addmidi(trest(icm)) */
2593 /*    but this only happens if rest at end of section (endrest=.true.) (called */
2594 /*    from getmidi(), in which case these above lines are bypassed. */
2595 
2596 	    chkimidi_(icm);
2597 	    return 0;
2598 	}
2599 
2600 /*  time tics */
2601 
2602 	if (commidi_1.imidi[*icm] > 0 && ion == 0) {
2603 	    idur = commidi_1.mgap;
2604 	} else {
2605 	    idur = 0;
2606 	}
2607 	if (commidi_1.restpend[*icm]) {
2608 	    commidi_1.restpend[*icm] = FALSE_;
2609 	    r__1 = commidi_1.trest[*icm] * 15;
2610 	    idur += i_nint(&r__1);
2611 	}
2612 
2613 /*  time to start of note */
2614 
2615 	idurvar = isetvarlen_(&idur, &nby2on);
2616 	if (nby2on > 4) {
2617 	    s_wsle(&io___87);
2618 	    do_lio(&c__9, &c__1, "You got >4 bytes, something is bogus.", (
2619 		    ftnlen)37);
2620 	    e_wsle();
2621 	    stop1_();
2622 	}
2623 	++commidi_1.imidi[*icm];
2624 	i__2 = nby2on;
2625 	for (i__ = 1; i__ <= i__2; ++i__) {
2626 
2627 /*  imidi points to cell before highest (leftmost) byte.  Start with lowest byte */
2628 /*    at far right, fill in backwards */
2629 
2630 	    commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nby2on - i__) *
2631 		    25 - 25] = (shortint) (idurvar % 256);
2632 	    if (nby2on > 1) {
2633 		idurvar /= 256;
2634 	    }
2635 /* L2: */
2636 	}
2637 	commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nby2on - 1;
2638 
2639 /*  Note-on signal */
2640 
2641 	++commidi_1.imidi[*icm];
2642 /*        mmidi(icm,imidi(icm)) = 9*16+icm */
2643 	commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint) (
2644 		icmm[*icm] + 144);
2645 
2646 /*  Entry point for chord note pitch determination */
2647 
2648 L6:
2649 
2650 /*  Get midi pitch.  On chord iteration, only do this first time (main note), */
2651 /*  since pitch was already computed for nonmain chord notes. */
2652 
2653 	if (ion == 0) {
2654 	    ipsav = *nolev * 12.f / 7 + 11;
2655 	    ipsav0 = ipsav;
2656 	    if (*midisig != 0) {
2657 
2658 /*  Adjust for signature */
2659 
2660 		*(unsigned char *)notenumq = (char) (*nolev % 7 + 48);
2661 		if (*midisig >= i_indx("4152630", notenumq, (ftnlen)7, (
2662 			ftnlen)1)) {
2663 		    ++ipsav;
2664 		} else if (-(*midisig) >= i_indx("0362514", notenumq, (ftnlen)
2665 			7, (ftnlen)1)) {
2666 		    --ipsav;
2667 		}
2668 	    }
2669 
2670 /*  Deal with accidentals. */
2671 
2672 /*  iacc   0   1   2   3   4   5   6   7 */
2673 /* effect  X   fl  sh  na  X  dfl dsh  X */
2674 /* iashft  X   -1  1   0   X  -2   2   X */
2675 
2676 	    jacc = 0;
2677 	    eximacc = FALSE_;
2678 	    if (*iacc > 0) {
2679 
2680 /*  Adjust key-sig-adjusted pitch for explicit accidental (and exit) */
2681 
2682 		jacc = iashft_(iacc);
2683 		eximacc = TRUE_;
2684 		if (! commidi_1.relacc) {
2685 		    jacc = jacc + ipsav0 - ipsav;
2686 		}
2687 
2688 /*  (Above) Shift applies to diatonic pitch but will be added to adjusted one */
2689 
2690 	    } else if (commidi_1.naccim[*icm] > 0) {
2691 
2692 /*  Possible implicit accidental from earlier in the bar */
2693 /*    Check for prior accid in this bar at this note level */
2694 
2695 		i__2 = commidi_1.naccim[*icm];
2696 		for (kacc = 1; kacc <= i__2; ++kacc) {
2697 		    if (commidi_1.laccim[*icm + kacc * 25 - 25] == *nolev) {
2698 			jacc = commidi_1.jaccim[*icm + kacc * 25 - 25];
2699 			eximacc = TRUE_;
2700 			if (! commidi_1.relacc) {
2701 			    jacc = jacc + ipsav0 - ipsav;
2702 			}
2703 			goto L4;
2704 		    }
2705 /* L3: */
2706 		}
2707 L4:
2708 		;
2709 	    }
2710 
2711 /*  Must split off the following if block from those above because chord */
2712 /*  notes can cause naccim>0, forcing us to miss other chord note's */
2713 /*  accross-bar-line accidental */
2714 
2715 	    if (comslm_1.naccbl[*icm] > 0 && ! eximacc) {
2716 
2717 /*  Possible carryover accid from prior bar (or prior same-pitch note). */
2718 
2719 		i__2 = comslm_1.naccbl[*icm];
2720 		for (kacc = 1; kacc <= i__2; ++kacc) {
2721 		    if (comslm_1.laccbl[*icm + kacc * 25 - 25] == *nolev) {
2722 			jacc = comslm_1.jaccbl[*icm + kacc * 25 - 25];
2723 
2724 /*  Since we are *using* the bar-line accid, must flag it to be saved for next. */
2725 
2726 			++comslm_1.nusebl;
2727 			comips_1.jusebl[comslm_1.nusebl - 1] = (shortint)
2728 				jacc;
2729 			comips_1.lusebl[comslm_1.nusebl - 1] = (shortint) (*
2730 				nolev);
2731 			if (! commidi_1.relacc) {
2732 			    jacc = jacc + ipsav0 - ipsav;
2733 			}
2734 			goto L22;
2735 		    }
2736 /* L21: */
2737 		}
2738 L22:
2739 		;
2740 	    }
2741 	    ipsav += jacc;
2742 	}
2743 	if (commidi_1.notmain) {
2744 	    commidi_1.mcpitch[commidi_1.nmidcrd - 1] = ipsav;
2745 
2746 /*  Save pitch for tie checks */
2747 
2748 	    if (comslm_1.levson[*icm] == *nolev && ! comslm_1.slmon[*icm]) {
2749 		comips_1.ipslon[*icm] = (shortint) ipsav;
2750 	    }
2751 	} else {
2752 	    ++commidi_1.imidi[*icm];
2753 	    if (ion == 0) {
2754 		commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (
2755 			shortint) ipsav;
2756 		if (comslm_1.levson[*icm] == *nolev && ! comslm_1.slmon[*icm])
2757 			 {
2758 		    comips_1.ipslon[*icm] = (shortint) ipsav;
2759 		}
2760 	    } else {
2761 		commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (
2762 			shortint) commidi_1.mcpitch[ion - 1];
2763 	    }
2764 	}
2765 	if (ion == 0) {
2766 
2767 /*  Only record accids for non-chords, main chord note during chord iteration */
2768 /*    and chordnotes on first call but not during iteration */
2769 
2770 	    if (*iacc > 0) {
2771 
2772 /*  Set marker for accidental for possible continuations later this bar */
2773 /*    but first check and clear earlier ones on same note. */
2774 
2775 		i__2 = commidi_1.naccim[*icm];
2776 		for (kacc = 1; kacc <= i__2; ++kacc) {
2777 		    if (commidi_1.laccim[*icm + kacc * 25 - 25] == *nolev) {
2778 			i__3 = commidi_1.naccim[*icm] - 1;
2779 			for (macc = kacc; macc <= i__3; ++macc) {
2780 			    commidi_1.laccim[*icm + macc * 25 - 25] =
2781 				    commidi_1.laccim[*icm + (macc + 1) * 25 -
2782 				    25];
2783 			    commidi_1.jaccim[*icm + macc * 25 - 25] =
2784 				    commidi_1.jaccim[*icm + (macc + 1) * 25 -
2785 				    25];
2786 /* L24: */
2787 			}
2788 			goto L25;
2789 		    }
2790 /* L23: */
2791 		}
2792 		goto L26;
2793 L25:
2794 		--commidi_1.naccim[*icm];
2795 L26:
2796 
2797 /*  Flag new accidental */
2798 
2799 		++commidi_1.naccim[*icm];
2800 		commidi_1.laccim[*icm + commidi_1.naccim[*icm] * 25 - 25] = *
2801 			nolev;
2802 		commidi_1.jaccim[*icm + commidi_1.naccim[*icm] * 25 - 25] =
2803 			iashft_(iacc);
2804 	    }
2805 
2806 /*  Bail if this is a chord note on the first call (from docrd) */
2807 
2808 	    if (commidi_1.notmain) {
2809 		chkimidi_(icm);
2810 		return 0;
2811 	    }
2812 	}
2813 
2814 /*  Vel */
2815 
2816 	++commidi_1.imidi[*icm];
2817 /*        mmidi(icm,imidi(icm)) = 127 */
2818 	commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint)
2819 		commvel_1.midvelc[*icm];
2820 	chkimidi_(icm);
2821 /* L7: */
2822     }
2823 
2824 /*  For tie checks */
2825 
2826     if (comslm_1.levson[*icm] > 0 && ! comslm_1.slmon[*icm]) {
2827 	comslm_1.imidso[*icm] = commidi_1.imidi[*icm];
2828     }
2829 
2830 /*  Entry point for special rests at section ends (endrest=T) */
2831 
2832 L20:
2833 
2834 /*  Now insert all the ends */
2835 
2836     i__1 = commidi_1.nmidcrd;
2837     for (ioff = 0; ioff <= i__1; ++ioff) {
2838 	if (ioff == 0) {
2839 
2840 /*  time to end */
2841 
2842 	    r__1 = *time * 15;
2843 	    idur1 = i_nint(&r__1);
2844 	    r__1 = commidi_1.trest[*icm] * 15;
2845 	    if (! (*endrest) || comevent_1.miditime == i_nint(&r__1)) {
2846 		idur = idur1 - commidi_1.mgap;
2847 	    } else {
2848 		idur = idur1;
2849 	    }
2850 
2851 /*  Deal with roundoff problems with 7-tuplets on half or quarters */
2852 
2853 	    if (idur1 == 69) {
2854 		++comdiag_1.n69[*icm];
2855 /*            if (mod(n69(icm)+6,7) .gt. 3) idur = 58 */
2856 		if ((comdiag_1.n69[*icm] + 6) % 7 > 3) {
2857 		    idur = idur1 - commidi_1.mgap - 1;
2858 		}
2859 	    } else if (idur1 == 34) {
2860 		++comdiag_1.n34[*icm];
2861 		if ((comdiag_1.n34[*icm] + 6) % 7 > 4) {
2862 		    idur = idur1 - commidi_1.mgap + 1;
2863 		}
2864 	    }
2865 	    idurvar = isetvarlen_(&idur, &nby2off);
2866 	    if (nby2off > 4) {
2867 		s_wsle(&io___99);
2868 		do_lio(&c__9, &c__1, "You got >4 bytes, something is bogus.",
2869 			(ftnlen)37);
2870 		e_wsle();
2871 		stop1_();
2872 	    }
2873 	    ++commidi_1.imidi[*icm];
2874 	    chkimidi_(icm);
2875 	    i__2 = nby2off;
2876 	    for (i__ = 1; i__ <= i__2; ++i__) {
2877 		commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nby2off - i__)
2878 			 * 25 - 25] = (shortint) (idurvar % 256);
2879 		if (nby2off > 1) {
2880 		    idurvar /= 256;
2881 		}
2882 /* L1: */
2883 	    }
2884 	    commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nby2off - 1;
2885 	} else {
2886 
2887 /*  Inserting end of chord note, delta time is 0 */
2888 
2889 	    ++commidi_1.imidi[*icm];
2890 	    commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = 0;
2891 	}
2892 
2893 /*  Note off */
2894 
2895 	++commidi_1.imidi[*icm];
2896 /*        mmidi(icm,imidi(icm)) = 8*16+icm */
2897 	commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint) (
2898 		icmm[*icm] + 128);
2899 
2900 /*  Pitch */
2901 
2902 	++commidi_1.imidi[*icm];
2903 	if (ioff == 0) {
2904 	    commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (
2905 		    shortint) ipsav;
2906 	} else {
2907 	    commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (
2908 		    shortint) commidi_1.mcpitch[ioff - 1];
2909 	}
2910 
2911 /*  Vel */
2912 
2913 	++commidi_1.imidi[*icm];
2914 	commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = 0;
2915 	chkimidi_(icm);
2916 	if (*endrest) {
2917 	    return 0;
2918 	}
2919 
2920 /*      print*,'Off, icm,imidi,ipsav,idur:',icm,imidi(icm),ipsav,time */
2921 
2922 /* L8: */
2923     }
2924     comslm_1.naccbl[*icm] = comslm_1.nusebl;
2925     if (comslm_1.nusebl > 0) {
2926 
2927 /*  Fix tables of "bar-line" accids that are saved due to consecutive notes. */
2928 
2929 	i__1 = comslm_1.nusebl;
2930 	for (kacc = 1; kacc <= i__1; ++kacc) {
2931 	    comslm_1.laccbl[*icm + kacc * 25 - 25] = comips_1.lusebl[kacc - 1]
2932 		    ;
2933 	    comslm_1.jaccbl[*icm + kacc * 25 - 25] = comips_1.jusebl[kacc - 1]
2934 		    ;
2935 /* L30: */
2936 	}
2937 	comslm_1.nusebl = 0;
2938     }
2939 
2940 /*  Begin tie checks */
2941 
2942     if (comslm_1.slmon[*icm]) {
2943 
2944 /*  Prior note had a slur start */
2945 
2946 	if (comslm_1.levson[*icm] == comslm_1.levsoff[*icm] && *iacc == 0) {
2947 
2948 /*  We have a tie! (Assumed there would be no accidental on tie-ending note) */
2949 /*  Make a list of times of all events back to the one starting at imidso+1, */
2950 /*    which is at or before where the tie started.  Ident tie start and stop by */
2951 /*    comparing pitches.  Save the 4 pieces of data in itiesav(1...4,nsav4tie) */
2952 /*    Store actual time in itiesav(5,nsav4tie), using itiesav(1,1) as initial */
2953 /*    time. */
2954 	    nsav4tie = 0;
2955 	    imidt = comslm_1.imidso[*icm];
2956 L10:
2957 	    ++nsav4tie;
2958 	    itiesav[nsav4tie * 5 - 5] = igetvarlen_(commidi_1.mmidi, icm, &
2959 		    imidt, &nbytes);
2960 	    imidt += nbytes;
2961 	    for (j = 1; j <= 3; ++j) {
2962 		itiesav[j + 1 + nsav4tie * 5 - 6] = commidi_1.mmidi[*icm + (
2963 			imidt + j) * 25 - 25];
2964 /* L11: */
2965 	    }
2966 	    imidt += 3;
2967 	    if (nsav4tie == 1) {
2968 		itiesav[4] = itiesav[0];
2969 	    } else {
2970 		itiesav[nsav4tie * 5 - 1] = itiesav[nsav4tie * 5 - 5] +
2971 			itiesav[(nsav4tie - 1) * 5 - 1];
2972 	    }
2973 	    if (imidt != commidi_1.imidi[*icm]) {
2974 		goto L10;
2975 	    }
2976 
2977 /*  Find which two pitches agree with saved slur pitch. */
2978 
2979 	    it1found = FALSE_;
2980 	    i__1 = nsav4tie;
2981 	    for (it2 = 1; it2 <= i__1; ++it2) {
2982 		if (itiesav[it2 * 5 - 3] == comips_1.ipslon[*icm]) {
2983 		    if (it1found) {
2984 			goto L13;
2985 		    }
2986 		    it1 = it2;
2987 		    it1found = TRUE_;
2988 		}
2989 /* L12: */
2990 	    }
2991 	    printl_("Program error, tied notes, send source to Dr. Don", (
2992 		    ftnlen)49);
2993 	    it1 = nsav4tie + 1;
2994 	    it2 = nsav4tie + 1;
2995 L13:
2996 
2997 /*  List the positions we want to keep */
2998 
2999 	    jsav = 0;
3000 	    i__1 = nsav4tie;
3001 	    for (isav = 1; isav <= i__1; ++isav) {
3002 		if (isav == it1 || isav == it2) {
3003 		    goto L14;
3004 		}
3005 		++jsav;
3006 		itk[jsav - 1] = (shortint) isav;
3007 L14:
3008 		;
3009 	    }
3010 	    nsav4tie += -2;
3011 
3012 /*  Now dump events it1 & it2, recompute times, restack mmidi. */
3013 
3014 	    commidi_1.imidi[*icm] = comslm_1.imidso[*icm];
3015 	    i__1 = nsav4tie;
3016 	    for (isav = 1; isav <= i__1; ++isav) {
3017 		if (isav == 1) {
3018 		    idurvar = isetvarlen_(&itiesav[itk[isav - 1] * 5 - 1], &
3019 			    nbytes);
3020 		} else {
3021 		    i__2 = itiesav[itk[isav - 1] * 5 - 1] - itiesav[itk[isav
3022 			    - 2] * 5 - 1];
3023 		    idurvar = isetvarlen_(&i__2, &nbytes);
3024 		}
3025 		++commidi_1.imidi[*icm];
3026 		i__2 = nbytes;
3027 		for (i__ = 1; i__ <= i__2; ++i__) {
3028 		    commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nbytes -
3029 			    i__) * 25 - 25] = (shortint) (idurvar % 256);
3030 		    if (nbytes > 1) {
3031 			idurvar /= 256;
3032 		    }
3033 /* L16: */
3034 		}
3035 		commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nbytes - 1;
3036 		for (i__ = 2; i__ <= 4; ++i__) {
3037 		    ++commidi_1.imidi[*icm];
3038 		    commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] =
3039 			    (shortint) itiesav[i__ + itk[isav - 1] * 5 - 6];
3040 /* L17: */
3041 		}
3042 /* L15: */
3043 	    }
3044 	}
3045 	comslm_1.slmon[*icm] = FALSE_;
3046 	comslm_1.levsoff[*icm] = 0;
3047 	if (! comslm_1.dbltie) {
3048 	    comslm_1.levson[*icm] = 0;
3049 	}
3050     }
3051     if (comslm_1.levson[*icm] > 0) {
3052 	comslm_1.slmon[*icm] = TRUE_;
3053     }
3054     if (commidi_1.nmidcrd > 0) {
3055 	commidi_1.nmidcrd = 0;
3056     }
3057     chkimidi_(icm);
3058     return 0;
3059 } /* addmidi_ */
3060 
addstr_(char * notexq,integer * lnote,char * soutq,integer * lsout,ftnlen notexq_len,ftnlen soutq_len)3061 /* Subroutine */ int addstr_(char *notexq, integer *lnote, char *soutq,
3062 	integer *lsout, ftnlen notexq_len, ftnlen soutq_len)
3063 {
3064     /* System generated locals */
3065     address a__1[2];
3066     integer i__1[2];
3067     char ch__1[81];
3068 
3069     /* Builtin functions */
3070     integer s_wsfe(cilist *);
3071     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
3072     integer do_fio(integer *, char *, ftnlen), e_wsfe(void);
3073     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
3074 
3075     /* Fortran I/O blocks */
3076     static cilist io___111 = { 0, 11, 0, "(a)", 0 };
3077 
3078 
3079     if (*lsout + *lnote > 72) {
3080 	if (comlast_1.islast) {
3081 	    s_wsfe(&io___111);
3082 /* Writing concatenation */
3083 	    i__1[0] = *lsout, a__1[0] = soutq;
3084 	    i__1[1] = 1, a__1[1] = "%";
3085 	    s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)81);
3086 	    do_fio(&c__1, ch__1, *lsout + 1);
3087 	    e_wsfe();
3088 	}
3089 	*lsout = 0;
3090     }
3091     if (*lsout > 0) {
3092 /* Writing concatenation */
3093 	i__1[0] = *lsout, a__1[0] = soutq;
3094 	i__1[1] = *lnote, a__1[1] = notexq;
3095 	s_cat(soutq, a__1, i__1, &c__2, (ftnlen)80);
3096     } else {
3097 	s_copy(soutq, notexq, (ftnlen)80, (*lnote));
3098     }
3099     *lsout += *lnote;
3100     return 0;
3101 } /* addstr_ */
3102 
adjusteskz_(integer * ib,real * squez,integer * istart,integer * istop,real * poenom)3103 /* Subroutine */ int adjusteskz_(integer *ib, real *squez, integer *istart,
3104 	integer *istop, real *poenom)
3105 {
3106     /* System generated locals */
3107     integer i__1, i__2;
3108     real r__1;
3109 
3110     /* Local variables */
3111     static integer in, iaskb, inmin;
3112     static real eskadd;
3113 
3114 
3115 /*  For block ib, this adds accidental spaces to eskz, for use in getting */
3116 /*  length of xtup bracket and slopes of brackets and beams. */
3117 
3118     /* Parameter adjustments */
3119     --istop;
3120     --istart;
3121     --squez;
3122 
3123     /* Function Body */
3124     inmin = istart[*ib] + 1;
3125     i__1 = comas1_1.naskb;
3126     for (iaskb = 1; iaskb <= i__1; ++iaskb) {
3127 	if (comas1_1.task[iaskb - 1] < all_1.to[istart[*ib] - 1] -
3128 		comtol_1.tol) {
3129 	    goto L10;
3130 	}
3131 	eskadd = comas1_1.wask[iaskb - 1] / *poenom - comas1_1.elask[iaskb -
3132 		1];
3133 	i__2 = comntot_1.ntot;
3134 	for (in = inmin; in <= i__2; ++in) {
3135 	    if (all_1.to[in - 1] > comas1_1.task[iaskb - 1] - comtol_1.tol) {
3136 		comeskz2_1.eskz2[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24
3137 			- 25] += eskadd;
3138 		if ((r__1 = all_1.to[in - 1] - comas1_1.task[iaskb - 1], dabs(
3139 			r__1)) < comtol_1.tol) {
3140 		    --inmin;
3141 		}
3142 	    } else {
3143 		++inmin;
3144 	    }
3145 /* L11: */
3146 	}
3147 L10:
3148 	;
3149     }
3150     return 0;
3151 } /* adjusteskz_ */
3152 
askfig_(char * pathnameq,integer * lpath,char * basenameq,integer * lbase,logical * figbass,logical * istype0,ftnlen pathnameq_len,ftnlen basenameq_len)3153 /* Subroutine */ int askfig_(char *pathnameq, integer *lpath, char *basenameq,
3154 	 integer *lbase, logical *figbass, logical *istype0, ftnlen
3155 	pathnameq_len, ftnlen basenameq_len)
3156 {
3157     /* System generated locals */
3158     address a__1[3], a__2[2];
3159     integer i__1[3], i__2[2], i__3;
3160     char ch__1[1], ch__2[88], ch__3[15], ch__4[5], ch__5[4];
3161     olist o__1;
3162     cllist cl__1;
3163     alist al__1;
3164 
3165     /* Builtin functions */
3166     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
3167     integer f_open(olist *), f_rew(alist *), f_clos(cllist *), s_wsfe(cilist *
3168 	    ), do_fio(integer *, char *, ftnlen), e_wsfe(void), s_rsfe(cilist
3169 	    *), e_rsfe(void), s_cmp(char *, char *, ftnlen, ftnlen), s_wsfi(
3170 	    icilist *), e_wsfi(void), i_indx(char *, char *, ftnlen, ftnlen);
3171 
3172     /* Local variables */
3173     static integer il;
3174     static char sq[1];
3175     static integer ihs;
3176     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
3177     static logical done;
3178     extern integer llen_(char *, integer *, ftnlen);
3179     static char outq[129];
3180     extern /* Subroutine */ int moveln_(integer *, integer *, logical *);
3181     static integer lenout;
3182     extern /* Subroutine */ int putast_(real *, integer *, char *, ftnlen);
3183     static integer indxask;
3184 
3185     /* Fortran I/O blocks */
3186     static cilist io___119 = { 0, 12, 0, "(a)", 0 };
3187     static cilist io___120 = { 0, 12, 0, "(a)", 0 };
3188     static cilist io___122 = { 0, 11, 1, "(a129)", 0 };
3189     static icilist io___124 = { 0, outq+11, 0, "(f4.1)", 4, 1 };
3190     static cilist io___127 = { 0, 12, 0, "(a)", 0 };
3191     static cilist io___128 = { 0, 16, 1, "(a129)", 0 };
3192     static cilist io___129 = { 0, 12, 0, "(a)", 0 };
3193 
3194 
3195     chax_(ch__1, (ftnlen)1, &c__92);
3196     *(unsigned char *)sq = *(unsigned char *)&ch__1[0];
3197     o__1.oerr = 0;
3198     o__1.ounit = 12;
3199     o__1.ofnmlen = *lpath + *lbase + 4;
3200 /* Writing concatenation */
3201     i__1[0] = *lpath, a__1[0] = pathnameq;
3202     i__1[1] = *lbase, a__1[1] = basenameq;
3203     i__1[2] = 4, a__1[2] = ".tex";
3204     s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)88);
3205     o__1.ofnm = ch__2;
3206     o__1.orl = 0;
3207     o__1.osta = 0;
3208     o__1.oacc = 0;
3209     o__1.ofm = 0;
3210     o__1.oblnk = 0;
3211     f_open(&o__1);
3212 
3213 /*  Transfer first 5 lines of main internal TeX file */
3214 
3215     for (il = 1; il <= 5; ++il) {
3216 	moveln_(&c__11, &c__12, &done);
3217 /* L11: */
3218     }
3219     if (*istype0) {
3220 
3221 /*  Transfer literal TeX stuff from special scratch file */
3222 
3223 	al__1.aerr = 0;
3224 	al__1.aunit = 17;
3225 	f_rew(&al__1);
3226 L10:
3227 	moveln_(&c__17, &c__12, &done);
3228 	if (! done) {
3229 	    goto L10;
3230 	}
3231 	cl__1.cerr = 0;
3232 	cl__1.cunit = 17;
3233 	cl__1.csta = 0;
3234 	f_clos(&cl__1);
3235     }
3236 
3237 /*  Transfer next 2 lines from main scratch file */
3238 
3239     for (il = 1; il <= 2; ++il) {
3240 	moveln_(&c__11, &c__12, &done);
3241 /* L3: */
3242     }
3243     if (compoi_1.ispoi) {
3244 	s_wsfe(&io___119);
3245 /* Writing concatenation */
3246 	i__2[0] = 1, a__2[0] = sq;
3247 	i__2[1] = 14, a__2[1] = "input musixpoi";
3248 	s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)15);
3249 	do_fio(&c__1, ch__3, (ftnlen)15);
3250 	e_wsfe();
3251     }
3252     if (combbm_1.isbbm) {
3253 	s_wsfe(&io___120);
3254 /* Writing concatenation */
3255 	i__2[0] = 1, a__2[0] = sq;
3256 	i__2[1] = 14, a__2[1] = "input musixbbm";
3257 	s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)15);
3258 	do_fio(&c__1, ch__3, (ftnlen)15);
3259 	e_wsfe();
3260     }
3261     if (*figbass) {
3262 
3263 /*  Transfer .fig data from scratch (unit 14) into external .tex (unit 12) */
3264 
3265 L4:
3266 	moveln_(&c__14, &c__12, &done);
3267 	if (! done) {
3268 	    goto L4;
3269 	}
3270 	cl__1.cerr = 0;
3271 	cl__1.cunit = 14;
3272 	cl__1.csta = 0;
3273 	f_clos(&cl__1);
3274     }
3275     comas3_1.iask = 0;
3276     ihs = 0;
3277 L1:
3278     i__3 = s_rsfe(&io___122);
3279     if (i__3 != 0) {
3280 	goto L999;
3281     }
3282     i__3 = do_fio(&c__1, outq, (ftnlen)129);
3283     if (i__3 != 0) {
3284 	goto L999;
3285     }
3286     i__3 = e_rsfe();
3287     if (i__3 != 0) {
3288 	goto L999;
3289     }
3290 
3291 /*  Hardspaces. */
3292 
3293 /* Writing concatenation */
3294     i__2[0] = 1, a__2[0] = sq;
3295     i__2[1] = 4, a__2[1] = "xard";
3296     s_cat(ch__4, a__2, i__2, &c__2, (ftnlen)5);
3297     if (s_cmp(outq, ch__4, (ftnlen)5, (ftnlen)5) == 0) {
3298 	++ihs;
3299 	*(unsigned char *)&outq[1] = 'h';
3300 	s_wsfi(&io___124);
3301 	do_fio(&c__1, (char *)&comhsp_1.hpttot[ihs - 1], (ftnlen)sizeof(real))
3302 		;
3303 	e_wsfi();
3304 	lenout = 19;
3305 	goto L9;
3306     }
3307 
3308 /*  This part hard-wires ask's into new .tex file as ast's */
3309 
3310 L2:
3311 /* Writing concatenation */
3312     i__2[0] = 1, a__2[0] = sq;
3313     i__2[1] = 3, a__2[1] = "ask";
3314     s_cat(ch__5, a__2, i__2, &c__2, (ftnlen)4);
3315     indxask = i_indx(outq, ch__5, (ftnlen)129, (ftnlen)4);
3316     if (indxask != 0) {
3317 	++comas3_1.iask;
3318 	putast_(&comas3_1.ask[comas3_1.iask - 1], &indxask, outq, (ftnlen)129)
3319 		;
3320 	goto L2;
3321     }
3322     lenout = llen_(outq, &c__129, (ftnlen)129);
3323 L9:
3324     s_wsfe(&io___127);
3325     do_fio(&c__1, outq, lenout);
3326     e_wsfe();
3327 
3328 /*  If this is the line with "readmod", check for topmods. */
3329 
3330     if (comas3_1.topmods && s_cmp(outq + 1, "readmod", (ftnlen)7, (ftnlen)7)
3331 	    == 0) {
3332 	comas3_1.topmods = FALSE_;
3333 	al__1.aerr = 0;
3334 	al__1.aunit = 16;
3335 	f_rew(&al__1);
3336 	for (il = 1; il <= 1000; ++il) {
3337 	    i__3 = s_rsfe(&io___128);
3338 	    if (i__3 != 0) {
3339 		goto L8;
3340 	    }
3341 	    i__3 = do_fio(&c__1, outq, (ftnlen)129);
3342 	    if (i__3 != 0) {
3343 		goto L8;
3344 	    }
3345 	    i__3 = e_rsfe();
3346 	    if (i__3 != 0) {
3347 		goto L8;
3348 	    }
3349 	    lenout = llen_(outq, &c__129, (ftnlen)129);
3350 
3351 /*  We inserted the '%' in subroutine littex, to guarantee including blank. */
3352 
3353 	    s_wsfe(&io___129);
3354 	    do_fio(&c__1, outq, lenout);
3355 	    e_wsfe();
3356 /* L7: */
3357 	}
3358 L8:
3359 	cl__1.cerr = 0;
3360 	cl__1.cunit = 16;
3361 	cl__1.csta = 0;
3362 	f_clos(&cl__1);
3363     }
3364     goto L1;
3365 L999:
3366     cl__1.cerr = 0;
3367     cl__1.cunit = 11;
3368     cl__1.csta = 0;
3369     f_clos(&cl__1);
3370     cl__1.cerr = 0;
3371     cl__1.cunit = 12;
3372     cl__1.csta = 0;
3373     f_clos(&cl__1);
3374     return 0;
3375 } /* askfig_ */
3376 
backfill_(integer * iunit,char * oldq,integer * lenold,char * newq,integer * lennew,ftnlen oldq_len,ftnlen newq_len)3377 /* Subroutine */ int backfill_(integer *iunit, char *oldq, integer *lenold,
3378 	char *newq, integer *lennew, ftnlen oldq_len, ftnlen newq_len)
3379 {
3380     /* System generated locals */
3381     address a__1[3];
3382     integer i__1, i__2[3];
3383     alist al__1;
3384 
3385     /* Builtin functions */
3386     integer f_back(alist *), s_rsfe(cilist *), do_fio(integer *, char *,
3387 	    ftnlen), e_rsfe(void), i_indx(char *, char *, ftnlen, ftnlen);
3388     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
3389 	     char **, integer *, integer *, ftnlen);
3390     integer s_wsfe(cilist *), e_wsfe(void);
3391 
3392     /* Local variables */
3393     static integer linesback, ndx, line;
3394     static char nowq[128], lineq[128*200];
3395 
3396     /* Fortran I/O blocks */
3397     static cilist io___131 = { 0, 0, 0, "(a)", 0 };
3398     static cilist io___136 = { 0, 0, 0, "(a128)", 0 };
3399 
3400 
3401 
3402 /*  In iunit, looks backward for oldq, overwrites newq */
3403 /*  Safest if both are same length! */
3404 
3405     linesback = 0;
3406 L1:
3407     al__1.aerr = 0;
3408     al__1.aunit = *iunit;
3409     f_back(&al__1);
3410     io___131.ciunit = *iunit;
3411     s_rsfe(&io___131);
3412     do_fio(&c__1, nowq, (ftnlen)128);
3413     e_rsfe();
3414     ndx = i_indx(nowq, oldq, (ftnlen)128, (*lenold));
3415 
3416 /*  Save the line just read */
3417 
3418     ++linesback;
3419     s_copy(lineq + (linesback - 1 << 7), nowq, (ftnlen)128, (ftnlen)128);
3420     if (ndx == 0) {
3421 	al__1.aerr = 0;
3422 	al__1.aunit = *iunit;
3423 	f_back(&al__1);
3424 	goto L1;
3425     }
3426 
3427 /*  If here, it's replacement time. */
3428 
3429     i__1 = ndx + *lenold - 1;
3430 /* Writing concatenation */
3431     i__2[0] = ndx - 1, a__1[0] = nowq;
3432     i__2[1] = *lennew, a__1[1] = newq;
3433     i__2[2] = 128 - i__1, a__1[2] = nowq + i__1;
3434     s_cat(lineq + (linesback - 1 << 7), a__1, i__2, &c__3, (ftnlen)128);
3435     al__1.aerr = 0;
3436     al__1.aunit = *iunit;
3437     f_back(&al__1);
3438     for (line = linesback; line >= 1; --line) {
3439 	io___136.ciunit = *iunit;
3440 	s_wsfe(&io___136);
3441 	do_fio(&c__1, lineq + (line - 1 << 7), (ftnlen)128);
3442 	e_wsfe();
3443 /* L2: */
3444     }
3445     return 0;
3446 } /* backfill_ */
3447 
beamend_(char * notexq,integer * lnote,ftnlen notexq_len)3448 /* Subroutine */ int beamend_(char *notexq, integer *lnote, ftnlen notexq_len)
3449 {
3450     /* System generated locals */
3451     address a__1[4], a__2[3], a__3[2];
3452     integer i__1, i__2[4], i__3[3], i__4[2];
3453     char ch__1[1];
3454 
3455     /* Builtin functions */
3456     integer pow_ii(integer *, integer *);
3457     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
3458     integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char
3459 	    *, ftnlen);
3460 
3461     /* Local variables */
3462     extern /* Subroutine */ int addblank_(char *, integer *, ftnlen);
3463     static integer ip, mp, len, imp;
3464     extern integer log2_(integer *);
3465     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
3466     static integer nole;
3467     static char ulqq[1];
3468     extern /* Subroutine */ int stop1_(void);
3469     extern integer ncmid_(integer *, integer *);
3470     static integer ndsav;
3471     static char tempq[4], noteq[8];
3472     extern /* Subroutine */ int notex_(char *, integer *, ftnlen), ntrbbb_(
3473 	    integer *, char *, char *, integer *, char *, integer *, ftnlen,
3474 	    ftnlen, ftnlen), notefq_(char *, integer *, integer *, integer *,
3475 	    ftnlen);
3476     static logical isdotm;
3477     static integer lnoten, multip;
3478     extern /* Subroutine */ int istring_(integer *, char *, integer *, ftnlen)
3479 	    ;
3480 
3481     /* Fortran I/O blocks */
3482     static cilist io___143 = { 0, 6, 0, 0, 0 };
3483     static cilist io___144 = { 0, 6, 0, 0, 0 };
3484 
3485 
3486     ip = all_1.ipo[all_1.jn - 1];
3487     multip = (all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8;
3488     if (strtmid_1.ixrest[commvl_1.ivx - 1] == 4) {
3489 
3490 /*  This is the LAST note in the xtup (i.e., all rests before).  Make single. */
3491 
3492 	i__1 = 4 - multip;
3493 	all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &i__1);
3494 	notex_(notexq, lnote, (ftnlen)79);
3495 	strtmid_1.ixrest[commvl_1.ivx - 1] = 0;
3496 	return 0;
3497     }
3498     nole = all_1.nolev[commvl_1.ivx + ip * 24 - 25];
3499 
3500 /*  Check for special situations with 2nds (see precrd) */
3501 
3502     if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],30)) {
3503 	--nole;
3504     } else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],31)) {
3505 	++nole;
3506     }
3507     if (! comdraw_1.drawbm[commvl_1.ivx - 1]) {
3508 
3509 /*  Xtuplet with no beam, just put in the right kind of note */
3510 
3511 	if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],30)) {
3512 
3513 /*  Forced stem direction */
3514 
3515 	    ndsav = all_1.nodur[commvl_1.ivx + ip * 24 - 25];
3516 	    i__1 = 4 - multip;
3517 	    all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &i__1);
3518 	    if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) {
3519 		all_1.nodur[commvl_1.ivx + ip * 24 - 25] /= 2;
3520 	    }
3521 	    notex_(notexq, lnote, (ftnlen)79);
3522 	    all_1.nodur[commvl_1.ivx + ip * 24 - 25] = ndsav;
3523 	} else {
3524 	    i__1 = ncmid_(&all_1.iv, &ip);
3525 	    notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
3526 	    if (lnoten == 1) {
3527 		addblank_(noteq, &lnoten, (ftnlen)8);
3528 	    }
3529 	    *lnote = lnoten + 3;
3530 	    if (! bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27))
3531 		    {
3532 
3533 /*  Prior note is not regular-dotted */
3534 
3535 		if (multip == 0) {
3536 /* Writing concatenation */
3537 		    i__2[0] = 1, a__1[0] = all_1.sq;
3538 		    i__2[1] = 1, a__1[1] = "q";
3539 		    i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
3540 			    all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
3541 		    i__2[3] = 8, a__1[3] = noteq;
3542 		    s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79);
3543 		} else if (multip == -1) {
3544 /* Writing concatenation */
3545 		    i__2[0] = 1, a__1[0] = all_1.sq;
3546 		    i__2[1] = 1, a__1[1] = "h";
3547 		    i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
3548 			    all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
3549 		    i__2[3] = 8, a__1[3] = noteq;
3550 		    s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79);
3551 		} else if (multip == 1) {
3552 /* Writing concatenation */
3553 		    i__2[0] = 1, a__1[0] = all_1.sq;
3554 		    i__2[1] = 1, a__1[1] = "c";
3555 		    i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
3556 			    all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
3557 		    i__2[3] = 8, a__1[3] = noteq;
3558 		    s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79);
3559 		} else if (multip == 2) {
3560 /* Writing concatenation */
3561 		    i__2[0] = 1, a__1[0] = all_1.sq;
3562 		    i__2[1] = 2, a__1[1] = "cc";
3563 		    i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
3564 			    all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
3565 		    i__2[3] = 8, a__1[3] = noteq;
3566 		    s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79);
3567 		    ++(*lnote);
3568 		} else if (multip == 3) {
3569 /* Writing concatenation */
3570 		    i__2[0] = 1, a__1[0] = all_1.sq;
3571 		    i__2[1] = 3, a__1[1] = "ccc";
3572 		    i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
3573 			    all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
3574 		    i__2[3] = 8, a__1[3] = noteq;
3575 		    s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79);
3576 		    *lnote += 2;
3577 		} else if (multip == -2) {
3578 /* Writing concatenation */
3579 		    i__3[0] = 1, a__2[0] = all_1.sq;
3580 		    i__3[1] = 2, a__2[1] = "wh";
3581 		    i__3[2] = 8, a__2[2] = noteq;
3582 		    s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
3583 		} else if (multip == -3) {
3584 /* Writing concatenation */
3585 		    i__3[0] = 1, a__2[0] = all_1.sq;
3586 		    i__3[1] = 5, a__2[1] = "breve";
3587 		    i__3[2] = 8, a__2[2] = noteq;
3588 		    s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
3589 		    *lnote += 3;
3590 		} else {
3591 		    s_wsle(&io___143);
3592 		    e_wsle();
3593 		    s_wsle(&io___144);
3594 		    do_lio(&c__9, &c__1, "(Error in beamend, send source to "
3595 			    "Dr. Don)", (ftnlen)42);
3596 		    e_wsle();
3597 		    stop1_();
3598 		}
3599 	    } else {
3600 
3601 /*  Prior note is regular-dotted so this one is halved */
3602 
3603 		if (multip == 0) {
3604 /* Writing concatenation */
3605 		    i__2[0] = 1, a__1[0] = all_1.sq;
3606 		    i__2[1] = 1, a__1[1] = "c";
3607 		    i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
3608 			    all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
3609 		    i__2[3] = 8, a__1[3] = noteq;
3610 		    s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79);
3611 		} else if (multip == -1) {
3612 /* Writing concatenation */
3613 		    i__2[0] = 1, a__1[0] = all_1.sq;
3614 		    i__2[1] = 1, a__1[1] = "q";
3615 		    i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
3616 			    all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
3617 		    i__2[3] = 8, a__1[3] = noteq;
3618 		    s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79);
3619 		} else if (multip == -2) {
3620 /* Writing concatenation */
3621 		    i__2[0] = 1, a__1[0] = all_1.sq;
3622 		    i__2[1] = 1, a__1[1] = "h";
3623 		    i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
3624 			    all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
3625 		    i__2[3] = 8, a__1[3] = noteq;
3626 		    s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79);
3627 		}
3628 	    }
3629 	}
3630 	return 0;
3631     }
3632     i__1 = ncmid_(&all_1.iv, &ip);
3633     notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
3634     *lnote = 0;
3635 
3636 /* New way, with flipend, which was computed in beamstrt. */
3637 
3638     if (strtmid_1.flipend[commvl_1.ivx - 1] && bit_test(all_1.ipl[
3639 	    commvl_1.ivx + ip * 24 - 25],30)) {
3640 	i__1 = 225 - *(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[
3641 		commvl_1.ivx - 1] * 24 - 25];
3642 	chax_(ch__1, (ftnlen)1, &i__1);
3643 	*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx
3644 		- 1] * 24 - 25] = *(unsigned char *)&ch__1[0];
3645     }
3646     if (ip > all_1.ibm1[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 -
3647 	    25]) {
3648 
3649 /* This is not a one-noter from beam-jump.  Check if multiplicity has increased */
3650 
3651 	if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],0)) {
3652 
3653 /*  Prior note is a rest, check one before that */
3654 
3655 	    mp = (all_1.mult[commvl_1.ivx + (ip - 2) * 24 - 25] & 15) - 8;
3656 	} else {
3657 	    mp = (all_1.mult[commvl_1.ivx + (ip - 1) * 24 - 25] & 15) - 8;
3658 	}
3659 	if (multip > mp) {
3660 
3661 /*  Assume 1-3, 2-3, or 1-2 */
3662 
3663 	    i__1 = mp + 1;
3664 	    for (imp = multip; imp >= i__1; --imp) {
3665 		ntrbbb_(&imp, "t", all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[
3666 			commvl_1.ivx - 1] * 24 - 25), &commvl_1.ivx, notexq,
3667 			lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79);
3668 /* L2: */
3669 	    }
3670 	} else if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27))
3671 		 {
3672 
3673 /*  2nd member of dotted xtup */
3674 
3675 	    i__1 = multip + 1;
3676 	    ntrbbb_(&i__1, "t", all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[
3677 		    commvl_1.ivx - 1] * 24 - 25), &commvl_1.ivx, notexq,
3678 		    lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79);
3679 	}
3680     }
3681 
3682 /* Beam termination and direction analysis */
3683 
3684     if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],23) && !
3685 	    combjmp_1.isbjmp) {
3686 
3687 /* This is the end of the first segment in a jump-beam.  ivbj1=ivx will be number */
3688 /*   of the jump-beam.  ivbj2 will be tested along with isbjmp to see if in the */
3689 /*   voice of the 2nd part of jumped beam.  (May need special treatment for */
3690 /*   multi-segment jump-beams */
3691 
3692 	combjmp_1.isbjmp = TRUE_;
3693 	combjmp_1.ivbj1 = commvl_1.ivx;
3694 	combjmp_1.ivbj2 = 0;
3695     }
3696     if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],23)) {
3697 
3698 /* This is either a normal beamend or end of a sequence of jump-beam segments, */
3699 /* so some sort of termination is required */
3700 
3701 	*(unsigned char *)ulqq = *(unsigned char *)&all_1.ulq[commvl_1.ivx +
3702 		all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25];
3703 	if (! combjmp_1.isbjmp || commvl_1.ivx != combjmp_1.ivbj2) {
3704 
3705 /* Normal termination */
3706 
3707 	    i__1 = commvl_1.ivx % 24;
3708 	    ntrbbb_(&c__1, "t", ulqq, &i__1, notexq, lnote, (ftnlen)1, (
3709 		    ftnlen)1, (ftnlen)79);
3710 	} else {
3711 
3712 /* Terminate a sequence of jump-beam segments. */
3713 
3714 	    i__1 = 225 - *(unsigned char *)ulqq;
3715 	    chax_(ch__1, (ftnlen)1, &i__1);
3716 	    *(unsigned char *)ulqq = *(unsigned char *)&ch__1[0];
3717 	    i__1 = combjmp_1.ivbj1 % 24;
3718 	    ntrbbb_(&c__1, "t", ulqq, &i__1, notexq, lnote, (ftnlen)1, (
3719 		    ftnlen)1, (ftnlen)79);
3720 	}
3721     }
3722 
3723 /*  And now the note */
3724 
3725     if (*lnote > 0) {
3726 /* Writing concatenation */
3727 	i__3[0] = *lnote, a__2[0] = notexq;
3728 	i__3[1] = 1, a__2[1] = all_1.sq;
3729 	i__3[2] = 2, a__2[2] = "qb";
3730 	s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
3731     } else {
3732 /* Writing concatenation */
3733 	i__4[0] = 1, a__3[0] = all_1.sq;
3734 	i__4[1] = 2, a__3[1] = "qb";
3735 	s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79);
3736     }
3737     *lnote += 3;
3738     isdotm = FALSE_;
3739     if (! comxtup_1.vxtup[commvl_1.ivx - 1]) {
3740 	i__1 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 - 25]);
3741 	if (pow_ii(&c__2, &i__1) != all_1.nodur[commvl_1.ivx + ip * 24 - 25])
3742 		{
3743 	    if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13)) {
3744 /* Writing concatenation */
3745 		i__4[0] = *lnote, a__3[0] = notexq;
3746 		i__4[1] = 1, a__3[1] = "p";
3747 		s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79);
3748 	    } else {
3749 /* Writing concatenation */
3750 		i__4[0] = *lnote, a__3[0] = notexq;
3751 		i__4[1] = 1, a__3[1] = "m";
3752 		s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79);
3753 		isdotm = TRUE_;
3754 	    }
3755 	    ++(*lnote);
3756 	}
3757     }
3758 
3759 /*  5/25/08 Allow >12 */
3760 /*  5/9/10 Up to 24; replace 24 with 0 */
3761 
3762     if (! (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2)) {
3763 /*        call istring(mod(ivx,12),tempq,len) */
3764 	i__1 = commvl_1.ivx % 24;
3765 	istring_(&i__1, tempq, &len, (ftnlen)4);
3766     } else {
3767 /*        call istring(mod(ivbj1,12),tempq,len) */
3768 	i__1 = combjmp_1.ivbj1 % 24;
3769 	istring_(&i__1, tempq, &len, (ftnlen)4);
3770     }
3771     if (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2 && ! bit_test(
3772 	    all_1.irest[commvl_1.ivx + ip * 24 - 25],23)) {
3773 	combjmp_1.isbjmp = FALSE_;
3774     }
3775 /* Writing concatenation */
3776     i__4[0] = *lnote, a__3[0] = notexq;
3777     i__4[1] = len, a__3[1] = tempq;
3778     s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79);
3779     *lnote += len;
3780 /* Writing concatenation */
3781     i__4[0] = *lnote, a__3[0] = notexq;
3782     i__4[1] = lnoten, a__3[1] = noteq;
3783     s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79);
3784     *lnote += lnoten;
3785     if (isdotm) {
3786 	if (lnoten == 1) {
3787 /* Writing concatenation */
3788 	    i__2[0] = *lnote, a__1[0] = notexq;
3789 	    i__2[1] = 1, a__1[1] = "{";
3790 	    i__2[2] = 1, a__1[2] = noteq;
3791 	    i__2[3] = 1, a__1[3] = "}";
3792 	    s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79);
3793 	    *lnote += 3;
3794 	} else {
3795 	    i__1 = lnoten - 2;
3796 /* Writing concatenation */
3797 	    i__4[0] = *lnote, a__3[0] = notexq;
3798 	    i__4[1] = lnoten - 1 - i__1, a__3[1] = noteq + i__1;
3799 	    s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79);
3800 	    ++(*lnote);
3801 	}
3802     }
3803     return 0;
3804 } /* beamend_ */
3805 
beamid_(char * notexq,integer * lnote,ftnlen notexq_len)3806 /* Subroutine */ int beamid_(char *notexq, integer *lnote, ftnlen notexq_len)
3807 {
3808     /* System generated locals */
3809     address a__1[3], a__2[2], a__3[4];
3810     integer i__1, i__2[3], i__3[2], i__4, i__5, i__6[4];
3811     real r__1;
3812     char ch__1[1];
3813 
3814     /* Builtin functions */
3815     integer pow_ii(integer *, integer *);
3816     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
3817 
3818     /* Local variables */
3819     extern /* Subroutine */ int addblank_(char *, integer *, ftnlen);
3820     extern integer igetbits_(integer *, integer *, integer *);
3821     extern logical isdotted_(integer *, integer *, integer *);
3822     static integer im, ip, len, ivb, iud, mua, mub, iup;
3823     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
3824     static integer nole;
3825     static char ulqq[1];
3826     extern integer ncmid_(integer *, integer *);
3827     static integer ipmid, iflop, ndsav;
3828     static char noteq[8], tempq[4];
3829     extern /* Subroutine */ int notex_(char *, integer *, ftnlen);
3830     extern integer levrn_(integer *, integer *, integer *, integer *, integer
3831 	    *);
3832     static integer nlnum, multl, multr;
3833     extern /* Subroutine */ int ntrbbb_(integer *, char *, char *, integer *,
3834 	    char *, integer *, ftnlen, ftnlen, ftnlen);
3835     static integer ipleft;
3836     extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer
3837 	    *, ftnlen);
3838     static real xnlmid;
3839     static logical isdotm;
3840     static integer lnoten, mprint, multip;
3841     extern /* Subroutine */ int putxtn_(integer *, integer *, integer *,
3842 	    integer *, real *, real *, integer *, integer *, real *, real *,
3843 	    integer *, integer *, char *, integer *, integer *, real *,
3844 	    integer *, integer *, logical *, ftnlen);
3845     static integer ipright;
3846     extern /* Subroutine */ int istring_(integer *, char *, integer *, ftnlen)
3847 	    ;
3848 
3849     *lnote = 0;
3850     ip = all_1.ipo[all_1.jn - 1];
3851     nole = all_1.nolev[commvl_1.ivx + ip * 24 - 25];
3852 
3853 /*  Check for special situations with 2nds (see precrd) */
3854 
3855     if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],30)) {
3856 	--nole;
3857     } else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],31)) {
3858 	++nole;
3859     }
3860     if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
3861 	multip = (all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8;
3862 /*          if (btest(islur(ivx,ip-1),3)) multip = multip+1 */
3863 
3864 /*  (Above test OK since must have ip>1).  Double dotted note preceding */
3865 
3866 /*  Move the following, because can't ask for note until after checking for */
3867 /*  embedded xtup with number, due to ordering/octave feature. */
3868 
3869 /*         call notefq(noteq,lnoten,nolev(ivx,ip),ncmid(iv,ip)) */
3870     }
3871     if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],28)) {
3872 	comxtup_1.vxtup[commvl_1.ivx - 1] = TRUE_;
3873     }
3874     if (comxtup_1.vxtup[commvl_1.ivx - 1]) {
3875 
3876 /*  In an xtup */
3877 
3878 	if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
3879 
3880 /*  Intermediate rest in xtup, put in the rest.  Reset nodur so notex works OK */
3881 
3882 	    i__1 = 4 - ((all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8);
3883 	    all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &i__1);
3884 	    notex_(notexq, lnote, (ftnlen)79);
3885 
3886 /*  Re-zero so next note does not get confused */
3887 
3888 	    all_1.nodur[commvl_1.ivx + ip * 24 - 25] = 0;
3889 	    return 0;
3890 	}
3891 /*          if (multip.le.0) then */
3892 /*          if (multip.le.0 .or. */
3893 /*     *        (multip.eq.1.and.btest(nacc(ivx,ip-1),18))) then */
3894 	if (! comdraw_1.drawbm[commvl_1.ivx - 1]) {
3895 
3896 /*  Xtuplet with no beam, just put in the right kind of note */
3897 
3898 	    if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],30)) {
3899 
3900 /*  Forced stem direction */
3901 
3902 		ndsav = all_1.nodur[commvl_1.ivx + ip * 24 - 25];
3903 		i__1 = 4 - multip;
3904 		all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &
3905 			i__1);
3906 		if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],19) ||
3907 			bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],27))
3908 			{
3909 		    all_1.nodur[commvl_1.ivx + ip * 24 - 25] = all_1.nodur[
3910 			    commvl_1.ivx + ip * 24 - 25] * 3 / 2;
3911 		} else if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 -
3912 			25],27)) {
3913 		    all_1.nodur[commvl_1.ivx + ip * 24 - 25] /= 2;
3914 		}
3915 		notex_(notexq, lnote, (ftnlen)79);
3916 		all_1.nodur[commvl_1.ivx + ip * 24 - 25] = ndsav;
3917 	    } else {
3918 
3919 /*  Use ulq for stem direction */
3920 
3921 		i__1 = ncmid_(&all_1.iv, &ip);
3922 		notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
3923 		if (lnoten == 1) {
3924 		    addblank_(noteq, &lnoten, (ftnlen)8);
3925 		}
3926 		*lnote = 3;
3927 		if (! bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],
3928 			27)) {
3929 
3930 /*  Prior note is not regular-dotted */
3931 
3932 		    if (multip == 0) {
3933 /* Writing concatenation */
3934 			i__2[0] = 1, a__1[0] = all_1.sq;
3935 			i__2[1] = 1, a__1[1] = "q";
3936 			i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
3937 				all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
3938 			s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
3939 		    } else if (multip == -1) {
3940 /* Writing concatenation */
3941 			i__2[0] = 1, a__1[0] = all_1.sq;
3942 			i__2[1] = 1, a__1[1] = "h";
3943 			i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
3944 				all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
3945 			s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
3946 		    } else if (multip == 1) {
3947 /* Writing concatenation */
3948 			i__2[0] = 1, a__1[0] = all_1.sq;
3949 			i__2[1] = 1, a__1[1] = "c";
3950 			i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
3951 				all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
3952 			s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
3953 		    } else if (multip == 2) {
3954 /* Writing concatenation */
3955 			i__2[0] = 1, a__1[0] = all_1.sq;
3956 			i__2[1] = 2, a__1[1] = "cc";
3957 			i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
3958 				all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
3959 			s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
3960 			*lnote = 4;
3961 		    } else if (multip == 3) {
3962 /* Writing concatenation */
3963 			i__2[0] = 1, a__1[0] = all_1.sq;
3964 			i__2[1] = 3, a__1[1] = "ccc";
3965 			i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
3966 				all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
3967 			s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
3968 			*lnote = 5;
3969 		    } else if (multip == -2) {
3970 /* Writing concatenation */
3971 			i__3[0] = 1, a__2[0] = all_1.sq;
3972 			i__3[1] = 2, a__2[1] = "wh";
3973 			s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
3974 		    }
3975 		    if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],27))
3976 			    {
3977 
3978 /*  This note is regular dotted non-beamed xtup */
3979 
3980 /* Writing concatenation */
3981 			i__3[0] = 3, a__2[0] = notexq;
3982 			i__3[1] = 1, a__2[1] = "p";
3983 			s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
3984 			*lnote = 4;
3985 		    }
3986 		} else {
3987 
3988 /*  Prior note is regular-dotted so this one is halved */
3989 
3990 		    if (multip == 0) {
3991 /* Writing concatenation */
3992 			i__2[0] = 1, a__1[0] = all_1.sq;
3993 			i__2[1] = 1, a__1[1] = "c";
3994 			i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
3995 				all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
3996 			s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
3997 		    } else if (multip == -1) {
3998 /* Writing concatenation */
3999 			i__2[0] = 1, a__1[0] = all_1.sq;
4000 			i__2[1] = 1, a__1[1] = "q";
4001 			i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
4002 				all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
4003 			s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
4004 		    } else if (multip == -2) {
4005 /* Writing concatenation */
4006 			i__2[0] = 1, a__1[0] = all_1.sq;
4007 			i__2[1] = 1, a__1[1] = "h";
4008 			i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
4009 				all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
4010 			s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
4011 		    }
4012 		}
4013 /* Writing concatenation */
4014 		i__3[0] = *lnote, a__2[0] = notexq;
4015 		i__3[1] = 8, a__2[1] = noteq;
4016 		s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4017 		*lnote += lnoten;
4018 	    }
4019 	    return 0;
4020 	} else if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 0) {
4021 
4022 /*  In the beamed xtup but not the last note */
4023 
4024 	    if (all_1.nodur[commvl_1.ivx + (ip - 1) * 24 - 25] > 0) {
4025 
4026 /*  Embedded Xtup, mult>0, starts here.  Put in number if needed */
4027 
4028 		++comxtup_1.nxtinbm[commvl_1.ivx - 1];
4029 		iud = 1;
4030 		if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[
4031 			commvl_1.ivx - 1] * 24 - 25] == 'u') {
4032 		    iud = -1;
4033 		}
4034 
4035 /*  Get ip#, notelevel of middle note (or gap) in xtup */
4036 
4037 		ipmid = ip + comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[
4038 			commvl_1.ivx - 1] * 24 - 25] / 2;
4039 		i__1 = ncmid_(&all_1.iv, &ipmid);
4040 		i__4 = (15 & all_1.mult[commvl_1.ivx + ipmid * 24 - 25]) - 8;
4041 		xnlmid = (real) levrn_(&all_1.nolev[commvl_1.ivx + ipmid * 24
4042 			- 25], &all_1.irest[commvl_1.ivx + ipmid * 24 - 25], &
4043 			iud, &i__1, &i__4);
4044 		if (comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[
4045 			commvl_1.ivx - 1] * 24 - 25] % 2 == 0) {
4046 		    i__4 = ipmid - 1;
4047 		    i__1 = ncmid_(&all_1.iv, &i__4);
4048 		    i__5 = (15 & all_1.mult[commvl_1.ivx + (ipmid - 1) * 24 -
4049 			    25]) - 8;
4050 		    xnlmid = (xnlmid + levrn_(&all_1.nolev[commvl_1.ivx + (
4051 			    ipmid - 1) * 24 - 25], &all_1.irest[commvl_1.ivx
4052 			    + (ipmid - 1) * 24 - 25], &iud, &i__1, &i__5)) /
4053 			    2;
4054 		}
4055 		iflop = 0;
4056 		if ((r__1 = xnlmid - ncmid_(&all_1.iv, &ip), dabs(r__1)) <
4057 			3.f) {
4058 		    iflop = -iud;
4059 		}
4060 		iup = iud + (iflop << 1);
4061 		if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],14)) {
4062 		    iup = -iup;
4063 		    iflop = 0;
4064 		    if (iud * iup < 0) {
4065 			iflop = iup;
4066 		    }
4067 		}
4068 
4069 /*  Place number if needed */
4070 
4071 		if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],31)) {
4072 		    mprint = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 -
4073 			    25], &c__5, &c__22);
4074 		    if (mprint == 0) {
4075 			mprint = comxtup_1.mtupv[commvl_1.ivx +
4076 				comxtup_1.nxtinbm[commvl_1.ivx - 1] * 24 - 25]
4077 				;
4078 		    }
4079 		    i__1 = ncmid_(&all_1.iv, &ip);
4080 		    putxtn_(&mprint, &iflop, &multip, &iud, &comask_1.wheadpt,
4081 			     &comask_1.poenom, &comxtup_1.nolev1[commvl_1.ivx
4082 			    - 1], &comxtup_1.islope[commvl_1.ivx - 1], &
4083 			    all_1.slfac, &xnlmid, &all_1.islur[commvl_1.ivx +
4084 			    ip * 24 - 25], lnote, notexq, &i__1, &nlnum, &
4085 			    comxtup_1.eloff[commvl_1.ivx + comxtup_1.nxtinbm[
4086 			    commvl_1.ivx - 1] * 24 - 25], &iup, &all_1.irest[
4087 			    commvl_1.ivx + ip * 24 - 25], &c_false, (ftnlen)
4088 			    79);
4089 		}
4090 		i__1 = ncmid_(&all_1.iv, &ip);
4091 		notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
4092 	    } else {
4093 
4094 /*  Intermediate note of xtup */
4095 
4096 		i__1 = ncmid_(&all_1.iv, &ip);
4097 		notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
4098 	    }
4099 	} else {
4100 
4101 /*  Last note of xtup (but not last note of beam!) */
4102 
4103 	    i__1 = ncmid_(&all_1.iv, &ip);
4104 	    notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
4105 	}
4106     } else if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
4107 	notex_(notexq, lnote, (ftnlen)79);
4108 	return 0;
4109     } else {
4110 	i__1 = ncmid_(&all_1.iv, &ip);
4111 	notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
4112     }
4113 
4114 /* Check if multiplicity changes in a way requiring action */
4115 
4116     ipleft = ip - 1;
4117     if (bit_test(all_1.irest[commvl_1.ivx + ipleft * 24 - 25],0)) {
4118 	--ipleft;
4119     }
4120     if (! bit_test(all_1.islur[commvl_1.ivx + ipleft * 24 - 25],20)) {
4121 	multl = (15 & all_1.mult[commvl_1.ivx + ipleft * 24 - 25]) - 8;
4122     } else {
4123 	multl = 1;
4124     }
4125     mub = multip - multl;
4126     ipright = ip + 1;
4127     if (bit_test(all_1.irest[commvl_1.ivx + ipright * 24 - 25],0)) {
4128 	++ipright;
4129     }
4130     if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],20)) {
4131 	multr = (15 & all_1.mult[commvl_1.ivx + ipright * 24 - 25]) - 8;
4132     } else {
4133 	multr = 1;
4134     }
4135     mua = multr - multip;
4136     if (mub > 0 || mua < 0) {
4137 
4138 /*  Multiplicity has increased from left or will decrease to right. Need action. */
4139 
4140 	if (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2) {
4141 	    ivb = combjmp_1.ivbj1;
4142 	    i__1 = 225 - *(unsigned char *)&all_1.ulq[commvl_1.ivx +
4143 		    all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25];
4144 	    chax_(ch__1, (ftnlen)1, &i__1);
4145 	    *(unsigned char *)ulqq = *(unsigned char *)&ch__1[0];
4146 	} else {
4147 	    ivb = commvl_1.ivx;
4148 	    *(unsigned char *)ulqq = *(unsigned char *)&all_1.ulq[
4149 		    commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25];
4150 	}
4151 	if (mua >= 0) {
4152 	    ntrbbb_(&multip, "n", ulqq, &ivb, notexq, lnote, (ftnlen)1, (
4153 		    ftnlen)1, (ftnlen)79);
4154 	} else if (multl >= multr) {
4155 	    i__1 = multr + 1;
4156 	    for (im = multip; im >= i__1; --im) {
4157 		ntrbbb_(&im, "t", ulqq, &ivb, notexq, lnote, (ftnlen)1, (
4158 			ftnlen)1, (ftnlen)79);
4159 /* L1: */
4160 	    }
4161 	} else {
4162 	    i__1 = multip;
4163 	    for (im = multr + 1; im <= i__1; ++im) {
4164 		ntrbbb_(&im, "r", ulqq, &ivb, notexq, lnote, (ftnlen)1, (
4165 			ftnlen)1, (ftnlen)79);
4166 /* L2: */
4167 	    }
4168 	    ntrbbb_(&multr, "n", ulqq, &ivb, notexq, lnote, (ftnlen)1, (
4169 		    ftnlen)1, (ftnlen)79);
4170 	}
4171     } else if (ip > 1) {
4172 
4173 /*  Check for 2nd member of dotted xtup */
4174 
4175 	if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) {
4176 	    i__1 = multip + 1;
4177 	    ntrbbb_(&i__1, "t", all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[
4178 		    commvl_1.ivx - 1] * 24 - 25), &commvl_1.ivx, notexq,
4179 		    lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79);
4180 	}
4181     }
4182 
4183 /* Now put in the note */
4184 
4185     if (*lnote > 0) {
4186 /* Writing concatenation */
4187 	i__2[0] = *lnote, a__1[0] = notexq;
4188 	i__2[1] = 1, a__1[1] = all_1.sq;
4189 	i__2[2] = 2, a__1[2] = "qb";
4190 	s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
4191     } else {
4192 /* Writing concatenation */
4193 	i__3[0] = 1, a__2[0] = all_1.sq;
4194 	i__3[1] = 2, a__2[1] = "qb";
4195 	s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4196     }
4197     *lnote += 3;
4198     isdotm = FALSE_;
4199     if (isdotted_(all_1.nodur, &commvl_1.ivx, &ip)) {
4200 
4201 /* rule out ')' */
4202 
4203 	if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13)) {
4204 	    if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],3)) {
4205 /* Writing concatenation */
4206 		i__3[0] = *lnote, a__2[0] = notexq;
4207 		i__3[1] = 1, a__2[1] = "p";
4208 		s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4209 	    } else {
4210 
4211 /*  Double dot */
4212 
4213 /* Writing concatenation */
4214 		i__3[0] = *lnote, a__2[0] = notexq;
4215 		i__3[1] = 2, a__2[1] = "pp";
4216 		s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4217 		++(*lnote);
4218 	    }
4219 	} else {
4220 /* Writing concatenation */
4221 	    i__3[0] = *lnote, a__2[0] = notexq;
4222 	    i__3[1] = 1, a__2[1] = "m";
4223 	    s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4224 	    isdotm = TRUE_;
4225 	}
4226 	++(*lnote);
4227     } else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],19) ||
4228 	    bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],27)) {
4229 
4230 /*  Special dotted notation for 2:1 xtup, or normal dot in xtup */
4231 
4232 /* Writing concatenation */
4233 	i__3[0] = *lnote, a__2[0] = notexq;
4234 	i__3[1] = 1, a__2[1] = "p";
4235 	s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4236 	++(*lnote);
4237     }
4238 
4239 /* 5/25/08 Allow >12 */
4240 
4241     if (! (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2)) {
4242 /*          call istring(mod(ivx,12),tempq,len) */
4243 	i__1 = commvl_1.ivx % 24;
4244 	istring_(&i__1, tempq, &len, (ftnlen)4);
4245     } else {
4246 /*          call istring(mod(ivbj1,12),tempq,len) */
4247 	i__1 = combjmp_1.ivbj1 % 24;
4248 	istring_(&i__1, tempq, &len, (ftnlen)4);
4249     }
4250 /* Writing concatenation */
4251     i__3[0] = *lnote, a__2[0] = notexq;
4252     i__3[1] = len, a__2[1] = tempq;
4253     s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4254     *lnote += len;
4255 /* Writing concatenation */
4256     i__3[0] = *lnote, a__2[0] = notexq;
4257     i__3[1] = lnoten, a__2[1] = noteq;
4258     s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4259     *lnote += lnoten;
4260     if (isdotm) {
4261 	if (lnoten == 2) {
4262 /* Writing concatenation */
4263 	    i__6[0] = *lnote, a__3[0] = notexq;
4264 	    i__6[1] = 1, a__3[1] = "{";
4265 	    i__6[2] = 1, a__3[2] = noteq + 1;
4266 	    i__6[3] = 1, a__3[3] = "}";
4267 	    s_cat(notexq, a__3, i__6, &c__4, (ftnlen)79);
4268 	    *lnote += 3;
4269 	} else {
4270 	    i__1 = lnoten - 2;
4271 /* Writing concatenation */
4272 	    i__3[0] = *lnote, a__2[0] = notexq;
4273 	    i__3[1] = lnoten - 1 - i__1, a__2[1] = noteq + i__1;
4274 	    s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4275 	    ++(*lnote);
4276 	}
4277     }
4278     return 0;
4279 } /* beamid_ */
4280 
beamn1_(char * notexq,integer * lnote,ftnlen notexq_len)4281 /* Subroutine */ int beamn1_(char *notexq, integer *lnote, ftnlen notexq_len)
4282 {
4283     /* System generated locals */
4284     address a__1[3], a__2[2], a__3[4];
4285     integer i__1, i__2[3], i__3[2], i__4[4];
4286 
4287     /* Builtin functions */
4288     integer pow_ii(integer *, integer *);
4289     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
4290     integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char
4291 	    *, ftnlen);
4292 
4293     /* Local variables */
4294     extern /* Subroutine */ int addblank_(char *, integer *, ftnlen);
4295     static integer nd, im, ip1, len;
4296     extern integer log2_(integer *);
4297     static integer nole;
4298     extern /* Subroutine */ int stop1_(void);
4299     extern integer ncmid_(integer *, integer *);
4300     static integer ndsav;
4301     static char noteq[8];
4302     extern /* Subroutine */ int notex_(char *, integer *, ftnlen);
4303     static integer multr;
4304     extern /* Subroutine */ int ntrbbb_(integer *, char *, char *, integer *,
4305 	    char *, integer *, ftnlen, ftnlen, ftnlen), notefq_(char *,
4306 	    integer *, integer *, integer *, ftnlen);
4307     static logical isdotm;
4308     static integer lnoten, multip;
4309     extern /* Subroutine */ int istring_(integer *, char *, integer *, ftnlen)
4310 	    ;
4311 
4312     /* Fortran I/O blocks */
4313     static cilist io___182 = { 0, 6, 0, 0, 0 };
4314     static cilist io___183 = { 0, 6, 0, 0, 0 };
4315 
4316 
4317     ip1 = all_1.ipo[all_1.jn - 1];
4318     multip = (15 & all_1.mult[commvl_1.ivx + ip1 * 24 - 25]) - 8;
4319 /*     if (multip.le.0 .and. btest(irest(ivx,ip1),0)) then */
4320     if (! comdraw_1.drawbm[commvl_1.ivx - 1] && bit_test(all_1.irest[
4321 	    commvl_1.ivx + ip1 * 24 - 25],0)) {
4322 	*lnote = 0;
4323 
4324 /*  The rest was already written in beamstrt, so just get out of here */
4325 
4326 	return 0;
4327     }
4328     nole = all_1.nolev[commvl_1.ivx + all_1.ipo[all_1.jn - 1] * 24 - 25];
4329 
4330 /*  Check for special situations with 2nds (see precrd) */
4331 
4332     if (bit_test(all_1.nacc[commvl_1.ivx + all_1.ipo[all_1.jn - 1] * 24 - 25],
4333 	    30)) {
4334 	--nole;
4335     } else if (bit_test(all_1.nacc[commvl_1.ivx + all_1.ipo[all_1.jn - 1] *
4336 	    24 - 25],31)) {
4337 	++nole;
4338     }
4339     if (comxtup_1.vxtup[commvl_1.ivx - 1] && ! comdraw_1.drawbm[commvl_1.ivx
4340 	    - 1]) {
4341 
4342 /*  Xtuplet with no beam, just put in the right kind of note */
4343 
4344 	if (bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25],30)) {
4345 
4346 /*  Forced stem direction */
4347 
4348 	    ndsav = all_1.nodur[commvl_1.ivx + ip1 * 24 - 25];
4349 	    i__1 = 4 - multip;
4350 	    all_1.nodur[commvl_1.ivx + ip1 * 24 - 25] = pow_ii(&c__2, &i__1);
4351 	    if (bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],19) ||
4352 		    bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],27)) {
4353 		all_1.nodur[commvl_1.ivx + ip1 * 24 - 25] = all_1.nodur[
4354 			commvl_1.ivx + ip1 * 24 - 25] * 3 / 2;
4355 	    }
4356 	    notex_(notexq, lnote, (ftnlen)79);
4357 	    all_1.nodur[commvl_1.ivx + ip1 * 24 - 25] = ndsav;
4358 	} else {
4359 	    i__1 = ncmid_(&all_1.iv, &ip1);
4360 	    notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
4361 	    if (lnoten == 1) {
4362 		addblank_(noteq, &lnoten, (ftnlen)8);
4363 	    }
4364 	    *lnote = 3;
4365 	    if (multip == 0) {
4366 /* Writing concatenation */
4367 		i__2[0] = 1, a__1[0] = all_1.sq;
4368 		i__2[1] = 1, a__1[1] = "q";
4369 		i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
4370 			all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
4371 		s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
4372 	    } else if (multip == -1) {
4373 /* Writing concatenation */
4374 		i__2[0] = 1, a__1[0] = all_1.sq;
4375 		i__2[1] = 1, a__1[1] = "h";
4376 		i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
4377 			all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
4378 		s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
4379 	    } else if (multip == 1) {
4380 /* Writing concatenation */
4381 		i__2[0] = 1, a__1[0] = all_1.sq;
4382 		i__2[1] = 1, a__1[1] = "c";
4383 		i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
4384 			all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
4385 		s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
4386 	    } else if (multip == 2) {
4387 /* Writing concatenation */
4388 		i__2[0] = 1, a__1[0] = all_1.sq;
4389 		i__2[1] = 2, a__1[1] = "cc";
4390 		i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
4391 			all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
4392 		s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
4393 		*lnote = 4;
4394 	    } else if (multip == 3) {
4395 /* Writing concatenation */
4396 		i__2[0] = 1, a__1[0] = all_1.sq;
4397 		i__2[1] = 3, a__1[1] = "ccc";
4398 		i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
4399 			all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
4400 		s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
4401 		*lnote = 5;
4402 	    } else if (multip == -2) {
4403 /* Writing concatenation */
4404 		i__3[0] = 1, a__2[0] = all_1.sq;
4405 		i__3[1] = 2, a__2[1] = "wh";
4406 		s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4407 	    } else if (multip == -3) {
4408 /* Writing concatenation */
4409 		i__3[0] = 1, a__2[0] = all_1.sq;
4410 		i__3[1] = 5, a__2[1] = "breve";
4411 		s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4412 		*lnote = 6;
4413 	    } else {
4414 		s_wsle(&io___182);
4415 		e_wsle();
4416 		s_wsle(&io___183);
4417 		do_lio(&c__9, &c__1, "(Error in beamn1, send source to Dr. D"
4418 			"on)", (ftnlen)41);
4419 		e_wsle();
4420 		stop1_();
4421 	    }
4422 	    if (bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],19) ||
4423 		    bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],27)) {
4424 /* Writing concatenation */
4425 		i__3[0] = 3, a__2[0] = notexq;
4426 		i__3[1] = 1, a__2[1] = "p";
4427 		s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4428 		*lnote = 4;
4429 	    }
4430 /* Writing concatenation */
4431 	    i__3[0] = *lnote, a__2[0] = notexq;
4432 	    i__3[1] = 8, a__2[1] = noteq;
4433 	    s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4434 	    *lnote += lnoten;
4435 	}
4436 	return 0;
4437     }
4438 
4439 /*  Check if mult. decreases from 1st note to 2nd */
4440 
4441     if (all_1.ibm2[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] >
4442 	    ip1 || bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25],20)) {
4443 
4444 /*  More than one note or single-note before a multiplicity-down-up "][" */
4445 
4446 	if (bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25],20)) {
4447 	    multr = 1;
4448 	} else if (! bit_test(all_1.irest[commvl_1.ivx + (ip1 + 1) * 24 - 25],
4449 		0)) {
4450 	    multr = (15 & all_1.mult[commvl_1.ivx + (ip1 + 1) * 24 - 25]) - 8;
4451 	} else {
4452 	    multr = (15 & all_1.mult[commvl_1.ivx + (ip1 + 2) * 24 - 25]) - 8;
4453 	}
4454 	*lnote = 0;
4455 	if (multr < multip) {
4456 	    i__1 = multr + 1;
4457 	    for (im = multip; im >= i__1; --im) {
4458 		ntrbbb_(&im, "r", all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[
4459 			commvl_1.ivx - 1] * 24 - 25), &commvl_1.ivx, notexq,
4460 			lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79);
4461 /* L1: */
4462 	    }
4463 	}
4464     }
4465 
4466 /*  Put in the note */
4467 
4468     if (*lnote > 0) {
4469 /* Writing concatenation */
4470 	i__2[0] = *lnote, a__1[0] = notexq;
4471 	i__2[1] = 1, a__1[1] = all_1.sq;
4472 	i__2[2] = 2, a__1[2] = "qb";
4473 	s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
4474     } else {
4475 /* Writing concatenation */
4476 	i__3[0] = 1, a__2[0] = all_1.sq;
4477 	i__3[1] = 2, a__2[1] = "qb";
4478 	s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4479     }
4480     *lnote += 3;
4481 
4482 /*  Check for dot */
4483 
4484     isdotm = FALSE_;
4485     if (! comxtup_1.vxtup[commvl_1.ivx - 1]) {
4486 	nd = all_1.nodur[commvl_1.ivx + all_1.ipo[all_1.jn - 1] * 24 - 25];
4487 	if (nd != 0) {
4488 	    i__1 = log2_(&nd);
4489 	    if (pow_ii(&c__2, &i__1) != nd) {
4490 		if (! bit_test(all_1.iornq[commvl_1.ivx + ip1 * 24 - 1],13)) {
4491 		    if (! bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25],
4492 			    3)) {
4493 /* Writing concatenation */
4494 			i__3[0] = *lnote, a__2[0] = notexq;
4495 			i__3[1] = 1, a__2[1] = "p";
4496 			s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4497 		    } else {
4498 
4499 /*  Double dot */
4500 
4501 /* Writing concatenation */
4502 			i__3[0] = *lnote, a__2[0] = notexq;
4503 			i__3[1] = 2, a__2[1] = "pp";
4504 			s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4505 			++(*lnote);
4506 		    }
4507 		} else {
4508 /* Writing concatenation */
4509 		    i__3[0] = *lnote, a__2[0] = notexq;
4510 		    i__3[1] = 1, a__2[1] = "m";
4511 		    s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4512 		    isdotm = TRUE_;
4513 		}
4514 		++(*lnote);
4515 	    }
4516 	}
4517     } else if (bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],19) ||
4518 	    bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],27)) {
4519 
4520 /*  In an xtup with special 2:1 notation with a dot on 1st note, or normal dot */
4521 
4522 /* Writing concatenation */
4523 	i__3[0] = *lnote, a__2[0] = notexq;
4524 	i__3[1] = 1, a__2[1] = "p";
4525 	s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4526 	++(*lnote);
4527     }
4528 
4529 /*  Do the number; 0 if 12 */
4530 
4531 /*  5/25/08 allow >12 */
4532 
4533     if (! bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],24)) {
4534 /*        call istring(mod(ivx,12),noteq,len) */
4535 	i__1 = commvl_1.ivx % 24;
4536 	istring_(&i__1, noteq, &len, (ftnlen)8);
4537     } else {
4538 /*        call istring(mod(ivbj1,12),noteq,len) */
4539 	i__1 = combjmp_1.ivbj1 % 24;
4540 	istring_(&i__1, noteq, &len, (ftnlen)8);
4541     }
4542 /* Writing concatenation */
4543     i__3[0] = *lnote, a__2[0] = notexq;
4544     i__3[1] = len, a__2[1] = noteq;
4545     s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4546     *lnote += len;
4547     i__1 = ncmid_(&all_1.iv, &ip1);
4548     notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
4549 /* Writing concatenation */
4550     i__3[0] = *lnote, a__2[0] = notexq;
4551     i__3[1] = lnoten, a__2[1] = noteq;
4552     s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4553     *lnote += lnoten;
4554     if (isdotm) {
4555 	if (lnoten == 1) {
4556 /* Writing concatenation */
4557 	    i__4[0] = *lnote, a__3[0] = notexq;
4558 	    i__4[1] = 1, a__3[1] = "{";
4559 	    i__4[2] = 1, a__3[2] = noteq;
4560 	    i__4[3] = 1, a__3[3] = "}";
4561 	    s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
4562 	    *lnote += 3;
4563 	} else {
4564 	    i__1 = lnoten - 2;
4565 /* Writing concatenation */
4566 	    i__3[0] = *lnote, a__2[0] = notexq;
4567 	    i__3[1] = lnoten - 1 - i__1, a__2[1] = noteq + i__1;
4568 	    s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4569 	    ++(*lnote);
4570 	}
4571     }
4572     return 0;
4573 } /* beamn1_ */
4574 
beamstrt_(char * notexq,integer * lnote,integer * nornb,integer * ihornb,real * space,real * squez,integer * ib,ftnlen notexq_len)4575 /* Subroutine */ int beamstrt_(char *notexq, integer *lnote, integer *nornb,
4576 	integer *ihornb, real *space, real *squez, integer *ib, ftnlen
4577 	notexq_len)
4578 {
4579     /* System generated locals */
4580     address a__1[3], a__2[2], a__3[5];
4581     integer i__1, i__2, i__3, i__4[3], i__5[2], i__6[5];
4582     real r__1;
4583     char ch__1[1];
4584     icilist ici__1;
4585 
4586     /* Builtin functions */
4587     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
4588     integer i_nint(real *), s_wsfi(icilist *), do_fio(integer *, char *,
4589 	    ftnlen), e_wsfi(void);
4590     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
4591     integer pow_ii(integer *, integer *), i_sign(integer *, integer *),
4592 	    lbit_shift(integer, integer);
4593 
4594     /* Local variables */
4595     static logical addbrack;
4596     extern /* Subroutine */ int addblank_(char *, integer *, ftnlen);
4597     extern integer igetbits_(integer *, integer *, integer *);
4598     static logical usexnumt;
4599     static integer nomornlev, ip, levbracket, ibc, inb, iud, imp, ivf, ipp,
4600 	    iup;
4601     static logical xto;
4602     static integer ipb1, iadj, icrd;
4603     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
4604     extern doublereal feon_(real *);
4605     static integer levc, nole, iorn;
4606     static real ymin, ybot;
4607     static integer levx;
4608     static real xnsk;
4609     extern integer ncmid_(integer *, integer *);
4610     static real ybeam;
4611     static integer ipmid, iflop;
4612     static real bmlev;
4613     static integer icrdx, multb, ltemp;
4614     static char noteq[8], tempq[79];
4615     extern integer levrn_(integer *, integer *, integer *, integer *, integer
4616 	    *);
4617     static char restq[40];
4618     static integer nlnum, lrest;
4619     extern /* Subroutine */ int notex_(char *, integer *, ftnlen);
4620     static integer isssb;
4621     static real zmult;
4622     extern /* Subroutine */ int ntrbbb_(integer *, char *, char *, integer *,
4623 	    char *, integer *, ftnlen, ftnlen, ftnlen);
4624     static real xnlmid;
4625     extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer
4626 	    *, ftnlen);
4627     static integer lnoten;
4628     extern /* Subroutine */ int setupb_(real *, integer *, real *, real *,
4629 	    integer *, real *, integer *);
4630     static integer mprint;
4631     static real xslope;
4632     extern /* Subroutine */ int putxtn_(integer *, integer *, integer *,
4633 	    integer *, real *, real *, integer *, integer *, real *, real *,
4634 	    integer *, integer *, char *, integer *, integer *, real *,
4635 	    integer *, integer *, logical *, ftnlen);
4636     static integer maxdrop;
4637 
4638     /* Fortran I/O blocks */
4639     static icilist io___212 = { 0, tempq, 0, "(i2)", 2, 1 };
4640 
4641 
4642 
4643 /*  The following is just to save the outputs from SetupB for the case of */
4644 /*  xtups starting with a rest, where beamstrt is called twice. */
4645 
4646     /* Parameter adjustments */
4647     --squez;
4648     --space;
4649     ihornb -= 25;
4650     --nornb;
4651 
4652     /* Function Body */
4653     ibc = all_1.ibmcnt[commvl_1.ivx - 1];
4654     ipb1 = all_1.ibm1[commvl_1.ivx + ibc * 24 - 25];
4655     multb = (15 & all_1.mult[commvl_1.ivx + ipb1 * 24 - 25]) - 8;
4656     ip = all_1.ipo[all_1.jn - 1];
4657 
4658 /*  Compute slopes and note offsets from start of beam.  Inside SetupB, for each */
4659 /*  xtup in the beam, set eloff,mtupv (in comxtup) for printed number. */
4660 
4661     if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0 && ! bit_test(all_1.nacc[
4662 	    commvl_1.ivx + ip * 24 - 25],21)) {
4663 	setupb_(comxtup_1.xelsk, &comipb_1.nnb, &comipb_1.sumx, &
4664 		comipb_1.sumy, comipb_1.ipb, &comipb_1.smed, &
4665 		strtmid_1.ixrest[commvl_1.ivx - 1]);
4666     }
4667     if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],21)) {
4668 
4669 /*  This is start of later segment of single-slope beam group so use slope and */
4670 /*    height from prior beam.   Slope is already OK. */
4671 
4672 	++comxtup_1.issb[commvl_1.ivx - 1];
4673 	comxtup_1.nolev1[commvl_1.ivx - 1] = comxtup_1.lev1ssb[commvl_1.ivx +
4674 		comxtup_1.issb[commvl_1.ivx - 1] * 24 - 25];
4675     }
4676     *lnote = 0;
4677     comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_;
4678     if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],28) &&
4679 	    strtmid_1.ixrest[commvl_1.ivx - 1] != 2) {
4680 	comxtup_1.vxtup[commvl_1.ivx - 1] = TRUE_;
4681 	++comxtup_1.nxtinbm[commvl_1.ivx - 1];
4682 
4683 /*  irest(28)=>Xtup starts on this note.  Set up for xtuplet. */
4684 /*  Number goes on notehead side at middle note (or gap) of xtup, unless that */
4685 /*  puts it in staff, then it flops to stem (or beam) side. */
4686 /*               __          __ */
4687 /*         |    |  |   O    |  | */
4688 /*         O      |    |      O */
4689 /*       |___|    O  |__|     | */
4690 
4691 /*  iud   -1     -1    1      1    ...stem direction */
4692 /* iflop   0      1   -1      0    ...direction of flop */
4693 /*  iup   -1      1   -1      1    ...direction of number and bracket */
4694 
4695 	iud = 1;
4696 	if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u')
4697 		 {
4698 	    iud = -1;
4699 	}
4700 
4701 /*  Get ip#, note level of middle note (or gap) in xtup */
4702 
4703 	ipmid = ipb1 + comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[
4704 		commvl_1.ivx - 1] * 24 - 25] / 2;
4705 
4706 /*  130129 If middle note is a rest, go to next note. Note last note cannot */
4707 /*    be a rest */
4708 
4709 L14:
4710 	if (bit_test(all_1.irest[commvl_1.ivx + ipmid * 24 - 25],0)) {
4711 	    ++ipmid;
4712 	    goto L14;
4713 	}
4714 	i__1 = ncmid_(&all_1.iv, &ipmid);
4715 	i__2 = (15 & all_1.mult[commvl_1.ivx + ipmid * 24 - 25]) - 8;
4716 	xnlmid = (real) levrn_(&all_1.nolev[commvl_1.ivx + ipmid * 24 - 25], &
4717 		all_1.irest[commvl_1.ivx + ipmid * 24 - 25], &iud, &i__1, &
4718 		i__2);
4719 	if (comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[commvl_1.ivx - 1]
4720 		 * 24 - 25] % 2 == 0) {
4721 	    i__2 = ipmid - 1;
4722 	    i__1 = ncmid_(&all_1.iv, &i__2);
4723 	    i__3 = (15 & all_1.mult[commvl_1.ivx + (ipmid - 1) * 24 - 25]) -
4724 		    8;
4725 	    xnlmid = (xnlmid + levrn_(&all_1.nolev[commvl_1.ivx + (ipmid - 1)
4726 		    * 24 - 25], &all_1.irest[commvl_1.ivx + (ipmid - 1) * 24
4727 		    - 25], &iud, &i__1, &i__3)) / 2;
4728 	}
4729 	iflop = 0;
4730 	if ((r__1 = xnlmid - ncmid_(&all_1.iv, &ipb1), dabs(r__1)) < 3.f) {
4731 	    iflop = -iud;
4732 	}
4733 	iup = iud + (iflop << 1);
4734 	if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],14)) {
4735 
4736 /*  Alter iud, iflop, iup to flip number/bracket. (Stare at above pic) */
4737 
4738 	    iup = -iup;
4739 	    iflop = 0;
4740 	    if (iud * iup < 0) {
4741 		iflop = iup;
4742 	    }
4743 	}
4744 
4745 /*  Determine if a beam is to be drawn */
4746 
4747 	i__1 = all_1.ibm2[commvl_1.ivx + ibc * 24 - 25];
4748 	for (ipp = all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]; ipp <= i__1;
4749 		++ipp) {
4750 	    if ((15 & all_1.mult[commvl_1.ivx + ipp * 24 - 25]) - 8 <= 0) {
4751 		comdraw_1.drawbm[commvl_1.ivx - 1] = FALSE_;
4752 		goto L6;
4753 	    }
4754 /* L5: */
4755 	}
4756 	comdraw_1.drawbm[commvl_1.ivx - 1] = ! bit_test(all_1.islur[
4757 		commvl_1.ivx + all_1.ibm1[commvl_1.ivx + ibc * 24 - 25] * 24
4758 		- 25],18);
4759 L6:
4760 
4761 /* Are we using tuplet.tex? */
4762 
4763 	usexnumt = comnvst_1.cstuplet && ! comdraw_1.drawbm[commvl_1.ivx - 1];
4764 
4765 /*  Place xtup number if needed */
4766 
4767 	if (! bit_test(all_1.islur[commvl_1.ivx + ipb1 * 24 - 25],31) ||
4768 		multb <= 0) {
4769 	    mprint = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], &
4770 		    c__5, &c__22);
4771 	    if (mprint == 0) {
4772 		mprint = comxtup_1.mtupv[commvl_1.ivx + comxtup_1.nxtinbm[
4773 			commvl_1.ivx - 1] * 24 - 25];
4774 	    }
4775 	    i__1 = ncmid_(&all_1.iv, &ipb1);
4776 	    putxtn_(&mprint, &iflop, &multb, &iud, &comask_1.wheadpt, &
4777 		    comask_1.poenom, &comxtup_1.nolev1[commvl_1.ivx - 1], &
4778 		    comxtup_1.islope[commvl_1.ivx - 1], &all_1.slfac, &xnlmid,
4779 		     &all_1.islur[commvl_1.ivx + ipb1 * 24 - 25], lnote,
4780 		    notexq, &i__1, &nlnum, &comxtup_1.eloff[commvl_1.ivx +
4781 		    comxtup_1.nxtinbm[commvl_1.ivx - 1] * 24 - 25], &iup, &
4782 		    all_1.irest[commvl_1.ivx + ipb1 * 24 - 25], &usexnumt, (
4783 		    ftnlen)79);
4784 	}
4785 	if (! comdraw_1.drawbm[commvl_1.ivx - 1]) {
4786 
4787 /*  Xtuplet with no beam */
4788 
4789 	    if (! bit_test(all_1.islur[commvl_1.ivx + ipb1 * 24 - 25],31)) {
4790 
4791 /*  Number printing has not been suppressed, so put in the bracket. */
4792 /*    scale = stretch factor for bracket if there are asx's */
4793 /*    xnsk = length of the bracket in \noteskips = (\elemskips)/(eon) */
4794 
4795 		r__1 = space[*ib] / squez[*ib];
4796 		xnsk = (comeskz2_1.eskz2[commvl_1.ivx + (ipb1 +
4797 			comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[
4798 			commvl_1.ivx - 1] * 24 - 25] - 1) * 24 - 25] -
4799 			comeskz2_1.eskz2[commvl_1.ivx + ipb1 * 24 - 25]) /
4800 			squez[*ib] / feon_(&r__1);
4801 		if (iup == 1) {
4802 		    if (*lnote > 0) {
4803 /* Writing concatenation */
4804 			i__4[0] = *lnote, a__1[0] = notexq;
4805 			i__4[1] = 1, a__1[1] = all_1.sq;
4806 			i__4[2] = 5, a__1[2] = "ovbkt";
4807 			s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79);
4808 		    } else {
4809 /* Writing concatenation */
4810 			i__5[0] = 1, a__2[0] = all_1.sq;
4811 			i__5[1] = 5, a__2[1] = "ovbkt";
4812 			s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
4813 		    }
4814 		} else {
4815 		    if (*lnote > 0) {
4816 /* Writing concatenation */
4817 			i__4[0] = *lnote, a__1[0] = notexq;
4818 			i__4[1] = 1, a__1[1] = all_1.sq;
4819 			i__4[2] = 5, a__1[2] = "unbkt";
4820 			s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79);
4821 		    } else {
4822 
4823 /*  Introduced 12/5/98, req'd due to possible presence of in-line TeX */
4824 
4825 /* Writing concatenation */
4826 			i__5[0] = 1, a__2[0] = all_1.sq;
4827 			i__5[1] = 5, a__2[1] = "unbkt";
4828 			s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
4829 		    }
4830 		}
4831 		*lnote += 6;
4832 		if (all_1.iline == 1) {
4833 		    comipb_1.smed /= 1.f - comtop_1.fracindent;
4834 		}
4835 		xslope = comipb_1.smed * 1.8f * all_1.slfac;
4836 		comxtup_1.islope[commvl_1.ivx - 1] = i_nint(&xslope);
4837 		r__1 = comipb_1.smed * comxtup_1.eloff[commvl_1.ivx - 1];
4838 		comxtup_1.nolev1[commvl_1.ivx - 1] = nlnum - i_nint(&r__1);
4839 		if (comxtup_1.islope[commvl_1.ivx - 1] == 0) {
4840 		    --comxtup_1.nolev1[commvl_1.ivx - 1];
4841 		}
4842 		if (iup == 1) {
4843 		    comxtup_1.nolev1[commvl_1.ivx - 1] += 4;
4844 		}
4845 		levbracket = comxtup_1.nolev1[commvl_1.ivx - 1];
4846 		if (iup == 1 && comnvst_1.cstuplet) {
4847 		    --levbracket;
4848 		}
4849 		i__1 = ncmid_(&all_1.iv, &ipb1);
4850 		notefq_(noteq, &lnoten, &levbracket, &i__1, (ftnlen)8);
4851 		if (lnoten == 1) {
4852 		    addblank_(noteq, &lnoten, (ftnlen)8);
4853 		}
4854 /* Writing concatenation */
4855 		i__4[0] = *lnote, a__1[0] = notexq;
4856 		i__4[1] = lnoten, a__1[1] = noteq;
4857 		i__4[2] = 1, a__1[2] = "{";
4858 		s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79);
4859 		*lnote = *lnote + lnoten + 1;
4860 		if (xnsk < .995f) {
4861 		    i__1 = *lnote;
4862 		    ici__1.icierr = 0;
4863 		    ici__1.icirnum = 1;
4864 		    ici__1.icirlen = *lnote + 4 - i__1;
4865 		    ici__1.iciunit = notexq + i__1;
4866 		    ici__1.icifmt = "(i1,f3.2)";
4867 		    s_wsfi(&ici__1);
4868 		    do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
4869 		    do_fio(&c__1, (char *)&xnsk, (ftnlen)sizeof(real));
4870 		    e_wsfi();
4871 		    *lnote += 4;
4872 		} else if (xnsk < 9.995f) {
4873 		    i__1 = *lnote;
4874 		    ici__1.icierr = 0;
4875 		    ici__1.icirnum = 1;
4876 		    ici__1.icirlen = *lnote + 4 - i__1;
4877 		    ici__1.iciunit = notexq + i__1;
4878 		    ici__1.icifmt = "(f4.2)";
4879 		    s_wsfi(&ici__1);
4880 		    do_fio(&c__1, (char *)&xnsk, (ftnlen)sizeof(real));
4881 		    e_wsfi();
4882 		    *lnote += 4;
4883 		} else {
4884 		    i__1 = *lnote;
4885 		    ici__1.icierr = 0;
4886 		    ici__1.icirnum = 1;
4887 		    ici__1.icirlen = *lnote + 5 - i__1;
4888 		    ici__1.iciunit = notexq + i__1;
4889 		    ici__1.icifmt = "(f5.2)";
4890 		    s_wsfi(&ici__1);
4891 		    do_fio(&c__1, (char *)&xnsk, (ftnlen)sizeof(real));
4892 		    e_wsfi();
4893 		    *lnote += 5;
4894 		}
4895 /* Writing concatenation */
4896 		i__5[0] = *lnote, a__2[0] = notexq;
4897 		i__5[1] = 1, a__2[1] = "}";
4898 		s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
4899 		++(*lnote);
4900 		if (bit_test(all_1.mult[commvl_1.ivx + ipb1 * 24 - 25],4)) {
4901 
4902 /* Tweak slope of bracket */
4903 
4904 		    comxtup_1.islope[commvl_1.ivx - 1] = comxtup_1.islope[
4905 			    commvl_1.ivx - 1] + igetbits_(&all_1.mult[
4906 			    commvl_1.ivx + ipb1 * 24 - 25], &c__5, &c__5) -
4907 			    16;
4908 		}
4909 		if (comxtup_1.islope[commvl_1.ivx - 1] < 0 ||
4910 			comxtup_1.islope[commvl_1.ivx - 1] >= 10) {
4911 /* Writing concatenation */
4912 		    i__5[0] = *lnote, a__2[0] = notexq;
4913 		    i__5[1] = 1, a__2[1] = "{";
4914 		    s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
4915 		    ++(*lnote);
4916 		    if (comxtup_1.islope[commvl_1.ivx - 1] < -9) {
4917 			i__1 = *lnote;
4918 			ici__1.icierr = 0;
4919 			ici__1.icirnum = 1;
4920 			ici__1.icirlen = *lnote + 3 - i__1;
4921 			ici__1.iciunit = notexq + i__1;
4922 			ici__1.icifmt = "(i3)";
4923 			s_wsfi(&ici__1);
4924 			do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx
4925 				- 1], (ftnlen)sizeof(integer));
4926 			e_wsfi();
4927 			*lnote += 3;
4928 		    } else {
4929 			i__1 = *lnote;
4930 			ici__1.icierr = 0;
4931 			ici__1.icirnum = 1;
4932 			ici__1.icirlen = *lnote + 2 - i__1;
4933 			ici__1.iciunit = notexq + i__1;
4934 			ici__1.icifmt = "(i2)";
4935 			s_wsfi(&ici__1);
4936 			do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx
4937 				- 1], (ftnlen)sizeof(integer));
4938 			e_wsfi();
4939 			*lnote += 2;
4940 		    }
4941 /* Writing concatenation */
4942 		    i__5[0] = *lnote, a__2[0] = notexq;
4943 		    i__5[1] = 1, a__2[1] = "}";
4944 		    s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
4945 		    ++(*lnote);
4946 		} else {
4947 		    i__1 = *lnote;
4948 		    ici__1.icierr = 0;
4949 		    ici__1.icirnum = 1;
4950 		    ici__1.icirlen = *lnote + 1 - i__1;
4951 		    ici__1.iciunit = notexq + i__1;
4952 		    ici__1.icifmt = "(i1)";
4953 		    s_wsfi(&ici__1);
4954 		    do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1],
4955 			     (ftnlen)sizeof(integer));
4956 		    e_wsfi();
4957 		    ++(*lnote);
4958 		}
4959 
4960 /*  Done with bracket */
4961 
4962 	    }
4963 	    if (strtmid_1.ixrest[commvl_1.ivx - 1] == 1) {
4964 
4965 /*  Put in the rest.  Possible problem: Rest is a spacing char, but between */
4966 /*  beamstrt and beamn1 some non-spacing chars. are inserted. */
4967 
4968 /*  130126 Deal with vertical shifts of rest starting xtuplet */
4969 
4970 /*            if (multb .eq. 0) then */
4971 /*              notexq = notexq(1:lnote)//sq//'qp' */
4972 /*              lnote = lnote+3 */
4973 /*            else if (.not.drawbm(ivx).and.multb.eq.1) then */
4974 /*              notexq = notexq(1:lnote)//sq//'ds' */
4975 /*              lnote = lnote+3 */
4976 /*            else if (.not.drawbm(ivx).and.multb.eq.2) then */
4977 /*              notexq = notexq(1:lnote)//sq//'qs' */
4978 /*              lnote = lnote+3 */
4979 /*            else if (.not.drawbm(ivx).and.multb.eq.3) then */
4980 /*              notexq = notexq(1:lnote)//sq//'hs' */
4981 /*              lnote = lnote+3 */
4982 /*            else */
4983 /*              notexq = notexq(1:lnote)//sq//'hpause' */
4984 /*              lnote = lnote+7 */
4985 /*            end if */
4986 		lrest = 3;
4987 		if (multb == 0) {
4988 /* Writing concatenation */
4989 		    i__5[0] = 1, a__2[0] = all_1.sq;
4990 		    i__5[1] = 2, a__2[1] = "qp";
4991 		    s_cat(restq, a__2, i__5, &c__2, (ftnlen)40);
4992 		} else if (! comdraw_1.drawbm[commvl_1.ivx - 1] && multb == 1)
4993 			 {
4994 /* Writing concatenation */
4995 		    i__5[0] = 1, a__2[0] = all_1.sq;
4996 		    i__5[1] = 2, a__2[1] = "ds";
4997 		    s_cat(restq, a__2, i__5, &c__2, (ftnlen)40);
4998 		} else if (! comdraw_1.drawbm[commvl_1.ivx - 1] && multb == 2)
4999 			 {
5000 /* Writing concatenation */
5001 		    i__5[0] = 1, a__2[0] = all_1.sq;
5002 		    i__5[1] = 2, a__2[1] = "qs";
5003 		    s_cat(restq, a__2, i__5, &c__2, (ftnlen)40);
5004 		} else if (! comdraw_1.drawbm[commvl_1.ivx - 1] && multb == 3)
5005 			 {
5006 /* Writing concatenation */
5007 		    i__5[0] = 1, a__2[0] = all_1.sq;
5008 		    i__5[1] = 2, a__2[1] = "hs";
5009 		    s_cat(restq, a__2, i__5, &c__2, (ftnlen)40);
5010 		} else {
5011 /* Writing concatenation */
5012 		    i__5[0] = 1, a__2[0] = all_1.sq;
5013 		    i__5[1] = 6, a__2[1] = "hpause";
5014 		    s_cat(restq, a__2, i__5, &c__2, (ftnlen)40);
5015 		    lrest = 7;
5016 		}
5017 		nole = (all_1.nolev[commvl_1.ivx + ip * 24 - 25] + 20) % 100
5018 			- 20;
5019 		if (nole == 0) {
5020 
5021 /* Rest is not raised */
5022 
5023 /* Writing concatenation */
5024 		    i__5[0] = *lnote, a__2[0] = notexq;
5025 		    i__5[1] = 40, a__2[1] = restq;
5026 		    s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
5027 		    *lnote += lrest;
5028 		} else {
5029 		    if (abs(nole) < 10) {
5030 			i__1 = abs(nole) + 48;
5031 			chax_(ch__1, (ftnlen)1, &i__1);
5032 			s_copy(tempq, ch__1, (ftnlen)79, (ftnlen)1);
5033 			ltemp = 1;
5034 		    } else {
5035 			s_wsfi(&io___212);
5036 			i__1 = abs(nole);
5037 			do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
5038 			e_wsfi();
5039 			ltemp = 2;
5040 		    }
5041 		    if (nole > 0) {
5042 /* Writing concatenation */
5043 			i__6[0] = 1, a__3[0] = all_1.sq;
5044 			i__6[1] = 5, a__3[1] = "raise";
5045 			i__6[2] = ltemp, a__3[2] = tempq;
5046 			i__6[3] = 1, a__3[3] = all_1.sq;
5047 			i__6[4] = 9, a__3[4] = "internote";
5048 			s_cat(tempq, a__3, i__6, &c__5, (ftnlen)79);
5049 		    } else {
5050 /* Writing concatenation */
5051 			i__6[0] = 1, a__3[0] = all_1.sq;
5052 			i__6[1] = 5, a__3[1] = "lower";
5053 			i__6[2] = ltemp, a__3[2] = tempq;
5054 			i__6[3] = 1, a__3[3] = all_1.sq;
5055 			i__6[4] = 9, a__3[4] = "internote";
5056 			s_cat(tempq, a__3, i__6, &c__5, (ftnlen)79);
5057 		    }
5058 		    ltemp += 16;
5059 /* Writing concatenation */
5060 		    i__4[0] = *lnote, a__1[0] = notexq;
5061 		    i__4[1] = ltemp, a__1[1] = tempq;
5062 		    i__4[2] = lrest, a__1[2] = restq;
5063 		    s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79);
5064 		    *lnote = *lnote + ltemp + lrest;
5065 		}
5066 
5067 /*  No need to come back through this subroutine (as would if rest starts bar */
5068 /*  & multb>0), so do not advance ibm1. But must check in beamn1 and do nothing. */
5069 
5070 		strtmid_1.ixrest[commvl_1.ivx - 1] = 0;
5071 	    }
5072 	    return 0;
5073 	}
5074 
5075 /*  End if block for non-beamed xtup start...note we returned */
5076 
5077 	if (strtmid_1.ixrest[commvl_1.ivx - 1] == 1) {
5078 
5079 /*  Insert rest at start of beamed xtup.  See above note for possible problem. */
5080 
5081 	    i__1 = 4 - multb;
5082 	    all_1.nodur[commvl_1.ivx + ipb1 * 24 - 25] = pow_ii(&c__2, &i__1);
5083 	    notex_(tempq, &ltemp, (ftnlen)79);
5084 	    if (*lnote > 0) {
5085 /* Writing concatenation */
5086 		i__5[0] = *lnote, a__2[0] = notexq;
5087 		i__5[1] = ltemp, a__2[1] = tempq;
5088 		s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
5089 	    } else {
5090 		s_copy(notexq, tempq, (ftnlen)79, ltemp);
5091 	    }
5092 	    *lnote += ltemp;
5093 
5094 /*  Re-zero just in case! */
5095 
5096 	    all_1.nodur[commvl_1.ivx + ipb1 * 24 - 25] = 0;
5097 	    ++all_1.ibm1[commvl_1.ivx + ibc * 24 - 25];
5098 
5099 /*  See if next note is a non-rest */
5100 
5101 	    if (! bit_test(all_1.irest[commvl_1.ivx + (ipb1 + 1) * 24 - 25],0)
5102 		    ) {
5103 		strtmid_1.ixrest[commvl_1.ivx - 1] = 2;
5104 	    } else {
5105 
5106 /*  Suppress reprinting xtup number next time through beamstrt */
5107 
5108 		all_1.islur[commvl_1.ivx + (ipb1 + 1) * 24 - 25] = bit_set(
5109 			all_1.islur[commvl_1.ivx + (ipb1 + 1) * 24 - 25],31);
5110 
5111 /*  Set new xtup start flag */
5112 
5113 		all_1.irest[commvl_1.ivx + (ipb1 + 1) * 24 - 25] = bit_set(
5114 			all_1.irest[commvl_1.ivx + (ipb1 + 1) * 24 - 25],28);
5115 	    }
5116 	    return 0;
5117 	}
5118     }
5119 
5120 /*  Just ended if block for xtups */
5121 
5122     if (comxtup_1.vxtup[commvl_1.ivx - 1] && ipb1 == all_1.ibm2[commvl_1.ivx
5123 	    + ibc * 24 - 25]) {
5124 
5125 /*  Move actual note writing to beamend */
5126 
5127 	strtmid_1.ixrest[commvl_1.ivx - 1] = 4;
5128 	return 0;
5129     }
5130     if (comxtup_1.issb[commvl_1.ivx - 1] == 0) {
5131 
5132 /*  1st bmstrt in single-slope bm grp, Adjust start level(s) and slope if needed */
5133 
5134 	iadj = igetbits_(&all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25], &c__6, &
5135 		c__11) - 30;
5136 	if (iadj != -30) {
5137 	    comxtup_1.nolev1[commvl_1.ivx - 1] += iadj;
5138 	    i__1 = comxtup_1.nssb[commvl_1.ivx - 1];
5139 	    for (isssb = 1; isssb <= i__1; ++isssb) {
5140 		comxtup_1.lev1ssb[commvl_1.ivx + isssb * 24 - 25] += iadj;
5141 /* L2: */
5142 	    }
5143 	}
5144 	iadj = igetbits_(&all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25], &c__6, &
5145 		c__17) - 30;
5146 	if (iadj != -30) {
5147 	    comxtup_1.islope[commvl_1.ivx - 1] += iadj;
5148 	    if ((i__1 = comxtup_1.islope[commvl_1.ivx - 1], abs(i__1)) > 9) {
5149 		comxtup_1.islope[commvl_1.ivx - 1] = i_sign(&c__9, &
5150 			comxtup_1.islope[commvl_1.ivx - 1]);
5151 	    }
5152 	    if (comxtup_1.nssb[commvl_1.ivx - 1] > 0) {
5153 
5154 /*  Cycle thru non-rest notes in SSBG, looking for bmstrts. */
5155 
5156 		isssb = 0;
5157 		i__1 = comipb_1.nnb;
5158 		for (inb = 2; inb <= i__1; ++inb) {
5159 		    if (bit_test(all_1.nacc[commvl_1.ivx + comipb_1.ipb[inb -
5160 			    1] * 24 - 25],21)) {
5161 
5162 /*  Beam segment start.  New start level */
5163 			++isssb;
5164 			comxtup_1.lev1ssb[commvl_1.ivx + isssb * 24 - 25] +=
5165 				comxtup_1.islope[commvl_1.ivx - 1] *
5166 				comxtup_1.xelsk[inb - 1] / all_1.slfac;
5167 		    }
5168 /* L4: */
5169 		}
5170 	    }
5171 	}
5172     }
5173     iadj = igetbits_(&all_1.islur[commvl_1.ivx + ipb1 * 24 - 25], &c__2, &
5174 	    c__27);
5175     addbrack = FALSE_;
5176     if (bit_test(all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25],30)) {
5177 
5178 /*  Check for altered starting polarity.  Only in forced beams. Nominal start */
5179 /*  level is nolev1. So beam level is nolev1 +/- 6, to be compared w/ nolev(.,.). */
5180 
5181 	if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u'
5182 		&& comxtup_1.nolev1[commvl_1.ivx - 1] + 6 < all_1.nolev[
5183 		commvl_1.ivx + ipb1 * 24 - 25]) {
5184 	    if (*lnote == 0) {
5185 /* Writing concatenation */
5186 		i__5[0] = 1, a__2[0] = all_1.sq;
5187 		i__5[1] = 5, a__2[1] = "loff{";
5188 		s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
5189 	    } else {
5190 /* Writing concatenation */
5191 		i__4[0] = *lnote, a__1[0] = notexq;
5192 		i__4[1] = 1, a__1[1] = all_1.sq;
5193 		i__4[2] = 5, a__1[2] = "loff{";
5194 		s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79);
5195 	    }
5196 	    *lnote += 6;
5197 	    addbrack = TRUE_;
5198 	} else if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25]
5199 		== 'l' && comxtup_1.nolev1[commvl_1.ivx - 1] - 6 >
5200 		all_1.nolev[commvl_1.ivx + ipb1 * 24 - 25]) {
5201 	    if (*lnote == 0) {
5202 /* Writing concatenation */
5203 		i__5[0] = 1, a__2[0] = all_1.sq;
5204 		i__5[1] = 5, a__2[1] = "roff{";
5205 		s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
5206 	    } else {
5207 /* Writing concatenation */
5208 		i__4[0] = *lnote, a__1[0] = notexq;
5209 		i__4[1] = 1, a__1[1] = all_1.sq;
5210 		i__4[2] = 5, a__1[2] = "roff{";
5211 		s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79);
5212 	    }
5213 	    *lnote += 6;
5214 	    addbrack = TRUE_;
5215 	}
5216 
5217 /*  Check end level for possible flipping in forced beam.  Have to do it */
5218 /*  here since with multiple voices, xelsk will not be preserved. */
5219 
5220 	if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[
5221 		commvl_1.ivx - 1] * 24 - 25] == 'u') {
5222 	    bmlev = comxtup_1.nolev1[commvl_1.ivx - 1] + 6 + comxtup_1.islope[
5223 		    commvl_1.ivx - 1] * comxtup_1.xelsk[comipb_1.nnb - 1] /
5224 		    all_1.slfac;
5225 	    strtmid_1.flipend[commvl_1.ivx - 1] = bmlev < (real) all_1.nolev[
5226 		    commvl_1.ivx + all_1.ibm2[commvl_1.ivx + ibc * 24 - 25] *
5227 		    24 - 25];
5228 	} else if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[
5229 		commvl_1.ivx - 1] * 24 - 25] == 'l') {
5230 	    bmlev = comxtup_1.nolev1[commvl_1.ivx - 1] - 6 + comxtup_1.islope[
5231 		    commvl_1.ivx - 1] * comxtup_1.xelsk[comipb_1.nnb - 1] /
5232 		    all_1.slfac;
5233 	    strtmid_1.flipend[commvl_1.ivx - 1] = bmlev > (real) all_1.nolev[
5234 		    commvl_1.ivx + all_1.ibm2[commvl_1.ivx + ibc * 24 - 25] *
5235 		    24 - 25];
5236 	}
5237     }
5238     i__1 = multb + iadj;
5239     ntrbbb_(&i__1, "i", all_1.ulq + (commvl_1.ivx + ibc * 24 - 25), &
5240 	    commvl_1.ivx, notexq, lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79);
5241 
5242 /*   Put in name of start level and slope, after correcting nolev1 if xtup */
5243 /*   started with a rest. */
5244 
5245     if (strtmid_1.ixrest[commvl_1.ivx - 1] == 2) {
5246 	r__1 = comxtup_1.nolev1[commvl_1.ivx - 1] + comxtup_1.xelsk[0] *
5247 		comxtup_1.islope[commvl_1.ivx - 1] / all_1.slfac;
5248 	comxtup_1.nolev1[commvl_1.ivx - 1] = i_nint(&r__1);
5249     }
5250     i__1 = ncmid_(&all_1.iv, &ipb1);
5251     notefq_(noteq, &lnoten, &comxtup_1.nolev1[commvl_1.ivx - 1], &i__1, (
5252 	    ftnlen)8);
5253     if (comxtup_1.islope[commvl_1.ivx - 1] < 0) {
5254 /* Writing concatenation */
5255 	i__4[0] = *lnote, a__1[0] = notexq;
5256 	i__4[1] = lnoten, a__1[1] = noteq;
5257 	i__4[2] = 1, a__1[2] = "{";
5258 	s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79);
5259 	*lnote = *lnote + 4 + lnoten;
5260 	i__1 = *lnote - 3;
5261 	ici__1.icierr = 0;
5262 	ici__1.icirnum = 1;
5263 	ici__1.icirlen = *lnote - i__1;
5264 	ici__1.iciunit = notexq + i__1;
5265 	ici__1.icifmt = "(i2,a1)";
5266 	s_wsfi(&ici__1);
5267 	do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1], (ftnlen)
5268 		sizeof(integer));
5269 	do_fio(&c__1, "}", (ftnlen)1);
5270 	e_wsfi();
5271     } else {
5272 /* Writing concatenation */
5273 	i__5[0] = *lnote, a__2[0] = notexq;
5274 	i__5[1] = lnoten, a__2[1] = noteq;
5275 	s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
5276 	*lnote = *lnote + 1 + lnoten;
5277 	ici__1.icierr = 0;
5278 	ici__1.icirnum = 1;
5279 	ici__1.icirlen = 1;
5280 	ici__1.iciunit = notexq + (*lnote - 1);
5281 	ici__1.icifmt = "(i1)";
5282 	s_wsfi(&ici__1);
5283 	do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1], (ftnlen)
5284 		sizeof(integer));
5285 	e_wsfi();
5286     }
5287 
5288 /*  Check for beam-thk fine-tuning */
5289 
5290     if (iadj > 0) {
5291 	i__1 = multb + 1;
5292 	for (imp = multb + iadj; imp >= i__1; --imp) {
5293 	    ntrbbb_(&imp, "t", all_1.ulq + (commvl_1.ivx + ibc * 24 - 25), &
5294 		    commvl_1.ivx, notexq, lnote, (ftnlen)1, (ftnlen)1, (
5295 		    ftnlen)79);
5296 /* L1: */
5297 	}
5298     }
5299 
5300 /*  If we shifted, must close with right bracket */
5301 
5302     if (addbrack) {
5303 /* Writing concatenation */
5304 	i__5[0] = *lnote, a__2[0] = notexq;
5305 	i__5[1] = 1, a__2[1] = "}";
5306 	s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
5307 	++(*lnote);
5308     }
5309 
5310 /*  Get 'floor' zmin for figures */
5311 /*  Note: Will not come thru here on 1st note of unbeamed xtup, so figure height */
5312 /*    won't be adjusted. If anyone ever needs that, need to duplicate this */
5313 /*    functionality up above, before exiting. */
5314 
5315     if (all_1.figbass && (commvl_1.ivx == 1 || commvl_1.ivx ==
5316 	    comfig_1.ivxfig2)) {
5317 	if (commvl_1.ivx == 1) {
5318 	    ivf = 1;
5319 	} else {
5320 	    ivf = comfig_1.ivxfig2;
5321 	}
5322 	zmult = (multb - 1) * 1.2f;
5323 	ymin = 100.f;
5324 	i__1 = comipb_1.nnb;
5325 	for (inb = 1; inb <= i__1; ++inb) {
5326 	    if (all_1.isfig[ivf + (comipb_1.ipb[inb - 1] << 1) - 3]) {
5327 		if (*(unsigned char *)&all_1.ulq[all_1.iv + ibc * 24 - 25] ==
5328 			'u') {
5329 		    ybot = (real) all_1.nolev[all_1.iv + comipb_1.ipb[inb - 1]
5330 			     * 24 - 25];
5331 		} else {
5332 		    ybot = comxtup_1.islope[commvl_1.ivx - 1] / all_1.slfac *
5333 			    comxtup_1.xelsk[inb - 1] + comxtup_1.nolev1[
5334 			    commvl_1.ivx - 1] - all_1.stemlen - zmult;
5335 		}
5336 		ymin = dmin(ymin,ybot);
5337 	    }
5338 /* L3: */
5339 	}
5340 	maxdrop = ncmid_(&all_1.iv, &ipb1) - 4 - ymin + 5.01f;
5341 /* Computing MAX */
5342 	i__1 = all_1.ifigdr[ivf + (all_1.iline << 1) - 3];
5343 	all_1.ifigdr[ivf + (all_1.iline << 1) - 3] = max(i__1,maxdrop);
5344     }
5345 
5346 /*  Compute ornament levels if needed */
5347 
5348     nomornlev = ncmid_(&all_1.iv, &ipb1) + 5;
5349     iorn = 0;
5350     i__1 = comipb_1.nnb;
5351     for (inb = 1; inb <= i__1; ++inb) {
5352 	ip = comipb_1.ipb[inb - 1];
5353 	if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],23)) {
5354 	    goto L8;
5355 	}
5356 	if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],26) && *(
5357 		unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] ==
5358 		'l') {
5359 
5360 /*  letter-dynamic or hairpin ending under down-beamed */
5361 
5362 	    ++iorn;
5363 	    ybeam = comxtup_1.nolev1[commvl_1.ivx - 1] - all_1.stemlen +
5364 		    comxtup_1.islope[commvl_1.ivx - 1] * comxtup_1.xelsk[inb
5365 		    - 1] / all_1.slfac + 1 - (multb - 1) * 1.2f;
5366 /* Computing MIN */
5367 	    r__1 = ybeam - 3.f;
5368 	    i__2 = i_nint(&r__1), i__3 = nomornlev - 10;
5369 	    ihornb[commvl_1.ivx + iorn * 24] = min(i__2,i__3);
5370 	} else if (! bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) {
5371 
5372 /*  Bits 0-13: (stmgx+Tupf._) , 14: Down fermata, was F */
5373 /*  15: Trill w/o "tr", was U , 16-18 Editorial s,f,n , 19-21 TBD */
5374 
5375 /*  Non-chord.  There IS an ornament.  Need ihornb only if upbeam, and if */
5376 /*  ornament is 1,2,3,5,6,7,8,9,10,15-21 (up- but not domn ferm.) */
5377 
5378 	    if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] ==
5379 		    'u' && (all_1.iornq[commvl_1.ivx + comipb_1.ipb[inb - 1] *
5380 		     24 - 1] & 4163566) > 0) {
5381 		++iorn;
5382 		all_1.iornq[commvl_1.ivx + ip * 24 - 1] = bit_set(all_1.iornq[
5383 			commvl_1.ivx + ip * 24 - 1],22);
5384 		ybeam = comxtup_1.nolev1[commvl_1.ivx - 1] + all_1.stemlen +
5385 			comxtup_1.islope[commvl_1.ivx - 1] * comxtup_1.xelsk[
5386 			inb - 1] / all_1.slfac - 1 + (multb - 1) * 1.2f;
5387 /* Computing MAX */
5388 		r__1 = ybeam + 3.f;
5389 		i__2 = i_nint(&r__1);
5390 		ihornb[commvl_1.ivx + iorn * 24] = max(i__2,nomornlev);
5391 	    }
5392 	} else {
5393 
5394 /* In a chord.  Orn may be on main note or non-main or both.  Set ihornb if */
5395 /* upbeam and highest note has orn, or down beam and lowest.  Find 1st chord note */
5396 
5397 	    i__2 = comtrill_1.ncrd;
5398 	    for (comtrill_1.icrd1 = 1; comtrill_1.icrd1 <= i__2;
5399 		    ++comtrill_1.icrd1) {
5400 		if ((255 & comtrill_1.icrdat[comtrill_1.icrd1 - 1]) == ip && (
5401 			15 & lbit_shift(comtrill_1.icrdat[comtrill_1.icrd1 -
5402 			1], (ftnlen)-8)) == commvl_1.ivx) {
5403 		    goto L11;
5404 		}
5405 /* L10: */
5406 	    }
5407 L11:
5408 
5409 /* Find outermost note, min or max depending on beam direction ulq.  xto is true */
5410 /* if there's an ornament on that note.  Expand orn list to include ._, since if */
5411 /* on extreme chord note in beam, will move. */
5412 /* So ornaments are all except 0,4,13 (,g,) */
5413 
5414 	    levx = all_1.nolev[commvl_1.ivx + ip * 24 - 25];
5415 	    xto = (all_1.iornq[commvl_1.ivx + comipb_1.ipb[inb - 1] * 24 - 1]
5416 		    & 4186094) > 0;
5417 	    icrdx = 0;
5418 	    i__2 = comtrill_1.ncrd;
5419 	    for (icrd = comtrill_1.icrd1; icrd <= i__2; ++icrd) {
5420 		if ((255 & comtrill_1.icrdat[icrd - 1]) != ip || (15 &
5421 			lbit_shift(comtrill_1.icrdat[icrd - 1], (ftnlen)-8))
5422 			!= commvl_1.ivx) {
5423 		    goto L13;
5424 		}
5425 		levc = 127 & lbit_shift(comtrill_1.icrdat[icrd - 1], (ftnlen)
5426 			-12);
5427 		if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25]
5428 			 == 'u' && levc > levx || *(unsigned char *)&
5429 			all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'l' &&
5430 			levc < levx) {
5431 		    levx = levc;
5432 		    icrdx = icrd;
5433 		    xto = (comtrill_1.icrdorn[icrd - 1] & 4186094) > 0;
5434 		}
5435 /* L12: */
5436 	    }
5437 L13:
5438 
5439 /*  If there's orn on extreme note, do stuff */
5440 
5441 	    if (xto) {
5442 		++iorn;
5443 		if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25]
5444 			 == 'u') {
5445 		    ybeam = comxtup_1.nolev1[commvl_1.ivx - 1] +
5446 			    all_1.stemlen + comxtup_1.islope[commvl_1.ivx - 1]
5447 			     * comxtup_1.xelsk[inb - 1] / all_1.slfac - 1 + (
5448 			    multb - 1) * 1.2f;
5449 /* Computing MAX */
5450 		    r__1 = ybeam + 3.f;
5451 		    i__2 = i_nint(&r__1);
5452 		    ihornb[commvl_1.ivx + iorn * 24] = max(i__2,nomornlev);
5453 		} else {
5454 		    ybeam = comxtup_1.nolev1[commvl_1.ivx - 1] -
5455 			    all_1.stemlen + comxtup_1.islope[commvl_1.ivx - 1]
5456 			     * comxtup_1.xelsk[inb - 1] / all_1.slfac + 1 - (
5457 			    multb - 1) * 1.2f;
5458 /* Computing MIN */
5459 		    r__1 = ybeam - 3.f;
5460 		    i__2 = i_nint(&r__1), i__3 = nomornlev - 10;
5461 		    ihornb[commvl_1.ivx + iorn * 24] = min(i__2,i__3);
5462 		}
5463 		if (icrdx == 0) {
5464 
5465 /*  Affected ornament is on main note */
5466 
5467 		    all_1.iornq[commvl_1.ivx + ip * 24 - 1] = bit_set(
5468 			    all_1.iornq[commvl_1.ivx + ip * 24 - 1],22);
5469 		} else {
5470 		    comtrill_1.icrdorn[icrdx - 1] = bit_set(
5471 			    comtrill_1.icrdorn[icrdx - 1],22);
5472 		}
5473 	    }
5474 	}
5475 L8:
5476 	;
5477     }
5478 
5479 /*  Henceforth nornb will be a counter. */
5480 
5481     if (iorn > 0) {
5482 	nornb[commvl_1.ivx] = 1;
5483     }
5484     if (strtmid_1.ixrest[commvl_1.ivx - 1] == 2) {
5485 	strtmid_1.ixrest[commvl_1.ivx - 1] = 0;
5486     }
5487     return 0;
5488 } /* beamstrt_ */
5489 
5490 
5491 
5492 /*  meter space (pts) = xb4mbr = musicsize*facmtr */
5493 
5494 
5495 /*  From other */
5496 
5497 /*     *   2.0,1.5,1.0,0.5,1.3,1.3,0.4,0.8,1.2,0.8,1.2,1.6, */
5498 
catspace_(real * space,real * squez,integer * nnsk)5499 /* Subroutine */ int catspace_(real *space, real *squez, integer *nnsk)
5500 {
5501     /* System generated locals */
5502     integer i__1;
5503     real r__1;
5504 
5505     /* Local variables */
5506     static integer iptr;
5507 
5508     i__1 = c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1;
5509     for (iptr = c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1]; iptr <= i__1;
5510 	    ++iptr) {
5511 	if ((r__1 = *space - c1omnotes_1.durb[iptr - 1], dabs(r__1)) <
5512 		comtol_1.tol) {
5513 	    if ((r__1 = *squez - c1omnotes_1.sqzb[iptr - 1], dabs(r__1)) <
5514 		    comtol_1.tol) {
5515 
5516 /*  Increment pre-existing entry */
5517 
5518 		c1omnotes_1.nnpd[iptr - 1] += *nnsk;
5519 		return 0;
5520 	    }
5521 	}
5522 /* L16: */
5523     }
5524 
5525 /*  Didn't find current duration & squez, so add a new entry. */
5526 /*  No particular reason to keep in order, so add at the end. */
5527 
5528     c1omnotes_1.nnpd[c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1] = *nnsk;
5529     c1omnotes_1.durb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1] = *space;
5530     c1omnotes_1.sqzb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1] = *squez;
5531     ++c1omnotes_1.nptr[c1omnotes_1.ibarcnt];
5532     return 0;
5533 } /* catspace_ */
5534 
chax_(char * ret_val,ftnlen ret_val_len,integer * n)5535 /* Character */ VOID chax_(char *ret_val, ftnlen ret_val_len, integer *n)
5536 {
5537 
5538 /* The only reason for this seemingly do-nothing function is to get around an */
5539 /*  apparent bug in the Visual Fortran Standard Edition 5.0.A compiler! */
5540 
5541     *(unsigned char *)ret_val = (char) (*n);
5542     return ;
5543 } /* chax_ */
5544 
checkdyn_(char * lineq,integer * iccount,integer * ibar,ftnlen lineq_len)5545 /* Subroutine */ int checkdyn_(char *lineq, integer *iccount, integer *ibar,
5546 	ftnlen lineq_len)
5547 {
5548     /* System generated locals */
5549     address a__1[3];
5550     integer i__1, i__2[3], i__3;
5551     real r__1;
5552     char ch__1[4], ch__2[1];
5553     icilist ici__1;
5554 
5555     /* Builtin functions */
5556     integer s_cmp(char *, char *, ftnlen, ftnlen), i_indx(char *, char *,
5557 	    ftnlen, ftnlen);
5558     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
5559     integer s_rsfi(icilist *), do_fio(integer *, char *, ftnlen), e_rsfi(void)
5560 	    , i_nint(real *);
5561 
5562     /* Local variables */
5563     static integer ipm, iend;
5564     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
5565     static integer idno;
5566     static real fnum;
5567     static char durq[1];
5568     extern /* Subroutine */ int stop1_(void), errmsg_(char *, integer *,
5569 	    integer *, char *, ftnlen, ftnlen);
5570     static logical txtdyn;
5571     extern /* Subroutine */ int readnum_(char *, integer *, char *, real *,
5572 	    ftnlen, ftnlen);
5573     static char dynsymq[4];
5574 
5575     txtdyn = FALSE_;
5576 
5577 /*  On entry, iccount is on "D" */
5578 
5579     i__1 = *iccount;
5580     if (s_cmp(lineq + i__1, "\"", *iccount + 1 - i__1, (ftnlen)1) == 0) {
5581 
5582 /*  Dynamic text */
5583 
5584 	i__1 = *iccount + 1;
5585 	iend = i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1);
5586 	if (iend == 0) {
5587 	    i__1 = *iccount + 1;
5588 	    errmsg_(lineq, &i__1, ibar, "Dynamic text must be terminated wit"
5589 		    "h double quote!", (ftnlen)128, (ftnlen)50);
5590 	    stop1_();
5591 	}
5592 
5593 /*  Set iccount to character after 2nd ", and set ipm */
5594 
5595 	*iccount = *iccount + iend + 2;
5596 	ipm = i_indx("- +", lineq + (*iccount - 1), (ftnlen)3, (ftnlen)1);
5597 	if (ipm == 0) {
5598 	    errmsg_(lineq, iccount, ibar, "Expected \"-\", \"+\", or blank h"
5599 		    "ere!", (ftnlen)128, (ftnlen)33);
5600 	    stop1_();
5601 	}
5602     } else {
5603 
5604 /*  Expect ordinary dynamic */
5605 
5606 	for (iend = *iccount + 2; iend <= 128; ++iend) {
5607 	    ipm = i_indx("- +", lineq + (iend - 1), (ftnlen)3, (ftnlen)1);
5608 	    if (ipm > 0) {
5609 		goto L2;
5610 	    }
5611 /* L1: */
5612 	}
5613 L2:
5614 	if (iend - *iccount > 5 || iend - *iccount < 2) {
5615 	    i__1 = iend - 1;
5616 	    errmsg_(lineq, &i__1, ibar, "Wrong length for dynamic mark!", (
5617 		    ftnlen)128, (ftnlen)30);
5618 	    stop1_();
5619 	}
5620 	i__1 = *iccount;
5621 	ici__1.icierr = 0;
5622 	ici__1.iciend = 0;
5623 	ici__1.icirnum = 1;
5624 	ici__1.icirlen = iend - 1 - i__1;
5625 	ici__1.iciunit = lineq + i__1;
5626 /* Writing concatenation */
5627 	i__2[0] = 2, a__1[0] = "(a";
5628 	i__3 = iend + 47 - *iccount;
5629 	chax_(ch__2, (ftnlen)1, &i__3);
5630 	i__2[1] = 1, a__1[1] = ch__2;
5631 	i__2[2] = 1, a__1[2] = ")";
5632 	ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1);
5633 	s_rsfi(&ici__1);
5634 	do_fio(&c__1, dynsymq, (ftnlen)4);
5635 	e_rsfi();
5636 	idno = (i_indx("ppppppp pp  p   mp  mf  f   fp  sfz ff  fff ffff<   "
5637 		">   ", dynsymq, (ftnlen)56, (ftnlen)4) + 3) / 4;
5638 	if (idno == 0) {
5639 	    i__1 = *iccount + 1;
5640 	    errmsg_(lineq, &i__1, ibar, "Illegal dynamic mark!", (ftnlen)128,
5641 		    (ftnlen)21);
5642 	    stop1_();
5643 	}
5644 	*iccount = iend;
5645     }
5646     if (ipm != 2) {
5647 
5648 /*  There is a vertical shift, have "+" or "-" */
5649 
5650 	++(*iccount);
5651 	if (i_indx("0123456789", lineq + (*iccount - 1), (ftnlen)10, (ftnlen)
5652 		1) == 0) {
5653 	    errmsg_(lineq, iccount, ibar, "Expected integer here for vertica"
5654 		    "l offset!", (ftnlen)128, (ftnlen)42);
5655 	    stop1_();
5656 	}
5657 	readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
5658 	idno = i_nint(&fnum);
5659 	if (idno > 63) {
5660 	    i__1 = *iccount - 1;
5661 	    errmsg_(lineq, &i__1, ibar, "Vertical offset for dynamic mark mu"
5662 		    "st be (-63,63)!", (ftnlen)128, (ftnlen)50);
5663 	    stop1_();
5664 	}
5665 	ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1);
5666 	if (ipm == 0) {
5667 	    errmsg_(lineq, iccount, ibar, "Expected \"+\", \"-\", or blank h"
5668 		    "ere!", (ftnlen)128, (ftnlen)33);
5669 	    stop1_();
5670 	}
5671 	if (ipm != 2) {
5672 
5673 /*  There is a horizontal shift */
5674 
5675 	    ++(*iccount);
5676 	    if (i_indx(".0123456789", lineq + (*iccount - 1), (ftnlen)11, (
5677 		    ftnlen)1) == 0) {
5678 		errmsg_(lineq, iccount, ibar, "Expected number here for hori"
5679 			"zontal offset!", (ftnlen)128, (ftnlen)43);
5680 		stop1_();
5681 	    }
5682 	    readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
5683 	    r__1 = fnum * 10;
5684 	    idno = i_nint(&r__1);
5685 	    if (idno > 255) {
5686 		i__1 = *iccount - 1;
5687 		errmsg_(lineq, &i__1, ibar, "Horizontal offset for dynamic m"
5688 			"ark must be (-25.5,25.5)!", (ftnlen)128, (ftnlen)56);
5689 		stop1_();
5690 	    } else if (*(unsigned char *)durq != ' ') {
5691 		errmsg_(lineq, iccount, ibar, "There should be a blank here!",
5692 			 (ftnlen)128, (ftnlen)29);
5693 		stop1_();
5694 	    }
5695 	}
5696 
5697 /*  iccount should be on the blank at the end of the entire symbol */
5698 
5699     }
5700     return 0;
5701 } /* checkdyn_ */
5702 
chkarp_(integer * ncrd,integer * icrdat,integer * ivx,integer * ip,logical * iscacc,logical * isarp)5703 /* Subroutine */ int chkarp_(integer *ncrd, integer *icrdat, integer *ivx,
5704 	integer *ip, logical *iscacc, logical *isarp)
5705 {
5706     /* System generated locals */
5707     integer i__1;
5708 
5709     /* Builtin functions */
5710     integer lbit_shift(integer, integer);
5711 
5712     /* Local variables */
5713     static integer icrd;
5714     static logical found1;
5715 
5716 /*      subroutine chkarp(found1,ncrd,icrdat,icrdot,ivx,ip,isacc,isarp, */
5717 /*     *                  icashft) */
5718     /* Parameter adjustments */
5719     --icrdat;
5720 
5721     /* Function Body */
5722     found1 = FALSE_;
5723 
5724 /*  icashft will be max left shift of accid's in chord notes. */
5725 /*  Used only for spacing checks. */
5726 /*  Will include left shift of chord note itself. */
5727 /*  Rezero after use. */
5728 
5729     i__1 = *ncrd;
5730     for (icrd = 1; icrd <= i__1; ++icrd) {
5731 
5732 /*  This if block cycles thru all chord notes on ivx,ip; then returns. */
5733 
5734 	if ((255 & icrdat[icrd]) == *ip && (15 & lbit_shift(icrdat[icrd], (
5735 		ftnlen)-8)) == *ivx) {
5736 	    found1 = TRUE_;
5737 	    *iscacc = *iscacc || bit_test(icrdat[icrd],19) && ! bit_test(
5738 		    icrdat[icrd],27);
5739 
5740 /*  Accid on this chord note, and it's not midi-only. */
5741 
5742 /*            irshft = igetbits(icrdot(icrd),7,20) */
5743 /* c */
5744 /* c  Include increment for notehead shift */
5745 /* c */
5746 /*            if (btest(icrdat(icrd),23)) then */
5747 /*              if (irshft .eq. 0) then */
5748 /*                irshft = 44 */
5749 /*              else */
5750 /*                irshft=irshft-20 */
5751 /*              end if */
5752 /*            end if */
5753 /*            if (irshft .ne. 0) then */
5754 /* c */
5755 /* c  Accid on chord note is shifted.  Include only left shift, in 20ths. */
5756 /* c */
5757 /*              if (irshft .lt. 64) icashft = max(icashft,64-irshft) */
5758 /*            end if */
5759 /*          end if */
5760 	    *isarp = *isarp || bit_test(icrdat[icrd],25);
5761 	} else if (found1) {
5762 	    return 0;
5763 	}
5764 /* L18: */
5765     }
5766     return 0;
5767 } /* chkarp_ */
5768 
chkimidi_(integer * icm)5769 /* Subroutine */ int chkimidi_(integer *icm)
5770 {
5771     /* Builtin functions */
5772     integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char
5773 	    *, ftnlen), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen),
5774 	    e_wsfe(void);
5775 
5776     /* Fortran I/O blocks */
5777     static cilist io___242 = { 0, 6, 0, 0, 0 };
5778     static cilist io___243 = { 0, 6, 0, 0, 0 };
5779     static cilist io___244 = { 0, 6, 0, "(a6,2x,4i8)", 0 };
5780 
5781 
5782     if (commidi_1.imidi[*icm] >= 24576) {
5783 	s_wsle(&io___242);
5784 	e_wsle();
5785 	s_wsle(&io___243);
5786 	do_lio(&c__9, &c__1, "Midi file is too long! It will be corrupted or"
5787 		" worse", (ftnlen)52);
5788 	e_wsle();
5789 	s_wsfe(&io___244);
5790 	do_fio(&c__1, "imidi:", (ftnlen)6);
5791 	do_fio(&c__1, (char *)&commidi_1.imidi[0], (ftnlen)sizeof(integer));
5792 	do_fio(&c__1, (char *)&commidi_1.imidi[1], (ftnlen)sizeof(integer));
5793 	do_fio(&c__1, (char *)&commidi_1.imidi[2], (ftnlen)sizeof(integer));
5794 	do_fio(&c__1, (char *)&commidi_1.imidi[3], (ftnlen)sizeof(integer));
5795 	e_wsfe();
5796     }
5797     return 0;
5798 } /* chkimidi_ */
5799 
chkkbdrests_(integer * ip,integer * iv,integer * ivx,integer * nn,integer * iornq,integer * islur,integer * irest,integer * nolev,integer * ivmx,integer * nib,integer * nv,integer * ibar,real * tnow,real * tol,integer * nodur,integer * mode,integer * levtopr,integer * levbotr,integer * mult)5800 /* Subroutine */ int chkkbdrests_(integer *ip, integer *iv, integer *ivx,
5801 	integer *nn, integer *iornq, integer *islur, integer *irest, integer *
5802 	nolev, integer *ivmx, integer *nib, integer *nv, integer *ibar, real *
5803 	tnow, real *tol, integer *nodur, integer *mode, integer *levtopr,
5804 	integer *levbotr, integer *mult)
5805 {
5806     /* System generated locals */
5807     integer i__1;
5808     real r__1;
5809 
5810     /* Builtin functions */
5811     integer i_sign(integer *, integer *);
5812 
5813     /* Local variables */
5814     static integer levother, kkp;
5815     extern integer log2_(integer *), ncmid_(integer *, integer *);
5816     static integer indxr, iraise, levbot;
5817     static real tother;
5818     static integer levtop, iraise1, iraise2, ivother, levnext, iupdown;
5819 
5820 
5821 /*  On 130127 put this code, formerly in make2bar right before calling notex for */
5822 /*  a single note/rest, into this subroutine, so the same logic could also be */
5823 /*  with the calls to beamstrt/mid/end to adjust height of rests in xtups if the */
5824 /*  keyboard rest option is selected */
5825 
5826 /*  mode=1 if called as before, 2 if for an xtup. Only affects check for */
5827 /*    quarter rests, which will fix later. */
5828 
5829 /*  Get reference level: next following note if no intervening blank rests, */
5830 /*    otherwise next prior note. Relative to bottom line. */
5831 
5832     /* Parameter adjustments */
5833     mult -= 25;
5834     --levbotr;
5835     --levtopr;
5836     nodur -= 25;
5837     nib -= 25;
5838     ivmx -= 25;
5839     nolev -= 25;
5840     irest -= 25;
5841     islur -= 25;
5842     --iornq;
5843     --nn;
5844 
5845     /* Function Body */
5846     if (*ip != nn[*ivx] && ! bit_test(iornq[*ivx + *ip * 24],30)) {
5847 
5848 /*  Not the last note and not "look-left" for level */
5849 
5850 	i__1 = nn[*ivx];
5851 	for (kkp = *ip + 1; kkp <= i__1; ++kkp) {
5852 	    if (bit_test(islur[*ivx + kkp * 24],29)) {
5853 		goto L4;
5854 	    }
5855 	    if (! bit_test(irest[*ivx + kkp * 24],0)) {
5856 		levnext = nolev[*ivx + kkp * 24] - ncmid_(iv, &kkp) + 4;
5857 /* Relative to botto */
5858 		goto L9;
5859 	    }
5860 /* L8: */
5861 	}
5862     }
5863 L4:
5864 
5865 /*  If here, there were no following notes or came to a blank rest, or */
5866 /*    "look-left" option set. So look before */
5867 
5868 /*      if (ip .eq. 1) go to 2 ! Get out if this is the first note. */
5869     if (*ip == 1) {
5870 	return 0;
5871     }
5872 /* Get out if this is the first note. */
5873     for (kkp = *ip - 1; kkp >= 1; --kkp) {
5874 	if (! bit_test(irest[*ivx + kkp * 24],0)) {
5875 	    levnext = nolev[*ivx + kkp * 24] - ncmid_(iv, &kkp) + 4;
5876 /* Relative to bottom */
5877 	    goto L9;
5878 	}
5879 /* L3: */
5880     }
5881 /*      go to 2  ! Pretty odd, should never be here, but get out if so. */
5882     return 0;
5883 /* Pretty odd, should never be here, but get out if so. */
5884 L9:
5885 
5886 /*  Find note in other voice at same time */
5887 
5888     i__1 = *ivx - *nv - 1;
5889     iupdown = i_sign(&c__1, &i__1);
5890     ivother = ivmx[*iv + (3 - iupdown) / 2 * 24];
5891     tother = 0.f;
5892     i__1 = nib[ivother + *ibar * 24];
5893     for (kkp = 1; kkp <= i__1; ++kkp) {
5894 	if ((r__1 = tother - *tnow, dabs(r__1)) < *tol) {
5895 	    goto L6;
5896 	}
5897 	tother += nodur[ivother + kkp * 24];
5898 /* L5: */
5899     }
5900 
5901 /*  If here, then no note starts in other voice at same time, so set default */
5902 
5903     levother = -iupdown * 50;
5904     goto L7;
5905 L6:
5906 
5907 /*  If here, have just identified a simultaneous note or rest in other voice */
5908 
5909     if (! bit_test(irest[ivother + kkp * 24],0)) {
5910 /* Not a rest, use it */
5911 	levother = nolev[ivother + kkp * 24] - ncmid_(iv, ip) + 4;
5912     } else {
5913 	if (nodur[ivother + kkp * 24] == nodur[*ivx + *ip * 24]) {
5914 
5915 /*  Rest in other voice has same duration, get out (so defualt spacing is used) */
5916 
5917 /*          go to 2 */
5918 	    return 0;
5919 	}
5920 	levother = -iupdown * 50;
5921     }
5922 L7:
5923     if (*mode == 1) {
5924 	indxr = log2_(&nodur[*ivx + *ip * 24]) + 1;
5925     } else {
5926 /*        nodu = 2**(4-(iand(mult(ivx,ip),15)-8)) */
5927 	indxr = 4 - ((mult[*ivx + *ip * 24] & 15) - 8) + 1;
5928     }
5929     if (iupdown < 0) {
5930 	levtop = levtopr[indxr];
5931 	iraise1 = levother - levtop - 3;
5932 /* Based on other note */
5933 	iraise2 = levnext - levtop;
5934 /* Based on following note */
5935 	if (indxr == 5 && levnext < 1) {
5936 	    iraise2 += 2;
5937 	}
5938 	iraise = min(iraise1,iraise2);
5939 	if ((iraise + 50) % 2 == 1 && iraise + levtop > -1) {
5940 	    --iraise;
5941 	}
5942     } else {
5943 	levbot = levbotr[indxr];
5944 	iraise1 = levother - levbot + 3;
5945 	iraise2 = levnext - levbot;
5946 	if (indxr == 5 && levnext > 8) {
5947 	    --iraise2;
5948 	}
5949 	iraise = max(iraise1,iraise2);
5950 	if ((iraise + 50) % 2 == 1 && iraise + levbot <= 9) {
5951 	    --iraise;
5952 	}
5953     }
5954     nolev[*ivx + *ip * 24] = iraise + 100;
5955     return 0;
5956 } /* chkkbdrests_ */
5957 
chklit_(char * lineq,integer * iccount,integer * literr,ftnlen lineq_len)5958 /* Subroutine */ int chklit_(char *lineq, integer *iccount, integer *literr,
5959 	ftnlen lineq_len)
5960 {
5961     /* System generated locals */
5962     char ch__1[1];
5963 
5964     /* Local variables */
5965     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
5966     static char charq[1];
5967     static integer itype, lenlit;
5968     extern /* Subroutine */ int g1etchar_(char *, integer *, char *, ftnlen,
5969 	    ftnlen);
5970 
5971     *literr = 0;
5972     itype = 1;
5973 L17:
5974     g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
5975     chax_(ch__1, (ftnlen)1, &c__92);
5976     if (*(unsigned char *)charq == *(unsigned char *)&ch__1[0]) {
5977 	++itype;
5978 /*        if (itype .eq. 2) then */
5979 /*          if (iccount .ne. 2 ) then */
5980 /* c */
5981 /* c type 2 or 3 tex string not starting in column 1 */
5982 /* c */
5983 /*            literr = 3 */
5984 /*            return */
5985 /*          end if */
5986 /*        else if (itype .gt. 3) then */
5987 	if (itype > 3) {
5988 	    *literr = 1;
5989 	    return 0;
5990 	}
5991 	goto L17;
5992     }
5993     lenlit = itype;
5994 L18:
5995     g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
5996     chax_(ch__1, (ftnlen)1, &c__92);
5997     if (*(unsigned char *)charq == *(unsigned char *)&ch__1[0]) {
5998 	g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
5999 	if (*(unsigned char *)charq != ' ') {
6000 
6001 /*  Starting a new tex command withing the string */
6002 
6003 	    lenlit += 2;
6004 	    if (lenlit > 128) {
6005 		*literr = 2;
6006 		return 0;
6007 	    }
6008 	    goto L18;
6009 	}
6010     } else {
6011 	++lenlit;
6012 	if (lenlit > 128) {
6013 	    *literr = 2;
6014 	    return 0;
6015 	}
6016 	goto L18;
6017     }
6018     return 0;
6019 } /* chklit_ */
6020 
chkpm4ac_(char * lineq,integer * iccount,integer * nacc,logical * moved,ftnlen lineq_len)6021 /* Subroutine */ int chkpm4ac_(char *lineq, integer *iccount, integer *nacc,
6022 	logical *moved, ftnlen lineq_len)
6023 {
6024     /* System generated locals */
6025     integer i__1, i__2;
6026     real r__1;
6027 
6028     /* Builtin functions */
6029     integer i_indx(char *, char *, ftnlen, ftnlen), s_cmp(char *, char *,
6030 	    ftnlen, ftnlen), i_nint(real *);
6031 
6032     /* Local variables */
6033     static integer ipm;
6034     static real fnum;
6035     static char durq[1];
6036     static integer icsav;
6037     static logical ishorz;
6038     extern /* Subroutine */ int readnum_(char *, integer *, char *, real *,
6039 	    ftnlen, ftnlen), setbits_(integer *, integer *, integer *,
6040 	    integer *);
6041 
6042 
6043 /*  Called after getting +/-/</> in a note (not rest).  iccount is on the +-<>. */
6044 /*  Sets moved=.true. and sets move parameters in nacc if necc: horiz only (bits */
6045 /*    10-16) if < or >,  horiz and vert (bits 4-9) if two consecutive signed */
6046 /*    numbers.  If moved=.true., iccount on exit is on end of last number. */
6047 /*    If moved=.false., iccount still on +/- */
6048 
6049     i__1 = *iccount - 2;
6050     i__2 = *iccount;
6051     if (i_indx("sfnA", lineq + i__1, (ftnlen)4, *iccount - 1 - i__1) > 0 &&
6052 	    i_indx("0123456789.", lineq + i__2, (ftnlen)11, *iccount + 1 -
6053 	    i__2) > 0) {
6054 
6055 /*  Prior char was accid & next is #; this may be start of accidental shift. */
6056 /*  Must test for "." above in case we get "<" or ">" */
6057 
6058 	ipm = i_indx("- +< >", lineq + (*iccount - 1), (ftnlen)6, (ftnlen)1)
6059 		- 2;
6060 	i__1 = *iccount + 1;
6061 	i__2 = *iccount;
6062 	if (s_cmp(lineq + i__2, ".", *iccount + 1 - i__2, (ftnlen)1) == 0 &&
6063 		i_indx("0123456789", lineq + i__1, (ftnlen)10, *iccount + 2 -
6064 		i__1) == 0) {
6065 
6066 /*  Rare case of [accid][+/-].[letter].  Bail out */
6067 
6068 	    *moved = FALSE_;
6069 	    return 0;
6070 	}
6071 	ishorz = ipm > 1;
6072 
6073 /*  Save iccount in case it's not accid shift and we have to reset. */
6074 
6075 	icsav = *iccount;
6076 	++(*iccount);
6077 	readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
6078 	if (ishorz || i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
6079 
6080 /*  This has to be accidental shift.  Set vert. shift. */
6081 
6082 	    if (! ishorz) {
6083 
6084 /*  +/- syntax, both shifts set, vertical first */
6085 
6086 		i__1 = (integer) (ipm * fnum + 32.5f);
6087 		setbits_(nacc, &c__6, &c__4, &i__1);
6088 		ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2;
6089 		++(*iccount);
6090 		readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
6091 	    } else {
6092 
6093 /*  </> syntax, only horiz set */
6094 
6095 		ipm += -3;
6096 	    }
6097 
6098 /*  Set horiz. shift */
6099 
6100 	    r__1 = (ipm * fnum + 5.35f) * 20;
6101 	    i__1 = i_nint(&r__1);
6102 	    setbits_(nacc, &c__7, &c__10, &i__1);
6103 	    --(*iccount);
6104 	    *moved = TRUE_;
6105 	} else {
6106 
6107 /*  False alarm.  Reset everything and flow onward */
6108 
6109 	    *moved = FALSE_;
6110 	    *iccount = icsav;
6111 	}
6112     } else {
6113 
6114 /* Either prior char was not 'sfn' or next was not digit, so take no action */
6115 
6116 	*moved = FALSE_;
6117     }
6118     return 0;
6119 } /* chkpm4ac_ */
6120 
clefsym_(integer * isl,char * notexq,integer * lnote,integer * nclef,ftnlen notexq_len)6121 /* Subroutine */ int clefsym_(integer *isl, char *notexq, integer *lnote,
6122 	integer *nclef, ftnlen notexq_len)
6123 {
6124     /* System generated locals */
6125     address a__1[4];
6126     integer i__1[4], i__2, i__3;
6127     char ch__1[1], ch__2[1], ch__3[1];
6128 
6129     /* Builtin functions */
6130     integer lbit_shift(integer, integer);
6131     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
6132 
6133     /* Local variables */
6134     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
6135     static integer nlev;
6136 
6137 
6138 /*  Returns string calling Don's TeX macro \pmxclef, for drawing small clefs. */
6139 
6140     *nclef = lbit_shift(*isl, (ftnlen)-12) & 7;
6141     if (*nclef == 0) {
6142 
6143 /*  treble */
6144 
6145 	nlev = 2;
6146     } else if (*nclef > 6) {
6147 
6148 /*  French violin */
6149 
6150 	nlev = 0;
6151     } else if (*nclef < 5) {
6152 
6153 /*  C-clef */
6154 
6155 	nlev = (*nclef << 1) - 2;
6156     } else {
6157 
6158 /*  F-clef */
6159 
6160 	nlev = (*nclef << 1) - 6;
6161     }
6162 /* Writing concatenation */
6163     chax_(ch__1, (ftnlen)1, &c__92);
6164     i__1[0] = 1, a__1[0] = ch__1;
6165     i__1[1] = 7, a__1[1] = "pmxclef";
6166     i__2 = min(*nclef,7) + 48;
6167     chax_(ch__2, (ftnlen)1, &i__2);
6168     i__1[2] = 1, a__1[2] = ch__2;
6169     i__3 = nlev + 48;
6170     chax_(ch__3, (ftnlen)1, &i__3);
6171     i__1[3] = 1, a__1[3] = ch__3;
6172     s_cat(notexq, a__1, i__1, &c__4, notexq_len);
6173     *lnote = 10;
6174     return 0;
6175 } /* clefsym_ */
6176 
crdacc_(integer * nacc,integer * naccid,integer * micrd,integer * nolevm,real * rmsshift,logical * lasttime,integer * levmaxacc,integer * icrdot0,real * segrb0,integer * ksegrb0,integer * nsegrb0,logical * twooftwo,integer * icashft)6177 /* Subroutine */ int crdacc_(integer *nacc, integer *naccid, integer *micrd,
6178 	integer *nolevm, real *rmsshift, logical *lasttime, integer *
6179 	levmaxacc, integer *icrdot0, real *segrb0, integer *ksegrb0, integer *
6180 	nsegrb0, logical *twooftwo, integer *icashft)
6181 {
6182     /* Initialized data */
6183 
6184     static integer nsegar[5] = { 3,4,3,3,2 };
6185     static integer nsegal[5] = { 2,4,3,3,2 };
6186     static real segar[60]	/* was [5][2][6] */ = { -.05f,-.38f,-.34f,
6187 	    -.05f,-.15f,-1.4f,-2.9f,-3.f,-1.4f,-1.2f,-.75f,-.2f,-.8f,-.75f,
6188 	    0.f,.96f,-1.04f,1.48f,.96f,1.2f,0.f,-.38f,0.f,0.f,0.f,3.15f,1.64f,
6189 	    3.f,3.15f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,2.9f,0.f,0.f,0.f,0.f,0.f,
6190 	    0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
6191 	    0.f,0.f };
6192     static real segal[60]	/* was [5][2][6] */ = { -1.f,-1.02f,-.6f,
6193 	    -1.65f,-1.2f,-1.4f,-2.9f,-3.f,-1.4f,-1.2f,0.f,-1.2f,-1.04f,0.f,
6194 	    0.f,3.15f,-1.64f,-1.48f,3.15f,1.2f,0.f,-1.02f,0.f,0.f,0.f,0.f,
6195 	    1.04f,3.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,2.9f,0.f,0.f,0.f,0.f,
6196 	    0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
6197 	    0.f,0.f,0.f };
6198     static integer iacctbl[6] = { 1,2,3,0,4,5 };
6199 
6200     /* System generated locals */
6201     integer i__1, i__2, i__3;
6202     real r__1;
6203 
6204     /* Builtin functions */
6205     integer i_nint(real *), s_wsle(cilist *), do_lio(integer *, integer *,
6206 	    char *, ftnlen), e_wsle(void);
6207 
6208     /* Local variables */
6209     static integer iacctype;
6210     static logical mainnote;
6211     extern integer igetbits_(integer *, integer *, integer *);
6212     static real ybotaseg, shiftmin;
6213     static integer isetshft[10];
6214     static real ytopaseg;
6215     static integer ibelowbot, ibelowtop, iwa, iranksetter, iseg;
6216     extern /* Subroutine */ int stop1_(void);
6217     static integer isega;
6218     static real segrb[100]	/* was [2][50] */;
6219     static integer irank;
6220     static real shift;
6221     static integer nolev, isegrb, ksegrb[50], nsegrb, ishift;
6222     extern /* Subroutine */ int printl_(char *, ftnlen);
6223     static integer netgain;
6224     extern /* Subroutine */ int setbits_(integer *, integer *, integer *,
6225 	    integer *);
6226 
6227     /* Fortran I/O blocks */
6228     static cilist io___291 = { 0, 6, 0, 0, 0 };
6229     static cilist io___292 = { 0, 6, 0, 0, 0 };
6230 
6231 
6232 
6233 /*       nacc = accidental bitmap for main note */
6234 /*       naccid = # of accid's in chord */
6235 /*       micrd = array with icrd #'s for notes w/ acc's, 0=>main note */
6236 /*       nolevm = level of main note */
6237 /*       segrb(1|2,.) x|y-coord of right-bdry segment */
6238 /*       ksegrb(.) internal use; tells what defined this segment */
6239 /*           -2: Left-shifted notehead */
6240 /*           -1: Original right boundary */
6241 /*            0: Main note accidental */
6242 /*         icrd: Chord-note accidental */
6243 /*       isetshft(i),i=1,naccid: what set shift for this accid, same codes */
6244 /*       icrdot0 = top-down level-rank of main note among accid-notes */
6245 /*       icrdot(icrd)(27-29) = level rank of chord-note among accid-notes */
6246 /*       twooftwo will be true 2nd time thru; signal to store shifts w/ notes */
6247 
6248     /* Parameter adjustments */
6249     --ksegrb0;
6250     segrb0 -= 3;
6251     --micrd;
6252 
6253     /* Function Body */
6254 
6255 /*  Fancy sharp boundary. fl,sh,na,dfl,dsh */
6256 
6257 /*     * -0.75,-0.20,-0.80, 0. , 0. , .96,-1.04,1.6, 0. , 0. , */
6258 /*           meas value for y, natural is 1.6 */
6259 /*     *  0.00, 0.00,-1.04, 0. , 0. ,3.15, 2.9,-1.6, 0. , 0. , */
6260 /* c            (meas. value is 3.08)    ^^^^ */
6261 /* c  Raise top of flat so it interferes with bottom of sharp */
6262 
6263 /*  iacctbl(i) = internal accid # (1-5) when i=extern accid # (1,2,3,5,6) */
6264 
6265 
6266 /*  Set up barrier segrb(iseg,ipoint) to define coords of corner points */
6267 /*    on stem+notes */
6268 
6269     i__1 = *nsegrb0;
6270     for (iseg = 1; iseg <= i__1; ++iseg) {
6271 	segrb[(iseg << 1) - 2] = segrb0[(iseg << 1) + 1];
6272 	segrb[(iseg << 1) - 1] = segrb0[(iseg << 1) + 2];
6273 	ksegrb[iseg - 1] = ksegrb0[iseg];
6274 /* L11: */
6275     }
6276     nsegrb = *nsegrb0;
6277     *rmsshift = 0.f;
6278     shiftmin = 1e3f;
6279     i__1 = *naccid;
6280     for (iwa = 1; iwa <= i__1; ++iwa) {
6281 
6282 /*  Initialize shift for this note */
6283 
6284 	shift = 0.f;
6285 	mainnote = micrd[iwa] == 0;
6286 	isetshft[iwa - 1] = -1;
6287 
6288 /* Get note level and accidental type */
6289 
6290 	if (mainnote) {
6291 	    nolev = *nolevm;
6292 	    iacctype = iacctbl[igetbits_(nacc, &c__3, &c__0) - 1];
6293 	} else {
6294 	    nolev = igetbits_(&comtrill_1.icrdat[micrd[iwa] - 1], &c__7, &
6295 		    c__12);
6296 	    iacctype = iacctbl[igetbits_(&comtrill_1.icrdat[micrd[iwa] - 1], &
6297 		    c__3, &c__20) - 1];
6298 	}
6299 
6300 /*  Cycle thru segments on right edge of this accidental */
6301 
6302 	i__2 = nsegar[iacctype - 1] - 1;
6303 	for (isega = 1; isega <= i__2; ++isega) {
6304 	    ybotaseg = nolev + segar[iacctype + ((isega << 1) + 2) * 5 - 16];
6305 	    ytopaseg = nolev + segar[iacctype + ((isega + 1 << 1) + 2) * 5 -
6306 		    16];
6307 
6308 /*  Cycle thru segments of right-hand barrier */
6309 
6310 	    i__3 = nsegrb - 1;
6311 	    for (isegrb = 1; isegrb <= i__3; ++isegrb) {
6312 
6313 /*  Must find all barrier segments that start below ytopseg & end above ybotseg */
6314 
6315 		if (segrb[(isegrb << 1) - 1] < ytopaseg) {
6316 
6317 /*  Barrier seg starts below top of accid */
6318 /*  Check if barrier seg ends above bottom of accid */
6319 
6320 		    if (segrb[(isegrb + 1 << 1) - 1] > ybotaseg) {
6321 			if (shift > segrb[(isegrb << 1) - 2] - segar[iacctype
6322 				+ ((isega << 1) + 1) * 5 - 16]) {
6323 			    shift = segrb[(isegrb << 1) - 2] - segar[iacctype
6324 				    + ((isega << 1) + 1) * 5 - 16];
6325 
6326 /*  Record the cause of the shift */
6327 
6328 			    isetshft[iwa - 1] = ksegrb[isegrb - 1];
6329 			}
6330 		    }
6331 
6332 /*  Does barrier segment end above top of accid seg? */
6333 
6334 		    if (segrb[(isegrb + 1 << 1) - 1] > ytopaseg) {
6335 			goto L4;
6336 		    }
6337 		}
6338 /* L3: */
6339 	    }
6340 L4:
6341 /* L2: */
6342 	    ;
6343 	}
6344 	if (! bit_test(*nacc,28) && dabs(shift) > 1e-4f && ! (*lasttime)) {
6345 /*          if (nolev .eq. levmaxacc) then */
6346 	    if (nolev == *levmaxacc && isetshft[iwa - 1] == -1) {
6347 		*rmsshift = 1e3f;
6348 		return 0;
6349 	    }
6350 
6351 /*  Does the following properly account for left-shifted noteheads? */
6352 
6353 /*  Top-down rank of this note we just shifted */
6354 
6355 	    if (mainnote) {
6356 		irank = *icrdot0;
6357 	    } else {
6358 		irank = igetbits_(&comtrill_1.icrdot[micrd[iwa] - 1], &c__3, &
6359 			c__27);
6360 	    }
6361 
6362 /*  Compare level-rank of this note vs. that of note that caused the shift. */
6363 /*    This has effect of checking for basic interferences from top down. */
6364 
6365 /*       ksegrb(.) internal use; tells what defined this segment */
6366 /*           -2: Left-shifted notehead */
6367 /*           -1: Original right boundary */
6368 /*            0: Main note accidental */
6369 /*         icrd: Chord-note accidental */
6370 /*       isetshft(i),i=1,naccid: what set shift for this accid, same codes */
6371 
6372 	    if (isetshft[iwa - 1] < 0) {
6373 		iranksetter = 0;
6374 	    } else if (isetshft[iwa - 1] == 0) {
6375 		iranksetter = *icrdot0;
6376 	    } else {
6377 		iranksetter = igetbits_(&comtrill_1.icrdot[isetshft[iwa - 1]
6378 			- 1], &c__3, &c__27);
6379 	    }
6380 	    if (iranksetter != 0 && irank != iranksetter + 1) {
6381 		*rmsshift = 1e3f;
6382 		return 0;
6383 	    }
6384 	}
6385 /* Computing 2nd power */
6386 	r__1 = shift;
6387 	*rmsshift += r__1 * r__1;
6388 	if (*lasttime && dabs(shift) > 1e-4f) {
6389 	    if (mainnote) {
6390 		if (! bit_test(*nacc,29)) {
6391 		    goto L10;
6392 		}
6393 	    } else {
6394 		if (! bit_test(comtrill_1.icrdat[micrd[iwa] - 1],29)) {
6395 		    goto L10;
6396 		}
6397 	    }
6398 
6399 /*  If here, "A" was set on a manual shift, so must cumulate the shift.  Note that if there */
6400 /*    was a manual shift but auto-shift was zero, will not come thru here, but shift value */
6401 /*    will be left intact. */
6402 
6403 	    if (mainnote) {
6404 		shift += (igetbits_(nacc, &c__7, &c__10) - 107) * .05f;
6405 	    } else {
6406 		shift += (igetbits_(&comtrill_1.icrdot[micrd[iwa] - 1], &c__7,
6407 			 &c__20) - 107) * .05f;
6408 	    }
6409 L10:
6410 	    if (*twooftwo) {
6411 
6412 /*  Record the shift for this accidental */
6413 
6414 		if (shift < -5.35f) {
6415 		    printl_(" ", (ftnlen)1);
6416 		    printl_("WARNING: auto-generated accidental shift too bi"
6417 			    "g for PMX, ignoring", (ftnlen)66);
6418 		} else {
6419 		    r__1 = (shift + 5.35f) * 20;
6420 		    ishift = i_nint(&r__1);
6421 		    if (mainnote) {
6422 			setbits_(nacc, &c__7, &c__10, &ishift);
6423 		    } else {
6424 			setbits_(&comtrill_1.icrdot[micrd[iwa] - 1], &c__7, &
6425 				c__20, &ishift);
6426 		    }
6427 		}
6428 	    } else {
6429 
6430 /*  This is the earlier call to precrd, so need minimum shift */
6431 
6432 		shiftmin = dmin(shiftmin,shift);
6433 	    }
6434 	}
6435 
6436 /*  Bail out if this is the last accidental to check */
6437 
6438 	if (iwa == *naccid) {
6439 	    goto L1;
6440 	}
6441 
6442 /*  Add this accidental to the right barrier! Count down from highest barrier segment, */
6443 /*    find 1st one starting below top of accid, and first one starting below bot. */
6444 
6445 	for (ibelowtop = nsegrb; ibelowtop >= 1; --ibelowtop) {
6446 	    if (segrb[(ibelowtop << 1) - 1] < nolev + segal[iacctype + ((
6447 		    nsegal[iacctype - 1] << 1) + 2) * 5 - 16]) {
6448 		for (ibelowbot = ibelowtop; ibelowbot >= 1; --ibelowbot) {
6449 		    if (segrb[(ibelowbot << 1) - 1] < nolev + segal[iacctype
6450 			    + 4]) {
6451 			goto L6;
6452 		    }
6453 /* L9: */
6454 		}
6455 		s_wsle(&io___291);
6456 		do_lio(&c__9, &c__1, "Oops2!", (ftnlen)6);
6457 		e_wsle();
6458 		stop1_();
6459 	    }
6460 /* L5: */
6461 	}
6462 	s_wsle(&io___292);
6463 	do_lio(&c__9, &c__1, "Ugh0! in crdaccs", (ftnlen)16);
6464 	e_wsle();
6465 	stop1_();
6466 L6:
6467 	netgain = nsegal[iacctype - 1] - ibelowtop + ibelowbot;
6468 
6469 /*  Shift high segments up */
6470 
6471 	if (netgain >= 0) {
6472 	    i__2 = ibelowtop + 1;
6473 	    for (isegrb = nsegrb; isegrb >= i__2; --isegrb) {
6474 		segrb[(isegrb + netgain << 1) - 2] = segrb[(isegrb << 1) - 2];
6475 		segrb[(isegrb + netgain << 1) - 1] = segrb[(isegrb << 1) - 1];
6476 		ksegrb[isegrb + netgain - 1] = ksegrb[isegrb - 1];
6477 /* L7: */
6478 	    }
6479 
6480 /*  Set up 1st segment above accid */
6481 
6482 	    segrb[(ibelowtop + netgain << 1) - 2] = segrb[(ibelowtop << 1) -
6483 		    2];
6484 	    segrb[(ibelowtop + netgain << 1) - 1] = nolev + segal[iacctype + (
6485 		    (nsegal[iacctype - 1] << 1) + 2) * 5 - 16];
6486 	    ksegrb[ibelowtop + netgain - 1] = ksegrb[ibelowtop - 1];
6487 	} else {
6488 
6489 /*  netgain<0, must remove segments. Use same coding but reverse order, */
6490 /*    work from bottom up */
6491 
6492 	    segrb[(ibelowtop + netgain << 1) - 2] = segrb[(ibelowtop << 1) -
6493 		    2];
6494 	    segrb[(ibelowtop + netgain << 1) - 1] = nolev + segal[iacctype + (
6495 		    (nsegal[iacctype - 1] << 1) + 2) * 5 - 16];
6496 	    ksegrb[ibelowtop + netgain - 1] = ksegrb[ibelowtop - 1];
6497 	    i__2 = nsegrb;
6498 	    for (isegrb = ibelowtop + 1; isegrb <= i__2; ++isegrb) {
6499 		segrb[(isegrb + netgain << 1) - 2] = segrb[(isegrb << 1) - 2];
6500 		segrb[(isegrb + netgain << 1) - 1] = segrb[(isegrb << 1) - 1];
6501 		ksegrb[isegrb + netgain - 1] = ksegrb[isegrb - 1];
6502 /* L12: */
6503 	    }
6504 	}
6505 
6506 /*  Insert new segments */
6507 
6508 	i__2 = nsegal[iacctype - 1] - 1;
6509 	for (isega = 1; isega <= i__2; ++isega) {
6510 	    segrb[(ibelowbot + isega << 1) - 2] = shift + segal[iacctype + ((
6511 		    isega << 1) + 1) * 5 - 16];
6512 	    segrb[(ibelowbot + isega << 1) - 1] = nolev + segal[iacctype + ((
6513 		    isega << 1) + 2) * 5 - 16];
6514 	    if (mainnote) {
6515 		ksegrb[ibelowbot + isega - 1] = 0;
6516 	    } else {
6517 		ksegrb[ibelowbot + isega - 1] = micrd[iwa];
6518 	    }
6519 /* L8: */
6520 	}
6521 
6522 /*  Update number of barrier segments */
6523 
6524 	nsegrb += netgain;
6525 /* c */
6526 /* c  Temporary printout for boundary segments as built up */
6527 /* c */
6528 /*      write(15,'()') */
6529 /*      write(15,'(a/(2f8.2,i5))')'  y       x       kseg', */
6530 /*     *    (segrb(2,iseg),segrb(1,iseg),ksegrb(iseg),iseg=1,nsegrb) */
6531 /*      write(15,'(a/(2i5))')' micrd isetshft', */
6532 /*     *    (micrd(iwa1),isetshft(iwa1),iwa1=1,iwa) */
6533 /* c */
6534 L1:
6535 	;
6536     }
6537 /* next accidental */
6538     if (*lasttime && ! (*twooftwo)) {
6539 
6540 /*  This is the final call on the pre-ask pass, so compute left-shift rqmt. */
6541 
6542 	r__1 = shiftmin * -20;
6543 	*icashft = i_nint(&r__1);
6544     }
6545 /* c */
6546 /* c  Temporary printout for boundary segments */
6547 /* c */
6548 /*      if (twooftwo) then */
6549 /*      write(15,'()') */
6550 /*      write(15,'(a/(2f8.2,i5))')'  y       x       kseg', */
6551 /*     *    (segrb(2,iseg),segrb(1,iseg),ksegrb(iseg),iseg=1,nsegrb) */
6552 /*      write(15,'(a/(2i5))')' micrd isetshft', */
6553 /*     *    (micrd(iwa),isetshft(iwa),iwa=1,naccid) */
6554 /*      end if */
6555 /* c */
6556     return 0;
6557 } /* crdacc_ */
6558 
crdaccs_(integer * nacc,integer * ipl,integer * irest,integer * naccid,integer * kicrd,integer * nolevm,integer * levmaxacc,integer * levminacc,integer * icrdot0,logical * twooftwo,integer * icashft)6559 /* Subroutine */ int crdaccs_(integer *nacc, integer *ipl, integer *irest,
6560 	integer *naccid, integer *kicrd, integer *nolevm, integer *levmaxacc,
6561 	integer *levminacc, integer *icrdot0, logical *twooftwo, integer *
6562 	icashft)
6563 {
6564     /* System generated locals */
6565     integer i__1, i__2, i__3;
6566 
6567     /* Builtin functions */
6568     integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
6569 	    e_wsle(void);
6570 
6571     /* Local variables */
6572     extern integer igetbits_(integer *, integer *, integer *);
6573     static integer ipermsav[7];
6574     static real rmsshift;
6575     static integer i__, j, k, levmidacc, ip, ir, is, it, maxmanshft, icrd;
6576     extern /* Subroutine */ int stop1_(void);
6577     static integer micrd[10], iiseg, irank, iperm[7], nolev;
6578     static real segrb0[100]	/* was [2][50] */;
6579     extern /* Subroutine */ int crdacc_(integer *, integer *, integer *,
6580 	    integer *, real *, logical *, integer *, integer *, real *,
6581 	    integer *, integer *, logical *, integer *);
6582     static logical tagged;
6583     static integer isegrb;
6584     static logical manual, lshift;
6585     static integer idummy;
6586     static real rmsmin;
6587     static integer ksegrb0[50], nsegrb0, manshft;
6588     extern /* Subroutine */ int setbits_(integer *, integer *, integer *,
6589 	    integer *);
6590 
6591     /* Fortran I/O blocks */
6592     static cilist io___321 = { 0, 6, 0, 0, 0 };
6593 
6594 
6595 
6596 /*       nacc = accidental bitmap for main note */
6597 /*       naccid = # of accid's in chord */
6598 /*       kicrd = array with icrd #'s for notes w/ acc's, 0=>main note */
6599 /*       nolevm = level of main note */
6600 
6601 /*  This is called once per multi-accidental chord.  In here, loop over all */
6602 /*  permutations of the order of accidental as stored in kicrd.  Each time thru */
6603 /*  loop, call crdacc once, get rms shift.  Only save permutation and rms value */
6604 /*  if it is less than old value. */
6605 
6606 
6607 /*  Make consistent? 120106 */
6608 /*      integer*4 kicrd(7),iperm(7),micrd(10),ipermsav(7),ksegrb0(50) */
6609 /* c */
6610 /* c  Temporary printout of level-rankings */
6611 /* c */
6612 /*      write(15,'()') */
6613 /*      do 98 iacc = 1 , naccid */
6614 /*        if (kicrd(iacc) .eq. 0) then */
6615 /*          write(15,'(3i5)')nolevm,icrdot0 */
6616 /*        else */
6617 /*          write(15,'(2i5)')igetbits(icrdat(kicrd(iacc)),7,12), */
6618 /*     *                     igetbits(icrdot(kicrd(iacc)),3,27) */
6619 /*        end if */
6620 /* 98    continue */
6621 /* c */
6622 
6623 /*  Initialize right-barrier */
6624 
6625     /* Parameter adjustments */
6626     --kicrd;
6627 
6628     /* Function Body */
6629     segrb0[0] = 0.f;
6630     segrb0[1] = -1e3f;
6631     segrb0[2] = 0.f;
6632     segrb0[3] = 1e3f;
6633     nsegrb0 = 2;
6634     ksegrb0[0] = -1;
6635     ksegrb0[1] = -1;
6636 
6637 /*  Search for left-shifted notes, Make up the initial right-barrier, which */
6638 /*     will be good for all permutations. */
6639 /*     irest()(27) is set if any notes are left-shifted */
6640 /*     Must use ALL chord notes, not just ones w/ accid's. */
6641 
6642     if (bit_test(*irest,27)) {
6643 	i__1 = comtrill_1.icrd2;
6644 	for (icrd = comtrill_1.icrd1 - 1; icrd <= i__1; ++icrd) {
6645 	    if (icrd == comtrill_1.icrd1 - 1) {
6646 
6647 /*  Main note */
6648 
6649 /*            lshift = btest(ipl,8) */
6650 		lshift = bit_test(*ipl,8) || bit_test(*nacc,31);
6651 		if (lshift) {
6652 		    nolev = *nolevm;
6653 		}
6654 	    } else {
6655 
6656 /*  Chord note */
6657 
6658 		lshift = bit_test(comtrill_1.icrdat[icrd - 1],23);
6659 /*            if (lshift) nolev = igetbits(icrdat(icrd),7,12) */
6660 		if (lshift) {
6661 		    nolev = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__7, &
6662 			    c__12);
6663 		    if (bit_test(*nacc,31) && nolev == *nolevm + 1) {
6664 
6665 /*  This note is not really shifted, It is the upper of a 2nd with the main */
6666 /*    note on an upstem, and Main note must be shifted. */
6667 /*    nacc(31) signals the real truth. */
6668 
6669 			lshift = FALSE_;
6670 		    }
6671 		}
6672 	    }
6673 	    if (lshift) {
6674 		i__2 = nsegrb0 - 1;
6675 		for (isegrb = 1; isegrb <= i__2; ++isegrb) {
6676 		    if (segrb0[(isegrb + 1 << 1) - 1] > (real) (nolev - 1)) {
6677 
6678 /*  Add this notehead to the right boundary here.  Move all higher segs up 2. */
6679 
6680 			i__3 = isegrb + 1;
6681 			for (iiseg = nsegrb0; iiseg >= i__3; --iiseg) {
6682 			    segrb0[(iiseg + 2 << 1) - 2] = segrb0[(iiseg << 1)
6683 				     - 2];
6684 			    segrb0[(iiseg + 2 << 1) - 1] = segrb0[(iiseg << 1)
6685 				     - 1];
6686 			    ksegrb0[iiseg + 1] = ksegrb0[iiseg - 1];
6687 /* L17: */
6688 			}
6689 			goto L18;
6690 		    }
6691 /* L16: */
6692 		}
6693 L18:
6694 
6695 /*  Insert notehead into list. Set kseg=-2 to signal notehead shift. */
6696 
6697 		iiseg = isegrb + 1;
6698 		segrb0[(iiseg << 1) - 2] = -1.2f;
6699 		segrb0[(iiseg << 1) - 1] = nolev - 1.f;
6700 		ksegrb0[iiseg - 1] = -2;
6701 		segrb0[(iiseg + 1 << 1) - 2] = 0.f;
6702 		segrb0[(iiseg + 1 << 1) - 1] = nolev + 1.f;
6703 		ksegrb0[iiseg] = -1;
6704 		nsegrb0 += 2;
6705 	    }
6706 /* L15: */
6707 	}
6708     }
6709 
6710 /*  Done setting right barrier for left-shifted noteheads */
6711 
6712     tagged = FALSE_;
6713     manual = FALSE_;
6714 
6715 /*  Preprocess to check for manual shifts. */
6716 /*   If are manual main [nacc(10-16)] or chord note [icrdot(20-26)]shifts, then */
6717 /*      If any manual shift is preceded by "A" [nacc(29), icrdat(29)] then */
6718 /*         1. Auto-shifting proceeds */
6719 /*         2. "A"-shifts add to autoshifts */
6720 /*         3. non-"A" shifts are ignored! */
6721 /*      Else (>0 man shifts, none has "A") */
6722 /*         No auto-ordering, No autoshifts, Observe all manual shifts. */
6723 /*      End if */
6724 /*   End if */
6725 
6726     maxmanshft = 0;
6727     i__1 = *naccid;
6728     for (i__ = 1; i__ <= i__1; ++i__) {
6729 	if (kicrd[i__] == 0) {
6730 
6731 /*  Main note */
6732 
6733 	    manshft = igetbits_(nacc, &c__7, &c__10);
6734 	    if (manshft != 0) {
6735 		manual = TRUE_;
6736 		if (bit_test(*nacc,29)) {
6737 		    tagged = TRUE_;
6738 		} else {
6739 /*              maxmanshft = max(maxmanshft,64-manshft) */
6740 /* Computing MAX */
6741 		    i__2 = maxmanshft, i__3 = 107 - manshft;
6742 		    maxmanshft = max(i__2,i__3);
6743 		}
6744 	    }
6745 	} else {
6746 
6747 /*  Chord note */
6748 
6749 	    manshft = igetbits_(&comtrill_1.icrdot[kicrd[i__] - 1], &c__7, &
6750 		    c__20);
6751 	    if (manshft != 0) {
6752 		manual = TRUE_;
6753 		if (bit_test(comtrill_1.icrdat[kicrd[i__] - 1],29)) {
6754 		    tagged = TRUE_;
6755 		} else {
6756 /*              maxmanshft = max(maxmanshft,64-manshft) */
6757 /* Computing MAX */
6758 		    i__2 = maxmanshft, i__3 = 107 - manshft;
6759 		    maxmanshft = max(i__2,i__3);
6760 		}
6761 	    }
6762 	}
6763 /* L13: */
6764     }
6765     if (manual) {
6766 	if (tagged) {
6767 
6768 /*  zero out all untagged shifts */
6769 
6770 	    i__1 = *naccid;
6771 	    for (i__ = 1; i__ <= i__1; ++i__) {
6772 		if (kicrd[i__] == 0) {
6773 		    if (! bit_test(*nacc,29)) {
6774 			setbits_(nacc, &c__7, &c__10, &c__0);
6775 		    }
6776 		} else {
6777 		    if (! bit_test(comtrill_1.icrdat[kicrd[i__] - 1],29)) {
6778 			setbits_(&comtrill_1.icrdot[kicrd[i__] - 1], &c__7, &
6779 				c__20, &c__0);
6780 		    }
6781 		}
6782 /* L14: */
6783 	    }
6784 	} else {
6785 
6786 /*  There are manual shifts but none tagged. Only proceed if "Ao" was entered */
6787 
6788 	    if (! bit_test(*nacc,28)) {
6789 		*icashft = maxmanshft;
6790 		return 0;
6791 	    }
6792 	}
6793     }
6794     if (bit_test(*nacc,28)) {
6795 
6796 /*  Take the accidentals in order as originally input, then exit. */
6797 
6798 	crdacc_(nacc, naccid, &kicrd[1], nolevm, &rmsshift, &c_true, &idummy,
6799 		&idummy, segrb0, ksegrb0, &nsegrb0, twooftwo, icashft);
6800 	return 0;
6801 /*      end if */
6802     } else if (*naccid == 3) {
6803 
6804 /*  Special treatment if 3 accidentals in chord. If there aren't accids on a 2nd */
6805 /*    then place in order top, bottom, middle. */
6806 
6807 	for (i__ = 1; i__ <= 3; ++i__) {
6808 	    if (kicrd[i__] == 0) {
6809 		irank = *icrdot0;
6810 		nolev = *nolevm;
6811 	    } else {
6812 		irank = igetbits_(&comtrill_1.icrdot[kicrd[i__] - 1], &c__3, &
6813 			c__27);
6814 		nolev = igetbits_(&comtrill_1.icrdat[kicrd[i__] - 1], &c__7, &
6815 			c__12);
6816 	    }
6817 	    if (irank == 1) {
6818 		micrd[0] = kicrd[i__];
6819 	    } else {
6820 		micrd[5 - irank - 1] = kicrd[i__];
6821 	    }
6822 	    if (irank == 2) {
6823 		levmidacc = nolev;
6824 	    }
6825 /* L20: */
6826 	}
6827 	if (*levmaxacc != levmidacc + 1 && levmidacc != *levminacc + 1) {
6828 	    crdacc_(nacc, naccid, micrd, nolevm, &rmsshift, &c_true, &idummy,
6829 		    &idummy, segrb0, ksegrb0, &nsegrb0, twooftwo, icashft);
6830 	    return 0;
6831 	}
6832     }
6833     rmsmin = 1e5f;
6834 
6835 /*  Initialize permutation array */
6836 
6837     i__1 = *naccid;
6838     for (i__ = 1; i__ <= i__1; ++i__) {
6839 	iperm[i__ - 1] = i__;
6840 /* L7: */
6841     }
6842 
6843 /*  Start looping over permutations */
6844 
6845     for (ip = 1; ip <= 5041; ++ip) {
6846 	if (ip != 1) {
6847 
6848 /*  Work the magic algorithm to get the next permutation */
6849 
6850 	    for (k = *naccid - 1; k >= 1; --k) {
6851 		if (iperm[k - 1] <= iperm[k]) {
6852 		    goto L2;
6853 		}
6854 /* L1: */
6855 	    }
6856 
6857 /*  If here, we just got the last permutation, so exit the loop over permutations */
6858 
6859 	    goto L10;
6860 L2:
6861 	    for (j = *naccid; j >= 1; --j) {
6862 		if (iperm[k - 1] <= iperm[j - 1]) {
6863 		    goto L4;
6864 		}
6865 /* L3: */
6866 	    }
6867 L4:
6868 	    it = iperm[j - 1];
6869 	    iperm[j - 1] = iperm[k - 1];
6870 	    iperm[k - 1] = it;
6871 	    is = k + 1;
6872 	    for (ir = *naccid; ir >= 1; --ir) {
6873 		if (ir <= is) {
6874 		    goto L6;
6875 		}
6876 		it = iperm[ir - 1];
6877 		iperm[ir - 1] = iperm[is - 1];
6878 		iperm[is - 1] = it;
6879 		++is;
6880 /* L5: */
6881 	    }
6882 L6:
6883 	    ;
6884 	}
6885 
6886 /*  New we have a permutation.  Take icrd values out of kicrd and put them into */
6887 /*  micrd in the order of the permutation */
6888 
6889 	i__1 = *naccid;
6890 	for (i__ = 1; i__ <= i__1; ++i__) {
6891 	    micrd[i__ - 1] = kicrd[iperm[i__ - 1]];
6892 /* L9: */
6893 	}
6894 /* c */
6895 /* c  Temporary printout */
6896 /* c */
6897 /*      write(15,'(/a6,10i3)')'perm:',(iperm(i),i=1,naccid) */
6898 /* c */
6899 	crdacc_(nacc, naccid, micrd, nolevm, &rmsshift, &c_false, levmaxacc,
6900 		icrdot0, segrb0, ksegrb0, &nsegrb0, twooftwo, icashft);
6901 /* c */
6902 /* c  Temporary printout */
6903 /* c */
6904 /*      write(15,*)'perm done, rmsshift:',rmsshift */
6905 /* c */
6906 	if (rmsshift < rmsmin) {
6907 
6908 /*  Save this permutation, reset minrms */
6909 
6910 	    i__1 = *naccid;
6911 	    for (i__ = 1; i__ <= i__1; ++i__) {
6912 		ipermsav[i__ - 1] = iperm[i__ - 1];
6913 		rmsmin = rmsshift;
6914 /* L11: */
6915 	    }
6916 	}
6917 /* L8: */
6918     }
6919     s_wsle(&io___321);
6920     do_lio(&c__9, &c__1, "Should not BEEEEEE here!", (ftnlen)24);
6921     e_wsle();
6922     stop1_();
6923 L10:
6924 
6925 /*  Done looping, get info for the final choice */
6926 
6927     i__1 = *naccid;
6928     for (i__ = 1; i__ <= i__1; ++i__) {
6929 	micrd[i__ - 1] = kicrd[ipermsav[i__ - 1]];
6930 /* L12: */
6931     }
6932 /* c */
6933 /* c  Temporary printout */
6934 /* c */
6935 /*      write(15,'(/a6,10i3)')'Final perm:',(ipermsav(i),i=1,naccid) */
6936 /* c */
6937     crdacc_(nacc, naccid, micrd, nolevm, &rmsshift, &c_true, &idummy, &idummy,
6938 	     segrb0, ksegrb0, &nsegrb0, twooftwo, icashft);
6939     return 0;
6940 } /* crdaccs_ */
6941 
doacc_(integer * ihshft,integer * ivshft,char * notexq,integer * lnote,integer * nacc,integer * nolev,integer * ncm,logical * caut,ftnlen notexq_len)6942 /* Subroutine */ int doacc_(integer *ihshft, integer *ivshft, char *notexq,
6943 	integer *lnote, integer *nacc, integer *nolev, integer *ncm, logical *
6944 	caut, ftnlen notexq_len)
6945 {
6946     /* System generated locals */
6947     address a__1[2], a__2[3];
6948     integer i__1[2], i__2[3];
6949     char ch__1[1];
6950     icilist ici__1;
6951 
6952     /* Builtin functions */
6953     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
6954     integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
6955 	    ;
6956     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
6957 
6958     /* Local variables */
6959     extern /* Subroutine */ int addblank_(char *, integer *, ftnlen);
6960     static char sq[1];
6961     static integer lacc;
6962     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
6963     static real hshft;
6964     static char noteq[8];
6965     extern /* Subroutine */ int accsym_(integer *, char *, integer *, ftnlen);
6966     static integer noleva;
6967     extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer
6968 	    *, ftnlen);
6969     static char acsymq[3];
6970     static integer lnoten;
6971 
6972     chax_(ch__1, (ftnlen)1, &c__92);
6973     *(unsigned char *)sq = *(unsigned char *)&ch__1[0];
6974     if (*ihshft == -107) {
6975 	*ihshft = 0;
6976     }
6977 /* c */
6978 /* c  If main note shifted left, so shift accid.  Terminate below, when acc. is done. */
6979 /* c */
6980     if (*ihshft != 0) {
6981 
6982 /*  Accid must be shifted horizontally */
6983 
6984 	if (*ihshft < 0) {
6985 /* Writing concatenation */
6986 	    i__1[0] = 1, a__1[0] = sq;
6987 	    i__1[1] = 8, a__1[1] = "loffset{";
6988 	    s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
6989 	    *ihshft = -(*ihshft);
6990 	} else {
6991 /* Writing concatenation */
6992 	    i__1[0] = 1, a__1[0] = sq;
6993 	    i__1[1] = 8, a__1[1] = "roffset{";
6994 	    s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
6995 	}
6996 	hshft = *ihshft * .05f;
6997 	if (hshft < 1.f) {
6998 	    ici__1.icierr = 0;
6999 	    ici__1.icirnum = 1;
7000 	    ici__1.icirlen = 3;
7001 	    ici__1.iciunit = notexq + 9;
7002 	    ici__1.icifmt = "(f3.2)";
7003 	    s_wsfi(&ici__1);
7004 	    do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real));
7005 	    e_wsfi();
7006 	    *lnote = 12;
7007 	} else {
7008 	    ici__1.icierr = 0;
7009 	    ici__1.icirnum = 1;
7010 	    ici__1.icirlen = 4;
7011 	    ici__1.iciunit = notexq + 9;
7012 	    ici__1.icifmt = "(f4.2)";
7013 	    s_wsfi(&ici__1);
7014 	    do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real));
7015 	    e_wsfi();
7016 	    *lnote = 13;
7017 	}
7018 /* Writing concatenation */
7019 	i__2[0] = *lnote, a__2[0] = notexq;
7020 	i__2[1] = 2, a__2[1] = "}{";
7021 	i__2[2] = 1, a__2[2] = sq;
7022 	s_cat(notexq, a__2, i__2, &c__3, (ftnlen)79);
7023 	*lnote += 3;
7024     } else {
7025 	s_copy(notexq, sq, (ftnlen)79, (ftnlen)1);
7026 	*lnote = 1;
7027     }
7028     if (bit_test(*nacc,3)) {
7029 /* Writing concatenation */
7030 	i__1[0] = *lnote, a__1[0] = notexq;
7031 	i__1[1] = 3, a__1[1] = "big";
7032 	s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
7033 	*lnote += 3;
7034     }
7035     if (*caut) {
7036 
7037 /*  Cautionary accidental.  Need to define bigcna,... in pmx.tex */
7038 
7039 /* Writing concatenation */
7040 	i__1[0] = *lnote, a__1[0] = notexq;
7041 	i__1[1] = 1, a__1[1] = "c";
7042 	s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
7043 	++(*lnote);
7044     }
7045     accsym_(nacc, acsymq, &lacc, (ftnlen)3);
7046 /* Writing concatenation */
7047     i__1[0] = *lnote, a__1[0] = notexq;
7048     i__1[1] = lacc, a__1[1] = acsymq;
7049     s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
7050     *lnote += lacc;
7051     noleva = *nolev;
7052     if (*ivshft != 0) {
7053 	noleva = noleva + *ivshft - 32;
7054     }
7055     notefq_(noteq, &lnoten, &noleva, ncm, (ftnlen)8);
7056     if (lnoten == 1) {
7057 	addblank_(noteq, &lnoten, (ftnlen)8);
7058     }
7059 /* Writing concatenation */
7060     i__1[0] = *lnote, a__1[0] = notexq;
7061     i__1[1] = lnoten, a__1[1] = noteq;
7062     s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
7063     *lnote += lnoten;
7064     if (*ihshft != 0) {
7065 
7066 /*  Terminate horizontal shift */
7067 
7068 /* Writing concatenation */
7069 	i__1[0] = *lnote, a__1[0] = notexq;
7070 	i__1[1] = 1, a__1[1] = "}";
7071 	s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
7072 	++(*lnote);
7073     }
7074     return 0;
7075 } /* doacc_ */
7076 
docrd_(integer * ivx,integer * ip,integer * nodu,integer * ncm,integer * iv,real * tnow,char * soutq,integer * lsout,char * ulq,integer * ibmcnt,integer * islur,integer * nvmx,integer * nv,logical * beamon,integer * nolevm,integer * ihornb,integer * nornb,real * stemlen,logical * dotxtup,integer * nacc,ftnlen soutq_len,ftnlen ulq_len)7077 /* Subroutine */ int docrd_(integer *ivx, integer *ip, integer *nodu, integer
7078 	*ncm, integer *iv, real *tnow, char *soutq, integer *lsout, char *ulq,
7079 	 integer *ibmcnt, integer *islur, integer *nvmx, integer *nv, logical
7080 	*beamon, integer *nolevm, integer *ihornb, integer *nornb, real *
7081 	stemlen, logical *dotxtup, integer *nacc, ftnlen soutq_len, ftnlen
7082 	ulq_len)
7083 {
7084     /* System generated locals */
7085     address a__1[2];
7086     integer i__1, i__2, i__3[2], i__4, i__5, i__6;
7087     logical L__1;
7088     char ch__1[1];
7089 
7090     /* Builtin functions */
7091     integer pow_ii(integer *, integer *), lbit_shift(integer, integer);
7092     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen),
7093 	     s_copy(char *, char *, ftnlen, ftnlen);
7094     integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char
7095 	    *, ftnlen);
7096 
7097     /* Local variables */
7098     extern /* Subroutine */ int addblank_(char *, integer *, ftnlen);
7099     extern integer igetbits_(integer *, integer *, integer *);
7100     static integer kv;
7101     extern integer log2_(integer *);
7102     static integer icrd;
7103     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
7104     static integer lout, lsym;
7105     static char outq[79];
7106     extern /* Subroutine */ int stop1_(void), doacc_(integer *, integer *,
7107 	    char *, integer *, integer *, integer *, integer *, logical *,
7108 	    ftnlen);
7109     extern integer ncmid_(integer *, integer *);
7110     static integer lnote, nolev;
7111     static char noteq[8];
7112     extern /* Subroutine */ int addstr_(char *, integer *, char *, integer *,
7113 	    ftnlen, ftnlen);
7114     static integer nactmp;
7115     static logical isleft;
7116     extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer
7117 	    *, ftnlen);
7118     static real updotc, rtdotc;
7119     static integer nolevo, lnoten;
7120     extern /* Subroutine */ int dotmov_(real *, real *, char *, integer *,
7121 	    integer *, ftnlen), putarp_(real *, integer *, integer *, integer
7122 	    *, integer *, char *, integer *, ftnlen);
7123     static char notexq[79], nosymq[7];
7124     extern /* Subroutine */ int putorn_(integer *, integer *, integer *,
7125 	    integer *, integer *, char *, integer *, integer *, integer *,
7126 	    integer *, integer *, integer *, integer *, real *, char *,
7127 	    integer *, integer *, integer *, logical *, logical *, ftnlen,
7128 	    ftnlen), addmidi_(integer *, integer *, integer *, integer *,
7129 	    real *, logical *, logical *);
7130     static logical isright;
7131     extern /* Subroutine */ int setbits_(integer *, integer *, integer *,
7132 	    integer *);
7133 
7134     /* Fortran I/O blocks */
7135     static cilist io___346 = { 0, 6, 0, 0, 0 };
7136     static cilist io___347 = { 0, 6, 0, 0, 0 };
7137 
7138 
7139 /* 130316 */
7140 
7141 
7142 /*  This subr. once produced notexq for entire chord.  10/18/97 altered to write */
7143 /*    chord notes as we go.  10/22/97 find range of icrd first. */
7144 /*    2/25/98 moved rangefinding to precrd so done before slurs, so now */
7145 /*    on entry, icrd1, icrd2 define range of icrd for this chord. */
7146 
7147 /*  Set counter (for this note) for chord notes present.  Set notmain=T. */
7148 /*    Will test for notmain=.true. in addmidi to tell whether to save pitch. */
7149 
7150     /* Parameter adjustments */
7151     --nornb;
7152     ihornb -= 25;
7153     ulq -= 25;
7154 
7155     /* Function Body */
7156     commidi_1.nmidcrd = 0;
7157     commidi_1.notmain = TRUE_;
7158     commidi_1.crdacc = FALSE_;
7159     i__1 = comtrill_1.icrd2;
7160     for (icrd = comtrill_1.icrd1; icrd <= i__1; ++icrd) {
7161 	lnote = 0;
7162 	nolev = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__7, &c__12);
7163 
7164 /*  3/8/03 save original pitch to use in midi, in case 2nds alter things. */
7165 
7166 	nolevo = nolev;
7167 
7168 /*  Check for special situations with 2nds (see precrd). */
7169 
7170 	if (bit_test(*nacc,30)) {
7171 	    if (nolev == *nolevm - 1) {
7172 		nolev = *nolevm;
7173 	    }
7174 	} else if (bit_test(*nacc,31)) {
7175 	    if (nolev == *nolevm + 1) {
7176 		nolev = *nolevm;
7177 	    }
7178 	}
7179 
7180 /*  Lower dot for lower-voice notes?.  Conditions are: */
7181 /*   1. Dotted time value */
7182 /*   2. Lower voice of two */
7183 /*   3. Note is on a line */
7184 /*   4. Not a rest (cannot be a rest in a chord!) */
7185 /* .  5. Flag (lowdot) is set to true */
7186 
7187 	if (comarp_1.lowdot && *nvmx == 2 && *ivx <= *nv) {
7188 	    i__2 = log2_(nodu);
7189 	    if (pow_ii(&c__2, &i__2) != *nodu && (nolev - *ncm) % 2 == 0) {
7190 		if (bit_test(comtrill_1.icrdat[icrd - 1],26)) {
7191 
7192 /*  Note already in movdot list.  Drop by 2. */
7193 
7194 		    i__2 = igetbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &
7195 			    c__0) - 20;
7196 		    setbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__0, &
7197 			    i__2);
7198 		} else {
7199 
7200 /*  Not in list so just move it right now */
7201 
7202 		    i__2 = igetbits_(islur, &c__1, &c__3);
7203 		    dotmov_(&c_b761, &c_b762, soutq, lsout, &i__2, (ftnlen)80)
7204 			    ;
7205 		}
7206 	    }
7207 	}
7208 	if (bit_test(comtrill_1.icrdat[icrd - 1],26)) {
7209 
7210 /*  Move the dot. */
7211 
7212 	    updotc = ((127 & comtrill_1.icrdot[icrd - 1]) - 64) * .1f;
7213 	    rtdotc = ((127 & lbit_shift(comtrill_1.icrdot[icrd - 1], (ftnlen)
7214 		    -7)) - 64) * .1f;
7215 	    i__2 = igetbits_(islur, &c__1, &c__3);
7216 	    dotmov_(&updotc, &rtdotc, soutq, lsout, &i__2, (ftnlen)80);
7217 	}
7218 	isleft = bit_test(comtrill_1.icrdat[icrd - 1],23);
7219 	isright = bit_test(comtrill_1.icrdat[icrd - 1],24);
7220 
7221 /*  Check for ornament in chord. */
7222 
7223 	if (comtrill_1.icrdorn[icrd - 1] > 0) {
7224 	    putorn_(&comtrill_1.icrdorn[icrd - 1], &nolev, nolevm, nodu, &
7225 		    nornb[1], ulq + 25, ibmcnt, ivx, ncm, islur, nvmx, nv, &
7226 		    ihornb[25], stemlen, outq, &lout, ip, &c__0, beamon, &
7227 		    c_true, (ftnlen)1, (ftnlen)79);
7228 
7229 /*     subroutin putorn(iornq,nolev,nolevm,nodur,nornb,ulq,ibmcnt,ivx, */
7230 /*    *     ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout,ip,islhgt, */
7231 /*    *     notcrd,beamon,iscrd) */
7232 
7233 	    addstr_(outq, &lout, soutq, lsout, (ftnlen)79, (ftnlen)80);
7234 	}
7235 
7236 /*  Chord-note symbol.  First check for breve */
7237 
7238 	if (*nodu == 128) {
7239 /* Writing concatenation */
7240 	    chax_(ch__1, (ftnlen)1, &c__92);
7241 	    i__3[0] = 1, a__1[0] = ch__1;
7242 	    i__3[1] = 6, a__1[1] = "zbreve";
7243 	    s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
7244 	    lsym = 7;
7245 	} else {
7246 
7247 /*  Not a breve chord.  Get first letters in chord-note symbol */
7248 
7249 	    if (isleft) {
7250 /* Writing concatenation */
7251 		chax_(ch__1, (ftnlen)1, &c__92);
7252 		i__3[0] = 1, a__1[0] = ch__1;
7253 		i__3[1] = 1, a__1[1] = "l";
7254 		s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
7255 	    } else if (isright) {
7256 /* Writing concatenation */
7257 		chax_(ch__1, (ftnlen)1, &c__92);
7258 		i__3[0] = 1, a__1[0] = ch__1;
7259 		i__3[1] = 1, a__1[1] = "r";
7260 		s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
7261 	    } else {
7262 /* Writing concatenation */
7263 		chax_(ch__1, (ftnlen)1, &c__92);
7264 		i__3[0] = 1, a__1[0] = ch__1;
7265 		i__3[1] = 1, a__1[1] = "z";
7266 		s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
7267 	    }
7268 	    if (*nodu >= 64) {
7269 /* Writing concatenation */
7270 		i__3[0] = 2, a__1[0] = nosymq;
7271 		i__3[1] = 1, a__1[1] = "w";
7272 		s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
7273 	    } else if (*nodu >= 32) {
7274 /* Writing concatenation */
7275 		i__3[0] = 2, a__1[0] = nosymq;
7276 		i__3[1] = 1, a__1[1] = "h";
7277 		s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
7278 	    } else {
7279 /* Writing concatenation */
7280 		i__3[0] = 2, a__1[0] = nosymq;
7281 		i__3[1] = 1, a__1[1] = "q";
7282 		s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
7283 	    }
7284 	    i__2 = log2_(nodu);
7285 	    if (pow_ii(&c__2, &i__2) == *nodu && ! (*dotxtup)) {
7286 		lsym = 3;
7287 	    } else if (! bit_test(*islur,3) || *dotxtup) {
7288 
7289 /*  Single dot */
7290 
7291 /* Writing concatenation */
7292 		i__3[0] = 3, a__1[0] = nosymq;
7293 		i__3[1] = 1, a__1[1] = "p";
7294 		s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
7295 		lsym = 4;
7296 	    } else {
7297 
7298 /*  Double dot */
7299 
7300 /* Writing concatenation */
7301 		i__3[0] = 3, a__1[0] = nosymq;
7302 		i__3[1] = 2, a__1[1] = "pp";
7303 		s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
7304 		lsym = 5;
7305 	    }
7306 	}
7307 	if (bit_test(comtrill_1.icrdat[icrd - 1],19) && ! bit_test(
7308 		comtrill_1.icrdat[icrd - 1],27)) {
7309 
7310 /*  Accidental and not MIDI-only.  Build up bits 0-3 of nacc */
7311 
7312 	    nactmp = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__3, &c__20);
7313 
7314 /*  Kluge for bigness.  Only means 'As' has not been issued */
7315 
7316 	    if (spfacs_1.bacfac != 1e6f) {
7317 		nactmp += 8;
7318 	    }
7319 	    i__2 = igetbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__20) -
7320 		    107;
7321 	    i__4 = igetbits_(&comtrill_1.icrdot[icrd - 1], &c__6, &c__14);
7322 	    i__5 = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__7, &c__12);
7323 	    i__6 = ncmid_(iv, ip);
7324 	    L__1 = bit_test(comtrill_1.icrdat[icrd - 1],31);
7325 	    doacc_(&i__2, &i__4, notexq, &lnote, &nactmp, &i__5, &i__6, &L__1,
7326 		     (ftnlen)79);
7327 /*     *        notexq,lnote,nactmp,nolev,ncmid(iv,ip)) */
7328 /*  Get original nolev, not altered to deal with 2nds */
7329 /*     *        ncmid(iv,ip)) */
7330 /* Writing concatenation */
7331 	    i__3[0] = lnote, a__1[0] = notexq;
7332 	    i__3[1] = 7, a__1[1] = nosymq;
7333 	    s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
7334 	    commidi_1.crdacc = TRUE_;
7335 	} else {
7336 	    s_copy(notexq, nosymq, (ftnlen)79, (ftnlen)7);
7337 	}
7338 	lnote += lsym;
7339 
7340 /*  Get note name (again if accid, due to possible octave jump) */
7341 
7342 	notefq_(noteq, &lnoten, &nolev, ncm, (ftnlen)8);
7343 	if (lnoten == 1) {
7344 	    addblank_(noteq, &lnoten, (ftnlen)8);
7345 	}
7346 
7347 /*  Put in note name */
7348 
7349 /* Writing concatenation */
7350 	i__3[0] = lnote, a__1[0] = notexq;
7351 	i__3[1] = 8, a__1[1] = noteq;
7352 	s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
7353 	lnote += lnoten;
7354 	if (bit_test(comtrill_1.icrdat[icrd - 1],25)) {
7355 
7356 /*  Arpeggio signal */
7357 
7358 /*          call putarp(tnow,iv,ip,nolev,ncm,soutq,lsout) */
7359 	    putarp_(tnow, ivx, ip, &nolev, ncm, soutq, lsout, (ftnlen)80);
7360 	}
7361 	addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
7362 	if (commidi_1.ismidi) {
7363 
7364 /*  Here is where we collect MIDI pitch info for the chord note.  By checking */
7365 /*    notmain, addmidi(...) knows to just compute the */
7366 /*    pitch number and store it in mcpitch(nmidcrd).  Then on call to addmidi() */
7367 /*    for MAIN note, will put in note codes for all chord notes + main note. */
7368 
7369 	    kv = 1;
7370 	    if (*ivx > *iv) {
7371 		kv = 2;
7372 	    }
7373 	    ++commidi_1.nmidcrd;
7374 	    if (commidi_1.nmidcrd > 20) {
7375 		s_wsle(&io___346);
7376 		e_wsle();
7377 		s_wsle(&io___347);
7378 		do_lio(&c__9, &c__1, "21 chord notes is too many for midi pr"
7379 			"ocessor", (ftnlen)45);
7380 		e_wsle();
7381 		stop1_();
7382 	    }
7383 
7384 /*  Use original saved pitch level, unaltered by 2nds logic. */
7385 
7386 /* 130316 */
7387 /*          call addmidi(midchan(iv,kv),nolevo-iTransAmt(instno(iv)), */
7388 	    i__2 = nolevo + commvel_1.miditran[cominsttrans_1.instno[*iv - 1]
7389 		    - 1];
7390 	    i__4 = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__3, &c__20);
7391 	    addmidi_(&commidi_1.midchan[*iv + kv * 24 - 25], &i__2, &i__4, &
7392 		    commidisig_1.midisig, &c_b807, &c_false, &c_false);
7393 /*     *             igetbits(icrdat(icrd),3,20),isig,1.,.false.,.false.) */
7394 /* 130316 */
7395 /*     *      igetbits(icrdat(icrd),3,20),midisig(instno(iv)),1., */
7396 	}
7397 /* L5: */
7398     }
7399     commidi_1.notmain = FALSE_;
7400     return 0;
7401 } /* docrd_ */
7402 
dodyn_(integer * ivx,integer * ip,integer * nolev,integer * ncm,integer * ipl,integer * islur,integer * irest,integer * nvmx,integer * nv,logical * beamon,integer * ihornb,integer * nornb,char * ulq,integer * ibmcnt,logical * nostem,char * soutq,integer * lsout,ftnlen ulq_len,ftnlen soutq_len)7403 /* Subroutine */ int dodyn_(integer *ivx, integer *ip, integer *nolev,
7404 	integer *ncm, integer *ipl, integer *islur, integer *irest, integer *
7405 	nvmx, integer *nv, logical *beamon, integer *ihornb, integer *nornb,
7406 	char *ulq, integer *ibmcnt, logical *nostem, char *soutq, integer *
7407 	lsout, ftnlen ulq_len, ftnlen soutq_len)
7408 {
7409     /* Initialized data */
7410 
7411     static char dyntablq[48] = "ppppppp pp  p   mp  mf  f   fp  sfz ff  fff "
7412 	    "ffff";
7413 
7414     /* System generated locals */
7415     address a__1[2], a__2[4], a__3[3], a__4[6];
7416     integer i__1, i__2, i__3[2], i__4[4], i__5, i__6[3], i__7[6];
7417     char ch__1[1], ch__2[6], ch__3[81], ch__4[53];
7418     icilist ici__1;
7419 
7420     /* Builtin functions */
7421     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen),
7422 	     s_copy(char *, char *, ftnlen, ftnlen);
7423     integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
7424 	    , s_wsfe(cilist *), e_wsfe(void);
7425 
7426     /* Local variables */
7427     extern /* Subroutine */ int backfill_(integer *, char *, integer *, char *
7428 	    , integer *, ftnlen, ftnlen);
7429     static integer jtxtdyn1;
7430     extern integer igetbits_(integer *, integer *, integer *);
7431     static integer lpretweak, id;
7432     static real hoff;
7433     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
7434     static integer idno, lbot, idyn, jdyn;
7435     extern /* Character */ VOID udqq_(char *, ftnlen, integer *, integer *,
7436 	    integer *, integer *, integer *, integer *);
7437     static integer lbot1;
7438     extern integer lfmt1_(real *);
7439     extern /* Subroutine */ int stop1_(void);
7440     static integer idynd, lform, idynn[10], lnote, ltemp;
7441     static char tempq[48];
7442     static integer ivxip;
7443     static char numpq[5];
7444     static integer idynd2;
7445     static real hoffsd;
7446     extern /* Subroutine */ int addstr_(char *, integer *, char *, integer *,
7447 	    ftnlen, ftnlen);
7448     static integer iptent;
7449     extern integer lenstr_(char *, integer *, ftnlen);
7450     extern /* Subroutine */ int printl_(char *, ftnlen);
7451     static integer numdyn;
7452     static logical upstem;
7453     static char notexq[79];
7454     static integer lnumpq, icntdyn, ivxtent;
7455     static char dynstrq[4];
7456     static integer jtxtdyn, ltxtdyn;
7457 
7458     /* Fortran I/O blocks */
7459     static icilist io___368 = { 0, numpq+1, 0, "(i2)", 2, 1 };
7460     static icilist io___370 = { 0, numpq+1, 0, "(i2)", 2, 1 };
7461     static icilist io___371 = { 0, numpq+1, 0, "(i3)", 3, 1 };
7462     static icilist io___378 = { 0, numpq+1, 0, "(i2)", 2, 1 };
7463     static icilist io___379 = { 0, numpq+1, 0, "(i2)", 2, 1 };
7464     static icilist io___380 = { 0, numpq+1, 0, "(i3)", 3, 1 };
7465     static cilist io___383 = { 0, 11, 0, "(a)", 0 };
7466 
7467 
7468 
7469 /*  Inputs are array *elements* except ihornb,nornb,ulq */
7470 
7471     /* Parameter adjustments */
7472     ulq -= 25;
7473     --nornb;
7474     ihornb -= 25;
7475 
7476     /* Function Body */
7477     numdyn = 0;
7478 
7479 /*  Find dynamics for (ivx,ip) in list.  May be as many as 4.  Store idyn values */
7480 /*      in idynn(1...4) */
7481 
7482     i__1 = comdyn_1.ndyn;
7483     for (idyn = 1; idyn <= i__1; ++idyn) {
7484 /*        ivxtent = iand(idyndat(idyn),15) */
7485 	ivxtent = (comdyn_1.idyndat[idyn - 1] & 15) + (igetbits_(&
7486 		comdyn_1.idynda2[idyn - 1], &c__1, &c__10) << 4);
7487 	if (ivxtent == *ivx) {
7488 	    iptent = igetbits_(&comdyn_1.idyndat[idyn - 1], &c__8, &c__4);
7489 	    if (iptent == *ip) {
7490 		++numdyn;
7491 		idynn[numdyn - 1] = idyn;
7492 	    } else if (iptent > *ip) {
7493 
7494 /*  I don't think there are any more possible for this ivx,ip, so exit loop */
7495 
7496 		goto L2;
7497 	    }
7498 /*        else if (ivxtent .gt. ivx) then */
7499 /*          go to 2 */
7500 	}
7501 /* L1: */
7502     }
7503 L2:
7504 
7505 /*  At this point there is a list of idyn's in idynn(1...numdyn) */
7506 /*  Compute level, and stem-dir'n-based horizontal tweaks */
7507 
7508     hoffsd = 0.f;
7509 
7510 /*  Set upstem to false as default */
7511 
7512     upstem = FALSE_;
7513     if (bit_test(*irest,0)) {
7514 
7515 /*  It's a rest.  Assume it doesn't go below the staff */
7516 
7517 	lbot = *ncm - 4;
7518     } else if (! (*beamon)) {
7519 	udqq_(ch__1, (ftnlen)1, nolev, ncm, islur, nvmx, ivx, nv);
7520 	if (*(unsigned char *)&ch__1[0] == 'u' || *nostem) {
7521 	    upstem = TRUE_;
7522 	    if (! bit_test(*ipl,10)) {
7523 /* Computing MIN */
7524 		i__1 = *nolev - 1, i__2 = *ncm - 4;
7525 		lbot = min(i__1,i__2);
7526 	    } else {
7527 /* Computing MIN */
7528 		i__1 = comtrill_1.minlev - 1, i__2 = *ncm - 4;
7529 		lbot = min(i__1,i__2);
7530 	    }
7531 	} else {
7532 	    hoffsd = -.5f;
7533 	    if (! bit_test(*ipl,10)) {
7534 /* Computing MIN */
7535 		i__1 = *nolev - 7, i__2 = *ncm - 4;
7536 		lbot = min(i__1,i__2);
7537 	    } else {
7538 /* Computing MIN */
7539 		i__1 = comtrill_1.minlev - 7, i__2 = *ncm - 4;
7540 		lbot = min(i__1,i__2);
7541 	    }
7542 	}
7543     } else {
7544 	if (*(unsigned char *)&ulq[*ivx + *ibmcnt * 24] == 'u') {
7545 	    upstem = TRUE_;
7546 	    if (! bit_test(*ipl,10)) {
7547 /* Computing MIN */
7548 		i__1 = *nolev - 1, i__2 = *ncm - 4;
7549 		lbot = min(i__1,i__2);
7550 	    } else {
7551 /* Computing MIN */
7552 		i__1 = comtrill_1.minlev - 1, i__2 = *ncm - 4;
7553 		lbot = min(i__1,i__2);
7554 	    }
7555 	} else {
7556 	    hoffsd = -.5f;
7557 	    lbot = ihornb[*ivx + nornb[*ivx] * 24] + 1;
7558 	    if (lbot == 1) {
7559 
7560 /* Kluge for non-beamed, down xtup, for which ihorb was never set. */
7561 /* Assumes stem is shortened. */
7562 
7563 		lbot = *nolev - 5;
7564 	    }
7565 	    ++nornb[*ivx];
7566 	}
7567     }
7568     lbot += -5;
7569     jtxtdyn1 = 1;
7570 
7571 /*  Now ready to loop over current dyn's */
7572 
7573     i__1 = numdyn;
7574     for (icntdyn = 1; icntdyn <= i__1; ++icntdyn) {
7575 	idynd = comdyn_1.idyndat[idynn[icntdyn - 1] - 1];
7576 	idynd2 = comdyn_1.idynda2[idynn[icntdyn - 1] - 1];
7577 	idno = igetbits_(&idynd, &c__4, &c__12);
7578 /*        ivx = iand(15,idynd) */
7579 	*ivx = (15 & idynd) + (igetbits_(&idynd2, &c__1, &c__10) << 4);
7580 
7581 /*  Build the command into notex in stages. Insert name & rq'd args in order: */
7582 
7583 /*    Command name */
7584 /*       hpstrt, hpcend, hpdend, pmxdyn */
7585 /*    ivx */
7586 /*        X       X       X */
7587 /*    level */
7588 /*                X       X       X */
7589 /*    hoff */
7590 /*        X       X       X       X */
7591 /*    d-mark */
7592 /*                                X */
7593 
7594 	if (idno == 0) {
7595 
7596 /*  Text-dynamic */
7597 
7598 /* Writing concatenation */
7599 	    chax_(ch__1, (ftnlen)1, &c__92);
7600 	    i__3[0] = 1, a__1[0] = ch__1;
7601 	    i__3[1] = 6, a__1[1] = "txtdyn";
7602 	    s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
7603 	    lnote = 7;
7604 	} else if (idno <= 12) {
7605 
7606 /*  Letter-group */
7607 
7608 /* Writing concatenation */
7609 	    chax_(ch__1, (ftnlen)1, &c__92);
7610 	    i__3[0] = 1, a__1[0] = ch__1;
7611 	    i__3[1] = 6, a__1[1] = "pmxdyn";
7612 	    s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
7613 	    lnote = 7;
7614 	} else if (comslur_1.fontslur) {
7615 	    lnote = 7;
7616 	    if (idno == 13) {
7617 
7618 /*  Start a hairpin */
7619 
7620 /* Writing concatenation */
7621 		chax_(ch__1, (ftnlen)1, &c__92);
7622 		i__3[0] = 1, a__1[0] = ch__1;
7623 		i__3[1] = 6, a__1[1] = "hpstrt";
7624 		s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
7625 	    } else if (idno == 14) {
7626 
7627 /*  End crescendo */
7628 
7629 /* Writing concatenation */
7630 		chax_(ch__1, (ftnlen)1, &c__92);
7631 		i__3[0] = 1, a__1[0] = ch__1;
7632 		i__3[1] = 6, a__1[1] = "hpcend";
7633 		s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
7634 	    } else {
7635 
7636 /*  End decrescendo */
7637 
7638 /* Writing concatenation */
7639 		chax_(ch__1, (ftnlen)1, &c__92);
7640 		i__3[0] = 1, a__1[0] = ch__1;
7641 		i__3[1] = 6, a__1[1] = "hpdend";
7642 		s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
7643 	    }
7644 	} else {
7645 
7646 /*  Postscript hairpins */
7647 
7648 	    lnote = 7;
7649 	    if (idno == 13) {
7650 /* Writing concatenation */
7651 		chax_(ch__1, (ftnlen)1, &c__92);
7652 		i__3[0] = 1, a__1[0] = ch__1;
7653 		i__3[1] = 6, a__1[1] = "Icresc";
7654 		s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
7655 	    } else if (idno == 14) {
7656 /* Writing concatenation */
7657 		chax_(ch__1, (ftnlen)1, &c__92);
7658 		i__3[0] = 1, a__1[0] = ch__1;
7659 		i__3[1] = 8, a__1[1] = "Idecresc";
7660 		s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
7661 		lnote = 9;
7662 	    } else {
7663 /* Writing concatenation */
7664 		chax_(ch__1, (ftnlen)1, &c__92);
7665 		i__3[0] = 1, a__1[0] = ch__1;
7666 		i__3[1] = 6, a__1[1] = "Tcresc";
7667 		s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
7668 	    }
7669 	}
7670 	if (idno >= 13) {
7671 
7672 /*  Put in voice number */
7673 
7674 	    if (*ivx <= 9) {
7675 /* Writing concatenation */
7676 		i__3[0] = lnote, a__1[0] = notexq;
7677 		*(unsigned char *)&ch__1[0] = *ivx + 48;
7678 		i__3[1] = 1, a__1[1] = ch__1;
7679 		s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
7680 		++lnote;
7681 	    } else if (*ivx <= 19) {
7682 /* Writing concatenation */
7683 		i__4[0] = lnote, a__2[0] = notexq;
7684 		i__4[1] = 2, a__2[1] = "{1";
7685 		*(unsigned char *)&ch__1[0] = *ivx + 38;
7686 		i__4[2] = 1, a__2[2] = ch__1;
7687 		i__4[3] = 1, a__2[3] = "}";
7688 		s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
7689 		lnote += 4;
7690 	    } else {
7691 /* Writing concatenation */
7692 		i__4[0] = lnote, a__2[0] = notexq;
7693 		i__4[1] = 2, a__2[1] = "{2";
7694 		*(unsigned char *)&ch__1[0] = *ivx + 28;
7695 		i__4[2] = 1, a__2[2] = ch__1;
7696 		i__4[3] = 1, a__2[3] = "}";
7697 		s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
7698 		lnote += 4;
7699 	    }
7700 	}
7701 
7702 /*  Begin setting level */
7703 
7704 	lbot1 = lbot;
7705 	if (idno > 0 && idno <= 5) {
7706 
7707 /*  All letters are short so raise a bit. */
7708 
7709 	    ++lbot1;
7710 	} else if (idno >= 13) {
7711 	    lbot1 += 2;
7712 	}
7713 
7714 /*  Convert so reference is bottom line */
7715 
7716 	lbot1 = lbot1 - *ncm + 4;
7717 	if (comslur_1.fontslur && idno == 13 || ! comslur_1.fontslur && (idno
7718 		== 13 || idno == 14)) {
7719 
7720 /*  Hairpin start.  Save level and user-tweak before applying user tweak. */
7721 
7722 	    comdyn_1.levdsav[*ivx - 1] = lbot1;
7723 	    comdyn_1.levhssav[*ivx - 1] = 0;
7724 	    if (bit_test(idynd,16)) {
7725 		comdyn_1.levhssav[*ivx - 1] = igetbits_(&idynd, &c__7, &c__17)
7726 			 - 64;
7727 	    }
7728 	} else if (comslur_1.fontslur && idno >= 14 || idno == 15) {
7729 
7730 /*  Hairpin end; Compare level with saved start level before user-tweaks */
7731 
7732 /* Computing MIN */
7733 	    i__2 = lbot1, i__5 = comdyn_1.levdsav[*ivx - 1];
7734 	    lbot1 = min(i__2,i__5);
7735 
7736 /*  Save pre-tweak level */
7737 
7738 	    lpretweak = lbot1;
7739 	}
7740 
7741 /*  Check for user-defined vertical tweak */
7742 
7743 	if (bit_test(idynd,16)) {
7744 	    lbot1 = lbot1 - 64 + igetbits_(&idynd, &c__7, &c__17);
7745 	}
7746 
7747 /*  Now horizontal stuff */
7748 
7749 	hoff = hoffsd;
7750 
7751 /*  Some special horizontal tweaks */
7752 
7753 	if (upstem && idno > 0 && (idno <= 4 || idno == 8 || idno == 9)) {
7754 	    hoff += .4f;
7755 	}
7756 
7757 /*  User-defined tweaks */
7758 
7759 	if (bit_test(idynd2,0)) {
7760 	    hoff += (igetbits_(&idynd2, &c__9, &c__1) - 256) * .1f;
7761 	}
7762 	if (numdyn > 1) {
7763 
7764 /*  Horizontal-interaction-based tweaks. */
7765 
7766 /*  Cases: */
7767 /*  numdyn  type1   type2    type3    data used */
7768 /*     2    wrd-grp hrpnstrt -        ivowg(1...12),hoh1(1...12) */
7769 /*     2       hrpnend wrd-grp  -               ivowg,hoh2 */
7770 /*     2    hrpnend hrpnstrt -               hoh2h1(1...2) */
7771 /*     3    hrpnend wrd-grp  hrpnstrt ivowg,hoh2,hoh1 */
7772 
7773 	    if (idno > 0 && idno <= 12) {
7774 
7775 /*  Word-group, may need vertical tweak to line up. */
7776 
7777 		lbot1 += comdyn_1.ivowg[idno - 1];
7778 
7779 /*  Protecting against hp start-stop on same note */
7780 
7781 	    } else if ((comslur_1.fontslur && idno >= 14 || idno == 15) &&
7782 		    icntdyn < numdyn) {
7783 
7784 /*  Hairpin ending, check next type */
7785 
7786 		if (comslur_1.fontslur && igetbits_(&comdyn_1.idyndat[idynn[
7787 			icntdyn] - 1], &c__4, &c__12) == 13 || !
7788 			comslur_1.fontslur && (igetbits_(&comdyn_1.idyndat[
7789 			idynn[icntdyn] - 1], &c__4, &c__12) == 13 ||
7790 			igetbits_(&comdyn_1.idyndat[idynn[icntdyn] - 1], &
7791 			c__4, &c__12) == 14)) {
7792 
7793 /*  Hairpin end then hairpin start, no words, (remember dealing with end now) */
7794 
7795 		    hoff += comdyn_1.hoh2h1[0];
7796 		} else {
7797 
7798 /*  Hairpin end then word-group, need idno for w-g to set hp offset */
7799 
7800 		    hoff += comdyn_1.hoh2[igetbits_(&comdyn_1.idyndat[idynn[
7801 			    icntdyn] - 1], &c__4, &c__12) - 1];
7802 		}
7803 
7804 /*  Protecting against hp start-stop on same note */
7805 
7806 	    } else if (icntdyn > 1 && idno > 0 && (comslur_1.fontslur && idno
7807 		    < 14 || ! comslur_1.fontslur && idno < 15)) {
7808 
7809 /*  Hairpin start, check prior type */
7810 
7811 		if (comslur_1.fontslur && igetbits_(&comdyn_1.idyndat[idynn[
7812 			icntdyn - 2] - 1], &c__4, &c__12) >= 14 || !
7813 			comslur_1.fontslur && igetbits_(&comdyn_1.idyndat[
7814 			idynn[icntdyn - 2] - 1], &c__4, &c__12) == 15) {
7815 
7816 /*  Hairpin end then hairpin start, (remember dealing with start now) */
7817 
7818 		    hoff += comdyn_1.hoh2h1[1];
7819 		} else {
7820 
7821 /*  Hairpin start after word-group, need idno for w-g to set hp offset */
7822 
7823 		    hoff += comdyn_1.hoh1[igetbits_(&comdyn_1.idyndat[idynn[
7824 			    icntdyn - 2] - 1], &c__4, &c__12) - 1];
7825 		}
7826 	    }
7827 	}
7828 
7829 /*  End of if-block for 2- or 3-way interactions. */
7830 
7831 	if (! comslur_1.fontslur && idno >= 13) {
7832 	    hoff = (hoff + .5f) * 6.f / 2.5f;
7833 	}
7834 
7835 /*  Slur font and hairpin. Add hoff, and change from \interneote to \qn@width */
7836 
7837 
7838 /*  Position corrections all done now.  Put in the level. */
7839 
7840 	if (comslur_1.fontslur && idno == 13 || ! comslur_1.fontslur && (idno
7841 		== 13 || idno == 14)) {
7842 
7843 /*  Hairpin start. */
7844 
7845 	    if (! comslur_1.fontslur) {
7846 
7847 /*  Postscript hairpin start...inset placeholder for start level. */
7848 /* Writing concatenation */
7849 		i__3[0] = lnote, a__1[0] = notexq;
7850 		i__3[1] = 5, a__1[1] = "{   }";
7851 		s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
7852 		lnote += 5;
7853 	    }
7854 	} else {
7855 
7856 /*  Insert actual level in all cases except hairpin start */
7857 /*  Create string with level in it */
7858 
7859 	    if (lbot1 > 9) {
7860 		s_copy(numpq, "{", (ftnlen)5, (ftnlen)1);
7861 		s_wsfi(&io___368);
7862 		do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer));
7863 		e_wsfi();
7864 /* Writing concatenation */
7865 		i__3[0] = 3, a__1[0] = numpq;
7866 		i__3[1] = 1, a__1[1] = "}";
7867 		s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5);
7868 		lnumpq = 4;
7869 	    } else if (lbot1 > -1) {
7870 		*(unsigned char *)&ch__1[0] = lbot1 + 48;
7871 		s_copy(numpq, ch__1, (ftnlen)5, (ftnlen)1);
7872 		lnumpq = 1;
7873 	    } else if (lbot1 > -10) {
7874 		s_copy(numpq, "{", (ftnlen)5, (ftnlen)1);
7875 		s_wsfi(&io___370);
7876 		do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer));
7877 		e_wsfi();
7878 /* Writing concatenation */
7879 		i__3[0] = 3, a__1[0] = numpq;
7880 		i__3[1] = 1, a__1[1] = "}";
7881 		s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5);
7882 		lnumpq = 4;
7883 	    } else {
7884 		s_copy(numpq, "{", (ftnlen)5, (ftnlen)1);
7885 		s_wsfi(&io___371);
7886 		do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer));
7887 		e_wsfi();
7888 /* Writing concatenation */
7889 		i__3[0] = 4, a__1[0] = numpq;
7890 		i__3[1] = 1, a__1[1] = "}";
7891 		s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5);
7892 		lnumpq = 5;
7893 	    }
7894 
7895 /*  Level has now been computed and stored in numpq */
7896 /*  Append the level */
7897 
7898 /* Writing concatenation */
7899 	    i__3[0] = lnote, a__1[0] = notexq;
7900 	    i__3[1] = lnumpq, a__1[1] = numpq;
7901 	    s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
7902 	    lnote += lnumpq;
7903 	}
7904 	if (dabs(hoff) < .001f) {
7905 
7906 /*  No horiz offset */
7907 
7908 /* Writing concatenation */
7909 	    i__3[0] = lnote, a__1[0] = notexq;
7910 	    i__3[1] = 1, a__1[1] = "0";
7911 	    s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
7912 	    ++lnote;
7913 	} else {
7914 
7915 /*  Horizontal tweak */
7916 
7917 	    lform = lfmt1_(&hoff);
7918 /* Writing concatenation */
7919 	    i__3[0] = lnote, a__1[0] = notexq;
7920 	    i__3[1] = 1, a__1[1] = "{";
7921 	    s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
7922 	    ++lnote;
7923 	    i__2 = lnote;
7924 	    ici__1.icierr = 0;
7925 	    ici__1.icirnum = 1;
7926 	    ici__1.icirlen = lnote + lform - i__2;
7927 	    ici__1.iciunit = notexq + i__2;
7928 /* Writing concatenation */
7929 	    i__6[0] = 2, a__3[0] = "(f";
7930 	    i__5 = lform + 48;
7931 	    chax_(ch__1, (ftnlen)1, &i__5);
7932 	    i__6[1] = 1, a__3[1] = ch__1;
7933 	    i__6[2] = 3, a__3[2] = ".1)";
7934 	    ici__1.icifmt = (s_cat(ch__2, a__3, i__6, &c__3, (ftnlen)6),
7935 		    ch__2);
7936 	    s_wsfi(&ici__1);
7937 	    do_fio(&c__1, (char *)&hoff, (ftnlen)sizeof(real));
7938 	    e_wsfi();
7939 	    lnote += lform;
7940 /* Writing concatenation */
7941 	    i__3[0] = lnote, a__1[0] = notexq;
7942 	    i__3[1] = 1, a__1[1] = "}";
7943 	    s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
7944 	    ++lnote;
7945 	}
7946 	if (idno == 0) {
7947 
7948 /*  text-dynamic.  Find the string and append it */
7949 
7950 	    i__2 = comdyn_1.ntxtdyn;
7951 	    for (jtxtdyn = jtxtdyn1; jtxtdyn <= i__2; ++jtxtdyn) {
7952 /*            ivxip = ivx+16*ip */
7953 		ivxip = *ivx + (*ip << 5);
7954 		if (ivxip == comdyn_1.ivxiptxt[jtxtdyn - 1]) {
7955 		    goto L5;
7956 		}
7957 /* L4: */
7958 	    }
7959 	    printl_("Abnormal stop in putdyn", (ftnlen)23);
7960 	    stop1_();
7961 L5:
7962 	    ltxtdyn = lenstr_(comdyn_1.txtdynq + (jtxtdyn - 1 << 7), &c__128,
7963 		    (ftnlen)128);
7964 
7965 /*  Font size based on musicsize */
7966 
7967 	    if (commus_1.musize == 20) {
7968 /* Writing concatenation */
7969 		i__7[0] = lnote, a__4[0] = notexq;
7970 		i__7[1] = 1, a__4[1] = "{";
7971 		i__7[2] = 1, a__4[2] = "\\";
7972 		i__7[3] = 7, a__4[3] = "medtype";
7973 		i__7[4] = 1, a__4[4] = "\\";
7974 		i__7[5] = 3, a__4[5] = "it ";
7975 		s_cat(notexq, a__4, i__7, &c__6, (ftnlen)79);
7976 		lnote += 13;
7977 	    } else if (commus_1.musize == 16) {
7978 /* Writing concatenation */
7979 		i__7[0] = lnote, a__4[0] = notexq;
7980 		i__7[1] = 1, a__4[1] = "{";
7981 		i__7[2] = 1, a__4[2] = "\\";
7982 		i__7[3] = 8, a__4[3] = "normtype";
7983 		i__7[4] = 1, a__4[4] = "\\";
7984 		i__7[5] = 3, a__4[5] = "it ";
7985 		s_cat(notexq, a__4, i__7, &c__6, (ftnlen)79);
7986 		lnote += 14;
7987 	    } else if (commus_1.musize == 24) {
7988 /* Writing concatenation */
7989 		i__7[0] = lnote, a__4[0] = notexq;
7990 		i__7[1] = 1, a__4[1] = "{";
7991 		i__7[2] = 1, a__4[2] = "\\";
7992 		i__7[3] = 7, a__4[3] = "bigtype";
7993 		i__7[4] = 1, a__4[4] = "\\";
7994 		i__7[5] = 3, a__4[5] = "it ";
7995 		s_cat(notexq, a__4, i__7, &c__6, (ftnlen)79);
7996 		lnote += 13;
7997 	    } else if (commus_1.musize == 29) {
7998 /* Writing concatenation */
7999 		i__7[0] = lnote, a__4[0] = notexq;
8000 		i__7[1] = 1, a__4[1] = "{";
8001 		i__7[2] = 1, a__4[2] = "\\";
8002 		i__7[3] = 7, a__4[3] = "Bigtype";
8003 		i__7[4] = 1, a__4[4] = "\\";
8004 		i__7[5] = 3, a__4[5] = "it ";
8005 		s_cat(notexq, a__4, i__7, &c__6, (ftnlen)79);
8006 		lnote += 13;
8007 	    }
8008 /* Writing concatenation */
8009 	    i__6[0] = lnote, a__3[0] = notexq;
8010 	    i__6[1] = ltxtdyn, a__3[1] = comdyn_1.txtdynq + (jtxtdyn - 1 << 7)
8011 		    ;
8012 	    i__6[2] = 1, a__3[2] = "}";
8013 	    s_cat(notexq, a__3, i__6, &c__3, (ftnlen)79);
8014 	    lnote = lnote + ltxtdyn + 1;
8015 
8016 /*  Reset jtxtdyn1 just in case >1 txtdyn on same note. */
8017 
8018 	    jtxtdyn1 = jtxtdyn + 1;
8019 	} else if (idno <= 12) {
8020 
8021 /*  Letter-group dynamic.  Append the letter-group command */
8022 
8023 	    id = idno << 2;
8024 	    i__2 = id - 4;
8025 	    s_copy(dynstrq, dyntablq + i__2, (ftnlen)4, id - i__2);
8026 	    id = lenstr_(dynstrq, &c__4, (ftnlen)4);
8027 /* Writing concatenation */
8028 	    i__6[0] = lnote, a__3[0] = notexq;
8029 	    chax_(ch__1, (ftnlen)1, &c__92);
8030 	    i__6[1] = 1, a__3[1] = ch__1;
8031 	    i__6[2] = id, a__3[2] = dynstrq;
8032 	    s_cat(notexq, a__3, i__6, &c__3, (ftnlen)79);
8033 	    lnote = lnote + 1 + id;
8034 	}
8035 	addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80);
8036 	if (! comslur_1.fontslur && idno == 15) {
8037 
8038 /*  PS slurs on, hairpin is ending.  Go back and set height at beginning. */
8039 /*  Add user-defined tweak to default level */
8040 
8041 	    lbot1 = lpretweak + comdyn_1.levhssav[*ivx - 1];
8042 	    if (lbot1 > 9) {
8043 		s_copy(numpq, "{", (ftnlen)5, (ftnlen)1);
8044 		s_wsfi(&io___378);
8045 		do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer));
8046 		e_wsfi();
8047 /* Writing concatenation */
8048 		i__3[0] = 3, a__1[0] = numpq;
8049 		i__3[1] = 1, a__1[1] = "}";
8050 		s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5);
8051 		lnumpq = 4;
8052 	    } else if (lbot1 > -1) {
8053 		*(unsigned char *)&ch__1[0] = lbot1 + 48;
8054 		s_copy(numpq, ch__1, (ftnlen)5, (ftnlen)1);
8055 		lnumpq = 1;
8056 	    } else if (lbot1 > -10) {
8057 		s_copy(numpq, "{", (ftnlen)5, (ftnlen)1);
8058 		s_wsfi(&io___379);
8059 		do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer));
8060 		e_wsfi();
8061 /* Writing concatenation */
8062 		i__3[0] = 3, a__1[0] = numpq;
8063 		i__3[1] = 1, a__1[1] = "}";
8064 		s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5);
8065 		lnumpq = 4;
8066 	    } else {
8067 		s_copy(numpq, "{", (ftnlen)5, (ftnlen)1);
8068 		s_wsfi(&io___380);
8069 		do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer));
8070 		e_wsfi();
8071 /* Writing concatenation */
8072 		i__3[0] = 4, a__1[0] = numpq;
8073 		i__3[1] = 1, a__1[1] = "}";
8074 		s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5);
8075 		lnumpq = 5;
8076 	    }
8077 
8078 /*  Construct string to search backwards for placeholder */
8079 
8080 	    if (*ivx <= 9) {
8081 /* Writing concatenation */
8082 		i__6[0] = 5, a__3[0] = "cresc";
8083 		*(unsigned char *)&ch__1[0] = *ivx + 48;
8084 		i__6[1] = 1, a__3[1] = ch__1;
8085 		i__6[2] = 5, a__3[2] = "{   }";
8086 		s_cat(tempq, a__3, i__6, &c__3, (ftnlen)48);
8087 		ltemp = 11;
8088 	    } else if (*ivx <= 19) {
8089 /* Writing concatenation */
8090 		i__6[0] = 7, a__3[0] = "cresc{1";
8091 		*(unsigned char *)&ch__1[0] = *ivx + 38;
8092 		i__6[1] = 1, a__3[1] = ch__1;
8093 		i__6[2] = 6, a__3[2] = "}{   }";
8094 		s_cat(tempq, a__3, i__6, &c__3, (ftnlen)48);
8095 		ltemp = 14;
8096 	    } else {
8097 /* Writing concatenation */
8098 		i__6[0] = 7, a__3[0] = "cresc{2";
8099 		*(unsigned char *)&ch__1[0] = *ivx + 28;
8100 		i__6[1] = 1, a__3[1] = ch__1;
8101 		i__6[2] = 6, a__3[2] = "}{   }";
8102 		s_cat(tempq, a__3, i__6, &c__3, (ftnlen)48);
8103 		ltemp = 14;
8104 	    }
8105 	    s_wsfe(&io___383);
8106 /* Writing concatenation */
8107 	    i__3[0] = *lsout, a__1[0] = soutq;
8108 	    i__3[1] = 1, a__1[1] = "%";
8109 	    s_cat(ch__3, a__1, i__3, &c__2, (ftnlen)81);
8110 	    do_fio(&c__1, ch__3, *lsout + 1);
8111 	    e_wsfe();
8112 	    *lsout = 0;
8113 /* Writing concatenation */
8114 	    i__3[0] = ltemp - 5, a__1[0] = tempq;
8115 	    i__3[1] = lnumpq, a__1[1] = numpq;
8116 	    s_cat(ch__4, a__1, i__3, &c__2, (ftnlen)53);
8117 	    i__2 = ltemp - 5 + lnumpq;
8118 	    backfill_(&c__11, tempq, &ltemp, ch__4, &i__2, (ftnlen)48, ltemp
8119 		    - 5 + lnumpq);
8120 	}
8121 /* L3: */
8122     }
8123 
8124 /*  Shrink arrays, decrease ndyn 111109 */
8125 
8126     for (icntdyn = numdyn; icntdyn >= 1; --icntdyn) {
8127 	i__1 = comdyn_1.ndyn - 1;
8128 	for (jdyn = idynn[icntdyn - 1]; jdyn <= i__1; ++jdyn) {
8129 	    comdyn_1.idyndat[jdyn - 1] = comdyn_1.idyndat[jdyn];
8130 	    comdyn_1.idynda2[jdyn - 1] = comdyn_1.idynda2[jdyn];
8131 /* L7: */
8132 	}
8133 	--comdyn_1.ndyn;
8134 /* L6: */
8135     }
8136     return 0;
8137 } /* dodyn_ */
8138 
dograce_(integer * ivx,integer * ip,real * ptgr,char * soutq,integer * lsout,integer * ncm,integer * nacc,integer * ig,integer * ipl,logical * farend,logical * beamon,integer * nolev,integer * ncmidx,integer * islur,integer * nvmx,integer * nv,integer * ibmcnt,real * tnote,char * ulq,integer * instno,ftnlen soutq_len,ftnlen ulq_len)8139 /* Subroutine */ int dograce_(integer *ivx, integer *ip, real *ptgr, char *
8140 	soutq, integer *lsout, integer *ncm, integer *nacc, integer *ig,
8141 	integer *ipl, logical *farend, logical *beamon, integer *nolev,
8142 	integer *ncmidx, integer *islur, integer *nvmx, integer *nv, integer *
8143 	ibmcnt, real *tnote, char *ulq, integer *instno, ftnlen soutq_len,
8144 	ftnlen ulq_len)
8145 {
8146     /* System generated locals */
8147     address a__1[2], a__2[3], a__3[4];
8148     integer i__1, i__2[2], i__3[3], i__4[4], i__5, i__6;
8149     real r__1;
8150     char ch__1[1], ch__2[6], ch__3[2], ch__4[5], ch__5[11], ch__6[7], ch__7[4]
8151 	    , ch__8[87], ch__9[15], ch__10[16], ch__11[9], ch__12[12], ch__13[
8152 	    21], ch__14[20], ch__15[19], ch__16[24], ch__17[13], ch__18[82],
8153 	    ch__19[3], ch__20[10];
8154     icilist ici__1;
8155 
8156     /* Builtin functions */
8157     integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
8158 	    e_wsle(void);
8159     /* Subroutine */ int s_stop(char *, ftnlen);
8160     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
8161     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
8162     integer i_nint(real *), s_wsfi(icilist *), e_wsfi(void);
8163     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
8164     integer i_sign(integer *, integer *);
8165 
8166     /* Local variables */
8167     extern /* Subroutine */ int addblank_(char *, integer *, ftnlen);
8168     static integer lnotenga;
8169     extern integer igetbits_(integer *, integer *, integer *);
8170     static integer i__;
8171     static real x, y, em;
8172     static integer mg;
8173     static char sq[1];
8174     static real finalshift;
8175     static integer ing, ngs;
8176     extern integer log2_(integer *);
8177     static integer lacc;
8178     static real beta;
8179     extern /* Character */ VOID chax_(char *, ftnlen, integer *), udqq_(char *
8180 	    , ftnlen, integer *, integer *, integer *, integer *, integer *,
8181 	    integer *);
8182     static real sumx, sumy;
8183     extern /* Subroutine */ int stop1_(void);
8184     static real delta, ptoff;
8185     static integer lnote;
8186     static char noteq[8];
8187     static real sumxx, sumxy, sumyy;
8188     static integer nolev1;
8189     static logical isgaft;
8190     extern /* Subroutine */ int accsym_(integer *, char *, integer *, ftnlen),
8191 	     addstr_(char *, integer *, char *, integer *, ftnlen, ftnlen);
8192     static integer islope;
8193     static logical iswaft;
8194     static char acsymq[3];
8195     extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer
8196 	    *, ftnlen);
8197     static integer lnoten, itrans, niptgr;
8198     static logical stemup, normsp;
8199     static char notexq[79], noteqga[8];
8200     static real wheadpt1;
8201 
8202     /* Fortran I/O blocks */
8203     static cilist io___389 = { 0, 6, 0, 0, 0 };
8204     static cilist io___393 = { 0, 6, 0, 0, 0 };
8205     static cilist io___394 = { 0, 6, 0, 0, 0 };
8206     static cilist io___395 = { 0, 15, 0, "(/,a)", 0 };
8207     static icilist io___398 = { 0, notexq, 0, "(i2)", 2, 1 };
8208     static cilist io___399 = { 0, 6, 0, 0, 0 };
8209     static icilist io___423 = { 0, notexq+13, 0, "(a1,f4.1)", 5, 1 };
8210     static icilist io___425 = { 0, notexq+13, 0, "(f4.1)", 4, 1 };
8211     static icilist io___427 = { 0, notexq+5, 0, "(f3.1)", 3, 1 };
8212 
8213 
8214 
8215 /*  ip will be one LESS than current note, for way-after's before bar-end, */
8216 /*    It is only used to find ig. */
8217 /*  ig is returned to makeabar in case there's a slur that needs to be ended */
8218 
8219     /* Parameter adjustments */
8220     ulq -= 25;
8221     --ptgr;
8222 
8223     /* Function Body */
8224     chax_(ch__1, (ftnlen)1, &c__92);
8225     *(unsigned char *)sq = *(unsigned char *)&ch__1[0];
8226     isgaft = bit_test(*ipl,29);
8227     iswaft = bit_test(*ipl,31);
8228     normsp = ! isgaft;
8229 
8230 /*  Find ig. */
8231 
8232     i__1 = comgrace_1.ngrace;
8233     for (*ig = 1; *ig <= i__1; ++(*ig)) {
8234 	if (comgrace_1.ipg[*ig - 1] == *ip && comgrace_1.ivg[*ig - 1] == *ivx)
8235 		 {
8236 	    goto L121;
8237 	}
8238 /* L120: */
8239     }
8240     s_wsle(&io___389);
8241     do_lio(&c__9, &c__1, "Problem finding grace index in dograce", (ftnlen)38)
8242 	    ;
8243     e_wsle();
8244     s_stop("", (ftnlen)0);
8245 L121:
8246     ngs = comgrace_1.ngstrt[*ig - 1];
8247     mg = comgrace_1.multg[*ig - 1];
8248 /*      wheadpt1 = wheadpt*fullsize(ivx) */
8249     wheadpt1 = comask_1.wheadpt * comfig_1.fullsize[*instno - 1];
8250 
8251 /*  For way-after-graces at end of bar, must set the octave. */
8252 
8253     if (*farend) {
8254 	comoct_1.noctup = 0;
8255 	if (*ncm == 23) {
8256 	    comoct_1.noctup = -2;
8257 	}
8258     }
8259     if (comgrace_1.slurg[*ig - 1] && ! iswaft && ! isgaft) {
8260 	if (comslur_1.listslur == 16777215) {
8261 	    s_wsle(&io___393);
8262 	    e_wsle();
8263 	    s_wsle(&io___394);
8264 	    do_lio(&c__9, &c__1, "You defined the twentyfifth slur, one too "
8265 		    "many!", (ftnlen)47);
8266 	    e_wsle();
8267 	    s_wsfe(&io___395);
8268 	    do_fio(&c__1, "You defined the twentyfifth slur, one too many!", (
8269 		    ftnlen)47);
8270 	    e_wsfe();
8271 	    stop1_();
8272 	}
8273 
8274 /*  Slur on fore-grace.  Get index of next slur not in use, from 23 down. */
8275 
8276 	i__1 = 16777215 - comslur_1.listslur;
8277 	comslur_1.ndxslur = log2_(&i__1);
8278     }
8279     if (comgrace_1.nng[*ig - 1] == 1) {
8280 
8281 /*  Single grace. */
8282 
8283 	if (normsp) {
8284 
8285 /*  Anything but GA */
8286 
8287 /* Writing concatenation */
8288 	    i__2[0] = 1, a__1[0] = sq;
8289 	    i__2[1] = 5, a__1[1] = "shlft";
8290 	    s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)6);
8291 	    addstr_(ch__2, &c__6, soutq, lsout, (ftnlen)6, (ftnlen)80);
8292 	    niptgr = i_nint(&ptgr[*ig]);
8293 
8294 /*  Empirical tweak for postscript. */
8295 
8296 /*          if (.not.fontslur) niptgr = niptgr+nint(wheadpt*.3) */
8297 /* ++ */
8298 	    if (niptgr < 10) {
8299 /* Writing concatenation */
8300 		i__1 = niptgr + 48;
8301 		chax_(ch__1, (ftnlen)1, &i__1);
8302 		i__2[0] = 1, a__1[0] = ch__1;
8303 		i__2[1] = 1, a__1[1] = "{";
8304 		s_cat(ch__3, a__1, i__2, &c__2, (ftnlen)2);
8305 		addstr_(ch__3, &c__2, soutq, lsout, (ftnlen)2, (ftnlen)80);
8306 	    } else if (niptgr < 100) {
8307 		s_wsfi(&io___398);
8308 		do_fio(&c__1, (char *)&niptgr, (ftnlen)sizeof(integer));
8309 		e_wsfi();
8310 /* Writing concatenation */
8311 		i__3[0] = 1, a__2[0] = "{";
8312 		i__3[1] = 2, a__2[1] = notexq;
8313 		i__3[2] = 2, a__2[2] = "}{";
8314 		s_cat(ch__4, a__2, i__3, &c__3, (ftnlen)5);
8315 		addstr_(ch__4, &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80);
8316 	    } else {
8317 		s_wsle(&io___399);
8318 		do_lio(&c__9, &c__1, "Call Dr. Don if you really want grace "
8319 			"note group > 99 pt", (ftnlen)56);
8320 		e_wsle();
8321 		s_stop("", (ftnlen)0);
8322 	    }
8323 	} else {
8324 /* Writing concatenation */
8325 	    i__2[0] = 1, a__1[0] = sq;
8326 	    i__2[1] = 10, a__1[1] = "gaft{1.5}{";
8327 	    s_cat(ch__5, a__1, i__2, &c__2, (ftnlen)11);
8328 	    addstr_(ch__5, &c__11, soutq, lsout, (ftnlen)11, (ftnlen)80);
8329 
8330 /*  GA.  Compute aftshft, for later use. */
8331 
8332 	    comgrace_1.aftshft = spfacs_1.grafac;
8333 	    if (comgrace_1.naccg[comgrace_1.ngstrt[*ig - 1] - 1] > 0) {
8334 		comgrace_1.aftshft += spfacs_1.agc1fac;
8335 	    }
8336 	    comgrace_1.aftshft *= comask_1.wheadpt;
8337 	}
8338 	if (comgrace_1.slurg[*ig - 1] && ! isgaft && ! iswaft) {
8339 
8340 /*  Start slur on pre-grace.  No accounting needed since will be ended very soon. */
8341 
8342 	    notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)
8343 		    8);
8344 	    if (comslur_1.fontslur) {
8345 		if (comgrace_1.upg[*ig - 1]) {
8346 /* Writing concatenation */
8347 		    i__2[0] = 1, a__1[0] = sq;
8348 		    i__2[1] = 6, a__1[1] = "islurd";
8349 		    s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7);
8350 		    addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80)
8351 			    ;
8352 		} else {
8353 /* Writing concatenation */
8354 		    i__2[0] = 1, a__1[0] = sq;
8355 		    i__2[1] = 6, a__1[1] = "isluru";
8356 		    s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7);
8357 		    addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80)
8358 			    ;
8359 		}
8360 	    } else {
8361 
8362 /*  Start Postscript slur. */
8363 
8364 		if (comgrace_1.upg[*ig - 1]) {
8365 /* Writing concatenation */
8366 		    i__2[0] = 1, a__1[0] = sq;
8367 		    i__2[1] = 3, a__1[1] = "isd";
8368 		    s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4);
8369 		    addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80)
8370 			    ;
8371 		} else {
8372 /* Writing concatenation */
8373 		    i__2[0] = 1, a__1[0] = sq;
8374 		    i__2[1] = 3, a__1[1] = "isu";
8375 		    s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4);
8376 		    addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80)
8377 			    ;
8378 		}
8379 	    }
8380 
8381 /*  Print slur number, 23-ndxslur */
8382 
8383 	    lnote = 0;
8384 	    if (23 - comslur_1.ndxslur < 10) {
8385 /*              notexq = notexq(1:lnote)//chax(59-ndxslur) */
8386 		i__1 = 71 - comslur_1.ndxslur;
8387 		chax_(ch__1, (ftnlen)1, &i__1);
8388 		s_copy(notexq, ch__1, (ftnlen)79, (ftnlen)1);
8389 		lnote = 1;
8390 	    } else if (23 - comslur_1.ndxslur < 20) {
8391 /*              notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */
8392 /* Writing concatenation */
8393 		i__3[0] = 2, a__2[0] = "{1";
8394 		i__1 = 61 - comslur_1.ndxslur;
8395 		chax_(ch__1, (ftnlen)1, &i__1);
8396 		i__3[1] = 1, a__2[1] = ch__1;
8397 		i__3[2] = 1, a__2[2] = "}";
8398 		s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
8399 		lnote = 4;
8400 	    } else {
8401 /* Writing concatenation */
8402 		i__4[0] = lnote, a__3[0] = notexq;
8403 		i__4[1] = 2, a__3[1] = "{2";
8404 		i__1 = 51 - comslur_1.ndxslur;
8405 		chax_(ch__1, (ftnlen)1, &i__1);
8406 		i__4[2] = 1, a__3[2] = ch__1;
8407 		i__4[3] = 1, a__3[3] = "}";
8408 		s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
8409 		lnote = 4;
8410 	    }
8411 /*          if (11-ndxslur .lt. 10) then */
8412 /*            call addstr(chax(59-ndxslur)//noteq(1:lnoten),1+lnoten, */
8413 /*     *                 soutq,lsout) */
8414 /*          else */
8415 /*            call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten), */
8416 /*     *            4+lnoten,soutq,lsout) */
8417 /*          end if */
8418 /* Writing concatenation */
8419 	    i__2[0] = lnote, a__1[0] = notexq;
8420 	    i__2[1] = lnoten, a__1[1] = noteq;
8421 	    s_cat(ch__8, a__1, i__2, &c__2, (ftnlen)87);
8422 	    i__1 = lnote + lnoten;
8423 	    addstr_(ch__8, &i__1, soutq, lsout, lnote + lnoten, (ftnlen)80);
8424 	    if (! comslur_1.fontslur) {
8425 
8426 /*  Horizontal tweaks for postscript slur on single grace */
8427 
8428 		stemup = TRUE_;
8429 		if (comgrace_1.upg[*ig - 1]) {
8430 
8431 /*  Check for up-grace + down stem. Get stem direction */
8432 
8433 		    if (! (*beamon)) {
8434 
8435 /*  Separate note.  Get stem direction. */
8436 
8437 			udqq_(ch__1, (ftnlen)1, nolev, ncmidx, islur, nvmx,
8438 				ivx, nv);
8439 			stemup = *(unsigned char *)&ch__1[0] == 'u';
8440 		    } else {
8441 
8442 /*  In a beam */
8443 
8444 			stemup = *(unsigned char *)&ulq[*ivx + *ibmcnt * 24]
8445 				== 'u';
8446 		    }
8447 
8448 /*  Stop the shift if whole note */
8449 
8450 		    stemup = stemup || *tnote > 63.f;
8451 		}
8452 		if (stemup) {
8453 		    addstr_("{-.3}", &c__5, soutq, lsout, (ftnlen)5, (ftnlen)
8454 			    80);
8455 		} else {
8456 		    addstr_("{-.8}", &c__5, soutq, lsout, (ftnlen)5, (ftnlen)
8457 			    80);
8458 		}
8459 	    }
8460 	}
8461 	if (comgrace_1.naccg[ngs - 1] > 0) {
8462 	    notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)
8463 		    8);
8464 
8465 /* Save for checking octave shifts in GA */
8466 
8467 	    if (isgaft) {
8468 		lnotenga = lnoten;
8469 		s_copy(noteqga, noteq, (ftnlen)8, (ftnlen)8);
8470 	    }
8471 
8472 	    if (lnoten == 1) {
8473 		addblank_(noteq, &lnoten, (ftnlen)8);
8474 	    }
8475 	    accsym_(&comgrace_1.naccg[ngs - 1], acsymq, &lacc, (ftnlen)3);
8476 /* Writing concatenation */
8477 	    i__4[0] = 1, a__3[0] = sq;
8478 	    i__4[1] = 3, a__3[1] = "big";
8479 	    i__4[2] = lacc, a__3[2] = acsymq;
8480 	    i__4[3] = lnoten, a__3[3] = noteq;
8481 	    s_cat(ch__9, a__3, i__4, &c__4, (ftnlen)15);
8482 	    i__1 = lacc + 4 + lnoten;
8483 	    addstr_(ch__9, &i__1, soutq, lsout, lacc + 4 + lnoten, (ftnlen)80)
8484 		    ;
8485 	}
8486 	if (comgrace_1.slashg[*ig - 1]) {
8487 /* Writing concatenation */
8488 	    i__2[0] = 1, a__1[0] = sq;
8489 	    i__2[1] = 3, a__1[1] = "grc";
8490 	    s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
8491 	    lnote = 4;
8492 	} else if (mg == 0) {
8493 /* Writing concatenation */
8494 	    i__2[0] = 1, a__1[0] = sq;
8495 	    i__2[1] = 2, a__1[1] = "zq";
8496 	    s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
8497 	    lnote = 3;
8498 	} else {
8499 /* Writing concatenation */
8500 	    i__2[0] = 1, a__1[0] = sq;
8501 	    i__2[1] = 2, a__1[1] = "zc";
8502 	    s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
8503 	    i__1 = mg;
8504 	    for (i__ = 2; i__ <= i__1; ++i__) {
8505 /* Writing concatenation */
8506 		i__2[0] = i__ + 1, a__1[0] = notexq;
8507 		i__2[1] = 1, a__1[1] = "c";
8508 		s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
8509 /* L61: */
8510 	    }
8511 	    lnote = mg + 2;
8512 	}
8513 	if (comgrace_1.upg[*ig - 1]) {
8514 /* Writing concatenation */
8515 	    i__2[0] = lnote, a__1[0] = notexq;
8516 	    i__2[1] = 1, a__1[1] = "u";
8517 	    s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
8518 	} else {
8519 /* Writing concatenation */
8520 	    i__2[0] = lnote, a__1[0] = notexq;
8521 	    i__2[1] = 1, a__1[1] = "l";
8522 	    s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
8523 	}
8524 	i__1 = lnote + 1;
8525 	addstr_(notexq, &i__1, soutq, lsout, (ftnlen)79, (ftnlen)80);
8526 	notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)8);
8527 
8528 	if (isgaft && comgrace_1.naccg[ngs - 1] == 0) {
8529 	    lnotenga = lnoten;
8530 	    s_copy(noteqga, noteq, (ftnlen)8, (ftnlen)8);
8531 	}
8532 
8533 	if (lnoten == 1) {
8534 	    addblank_(noteq, &lnoten, (ftnlen)8);
8535 	}
8536 	addstr_(noteq, &lnoten, soutq, lsout, (ftnlen)8, (ftnlen)80);
8537 	if (comgrace_1.slashg[*ig - 1]) {
8538 /* Writing concatenation */
8539 	    i__4[0] = 1, a__3[0] = sq;
8540 	    i__4[1] = 5, a__3[1] = "off{-";
8541 	    i__4[2] = 1, a__3[2] = sq;
8542 	    i__4[3] = 9, a__3[3] = "noteskip}";
8543 	    s_cat(ch__10, a__3, i__4, &c__4, (ftnlen)16);
8544 	    addstr_(ch__10, &c__16, soutq, lsout, (ftnlen)16, (ftnlen)80);
8545 	}
8546 
8547 /*  Above code needed since slashg causes spacing */
8548 
8549 	if (comgrace_1.slurg[*ig - 1] && (iswaft || isgaft)) {
8550 
8551 /*  Terminate slur on single after-grace */
8552 
8553 /*          ndxslur = igetbits(ipl,4,23) */
8554 	    comslur_1.ndxslur = igetbits_(ipl, &c__5, &c__23);
8555 	    notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)
8556 		    8);
8557 /* Writing concatenation */
8558 	    i__2[0] = 1, a__1[0] = sq;
8559 	    i__2[1] = 5, a__1[1] = "tslur";
8560 	    s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)6);
8561 	    addstr_(ch__2, &c__6, soutq, lsout, (ftnlen)6, (ftnlen)80);
8562 
8563 /* c  Print 11-ndxslur */
8564 /*  Print 24-ndxslur */
8565 
8566 /*          if (11-ndxslur .lt. 10) then */
8567 	    if (23 - comslur_1.ndxslur < 10) {
8568 /*            call addstr(chax(59-ndxslur)//noteq(1:lnoten), */
8569 /* Writing concatenation */
8570 		i__1 = 71 - comslur_1.ndxslur;
8571 		chax_(ch__1, (ftnlen)1, &i__1);
8572 		i__2[0] = 1, a__1[0] = ch__1;
8573 		i__2[1] = lnoten, a__1[1] = noteq;
8574 		s_cat(ch__11, a__1, i__2, &c__2, (ftnlen)9);
8575 		i__5 = lnoten + 1;
8576 		addstr_(ch__11, &i__5, soutq, lsout, lnoten + 1, (ftnlen)80);
8577 	    } else if (23 - comslur_1.ndxslur < 20) {
8578 /* Writing concatenation */
8579 		i__4[0] = 2, a__3[0] = "{2";
8580 		i__1 = 61 - comslur_1.ndxslur;
8581 		chax_(ch__1, (ftnlen)1, &i__1);
8582 		i__4[1] = 1, a__3[1] = ch__1;
8583 		i__4[2] = 1, a__3[2] = "}";
8584 		i__4[3] = lnoten, a__3[3] = noteq;
8585 		s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12);
8586 		i__5 = lnoten + 4;
8587 		addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80);
8588 	    } else {
8589 /*            call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten), */
8590 /* Writing concatenation */
8591 		i__4[0] = 2, a__3[0] = "{1";
8592 		i__1 = 51 - comslur_1.ndxslur;
8593 		chax_(ch__1, (ftnlen)1, &i__1);
8594 		i__4[1] = 1, a__3[1] = ch__1;
8595 		i__4[2] = 1, a__3[2] = "}";
8596 		i__4[3] = lnoten, a__3[3] = noteq;
8597 		s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12);
8598 		i__5 = lnoten + 4;
8599 		addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80);
8600 	    }
8601 	    comgrace_1.slurg[*ig - 1] = FALSE_;
8602 	    comslur_1.listslur = bit_clear(comslur_1.listslur,
8603 		    comslur_1.ndxslur);
8604 	}
8605 	addstr_("}", &c__1, soutq, lsout, (ftnlen)1, (ftnlen)80);
8606 
8607 /* +++  Try to fix loss of octave with single gaft */
8608 
8609 /*        if (isgaft) call addstr(sq//'zcharnote'//noteq(1:lnoten)//'{~}', */
8610 /*     *                          13+lnoten,soutq,lsout) */
8611 	if (isgaft) {
8612 	    itrans = 0;
8613 	    i__1 = lnotenga;
8614 	    for (i__ = 1; i__ <= i__1; ++i__) {
8615 		chax_(ch__1, (ftnlen)1, &c__39);
8616 		if (*(unsigned char *)&noteqga[i__ - 1] == *(unsigned char *)&
8617 			ch__1[0]) {
8618 		    itrans += 7;
8619 		} else /* if(complicated condition) */ {
8620 		    chax_(ch__1, (ftnlen)1, &c__96);
8621 		    if (*(unsigned char *)&noteqga[i__ - 1] == *(unsigned
8622 			    char *)&ch__1[0]) {
8623 			itrans += -7;
8624 		    }
8625 		}
8626 /* L1: */
8627 	    }
8628 	    if (itrans == -14) {
8629 /* Writing concatenation */
8630 		i__4[0] = 1, a__3[0] = sq;
8631 		i__4[1] = 7, a__3[1] = "advance";
8632 		i__4[2] = 1, a__3[2] = sq;
8633 		i__4[3] = 12, a__3[3] = "transpose-14";
8634 		s_cat(ch__13, a__3, i__4, &c__4, (ftnlen)21);
8635 		addstr_(ch__13, &c__21, soutq, lsout, (ftnlen)21, (ftnlen)80);
8636 	    } else if (itrans == -7) {
8637 /* Writing concatenation */
8638 		i__4[0] = 1, a__3[0] = sq;
8639 		i__4[1] = 7, a__3[1] = "advance";
8640 		i__4[2] = 1, a__3[2] = sq;
8641 		i__4[3] = 11, a__3[3] = "transpose-7";
8642 		s_cat(ch__14, a__3, i__4, &c__4, (ftnlen)20);
8643 		addstr_(ch__14, &c__20, soutq, lsout, (ftnlen)20, (ftnlen)80);
8644 	    } else if (itrans == 7) {
8645 /* Writing concatenation */
8646 		i__4[0] = 1, a__3[0] = sq;
8647 		i__4[1] = 7, a__3[1] = "advance";
8648 		i__4[2] = 1, a__3[2] = sq;
8649 		i__4[3] = 10, a__3[3] = "transpose7";
8650 		s_cat(ch__15, a__3, i__4, &c__4, (ftnlen)19);
8651 		addstr_(ch__15, &c__19, soutq, lsout, (ftnlen)19, (ftnlen)80);
8652 	    } else if (itrans == 14) {
8653 /* Writing concatenation */
8654 		i__4[0] = 1, a__3[0] = sq;
8655 		i__4[1] = 7, a__3[1] = "advance";
8656 		i__4[2] = 1, a__3[2] = sq;
8657 		i__4[3] = 11, a__3[3] = "transpose14";
8658 		s_cat(ch__14, a__3, i__4, &c__4, (ftnlen)20);
8659 		addstr_(ch__14, &c__20, soutq, lsout, (ftnlen)20, (ftnlen)80);
8660 	    }
8661 	}
8662     } else {
8663 
8664 /*  Multiple grace.  Put in literally.  Compute beam stuff */
8665 
8666 	sumx = 0.f;
8667 	sumy = 0.f;
8668 	sumxy = 0.f;
8669 	sumxx = 0.f;
8670 	sumyy = 0.f;
8671 	x = 0.f;
8672 	i__1 = ngs + comgrace_1.nng[*ig - 1] - 1;
8673 	for (ing = ngs; ing <= i__1; ++ing) {
8674 	    if (ing > ngs && comgrace_1.naccg[ing - 1] > 0) {
8675 		x += spfacs_1.acgfac;
8676 	    }
8677 	    y = (real) comgrace_1.nolevg[ing - 1];
8678 	    sumx += x;
8679 	    sumy += y;
8680 	    sumxy += x * y;
8681 	    sumxx += x * x;
8682 	    sumyy += y * y;
8683 	    x += spfacs_1.emgfac;
8684 /* L118: */
8685 	}
8686 	delta = comgrace_1.nng[*ig - 1] * sumxx - sumx * sumx;
8687 	em = (comgrace_1.nng[*ig - 1] * sumxy - sumx * sumy) / delta;
8688 	r__1 = em * .5f * spfacs_1.gslfac;
8689 	islope = i_nint(&r__1);
8690 	if (abs(islope) > 9) {
8691 	    islope = i_sign(&c__9, &islope);
8692 	}
8693 	beta = (sumy - islope / spfacs_1.gslfac * sumx) / comgrace_1.nng[*ig
8694 		- 1];
8695 	nolev1 = i_nint(&beta);
8696 
8697 /*  Back up */
8698 
8699 /* Writing concatenation */
8700 	i__4[0] = 1, a__3[0] = sq;
8701 	i__4[1] = 7, a__3[1] = "settiny";
8702 	i__4[2] = 1, a__3[2] = sq;
8703 	i__4[3] = 4, a__3[3] = "off{";
8704 	s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
8705 	if (normsp) {
8706 	    s_wsfi(&io___423);
8707 	    do_fio(&c__1, "-", (ftnlen)1);
8708 	    do_fio(&c__1, (char *)&ptgr[*ig], (ftnlen)sizeof(real));
8709 	    e_wsfi();
8710 /* Writing concatenation */
8711 	    i__2[0] = 18, a__1[0] = notexq;
8712 	    i__2[1] = 3, a__1[1] = "pt}";
8713 	    s_cat(ch__13, a__1, i__2, &c__2, (ftnlen)21);
8714 	    addstr_(ch__13, &c__21, soutq, lsout, (ftnlen)21, (ftnlen)80);
8715 	    finalshift = ptgr[*ig];
8716 	} else {
8717 	    comgrace_1.aftshft = comask_1.wheadpt * 1.33f;
8718 	    if (comgrace_1.naccg[comgrace_1.ngstrt[*ig - 1] - 1] > 0) {
8719 		comgrace_1.aftshft += comask_1.wheadpt * .5f;
8720 	    }
8721 	    s_wsfi(&io___425);
8722 	    do_fio(&c__1, (char *)&comgrace_1.aftshft, (ftnlen)sizeof(real));
8723 	    e_wsfi();
8724 /* Writing concatenation */
8725 	    i__4[0] = 17, a__3[0] = notexq;
8726 	    i__4[1] = 3, a__3[1] = "pt}";
8727 	    i__4[2] = 1, a__3[2] = sq;
8728 	    i__4[3] = 3, a__3[3] = "bsk";
8729 	    s_cat(ch__16, a__3, i__4, &c__4, (ftnlen)24);
8730 	    addstr_(ch__16, &c__24, soutq, lsout, (ftnlen)24, (ftnlen)80);
8731 	}
8732 
8733 /*  Start the beam */
8734 
8735 /* Writing concatenation */
8736 	i__2[0] = 1, a__1[0] = sq;
8737 	i__2[1] = 2, a__1[1] = "ib";
8738 	s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
8739 	i__1 = mg;
8740 	for (ing = 2; ing <= i__1; ++ing) {
8741 /* Writing concatenation */
8742 	    i__2[0] = ing + 1, a__1[0] = notexq;
8743 	    i__2[1] = 1, a__1[1] = "b";
8744 	    s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
8745 /* L119: */
8746 	}
8747 	if (comgrace_1.upg[*ig - 1]) {
8748 /* Writing concatenation */
8749 	    i__2[0] = mg + 2, a__1[0] = notexq;
8750 	    i__2[1] = 1, a__1[1] = "u";
8751 	    s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
8752 	} else {
8753 /* Writing concatenation */
8754 	    i__2[0] = mg + 2, a__1[0] = notexq;
8755 	    i__2[1] = 1, a__1[1] = "l";
8756 	    s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
8757 	}
8758 /* Writing concatenation */
8759 	i__2[0] = mg + 3, a__1[0] = notexq;
8760 	i__2[1] = 1, a__1[1] = "0";
8761 	s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
8762 
8763 /*  Get starting note for beam */
8764 
8765 	notefq_(noteq, &lnoten, &nolev1, ncm, (ftnlen)8);
8766 /* Writing concatenation */
8767 	i__2[0] = mg + 4, a__1[0] = notexq;
8768 	i__2[1] = lnoten, a__1[1] = noteq;
8769 	s_cat(ch__8, a__1, i__2, &c__2, (ftnlen)87);
8770 	i__1 = mg + 4 + lnoten;
8771 	addstr_(ch__8, &i__1, soutq, lsout, mg + 4 + lnoten, (ftnlen)80);
8772 
8773 /*  Put in the slope */
8774 
8775 	if (islope >= 0) {
8776 	    i__1 = islope + 48;
8777 	    chax_(ch__1, (ftnlen)1, &i__1);
8778 	    addstr_(ch__1, &c__1, soutq, lsout, (ftnlen)1, (ftnlen)80);
8779 	} else {
8780 /* Writing concatenation */
8781 	    i__3[0] = 2, a__2[0] = "{-";
8782 	    i__1 = 48 - islope;
8783 	    chax_(ch__1, (ftnlen)1, &i__1);
8784 	    i__3[1] = 1, a__2[1] = ch__1;
8785 	    i__3[2] = 1, a__2[2] = "}";
8786 	    s_cat(ch__7, a__2, i__3, &c__3, (ftnlen)4);
8787 	    addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80);
8788 	}
8789 
8790 /*  Start a slur on multiple fore-grace */
8791 
8792 	if (comgrace_1.slurg[*ig - 1] && ! isgaft && ! iswaft) {
8793 	    notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)
8794 		    8);
8795 	    if (comslur_1.fontslur) {
8796 		if (comgrace_1.upg[*ig - 1]) {
8797 /* Writing concatenation */
8798 		    i__2[0] = 1, a__1[0] = sq;
8799 		    i__2[1] = 6, a__1[1] = "islurd";
8800 		    s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7);
8801 		    addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80)
8802 			    ;
8803 		} else {
8804 /* Writing concatenation */
8805 		    i__2[0] = 1, a__1[0] = sq;
8806 		    i__2[1] = 6, a__1[1] = "isluru";
8807 		    s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7);
8808 		    addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80)
8809 			    ;
8810 		}
8811 	    } else {
8812 
8813 /*  Need a tweak for postscript slur */
8814 
8815 		if (comgrace_1.upg[*ig - 1]) {
8816 /* Writing concatenation */
8817 		    i__2[0] = 1, a__1[0] = sq;
8818 		    i__2[1] = 3, a__1[1] = "isd";
8819 		    s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4);
8820 		    addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80)
8821 			    ;
8822 		} else {
8823 /* Writing concatenation */
8824 		    i__2[0] = 1, a__1[0] = sq;
8825 		    i__2[1] = 3, a__1[1] = "isu";
8826 		    s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4);
8827 		    addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80)
8828 			    ;
8829 		}
8830 	    }
8831 
8832 /*  Print 11-ndxslur */
8833 
8834 	    if (23 - comslur_1.ndxslur < 10) {
8835 /* Writing concatenation */
8836 		i__1 = 71 - comslur_1.ndxslur;
8837 		chax_(ch__1, (ftnlen)1, &i__1);
8838 		i__2[0] = 1, a__1[0] = ch__1;
8839 		i__2[1] = lnoten, a__1[1] = noteq;
8840 		s_cat(ch__11, a__1, i__2, &c__2, (ftnlen)9);
8841 		i__5 = lnoten + 1;
8842 		addstr_(ch__11, &i__5, soutq, lsout, lnoten + 1, (ftnlen)80);
8843 	    } else if (23 - comslur_1.ndxslur < 2) {
8844 /* Writing concatenation */
8845 		i__4[0] = 2, a__3[0] = "{1";
8846 		i__1 = 61 - comslur_1.ndxslur;
8847 		chax_(ch__1, (ftnlen)1, &i__1);
8848 		i__4[1] = 1, a__3[1] = ch__1;
8849 		i__4[2] = 1, a__3[2] = "}";
8850 		i__4[3] = lnoten, a__3[3] = noteq;
8851 		s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12);
8852 		i__5 = lnoten + 4;
8853 		addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80);
8854 	    } else {
8855 /* Writing concatenation */
8856 		i__4[0] = 2, a__3[0] = "{1";
8857 		i__1 = 51 - comslur_1.ndxslur;
8858 		chax_(ch__1, (ftnlen)1, &i__1);
8859 		i__4[1] = 1, a__3[1] = ch__1;
8860 		i__4[2] = 1, a__3[2] = "}";
8861 		i__4[3] = lnoten, a__3[3] = noteq;
8862 		s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12);
8863 		i__5 = lnoten + 4;
8864 		addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80);
8865 	    }
8866 
8867 /*  Put in tweak for postscript slur */
8868 
8869 	    if (! comslur_1.fontslur) {
8870 		addstr_("{-.3}", &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80);
8871 	    }
8872 	}
8873 
8874 /*  Put in first note.  Call notefq again in case octave changed */
8875 
8876 	notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)8);
8877 	if (comgrace_1.naccg[ngs - 1] == 0) {
8878 /* Writing concatenation */
8879 	    i__3[0] = 1, a__2[0] = sq;
8880 	    i__3[1] = 4, a__2[1] = "zqb0";
8881 	    i__3[2] = lnoten, a__2[2] = noteq;
8882 	    s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
8883 	    lnote = lnoten + 5;
8884 	} else {
8885 	    if (lnoten == 1) {
8886 		addblank_(noteq, &lnoten, (ftnlen)8);
8887 	    }
8888 	    accsym_(&comgrace_1.naccg[ngs - 1], acsymq, &lacc, (ftnlen)3);
8889 /* Writing concatenation */
8890 	    i__4[0] = 1, a__3[0] = sq;
8891 	    i__4[1] = 3, a__3[1] = "big";
8892 	    i__4[2] = lacc, a__3[2] = acsymq;
8893 	    i__4[3] = lnoten, a__3[3] = noteq;
8894 	    s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
8895 	    lnote = lacc + 4 + lnoten;
8896 	    notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)
8897 		    8);
8898 /* Writing concatenation */
8899 	    i__4[0] = lnote, a__3[0] = notexq;
8900 	    i__4[1] = 1, a__3[1] = sq;
8901 	    i__4[2] = 4, a__3[2] = "zqb0";
8902 	    i__4[3] = lnoten, a__3[3] = noteq;
8903 	    s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
8904 	    lnote = lnote + 5 + lnoten;
8905 	}
8906 	addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
8907 	i__1 = ngs + comgrace_1.nng[*ig - 1] - 1;
8908 	for (ing = ngs + 1; ing <= i__1; ++ing) {
8909 
8910 /*  Skip */
8911 
8912 	    ptoff = wheadpt1 * spfacs_1.emgfac;
8913 	    if (comgrace_1.naccg[ing - 1] > 0) {
8914 		ptoff += wheadpt1 * spfacs_1.acgfac;
8915 	    }
8916 	    if (isgaft && ! iswaft) {
8917 		comgrace_1.aftshft += ptoff;
8918 	    }
8919 /* Writing concatenation */
8920 	    i__2[0] = 1, a__1[0] = sq;
8921 	    i__2[1] = 4, a__1[1] = "off{";
8922 	    s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
8923 	    s_wsfi(&io___427);
8924 	    do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real));
8925 	    e_wsfi();
8926 	    if (normsp) {
8927 		finalshift -= ptoff;
8928 	    }
8929 /* Writing concatenation */
8930 	    i__2[0] = 8, a__1[0] = notexq;
8931 	    i__2[1] = 3, a__1[1] = "pt}";
8932 	    s_cat(ch__5, a__1, i__2, &c__2, (ftnlen)11);
8933 	    addstr_(ch__5, &c__11, soutq, lsout, (ftnlen)11, (ftnlen)80);
8934 	    if (ing == ngs + comgrace_1.nng[*ig - 1] - 1) {
8935 
8936 /*  Terminate beam if needed */
8937 
8938 		if (comgrace_1.upg[*ig - 1]) {
8939 /* Writing concatenation */
8940 		    i__2[0] = 1, a__1[0] = sq;
8941 		    i__2[1] = 4, a__1[1] = "tbu0";
8942 		    s_cat(ch__4, a__1, i__2, &c__2, (ftnlen)5);
8943 		    addstr_(ch__4, &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80)
8944 			    ;
8945 		} else {
8946 /* Writing concatenation */
8947 		    i__2[0] = 1, a__1[0] = sq;
8948 		    i__2[1] = 4, a__1[1] = "tbl0";
8949 		    s_cat(ch__4, a__1, i__2, &c__2, (ftnlen)5);
8950 		    addstr_(ch__4, &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80)
8951 			    ;
8952 		}
8953 
8954 /*  Terminate after slur if needed */
8955 
8956 		if ((isgaft || iswaft) && comgrace_1.slurg[*ig - 1]) {
8957 /*              if (iswaft) ndxslur = igetbits(ipl,4,23) */
8958 		    if (iswaft) {
8959 			comslur_1.ndxslur = igetbits_(ipl, &c__5, &c__23);
8960 		    }
8961 		    notefq_(noteq, &lnoten, &comgrace_1.nolevg[ing - 1], ncm,
8962 			    (ftnlen)8);
8963 /* Writing concatenation */
8964 		    i__2[0] = 1, a__1[0] = sq;
8965 		    i__2[1] = 5, a__1[1] = "tslur";
8966 		    s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)6);
8967 		    addstr_(ch__2, &c__6, soutq, lsout, (ftnlen)6, (ftnlen)80)
8968 			    ;
8969 
8970 /*  Print 11-ndxslur */
8971 /* c  Print 23-ndxslur */
8972 
8973 		    if (23 - comslur_1.ndxslur < 10) {
8974 /* Writing concatenation */
8975 			i__5 = 71 - comslur_1.ndxslur;
8976 			chax_(ch__1, (ftnlen)1, &i__5);
8977 			i__2[0] = 1, a__1[0] = ch__1;
8978 			i__2[1] = lnoten, a__1[1] = noteq;
8979 			s_cat(ch__11, a__1, i__2, &c__2, (ftnlen)9);
8980 			i__6 = lnoten + 1;
8981 			addstr_(ch__11, &i__6, soutq, lsout, lnoten + 1, (
8982 				ftnlen)80);
8983 		    } else if (23 - comslur_1.ndxslur < 20) {
8984 /* Writing concatenation */
8985 			i__4[0] = 2, a__3[0] = "{2";
8986 			i__5 = 61 - comslur_1.ndxslur;
8987 			chax_(ch__1, (ftnlen)1, &i__5);
8988 			i__4[1] = 1, a__3[1] = ch__1;
8989 			i__4[2] = 1, a__3[2] = "}";
8990 			i__4[3] = lnoten, a__3[3] = noteq;
8991 			s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12);
8992 			i__6 = lnoten + 4;
8993 			addstr_(ch__12, &i__6, soutq, lsout, lnoten + 4, (
8994 				ftnlen)80);
8995 		    } else {
8996 /* Writing concatenation */
8997 			i__4[0] = 2, a__3[0] = "{1";
8998 			i__5 = 51 - comslur_1.ndxslur;
8999 			chax_(ch__1, (ftnlen)1, &i__5);
9000 			i__4[1] = 1, a__3[1] = ch__1;
9001 			i__4[2] = 1, a__3[2] = "}";
9002 			i__4[3] = lnoten, a__3[3] = noteq;
9003 			s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12);
9004 			i__6 = lnoten + 4;
9005 			addstr_(ch__12, &i__6, soutq, lsout, lnoten + 4, (
9006 				ftnlen)80);
9007 		    }
9008 
9009 /*  Stop slur terminator after exit from this subroutine */
9010 
9011 		    comslur_1.listslur = bit_clear(comslur_1.listslur,
9012 			    comslur_1.ndxslur);
9013 		    comgrace_1.slurg[*ig - 1] = FALSE_;
9014 		}
9015 	    }
9016 
9017 /*  Accidental if needed */
9018 
9019 	    if (comgrace_1.naccg[ing - 1] > 0) {
9020 		notefq_(noteq, &lnoten, &comgrace_1.nolevg[ing - 1], ncm, (
9021 			ftnlen)8);
9022 		if (lnoten == 1) {
9023 		    addblank_(noteq, &lnoten, (ftnlen)8);
9024 		}
9025 		accsym_(&comgrace_1.naccg[ing - 1], acsymq, &lacc, (ftnlen)3);
9026 /* Writing concatenation */
9027 		i__4[0] = 1, a__3[0] = sq;
9028 		i__4[1] = 3, a__3[1] = "big";
9029 		i__4[2] = lacc, a__3[2] = acsymq;
9030 		i__4[3] = lnoten, a__3[3] = noteq;
9031 		s_cat(ch__9, a__3, i__4, &c__4, (ftnlen)15);
9032 		i__5 = lacc + 4 + lnoten;
9033 		addstr_(ch__9, &i__5, soutq, lsout, lacc + 4 + lnoten, (
9034 			ftnlen)80);
9035 	    }
9036 
9037 /*  Put in the (beamed) grace note */
9038 
9039 	    notefq_(noteq, &lnoten, &comgrace_1.nolevg[ing - 1], ncm, (ftnlen)
9040 		    8);
9041 /* Writing concatenation */
9042 	    i__3[0] = 1, a__2[0] = sq;
9043 	    i__3[1] = 4, a__2[1] = "zqb0";
9044 	    i__3[2] = lnoten, a__2[2] = noteq;
9045 	    s_cat(ch__17, a__2, i__3, &c__3, (ftnlen)13);
9046 	    i__5 = lnoten + 5;
9047 	    addstr_(ch__17, &i__5, soutq, lsout, lnoten + 5, (ftnlen)80);
9048 /* L127: */
9049 	}
9050 
9051 /*  Terminate the grace */
9052 
9053 /*        notexq = sq//'normalnotesize'//sq//'off{' */
9054 /*        lnote = 20 */
9055 /*        notexq = '}'//sq//'off{' */
9056 /*        lnote = 6 */
9057 /* Writing concatenation */
9058 	i__2[0] = 1, a__1[0] = sq;
9059 	i__2[1] = 4, a__1[1] = "off{";
9060 	s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
9061 	lnote = 5;
9062 	ptoff = comask_1.wheadpt * spfacs_1.emgfac;
9063 	if ((*nacc & 3) > 0 && ! bit_test(*nacc,17)) {
9064 	    ptoff += comask_1.wheadpt * spfacs_1.accfac;
9065 	}
9066 	if (isgaft && ! iswaft) {
9067 /* Writing concatenation */
9068 	    i__2[0] = 5, a__1[0] = notexq;
9069 	    i__2[1] = 1, a__1[1] = "-";
9070 	    s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
9071 	    lnote = 6;
9072 	    ptoff = comgrace_1.aftshft;
9073 	}
9074 	if (normsp) {
9075 	    ptoff = finalshift;
9076 	}
9077 	if (ptoff < 9.95f) {
9078 	    i__1 = lnote;
9079 	    ici__1.icierr = 0;
9080 	    ici__1.icirnum = 1;
9081 	    ici__1.icirlen = lnote + 3 - i__1;
9082 	    ici__1.iciunit = notexq + i__1;
9083 	    ici__1.icifmt = "(f3.1)";
9084 	    s_wsfi(&ici__1);
9085 	    do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real));
9086 	    e_wsfi();
9087 	    lnote += 3;
9088 	} else if (ptoff < 99.95f) {
9089 	    i__1 = lnote;
9090 	    ici__1.icierr = 0;
9091 	    ici__1.icirnum = 1;
9092 	    ici__1.icirlen = lnote + 4 - i__1;
9093 	    ici__1.iciunit = notexq + i__1;
9094 	    ici__1.icifmt = "(f4.1)";
9095 	    s_wsfi(&ici__1);
9096 	    do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real));
9097 	    e_wsfi();
9098 	    lnote += 4;
9099 	} else {
9100 	    i__1 = lnote;
9101 	    ici__1.icierr = 0;
9102 	    ici__1.icirnum = 1;
9103 	    ici__1.icirlen = lnote + 5 - i__1;
9104 	    ici__1.iciunit = notexq + i__1;
9105 	    ici__1.icifmt = "(f5.1)";
9106 	    s_wsfi(&ici__1);
9107 	    do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real));
9108 	    e_wsfi();
9109 	    lnote += 5;
9110 	}
9111 /* Writing concatenation */
9112 	i__2[0] = lnote, a__1[0] = notexq;
9113 	i__2[1] = 3, a__1[1] = "pt}";
9114 	s_cat(ch__18, a__1, i__2, &c__2, (ftnlen)82);
9115 	i__1 = lnote + 3;
9116 	addstr_(ch__18, &i__1, soutq, lsout, lnote + 3, (ftnlen)80);
9117 	if (isgaft && ! iswaft) {
9118 /* Writing concatenation */
9119 	    i__2[0] = 1, a__1[0] = sq;
9120 	    i__2[1] = 2, a__1[1] = "sk";
9121 	    s_cat(ch__19, a__1, i__2, &c__2, (ftnlen)3);
9122 	    addstr_(ch__19, &c__3, soutq, lsout, (ftnlen)3, (ftnlen)80);
9123 	}
9124 /* Writing concatenation */
9125 	i__2[0] = 1, a__1[0] = sq;
9126 	i__2[1] = 9, a__1[1] = "resetsize";
9127 	s_cat(ch__20, a__1, i__2, &c__2, (ftnlen)10);
9128 	addstr_(ch__20, &c__10, soutq, lsout, (ftnlen)10, (ftnlen)80);
9129     }
9130     return 0;
9131 } /* dograce_ */
9132 
dopsslur_(integer * nolev,integer * isdat1,integer * isdat2,integer * isdat3,integer * isdat4,integer * nsdat,integer * ip,integer * iv,integer * kv,integer * nv,logical * beamon,integer * ncm,char * soutq,integer * lsout,char * ulq,integer * islur,integer * ipl,integer * iornq,integer * islhgt,real * tno,integer * nacc,ftnlen soutq_len,ftnlen ulq_len)9133 /* Subroutine */ int dopsslur_(integer *nolev, integer *isdat1, integer *
9134 	isdat2, integer *isdat3, integer *isdat4, integer *nsdat, integer *ip,
9135 	 integer *iv, integer *kv, integer *nv, logical *beamon, integer *ncm,
9136 	 char *soutq, integer *lsout, char *ulq, integer *islur, integer *ipl,
9137 	 integer *iornq, integer *islhgt, real *tno, integer *nacc, ftnlen
9138 	soutq_len, ftnlen ulq_len)
9139 {
9140     /* System generated locals */
9141     address a__1[3], a__2[4], a__3[2];
9142     integer i__1, i__2, i__3[3], i__4[4], i__5[2], i__6;
9143     char ch__1[1], ch__2[1], ch__3[6], ch__4[9];
9144     icilist ici__1;
9145 
9146     /* Builtin functions */
9147     integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char
9148 	    *, ftnlen), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen),
9149 	    e_wsfe(void);
9150     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
9151 	     char **, integer *, integer *, ftnlen);
9152     integer s_wsfi(icilist *), e_wsfi(void);
9153 
9154     /* Local variables */
9155     static integer ivoffinc;
9156     extern integer igetbits_(integer *, integer *, integer *);
9157     static integer j, icm;
9158     extern integer log2_(integer *);
9159     static integer imid;
9160     extern /* Character */ VOID chax_(char *, ftnlen, integer *), udfq_(char *
9161 	    , ftnlen, integer *, integer *), udqq_(char *, ftnlen, integer *,
9162 	    integer *, integer *, integer *, integer *, integer *);
9163     extern integer lfmt1_(real *);
9164     extern /* Subroutine */ int stop1_(void);
9165     static integer ihoff;
9166     static logical iscrd;
9167     static integer isdat, ivoff;
9168     static real shift;
9169     static integer iupdn, lform, lnote;
9170     static logical pstie;
9171     static char noteq[8];
9172     static integer idcode, isdata;
9173     extern /* Subroutine */ int addstr_(char *, integer *, char *, integer *,
9174 	    ftnlen, ftnlen);
9175     static logical settie;
9176     extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer
9177 	    *, ftnlen);
9178     static integer lnoten, nolevs;
9179     static logical stemup;
9180     static char notexq[79];
9181     extern /* Subroutine */ int setbits_(integer *, integer *, integer *,
9182 	    integer *);
9183     static integer numdrop;
9184     static char slurudq[1];
9185 
9186     /* Fortran I/O blocks */
9187     static cilist io___441 = { 0, 6, 0, 0, 0 };
9188     static cilist io___442 = { 0, 6, 0, 0, 0 };
9189     static cilist io___443 = { 0, 15, 0, "(/,a)", 0 };
9190     static cilist io___451 = { 0, 6, 0, 0, 0 };
9191 
9192 
9193 
9194 /*  Called once per main note. */
9195 /*  12 May 2002  Create this subroutine to isolate postscript slurs/ties. */
9196 /*    Always set \Nosluradjust\Notieadjust */
9197 
9198 /* 130316 */
9199 
9200 /*  Bits in isdat1: */
9201 /*  13-17    iv */
9202 /*  3-10     ip */
9203 /*  11       start/stop switch */
9204 /*  12       kv-1 */
9205 /*  19-25    ichar(code$) */
9206 /*  26       force direction? */
9207 /*  27       forced dir'n = up if on, set in sslur; also */
9208 /*           final direction, set in doslur when beam is started, used on term. */
9209 /*  28-31    mod(ndxslur,16), set in doslur when slur is started, used on term. */
9210 /*  18       int(ndxslur/16), ditto. So this allows ndxslur>15. */
9211 
9212 /*  Bits in isdat2 */
9213 /*  0        Chord switch.  Not set on main note. */
9214 /*  1-2      left/right notehead shift.  Set only for chord note. */
9215 /*  3        tie positioning */
9216 /*  4        dotted flag */
9217 /*  6-11     voff1 1-63  =>  -31...+31 */
9218 /*  12-18    hoff1 1-127 => -6.3...+6.3 */
9219 /*  19-25    nolev */
9220 /*  26       \sluradjust    (p+s) */
9221 /*  27       \nosluradjust  (p-s) */
9222 /*  28       \tieadjust     (p+t) */
9223 /*  29       \notieadjust   (p-t) */
9224 
9225 /*  Bits in isdat3: Only used for slur endings */
9226 /*  0        set if midslur (at least one argument) */
9227 /*  1        set if curve (2 more args) */
9228 /*  2-7      32+first arg (height correction) (1st arg may be negative) */
9229 /*  8-10     second arg (initial slope) */
9230 /*  11-13    third arg (closing slope) */
9231 /*  14-21    tie level for use in LineBreakTies */
9232 /*  22-29    ncm for use in LineBreakTies */
9233 
9234 /*  Bits in isdat4  Only used for linebreak slurs */
9235 /*  0-5      Linebreak seg 1 voff 1-63  =>  -31...+31 */
9236 /*  6-12     Linebreak seg 1 hoff 1-127 => -6.3...+6.3 */
9237 /*  16-21    Linebreak seg 2 voff 1-63  =>  -31...+31 */
9238 /*  22-28    Linebreak seg 2 hoff 1-127 => -6.3...+6.3 */
9239 
9240 /*  In listslur bit ib is on if slur index ib is in use, ib=0-13. */
9241 /*  ndxslur = slur index */
9242 /*  Height of slur is nole+ivoff+iupdn.  iupdn is +/-1 if t&s slurs on same note, */
9243 /*  s-slur is blank (idcode=32), t-slur is idcode=1. */
9244 /*  ivoff is user-defined shift or shift due to . or _ , or chord adjustment. */
9245 /*  Ivoff will be set for ./_ only if no user-defined shift is specified. */
9246 /*  If highest note has upslur, save slur height in islhgt in case */
9247 /*  ornament must be moved. */
9248 
9249     /* Parameter adjustments */
9250     --isdat4;
9251     --isdat3;
9252     --isdat2;
9253     --isdat1;
9254 
9255     /* Function Body */
9256     *islhgt = 0;
9257     if (*beamon) {
9258 	stemup = *(unsigned char *)ulq == 'u';
9259     } else if (commvl_1.nvmx[*iv - 1] == 2) {
9260 	if (! bit_test(*islur,30)) {
9261 
9262 /*  Single note, 2 lines of music, stem direction not forced */
9263 
9264 	    stemup = commvl_1.ivx > *nv;
9265 	} else {
9266 	    stemup = bit_test(*islur,17);
9267 	}
9268     } else {
9269 	udqq_(ch__1, (ftnlen)1, nolev, ncm, islur, &commvl_1.nvmx[*iv - 1], &
9270 		commvl_1.ivx, nv);
9271 	stemup = *(unsigned char *)&ch__1[0] == 'u';
9272     }
9273     iscrd = bit_test(*ipl,10);
9274     if (commidi_1.ismidi) {
9275 	settie = FALSE_;
9276 	comslm_1.dbltie = FALSE_;
9277     }
9278     i__1 = *nsdat;
9279     for (isdat = 1; isdat <= i__1; ++isdat) {
9280 	isdata = isdat1[isdat];
9281 	if (*iv == igetbits_(&isdata, &c__5, &c__13) && *ip == igetbits_(&
9282 		isdata, &c__8, &c__3) && *kv == igetbits_(&isdata, &c__1, &
9283 		c__12) + 1) {
9284 
9285 /*  Since iv and kv match, ivx will be correct */
9286 
9287 	    idcode = igetbits_(&isdata, &c__7, &c__19);
9288 	    ivoff = igetbits_(&isdat2[isdat], &c__6, &c__6) - 32;
9289 	    ihoff = igetbits_(&isdat2[isdat], &c__7, &c__12) - 64;
9290 	    iupdn = 0;
9291 	    *(unsigned char *)slurudq = 'd';
9292 	    nolevs = igetbits_(&isdat2[isdat], &c__7, &c__19);
9293 	    pstie = bit_test(isdat2[isdat],3) || idcode == 1;
9294 	    if (bit_test(isdata,11)) {
9295 
9296 /*  Turnon */
9297 
9298 /*            if (nolevs.eq.0 .or. nolevs.gt.60) then */
9299 /* c */
9300 /* c  Note was a rest, cannot start slur on rest. */
9301 /* c */
9302 /*              print* */
9303 /*              call printl('Cannot start slur on a rest') */
9304 /*              call stop1() */
9305 /*              nolevs = ncm+5 */
9306 /*            end if */
9307 
9308 /*  Get slur direction */
9309 
9310 		if (bit_test(isdata,26)) {
9311 
9312 /*  Force slur direction */
9313 
9314 		    if (bit_test(isdata,27)) {
9315 			*(unsigned char *)slurudq = 'u';
9316 		    }
9317 		} else if (commvl_1.nvmx[*iv - 1] == 1) {
9318 
9319 /*  Only one voice per line */
9320 
9321 		    if (! (*beamon)) {
9322 
9323 /*  Separate note. */
9324 
9325 			udfq_(ch__1, (ftnlen)1, nolev, ncm);
9326 			*(unsigned char *)slurudq = *(unsigned char *)&ch__1[
9327 				0];
9328 		    } else {
9329 
9330 /*  In a beam */
9331 
9332 			if (*(unsigned char *)ulq != 'u') {
9333 			    *(unsigned char *)slurudq = 'u';
9334 			}
9335 		    }
9336 		    if (iscrd) {
9337 			if (nolevs > *ncm) {
9338 			    *(unsigned char *)slurudq = 'u';
9339 			} else {
9340 			    *(unsigned char *)slurudq = 'd';
9341 			}
9342 		    }
9343 		} else {
9344 
9345 /*  Two voices per line.  Get default */
9346 
9347 		    if (commvl_1.ivx > *nv) {
9348 			*(unsigned char *)slurudq = 'u';
9349 		    }
9350 
9351 /*  Upper voice of the two, so up slur */
9352 
9353 		}
9354 
9355 /*  Set level for slur starting on rest */
9356 
9357 		if (nolevs == 0 || nolevs > 60) {
9358 		    if (*(unsigned char *)slurudq == 'u') {
9359 			nolevs = *ncm + 2;
9360 		    } else {
9361 			nolevs = *ncm - 2;
9362 		    }
9363 		}
9364 
9365 /*  Save up/down-ness for use at termination */
9366 
9367 		if (*(unsigned char *)slurudq == 'u') {
9368 		    isdata = bit_set(isdata,27);
9369 		}
9370 
9371 /*  End of section for setting slur direction, still in "Turnon" if-block. */
9372 
9373 		if (bit_test(*iornq,11) || bit_test(*iornq,12)) {
9374 
9375 /*  Raise or lower slur by one unit provided . or _ is on same side as slur */
9376 
9377 		    ivoffinc = 0;
9378 		    if (stemup && *(unsigned char *)slurudq == 'd' || !
9379 			    stemup && *(unsigned char *)slurudq == 'u') {
9380 
9381 /*  Must move the slur for _ or . */
9382 
9383 			if (stemup) {
9384 			    ivoffinc = -1;
9385 			} else {
9386 			    ivoffinc = 1;
9387 			}
9388 			if ((stemup && *nolev >= *ncm - 2 || ! stemup && *
9389 				nolev <= *ncm + 2) && (i__2 = *ncm - *nolev,
9390 				abs(i__2)) % 2 == 0) {
9391 			    ivoffinc <<= 1;
9392 			}
9393 			ivoff += ivoffinc;
9394 		    }
9395 		}
9396 		if (comslur_1.listslur == 16777215) {
9397 		    s_wsle(&io___441);
9398 		    e_wsle();
9399 		    s_wsle(&io___442);
9400 		    do_lio(&c__9, &c__1, "You1 defined the twentyfifth slur,"
9401 			    " one too many!", (ftnlen)48);
9402 		    e_wsle();
9403 		    s_wsfe(&io___443);
9404 		    do_fio(&c__1, "You defined the twentyfifth slur, one too"
9405 			    " many!", (ftnlen)47);
9406 		    e_wsfe();
9407 		    stop1_();
9408 		}
9409 
9410 /*  Get index of next slur not in use, starting from 12 down */
9411 
9412 		i__2 = 16777215 - comslur_1.listslur;
9413 		comslur_1.ndxslur = log2_(&i__2);
9414 /*      write(*,'()') */
9415 /*      write(*,'(2i4,2x,B24)')ivx,ndxslur,listslur */
9416 
9417 /*  Record slur index */
9418 
9419 		comslur_1.listslur = bit_set(comslur_1.listslur,
9420 			comslur_1.ndxslur);
9421 /*      write(*,'(10x,B24)')listslur */
9422 
9423 /*  Save for use on termination */
9424 
9425 /*            call setbits(isdata,4,28,ndxslur) */
9426 /*  080531  Allow >16 slurs */
9427 		i__2 = comslur_1.ndxslur % 16;
9428 		setbits_(&isdata, &c__4, &c__28, &i__2);
9429 		i__2 = comslur_1.ndxslur / 16;
9430 		setbits_(&isdata, &c__1, &c__18, &i__2);
9431 
9432 /*  Shift for stem? */
9433 
9434 		if (stemup && *(unsigned char *)slurudq == 'u' && *tno < 63.f)
9435 			 {
9436 		    if (! pstie) {
9437 			ihoff += 8;
9438 		    } else {
9439 			ihoff += 2;
9440 		    }
9441 		}
9442 		if (iscrd) {
9443 
9444 /*  Additional horiz shifts for h-shifted noteheads? */
9445 
9446 		    if (bit_test(isdat2[isdat],1)) {
9447 
9448 /*  Slur start on left-shifted chord notehead.  ASSUME downstem. */
9449 
9450 			if (nolevs == comtrill_1.minlev && *(unsigned char *)
9451 				slurudq == 'd') {
9452 			    ihoff += -2;
9453 			} else {
9454 			    ihoff += -10;
9455 			}
9456 		    } else if (bit_test(isdat2[isdat],2)) {
9457 
9458 /*  Right shifted chord notehead.  ASSUME upstem. */
9459 
9460 			if (nolevs == comtrill_1.maxlev && *(unsigned char *)
9461 				slurudq == 'u') {
9462 			    ihoff += 2;
9463 			} else {
9464 			    ihoff += 10;
9465 			}
9466 		    }
9467 		}
9468 		chax_(ch__1, (ftnlen)1, &c__92);
9469 		s_copy(notexq, ch__1, (ftnlen)79, (ftnlen)1);
9470 		lnote = 1;
9471 
9472 /*  Check for local adjustment default changes */
9473 
9474 		if (bit_test(isdat2[isdat],26)) {
9475 /* Writing concatenation */
9476 		    chax_(ch__1, (ftnlen)1, &c__92);
9477 		    i__3[0] = 1, a__1[0] = ch__1;
9478 		    i__3[1] = 10, a__1[1] = "sluradjust";
9479 		    chax_(ch__2, (ftnlen)1, &c__92);
9480 		    i__3[2] = 1, a__1[2] = ch__2;
9481 		    s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
9482 		    lnote = 12;
9483 		} else if (bit_test(isdat2[isdat],27)) {
9484 /* Writing concatenation */
9485 		    chax_(ch__1, (ftnlen)1, &c__92);
9486 		    i__3[0] = 1, a__1[0] = ch__1;
9487 		    i__3[1] = 12, a__1[1] = "nosluradjust";
9488 		    chax_(ch__2, (ftnlen)1, &c__92);
9489 		    i__3[2] = 1, a__1[2] = ch__2;
9490 		    s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
9491 		    lnote = 14;
9492 		} else if (bit_test(isdat2[isdat],28)) {
9493 /* Writing concatenation */
9494 		    chax_(ch__1, (ftnlen)1, &c__92);
9495 		    i__3[0] = 1, a__1[0] = ch__1;
9496 		    i__3[1] = 9, a__1[1] = "tieadjust";
9497 		    chax_(ch__2, (ftnlen)1, &c__92);
9498 		    i__3[2] = 1, a__1[2] = ch__2;
9499 		    s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
9500 		    lnote = 11;
9501 		} else if (bit_test(isdat2[isdat],29)) {
9502 /* Writing concatenation */
9503 		    chax_(ch__1, (ftnlen)1, &c__92);
9504 		    i__3[0] = 1, a__1[0] = ch__1;
9505 		    i__3[1] = 11, a__1[1] = "notieadjust";
9506 		    chax_(ch__2, (ftnlen)1, &c__92);
9507 		    i__3[2] = 1, a__1[2] = ch__2;
9508 		    s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
9509 		    lnote = 13;
9510 		}
9511 		if (ihoff == 0) {
9512 
9513 /*  Write stuff for non-shifted start */
9514 
9515 /* Writing concatenation */
9516 		    i__3[0] = lnote, a__1[0] = notexq;
9517 		    i__3[1] = 5, a__1[1] = "islur";
9518 		    i__3[2] = 1, a__1[2] = slurudq;
9519 		    s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
9520 		    lnote += 6;
9521 		} else {
9522 /* Writing concatenation */
9523 		    i__3[0] = lnote, a__1[0] = notexq;
9524 		    i__3[1] = 2, a__1[1] = "is";
9525 		    i__3[2] = 1, a__1[2] = slurudq;
9526 		    s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
9527 		    lnote += 3;
9528 		}
9529 
9530 /*  Prepend postscript tie switch */
9531 
9532 		if (pstie) {
9533 /* Writing concatenation */
9534 		    chax_(ch__1, (ftnlen)1, &c__92);
9535 		    i__4[0] = 1, a__2[0] = ch__1;
9536 		    i__4[1] = 8, a__2[1] = "tieforis";
9537 		    i__4[2] = 1, a__2[2] = slurudq;
9538 		    i__4[3] = lnote, a__2[3] = notexq;
9539 		    s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
9540 		    lnote += 10;
9541 		}
9542 		if (bit_test(isdat2[isdat],4)) {
9543 
9544 /*  Dotted slur */
9545 
9546 /*              noteq = notexq */
9547 /*              notexq = chax(92)//'dotted'//noteq */
9548 /* Writing concatenation */
9549 		    chax_(ch__1, (ftnlen)1, &c__92);
9550 		    i__3[0] = 1, a__1[0] = ch__1;
9551 		    i__3[1] = 6, a__1[1] = "dotted";
9552 		    i__3[2] = lnote, a__1[2] = notexq;
9553 		    s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
9554 		    lnote += 7;
9555 		}
9556 
9557 /*  Add slur index to string */
9558 /* c  Print 11-ndxslur */
9559 /*  Print 23-ndxslur */
9560 
9561 /*            if (11-ndxslur .lt. 10) then */
9562 		if (23 - comslur_1.ndxslur < 10) {
9563 
9564 /*  5/25/08 Allow 24 slurs */
9565 
9566 /*              notexq = notexq(1:lnote)//chax(59-ndxslur) */
9567 /* Writing concatenation */
9568 		    i__5[0] = lnote, a__3[0] = notexq;
9569 		    i__2 = 71 - comslur_1.ndxslur;
9570 		    chax_(ch__1, (ftnlen)1, &i__2);
9571 		    i__5[1] = 1, a__3[1] = ch__1;
9572 		    s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
9573 		    ++lnote;
9574 		} else if (23 - comslur_1.ndxslur < 20) {
9575 /*              notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */
9576 /* Writing concatenation */
9577 		    i__4[0] = lnote, a__2[0] = notexq;
9578 		    i__4[1] = 2, a__2[1] = "{1";
9579 		    i__2 = 61 - comslur_1.ndxslur;
9580 		    chax_(ch__1, (ftnlen)1, &i__2);
9581 		    i__4[2] = 1, a__2[2] = ch__1;
9582 		    i__4[3] = 1, a__2[3] = "}";
9583 		    s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
9584 		    lnote += 4;
9585 		} else {
9586 /* Writing concatenation */
9587 		    i__4[0] = lnote, a__2[0] = notexq;
9588 		    i__4[1] = 2, a__2[1] = "{2";
9589 		    i__2 = 51 - comslur_1.ndxslur;
9590 		    chax_(ch__1, (ftnlen)1, &i__2);
9591 		    i__4[2] = 1, a__2[2] = ch__1;
9592 		    i__4[3] = 1, a__2[3] = "}";
9593 		    s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
9594 		    lnote += 4;
9595 		}
9596 
9597 /*  Add note name to string */
9598 
9599 /*            call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm) */
9600 		*islhgt = nolevs + iupdn + ivoff;
9601 		notefq_(noteq, &lnoten, islhgt, ncm, (ftnlen)8);
9602 /* Writing concatenation */
9603 		i__5[0] = lnote, a__3[0] = notexq;
9604 		i__5[1] = lnoten, a__3[1] = noteq;
9605 		s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
9606 		lnote += lnoten;
9607 
9608 /*  Store height and staff mid level for use with LineBreakTies */
9609 
9610 		setbits_(&isdat3[isdat], &c__8, &c__14, islhgt);
9611 		setbits_(&isdat3[isdat], &c__8, &c__22, ncm);
9612 
9613 /*  Save height (for ornament and barnobox interference) if topmost slur is up */
9614 
9615 		if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[
9616 			isdat],0) || nolevs == comtrill_1.maxlev)) {
9617 		    *islhgt = nolevs + iupdn + ivoff;
9618 
9619 /*  Save height & idcode if top voice and slur start */
9620 
9621 		    if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv
9622 			    - 1] * 24 - 25] && *islhgt > comsln_1.is1n1) {
9623 			comsln_1.is1n1 = *islhgt;
9624 			comsln_1.is2n1 = idcode;
9625 		    }
9626 		}
9627 		if ((real) ihoff != 0.f) {
9628 		    shift = ihoff * .1f;
9629 /* Writing concatenation */
9630 		    i__5[0] = lnote, a__3[0] = notexq;
9631 		    i__5[1] = 1, a__3[1] = "{";
9632 		    s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
9633 		    ++lnote;
9634 		    lform = lfmt1_(&shift);
9635 		    i__2 = lnote;
9636 		    ici__1.icierr = 0;
9637 		    ici__1.icirnum = 1;
9638 		    ici__1.icirlen = lnote + lform - i__2;
9639 		    ici__1.iciunit = notexq + i__2;
9640 /* Writing concatenation */
9641 		    i__3[0] = 2, a__1[0] = "(f";
9642 		    i__6 = lform + 48;
9643 		    chax_(ch__1, (ftnlen)1, &i__6);
9644 		    i__3[1] = 1, a__1[1] = ch__1;
9645 		    i__3[2] = 3, a__1[2] = ".1)";
9646 		    ici__1.icifmt = (s_cat(ch__3, a__1, i__3, &c__3, (ftnlen)
9647 			    6), ch__3);
9648 		    s_wsfi(&ici__1);
9649 		    do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real));
9650 		    e_wsfi();
9651 		    lnote += lform;
9652 /* Writing concatenation */
9653 		    i__5[0] = lnote, a__3[0] = notexq;
9654 		    i__5[1] = 1, a__3[1] = "}";
9655 		    s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
9656 		    ++lnote;
9657 		}
9658 		addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
9659 
9660 /*  Zero out ip1 to avoid problems if slur goes to next input blk. */
9661 
9662 		setbits_(&isdata, &c__8, &c__3, &c__0);
9663 
9664 /*  Set slur-on data for midi.  Only treat null-index slurs and ps ties for now. */
9665 
9666 		if (commidi_1.ismidi && (idcode == 32 || idcode == 1)) {
9667 /*              levson(midchan(iv,kv)) = nolevs */
9668 /* 130316 */
9669 /*              levson(midchan(iv,kv)) = nolevs-iTransAmt(instno(iv)) */
9670 		    comslm_1.levson[commidi_1.midchan[*iv + *kv * 24 - 25]] =
9671 			    nolevs + commvel_1.miditran[cominsttrans_1.instno[
9672 			    *iv - 1] - 1];
9673 		    if (settie) {
9674 			comslm_1.dbltie = TRUE_;
9675 		    }
9676 
9677 /*  Only way settie=T is if we just set a tie ending.  So there's also a slur */
9678 /*   start here, so set a flag telling addmidi not to zero out levson */
9679 
9680 		}
9681 	    } else {
9682 
9683 /*  Slur is ending.  Back thru list to find starting slur */
9684 
9685 		for (j = isdat - 1; j >= 1; --j) {
9686 		    if (*iv == igetbits_(&isdat1[j], &c__5, &c__13) && *kv ==
9687 			    igetbits_(&isdat1[j], &c__1, &c__12) + 1) {
9688 			if (idcode == igetbits_(&isdat1[j], &c__7, &c__19)) {
9689 			    comslur_1.ndxslur = igetbits_(&isdat1[j], &c__4, &
9690 				    c__28) + (igetbits_(&isdat1[j], &c__1, &
9691 				    c__18) << 4);
9692 
9693 /*  080531 Allow >16 slurs */
9694 
9695 			    if (bit_test(isdat1[j],27)) {
9696 				*(unsigned char *)slurudq = 'u';
9697 			    }
9698 			    goto L4;
9699 			}
9700 		    }
9701 /* L3: */
9702 		}
9703 		s_wsle(&io___451);
9704 		do_lio(&c__9, &c__1, "Bad place in doslur", (ftnlen)19);
9705 		e_wsle();
9706 		stop1_();
9707 L4:
9708 
9709 /*  Bugfix 070901 for slur ending on rest in 2-voice staff */
9710 
9711 /*            if (nolevs.eq.0 .or. nolevs.gt.60) then */
9712 		if (nolevs <= 2 || nolevs > 60) {
9713 
9714 /*  Ending is on a rest, reset nolevs to default starting height */
9715 
9716 		    nolevs = igetbits_(&isdat2[j], &c__7, &c__19);
9717 		}
9718 		if (bit_test(isdat3[isdat],0) || bit_test(isdat3[j],0)) {
9719 
9720 /*  Deal with \curve or \midslur. isdat is ending, j is start. */
9721 
9722 		    if (bit_test(isdat3[isdat],0)) {
9723 			imid = igetbits_(&isdat3[isdat], &c__6, &c__2) - 32;
9724 		    } else {
9725 			imid = igetbits_(&isdat3[j], &c__6, &c__2) - 32;
9726 		    }
9727 
9728 /*  Postscript slurs, and \midslur adjustment is needed.  Invoke macro */
9729 /*   (from pmx.tex) that redefines \tslur as r'qd.  Tentative mapping: */
9730 /*       Abs(imid)  Postscript slur type */
9731 /*          1          f */
9732 /*          2-3        default */
9733 /*          4          h */
9734 /*          5          H */
9735 /*          6+         HH */
9736 
9737 /* Writing concatenation */
9738 		    chax_(ch__1, (ftnlen)1, &c__92);
9739 		    i__3[0] = 1, a__1[0] = ch__1;
9740 		    i__3[1] = 7, a__1[1] = "psforts";
9741 /* Computing MIN */
9742 		    i__6 = abs(imid);
9743 		    i__2 = min(i__6,6) + 48;
9744 		    chax_(ch__2, (ftnlen)1, &i__2);
9745 		    i__3[2] = 1, a__1[2] = ch__2;
9746 		    s_cat(ch__4, a__1, i__3, &c__3, (ftnlen)9);
9747 		    addstr_(ch__4, &c__9, soutq, lsout, (ftnlen)9, (ftnlen)80)
9748 			    ;
9749 		}
9750 
9751 /*  Shift slur ending for stem on any note? */
9752 
9753 		if (! stemup && *(unsigned char *)slurudq == 'd' && *tno <
9754 			63.f) {
9755 		    if (! pstie) {
9756 			ihoff += -8;
9757 		    } else {
9758 			ihoff += -3;
9759 		    }
9760 		}
9761 		if (iscrd) {
9762 
9763 /*  Shift termination for shifted notehead? */
9764 
9765 		    if (bit_test(isdat2[isdat],1)) {
9766 
9767 /*  Left-shifted chord notehead.  ASSUME downstem. */
9768 
9769 			if (nolevs == comtrill_1.minlev && *(unsigned char *)
9770 				slurudq == 'd') {
9771 			    ihoff += -2;
9772 			} else {
9773 			    ihoff += -10;
9774 			}
9775 		    } else if (bit_test(isdat2[isdat],2)) {
9776 
9777 /*  Right shifted chord notehead.  ASSUME upstem. */
9778 
9779 			if (nolevs == comtrill_1.maxlev && *(unsigned char *)
9780 				slurudq == 'u') {
9781 			    ihoff += 2;
9782 			} else {
9783 			    ihoff += 10;
9784 			}
9785 		    }
9786 		}
9787 		if (ihoff == 0) {
9788 /* Writing concatenation */
9789 		    chax_(ch__1, (ftnlen)1, &c__92);
9790 		    i__5[0] = 1, a__3[0] = ch__1;
9791 		    i__5[1] = 5, a__3[1] = "tslur";
9792 		    s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
9793 		    lnote = 6;
9794 		} else {
9795 
9796 /*  Shift needed */
9797 
9798 /* Writing concatenation */
9799 		    chax_(ch__1, (ftnlen)1, &c__92);
9800 		    i__5[0] = 1, a__3[0] = ch__1;
9801 		    i__5[1] = 2, a__3[1] = "ts";
9802 		    s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
9803 		    lnote = 3;
9804 		}
9805 
9806 /*  Switch to postscript tie */
9807 
9808 		if (pstie) {
9809 /* Writing concatenation */
9810 		    chax_(ch__1, (ftnlen)1, &c__92);
9811 		    i__3[0] = 1, a__1[0] = ch__1;
9812 		    i__3[1] = 8, a__1[1] = "tieforts";
9813 		    i__3[2] = lnote, a__1[2] = notexq;
9814 		    s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
9815 		    lnote += 9;
9816 		}
9817 
9818 /*  Print 13-ndxslur */
9819 /*  5/25/08 Allow 14 slurs */
9820 
9821 		if (23 - comslur_1.ndxslur < 10) {
9822 /* Writing concatenation */
9823 		    i__5[0] = lnote, a__3[0] = notexq;
9824 		    i__2 = 71 - comslur_1.ndxslur;
9825 		    chax_(ch__1, (ftnlen)1, &i__2);
9826 		    i__5[1] = 1, a__3[1] = ch__1;
9827 		    s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
9828 		    ++lnote;
9829 		} else if (23 - comslur_1.ndxslur < 20) {
9830 /* Writing concatenation */
9831 		    i__4[0] = lnote, a__2[0] = notexq;
9832 		    i__4[1] = 2, a__2[1] = "{1";
9833 		    i__2 = 61 - comslur_1.ndxslur;
9834 		    chax_(ch__1, (ftnlen)1, &i__2);
9835 		    i__4[2] = 1, a__2[2] = ch__1;
9836 		    i__4[3] = 1, a__2[3] = "}";
9837 		    s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
9838 		    lnote += 4;
9839 		} else {
9840 /* Writing concatenation */
9841 		    i__4[0] = lnote, a__2[0] = notexq;
9842 		    i__4[1] = 2, a__2[1] = "{2";
9843 		    i__2 = 51 - comslur_1.ndxslur;
9844 		    chax_(ch__1, (ftnlen)1, &i__2);
9845 		    i__4[2] = 1, a__2[2] = ch__1;
9846 		    i__4[3] = 1, a__2[3] = "}";
9847 		    s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
9848 		    lnote += 4;
9849 		}
9850 		if (bit_test(*iornq,11) || bit_test(*iornq,12)) {
9851 
9852 /*  Raise or lower slur by one unit provided . or _ is on same side as slur */
9853 
9854 		    ivoffinc = 0;
9855 		    if (stemup && *(unsigned char *)slurudq == 'd' || !
9856 			    stemup && *(unsigned char *)slurudq == 'u') {
9857 			if (stemup) {
9858 			    ivoffinc = -1;
9859 			} else {
9860 			    ivoffinc = 1;
9861 			}
9862 			if ((stemup && *nolev >= *ncm - 2 || ! stemup && *
9863 				nolev <= *ncm + 2) && (i__2 = *ncm - *nolev,
9864 				abs(i__2)) % 2 == 0) {
9865 			    ivoffinc <<= 1;
9866 			}
9867 		    }
9868 		    ivoff += ivoffinc;
9869 		}
9870 		i__2 = nolevs + iupdn + ivoff;
9871 		notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8);
9872 		if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[
9873 			isdat],0) || nolevs == comtrill_1.maxlev)) {
9874 		    *islhgt = nolevs + iupdn + ivoff;
9875 
9876 /*  If topvoice, upslur, and idcode checks, no more need to keep hgt for barno. */
9877 
9878 		    if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv
9879 			    - 1] * 24 - 25] && comsln_1.is1n1 > 0) {
9880 			if (idcode == comsln_1.is2n1) {
9881 			    comsln_1.is1n1 = 0;
9882 			}
9883 		    }
9884 		}
9885 /* Writing concatenation */
9886 		i__5[0] = lnote, a__3[0] = notexq;
9887 		i__5[1] = lnoten, a__3[1] = noteq;
9888 		s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
9889 		lnote += lnoten;
9890 		if (ihoff != 0) {
9891 		    shift = ihoff * .1f;
9892 /* Writing concatenation */
9893 		    i__5[0] = lnote, a__3[0] = notexq;
9894 		    i__5[1] = 1, a__3[1] = "{";
9895 		    s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
9896 		    ++lnote;
9897 		    lform = lfmt1_(&shift);
9898 		    i__2 = lnote;
9899 		    ici__1.icierr = 0;
9900 		    ici__1.icirnum = 1;
9901 		    ici__1.icirlen = lnote + lform - i__2;
9902 		    ici__1.iciunit = notexq + i__2;
9903 /* Writing concatenation */
9904 		    i__3[0] = 2, a__1[0] = "(f";
9905 		    i__6 = lform + 48;
9906 		    chax_(ch__1, (ftnlen)1, &i__6);
9907 		    i__3[1] = 1, a__1[1] = ch__1;
9908 		    i__3[2] = 3, a__1[2] = ".1)";
9909 		    ici__1.icifmt = (s_cat(ch__3, a__1, i__3, &c__3, (ftnlen)
9910 			    6), ch__3);
9911 		    s_wsfi(&ici__1);
9912 		    do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real));
9913 		    e_wsfi();
9914 		    lnote += lform;
9915 /* Writing concatenation */
9916 		    i__5[0] = lnote, a__3[0] = notexq;
9917 		    i__5[1] = 1, a__3[1] = "}";
9918 		    s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
9919 		    ++lnote;
9920 		}
9921 		addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
9922 
9923 /*  Clear the bit from list of slurs in use */
9924 
9925 		comslur_1.listslur = bit_clear(comslur_1.listslur,
9926 			comslur_1.ndxslur);
9927 
9928 /*  Zero out the entire strings for start and stop */
9929 
9930 		isdata = 0;
9931 		isdat2[isdat] = 0;
9932 		isdat3[isdat] = 0;
9933 		isdat4[isdat] = 0;
9934 		isdat1[j] = 0;
9935 		isdat2[j] = 0;
9936 		isdat3[j] = 0;
9937 		isdat4[j] = 0;
9938 
9939 /*  Set midi info for slur ending */
9940 
9941 		if (commidi_1.ismidi && (idcode == 32 || idcode == 1)) {
9942 		    icm = commidi_1.midchan[*iv + *kv * 24 - 25];
9943 		    if (comslm_1.slmon[icm]) {
9944 /*                if (nolevs.eq.levson(icm) .and. iand(7,nacc).eq.0) then */
9945 /* 130316 */
9946 /*                if (nolevs-iTransAmt(instno(iv)).eq.levson(icm) .and. */
9947 			if (nolevs + commvel_1.miditran[cominsttrans_1.instno[
9948 				*iv - 1] - 1] == comslm_1.levson[icm] && (7 &
9949 				*nacc) == 0) {
9950 
9951 /*  There is a tie here.  NB!!! assumed no accidental on 2nd member of tie. */
9952 
9953 /*                  levsoff(icm) = nolevs */
9954 /* 130316 */
9955 /*                  levsoff(icm) = nolevs-iTransAmt(instno(iv)) */
9956 			    comslm_1.levsoff[icm] = nolevs +
9957 				    commvel_1.miditran[cominsttrans_1.instno[*
9958 				    iv - 1] - 1];
9959 			    settie = TRUE_;
9960 			} else {
9961 			    comslm_1.levsoff[icm] = 0;
9962 			    comslm_1.levson[icm] = 0;
9963 			    comslm_1.slmon[icm] = FALSE_;
9964 			}
9965 		    }
9966 		}
9967 	    }
9968 	    isdat1[isdat] = isdata;
9969 	}
9970 /* L1: */
9971     }
9972 
9973 /*  Clear and collapse the slur data list */
9974 
9975     numdrop = 0;
9976     i__1 = *nsdat;
9977     for (isdat = 1; isdat <= i__1; ++isdat) {
9978 	if (isdat1[isdat] == 0) {
9979 	    ++numdrop;
9980 	} else if (numdrop > 0) {
9981 	    isdat1[isdat - numdrop] = isdat1[isdat];
9982 	    isdat2[isdat - numdrop] = isdat2[isdat];
9983 	    isdat3[isdat - numdrop] = isdat3[isdat];
9984 	    isdat4[isdat - numdrop] = isdat4[isdat];
9985 	    isdat1[isdat] = 0;
9986 	    isdat2[isdat] = 0;
9987 	    isdat3[isdat] = 0;
9988 	    isdat4[isdat] = 0;
9989 	}
9990 /* L2: */
9991     }
9992     *nsdat -= numdrop;
9993 /*      call report(nsdat,isdat1,isdat2) */
9994     return 0;
9995 } /* dopsslur_ */
9996 
doslur_(integer * nolev,integer * isdat1,integer * isdat2,integer * isdat3,integer * nsdat,integer * ip,integer * iv,integer * kv,integer * nv,logical * beamon,integer * ncm,char * soutq,integer * lsout,char * ulq,integer * islur,integer * ipl,integer * iornq,integer * islhgt,real * tno,integer * nacc,ftnlen soutq_len,ftnlen ulq_len)9997 /* Subroutine */ int doslur_(integer *nolev, integer *isdat1, integer *isdat2,
9998 	 integer *isdat3, integer *nsdat, integer *ip, integer *iv, integer *
9999 	kv, integer *nv, logical *beamon, integer *ncm, char *soutq, integer *
10000 	lsout, char *ulq, integer *islur, integer *ipl, integer *iornq,
10001 	integer *islhgt, real *tno, integer *nacc, ftnlen soutq_len, ftnlen
10002 	ulq_len)
10003 {
10004     /* System generated locals */
10005     address a__1[3], a__2[2], a__3[4];
10006     integer i__1, i__2, i__3[3], i__4[2], i__5[4], i__6;
10007     char ch__1[1], ch__2[6];
10008     icilist ici__1;
10009 
10010     /* Builtin functions */
10011     integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char
10012 	    *, ftnlen), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen),
10013 	    e_wsfe(void);
10014     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen),
10015 	     s_copy(char *, char *, ftnlen, ftnlen);
10016     integer s_wsfi(icilist *), e_wsfi(void);
10017 
10018     /* Local variables */
10019     static integer ivoffinc;
10020     extern integer igetbits_(integer *, integer *, integer *);
10021     static integer j, icm;
10022     extern integer log2_(integer *);
10023     static integer imid;
10024     extern /* Character */ VOID chax_(char *, ftnlen, integer *), udfq_(char *
10025 	    , ftnlen, integer *, integer *), udqq_(char *, ftnlen, integer *,
10026 	    integer *, integer *, integer *, integer *, integer *);
10027     extern integer lfmt1_(real *);
10028     extern /* Subroutine */ int stop1_(void);
10029     static integer ihoff;
10030     static logical iscrd;
10031     static integer isdat, ivoff;
10032     static real shift;
10033     static integer iupdn, lform, lnote;
10034     static char noteq[8];
10035     static logical tmove;
10036     static integer idcode, isdata;
10037     extern /* Subroutine */ int addstr_(char *, integer *, char *, integer *,
10038 	    ftnlen, ftnlen);
10039     static integer isdats;
10040     static logical settie, sfound, tfound;
10041     static integer isdatt;
10042     extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer
10043 	    *, ftnlen);
10044     static integer nolevt, nolevs;
10045     extern /* Subroutine */ int printl_(char *, ftnlen);
10046     static logical stemup;
10047     static char notexq[79];
10048     static integer lnoten;
10049     extern /* Subroutine */ int setbits_(integer *, integer *, integer *,
10050 	    integer *);
10051     static integer numdrop;
10052     static char slurudq[1];
10053 
10054     /* Fortran I/O blocks */
10055     static cilist io___472 = { 0, 6, 0, 0, 0 };
10056     static cilist io___474 = { 0, 6, 0, 0, 0 };
10057     static cilist io___475 = { 0, 6, 0, 0, 0 };
10058     static cilist io___476 = { 0, 15, 0, "(/,a)", 0 };
10059     static cilist io___484 = { 0, 6, 0, 0, 0 };
10060 
10061 
10062 
10063 /*  Called once per main note.  (5/26/02) for non-ps slurs only */
10064 
10065 /* 130316 */
10066 
10067 /*  Bits in isdat1: */
10068 /*  13-17    iv */
10069 /*  3-10     ip */
10070 /*  11       start/stop switch */
10071 /*  12       kv-1 */
10072 /*  19-25    ichar(code$) */
10073 /*  26       force direction? */
10074 /*  27       forced dir'n = up if on, set in sslur; also */
10075 /*           final direction, set in doslur when beam is started, used on term. */
10076 /*  28-31    ndxslur, set in doslur when beam is started, used on term. */
10077 
10078 /*  Bits in isdat2 */
10079 /*  0        Chord switch.  Not set on main note. */
10080 /*  1-2      left/right notehead shift.  Set only for chord note. */
10081 /*  3        tie positioning */
10082 /*  4        dotted flag */
10083 /*  6-11     voff1 1-63  =>  -31...+31 */
10084 /*  12-18    hoff1 1-127 => -6.3...+6.3 */
10085 /*  19-25    nolev */
10086 
10087 /*  Bits in isdat3: Only used for slur endings */
10088 /*  0        set if midslur (at least one argument) */
10089 /*  1        set if curve (2 more args) */
10090 /*  2-7      32+first arg (height correction) (1st arg may be negative) */
10091 /*  8-10     second arg (initial slope) */
10092 /*  11-13    third arg (closing slope) */
10093 
10094 /*  In listslur bit ib is on if slur index ib is in use, ib=0-23. */
10095 /*  ndxslur = slur index */
10096 /*  Height of slur is nole+ivoff+iupdn.  iupdn is +/-1 if t&s slurs on same note, */
10097 /*  s-slur is blank (idcode=32), t-slur is idcode=1. */
10098 /*  ivoff is user-defined shift or shift due to . or _ , or chord adjustment. */
10099 /*  Ivoff will be set for ./_ only if no user-defined shift is specified. */
10100 /*  If highest note has upslur, save slur height in islhgt in case */
10101 /*  ornament must be moved. */
10102 
10103     /* Parameter adjustments */
10104     --isdat3;
10105     --isdat2;
10106     --isdat1;
10107 
10108     /* Function Body */
10109     *islhgt = 0;
10110     if (*beamon) {
10111 	stemup = *(unsigned char *)ulq == 'u';
10112     } else if (commvl_1.nvmx[*iv - 1] == 2) {
10113 	if (! bit_test(*islur,30)) {
10114 
10115 /*  Single note, 2 lines of music, stem direction not forced */
10116 
10117 	    stemup = commvl_1.ivx > *nv;
10118 	} else {
10119 	    stemup = bit_test(*islur,17);
10120 	}
10121     } else {
10122 	udqq_(ch__1, (ftnlen)1, nolev, ncm, islur, &commvl_1.nvmx[*iv - 1], &
10123 		commvl_1.ivx, nv);
10124 	stemup = *(unsigned char *)&ch__1[0] == 'u';
10125     }
10126     iscrd = bit_test(*ipl,10);
10127     if (bit_test(*islur,1)) {
10128 
10129 /*  't'-slur (idcode=1) somewhere on this note.  Find it, check height against */
10130 /*    's'-slur (idcode=32) */
10131 
10132 	sfound = FALSE_;
10133 	tfound = FALSE_;
10134 	tmove = FALSE_;
10135 	i__1 = *nsdat;
10136 	for (isdat = 1; isdat <= i__1; ++isdat) {
10137 	    if (*iv == igetbits_(&isdat1[isdat], &c__5, &c__13) && *ip ==
10138 		    igetbits_(&isdat1[isdat], &c__8, &c__3) && *kv ==
10139 		    igetbits_(&isdat1[isdat], &c__1, &c__12) + 1) {
10140 		if (! tfound) {
10141 		    tfound = igetbits_(&isdat1[isdat], &c__7, &c__19) == 1;
10142 		    if (tfound) {
10143 			nolevt = igetbits_(&isdat2[isdat], &c__7, &c__19);
10144 			isdatt = isdat;
10145 			if (sfound) {
10146 			    goto L6;
10147 			}
10148 		    }
10149 		}
10150 		if (! sfound) {
10151 		    sfound = igetbits_(&isdat1[isdat], &c__7, &c__19) == 32;
10152 		    if (sfound) {
10153 			nolevs = igetbits_(&isdat2[isdat], &c__7, &c__19);
10154 			isdats = isdat;
10155 			if (tfound) {
10156 			    goto L6;
10157 			}
10158 		    }
10159 		}
10160 	    }
10161 /* L5: */
10162 	}
10163 
10164 /*  Will come thru here if there is a t with no s, so comment out the following */
10165 /*        print*,'Did not find s+t-slurs in doslur' */
10166 
10167 L6:
10168 	if (sfound && tfound) {
10169 	    tmove = nolevs == nolevt && (bit_test(isdat1[isdats],11) &&
10170 		    bit_test(isdat1[isdatt],11) || ! bit_test(isdat1[isdats],
10171 		    11) && ! bit_test(isdat1[isdatt],11));
10172 	}
10173 
10174 /*  Check if 2 starts or two stops */
10175 
10176 
10177 /*  This is a flag for later changing slur level, after we know slur dir'n. */
10178 
10179     }
10180     if (commidi_1.ismidi) {
10181 	settie = FALSE_;
10182 	comslm_1.dbltie = FALSE_;
10183     }
10184     i__1 = *nsdat;
10185     for (isdat = 1; isdat <= i__1; ++isdat) {
10186 	isdata = isdat1[isdat];
10187 	if (*iv == igetbits_(&isdata, &c__5, &c__13) && *ip == igetbits_(&
10188 		isdata, &c__8, &c__3) && *kv == igetbits_(&isdata, &c__1, &
10189 		c__12) + 1) {
10190 
10191 /*  Since iv and kv match, ivx will be correct */
10192 
10193 	    idcode = igetbits_(&isdata, &c__7, &c__19);
10194 	    ivoff = igetbits_(&isdat2[isdat], &c__6, &c__6) - 32;
10195 	    ihoff = igetbits_(&isdat2[isdat], &c__7, &c__12) - 64;
10196 	    iupdn = 0;
10197 	    *(unsigned char *)slurudq = 'd';
10198 	    nolevs = igetbits_(&isdat2[isdat], &c__7, &c__19);
10199 	    if (bit_test(isdata,11)) {
10200 
10201 /*  Turnon, */
10202 
10203 		if (nolevs == 0 || nolevs > 60) {
10204 
10205 /*  Note was a rest, cannot start slur on rest. */
10206 
10207 		    s_wsle(&io___472);
10208 		    e_wsle();
10209 		    printl_("Cannot start slur on a rest", (ftnlen)27);
10210 		    stop1_();
10211 		}
10212 
10213 /*  Get slur direction */
10214 
10215 		if (bit_test(isdata,26)) {
10216 
10217 /*  Force slur direction */
10218 
10219 		    if (bit_test(isdata,27)) {
10220 			*(unsigned char *)slurudq = 'u';
10221 		    }
10222 		} else if (commvl_1.nvmx[*iv - 1] == 1) {
10223 
10224 /*  Only one voice per line */
10225 
10226 		    if (! (*beamon)) {
10227 
10228 /*  Separate note. */
10229 
10230 			udfq_(ch__1, (ftnlen)1, nolev, ncm);
10231 			*(unsigned char *)slurudq = *(unsigned char *)&ch__1[
10232 				0];
10233 		    } else {
10234 
10235 /*  In a beam */
10236 
10237 			if (*(unsigned char *)ulq != 'u') {
10238 			    *(unsigned char *)slurudq = 'u';
10239 			}
10240 		    }
10241 		    if (iscrd) {
10242 			if (nolevs > *ncm) {
10243 			    *(unsigned char *)slurudq = 'u';
10244 			} else {
10245 			    *(unsigned char *)slurudq = 'd';
10246 			}
10247 		    }
10248 		} else {
10249 
10250 /*  Two voices per line.  Get default */
10251 
10252 		    if (commvl_1.ivx > *nv) {
10253 			*(unsigned char *)slurudq = 'u';
10254 		    }
10255 
10256 /*  Upper voice of the two, so up slur */
10257 
10258 		}
10259 
10260 /*  Save up/down-ness for use at termination */
10261 
10262 		if (*(unsigned char *)slurudq == 'u') {
10263 		    isdata = bit_set(isdata,27);
10264 		}
10265 
10266 /*  End of section for setting slur direction, still in "Turnon" if-block. */
10267 
10268 		if (idcode == 1 && tmove) {
10269 		    iupdn = 1;
10270 		    if (*(unsigned char *)slurudq == 'd') {
10271 			iupdn = -1;
10272 		    }
10273 		}
10274 		if (bit_test(*iornq,11) || bit_test(*iornq,12)) {
10275 
10276 /*  Raise or lower slur by one unit provided . or _ is on same side as slur */
10277 
10278 		    ivoffinc = 0;
10279 		    if (stemup && *(unsigned char *)slurudq == 'd' || !
10280 			    stemup && *(unsigned char *)slurudq == 'u') {
10281 
10282 /*  Must move the slur for _ or . */
10283 
10284 			if (stemup) {
10285 			    ivoffinc = -1;
10286 			} else {
10287 			    ivoffinc = 1;
10288 			}
10289 			if ((stemup && *nolev >= *ncm - 2 || ! stemup && *
10290 				nolev <= *ncm + 2) && (i__2 = *ncm - *nolev,
10291 				abs(i__2)) % 2 == 0) {
10292 			    ivoffinc <<= 1;
10293 			}
10294 			ivoff += ivoffinc;
10295 		    }
10296 		}
10297 		if (comslur_1.listslur == 16777215) {
10298 		    s_wsle(&io___474);
10299 		    e_wsle();
10300 		    s_wsle(&io___475);
10301 		    do_lio(&c__9, &c__1, "You1 defined the twenty-fifth slur"
10302 			    ", one too many!", (ftnlen)49);
10303 		    e_wsle();
10304 		    s_wsfe(&io___476);
10305 		    do_fio(&c__1, "You2 defined the twenty-fifth slur, one t"
10306 			    "oo many!", (ftnlen)49);
10307 		    e_wsfe();
10308 		    stop1_();
10309 		}
10310 
10311 /*  Get index of next slur not in use, starting from ? down */
10312 
10313 		i__2 = 16777215 - comslur_1.listslur;
10314 		comslur_1.ndxslur = log2_(&i__2);
10315 
10316 /*  Record slur index */
10317 
10318 		comslur_1.listslur = bit_set(comslur_1.listslur,
10319 			comslur_1.ndxslur);
10320 
10321 /*  Save for use on termination */
10322 
10323 /*            call setbits(isdata,4,28,ndxslur) */
10324 /*  080531  Allow >16 slurs */
10325 		i__2 = comslur_1.ndxslur % 16;
10326 		setbits_(&isdata, &c__4, &c__28, &i__2);
10327 		i__2 = comslur_1.ndxslur / 16;
10328 		setbits_(&isdata, &c__1, &c__18, &i__2);
10329 
10330 /*  Shift for stem? */
10331 
10332 		if (stemup && *(unsigned char *)slurudq == 'u' && *tno < 63.f)
10333 			 {
10334 		    ihoff += 8;
10335 		}
10336 		if (bit_test(isdat2[isdat],3)) {
10337 
10338 /*  Tie spacing, (slur start) */
10339 
10340 		    if (*(unsigned char *)slurudq == 'd') {
10341 			++ivoff;
10342 			ihoff += 8;
10343 		    } else if (*(unsigned char *)slurudq == 'u') {
10344 			--ivoff;
10345 			if (! (stemup && *tno < 63.f)) {
10346 			    ihoff += 8;
10347 			}
10348 
10349 /*  (already shifted if (stemup.and.tno.gt.63.) and slurudq='u') */
10350 
10351 		    }
10352 		}
10353 		if (iscrd) {
10354 
10355 /*  Additional horiz shifts for h-shifted noteheads? */
10356 
10357 		    if (bit_test(isdat2[isdat],1)) {
10358 
10359 /*  Slur start on left-shifted chord notehead.  ASSUME downstem. */
10360 
10361 			if (nolevs == comtrill_1.minlev && *(unsigned char *)
10362 				slurudq == 'd') {
10363 			    ihoff += -2;
10364 			} else {
10365 			    ihoff += -10;
10366 			}
10367 		    } else if (bit_test(isdat2[isdat],2)) {
10368 
10369 /*  Right shifted chord notehead.  ASSUME upstem. */
10370 
10371 			if (nolevs == comtrill_1.maxlev && *(unsigned char *)
10372 				slurudq == 'u') {
10373 			    ihoff += 2;
10374 			} else {
10375 			    ihoff += 10;
10376 			}
10377 		    }
10378 		}
10379 		if (ihoff == 0) {
10380 
10381 /*  Write stuff for non-shifted start */
10382 
10383 /* Writing concatenation */
10384 		    chax_(ch__1, (ftnlen)1, &c__92);
10385 		    i__3[0] = 1, a__1[0] = ch__1;
10386 		    i__3[1] = 5, a__1[1] = "islur";
10387 		    i__3[2] = 1, a__1[2] = slurudq;
10388 		    s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
10389 		    lnote = 7;
10390 		} else {
10391 /* Writing concatenation */
10392 		    chax_(ch__1, (ftnlen)1, &c__92);
10393 		    i__3[0] = 1, a__1[0] = ch__1;
10394 		    i__3[1] = 2, a__1[1] = "is";
10395 		    i__3[2] = 1, a__1[2] = slurudq;
10396 		    s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
10397 		    lnote = 4;
10398 		}
10399 		if (bit_test(isdat2[isdat],4)) {
10400 
10401 /*  Dotted slur */
10402 
10403 		    s_copy(noteq, notexq, (ftnlen)8, (ftnlen)79);
10404 /* Writing concatenation */
10405 		    chax_(ch__1, (ftnlen)1, &c__92);
10406 		    i__3[0] = 1, a__1[0] = ch__1;
10407 		    i__3[1] = 6, a__1[1] = "dotted";
10408 		    i__3[2] = 8, a__1[2] = noteq;
10409 		    s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
10410 		    lnote += 7;
10411 		}
10412 
10413 /*  Add slur index to string */
10414 /* c  Print 11-ndxslur */
10415 /*  Print 23-ndxslur */
10416 
10417 /*            if (11-ndxslur .lt. 10) then */
10418 		if (23 - comslur_1.ndxslur < 10) {
10419 
10420 /*  5/25/08 Allow 24 slurs */
10421 
10422 /*              notexq = notexq(1:lnote)//chax(59-ndxslur) */
10423 /* Writing concatenation */
10424 		    i__4[0] = lnote, a__2[0] = notexq;
10425 		    i__2 = 71 - comslur_1.ndxslur;
10426 		    chax_(ch__1, (ftnlen)1, &i__2);
10427 		    i__4[1] = 1, a__2[1] = ch__1;
10428 		    s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
10429 		    ++lnote;
10430 		} else if (23 - comslur_1.ndxslur < 20) {
10431 /*              notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */
10432 /* Writing concatenation */
10433 		    i__5[0] = lnote, a__3[0] = notexq;
10434 		    i__5[1] = 2, a__3[1] = "{1";
10435 		    i__2 = 61 - comslur_1.ndxslur;
10436 		    chax_(ch__1, (ftnlen)1, &i__2);
10437 		    i__5[2] = 1, a__3[2] = ch__1;
10438 		    i__5[3] = 1, a__3[3] = "}";
10439 		    s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79);
10440 		    lnote += 4;
10441 		} else {
10442 /* Writing concatenation */
10443 		    i__5[0] = lnote, a__3[0] = notexq;
10444 		    i__5[1] = 2, a__3[1] = "{2";
10445 		    i__2 = 51 - comslur_1.ndxslur;
10446 		    chax_(ch__1, (ftnlen)1, &i__2);
10447 		    i__5[2] = 1, a__3[2] = ch__1;
10448 		    i__5[3] = 1, a__3[3] = "}";
10449 		    s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79);
10450 		    lnote += 4;
10451 		}
10452 
10453 /*  Add note name to string */
10454 
10455 		i__2 = nolevs + iupdn + ivoff;
10456 		notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8);
10457 /* Writing concatenation */
10458 		i__4[0] = lnote, a__2[0] = notexq;
10459 		i__4[1] = lnoten, a__2[1] = noteq;
10460 		s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
10461 		lnote += lnoten;
10462 
10463 /*  Save height (for ornament and barnobox interference) if topmost slur is up */
10464 
10465 		if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[
10466 			isdat],0) || nolevs == comtrill_1.maxlev)) {
10467 		    *islhgt = nolevs + iupdn + ivoff;
10468 
10469 /*  Save height & idcode if top voice and slur start */
10470 
10471 		    if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv
10472 			    - 1] * 24 - 25] && *islhgt > comsln_1.is1n1) {
10473 			comsln_1.is1n1 = *islhgt;
10474 			comsln_1.is2n1 = idcode;
10475 		    }
10476 		}
10477 		if ((real) ihoff != 0.f) {
10478 		    shift = ihoff * .1f;
10479 /* Writing concatenation */
10480 		    i__4[0] = lnote, a__2[0] = notexq;
10481 		    i__4[1] = 1, a__2[1] = "{";
10482 		    s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
10483 		    ++lnote;
10484 		    lform = lfmt1_(&shift);
10485 		    i__2 = lnote;
10486 		    ici__1.icierr = 0;
10487 		    ici__1.icirnum = 1;
10488 		    ici__1.icirlen = lnote + lform - i__2;
10489 		    ici__1.iciunit = notexq + i__2;
10490 /* Writing concatenation */
10491 		    i__3[0] = 2, a__1[0] = "(f";
10492 		    i__6 = lform + 48;
10493 		    chax_(ch__1, (ftnlen)1, &i__6);
10494 		    i__3[1] = 1, a__1[1] = ch__1;
10495 		    i__3[2] = 3, a__1[2] = ".1)";
10496 		    ici__1.icifmt = (s_cat(ch__2, a__1, i__3, &c__3, (ftnlen)
10497 			    6), ch__2);
10498 		    s_wsfi(&ici__1);
10499 		    do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real));
10500 		    e_wsfi();
10501 		    lnote += lform;
10502 /* Writing concatenation */
10503 		    i__4[0] = lnote, a__2[0] = notexq;
10504 		    i__4[1] = 1, a__2[1] = "}";
10505 		    s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
10506 		    ++lnote;
10507 		}
10508 		addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
10509 
10510 /*  Zero out ip1 to avoid problems if slur goes to next input blk. */
10511 
10512 		setbits_(&isdata, &c__8, &c__3, &c__0);
10513 
10514 /*  Set slur-on data for midi.  Only treat null-index slurs and ps ties for now. */
10515 
10516 		if (commidi_1.ismidi && idcode == 32) {
10517 /*              levson(midchan(iv,kv)) = nolevs */
10518 /* 130316 */
10519 /*              levson(midchan(iv,kv)) = nolevs-iTransAmt(instno(iv)) */
10520 		    comslm_1.levson[commidi_1.midchan[*iv + *kv * 24 - 25]] =
10521 			    nolevs + commvel_1.miditran[cominsttrans_1.instno[
10522 			    *iv - 1] - 1];
10523 		    if (settie) {
10524 			comslm_1.dbltie = TRUE_;
10525 		    }
10526 
10527 /*  Only way settie=T is if we just set a tie ending.  So there's also a slur */
10528 /*   start here, so set a flag telling addmidi not to zero out levson */
10529 
10530 		}
10531 	    } else {
10532 
10533 /*  Slur is ending.  Back thru list to find starting slur */
10534 
10535 		for (j = isdat - 1; j >= 1; --j) {
10536 		    if (*iv == igetbits_(&isdat1[j], &c__5, &c__13) && *kv ==
10537 			    igetbits_(&isdat1[j], &c__1, &c__12) + 1) {
10538 			if (idcode == igetbits_(&isdat1[j], &c__7, &c__19)) {
10539 			    comslur_1.ndxslur = igetbits_(&isdat1[j], &c__4, &
10540 				    c__28) + (igetbits_(&isdat1[j], &c__1, &
10541 				    c__18) << 4);
10542 
10543 /*  080531 Allow >16 slurs */
10544 
10545 			    if (bit_test(isdat1[j],27)) {
10546 				*(unsigned char *)slurudq = 'u';
10547 			    }
10548 			    goto L4;
10549 			}
10550 		    }
10551 /* L3: */
10552 		}
10553 		s_wsle(&io___484);
10554 		do_lio(&c__9, &c__1, "Bad place in doslur", (ftnlen)19);
10555 		e_wsle();
10556 		stop1_();
10557 L4:
10558 		if (nolevs == 0 || nolevs > 60) {
10559 
10560 /*  Ending is on a rest, reset nolevs to default starting height */
10561 
10562 		    nolevs = igetbits_(&isdat2[j], &c__7, &c__19);
10563 		}
10564 		if (bit_test(isdat3[isdat],0)) {
10565 
10566 /*  Deal with \curve or \midslur */
10567 
10568 		    imid = igetbits_(&isdat3[isdat], &c__6, &c__2) - 32;
10569 
10570 /*  Remember, only dealing with non-ps slurs */
10571 
10572 /*  Who knows where the following line came from.  Removed it 6/30/02 to */
10573 /*  restore behavior of non-ps slurs to old way */
10574 /*              if (slurudq .eq. 'd') imid = -imid */
10575 /*  3/8/03 added the following */
10576 
10577 		    if (*(unsigned char *)slurudq == 'd') {
10578 			imid = -abs(imid);
10579 		    }
10580 
10581 		    if (bit_test(isdat3[isdat],1)) {
10582 /* Writing concatenation */
10583 			chax_(ch__1, (ftnlen)1, &c__92);
10584 			i__4[0] = 1, a__2[0] = ch__1;
10585 			i__4[1] = 5, a__2[1] = "curve";
10586 			s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
10587 			lnote = 6;
10588 		    } else {
10589 /* Writing concatenation */
10590 			chax_(ch__1, (ftnlen)1, &c__92);
10591 			i__4[0] = 1, a__2[0] = ch__1;
10592 			i__4[1] = 7, a__2[1] = "midslur";
10593 			s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
10594 			lnote = 8;
10595 		    }
10596 		    if (imid < 0 || imid > 9) {
10597 
10598 /*  Need brackets */
10599 
10600 /* Writing concatenation */
10601 			i__4[0] = lnote, a__2[0] = notexq;
10602 			i__4[1] = 1, a__2[1] = "{";
10603 			s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
10604 			++lnote;
10605 			if (imid < -9) {
10606 			    i__2 = lnote;
10607 			    ici__1.icierr = 0;
10608 			    ici__1.icirnum = 1;
10609 			    ici__1.icirlen = lnote + 3 - i__2;
10610 			    ici__1.iciunit = notexq + i__2;
10611 			    ici__1.icifmt = "(i3)";
10612 			    s_wsfi(&ici__1);
10613 			    do_fio(&c__1, (char *)&imid, (ftnlen)sizeof(
10614 				    integer));
10615 			    e_wsfi();
10616 			    lnote += 3;
10617 			} else if (imid < 0 || imid > 9) {
10618 			    i__2 = lnote;
10619 			    ici__1.icierr = 0;
10620 			    ici__1.icirnum = 1;
10621 			    ici__1.icirlen = lnote + 2 - i__2;
10622 			    ici__1.iciunit = notexq + i__2;
10623 			    ici__1.icifmt = "(i2)";
10624 			    s_wsfi(&ici__1);
10625 			    do_fio(&c__1, (char *)&imid, (ftnlen)sizeof(
10626 				    integer));
10627 			    e_wsfi();
10628 			    lnote += 2;
10629 			} else {
10630 			    i__2 = lnote;
10631 			    ici__1.icierr = 0;
10632 			    ici__1.icirnum = 1;
10633 			    ici__1.icirlen = lnote + 1 - i__2;
10634 			    ici__1.iciunit = notexq + i__2;
10635 			    ici__1.icifmt = "(i1)";
10636 			    s_wsfi(&ici__1);
10637 			    do_fio(&c__1, (char *)&imid, (ftnlen)sizeof(
10638 				    integer));
10639 			    e_wsfi();
10640 			    ++lnote;
10641 			}
10642 /* Writing concatenation */
10643 			i__4[0] = lnote, a__2[0] = notexq;
10644 			i__4[1] = 1, a__2[1] = "}";
10645 			s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
10646 			++lnote;
10647 		    } else {
10648 
10649 /*  1=<imid=<9, no brackets */
10650 
10651 /* Writing concatenation */
10652 			i__4[0] = lnote, a__2[0] = notexq;
10653 			*(unsigned char *)&ch__1[0] = imid + 48;
10654 			i__4[1] = 1, a__2[1] = ch__1;
10655 			s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
10656 			++lnote;
10657 		    }
10658 		    if (bit_test(isdat3[isdat],1)) {
10659 
10660 /*  \curve; 3 args */
10661 
10662 /* Writing concatenation */
10663 			i__4[0] = lnote, a__2[0] = notexq;
10664 			*(unsigned char *)&ch__1[0] = igetbits_(&isdat3[isdat]
10665 				, &c__3, &c__8) + 48;
10666 			i__4[1] = 1, a__2[1] = ch__1;
10667 			s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
10668 /* Writing concatenation */
10669 			i__4[0] = lnote + 1, a__2[0] = notexq;
10670 			*(unsigned char *)&ch__1[0] = igetbits_(&isdat3[isdat]
10671 				, &c__3, &c__11) + 48;
10672 			i__4[1] = 1, a__2[1] = ch__1;
10673 			s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
10674 			lnote += 2;
10675 		    }
10676 		    addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)
10677 			    80);
10678 		}
10679 
10680 /*  Shift slur ending for stem on any note? */
10681 
10682 		if (! stemup && *(unsigned char *)slurudq == 'd' && *tno <
10683 			63.f) {
10684 		    ihoff += -8;
10685 		}
10686 		if (bit_test(isdat2[isdat],3)) {
10687 
10688 /*  Shift ending for tie spacing */
10689 
10690 		    if (*(unsigned char *)slurudq == 'u') {
10691 			ihoff += -8;
10692 			--ivoff;
10693 		    } else if (*(unsigned char *)slurudq == 'd') {
10694 			++ivoff;
10695 			if (stemup || *tno > 63.f) {
10696 			    ihoff += -8;
10697 			}
10698 		    }
10699 		}
10700 		if (iscrd) {
10701 
10702 /*  Shift termination for shifted notehead? */
10703 
10704 		    if (bit_test(isdat2[isdat],1)) {
10705 
10706 /*  Left-shifted chord notehead.  ASSUME downstem. */
10707 
10708 			if (nolevs == comtrill_1.minlev && *(unsigned char *)
10709 				slurudq == 'd') {
10710 			    ihoff += -2;
10711 			} else {
10712 			    ihoff += -10;
10713 			}
10714 		    } else if (bit_test(isdat2[isdat],2)) {
10715 
10716 /*  Right shifted chord notehead.  ASSUME upstem. */
10717 
10718 			if (nolevs == comtrill_1.maxlev && *(unsigned char *)
10719 				slurudq == 'u') {
10720 			    ihoff += 2;
10721 			} else {
10722 			    ihoff += 10;
10723 			}
10724 		    }
10725 		}
10726 		if (ihoff == 0) {
10727 /* Writing concatenation */
10728 		    chax_(ch__1, (ftnlen)1, &c__92);
10729 		    i__4[0] = 1, a__2[0] = ch__1;
10730 		    i__4[1] = 5, a__2[1] = "tslur";
10731 		    s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
10732 		    lnote = 6;
10733 		} else {
10734 
10735 /*  Shift needed */
10736 
10737 /* Writing concatenation */
10738 		    chax_(ch__1, (ftnlen)1, &c__92);
10739 		    i__4[0] = 1, a__2[0] = ch__1;
10740 		    i__4[1] = 2, a__2[1] = "ts";
10741 		    s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
10742 		    lnote = 3;
10743 		}
10744 
10745 /*  Print 23-ndxslur */
10746 /*  5/25/08 Allow 14 slurs (???????????) */
10747 
10748 		if (23 - comslur_1.ndxslur < 10) {
10749 /* Writing concatenation */
10750 		    i__4[0] = lnote, a__2[0] = notexq;
10751 		    i__2 = 71 - comslur_1.ndxslur;
10752 		    chax_(ch__1, (ftnlen)1, &i__2);
10753 		    i__4[1] = 1, a__2[1] = ch__1;
10754 		    s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
10755 		    ++lnote;
10756 		} else if (23 - comslur_1.ndxslur < 20) {
10757 /* Writing concatenation */
10758 		    i__5[0] = lnote, a__3[0] = notexq;
10759 		    i__5[1] = 2, a__3[1] = "{1";
10760 		    i__2 = 61 - comslur_1.ndxslur;
10761 		    chax_(ch__1, (ftnlen)1, &i__2);
10762 		    i__5[2] = 1, a__3[2] = ch__1;
10763 		    i__5[3] = 1, a__3[3] = "}";
10764 		    s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79);
10765 		    lnote += 4;
10766 		} else {
10767 /* Writing concatenation */
10768 		    i__5[0] = lnote, a__3[0] = notexq;
10769 		    i__5[1] = 2, a__3[1] = "{2";
10770 		    i__2 = 51 - comslur_1.ndxslur;
10771 		    chax_(ch__1, (ftnlen)1, &i__2);
10772 		    i__5[2] = 1, a__3[2] = ch__1;
10773 		    i__5[3] = 1, a__3[3] = "}";
10774 		    s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79);
10775 		    lnote += 4;
10776 		}
10777 		if (bit_test(*iornq,11) || bit_test(*iornq,12)) {
10778 
10779 /*  Raise or lower slur by one unit provided . or _ is on same side as slur */
10780 
10781 		    ivoffinc = 0;
10782 		    if (stemup && *(unsigned char *)slurudq == 'd' || !
10783 			    stemup && *(unsigned char *)slurudq == 'u') {
10784 			if (stemup) {
10785 			    ivoffinc = -1;
10786 			} else {
10787 			    ivoffinc = 1;
10788 			}
10789 			if ((stemup && *nolev >= *ncm - 2 || ! stemup && *
10790 				nolev <= *ncm + 2) && (i__2 = *ncm - *nolev,
10791 				abs(i__2)) % 2 == 0) {
10792 			    ivoffinc <<= 1;
10793 			}
10794 		    }
10795 		    ivoff += ivoffinc;
10796 		}
10797 		if (idcode == 1 && tmove) {
10798 
10799 /*  t-slur height adjustment */
10800 
10801 		    iupdn = 1;
10802 		    if (*(unsigned char *)slurudq == 'd') {
10803 			iupdn = -1;
10804 		    }
10805 		}
10806 		i__2 = nolevs + iupdn + ivoff;
10807 		notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8);
10808 		if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[
10809 			isdat],0) || nolevs == comtrill_1.maxlev)) {
10810 		    *islhgt = nolevs + iupdn + ivoff;
10811 
10812 /*  If topvoice, upslur, and idcode checks, no more need to keep hgt for barno. */
10813 
10814 		    if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv
10815 			    - 1] * 24 - 25] && comsln_1.is1n1 > 0) {
10816 			if (idcode == comsln_1.is2n1) {
10817 			    comsln_1.is1n1 = 0;
10818 			}
10819 		    }
10820 		}
10821 /* Writing concatenation */
10822 		i__4[0] = lnote, a__2[0] = notexq;
10823 		i__4[1] = lnoten, a__2[1] = noteq;
10824 		s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
10825 		lnote += lnoten;
10826 		if (ihoff != 0) {
10827 		    shift = ihoff * .1f;
10828 /* Writing concatenation */
10829 		    i__4[0] = lnote, a__2[0] = notexq;
10830 		    i__4[1] = 1, a__2[1] = "{";
10831 		    s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
10832 		    ++lnote;
10833 		    lform = lfmt1_(&shift);
10834 		    i__2 = lnote;
10835 		    ici__1.icierr = 0;
10836 		    ici__1.icirnum = 1;
10837 		    ici__1.icirlen = lnote + lform - i__2;
10838 		    ici__1.iciunit = notexq + i__2;
10839 /* Writing concatenation */
10840 		    i__3[0] = 2, a__1[0] = "(f";
10841 		    i__6 = lform + 48;
10842 		    chax_(ch__1, (ftnlen)1, &i__6);
10843 		    i__3[1] = 1, a__1[1] = ch__1;
10844 		    i__3[2] = 3, a__1[2] = ".1)";
10845 		    ici__1.icifmt = (s_cat(ch__2, a__1, i__3, &c__3, (ftnlen)
10846 			    6), ch__2);
10847 		    s_wsfi(&ici__1);
10848 		    do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real));
10849 		    e_wsfi();
10850 		    lnote += lform;
10851 /* Writing concatenation */
10852 		    i__4[0] = lnote, a__2[0] = notexq;
10853 		    i__4[1] = 1, a__2[1] = "}";
10854 		    s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
10855 		    ++lnote;
10856 		}
10857 		addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
10858 
10859 /*  Clear the bit from list of slurs in use */
10860 
10861 		comslur_1.listslur = bit_clear(comslur_1.listslur,
10862 			comslur_1.ndxslur);
10863 
10864 /*  Zero out the entire strings for start and stop */
10865 
10866 		isdata = 0;
10867 		isdat2[isdat] = 0;
10868 		isdat1[j] = 0;
10869 		isdat2[j] = 0;
10870 		isdat3[isdat] = 0;
10871 
10872 /*  Set midi info for slur ending */
10873 
10874 		if (commidi_1.ismidi && idcode == 32) {
10875 		    icm = commidi_1.midchan[*iv + *kv * 24 - 25];
10876 		    if (comslm_1.slmon[icm]) {
10877 /*                if (nolevs.eq.levson(icm) .and. iand(7,nacc).eq.0) then */
10878 /* 130316 */
10879 /*                if (nolevs-iTransAmt(instno(iv)).eq.levson(icm) .and. */
10880 			if (nolevs + commvel_1.miditran[cominsttrans_1.instno[
10881 				*iv - 1] - 1] == comslm_1.levson[icm] && (7 &
10882 				*nacc) == 0) {
10883 
10884 /*  There is a tie here.  NB!!! assumed no accidental on 2nd member of tie. */
10885 
10886 /*                  levsoff(icm) = nolevs */
10887 /* 130316 */
10888 /*                  levsoff(icm) = nolevs-iTransAmt(instno(iv)) */
10889 			    comslm_1.levsoff[icm] = nolevs +
10890 				    commvel_1.miditran[cominsttrans_1.instno[*
10891 				    iv - 1] - 1];
10892 			    settie = TRUE_;
10893 			} else {
10894 			    comslm_1.levsoff[icm] = 0;
10895 			    comslm_1.levson[icm] = 0;
10896 			    comslm_1.slmon[icm] = FALSE_;
10897 			}
10898 		    }
10899 		}
10900 	    }
10901 	    isdat1[isdat] = isdata;
10902 	}
10903 /* L1: */
10904     }
10905 
10906 /*  Clear and collapse the slur data list */
10907 
10908     numdrop = 0;
10909     i__1 = *nsdat;
10910     for (isdat = 1; isdat <= i__1; ++isdat) {
10911 	if (isdat1[isdat] == 0) {
10912 	    ++numdrop;
10913 	} else if (numdrop > 0) {
10914 	    isdat1[isdat - numdrop] = isdat1[isdat];
10915 	    isdat2[isdat - numdrop] = isdat2[isdat];
10916 	    isdat3[isdat - numdrop] = isdat3[isdat];
10917 	    isdat1[isdat] = 0;
10918 	    isdat2[isdat] = 0;
10919 	    isdat3[isdat] = 0;
10920 	}
10921 /* L2: */
10922     }
10923     *nsdat -= numdrop;
10924 /*      call report(nsdat,isdat1,isdat2) */
10925     return 0;
10926 } /* doslur_ */
10927 
dotmov_(real * updot,real * rtdot,char * soutq,integer * lsout,integer * iddot,ftnlen soutq_len)10928 /* Subroutine */ int dotmov_(real *updot, real *rtdot, char *soutq, integer *
10929 	lsout, integer *iddot, ftnlen soutq_len)
10930 {
10931     /* System generated locals */
10932     address a__1[5], a__2[8], a__3[5];
10933     integer i__1[5], i__2, i__3, i__4[8], i__5[5], i__6;
10934     char ch__1[1], ch__2[22], ch__3[1], ch__4[37], ch__5[15], ch__6[1];
10935     icilist ici__1;
10936 
10937     /* Builtin functions */
10938     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
10939     integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
10940 	    ;
10941 
10942     /* Local variables */
10943     static char sq[1];
10944     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
10945     extern integer lfmt1_(real *);
10946     static integer lnote;
10947     extern /* Subroutine */ int addstr_(char *, integer *, char *, integer *,
10948 	    ftnlen, ftnlen);
10949     static integer lfmtup, lfmtrt;
10950     static char notexq[80];
10951 
10952 
10953 /*  iddot = 0 for single dot, 1 for double */
10954 
10955     chax_(ch__1, (ftnlen)1, &c__92);
10956     *(unsigned char *)sq = *(unsigned char *)&ch__1[0];
10957     lfmtup = lfmt1_(updot);
10958     lfmtrt = lfmt1_(rtdot);
10959     ici__1.icierr = 0;
10960     ici__1.icirnum = 1;
10961     ici__1.icirlen = 80;
10962     ici__1.iciunit = notexq;
10963 /* Writing concatenation */
10964     i__1[0] = 6, a__1[0] = "(a37,f";
10965     i__2 = lfmtup + 48;
10966     chax_(ch__1, (ftnlen)1, &i__2);
10967     i__1[1] = 1, a__1[1] = ch__1;
10968     i__1[2] = 7, a__1[2] = ".1,a2,f";
10969     i__3 = lfmtrt + 48;
10970     chax_(ch__3, (ftnlen)1, &i__3);
10971     i__1[3] = 1, a__1[3] = ch__3;
10972     i__1[4] = 7, a__1[4] = ".1,a15)";
10973     ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__5, (ftnlen)22), ch__2);
10974     s_wsfi(&ici__1);
10975 /* Writing concatenation */
10976     i__4[0] = 1, a__2[0] = sq;
10977     i__4[1] = 12, a__2[1] = "makeatletter";
10978     i__4[2] = 1, a__2[2] = sq;
10979     i__4[3] = 3, a__2[3] = "def";
10980     i__4[4] = 1, a__2[4] = sq;
10981     i__4[5] = 12, a__2[5] = "C@Point#1#2{";
10982     i__4[6] = 1, a__2[6] = sq;
10983     i__4[7] = 6, a__2[7] = "PMXpt{";
10984     s_cat(ch__4, a__2, i__4, &c__8, (ftnlen)37);
10985     do_fio(&c__1, ch__4, (ftnlen)37);
10986     do_fio(&c__1, (char *)&(*updot), (ftnlen)sizeof(real));
10987     do_fio(&c__1, "}{", (ftnlen)2);
10988     do_fio(&c__1, (char *)&(*rtdot), (ftnlen)sizeof(real));
10989 /* Writing concatenation */
10990     i__5[0] = 1, a__3[0] = "}";
10991     i__6 = *iddot + 48;
10992     chax_(ch__6, (ftnlen)1, &i__6);
10993     i__5[1] = 1, a__3[1] = ch__6;
10994     i__5[2] = 1, a__3[2] = "}";
10995     i__5[3] = 1, a__3[3] = sq;
10996     i__5[4] = 11, a__3[4] = "makeatother";
10997     s_cat(ch__5, a__3, i__5, &c__5, (ftnlen)15);
10998     do_fio(&c__1, ch__5, (ftnlen)15);
10999     e_wsfi();
11000 
11001 /*   Example of string just created: */
11002 /*   \makeatletter\def\C@Point#1#2{\PMXpt{.5}{.5}}\makeatother\ */
11003 
11004     lnote = lfmtup + 54 + lfmtrt;
11005     addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80);
11006     return 0;
11007 } /* dotmov_ */
11008 
dotrill_(integer * iv,integer * ip,integer * iornq,char * noteq,integer * lnoten,char * notexq,integer * lnote,ftnlen noteq_len,ftnlen notexq_len)11009 /* Subroutine */ int dotrill_(integer *iv, integer *ip, integer *iornq, char *
11010 	noteq, integer *lnoten, char *notexq, integer *lnote, ftnlen
11011 	noteq_len, ftnlen notexq_len)
11012 {
11013     /* System generated locals */
11014     address a__1[2], a__2[3];
11015     integer i__1, i__2[2], i__3[3], i__4;
11016     char ch__1[1], ch__2[6];
11017     icilist ici__1;
11018 
11019     /* Builtin functions */
11020     integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
11021 	    e_wsle(void);
11022     /* Subroutine */ int s_stop(char *, ftnlen), s_cat(char *, char **,
11023 	    integer *, integer *, ftnlen);
11024     integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
11025 	    ;
11026 
11027     /* Local variables */
11028     static integer itr;
11029     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
11030     static integer nfmt;
11031     static logical tronly;
11032 
11033     /* Fortran I/O blocks */
11034     static cilist io___494 = { 0, 6, 0, 0, 0 };
11035 
11036 
11037     i__1 = comtrill_1.ntrill;
11038     for (itr = 1; itr <= i__1; ++itr) {
11039 	if (*iv == comtrill_1.ivtrill[itr - 1] && *ip == comtrill_1.iptrill[
11040 		itr - 1]) {
11041 	    goto L2;
11042 	}
11043 /* L1: */
11044     }
11045     s_wsle(&io___494);
11046     do_lio(&c__9, &c__1, "Problem in dotrill.  Call Dr. Don", (ftnlen)33);
11047     e_wsle();
11048     s_stop("", (ftnlen)0);
11049 L2:
11050     tronly = comtrill_1.xnsktr[itr - 1] < .01f;
11051     if (tronly) {
11052 /* Writing concatenation */
11053 	chax_(ch__1, (ftnlen)1, &c__92);
11054 	i__2[0] = 1, a__1[0] = ch__1;
11055 	i__2[1] = 9, a__1[1] = "zcharnote";
11056 	s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
11057 	*lnote = 10;
11058     } else if (bit_test(*iornq,7)) {
11059 /* Writing concatenation */
11060 	chax_(ch__1, (ftnlen)1, &c__92);
11061 	i__2[0] = 1, a__1[0] = ch__1;
11062 	i__2[1] = 6, a__1[1] = "Trille";
11063 	s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
11064 	*lnote = 7;
11065     } else {
11066 /* Writing concatenation */
11067 	chax_(ch__1, (ftnlen)1, &c__92);
11068 	i__2[0] = 1, a__1[0] = ch__1;
11069 	i__2[1] = 6, a__1[1] = "trille";
11070 	s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
11071 	*lnote = 7;
11072     }
11073 /* Writing concatenation */
11074     i__3[0] = *lnote, a__2[0] = notexq;
11075     i__3[1] = *lnoten, a__2[1] = noteq;
11076     i__3[2] = 1, a__2[2] = "{";
11077     s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
11078     *lnote = *lnote + *lnoten + 1;
11079 
11080 /*  Write trill duration to nearest tenth of a noteskip */
11081 
11082     if (tronly) {
11083 /* Writing concatenation */
11084 	i__3[0] = *lnote, a__2[0] = notexq;
11085 	chax_(ch__1, (ftnlen)1, &c__92);
11086 	i__3[1] = 1, a__2[1] = ch__1;
11087 	i__3[2] = 6, a__2[2] = "it tr}";
11088 	s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
11089 	*lnote += 7;
11090 	return 0;
11091     }
11092     if (comtrill_1.xnsktr[itr - 1] < .95f) {
11093 	nfmt = 2;
11094     } else if (comtrill_1.xnsktr[itr - 1] < 9.95f) {
11095 	nfmt = 3;
11096     } else {
11097 	nfmt = 4;
11098     }
11099     i__1 = *lnote;
11100     ici__1.icierr = 0;
11101     ici__1.icirnum = 1;
11102     ici__1.icirlen = *lnote + nfmt - i__1;
11103     ici__1.iciunit = notexq + i__1;
11104 /* Writing concatenation */
11105     i__3[0] = 2, a__2[0] = "(f";
11106     i__4 = nfmt + 48;
11107     chax_(ch__1, (ftnlen)1, &i__4);
11108     i__3[1] = 1, a__2[1] = ch__1;
11109     i__3[2] = 3, a__2[2] = ".1)";
11110     ici__1.icifmt = (s_cat(ch__2, a__2, i__3, &c__3, (ftnlen)6), ch__2);
11111     s_wsfi(&ici__1);
11112     do_fio(&c__1, (char *)&comtrill_1.xnsktr[itr - 1], (ftnlen)sizeof(real));
11113     e_wsfi();
11114     *lnote += nfmt;
11115 /* Writing concatenation */
11116     i__2[0] = *lnote, a__1[0] = notexq;
11117     i__2[1] = 1, a__1[1] = "}";
11118     s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
11119     ++(*lnote);
11120     return 0;
11121 } /* dotrill_ */
11122 
endslur_(logical * stemup,logical * upslur,integer * nolev,integer * iupdn,integer * ndxslur,integer * ivoff,integer * ncm,char * soutq,integer * lsout,logical * fontslur,ftnlen soutq_len)11123 /* Subroutine */ int endslur_(logical *stemup, logical *upslur, integer *
11124 	nolev, integer *iupdn, integer *ndxslur, integer *ivoff, integer *ncm,
11125 	 char *soutq, integer *lsout, logical *fontslur, ftnlen soutq_len)
11126 {
11127     /* System generated locals */
11128     address a__1[2], a__2[4];
11129     integer i__1[2], i__2, i__3[4];
11130     char ch__1[1];
11131 
11132     /* Builtin functions */
11133     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
11134 
11135     /* Local variables */
11136     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
11137     static logical shift;
11138     static integer lnote;
11139     static char noteq[8];
11140     extern /* Subroutine */ int addstr_(char *, integer *, char *, integer *,
11141 	    ftnlen, ftnlen), notefq_(char *, integer *, integer *, integer *,
11142 	    ftnlen);
11143     static integer lnoten;
11144     static char notexq[79];
11145 
11146 
11147 /*  Only called to end slur started in dograce. */
11148 
11149     shift = ! (*stemup) && ! (*upslur);
11150     if (! shift) {
11151 
11152 /*  No shift needed */
11153 
11154 /* Writing concatenation */
11155 	chax_(ch__1, (ftnlen)1, &c__92);
11156 	i__1[0] = 1, a__1[0] = ch__1;
11157 	i__1[1] = 5, a__1[1] = "tslur";
11158 	s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
11159 	lnote = 6;
11160     } else {
11161 
11162 /*  Shift needed */
11163 
11164 /* Writing concatenation */
11165 	chax_(ch__1, (ftnlen)1, &c__92);
11166 	i__1[0] = 1, a__1[0] = ch__1;
11167 	i__1[1] = 2, a__1[1] = "ts";
11168 	s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
11169 	lnote = 3;
11170     }
11171 /*      if (ndxslur .lt. 10) then */
11172 /*        notexq = notexq(1:lnote)//chax(48+ndxslur) */
11173 /*        lnote = lnote+1 */
11174 /*      else */
11175 /*        notexq = notexq(1:lnote)//'{1'//chax(38+ndxslur)//'}' */
11176 /*        lnote = lnote+4 */
11177 /*      end if */
11178 
11179 /* c  Print 11-ndxslur */
11180 /*  Print 23-ndxslur */
11181 
11182 /*      if (11-ndxslur .lt. 10) then */
11183     if (23 - *ndxslur < 10) {
11184 /*        notexq = notexq(1:lnote)//chax(59-ndxslur) */
11185 /* Writing concatenation */
11186 	i__1[0] = lnote, a__1[0] = notexq;
11187 	i__2 = 71 - *ndxslur;
11188 	chax_(ch__1, (ftnlen)1, &i__2);
11189 	i__1[1] = 1, a__1[1] = ch__1;
11190 	s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
11191 	++lnote;
11192     } else if (23 - *ndxslur < 20) {
11193 /*              notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */
11194 /* Writing concatenation */
11195 	i__3[0] = lnote, a__2[0] = notexq;
11196 	i__3[1] = 2, a__2[1] = "{1";
11197 	i__2 = 61 - *ndxslur;
11198 	chax_(ch__1, (ftnlen)1, &i__2);
11199 	i__3[2] = 1, a__2[2] = ch__1;
11200 	i__3[3] = 1, a__2[3] = "}";
11201 	s_cat(notexq, a__2, i__3, &c__4, (ftnlen)79);
11202 	lnote += 4;
11203     } else {
11204 /* Writing concatenation */
11205 	i__3[0] = lnote, a__2[0] = notexq;
11206 	i__3[1] = 2, a__2[1] = "{2";
11207 	i__2 = 51 - *ndxslur;
11208 	chax_(ch__1, (ftnlen)1, &i__2);
11209 	i__3[2] = 1, a__2[2] = ch__1;
11210 	i__3[3] = 1, a__2[3] = "}";
11211 	s_cat(notexq, a__2, i__3, &c__4, (ftnlen)79);
11212 	lnote += 4;
11213     }
11214     i__2 = *nolev + *iupdn + *ivoff;
11215     notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8);
11216 /* Writing concatenation */
11217     i__1[0] = lnote, a__1[0] = notexq;
11218     i__1[1] = lnoten, a__1[1] = noteq;
11219     s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
11220     lnote += lnoten;
11221     if (shift) {
11222 	if (*fontslur) {
11223 /* Writing concatenation */
11224 	    i__1[0] = lnote, a__1[0] = notexq;
11225 	    i__1[1] = 5, a__1[1] = "{-.6}";
11226 	    s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
11227 	} else {
11228 /* Writing concatenation */
11229 	    i__1[0] = lnote, a__1[0] = notexq;
11230 	    i__1[1] = 5, a__1[1] = "{-.8}";
11231 	    s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
11232 	}
11233 	lnote += 5;
11234     }
11235     addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
11236     return 0;
11237 } /* endslur_ */
11238 
errmsg_(char * lineq,integer * iccount,integer * ibarno,char * msgq,ftnlen lineq_len,ftnlen msgq_len)11239 /* Subroutine */ int errmsg_(char *lineq, integer *iccount, integer *ibarno,
11240 	char *msgq, ftnlen lineq_len, ftnlen msgq_len)
11241 {
11242     /* System generated locals */
11243     address a__1[2], a__2[5], a__3[4];
11244     integer i__1[2], i__2, i__3, i__4[5], i__5[4];
11245     real r__1;
11246     char ch__1[18], ch__2[1], ch__3[1], ch__4[7], ch__5[79];
11247     cilist ci__1;
11248     olist o__1;
11249     cllist cl__1;
11250 
11251     /* Builtin functions */
11252     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
11253 	     char **, integer *, integer *, ftnlen);
11254     integer s_wsle(cilist *), e_wsle(void), f_open(olist *), s_wsfe(cilist *),
11255 	     do_fio(integer *, char *, ftnlen), e_wsfe(void), f_clos(cllist *)
11256 	    ;
11257     double r_lg10(real *);
11258     integer i_indx(char *, char *, ftnlen, ftnlen), do_lio(integer *, integer
11259 	    *, char *, ftnlen);
11260 
11261     /* Local variables */
11262     static integer i1, i10;
11263     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
11264     static char outq[78];
11265     static integer iposn, ndigbn, ndignl, nlinep, lenmsg;
11266     extern /* Subroutine */ int printl_(char *, ftnlen);
11267     static integer ibarnop;
11268 
11269     /* Fortran I/O blocks */
11270     static cilist io___504 = { 0, 6, 0, 0, 0 };
11271     static cilist io___507 = { 0, 19, 0, "(i6)", 0 };
11272     static cilist io___511 = { 0, 6, 0, "(1x,a)", 0 };
11273     static cilist io___512 = { 0, 15, 0, "(a)", 0 };
11274     static cilist io___515 = { 0, 6, 0, 0, 0 };
11275     static cilist io___516 = { 0, 15, 0, "(a)", 0 };
11276 
11277 
11278     if (*iccount <= 78) {
11279 	s_copy(outq, lineq, (ftnlen)78, (ftnlen)78);
11280 	iposn = *iccount;
11281     } else {
11282 /* Writing concatenation */
11283 	i__1[0] = 4, a__1[0] = "... ";
11284 	i__1[1] = 74, a__1[1] = lineq + 54;
11285 	s_cat(outq, a__1, i__1, &c__2, (ftnlen)78);
11286 	iposn = *iccount - 50;
11287     }
11288     s_wsle(&io___504);
11289     e_wsle();
11290     ibarnop = *ibarno;
11291     if (c1omget_1.linesinpmxmod == 0 || c1omget_1.nline >
11292 	    c1omget_1.line1pmxmod + c1omget_1.linesinpmxmod) {
11293 
11294 /*  Error is in main .pmx file */
11295 
11296 /*        nlinep = nline-linesinpmxmod */
11297 /*       Correct for comments not copied into buffer */
11298 	nlinep = truelinecount_1.linewcom[c1omget_1.nline - 1] -
11299 		c1omget_1.linesinpmxmod;
11300     } else {
11301 
11302 /*  Error is in include file */
11303 
11304 	ibarnop = 0;
11305 	nlinep = c1omget_1.nline - c1omget_1.line1pmxmod + 1;
11306 	printl_("ERROR in include file named above, description given below",
11307 		(ftnlen)58);
11308     }
11309     o__1.oerr = 0;
11310     o__1.ounit = 19;
11311     o__1.ofnmlen = 11;
11312     o__1.ofnm = "pmxaerr.dat";
11313     o__1.orl = 0;
11314     o__1.osta = 0;
11315     o__1.oacc = 0;
11316     o__1.ofm = 0;
11317     o__1.oblnk = 0;
11318     f_open(&o__1);
11319     s_wsfe(&io___507);
11320     do_fio(&c__1, (char *)&nlinep, (ftnlen)sizeof(integer));
11321     e_wsfe();
11322     cl__1.cerr = 0;
11323     cl__1.cunit = 19;
11324     cl__1.csta = 0;
11325     f_clos(&cl__1);
11326 /* Computing MAX */
11327     r__1 = ibarnop + .1f;
11328     i__2 = 1, i__3 = (integer) (r_lg10(&r__1) + 1);
11329     ndigbn = max(i__2,i__3);
11330     r__1 = nlinep + .1f;
11331     ndignl = (integer) (r_lg10(&r__1) + 1);
11332     lenmsg = i_indx(msgq, "!", msgq_len, (ftnlen)1) - 1;
11333 
11334 /*  Split off msgq(..) since UNIX compilers don't allow concat substring!!! */
11335 
11336     ci__1.cierr = 0;
11337     ci__1.ciunit = 6;
11338 /* Writing concatenation */
11339     i__4[0] = 8, a__2[0] = "(/,a15,i";
11340     i__2 = ndignl + 48;
11341     chax_(ch__2, (ftnlen)1, &i__2);
11342     i__4[1] = 1, a__2[1] = ch__2;
11343     i__4[2] = 5, a__2[2] = ",a6,i";
11344     i__3 = ndigbn + 48;
11345     chax_(ch__3, (ftnlen)1, &i__3);
11346     i__4[3] = 1, a__2[3] = ch__3;
11347     i__4[4] = 3, a__2[4] = ",$)";
11348     ci__1.cifmt = (s_cat(ch__1, a__2, i__4, &c__5, (ftnlen)18), ch__1);
11349     s_wsfe(&ci__1);
11350     do_fio(&c__1, " ERROR in line ", (ftnlen)15);
11351     do_fio(&c__1, (char *)&nlinep, (ftnlen)sizeof(integer));
11352     do_fio(&c__1, ", bar ", (ftnlen)6);
11353     do_fio(&c__1, (char *)&ibarnop, (ftnlen)sizeof(integer));
11354     e_wsfe();
11355     s_wsfe(&io___511);
11356     do_fio(&c__1, msgq, lenmsg);
11357     e_wsfe();
11358     ci__1.cierr = 0;
11359     ci__1.ciunit = 15;
11360 /* Writing concatenation */
11361     i__4[0] = 8, a__2[0] = "(/,a15,i";
11362     i__2 = ndignl + 48;
11363     chax_(ch__2, (ftnlen)1, &i__2);
11364     i__4[1] = 1, a__2[1] = ch__2;
11365     i__4[2] = 5, a__2[2] = ",a6,i";
11366     i__3 = ndigbn + 48;
11367     chax_(ch__3, (ftnlen)1, &i__3);
11368     i__4[3] = 1, a__2[3] = ch__3;
11369     i__4[4] = 3, a__2[4] = ",$)";
11370     ci__1.cifmt = (s_cat(ch__1, a__2, i__4, &c__5, (ftnlen)18), ch__1);
11371     s_wsfe(&ci__1);
11372     do_fio(&c__1, " ERROR in line ", (ftnlen)15);
11373     do_fio(&c__1, (char *)&nlinep, (ftnlen)sizeof(integer));
11374     do_fio(&c__1, ", bar ", (ftnlen)6);
11375     do_fio(&c__1, (char *)&ibarnop, (ftnlen)sizeof(integer));
11376     e_wsfe();
11377     s_wsfe(&io___512);
11378     do_fio(&c__1, msgq, lenmsg);
11379     e_wsfe();
11380     i10 = iposn / 10;
11381     i1 = iposn - i10 * 10;
11382     ci__1.cierr = 0;
11383     ci__1.ciunit = 6;
11384 /* Writing concatenation */
11385     i__5[0] = 1, a__3[0] = "(";
11386     i__2 = i10 + 48;
11387     chax_(ch__2, (ftnlen)1, &i__2);
11388     i__5[1] = 1, a__3[1] = ch__2;
11389     i__3 = i1 + 48;
11390     chax_(ch__3, (ftnlen)1, &i__3);
11391     i__5[2] = 1, a__3[2] = ch__3;
11392     i__5[3] = 4, a__3[3] = "x,a)";
11393     ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4);
11394     s_wsfe(&ci__1);
11395     do_fio(&c__1, "v", (ftnlen)1);
11396     e_wsfe();
11397     ci__1.cierr = 0;
11398     ci__1.ciunit = 15;
11399 /* Writing concatenation */
11400     i__5[0] = 1, a__3[0] = "(";
11401     i__2 = i10 + 48;
11402     chax_(ch__2, (ftnlen)1, &i__2);
11403     i__5[1] = 1, a__3[1] = ch__2;
11404     i__3 = i1 + 48;
11405     chax_(ch__3, (ftnlen)1, &i__3);
11406     i__5[2] = 1, a__3[2] = ch__3;
11407     i__5[3] = 4, a__3[3] = "x,a)";
11408     ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4);
11409     s_wsfe(&ci__1);
11410     do_fio(&c__1, "v", (ftnlen)1);
11411     e_wsfe();
11412     s_wsle(&io___515);
11413     do_lio(&c__9, &c__1, outq, (ftnlen)78);
11414     e_wsle();
11415     s_wsfe(&io___516);
11416 /* Writing concatenation */
11417     i__1[0] = 1, a__1[0] = " ";
11418     i__1[1] = 78, a__1[1] = outq;
11419     s_cat(ch__5, a__1, i__1, &c__2, (ftnlen)79);
11420     do_fio(&c__1, ch__5, (ftnlen)79);
11421     e_wsfe();
11422     ci__1.cierr = 0;
11423     ci__1.ciunit = 6;
11424 /* Writing concatenation */
11425     i__5[0] = 1, a__3[0] = "(";
11426     i__2 = i10 + 48;
11427     chax_(ch__2, (ftnlen)1, &i__2);
11428     i__5[1] = 1, a__3[1] = ch__2;
11429     i__3 = i1 + 48;
11430     chax_(ch__3, (ftnlen)1, &i__3);
11431     i__5[2] = 1, a__3[2] = ch__3;
11432     i__5[3] = 4, a__3[3] = "x,a)";
11433     ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4);
11434     s_wsfe(&ci__1);
11435     do_fio(&c__1, "^", (ftnlen)1);
11436     e_wsfe();
11437     ci__1.cierr = 0;
11438     ci__1.ciunit = 15;
11439 /* Writing concatenation */
11440     i__5[0] = 1, a__3[0] = "(";
11441     i__2 = i10 + 48;
11442     chax_(ch__2, (ftnlen)1, &i__2);
11443     i__5[1] = 1, a__3[1] = ch__2;
11444     i__3 = i1 + 48;
11445     chax_(ch__3, (ftnlen)1, &i__3);
11446     i__5[2] = 1, a__3[2] = ch__3;
11447     i__5[3] = 4, a__3[3] = "x,a)";
11448     ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4);
11449     s_wsfe(&ci__1);
11450     do_fio(&c__1, "^", (ftnlen)1);
11451     e_wsfe();
11452     return 0;
11453 } /* errmsg_ */
11454 
eskb4_(integer * ip,integer * ivx,integer * in,integer * ib,real * space,real * tstart,real * fbar,integer * itrpt,real * esk)11455 /* Subroutine */ int eskb4_(integer *ip, integer *ivx, integer *in, integer *
11456 	ib, real *space, real *tstart, real *fbar, integer *itrpt, real *esk)
11457 {
11458     /* System generated locals */
11459     real r__1;
11460 
11461     /* Builtin functions */
11462     integer i_nint(real *), s_wsle(cilist *), do_lio(integer *, integer *,
11463 	    char *, ftnlen), e_wsle(void);
11464     /* Subroutine */ int s_stop(char *, ftnlen);
11465 
11466     /* Local variables */
11467     static integer iib;
11468     extern doublereal feon_(real *);
11469     static integer itnd, nnsk, itprev;
11470 
11471     /* Fortran I/O blocks */
11472     static cilist io___521 = { 0, 6, 0, 0, 0 };
11473 
11474 
11475 
11476 /*  Get elemskips to previous note.  Called only for graces, no xtups involved. */
11477 
11478     /* Parameter adjustments */
11479     --tstart;
11480     --space;
11481 
11482     /* Function Body */
11483     itnd = i_nint(&all_1.to[*in - 1]);
11484     if (*ip == 1 || itnd == *itrpt) {
11485 
11486 /*  Start of bar or after rpt. */
11487 
11488 	*esk = *fbar;
11489 	return 0;
11490     } else {
11491 	*esk = 0.f;
11492 	itprev = itnd - all_1.nodur[*ivx + (*ip - 1) * 24 - 25];
11493 	for (iib = *ib; iib >= 1; --iib) {
11494 	    if (tstart[iib] < itprev + comtol_1.tol) {
11495 
11496 /*  This is the block */
11497 
11498 		r__1 = (real) (itnd - itprev) / space[iib];
11499 		nnsk = i_nint(&r__1);
11500 		*esk += nnsk * feon_(&space[iib]);
11501 		return 0;
11502 	    } else {
11503 		r__1 = (itnd - tstart[iib]) / space[iib];
11504 		nnsk = i_nint(&r__1);
11505 		*esk += nnsk * feon_(&space[iib]);
11506 		itnd = i_nint(&tstart[iib]);
11507 	    }
11508 /* L1: */
11509 	}
11510     }
11511     s_wsle(&io___521);
11512     do_lio(&c__9, &c__1, "Problem in eskb4.  Send files to Dr. Don", (ftnlen)
11513 	    40);
11514     e_wsle();
11515     s_stop("", (ftnlen)0);
11516     return 0;
11517 } /* eskb4_ */
11518 
f1eon_(real * time)11519 doublereal f1eon_(real *time)
11520 {
11521     /* System generated locals */
11522     real ret_val;
11523 
11524     /* Builtin functions */
11525     double sqrt(doublereal);
11526 
11527     ret_val = sqrt(*time / 2);
11528     return ret_val;
11529 } /* f1eon_ */
11530 
feon_(real * time)11531 doublereal feon_(real *time)
11532 {
11533     /* System generated locals */
11534     real ret_val;
11535     doublereal d__1, d__2;
11536 
11537     /* Builtin functions */
11538     double sqrt(doublereal), pow_dd(doublereal *, doublereal *);
11539 
11540     d__1 = (doublereal) sqrt(*time / 2);
11541     d__2 = (doublereal) (1.f - comeon_1.eonk);
11542     ret_val = pow_dd(&d__1, &d__2) * comeon_1.ewmxk;
11543     return ret_val;
11544 } /* feon_ */
11545 
findbeam_(integer * ibmrep,integer * numbms,integer * mapfb)11546 /* Subroutine */ int findbeam_(integer *ibmrep, integer *numbms, integer *
11547 	mapfb)
11548 {
11549     /* Initialized data */
11550 
11551     static integer nip1[248] = { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
11552 	    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
11553 	    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
11554 	    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
11555 	    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
11556 	    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
11557 	    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
11558 	    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 };
11559     static integer nip2[248] = { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
11560 	    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
11561 	    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
11562 	    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
11563 	    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
11564 	    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
11565 	    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
11566 	    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 };
11567     static integer nummask[3] = { 29,49,12 };
11568     static integer mask[147]	/* was [49][3] */ = { 65535,4095,65520,255,
11569 	    65280,63,252,16128,64512,15,240,3840,61440,7,14,112,224,1792,3584,
11570 	    28672,57344,3,12,48,192,768,3072,12288,49152,0,0,0,0,0,0,0,0,0,0,
11571 	    0,0,0,0,0,0,0,0,0,0,16777215,65535,16776960,4095,65520,1048320,
11572 	    16773120,255,65280,16711680,63,252,16128,64512,4128768,16515072,
11573 	    15,60,240,3840,15360,61440,983040,3932160,15728640,7,14,112,224,
11574 	    1792,3584,28672,57344,458752,917504,7340032,14680064,3,12,48,192,
11575 	    768,3072,12288,49152,196608,786432,3145728,12582912,4095,255,4080,
11576 	    15,240,3840,3,12,48,192,768,3072,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
11577 	    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 };
11578     static logical eqonly[147]	/* was [49][3] */ = { TRUE_,TRUE_,TRUE_,
11579 	    FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
11580 	    FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
11581 	    FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
11582 	    FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
11583 	    FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
11584 	    FALSE_,TRUE_,TRUE_,TRUE_,TRUE_,TRUE_,TRUE_,TRUE_,FALSE_,FALSE_,
11585 	    FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
11586 	    FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
11587 	    FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
11588 	    FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
11589 	    FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
11590 	    FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
11591 	    FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
11592 	    FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
11593 	    FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
11594 	    FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_ };
11595 
11596     /* System generated locals */
11597     integer i__1, i__2, i__3, i__4;
11598     real r__1, r__2;
11599 
11600     /* Builtin functions */
11601     integer lbit_shift(integer, integer), s_wsle(cilist *), do_lio(integer *,
11602 	    integer *, char *, ftnlen), e_wsle(void);
11603     double r_mod(real *, real *);
11604 
11605     /* Local variables */
11606     static integer ib, ip, ir, it, is, ib1, ib2, ir1, is1, is2, it2, iip, ipr[
11607 	    248], itr[248], mape, mapm, irep, maps, nreal, itend, itoff,
11608 	    maskm, nodue[248], itseg, mtemp;
11609     static logical short__[248];
11610     static integer itnow, ithalf, numnew;
11611     extern /* Subroutine */ int logbeam_(integer *, integer *, integer *);
11612     static integer masknow;
11613 
11614     /* Fortran I/O blocks */
11615     static cilist io___555 = { 0, 6, 0, 0, 0 };
11616 
11617 
11618 
11619 /*  Called once per voice per bar, after setting forced beams. */
11620 
11621 /*      integer numbms(nm),ipr(48),nip1(0:47),nip2(0:47),mapfb(16), */
11622 /*     *       itr(48),nodue(48) */
11623 /*      logical short(48),eqonly */
11624     /* Parameter adjustments */
11625     --mapfb;
11626     --numbms;
11627 
11628     /* Function Body */
11629     ip = 0;
11630     nreal = 0;
11631     itnow = 0;
11632 L1:
11633     ++ip;
11634     if (ip > all_1.nn[commvl_1.ivx - 1]) {
11635 	goto L9;
11636     }
11637 L11:
11638     if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 0) {
11639 
11640 /*  Ignore all xtup notes except the last, the one with nodur > 0 . */
11641 /*  Xtups are irrelevant here since they are already all in forced beams. */
11642 /*  Will update itnow by nodur at the END of this loop */
11643 
11644 	++ip;
11645 	goto L11;
11646     }
11647     ++nreal;
11648     nodue[nreal - 1] = all_1.nodur[commvl_1.ivx + ip * 24 - 25];
11649     short__[nreal - 1] = nodue[nreal - 1] < 16 && ! bit_test(all_1.irest[
11650 	    commvl_1.ivx + ip * 24 - 25],0) && ! bit_test(all_1.islur[
11651 	    commvl_1.ivx + ip * 24 - 25],18);
11652 
11653 /*  Rule out notes that have 'alone'-flag set */
11654 
11655     ipr[nreal - 1] = ip;
11656     itr[nreal - 1] = itnow;
11657     if (nodue[nreal - 1] == 1) {
11658 
11659 /*  64th gap */
11660 
11661 	if (itnow % 2 == 0) {
11662 
11663 /*  Start of 32nd gap, lump with following note */
11664 
11665 	    ++ip;
11666 	    nodue[nreal - 1] = all_1.nodur[commvl_1.ivx + ip * 24 - 25] + 1;
11667 	    itnow += nodue[nreal - 1];
11668 	} else {
11669 
11670 /*  End of 32nd gap, lump with preceeding note */
11671 
11672 	    --nreal;
11673 	    ++nodue[nreal - 1];
11674 	    ++itnow;
11675 	}
11676     } else {
11677 	itnow += all_1.nodur[commvl_1.ivx + ip * 24 - 25];
11678     }
11679     goto L1;
11680 L9:
11681     ir1 = 1;
11682     itseg = all_1.lenbar / *ibmrep;
11683     i__1 = *ibmrep;
11684     for (irep = 1; irep <= i__1; ++irep) {
11685 
11686 /*  Set bitmaps for all shorts neighbored by a short. Each bit represents a */
11687 /*  span of 32nd note.  maps, mapm, mape record start, full duration, and end */
11688 /*  of consecutive span of beamable (<1/4) notes. */
11689 
11690 	maps = 0;
11691 	mapm = 0;
11692 	mape = 0;
11693 	itend = itseg * irep;
11694 	itoff = itend - itseg;
11695 	i__2 = nreal;
11696 	for (ir = ir1; ir <= i__2; ++ir) {
11697 	    it2 = itr[ir - 1] + nodue[ir - 1] - 2;
11698 	    if (it2 >= itend) {
11699 		ir1 = ir;
11700 		goto L14;
11701 	    }
11702 /*         if (short(ir).and.((ir.gt.1.and.short(ir-1)).or.(ir.lt.nreal */
11703 /* Computing MAX */
11704 	    i__3 = ir - 1;
11705 	    if (short__[ir - 1] && (ir > 1 && short__[max(i__3,1) - 1] || ir <
11706 		     nreal && short__[ir])) {
11707 		ib1 = (itr[ir - 1] - itoff) / 2;
11708 		ib2 = (it2 - itoff) / 2;
11709 		if (max(ib1,ib2) > 47 || ir > 48 || min(ib1,ib2) < 0) {
11710 		    return 0;
11711 		}
11712 
11713 /*  Must have an odd number obe beats in a long bar.  Auto-beam won't work */
11714 
11715 		nip1[ib1] = ipr[ir - 1];
11716 		nip2[ib2] = ipr[ir - 1];
11717 
11718 /*  nip1,2(ib) = 0 unless a real note starts,ends on bit ib; then = ip */
11719 
11720 		maps = bit_set(maps,ib1);
11721 		mape = bit_set(mape,ib2);
11722 		i__3 = ib2;
11723 		for (ib = ib1; ib <= i__3; ++ib) {
11724 		    mapm = bit_set(mapm,ib);
11725 /* L3: */
11726 		}
11727 	    }
11728 /* L2: */
11729 	}
11730 L14:
11731 	if (mapm == 0) {
11732 	    goto L13;
11733 	}
11734 
11735 /*  Zero out bits from forced beams */
11736 
11737 	maps &= ~ mapfb[irep];
11738 	mapm &= ~ mapfb[irep];
11739 	mape &= ~ mapfb[irep];
11740 
11741 /*  Compare map with template. */
11742 
11743 	i__2 = nummask[combeam_1.ibmtyp - 1];
11744 	for (it = 1; it <= i__2; ++it) {
11745 	    masknow = mask[it + combeam_1.ibmtyp * 49 - 50];
11746 	    if ((masknow & mapm) == masknow) {
11747 
11748 /*  Find least significant bit in the mask to check start time */
11749 
11750 		mtemp = masknow;
11751 		maskm = masknow;
11752 		for (is1 = 0; is1 <= 47; ++is1) {
11753 		    if ((1 & mtemp) == 1) {
11754 			goto L6;
11755 		    }
11756 		    mtemp = lbit_shift(mtemp, (ftnlen)-1);
11757 /* L5: */
11758 		}
11759 L6:
11760 		if ((lbit_shift((ftnlen)1, is1) & maps) == 0) {
11761 		    goto L4;
11762 		}
11763 
11764 /*  is1 is the bit where the beam starts.  Continue shifting to */
11765 /*  find most significant bit in the mask to check ending time */
11766 
11767 		for (is2 = is1; is2 <= 47; ++is2) {
11768 		    mtemp = lbit_shift(mtemp, (ftnlen)-1);
11769 		    if ((1 & ~ mtemp) == 1) {
11770 			goto L8;
11771 		    }
11772 /* L7: */
11773 		}
11774 L8:
11775 
11776 /*  is2 is now the bit on which the beam ends. */
11777 
11778 		if ((lbit_shift((ftnlen)1, is2) & mape) == 0) {
11779 		    goto L4;
11780 		}
11781 
11782 /*  Did we pick out a single note from the middle of a longer sequence? */
11783 
11784 		if (nip1[is1] == nip2[is2]) {
11785 		    goto L4;
11786 		}
11787 
11788 /*  We almost have a beam.  Check equality of notes if needed. */
11789 
11790 		if (eqonly[it + combeam_1.ibmtyp * 49 - 50]) {
11791 		    i__3 = nip2[is2];
11792 		    for (ip = nip1[is1]; ip <= i__3; ++ip) {
11793 			if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] != 8) {
11794 
11795 /*  There is a non-1/8th note in this beam. Exit if not 2 quarters */
11796 
11797 			    if (is2 - is1 != 15) {
11798 				goto L4;
11799 			    }
11800 
11801 /*  Beam is 2 quarters long.  Check if can split in half. */
11802 
11803 			    ithalf = 0;
11804 			    i__4 = nip2[is2];
11805 			    for (iip = nip1[is1]; iip <= i__4; ++iip) {
11806 				ithalf += all_1.nodur[commvl_1.ivx + iip * 24
11807 					- 25];
11808 				if (ithalf > 16) {
11809 				    goto L4;
11810 				}
11811 				if (ithalf == 16) {
11812 				    goto L21;
11813 				}
11814 /* L20: */
11815 			    }
11816 			    s_wsle(&io___555);
11817 			    do_lio(&c__9, &c__1, "Problem in findbeam, pleas"
11818 				    "e call Dr. Don", (ftnlen)40);
11819 			    e_wsle();
11820 			    goto L4;
11821 L21:
11822 
11823 /*  Otherwise, split in half by keeping only the first half.  Other half will */
11824 /*  be picked up later, assuming masks are listed longest first. */
11825 
11826 			    is2 = is1 + 7;
11827 
11828 /*  Reset maskm (since only used part of mask), used later to zero out */
11829 /*  bits that contain beams */
11830 
11831 			    maskm = 0;
11832 			    i__4 = is2;
11833 			    for (is = is1; is <= i__4; ++is) {
11834 				maskm = bit_set(maskm,is);
11835 /* L15: */
11836 			    }
11837 			    goto L16;
11838 			}
11839 /* L10: */
11840 		    }
11841 		}
11842 L16:
11843 
11844 /*  This is a beam.  If last "effective" ends on odd 64th, add 1 more */
11845 
11846 /*            if (abs(mod(to(iand(255,ipl(ivx,nip2(is2)))) */
11847 /*     *           +nodur(ivx,nip2(is2)),2.)) .gt. tol) then */
11848 		r__2 = all_1.to[comipl2_1.ipl2[commvl_1.ivx + nip2[is2] * 24
11849 			- 25] - 1] + all_1.nodur[commvl_1.ivx + nip2[is2] *
11850 			24 - 25] + comtol_1.tol * .5f;
11851 		if ((r__1 = r_mod(&r__2, &c_b1659), dabs(r__1)) >
11852 			comtol_1.tol) {
11853 		    ++nip2[is2];
11854 		}
11855 		++numbms[commvl_1.ivx];
11856 		numnew = numbms[commvl_1.ivx];
11857 		logbeam_(&numnew, &nip1[is1], &nip2[is2]);
11858 
11859 /*  Zero out the appropriate bits so these notes don't get used again */
11860 
11861 		mapm &= ~ maskm;
11862 		if (mapm == 0) {
11863 		    goto L13;
11864 		}
11865 		maps &= ~ maskm;
11866 		mape &= ~ maskm;
11867 	    }
11868 L4:
11869 	    ;
11870 	}
11871 L13:
11872 	;
11873     }
11874     return 0;
11875 } /* findbeam_ */
11876 
findeonk_(integer * nptr1,integer * nptr2,real * wovera,real * xelsk,real * dtmin,real * dtmax,real * eonk0)11877 /* Subroutine */ int findeonk_(integer *nptr1, integer *nptr2, real *wovera,
11878 	real *xelsk, real *dtmin, real *dtmax, real *eonk0)
11879 {
11880     /* System generated locals */
11881     integer i__1;
11882     real r__1;
11883     doublereal d__1, d__2;
11884 
11885     /* Builtin functions */
11886     double pow_dd(doublereal *, doublereal *), sqrt(doublereal), log(
11887 	    doublereal);
11888 
11889     /* Local variables */
11890     static real f, fp;
11891     extern doublereal feon_(real *);
11892     static real targ, esum;
11893     static integer iptr;
11894     extern doublereal f1eon_(real *);
11895     static real desum, dsoln;
11896     static integer niter;
11897     static real detarg;
11898     extern /* Subroutine */ int printl_(char *, ftnlen);
11899 
11900 
11901 /*  Compute an exponent eonk for use in the "flattened" formula for elemskips */
11902 /*   vs time.  We must solve the eqution f = 0.  Initial quess is eonk0. */
11903 
11904     comeon_1.eonk = *eonk0;
11905     niter = 0;
11906 L1:
11907     d__1 = (doublereal) f1eon_(dtmax);
11908     d__2 = (doublereal) comeon_1.eonk;
11909     comeon_1.ewmxk = pow_dd(&d__1, &d__2);
11910     ++niter;
11911     esum = 0.f;
11912     desum = 0.f;
11913     i__1 = *nptr2;
11914     for (iptr = *nptr1; iptr <= i__1; ++iptr) {
11915 	targ = c1omnotes_1.durb[iptr - 1] / c1omnotes_1.sqzb[iptr - 1];
11916 	esum += c1omnotes_1.nnpd[iptr - 1] * c1omnotes_1.sqzb[iptr - 1] *
11917 		feon_(&targ);
11918 	d__1 = (doublereal) (*dtmax / targ);
11919 	d__2 = (doublereal) comeon_1.eonk;
11920 	detarg = sqrt(targ / 2 * pow_dd(&d__1, &d__2)) * log(*dtmax / targ);
11921 	desum += c1omnotes_1.nnpd[iptr - 1] * c1omnotes_1.sqzb[iptr - 1] *
11922 		detarg;
11923 /* L2: */
11924     }
11925     f = *wovera * feon_(dtmin) - *xelsk - esum;
11926     d__1 = (doublereal) (*dtmax / *dtmin);
11927     d__2 = (doublereal) comeon_1.eonk;
11928     fp = *wovera * sqrt(*dtmin / 2 * pow_dd(&d__1, &d__2)) * log(*dtmax / *
11929 	    dtmin) - desum;
11930     if (dabs(fp) < comtol_1.tol || (r__1 = comeon_1.eonk - .5f, dabs(r__1)) >
11931 	    .5f || niter > 100) {
11932 	printl_("Error in findeonk.  Please send source to Dr. Don", (ftnlen)
11933 		49);
11934 	comeon_1.eonk = 0.f;
11935 	comeon_1.ewmxk = 1.f;
11936 	return 0;
11937     }
11938     dsoln = -f / fp;
11939     if (dabs(dsoln) < comtol_1.tol * .1f) {
11940 	return 0;
11941     }
11942 
11943 /*  Not converged yet, try again */
11944 
11945     comeon_1.eonk += dsoln;
11946     goto L1;
11947 } /* findeonk_ */
11948 
fnote_(integer * nodur,integer * ivx,integer * ip,integer * nacc)11949 doublereal fnote_(integer *nodur, integer *ivx, integer *ip, integer *nacc)
11950 {
11951     /* System generated locals */
11952     real ret_val;
11953 
11954     /* Builtin functions */
11955     integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
11956 	    e_wsle(void);
11957 
11958     /* Local variables */
11959     static integer iip, ip1m1;
11960     extern /* Subroutine */ int stop1_(void);
11961     static integer ndoub, ipback;
11962     extern /* Subroutine */ int printl_(char *, ftnlen);
11963 
11964     /* Fortran I/O blocks */
11965     static cilist io___571 = { 0, 6, 0, 0, 0 };
11966 
11967 
11968 
11969 /*  This return the real duration of a note */
11970 
11971     /* Parameter adjustments */
11972     nacc -= 25;
11973     nodur -= 25;
11974 
11975     /* Function Body */
11976     ipback = *ip;
11977     if (nodur[*ivx + *ip * 24] > 0) {
11978 	if (*ip > 1) {
11979 
11980 /*  Check if this is last note of xtup */
11981 
11982 	    if (nodur[*ivx + (*ip - 1) * 24] == 0) {
11983 		ipback = *ip - 1;
11984 		goto L2;
11985 	    }
11986 	}
11987 	ret_val = (real) nodur[*ivx + *ip * 24];
11988 	return ret_val;
11989     }
11990 L2:
11991 
11992 /*  Count back to prior non zero note. Start at ip to avoid neg index if ip=1. */
11993 /*  Count how many doubled xtups notes there are from ip-1 to first note. */
11994 
11995     ndoub = 0;
11996     for (ip1m1 = ipback; ip1m1 >= 1; --ip1m1) {
11997 	if (nodur[*ivx + ip1m1 * 24] > 0) {
11998 	    goto L4;
11999 	}
12000 	if (ip1m1 < *ip && bit_test(nacc[*ivx + ip1m1 * 24],18)) {
12001 	    ++ndoub;
12002 	}
12003 /* L1: */
12004     }
12005 L4:
12006 
12007 /*  count forward to next non-0 nodur. Start at ip in case last note of xtup. */
12008 
12009     for (iip = *ip; iip <= 200; ++iip) {
12010 
12011 /*  Count doubled xtup notes from ip to end. */
12012 
12013 	if (bit_test(nacc[*ivx + iip * 24],18)) {
12014 	    ++ndoub;
12015 	}
12016 	if (nodur[*ivx + iip * 24] > 0) {
12017 /*          fnote = nodur(ivx,iip)/float(iip-ip1m1) */
12018 	    ret_val = nodur[*ivx + iip * 24] / (real) (iip - ip1m1 + ndoub);
12019 	    if (bit_test(nacc[*ivx + *ip * 24],18)) {
12020 		ret_val *= 2;
12021 	    } else if (bit_test(nacc[*ivx + *ip * 24],27)) {
12022 		ret_val *= 1.5f;
12023 	    } else if (*ip > 1) {
12024 		if (bit_test(nacc[*ivx + (*ip - 1) * 24],27)) {
12025 		    ret_val *= .5f;
12026 		}
12027 	    }
12028 	    return ret_val;
12029 	}
12030 /* L3: */
12031     }
12032     s_wsle(&io___571);
12033     do_lio(&c__9, &c__1, " ", (ftnlen)1);
12034     e_wsle();
12035     printl_("Probable misplaced barline or incorrect meter, stopping", (
12036 	    ftnlen)55);
12037 /*      call printl('Program error in fnote, send source to Dr. Don') */
12038     stop1_();
12039     return ret_val;
12040 } /* fnote_ */
12041 
g1etchar_(char * lineq,integer * iccount,char * charq,ftnlen lineq_len,ftnlen charq_len)12042 /* Subroutine */ int g1etchar_(char *lineq, integer *iccount, char *charq,
12043 	ftnlen lineq_len, ftnlen charq_len)
12044 {
12045     /* Builtin functions */
12046     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
12047 
12048     /* Local variables */
12049     static integer ndxm;
12050     extern /* Subroutine */ int read10_(char *, logical *, ftnlen), m1rec1_(
12051 	    char *, integer *, integer *, integer *, integer *, integer *,
12052 	    ftnlen);
12053     static integer nbars, ibaroff, ibarcnt;
12054 
12055 
12056 /*  Gets the next character out of lineq*128.  If pointer iccount=128 on entry, */
12057 /*  then reads in a new line.  Resets iccount.  Ends program if no more input. */
12058 
12059     if (*iccount == 128) {
12060 	read10_(lineq, &c1omget_1.lastchar, (ftnlen)128);
12061 	if (c1omget_1.lastchar) {
12062 	    return 0;
12063 	}
12064 	if (! commac_1.endmac) {
12065 	    *iccount = 0;
12066 	    if (! commac_1.mplay) {
12067 		++c1omget_1.nline;
12068 	    }
12069 	} else {
12070 	    commac_1.endmac = FALSE_;
12071 	    *iccount = commac_1.icchold;
12072 	    s_copy(lineq, commac_1.lnholdq, (ftnlen)128, (ftnlen)128);
12073 	}
12074 	if (commac_1.mrecord) {
12075 	    m1rec1_(lineq, iccount, &ibarcnt, &ibaroff, &nbars, &ndxm, (
12076 		    ftnlen)128);
12077 	}
12078     }
12079     ++(*iccount);
12080     *(unsigned char *)charq = *(unsigned char *)&lineq[*iccount - 1];
12081     return 0;
12082 } /* g1etchar_ */
12083 
g1etnote_(logical * loop,integer * ifig,logical * optimize,logical * fulltrans)12084 /* Subroutine */ int g1etnote_(logical *loop, integer *ifig, logical *
12085 	optimize, logical *fulltrans)
12086 {
12087     /* Initialized data */
12088 
12089     static char literq[51*3] = "Literal TeX string cannot start with 4 backs"
12090 	    "lashes!" "TeX string must have <129 char, end with backslash!"
12091 	    "Type 2 or 3 TeX string can only start in column 1! ";
12092 
12093     /* System generated locals */
12094     address a__1[3], a__2[2], a__3[4];
12095     integer i__1, i__2[3], i__3[2], i__4, i__5, i__6, i__7, i__8[4];
12096     real r__1;
12097     char ch__1[42], ch__2[1], ch__3[55], ch__4[54], ch__5[46];
12098     icilist ici__1;
12099 
12100     /* Builtin functions */
12101     integer i_indx(char *, char *, ftnlen, ftnlen), s_wsle(cilist *), e_wsle(
12102 	    void), do_lio(integer *, integer *, char *, ftnlen), s_wsfe(
12103 	    cilist *);
12104     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
12105     integer do_fio(integer *, char *, ftnlen), e_wsfe(void), s_cmp(char *,
12106 	    char *, ftnlen, ftnlen), i_nint(real *);
12107     double log(doublereal);
12108     integer pow_ii(integer *, integer *), s_rsfe(cilist *), e_rsfe(void),
12109 	    s_rsfi(icilist *), e_rsfi(void);
12110 
12111     /* Local variables */
12112     extern integer i1fnodur_(integer *, char *, ftnlen);
12113     extern /* Subroutine */ int checkdyn_(char *, integer *, integer *,
12114 	    ftnlen);
12115     static integer idotform, ndxquote, i__, j;
12116     extern /* Subroutine */ int readmeter_(char *, integer *, integer *,
12117 	    integer *, ftnlen), getpmxmod_(logical *, char *, ftnlen);
12118     static integer ic, igr, ipm;
12119     static real dum;
12120     static integer ngr, iiv, nbb4, num1, num2;
12121     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
12122     static logical cdot;
12123     static real fnum;
12124     static char dumq[1], dotq[1], durq[1];
12125     static integer itup;
12126     static real snum;
12127     static integer ntup;
12128     extern /* Subroutine */ int g1etx_(char *, integer *, logical *, logical *
12129 	    , integer *, real *, real *, ftnlen), stop1_(void), read10_(char *
12130 	    , logical *, ftnlen);
12131     static real dimen;
12132     static char charq[1];
12133     static integer indxb;
12134     static char lineq[128];
12135     static integer icsav, ndoub, iorig, iinow, iposn, ninow;
12136     extern /* Subroutine */ int getitransinfo_(logical *, integer *, char *,
12137 	    integer *, integer *, integer *, integer *, integer *, ftnlen);
12138     static integer icclhw;
12139     static char charlq[1];
12140     extern /* Subroutine */ int setmac_(char *, integer *, integer *, integer
12141 	    *, integer *, char *, char *, integer *, integer *, ftnlen,
12142 	    ftnlen, ftnlen), chklit_(char *, integer *, integer *, ftnlen);
12143     static logical fulbrp;
12144     extern /* Subroutine */ int errmsg_(char *, integer *, integer *, char *,
12145 	    ftnlen, ftnlen);
12146     static integer literr, mtrdnp;
12147     static real sysflb;
12148     static integer numint, mtrnmp, numnum;
12149     static logical ztrans;
12150     static real fnsyst;
12151     static integer lenbeat;
12152     extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen,
12153 	    ftnlen), getmidi_(integer *, char *, integer *, integer *,
12154 	    integer *, integer *, integer *, integer *, logical *, ftnlen),
12155 	    readnum_(char *, integer *, char *, real *, ftnlen, ftnlen);
12156     static integer mtrdenl, lenmult, numshft;
12157     static logical plusmin;
12158     static real tintstf;
12159     extern /* Subroutine */ int g1etchar_(char *, integer *, char *, ftnlen,
12160 	    ftnlen);
12161     static integer lvoltxt;
12162 
12163     /* Fortran I/O blocks */
12164     static cilist io___581 = { 0, 6, 0, 0, 0 };
12165     static cilist io___582 = { 0, 6, 0, 0, 0 };
12166     static cilist io___583 = { 0, 6, 0, 0, 0 };
12167     static cilist io___584 = { 0, 6, 0, 0, 0 };
12168     static cilist io___585 = { 0, 15, 0, "(/a)", 0 };
12169     static cilist io___586 = { 0, 15, 0, "(a11,2x,i3)", 0 };
12170     static cilist io___587 = { 0, 15, 0, 0, 0 };
12171     static cilist io___588 = { 0, 6, 0, 0, 0 };
12172     static cilist io___596 = { 0, 6, 0, 0, 0 };
12173     static cilist io___597 = { 0, 6, 0, 0, 0 };
12174     static cilist io___598 = { 0, 6, 0, 0, 0 };
12175     static cilist io___603 = { 0, 6, 0, 0, 0 };
12176     static cilist io___604 = { 0, 6, 0, 0, 0 };
12177     static cilist io___605 = { 0, 6, 0, 0, 0 };
12178     static cilist io___618 = { 0, 6, 0, 0, 0 };
12179     static cilist io___621 = { 0, 6, 0, 0, 0 };
12180     static cilist io___622 = { 0, 6, 0, 0, 0 };
12181     static cilist io___623 = { 0, 6, 0, 0, 0 };
12182     static cilist io___626 = { 0, 6, 0, 0, 0 };
12183     static cilist io___632 = { 0, 6, 0, 0, 0 };
12184     static cilist io___633 = { 0, 6, 0, 0, 0 };
12185     static cilist io___634 = { 0, 15, 0, "(/,a)", 0 };
12186     static cilist io___635 = { 0, 6, 0, 0, 0 };
12187     static cilist io___636 = { 0, 6, 0, 0, 0 };
12188     static cilist io___637 = { 0, 15, 0, "(a)", 0 };
12189     static cilist io___638 = { 0, 15, 0, "(a)", 0 };
12190     static cilist io___643 = { 0, 6, 0, 0, 0 };
12191     static cilist io___644 = { 0, 15, 0, "(a)", 0 };
12192     static cilist io___648 = { 0, 6, 0, 0, 0 };
12193     static cilist io___649 = { 0, 6, 0, 0, 0 };
12194     static cilist io___650 = { 0, 6, 0, 0, 0 };
12195     static cilist io___651 = { 0, 6, 0, "(1x,a21,i3,a23)", 0 };
12196     static cilist io___655 = { 0, 6, 0, 0, 0 };
12197     static cilist io___656 = { 0, 6, 0, 0, 0 };
12198     static cilist io___657 = { 0, 5, 0, "(a)", 0 };
12199     static cilist io___661 = { 0, 6, 0, 0, 0 };
12200     static cilist io___662 = { 0, 6, 0, 0, 0 };
12201 
12202 
12203     cdot = FALSE_;
12204 L1:
12205     g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
12206     if (*(unsigned char *)charq != ' ') {
12207 	*(unsigned char *)charlq = *(unsigned char *)charq;
12208     }
12209     if (c1omget_1.lastchar) {
12210 	if (i_indx("/%", charlq, (ftnlen)2, (ftnlen)1) == 0) {
12211 	    s_wsle(&io___581);
12212 	    e_wsle();
12213 	    s_wsle(&io___582);
12214 	    do_lio(&c__9, &c__1, "WARNING:", (ftnlen)8);
12215 	    e_wsle();
12216 	    s_wsle(&io___583);
12217 	    do_lio(&c__9, &c__1, "Last non-blank character is \"", (ftnlen)29)
12218 		    ;
12219 	    do_lio(&c__9, &c__1, charlq, (ftnlen)1);
12220 	    do_lio(&c__9, &c__1, "\", not \"/,%\"", (ftnlen)12);
12221 	    e_wsle();
12222 	    s_wsle(&io___584);
12223 	    do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11);
12224 	    i__1 = *(unsigned char *)charlq;
12225 	    do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer));
12226 	    e_wsle();
12227 	    s_wsfe(&io___585);
12228 /* Writing concatenation */
12229 	    i__2[0] = 29, a__1[0] = "Last non-blank character is \"";
12230 	    i__2[1] = 1, a__1[1] = charlq;
12231 	    i__2[2] = 12, a__1[2] = "\", not \"/,%\"";
12232 	    s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)42);
12233 	    do_fio(&c__1, ch__1, (ftnlen)42);
12234 	    e_wsfe();
12235 	    s_wsfe(&io___586);
12236 	    do_fio(&c__1, "ASCII code:", (ftnlen)11);
12237 	    i__1 = *(unsigned char *)charlq;
12238 	    do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
12239 	    e_wsfe();
12240 
12241 /*  Append " /" to last line.  NB lastchar=.true. => ilbuf=nlbuf+1. */
12242 
12243 	    --inbuff_1.ilbuf;
12244 	    inbuff_1.lbuf[inbuff_1.ilbuf - 1] = (shortint) (inbuff_1.lbuf[
12245 		    inbuff_1.ilbuf - 1] + 2);
12246 /* Writing concatenation */
12247 	    i__3[0] = inbuff_1.ipbuf, a__2[0] = inbuff_1.bufq;
12248 	    i__3[1] = 2, a__2[1] = " /";
12249 	    s_cat(inbuff_1.bufq, a__2, i__3, &c__2, (ftnlen)65536);
12250 	    s_wsle(&io___587);
12251 	    do_lio(&c__9, &c__1, "appending <blank>/", (ftnlen)18);
12252 	    e_wsle();
12253 	    s_wsle(&io___588);
12254 	    do_lio(&c__9, &c__1, "appending <blank>/", (ftnlen)18);
12255 	    e_wsle();
12256 /* Writing concatenation */
12257 	    i__3[0] = a1ll_2.iccount, a__2[0] = lineq;
12258 	    i__3[1] = 2, a__2[1] = " /";
12259 	    s_cat(lineq, a__2, i__3, &c__2, (ftnlen)128);
12260 	    c1omget_1.lastchar = FALSE_;
12261 	    goto L1;
12262 	}
12263 	return 0;
12264     }
12265     if (*(unsigned char *)charq == ' ') {
12266 	goto L1;
12267     } else if (*(unsigned char *)charq == '%' && a1ll_2.iccount == 1) {
12268 	a1ll_2.iccount = 128;
12269 	goto L1;
12270 
12271 /*  Replacement 1/22/12 since gfortran 4.7 with -O was choking here! */
12272 
12273 /*      else if ((ichar(charq).ge.97.and.ichar(charq).le.103) .or. */
12274     } else if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) > 0 || *(
12275 	    unsigned char *)charq == 'r') {
12276 
12277 /*  This is a note/rest. gotclef is only used for checking for clef before "/" */
12278 
12279 	if (cdot) {
12280 	    goto L28;
12281 	}
12282 	if (c1omnotes_1.gotclef) {
12283 	    c1omnotes_1.gotclef = FALSE_;
12284 	}
12285 	idotform = 0;
12286 	numnum = 0;
12287 	plusmin = FALSE_;
12288 L28:
12289 	++a1ll_2.nnl[c1ommvl_1.ivx - 1];
12290 	if (a1ll_2.nnl[c1ommvl_1.ivx - 1] > 200) {
12291 	    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
12292 		    1;
12293 	    errmsg_(lineq, &a1ll_2.iccount, &i__1, ">200 notes in line of mu"
12294 		    "sic. Use smaller blocks!", (ftnlen)128, (ftnlen)48);
12295 	    stop1_();
12296 	}
12297 	*(unsigned char *)dotq = 'x';
12298 
12299 /*  Check if this is 'r ' and previous note was full-bar-pause */
12300 
12301 	i__1 = a1ll_2.iccount;
12302 /* Computing MAX */
12303 	i__4 = 1, i__5 = a1ll_2.nnl[c1ommvl_1.ivx - 1] - 1;
12304 /* Computing MAX */
12305 	i__6 = 1, i__7 = a1ll_2.nnl[c1ommvl_1.ivx - 1] - 1;
12306 	fulbrp = *(unsigned char *)charq == 'r' && s_cmp(lineq + i__1, " ",
12307 		a1ll_2.iccount + 1 - i__1, (ftnlen)1) == 0 && a1ll_2.nnl[
12308 		c1ommvl_1.ivx - 1] > 1 && a1ll_2.rest[c1ommvl_1.ivx + max(
12309 		i__4,i__5) * 24 - 25] && a1ll_2.nodur[c1ommvl_1.ivx + max(
12310 		i__6,i__7) * 24 - 25] == a1ll_2.lenbar;
12311 L2:
12312 	g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
12313 	ic = *(unsigned char *)durq;
12314 	if (ic <= 57 && ic >= 48) {
12315 
12316 /*  Digit */
12317 
12318 	    if (numnum == 0) {
12319 		c1omnotes_1.nnodur = ic - 48;
12320 		numnum = 1;
12321 		goto L2;
12322 	    } else if (numnum == 1) {
12323 		if (*(unsigned char *)charq == 'r') {
12324 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12325 			    a1ll_2.nbars + 1;
12326 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only one digit a"
12327 			    "llowed after rest symbol \"r\"!", (ftnlen)128, (
12328 			    ftnlen)45);
12329 		    stop1_();
12330 		}
12331 		numnum = 2;
12332 		if (plusmin) {
12333 		    s_wsle(&io___596);
12334 		    e_wsle();
12335 		    s_wsle(&io___597);
12336 		    do_lio(&c__9, &c__1, "*********WARNING*********", (ftnlen)
12337 			    25);
12338 		    e_wsle();
12339 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12340 			    a1ll_2.nbars + 1;
12341 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Before version 1"
12342 			    ".2, +/- was ignored if octave was!", (ftnlen)128,
12343 			    (ftnlen)50);
12344 		    s_wsle(&io___598);
12345 		    do_lio(&c__9, &c__1, "explicitly specified.  May need to"
12346 			    " edit old editions", (ftnlen)52);
12347 		    e_wsle();
12348 		}
12349 		goto L2;
12350 	    } else {
12351 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12352 			a1ll_2.nbars + 1;
12353 		errmsg_(lineq, &a1ll_2.iccount, &i__1, ">2 digits in note sy"
12354 			"mbol!", (ftnlen)128, (ftnlen)25);
12355 		stop1_();
12356 	    }
12357 	} else if (*(unsigned char *)durq == 'd') {
12358 	    *(unsigned char *)dotq = *(unsigned char *)durq;
12359 	    i__1 = a1ll_2.iccount;
12360 	    if (s_cmp(lineq + i__1, "d", a1ll_2.iccount + 1 - i__1, (ftnlen)1)
12361 		     == 0) {
12362 		c1omnotes_1.iddot = 1;
12363 		++a1ll_2.iccount;
12364 
12365 /*  Since we flow out, double dots won't work with other dot options */
12366 
12367 	    }
12368 	    i__1 = a1ll_2.iccount;
12369 	    if (i_indx("+-", lineq + i__1, (ftnlen)2, a1ll_2.iccount + 1 -
12370 		    i__1) > 0) {
12371 
12372 /*  move a dot, provided a number follows. */
12373 
12374 		g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
12375 			1);
12376 		g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
12377 			1);
12378 		if (i_indx("0123456789-.", durq, (ftnlen)12, (ftnlen)1) == 0)
12379 			{
12380 
12381 /*  Backup, exit the loop normally */
12382 
12383 		    a1ll_2.iccount += -2;
12384 		    goto L2;
12385 		}
12386 		readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)128, (
12387 			ftnlen)1);
12388 		if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
12389 
12390 /*  Vertical shift also */
12391 
12392 		    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
12393 			    ftnlen)1);
12394 		    if (i_indx("0123456789-.", durq, (ftnlen)12, (ftnlen)1) ==
12395 			     0) {
12396 			i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12397 				a1ll_2.nbars + 1;
12398 			errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected num"
12399 				"ber after 2nd +/- (shift dot)!", (ftnlen)128,
12400 				(ftnlen)42);
12401 			stop1_();
12402 		    }
12403 		    readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128,
12404 			     (ftnlen)1);
12405 		}
12406 		--a1ll_2.iccount;
12407 	    }
12408 	    goto L2;
12409 	} else if (i_indx("<>", durq, (ftnlen)2, (ftnlen)1) > 0) {
12410 
12411 /*  Accidental shift */
12412 
12413 /*          if (index('fsn',lineq(iccount-1:iccount-1)) .eq. 0) then */
12414 	    i__1 = a1ll_2.iccount - 2;
12415 	    if (i_indx("fsnA", lineq + i__1, (ftnlen)4, a1ll_2.iccount - 1 -
12416 		    i__1) == 0) {
12417 		i__1 = a1ll_2.iccount - 1;
12418 		i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12419 			a1ll_2.nbars + 1;
12420 		errmsg_(lineq, &i__1, &i__4, "Expected \"f\", \"s\", \"n\" o"
12421 			"r \"A\" before \"<\" or \">\"!", (ftnlen)128, (ftnlen)
12422 			48);
12423 /*     *         'Expected "f", "s", or "n" before "<" or ">"!') */
12424 		stop1_();
12425 	    }
12426 	    ipm = 1;
12427 	    if (*(unsigned char *)durq == '<') {
12428 		ipm = -1;
12429 	    }
12430 	    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
12431 	    if (i_indx("123456789.0", durq, (ftnlen)11, (ftnlen)1) == 0) {
12432 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12433 			a1ll_2.nbars + 1;
12434 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected number afte"
12435 			"r </> (accidental shift)!", (ftnlen)128, (ftnlen)45);
12436 		stop1_();
12437 	    }
12438 	    readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
12439 		    ftnlen)1);
12440 	    fnum = ipm * fnum;
12441 	    if (fnum < -5.35f || fnum > 1.f) {
12442 		i__1 = a1ll_2.iccount - 1;
12443 		i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12444 			a1ll_2.nbars + 1;
12445 		errmsg_(lineq, &i__1, &i__4, "Horizontal accidental shift mu"
12446 			"st be >-5.35 and <1.0!", (ftnlen)128, (ftnlen)52);
12447 		stop1_();
12448 	    }
12449 	    --a1ll_2.iccount;
12450 	    goto L2;
12451 	} else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
12452 	    if (*(unsigned char *)charq != 'r') {
12453 		i__1 = a1ll_2.iccount - 2;
12454 		if (i_indx("fsnA", lineq + i__1, (ftnlen)4, a1ll_2.iccount -
12455 			1 - i__1) > 0) {
12456 		    ipm = 1;
12457 		    if (*(unsigned char *)durq == '-') {
12458 			ipm = -1;
12459 		    }
12460 		    i__1 = a1ll_2.iccount;
12461 		    if (i_indx("0123456789", lineq + i__1, (ftnlen)10,
12462 			    a1ll_2.iccount + 1 - i__1) > 0) {
12463 
12464 /*  This may be start of accidental shift, but may be octave jump; then duration */
12465 
12466 			icsav = a1ll_2.iccount;
12467 			++a1ll_2.iccount;
12468 			readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)
12469 				128, (ftnlen)1);
12470 			if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
12471 
12472 /*  This is an accid shift since there's a 2nd consecutive signed number. */
12473 /*  Check size of 1st number. */
12474 
12475 			    if (fnum > 30.5f) {
12476 				i__1 = a1ll_2.iccount - 1;
12477 				i__4 = c1omnotes_1.ibarcnt -
12478 					c1omnotes_1.ibaroff + a1ll_2.nbars +
12479 					1;
12480 				errmsg_(lineq, &i__1, &i__4, "Vertical accid"
12481 					"ental shift must be less than 31!", (
12482 					ftnlen)128, (ftnlen)47);
12483 				stop1_();
12484 			    }
12485 			    ipm = 1;
12486 			    if (*(unsigned char *)durq == '-') {
12487 				ipm = -1;
12488 			    }
12489 			    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)
12490 				    128, (ftnlen)1);
12491 			    if (i_indx("1234567890.", durq, (ftnlen)11, (
12492 				    ftnlen)1) == 0) {
12493 				i__1 = c1omnotes_1.ibarcnt -
12494 					c1omnotes_1.ibaroff + a1ll_2.nbars +
12495 					1;
12496 				errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expe"
12497 					"cted 2nd number of accidental shift)!"
12498 					, (ftnlen)128, (ftnlen)41);
12499 				stop1_();
12500 			    }
12501 			    readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (
12502 				    ftnlen)128, (ftnlen)1);
12503 			    fnum = ipm * fnum;
12504 			    if (fnum < -5.35f || fnum > 1.f) {
12505 				i__1 = a1ll_2.iccount - 1;
12506 				i__4 = c1omnotes_1.ibarcnt -
12507 					c1omnotes_1.ibaroff + a1ll_2.nbars +
12508 					1;
12509 				errmsg_(lineq, &i__1, &i__4, "Horiz. acciden"
12510 					"tal shift must be >-5.35 and <1.0!", (
12511 					ftnlen)128, (ftnlen)48);
12512 				stop1_();
12513 			    }
12514 			    --a1ll_2.iccount;
12515 			    goto L2;
12516 			} else {
12517 
12518 /*  Not accid shift, reset, then flow out */
12519 
12520 			    a1ll_2.iccount = icsav;
12521 			}
12522 		    }
12523 		}
12524 		plusmin = TRUE_;
12525 		if (numnum == 2) {
12526 		    s_wsle(&io___603);
12527 		    e_wsle();
12528 		    s_wsle(&io___604);
12529 		    do_lio(&c__9, &c__1, "*********WARNING*********", (ftnlen)
12530 			    25);
12531 		    e_wsle();
12532 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12533 			    a1ll_2.nbars + 1;
12534 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Before version 1"
12535 			    ".2, +/- was ignored if octave was!", (ftnlen)128,
12536 			    (ftnlen)50);
12537 		    s_wsle(&io___605);
12538 		    do_lio(&c__9, &c__1, "explicitly specified.  May need to"
12539 			    " edit old editions", (ftnlen)52);
12540 		    e_wsle();
12541 		}
12542 		goto L2;
12543 
12544 /*  It's a rest containing +|- .  Must refer to a vertical shift.  Read past. */
12545 
12546 	    } else {
12547 		g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
12548 			1);
12549 		readnum_(lineq, &a1ll_2.iccount, durq, &dum, (ftnlen)128, (
12550 			ftnlen)1);
12551 		--a1ll_2.iccount;
12552 		goto L2;
12553 	    }
12554 /*        else if (index('ulare',durq) .gt. 0) then */
12555 	} else if (i_indx("ularec", durq, (ftnlen)6, (ftnlen)1) > 0) {
12556 	    goto L2;
12557 	} else if (*(unsigned char *)durq == 'S') {
12558 
12559 /* Stemlength change */
12560 
12561 	    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
12562 	    if (i_indx(".0123456789:", durq, (ftnlen)12, (ftnlen)1) == 0) {
12563 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12564 			a1ll_2.nbars + 1;
12565 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "There must be a numb"
12566 			"er or colon here!", (ftnlen)128, (ftnlen)37);
12567 		stop1_();
12568 	    }
12569 	    if (*(unsigned char *)durq == ':') {
12570 		if (! comkeys_1.stickys) {
12571 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12572 			    a1ll_2.nbars + 1;
12573 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned off stick"
12574 			    "y stemshrinks without turning on!", (ftnlen)128, (
12575 			    ftnlen)49);
12576 		    stop1_();
12577 		}
12578 		comkeys_1.stickys = FALSE_;
12579 		goto L2;
12580 	    }
12581 	    readnum_(lineq, &a1ll_2.iccount, durq, &dum, (ftnlen)128, (ftnlen)
12582 		    1);
12583 	    if (dum < .5f || dum > 4.f) {
12584 		i__1 = a1ll_2.iccount - 1;
12585 		i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12586 			a1ll_2.nbars + 1;
12587 		errmsg_(lineq, &i__1, &i__4, "Stemlength shortening must be "
12588 			"from .5 to 4!", (ftnlen)128, (ftnlen)43);
12589 		stop1_();
12590 	    }
12591 	    if (*(unsigned char *)durq != ':') {
12592 		--a1ll_2.iccount;
12593 	    } else {
12594 		if (comkeys_1.stickys) {
12595 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12596 			    a1ll_2.nbars + 1;
12597 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned on sticky"
12598 			    " stemshrinks when already on!", (ftnlen)128, (
12599 			    ftnlen)45);
12600 		    stop1_();
12601 		}
12602 		comkeys_1.stickys = TRUE_;
12603 	    }
12604 	    goto L2;
12605 	} else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) {
12606 
12607 /* Check for midi-only accid. CANNOT coesist with accidental position tweaks, so */
12608 /*   MUST come right after "f,s,n" */
12609 
12610 	    i__1 = a1ll_2.iccount;
12611 	    if (s_cmp(lineq + i__1, "i", a1ll_2.iccount + 1 - i__1, (ftnlen)1)
12612 		     == 0) {
12613 		++a1ll_2.iccount;
12614 	    }
12615 	    goto L2;
12616 	} else if (*(unsigned char *)durq == 'p') {
12617 	    fulbrp = *(unsigned char *)charq == 'r';
12618 	    if (! fulbrp) {
12619 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12620 			a1ll_2.nbars + 1;
12621 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "The option \"p\" onl"
12622 			"y works with \"r\" (rest)!", (ftnlen)128, (ftnlen)42);
12623 		stop1_();
12624 	    }
12625 	    goto L2;
12626 	} else if (*(unsigned char *)durq == 'b') {
12627 	    if (*(unsigned char *)charq != 'r') {
12628 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12629 			a1ll_2.nbars + 1;
12630 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "You entered \"b\"; I"
12631 			" expected \"rb\"!", (ftnlen)128, (ftnlen)33);
12632 		stop1_();
12633 	    } else if (numnum == 2) {
12634 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12635 			a1ll_2.nbars + 1;
12636 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "You entered \"r\" &"
12637 			" \"b\" with two numbers!", (ftnlen)128, (ftnlen)39);
12638 	    }
12639 	    goto L2;
12640 	} else if (*(unsigned char *)durq == 'x') {
12641 
12642 /*  Xtuplet. Count number of doubled notes (for unequal xtups) */
12643 
12644 	    if (bit_test(c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[
12645 		    c1ommvl_1.ivx - 1] * 24 - 25],18)) {
12646 		ndoub = 1;
12647 	    } else {
12648 		ndoub = 0;
12649 	    }
12650 
12651 /*  Will set all durations to 0 except last one. */
12652 
12653 	    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
12654 	    if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
12655 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12656 			a1ll_2.nbars + 1;
12657 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "First char after \""
12658 			"x\" in xtuplet must be \"1\"-\"9\"!", (ftnlen)128, (
12659 			ftnlen)48);
12660 		stop1_();
12661 	    }
12662 	    readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
12663 		    ftnlen)1);
12664 	    if (fnum > 99.f) {
12665 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12666 			a1ll_2.nbars + 1;
12667 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Xtuplet cannot have "
12668 			"more than 99 notes!", (ftnlen)128, (ftnlen)39);
12669 		stop1_();
12670 	    } else if (i_indx(" DFnd", durq, (ftnlen)5, (ftnlen)1) == 0) {
12671 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12672 			a1ll_2.nbars + 1;
12673 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only legal character"
12674 			"s here are \" \",\"D\",\"F\",\"n\"!", (ftnlen)128, (
12675 			ftnlen)47);
12676 		stop1_();
12677 	    }
12678 
12679 /*  End of mandatory xtup inputs.  Check for options. Note D,F,d must precede n. */
12680 
12681 	    if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) {
12682 
12683 /*  Double xtup note to make an un= xtup. Here, number already set, but may also */
12684 /*    have used this before number was set. */
12685 
12686 		c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
12687 			 24 - 25] = bit_set(c1ommvl_1.nacc[c1ommvl_1.ivx +
12688 			a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25],18);
12689 		ndoub = 1;
12690 		g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
12691 			1);
12692 	    } else if (*(unsigned char *)durq == 'd') {
12693 		c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
12694 			 24 - 25] = bit_set(c1ommvl_1.nacc[c1ommvl_1.ivx +
12695 			a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25],27);
12696 		g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
12697 			1);
12698 	    }
12699 	    if (*(unsigned char *)durq == 'n') {
12700 
12701 /*  Number alteration stuff.  After 'n', require '+-123456789fs ', no more 'DF'. */
12702 
12703 		numshft = 0;
12704 L30:
12705 		g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
12706 			1);
12707 		if (*(unsigned char *)durq == 'f') {
12708 		    goto L30;
12709 		} else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
12710 		    ++numshft;
12711 		    if (numshft == 3) {
12712 			i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12713 				a1ll_2.nbars + 1;
12714 			errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only 2 shift"
12715 				"s are allowed after \"n\" in xtup!", (ftnlen)
12716 				128, (ftnlen)44);
12717 			stop1_();
12718 		    }
12719 		    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
12720 			    ftnlen)1);
12721 		    if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) ==
12722 			    0) {
12723 			i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12724 				a1ll_2.nbars + 1;
12725 			errmsg_(lineq, &a1ll_2.iccount, &i__1, "This charact"
12726 				"er should be a digit or \".\"!", (ftnlen)128,
12727 				(ftnlen)40);
12728 			stop1_();
12729 		    }
12730 		    readnum_(lineq, &a1ll_2.iccount, durq, &snum, (ftnlen)128,
12731 			     (ftnlen)1);
12732 		    --a1ll_2.iccount;
12733 		    if (numshft == 1 && snum > 15.1f || numshft == 2 && snum
12734 			    > 1.51f) {
12735 			i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12736 				a1ll_2.nbars + 1;
12737 			errmsg_(lineq, &a1ll_2.iccount, &i__1, "Shift number"
12738 				" after \"n\" in xtup is out of range!", (
12739 				ftnlen)128, (ftnlen)47);
12740 			stop1_();
12741 		    }
12742 		    goto L30;
12743 		} else if (*(unsigned char *)durq == 's') {
12744 
12745 /*  Slope alteration for bracket */
12746 
12747 		    getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
12748 			    ftnlen)1);
12749 		    if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
12750 			i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12751 				a1ll_2.nbars + 1;
12752 			errmsg_(lineq, &a1ll_2.iccount, &i__1, "For slope ad"
12753 				"justment, this character must be \"+\" or \"-"
12754 				"\"!", (ftnlen)128, (ftnlen)56);
12755 			stop1_();
12756 		    }
12757 		    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
12758 			    ftnlen)1);
12759 		    if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0)
12760 			    {
12761 			i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12762 				a1ll_2.nbars + 1;
12763 			errmsg_(lineq, &a1ll_2.iccount, &i__1, "This charact"
12764 				"er should be a digit!", (ftnlen)128, (ftnlen)
12765 				33);
12766 			stop1_();
12767 		    }
12768 		    readnum_(lineq, &a1ll_2.iccount, durq, &snum, (ftnlen)128,
12769 			     (ftnlen)1);
12770 		    --a1ll_2.iccount;
12771 		    if (i_nint(&snum) > 15) {
12772 			i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12773 				a1ll_2.nbars + 1;
12774 			errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slope adjust"
12775 				"ment cannot exceed 15!", (ftnlen)128, (ftnlen)
12776 				34);
12777 			stop1_();
12778 		    }
12779 		    goto L30;
12780 		} else if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) >
12781 			0) {
12782 
12783 /* Unsigned integer => alternate printed number */
12784 
12785 		    readnum_(lineq, &a1ll_2.iccount, durq, &snum, (ftnlen)128,
12786 			     (ftnlen)1);
12787 		    if (snum > 15.1f) {
12788 			i__1 = a1ll_2.iccount - 1;
12789 			i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12790 				a1ll_2.nbars + 1;
12791 			errmsg_(lineq, &i__1, &i__4, "Alternate xtup number "
12792 				"after \"n\" must be <16!", (ftnlen)128, (
12793 				ftnlen)44);
12794 			stop1_();
12795 		    }
12796 		    --a1ll_2.iccount;
12797 		    goto L30;
12798 		} else if (*(unsigned char *)durq != ' ') {
12799 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12800 			    a1ll_2.nbars + 1;
12801 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"
12802 			    "r after \"n\" in xtup!", (ftnlen)128, (ftnlen)36);
12803 		    stop1_();
12804 		}
12805 	    }
12806 	    ntup = i_nint(&fnum);
12807 	    i__1 = ntup;
12808 	    for (itup = 2; itup <= i__1; ++itup) {
12809 		a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
12810 			24 - 25] = 0;
12811 		++a1ll_2.nnl[c1ommvl_1.ivx - 1];
12812 L110:
12813 		g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
12814 			1);
12815 		if (*(unsigned char *)durq == ' ') {
12816 		    goto L110;
12817 		} else if (*(unsigned char *)durq == 'o') {
12818 
12819 /*  Ornament in xtup.  "o" symbol must come AFTER the affected note */
12820 
12821 		    g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
12822 			    ftnlen)1);
12823 		    if (i_indx("(stmx+Tup._)e:>^bc", dumq, (ftnlen)18, (
12824 			    ftnlen)1) == 0) {
12825 			if (i_indx("fg", dumq, (ftnlen)2, (ftnlen)1) > 0) {
12826 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
12827 				    + a1ll_2.nbars + 1;
12828 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "Fermata "
12829 				    "or segno not allowed in xtuplet!", (
12830 				    ftnlen)128, (ftnlen)40);
12831 			} else {
12832 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
12833 				    + a1ll_2.nbars + 1;
12834 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal "
12835 				    "ornament!", (ftnlen)128, (ftnlen)17);
12836 			}
12837 			stop1_();
12838 		    }
12839 		    if (*(unsigned char *)dumq == 'T') {
12840 
12841 /*  Trill.  may be followed by 't' and/or number.  read 'til blank */
12842 
12843 L29:
12844 			g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
12845 				ftnlen)1);
12846 			if (*(unsigned char *)dumq != ' ') {
12847 			    goto L29;
12848 			}
12849 		    } else if (*(unsigned char *)dumq == 'e') {
12850 			g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
12851 				ftnlen)1);
12852 			if (i_indx("sfn?", dumq, (ftnlen)4, (ftnlen)1) == 0) {
12853 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
12854 				    + a1ll_2.nbars + 1;
12855 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal "
12856 				    "character after \"e\" in edit. accid. sy"
12857 				    "mbol!", (ftnlen)128, (ftnlen)51);
12858 			    stop1_();
12859 			}
12860 			g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
12861 				ftnlen)1);
12862 			if (*(unsigned char *)dumq == '?') {
12863 			    g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)
12864 				    128, (ftnlen)1);
12865 			}
12866 		    } else if (*(unsigned char *)dumq == ':') {
12867 			i__4 = a1ll_2.iccount;
12868 			if (s_cmp(lineq + i__4, " ", a1ll_2.iccount + 1 -
12869 				i__4, (ftnlen)1) != 0) {
12870 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
12871 				    + a1ll_2.nbars + 1;
12872 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "\":\" mu"
12873 				    "st be followed by blank in \"o: \"!", (
12874 				    ftnlen)128, (ftnlen)39);
12875 			    stop1_();
12876 			} else if (! comkeys_1.ornrpt) {
12877 			    i__4 = a1ll_2.iccount - 1;
12878 			    i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
12879 				    + a1ll_2.nbars + 1;
12880 			    errmsg_(lineq, &i__4, &i__5, "Turned off repeate"
12881 				    "d ornaments before they were on!", (
12882 				    ftnlen)128, (ftnlen)50);
12883 			    stop1_();
12884 			}
12885 			comkeys_1.ornrpt = FALSE_;
12886 		    } else {
12887 			g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
12888 				ftnlen)1);
12889 		    }
12890 		    if (i_indx("+- :", dumq, (ftnlen)4, (ftnlen)1) == 0) {
12891 			i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
12892 				a1ll_2.nbars + 1;
12893 			errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"
12894 				"acter in ornament symbol!", (ftnlen)128, (
12895 				ftnlen)37);
12896 			stop1_();
12897 		    }
12898 		    if (*(unsigned char *)dumq == ':') {
12899 			i__4 = a1ll_2.iccount;
12900 			if (s_cmp(lineq + i__4, " ", a1ll_2.iccount + 1 -
12901 				i__4, (ftnlen)1) != 0) {
12902 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
12903 				    + a1ll_2.nbars + 1;
12904 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "\":\" mu"
12905 				    "st be followed by blank in \"o: \"!", (
12906 				    ftnlen)128, (ftnlen)39);
12907 			    stop1_();
12908 			} else if (comkeys_1.ornrpt) {
12909 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
12910 				    + a1ll_2.nbars + 1;
12911 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "Turned o"
12912 				    "n repeated ornaments but already on!", (
12913 				    ftnlen)128, (ftnlen)44);
12914 			    stop1_();
12915 			}
12916 			comkeys_1.ornrpt = TRUE_;
12917 		    }
12918 		    if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
12919 			i__4 = a1ll_2.iccount;
12920 			if (i_indx("0123456789", lineq + i__4, (ftnlen)10,
12921 				a1ll_2.iccount + 1 - i__4) == 0) {
12922 			    i__4 = a1ll_2.iccount + 1;
12923 			    i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
12924 				    + a1ll_2.nbars + 1;
12925 			    errmsg_(lineq, &i__4, &i__5, "There should be an"
12926 				    " integer here!", (ftnlen)128, (ftnlen)32);
12927 			    stop1_();
12928 			}
12929 			readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)
12930 				128, (ftnlen)1);
12931 			if (*(unsigned char *)durq == ':') {
12932 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
12933 				    + a1ll_2.nbars + 1;
12934 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "Cannot s"
12935 				    "hift AND repeat an ornament!", (ftnlen)
12936 				    128, (ftnlen)36);
12937 			    stop1_();
12938 			}
12939 
12940 /*  12/7/03 Allow horizontal shift on any ornament, not just breath and ceas. */
12941 
12942 			if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
12943 			    i__4 = a1ll_2.iccount;
12944 			    if (i_indx(".0123456789", lineq + i__4, (ftnlen)
12945 				    11, a1ll_2.iccount + 1 - i__4) == 0) {
12946 				i__4 = a1ll_2.iccount + 1;
12947 				i__5 = c1omnotes_1.ibarcnt -
12948 					c1omnotes_1.ibaroff + a1ll_2.nbars +
12949 					1;
12950 				errmsg_(lineq, &i__4, &i__5, "There should b"
12951 					"e a number here!", (ftnlen)128, (
12952 					ftnlen)30);
12953 				stop1_();
12954 			    }
12955 			    readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (
12956 				    ftnlen)128, (ftnlen)1);
12957 			}
12958 		    }
12959 		    goto L110;
12960 		} else if (i_indx("st(){}", durq, (ftnlen)6, (ftnlen)1) > 0) {
12961 
12962 /*  Slur in xtup */
12963 
12964 		    iposn = 0;
12965 		    numint = 0;
12966 L15:
12967 		    g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
12968 			    ftnlen)1);
12969 		    ++iposn;
12970 		    if (i_indx("udlbfnht", dumq, (ftnlen)8, (ftnlen)1) > 0) {
12971 			if (*(unsigned char *)dumq == 't' && *(unsigned char *
12972 				)durq == 't') {
12973 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
12974 				    + a1ll_2.nbars + 1;
12975 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "Cannot u"
12976 				    "se \"t\" as an option on a tie!", (ftnlen)
12977 				    128, (ftnlen)37);
12978 			    stop1_();
12979 			}
12980 			goto L15;
12981 		    } else if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
12982 			++numint;
12983 			++a1ll_2.iccount;
12984 			readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)
12985 				128, (ftnlen)1);
12986 			if (numint == 1) {
12987 			    if (i_nint(&fnum) > 30) {
12988 				i__4 = a1ll_2.iccount - 1;
12989 				i__5 = c1omnotes_1.ibarcnt -
12990 					c1omnotes_1.ibaroff + a1ll_2.nbars +
12991 					1;
12992 				errmsg_(lineq, &i__4, &i__5, "Magnitude of s"
12993 					"lur height adjustment cannot exceed "
12994 					"30!", (ftnlen)128, (ftnlen)53);
12995 				stop1_();
12996 			    }
12997 			} else if (numint == 2) {
12998 			    if (dabs(fnum) > 6.3f) {
12999 				i__4 = a1ll_2.iccount - 1;
13000 				i__5 = c1omnotes_1.ibarcnt -
13001 					c1omnotes_1.ibaroff + a1ll_2.nbars +
13002 					1;
13003 				errmsg_(lineq, &i__4, &i__5, "Slur horiz shi"
13004 					"ft must be in the range (-6.3,6.3)!",
13005 					(ftnlen)128, (ftnlen)49);
13006 				stop1_();
13007 			    }
13008 			} else {
13009 
13010 /*  Third signed integer, must be a midslur or curve spec. */
13011 
13012 			    if (dabs(fnum) > 31.f) {
13013 				i__4 = a1ll_2.iccount - 1;
13014 				i__5 = c1omnotes_1.ibarcnt -
13015 					c1omnotes_1.ibaroff + a1ll_2.nbars +
13016 					1;
13017 				errmsg_(lineq, &i__4, &i__5, "Slur midheight"
13018 					" must be in the range (-31,31)!", (
13019 					ftnlen)128, (ftnlen)45);
13020 				stop1_();
13021 			    }
13022 			    if (*(unsigned char *)durq == ':') {
13023 
13024 /*  Expecting curve parameters.  Get two numbers */
13025 
13026 				for (i__ = 1; i__ <= 2; ++i__) {
13027 				    ++a1ll_2.iccount;
13028 				    fnum = (real) (*(unsigned char *)&lineq[
13029 					    a1ll_2.iccount - 1] - 48);
13030 				    if ((r__1 = fnum - 3.5f, dabs(r__1)) >
13031 					    3.6f) {
13032 					i__4 = c1omnotes_1.ibarcnt -
13033 						c1omnotes_1.ibaroff +
13034 						a1ll_2.nbars + 1;
13035 					errmsg_(lineq, &a1ll_2.iccount, &i__4,
13036 						 "Slur curve parameter must "
13037 						"be in range (0,7)!", (ftnlen)
13038 						128, (ftnlen)44);
13039 					stop1_();
13040 				    }
13041 /* L40: */
13042 				}
13043 				++a1ll_2.iccount;
13044 			    }
13045 			}
13046 			--a1ll_2.iccount;
13047 			goto L15;
13048 		    } else if (*(unsigned char *)dumq == 's') {
13049 
13050 /* What follows should be one or two signed numbers for adjustment of line break */
13051 /* slur, end of 1st segment or start of second. */
13052 
13053 			if (comslur_1.fontslur) {
13054 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
13055 				    + a1ll_2.nbars + 1;
13056 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "May not "
13057 				    "use linebreak slur options with font-bas"
13058 				    "ed slurs!", (ftnlen)128, (ftnlen)57);
13059 			    stop1_();
13060 			}
13061 			g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
13062 				ftnlen)1);
13063 			if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) {
13064 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
13065 				    + a1ll_2.nbars + 1;
13066 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "This cha"
13067 				    "racter must be \"+\" or \"-\"!", (ftnlen)
13068 				    128, (ftnlen)34);
13069 			    stop1_();
13070 			}
13071 			++a1ll_2.iccount;
13072 			readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)
13073 				128, (ftnlen)1);
13074 			if (i_nint(&fnum) > 30) {
13075 			    i__4 = a1ll_2.iccount - 1;
13076 			    i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
13077 				    + a1ll_2.nbars + 1;
13078 			    errmsg_(lineq, &i__4, &i__5, "Magnitude of slur "
13079 				    "height adjustment cannot exceed 30!", (
13080 				    ftnlen)128, (ftnlen)53);
13081 			    stop1_();
13082 			}
13083 			if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
13084 			    ++a1ll_2.iccount;
13085 			    readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (
13086 				    ftnlen)128, (ftnlen)1);
13087 			    if (dabs(fnum) > 6.3f) {
13088 				i__4 = a1ll_2.iccount - 1;
13089 				i__5 = c1omnotes_1.ibarcnt -
13090 					c1omnotes_1.ibaroff + a1ll_2.nbars +
13091 					1;
13092 				errmsg_(lineq, &i__4, &i__5, "Slur horiz shi"
13093 					"ft must be in range (-6.3,6.3)!", (
13094 					ftnlen)128, (ftnlen)45);
13095 				stop1_();
13096 			    }
13097 			}
13098 			--a1ll_2.iccount;
13099 			goto L15;
13100 		    } else if (*(unsigned char *)dumq == 'H' && iposn > 1) {
13101 			i__4 = a1ll_2.iccount;
13102 			if (s_cmp(lineq + i__4, "H", a1ll_2.iccount + 1 -
13103 				i__4, (ftnlen)1) == 0) {
13104 			    ++a1ll_2.iccount;
13105 			}
13106 			goto L15;
13107 		    } else if (*(unsigned char *)dumq == 'p') {
13108 
13109 /*  local change in postscript slur/tie adjustment default */
13110 
13111 			if (comslur_1.fontslur) {
13112 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
13113 				    + a1ll_2.nbars + 1;
13114 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must use"
13115 				    " postscript slurs (\"Ap\") to use this o"
13116 				    "ption!", (ftnlen)128, (ftnlen)52);
13117 			    stop1_();
13118 			}
13119 			g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
13120 				ftnlen)1);
13121 			if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) {
13122 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
13123 				    + a1ll_2.nbars + 1;
13124 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expect"
13125 				    "ed \"+\" or \"-\" here!", (ftnlen)128, (
13126 				    ftnlen)25);
13127 			    stop1_();
13128 			}
13129 			g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
13130 				ftnlen)1);
13131 			if (i_indx("st", dumq, (ftnlen)2, (ftnlen)1) == 0) {
13132 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
13133 				    + a1ll_2.nbars + 1;
13134 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expect"
13135 				    "ed \"s\" or \"t\" here!", (ftnlen)128, (
13136 				    ftnlen)25);
13137 			    stop1_();
13138 			}
13139 			goto L15;
13140 		    } else if (*(unsigned char *)dumq != ' ') {
13141 			ic = *(unsigned char *)dumq;
13142 			if (ic >= 48 && ic <= 57 || ic >= 65 && ic <= 90) {
13143 			    if (iposn == 1) {
13144 				if (*(unsigned char *)durq == 't' &&
13145 					comslur_1.fontslur) {
13146 				    i__4 = c1omnotes_1.ibarcnt -
13147 					    c1omnotes_1.ibaroff +
13148 					    a1ll_2.nbars + 1;
13149 				    errmsg_(lineq, &a1ll_2.iccount, &i__4,
13150 					    "Slur ID not allowed on non-post"
13151 					    "script tie!", (ftnlen)128, (
13152 					    ftnlen)42);
13153 				    stop1_();
13154 				}
13155 				goto L15;
13156 			    }
13157 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
13158 				    + a1ll_2.nbars + 1;
13159 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "Slur ID "
13160 				    "must be 2nd character in slur symbol!", (
13161 				    ftnlen)128, (ftnlen)45);
13162 			    stop1_();
13163 			}
13164 			i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13165 				a1ll_2.nbars + 1;
13166 			errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"
13167 				"acter in slur symbol!", (ftnlen)128, (ftnlen)
13168 				33);
13169 			stop1_();
13170 		    }
13171 		    goto L110;
13172 		} else if (i_indx("0123456789#-nx_", durq, (ftnlen)15, (
13173 			ftnlen)1) > 0) {
13174 
13175 /*  We have a figure.  Only allow on 1st note of xtup */
13176 
13177 		    if (itup != 2) {
13178 			i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13179 				a1ll_2.nbars + 1;
13180 			errmsg_(lineq, &a1ll_2.iccount, &i__4, "Figure in xt"
13181 				"up only allowed on 1st note!", (ftnlen)128, (
13182 				ftnlen)40);
13183 			stop1_();
13184 		    } else if (*(unsigned char *)durq == 'x') {
13185 			i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13186 				a1ll_2.nbars + 1;
13187 			errmsg_(lineq, &a1ll_2.iccount, &i__4, "No floating "
13188 				"figures in xtuplets!", (ftnlen)128, (ftnlen)
13189 				32);
13190 			stop1_();
13191 		    }
13192 		    if (compage_1.usefig && c1ommvl_1.ivx == 1) {
13193 			*ifig = 1;
13194 		    }
13195 L26:
13196 		    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
13197 			    ftnlen)1);
13198 		    if (i_indx("0123456789#-n_.:", durq, (ftnlen)16, (ftnlen)
13199 			    1) > 0) {
13200 			goto L26;
13201 		    } else if (*(unsigned char *)durq == 's') {
13202 			comligfont_1.isligfont = TRUE_;
13203 			goto L26;
13204 		    } else if (*(unsigned char *)durq == '+') {
13205 
13206 /* vertical offset, must be integer then blank */
13207 
13208 			g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
13209 				ftnlen)1);
13210 			if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) !=
13211 				 0) {
13212 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
13213 				    + a1ll_2.nbars + 1;
13214 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "Integer "
13215 				    "for vertical offset expected here!", (
13216 				    ftnlen)128, (ftnlen)42);
13217 			    stop1_();
13218 			}
13219 			readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)
13220 				128, (ftnlen)1);
13221 			if (*(unsigned char *)durq != ' ') {
13222 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
13223 				    + a1ll_2.nbars + 1;
13224 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "Vertical"
13225 				    " offset must terminate figure!", (ftnlen)
13226 				    128, (ftnlen)38);
13227 			    stop1_();
13228 			}
13229 			--a1ll_2.iccount;
13230 			goto L26;
13231 		    } else if (*(unsigned char *)durq != ' ') {
13232 			i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13233 				a1ll_2.nbars + 1;
13234 			errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"
13235 				"acter in figure in xtuplet!", (ftnlen)128, (
13236 				ftnlen)39);
13237 			stop1_();
13238 		    }
13239 		    goto L110;
13240 		} else if (*(unsigned char *)durq == 'G') {
13241 		    ngr = 1;
13242 L79:
13243 		    g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (
13244 			    ftnlen)1);
13245 		    if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) > 0)
13246 			    {
13247 			readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)
13248 				128, (ftnlen)1);
13249 			ngr = i_nint(&fnum);
13250 			--a1ll_2.iccount;
13251 			goto L79;
13252 		    } else if (i_indx("AWulxs", charq, (ftnlen)6, (ftnlen)1)
13253 			    > 0) {
13254 			goto L79;
13255 		    } else if (*(unsigned char *)charq == 'm') {
13256 			g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128,
13257 				(ftnlen)1);
13258 			if (i_indx("01234", charq, (ftnlen)5, (ftnlen)1) == 0)
13259 				 {
13260 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
13261 				    + a1ll_2.nbars + 1;
13262 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "A digit "
13263 				    "less than 5 must follow \"m\" in a grace"
13264 				    " note!", (ftnlen)128, (ftnlen)52);
13265 			    stop1_();
13266 			}
13267 			goto L79;
13268 		    } else if (*(unsigned char *)charq == 'X') {
13269 
13270 /* Space before main note */
13271 
13272 			g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128,
13273 				(ftnlen)1);
13274 			if (i_indx("0123456789.", charq, (ftnlen)11, (ftnlen)
13275 				1) > 0) {
13276 			    readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (
13277 				    ftnlen)128, (ftnlen)1);
13278 			    --a1ll_2.iccount;
13279 			    goto L79;
13280 			} else {
13281 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
13282 				    + a1ll_2.nbars + 1;
13283 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "A number"
13284 				    " must follow \"X\" in a grace note!", (
13285 				    ftnlen)128, (ftnlen)41);
13286 			    stop1_();
13287 			}
13288 		    }
13289 
13290 /*  At this point, charq is first note name in rest (grace?) */
13291 
13292 		    i__4 = ngr;
13293 		    for (igr = 1; igr <= i__4; ++igr) {
13294 			numnum = 0;
13295 			if (igr > 1) {
13296 L75:
13297 			    g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)
13298 				    128, (ftnlen)1);
13299 			    if (*(unsigned char *)charq == ' ') {
13300 				goto L75;
13301 			    }
13302 			}
13303 			if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) ==
13304 				0) {
13305 			    i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
13306 				    + a1ll_2.nbars + 1;
13307 			    errmsg_(lineq, &a1ll_2.iccount, &i__5, "In grace"
13308 				    ", expected \"a\"-\"g\"!", (ftnlen)128, (
13309 				    ftnlen)27);
13310 			    stop1_();
13311 			}
13312 L78:
13313 			g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128,
13314 				(ftnlen)1);
13315 			if (*(unsigned char *)charq != ' ') {
13316 			    if (i_indx("1234567", charq, (ftnlen)7, (ftnlen)1)
13317 				     > 0) {
13318 				if (numnum == 1) {
13319 				    i__5 = c1omnotes_1.ibarcnt -
13320 					    c1omnotes_1.ibaroff +
13321 					    a1ll_2.nbars + 1;
13322 				    errmsg_(lineq, &a1ll_2.iccount, &i__5,
13323 					    "Only one of \"+-1234567\" allow"
13324 					    "ed here in grace!", (ftnlen)128, (
13325 					    ftnlen)46);
13326 				    stop1_();
13327 				}
13328 				numnum = 1;
13329 				goto L78;
13330 			    } else if (i_indx("+-nfs", charq, (ftnlen)5, (
13331 				    ftnlen)1) > 0) {
13332 				goto L78;
13333 			    }
13334 
13335 /*  Digits are possible octave numbers */
13336 
13337 			    i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
13338 				    + a1ll_2.nbars + 1;
13339 			    errmsg_(lineq, &a1ll_2.iccount, &i__5, "Illegal "
13340 				    "character after note name in grace!", (
13341 				    ftnlen)128, (ftnlen)43);
13342 			    stop1_();
13343 			}
13344 /* L71: */
13345 		    }
13346 		    goto L110;
13347 		} else /* if(complicated condition) */ {
13348 		    chax_(ch__2, (ftnlen)1, &c__92);
13349 		    if (*(unsigned char *)durq == *(unsigned char *)&ch__2[0])
13350 			     {
13351 			chklit_(lineq, &a1ll_2.iccount, &literr, (ftnlen)128);
13352 			if (literr > 0) {
13353 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
13354 				    + a1ll_2.nbars + 1;
13355 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, literq + (
13356 				    literr - 1) * 51, (ftnlen)128, (ftnlen)51)
13357 				    ;
13358 			    stop1_();
13359 			}
13360 			goto L110;
13361 		    } else if (*(unsigned char *)durq == 'M') {
13362 
13363 /*  Temporary trap until I get around putting this in pmxb */
13364 
13365 			i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13366 				a1ll_2.nbars + 1;
13367 			errmsg_(lineq, &a1ll_2.iccount, &i__4, "Macros not y"
13368 				"et allowed in xtuplets!", (ftnlen)128, (
13369 				ftnlen)35);
13370 			stop1_();
13371 		    } else if (*(unsigned char *)durq == 'X') {
13372 			i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13373 				a1ll_2.nbars + 1;
13374 			g1etx_(lineq, &a1ll_2.iccount, &c_false, &
13375 				comkeys_1.shifton, &i__4, &c1omnotes_1.udsp[
13376 				c1omnotes_1.ibarcnt + a1ll_2.nbars], &
13377 				c1omnotes_1.wheadpt, (ftnlen)128);
13378 			goto L110;
13379 		    } else if (*(unsigned char *)durq == 'z') {
13380 
13381 /*  Chord note in xtup.  Read past for now. */
13382 
13383 L33:
13384 			g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
13385 				ftnlen)1);
13386 			if (*(unsigned char *)durq != ' ') {
13387 			    goto L33;
13388 			}
13389 			goto L110;
13390 		    } else if (*(unsigned char *)durq == 'D') {
13391 
13392 /*  Dynamic mark */
13393 
13394 			i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13395 				a1ll_2.nbars + 1;
13396 			checkdyn_(lineq, &a1ll_2.iccount, &i__4, (ftnlen)128);
13397 			goto L110;
13398 		    } else if (*(unsigned char *)durq == '%') {
13399 			if (a1ll_2.iccount != 1) {
13400 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
13401 				    + a1ll_2.nbars + 1;
13402 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "Comment "
13403 				    "must have \"%\" in column 1!", (ftnlen)
13404 				    128, (ftnlen)34);
13405 			    stop1_();
13406 			}
13407 			a1ll_2.iccount = 128;
13408 			goto L110;
13409 		    } else if (*(unsigned char *)durq == '?') {
13410 			getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
13411 				ftnlen)1);
13412 			if (*(unsigned char *)durq == ' ') {
13413 			    --a1ll_2.iccount;
13414 			    goto L110;
13415 			}
13416 			if (*(unsigned char *)durq != '-') {
13417 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
13418 				    + a1ll_2.nbars + 1;
13419 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expectin"
13420 				    "g \"-\"", (ftnlen)128, (ftnlen)13);
13421 			    stop1_();
13422 			}
13423 			getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
13424 				ftnlen)1);
13425 			if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1)
13426 				 == 0) {
13427 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
13428 				    + a1ll_2.nbars + 1;
13429 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expectin"
13430 				    "g number", (ftnlen)128, (ftnlen)16);
13431 			    stop1_();
13432 			}
13433 			readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)
13434 				128, (ftnlen)1);
13435 			--a1ll_2.iccount;
13436 			goto L110;
13437 /* +++ */
13438 		    } else /* if(complicated condition) */ {
13439 			i__4 = a1ll_2.iccount;
13440 			i__5 = a1ll_2.iccount + 1;
13441 			if (*(unsigned char *)durq == ']' && s_cmp(lineq +
13442 				i__4, "[", a1ll_2.iccount + 1 - i__4, (ftnlen)
13443 				1) == 0 && s_cmp(lineq + i__5, " ",
13444 				a1ll_2.iccount + 2 - i__5, (ftnlen)1) == 0) {
13445 			    a1ll_2.iccount += 2;
13446 			    goto L110;
13447 /* +++ */
13448 			}
13449 		    }
13450 		}
13451 
13452 /*  End of xtup options. At this point symbol can only be note or rest */
13453 
13454 		if (i_indx("abcdefgr", durq, (ftnlen)8, (ftnlen)1) == 0) {
13455 		    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13456 			    a1ll_2.nbars + 1;
13457 		    errmsg_(lineq, &a1ll_2.iccount, &i__4, "In xtup, this ch"
13458 			    "aracter is not allowed!", (ftnlen)128, (ftnlen)39)
13459 			    ;
13460 		    stop1_();
13461 		} else if (*(unsigned char *)durq == 'r' && itup == ntup) {
13462 		    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13463 			    a1ll_2.nbars + 1;
13464 		    errmsg_(lineq, &a1ll_2.iccount, &i__4, "Sorry, PMX canno"
13465 			    "t end an xtuplet with a rest!", (ftnlen)128, (
13466 			    ftnlen)45);
13467 		    stop1_();
13468 		}
13469 L7:
13470 		g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
13471 			1);
13472 		if (i_indx("2345678ulcb", durq, (ftnlen)11, (ftnlen)1) > 0) {
13473 		    goto L7;
13474 		} else if (i_indx("sfn", durq, (ftnlen)3, (ftnlen)1) > 0) {
13475 
13476 /*  Check for MIDI-only accidental. Cannot coexist with accid. pos'n shift. */
13477 
13478 		    i__4 = a1ll_2.iccount;
13479 		    if (s_cmp(lineq + i__4, "i", a1ll_2.iccount + 1 - i__4, (
13480 			    ftnlen)1) == 0) {
13481 			++a1ll_2.iccount;
13482 		    }
13483 		    goto L7;
13484 		} else if (i_indx("+-<>", durq, (ftnlen)4, (ftnlen)1) > 0) {
13485 
13486 /*  May have either octave jump or shifted accid. on main xtup note */
13487 
13488 		    i__4 = a1ll_2.iccount;
13489 		    if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0 &&
13490 			    i_indx("01234567890", lineq + i__4, (ftnlen)11,
13491 			    a1ll_2.iccount + 1 - i__4) == 0) {
13492 			goto L7;
13493 		    }
13494 		    ++a1ll_2.iccount;
13495 		    readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128,
13496 			     (ftnlen)1);
13497 		    --a1ll_2.iccount;
13498 		    goto L7;
13499 		} else if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) {
13500 
13501 /*  Double an xtup note to make an unequal xtup */
13502 
13503 		    c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx -
13504 			    1] * 24 - 25] = bit_set(c1ommvl_1.nacc[
13505 			    c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
13506 			    24 - 25],18);
13507 		    ++ndoub;
13508 		    goto L7;
13509 		} else if (*(unsigned char *)durq == 'd') {
13510 		    c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx -
13511 			    1] * 24 - 25] = bit_set(c1ommvl_1.nacc[
13512 			    c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
13513 			    24 - 25],27);
13514 		    goto L7;
13515 		} else if (*(unsigned char *)durq != ' ') {
13516 		    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13517 			    a1ll_2.nbars + 1;
13518 		    errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal option o"
13519 			    "n xtuplet note!", (ftnlen)128, (ftnlen)31);
13520 		    stop1_();
13521 		}
13522 		if (itup == ntup - ndoub) {
13523 		    goto L3;
13524 		}
13525 /* L6: */
13526 	    }
13527 L3:
13528 
13529 /*  6==End of loop for xtuplet input */
13530 
13531 	    ;
13532 	} else if (*(unsigned char *)durq == 'm') {
13533 
13534 /*  Multi-bar rest: next 1 or two digits are # of bars. */
13535 
13536 	    if (a1ll_2.itsofar[a1ll_2.iv - 1] % a1ll_2.lenbar != 0) {
13537 		i__1 = a1ll_2.iccount - 1;
13538 		i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13539 			a1ll_2.nbars + 1;
13540 		errmsg_(lineq, &i__1, &i__4, "Multibar rest must start at be"
13541 			"ginning of bar!", (ftnlen)128, (ftnlen)45);
13542 		stop1_();
13543 	    } else if (a1ll_2.iv == 1 && c1omnotes_1.ibarmbr > 0) {
13544 		i__1 = a1ll_2.iccount - 1;
13545 		i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13546 			a1ll_2.nbars + 1;
13547 		errmsg_(lineq, &i__1, &i__4, "Multibar rest only OK at one t"
13548 			"ime per block!", (ftnlen)128, (ftnlen)44);
13549 		stop1_();
13550 	    }
13551 
13552 /*  For some purposes, pretend its one bar only */
13553 
13554 	    a1ll_2.nodur[a1ll_2.iv + a1ll_2.nnl[a1ll_2.iv - 1] * 24 - 25] =
13555 		    a1ll_2.lenbar;
13556 	    c1omnotes_1.ibarmbr = a1ll_2.nbars + 1;
13557 	    c1omnotes_1.mbrest = 0;
13558 /* 20        call g1etchar(lineq,iccount,durq) */
13559 	    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
13560 	    if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
13561 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13562 			a1ll_2.nbars + 1;
13563 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected an integer "
13564 			"after \"rm\"!", (ftnlen)128, (ftnlen)31);
13565 		stop1_();
13566 	    }
13567 	    readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
13568 		    ftnlen)1);
13569 	    c1omnotes_1.mbrest = i_nint(&fnum);
13570 	    --a1ll_2.iccount;
13571 /*          if (ichar(durq).ge.48.and.ichar(durq).le.57) then */
13572 /*            mbrest = 10*mbrest+ichar(durq)-48 */
13573 /*            go to 20 */
13574 /*          end if */
13575 	    if (a1ll_2.nv > 1) {
13576 		if (a1ll_2.iv == 1) {
13577 		    comkeys_1.mbrestsav = c1omnotes_1.mbrest;
13578 		} else {
13579 		    if (c1omnotes_1.mbrest != comkeys_1.mbrestsav) {
13580 			i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13581 				a1ll_2.nbars + 1;
13582 			errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must enter s"
13583 				"ame multi-bar rest in every voice!", (ftnlen)
13584 				128, (ftnlen)46);
13585 			stop1_();
13586 		    }
13587 		}
13588 
13589 /*  Zero out mbrestsav so can check at end of input block whether */
13590 /*    all voices have one */
13591 
13592 		if (a1ll_2.iv == a1ll_2.nv) {
13593 		    comkeys_1.mbrestsav = 0;
13594 		}
13595 	    }
13596 	    if (*(unsigned char *)durq != ' ') {
13597 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13598 			a1ll_2.nbars + 1;
13599 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"
13600 			"ter \"rm\"!", (ftnlen)128, (ftnlen)29);
13601 		stop1_();
13602 	    }
13603 	} else if (*(unsigned char *)durq == '.') {
13604 
13605 /*  Dotted pattern.  Close out note.  Mult time by 3/4. */
13606 /*  Set time for next note to 1/4.  Start the note. */
13607 
13608 	    idotform = 1;
13609 	} else if (*(unsigned char *)durq == ',') {
13610 	    idotform = 3;
13611 
13612 /*  Now flow to duration setting, as if durq=' ' */
13613 
13614 	} else if (i_indx("oL", durq, (ftnlen)2, (ftnlen)1) > 0) {
13615 
13616 /*  Suppress full bar rest, or look left for height */
13617 
13618 	    if (*(unsigned char *)charq != 'r') {
13619 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13620 			a1ll_2.nbars + 1;
13621 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\",\"L\" options "
13622 			"only legal for rest, not note!", (ftnlen)128, (ftnlen)
13623 			46);
13624 		stop1_();
13625 	    }
13626 	    goto L2;
13627 	} else if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) {
13628 
13629 /*  Double note for xtup.  Must check here in case "D" or "F" came before "x" or on */
13630 /*  last note of xtup.   Need to flag it in pmxa since affects horiz. spacing. */
13631 
13632 	    c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24
13633 		    - 25] = bit_set(c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[
13634 		    c1ommvl_1.ivx - 1] * 24 - 25],18);
13635 	    goto L2;
13636 	} else if (*(unsigned char *)durq == 'A') {
13637 
13638 /*  Main note accidental option */
13639 
13640 	    getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
13641 	    if (i_indx("o+-<>", durq, (ftnlen)5, (ftnlen)1) == 0) {
13642 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13643 			a1ll_2.nbars + 1;
13644 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\",+\",\"-\",\""
13645 			"<\",\">\" are the only legal options here!", (ftnlen)
13646 			128, (ftnlen)51);
13647 		stop1_();
13648 	    }
13649 
13650 /*  Need more stuff here */
13651 
13652 	    if (*(unsigned char *)durq != 'o') {
13653 
13654 /*  Back up 1, flow out, will get +|-|<|> next loop preceded by "A", and will */
13655 /*    proceed to number input checking */
13656 
13657 		--a1ll_2.iccount;
13658 	    }
13659 	    goto L2;
13660 	} else if (*(unsigned char *)durq != ' ') {
13661 	    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
13662 		    1;
13663 	    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character!", (
13664 		    ftnlen)128, (ftnlen)18);
13665 	    s_wsle(&io___618);
13666 	    do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11);
13667 	    i__1 = *(unsigned char *)durq;
13668 	    do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer));
13669 	    e_wsle();
13670 	    stop1_();
13671 	}
13672 
13673 /*  End of block for note options. */
13674 
13675 /*  Set the duration */
13676 
13677 	if (idotform > 0) {
13678 	    if (idotform == 1) {
13679 		a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
13680 			24 - 25] = i1fnodur_(&c1omnotes_1.nnodur, dotq, (
13681 			ftnlen)1) * 3 / 2;
13682 	    } else if (idotform == 2) {
13683 		a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
13684 			24 - 25] = a1ll_2.nodur[c1ommvl_1.ivx + (a1ll_2.nnl[
13685 			c1ommvl_1.ivx - 1] - 1) * 24 - 25] / 3;
13686 	    } else if (idotform == 3) {
13687 		a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
13688 			24 - 25] = i1fnodur_(&c1omnotes_1.nnodur, dotq, (
13689 			ftnlen)1);
13690 	    } else if (idotform == 4) {
13691 		a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
13692 			24 - 25] = a1ll_2.nodur[c1ommvl_1.ivx + (a1ll_2.nnl[
13693 			c1ommvl_1.ivx - 1] - 1) * 24 - 25] / 2;
13694 	    }
13695 	} else if (c1omnotes_1.ibarmbr != a1ll_2.nbars + 1 && ! fulbrp) {
13696 	    a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 -
13697 		    25] = i1fnodur_(&c1omnotes_1.nnodur, dotq, (ftnlen)1);
13698 
13699 /*  Check for double dot */
13700 
13701 	    if (c1omnotes_1.iddot == 1) {
13702 		a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
13703 			24 - 25] = a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[
13704 			c1ommvl_1.ivx - 1] * 24 - 25] * 7 / 6;
13705 		c1omnotes_1.iddot = 0;
13706 	    }
13707 	} else if (fulbrp) {
13708 	    a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 -
13709 		    25] = a1ll_2.lenbar;
13710 
13711 /*  Use a one-line function to set nnodur.  It gives inverse of ifnodur. */
13712 
13713 	    i__1 = (integer) (log(a1ll_2.lenbar + .1f) / .69315f) + 48;
13714 	    chax_(ch__2, (ftnlen)1, &i__1);
13715 	    c1omnotes_1.nnodur = i_indx("62514x0x37", ch__2, (ftnlen)10, (
13716 		    ftnlen)1) - 1;
13717 	    fulbrp = FALSE_;
13718 	}
13719 	a1ll_2.rest[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] =
13720 		 *(unsigned char *)charq == 'r';
13721 
13722 /*  If inside forced beam, check if note is beamable */
13723 
13724 	if (c1omget_1.fbon) {
13725 	    if (a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
13726 		    24 - 25] < 16) {
13727 		goto L120;
13728 	    }
13729 	    if (a1ll_2.nnl[c1ommvl_1.ivx - 1] > 1) {
13730 		if (a1ll_2.nodur[c1ommvl_1.ivx + (a1ll_2.nnl[c1ommvl_1.ivx -
13731 			1] - 1) * 24 - 25] == 0) {
13732 		    goto L120;
13733 		}
13734 	    }
13735 	    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
13736 		    1;
13737 	    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Unbeamable thing in forc"
13738 		    "ed beam!", (ftnlen)128, (ftnlen)32);
13739 	    stop1_();
13740 	}
13741 L120:
13742 
13743 /* Get number of prior bars for later check on whether note spans bar line */
13744 
13745 	nbb4 = a1ll_2.itsofar[c1ommvl_1.ivx - 1] / a1ll_2.lenbar;
13746 	a1ll_2.itsofar[c1ommvl_1.ivx - 1] += a1ll_2.nodur[c1ommvl_1.ivx +
13747 		a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25];
13748 	if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar == 0) {
13749 	    ++a1ll_2.nbars;
13750 	    if (comkeys_1.shifton) {
13751 		comkeys_1.barend = TRUE_;
13752 	    }
13753 
13754 /*  Will check barend when 1st note of next bar is entered. */
13755 
13756 	    if (a1ll_2.nbars > 15) {
13757 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13758 			a1ll_2.nbars + 1;
13759 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot have more tha"
13760 			"n 15 bars in an input block!", (ftnlen)128, (ftnlen)
13761 			48);
13762 		stop1_();
13763 	    }
13764 	    a1ll_2.nib[c1ommvl_1.ivx + a1ll_2.nbars * 24 - 25] = a1ll_2.nnl[
13765 		    c1ommvl_1.ivx - 1];
13766 	    if (a1ll_2.firstline && a1ll_2.lenbar != a1ll_2.lenbr1) {
13767 
13768 /*  Just finished the pickup bar for this voice. */
13769 
13770 		if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] != a1ll_2.lenbr0) {
13771 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13772 			    a1ll_2.nbars + 1;
13773 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Pickup bar lengt"
13774 			    "h disagrees with mtrnum0!", (ftnlen)128, (ftnlen)
13775 			    41);
13776 		    stop1_();
13777 		}
13778 		a1ll_2.lenbar = a1ll_2.lenbr1;
13779 		a1ll_2.itsofar[c1ommvl_1.ivx - 1] = 0;
13780 	    }
13781 	} else if (comkeys_1.barend) {
13782 	    if (comkeys_1.shifton) {
13783 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13784 			a1ll_2.nbars + 1;
13785 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"
13786 			"defined shift still on!", (ftnlen)128, (ftnlen)43);
13787 		stop1_();
13788 	    }
13789 	    comkeys_1.barend = FALSE_;
13790 	} else if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] / a1ll_2.lenbar > nbb4) {
13791 	    i__1 = a1ll_2.iccount - 1;
13792 	    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
13793 		    1;
13794 	    errmsg_(lineq, &i__1, &i__4, "This note spans a bar line!", (
13795 		    ftnlen)128, (ftnlen)27);
13796 	    stop1_();
13797 	}
13798 	if (idotform == 1 || idotform == 3) {
13799 	    g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
13800 	    if (i_indx("abcedfgr", charq, (ftnlen)8, (ftnlen)1) == 0) {
13801 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13802 			a1ll_2.nbars + 1;
13803 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected note name o"
13804 			"r \"r\" here!", (ftnlen)128, (ftnlen)31);
13805 		stop1_();
13806 	    }
13807 	    ++idotform;
13808 	    numnum = 1;
13809 	    goto L28;
13810 	}
13811 
13812 /*  End of sub block for note-rest */
13813 
13814     } else if (*(unsigned char *)charq == 'z') {
13815 	g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
13816 	if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == 0) {
13817 	    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
13818 		    1;
13819 	    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected chord note name"
13820 		    " here!", (ftnlen)128, (ftnlen)30);
13821 	    stop1_();
13822 	}
13823 L25:
13824 	g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
13825 /*        if (index('dre12345678',durq) .gt. 0) then */
13826 	if (i_indx("dre12345678c", durq, (ftnlen)12, (ftnlen)1) > 0) {
13827 	    goto L25;
13828 	} else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) {
13829 
13830 /* Check for midi-only accid. CANNOT coesist with accidental position tweaks, so */
13831 /*   MUST come right after "f,s,n" */
13832 
13833 	    i__1 = a1ll_2.iccount;
13834 	    if (s_cmp(lineq + i__1, "i", a1ll_2.iccount + 1 - i__1, (ftnlen)1)
13835 		     == 0) {
13836 		++a1ll_2.iccount;
13837 	    }
13838 	    goto L25;
13839 	} else if (*(unsigned char *)durq == 'A') {
13840 	    i__1 = a1ll_2.iccount - 2;
13841 	    if (i_indx("fsn", lineq + i__1, (ftnlen)3, a1ll_2.iccount - 1 -
13842 		    i__1) == 0) {
13843 		i__1 = a1ll_2.iccount - 1;
13844 		i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13845 			a1ll_2.nbars + 1;
13846 		errmsg_(lineq, &i__1, &i__4, "Must have \"f,s,n\" before \""
13847 			"A\" in chord note!", (ftnlen)128, (ftnlen)43);
13848 		stop1_();
13849 	    }
13850 	    goto L25;
13851 	} else if (i_indx("<>", durq, (ftnlen)2, (ftnlen)1) > 0) {
13852 	    i__1 = a1ll_2.iccount - 2;
13853 	    if (i_indx("fsnA", lineq + i__1, (ftnlen)4, a1ll_2.iccount - 1 -
13854 		    i__1) == 0) {
13855 /*          if (index('fsncA',lineq(iccount-1:iccount-1)) .eq. 0) then ! Causes problems */
13856 		i__1 = a1ll_2.iccount - 1;
13857 		i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13858 			a1ll_2.nbars + 1;
13859 		errmsg_(lineq, &i__1, &i__4, "Must have \"f,s,n,A\" before"
13860 			" \"<\" or \">\"!", (ftnlen)128, (ftnlen)38);
13861 		stop1_();
13862 	    }
13863 	    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
13864 	    if (i_indx("1234567890.", durq, (ftnlen)11, (ftnlen)1) == 0) {
13865 		i__1 = a1ll_2.iccount - 1;
13866 		i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13867 			a1ll_2.nbars + 1;
13868 		errmsg_(lineq, &i__1, &i__4, "Expected a number to start her"
13869 			"e for accidental shift!", (ftnlen)128, (ftnlen)53);
13870 		stop1_();
13871 	    }
13872 	    readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
13873 		    ftnlen)1);
13874 	    --a1ll_2.iccount;
13875 	    goto L25;
13876 	} else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
13877 	    i__1 = a1ll_2.iccount;
13878 	    if (i_indx("1234567890.", lineq + i__1, (ftnlen)11,
13879 		    a1ll_2.iccount + 1 - i__1) == 0) {
13880 		goto L25;
13881 	    }
13882 
13883 /*  Number or '.' (durq) follows +/- .   Get it. */
13884 
13885 	    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
13886 	    i__1 = a1ll_2.iccount;
13887 	    if (*(unsigned char *)durq == '.' && i_indx("1234567890", lineq +
13888 		    i__1, (ftnlen)10, a1ll_2.iccount + 1 - i__1) == 0) {
13889 		i__1 = a1ll_2.iccount - 1;
13890 		i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13891 			a1ll_2.nbars + 1;
13892 		errmsg_(lineq, &i__1, &i__4, "\".\" here must be followed by"
13893 			" a digit!", (ftnlen)128, (ftnlen)37);
13894 		stop1_();
13895 	    } else /* if(complicated condition) */ {
13896 		i__1 = a1ll_2.iccount - 3;
13897 		if (i_indx("sfndA", lineq + i__1, (ftnlen)5, a1ll_2.iccount -
13898 			2 - i__1) == 0) {
13899 		    i__1 = a1ll_2.iccount - 1;
13900 		    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13901 			    a1ll_2.nbars + 1;
13902 		    errmsg_(lineq, &i__1, &i__4, "Number after +/- must foll"
13903 			    "ow \"d,s,f,n,A\"!", (ftnlen)128, (ftnlen)41);
13904 		    stop1_();
13905 		}
13906 	    }
13907 	    readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
13908 		    ftnlen)1);
13909 	    if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
13910 		--a1ll_2.iccount;
13911 		goto L25;
13912 	    }
13913 
13914 /*  2nd +/- */
13915 
13916 	    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
13917 	    if (*(unsigned char *)durq == '.') {
13918 		g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
13919 			1);
13920 	    }
13921 	    if (i_indx("1234567890", durq, (ftnlen)10, (ftnlen)1) == 0) {
13922 		i__1 = a1ll_2.iccount - 1;
13923 		i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13924 			a1ll_2.nbars + 1;
13925 		errmsg_(lineq, &i__1, &i__4, "Expected a number here!", (
13926 			ftnlen)128, (ftnlen)23);
13927 		stop1_();
13928 	    }
13929 	    readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
13930 		    ftnlen)1);
13931 	    --a1ll_2.iccount;
13932 	    goto L25;
13933 	} else if (*(unsigned char *)durq != ' ') {
13934 	    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
13935 		    1;
13936 	    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in cho"
13937 		    "rd note!", (ftnlen)128, (ftnlen)32);
13938 	    stop1_();
13939 	}
13940     } else if (*(unsigned char *)charq == 'G') {
13941 	ngr = 1;
13942 L9:
13943 	g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
13944 	if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) > 0) {
13945 	    readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
13946 		    ftnlen)1);
13947 	    ngr = i_nint(&fnum);
13948 	    --a1ll_2.iccount;
13949 	    goto L9;
13950 	} else if (i_indx("AWulxs", charq, (ftnlen)6, (ftnlen)1) > 0) {
13951 	    goto L9;
13952 	} else if (*(unsigned char *)charq == 'm') {
13953 	    g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
13954 	    if (i_indx("01234", charq, (ftnlen)5, (ftnlen)1) == 0) {
13955 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13956 			a1ll_2.nbars + 1;
13957 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "A digit less than 5 "
13958 			"must follow \"m\" in a grace note!", (ftnlen)128, (
13959 			ftnlen)52);
13960 		stop1_();
13961 	    }
13962 	    goto L9;
13963 	} else if (*(unsigned char *)charq == 'X') {
13964 
13965 /* Space before main note */
13966 
13967 	    g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
13968 	    if (i_indx("0123456789.", charq, (ftnlen)11, (ftnlen)1) > 0) {
13969 		readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
13970 			ftnlen)1);
13971 		--a1ll_2.iccount;
13972 		goto L9;
13973 	    } else {
13974 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13975 			a1ll_2.nbars + 1;
13976 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number must foll"
13977 			"ow \"X\" in a grace note!", (ftnlen)128, (ftnlen)41);
13978 		stop1_();
13979 	    }
13980 	}
13981 
13982 /*  At this point, charq is first note name in rest (grace?) */
13983 
13984 	i__1 = ngr;
13985 	for (igr = 1; igr <= i__1; ++igr) {
13986 	    numnum = 0;
13987 	    if (igr > 1) {
13988 L55:
13989 		g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)
13990 			1);
13991 		if (*(unsigned char *)charq == ' ') {
13992 		    goto L55;
13993 		}
13994 	    }
13995 	    if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == 0) {
13996 		i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
13997 			a1ll_2.nbars + 1;
13998 		errmsg_(lineq, &a1ll_2.iccount, &i__4, "In grace, expected"
13999 			" \"a\"-\"g\"!", (ftnlen)128, (ftnlen)27);
14000 		stop1_();
14001 	    }
14002 L18:
14003 	    g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
14004 	    if (*(unsigned char *)charq != ' ') {
14005 		if (i_indx("1234567", charq, (ftnlen)7, (ftnlen)1) > 0) {
14006 		    if (numnum == 1) {
14007 			i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14008 				a1ll_2.nbars + 1;
14009 			errmsg_(lineq, &a1ll_2.iccount, &i__4, "Only one of"
14010 				" \"+-1234567\" allowed here in grace!", (
14011 				ftnlen)128, (ftnlen)46);
14012 			stop1_();
14013 		    }
14014 		    numnum = 1;
14015 		    goto L18;
14016 /*            else if (index('nfs',charq) .gt. 0) then */
14017 		} else if (i_indx("+-nfs", charq, (ftnlen)5, (ftnlen)1) > 0) {
14018 		    goto L18;
14019 		}
14020 
14021 /*  Digits are possible octave numbers */
14022 
14023 		i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14024 			a1ll_2.nbars + 1;
14025 		errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal character af"
14026 			"ter note name in grace!", (ftnlen)128, (ftnlen)43);
14027 		stop1_();
14028 	    }
14029 /* L19: */
14030 	}
14031     } else /* if(complicated condition) */ {
14032 	chax_(ch__2, (ftnlen)1, &c__92);
14033 	if (*(unsigned char *)charq == *(unsigned char *)&ch__2[0]) {
14034 	    chklit_(lineq, &a1ll_2.iccount, &literr, (ftnlen)128);
14035 	    if (literr > 0) {
14036 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14037 			a1ll_2.nbars + 1;
14038 		errmsg_(lineq, &a1ll_2.iccount, &i__1, literq + (literr - 1) *
14039 			 51, (ftnlen)128, (ftnlen)51);
14040 		stop1_();
14041 	    }
14042 	} else if (*(unsigned char *)charq == 'o') {
14043 
14044 /*  Ornament on non-xtup note. "o" symbol must come AFTER the affected note */
14045 
14046 	    if (a1ll_2.nnl[c1ommvl_1.ivx - 1] == 0) {
14047 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14048 			a1ll_2.nbars + 1;
14049 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\" must be in sam"
14050 			"e input block, after affected note!", (ftnlen)128, (
14051 			ftnlen)53);
14052 		stop1_();
14053 	    }
14054 	    g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)1);
14055 	    if (i_indx("(stmgx+Tupf._)e:>^bc", dumq, (ftnlen)20, (ftnlen)1) ==
14056 		     0) {
14057 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14058 			a1ll_2.nbars + 1;
14059 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal ornament!", (
14060 			ftnlen)128, (ftnlen)17);
14061 		stop1_();
14062 	    }
14063 	    if (*(unsigned char *)dumq == ':') {
14064 		g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
14065 			1);
14066 		if (*(unsigned char *)dumq != ' ') {
14067 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14068 			    a1ll_2.nbars + 1;
14069 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected blank a"
14070 			    "fter \"o:\"!", (ftnlen)128, (ftnlen)26);
14071 		    stop1_();
14072 		} else if (! comkeys_1.ornrpt) {
14073 		    i__1 = a1ll_2.iccount - 1;
14074 		    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14075 			    a1ll_2.nbars + 1;
14076 		    errmsg_(lineq, &i__1, &i__4, "Turned off repeated orname"
14077 			    "nts before they were on!", (ftnlen)128, (ftnlen)
14078 			    50);
14079 		    stop1_();
14080 		}
14081 		comkeys_1.ornrpt = FALSE_;
14082 	    } else if (*(unsigned char *)dumq == 'g') {
14083 		if (c1omget_1.issegno) {
14084 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14085 			    a1ll_2.nbars + 1;
14086 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry, only one"
14087 			    " \"segno\" per input block!", (ftnlen)128, (
14088 			    ftnlen)40);
14089 		    stop1_();
14090 		} else if (c1ommvl_1.ivx != 1) {
14091 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14092 			    a1ll_2.nbars + 1;
14093 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "segno can only b"
14094 			    "e in voice 1!", (ftnlen)128, (ftnlen)29);
14095 		    stop1_();
14096 		}
14097 		c1omget_1.issegno = TRUE_;
14098 L12:
14099 		g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
14100 			1);
14101 		if (*(unsigned char *)dumq == '-' || *(unsigned char *)dumq >=
14102 			 48 && *(unsigned char *)dumq <= 58) {
14103 		    goto L12;
14104 		}
14105 		if (*(unsigned char *)dumq != ' ') {
14106 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14107 			    a1ll_2.nbars + 1;
14108 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"
14109 			    "r in segno ornament symbol!", (ftnlen)128, (
14110 			    ftnlen)43);
14111 		    stop1_();
14112 		}
14113 	    } else if (*(unsigned char *)dumq == 'T') {
14114 
14115 /*  Trill.  may be followed by 't' and/or number.  read 'til blank */
14116 
14117 L22:
14118 		g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
14119 			1);
14120 		if (*(unsigned char *)dumq == ':') {
14121 		    i__1 = a1ll_2.iccount;
14122 		    if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, (
14123 			    ftnlen)1) != 0) {
14124 			i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14125 				a1ll_2.nbars + 1;
14126 			errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected bla"
14127 				"nk after \":\"!", (ftnlen)128, (ftnlen)25);
14128 			stop1_();
14129 		    }
14130 		    goto L32;
14131 		} else if (*(unsigned char *)dumq != ' ') {
14132 		    goto L22;
14133 		}
14134 	    } else if (*(unsigned char *)dumq == 'f') {
14135 		g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
14136 			1);
14137 		if (i_indx(" d+-:", dumq, (ftnlen)5, (ftnlen)1) == 0) {
14138 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14139 			    a1ll_2.nbars + 1;
14140 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"
14141 			    "r after \"f\" in fermata ornament symbol!", (
14142 			    ftnlen)128, (ftnlen)55);
14143 		    stop1_();
14144 		}
14145 		if (*(unsigned char *)dumq == 'd') {
14146 		    g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
14147 			    ftnlen)1);
14148 		}
14149 		if (*(unsigned char *)dumq == ':') {
14150 		    goto L32;
14151 		}
14152 	    } else if (*(unsigned char *)dumq == 'e') {
14153 		g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
14154 			1);
14155 		if (i_indx("sfn?", dumq, (ftnlen)4, (ftnlen)1) == 0) {
14156 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14157 			    a1ll_2.nbars + 1;
14158 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"
14159 			    "r after \"e\" in edit. accid. symbol!", (ftnlen)
14160 			    128, (ftnlen)51);
14161 		    stop1_();
14162 		}
14163 		g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
14164 			1);
14165 		if (*(unsigned char *)dumq == '?') {
14166 		    g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
14167 			    ftnlen)1);
14168 		}
14169 	    } else {
14170 		g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
14171 			1);
14172 	    }
14173 	    if (i_indx("+- :", dumq, (ftnlen)4, (ftnlen)1) == 0) {
14174 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14175 			a1ll_2.nbars + 1;
14176 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"
14177 			" ornament symbol!", (ftnlen)128, (ftnlen)37);
14178 		stop1_();
14179 	    }
14180 	    if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
14181 		i__1 = a1ll_2.iccount;
14182 		if (i_indx("0123456789", lineq + i__1, (ftnlen)10,
14183 			a1ll_2.iccount + 1 - i__1) == 0) {
14184 		    i__1 = a1ll_2.iccount + 1;
14185 		    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14186 			    a1ll_2.nbars + 1;
14187 		    errmsg_(lineq, &i__1, &i__4, "There should be an integer"
14188 			    " here!", (ftnlen)128, (ftnlen)32);
14189 		    stop1_();
14190 		}
14191 		readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
14192 			ftnlen)1);
14193 		if (*(unsigned char *)durq == ':') {
14194 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14195 			    a1ll_2.nbars + 1;
14196 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot shift AND"
14197 			    " repeat an ornament!", (ftnlen)128, (ftnlen)36);
14198 		    stop1_();
14199 		}
14200 
14201 /*  12/7/03 Allow horizontal shift on any ornament, not just breath and caes. */
14202 
14203 		if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
14204 		    i__1 = a1ll_2.iccount;
14205 		    if (i_indx(".0123456789", lineq + i__1, (ftnlen)11,
14206 			    a1ll_2.iccount + 1 - i__1) == 0) {
14207 			i__1 = a1ll_2.iccount + 1;
14208 			i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14209 				a1ll_2.nbars + 1;
14210 			errmsg_(lineq, &i__1, &i__4, "There should be a numb"
14211 				"er here!", (ftnlen)128, (ftnlen)30);
14212 			stop1_();
14213 		    }
14214 		    readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128,
14215 			     (ftnlen)1);
14216 		}
14217 	    }
14218 L32:
14219 	    if (*(unsigned char *)dumq == ':') {
14220 		i__1 = a1ll_2.iccount;
14221 		if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, (
14222 			ftnlen)1) != 0) {
14223 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14224 			    a1ll_2.nbars + 1;
14225 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "\":\" must be fo"
14226 			    "llowed by blank in \"o: \"!", (ftnlen)128, (
14227 			    ftnlen)39);
14228 		    stop1_();
14229 		} else if (comkeys_1.ornrpt) {
14230 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14231 			    a1ll_2.nbars + 1;
14232 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned on repeat"
14233 			    "ed ornaments but already on!", (ftnlen)128, (
14234 			    ftnlen)44);
14235 		    stop1_();
14236 		}
14237 		comkeys_1.ornrpt = TRUE_;
14238 	    }
14239 	} else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0) {
14240 	    numint = 0;
14241 	    iposn = 0;
14242 L8:
14243 	    g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)1);
14244 	    ++iposn;
14245 	    if (*(unsigned char *)charq == 't' && *(unsigned char *)dumq ==
14246 		    't') {
14247 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14248 			a1ll_2.nbars + 1;
14249 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot use \"t\" as "
14250 			"an option on a tie!", (ftnlen)128, (ftnlen)37);
14251 		stop1_();
14252 	    }
14253 	    if (i_indx("udltb+-fnhHps ", dumq, (ftnlen)14, (ftnlen)1) == 0) {
14254 
14255 /*  Check for explicit ID code. */
14256 
14257 		ic = *(unsigned char *)dumq;
14258 		if (ic < 48 || ic > 57 && ic < 65 || ic > 90) {
14259 
14260 /*  Not 0-9 or A-Z, so exit */
14261 
14262 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14263 			    a1ll_2.nbars + 1;
14264 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"
14265 			    "r in slur symbol!", (ftnlen)128, (ftnlen)33);
14266 		    stop1_();
14267 		} else {
14268 
14269 /*  It is a possible ID code.  Right place? */
14270 
14271 		    if (iposn != 1) {
14272 
14273 /*  Slur ID is not 2nd! */
14274 
14275 			i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14276 				a1ll_2.nbars + 1;
14277 			errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID must"
14278 				" be second character in slur symbol!", (
14279 				ftnlen)128, (ftnlen)48);
14280 			stop1_();
14281 		    } else if (*(unsigned char *)charq == 't' &&
14282 			    comslur_1.fontslur) {
14283 			i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14284 				a1ll_2.nbars + 1;
14285 			errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID not "
14286 				"allowed on non-postscript tie!", (ftnlen)128,
14287 				(ftnlen)42);
14288 			stop1_();
14289 		    }
14290 		}
14291 
14292 /*  Slur ID is OK. Note it cannot be "H" at this point.. */
14293 
14294 		goto L8;
14295 	    } else if (*(unsigned char *)dumq == 'H') {
14296 		if (iposn == 1) {
14297 		    goto L8;
14298 		}
14299 
14300 /*  "H" is NOT an ID code. */
14301 
14302 		if (! comslur_1.fontslur && *(unsigned char *)charq == 't') {
14303 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14304 			    a1ll_2.nbars + 1;
14305 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot reshape p"
14306 			    "ostscript ties this way!", (ftnlen)128, (ftnlen)
14307 			    40);
14308 		    stop1_();
14309 		}
14310 		i__1 = a1ll_2.iccount;
14311 		if (s_cmp(lineq + i__1, "H", a1ll_2.iccount + 1 - i__1, (
14312 			ftnlen)1) == 0) {
14313 		    ++a1ll_2.iccount;
14314 		    ++iposn;
14315 		}
14316 		goto L8;
14317 	    } else if (i_indx("fh", dumq, (ftnlen)2, (ftnlen)1) > 0 && !
14318 		    comslur_1.fontslur && *(unsigned char *)charq == 't') {
14319 
14320 /*  3/9/03 Can't reshape postscript tie. */
14321 
14322 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14323 			a1ll_2.nbars + 1;
14324 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot reshape posts"
14325 			"cript ties this way!", (ftnlen)128, (ftnlen)40);
14326 		stop1_();
14327 	    } else if (*(unsigned char *)dumq == 'p') {
14328 
14329 /*  local change in postscript slur/tie adjustment default */
14330 
14331 		if (comslur_1.fontslur) {
14332 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14333 			    a1ll_2.nbars + 1;
14334 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must use postscr"
14335 			    "ipt slurs (\"Ap\") to use this option!", (ftnlen)
14336 			    128, (ftnlen)52);
14337 		    stop1_();
14338 		}
14339 		g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
14340 			1);
14341 		if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) {
14342 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14343 			    a1ll_2.nbars + 1;
14344 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \"+\" o"
14345 			    "r \"-\" here!", (ftnlen)128, (ftnlen)25);
14346 		    stop1_();
14347 		}
14348 		g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
14349 			1);
14350 		if (i_indx("st", dumq, (ftnlen)2, (ftnlen)1) == 0) {
14351 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14352 			    a1ll_2.nbars + 1;
14353 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \"s\" o"
14354 			    "r \"t\" here!", (ftnlen)128, (ftnlen)25);
14355 		    stop1_();
14356 		}
14357 		iposn += 2;
14358 		goto L8;
14359 	    }
14360 	    if (i_indx("udltbfnh", dumq, (ftnlen)8, (ftnlen)1) > 0) {
14361 		goto L8;
14362 	    } else if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
14363 		++numint;
14364 		if (comslur_1.fontslur && *(unsigned char *)charq == 't') {
14365 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14366 			    a1ll_2.nbars + 1;
14367 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+|-\" for slur"
14368 			    " height only allowed in \"s\"-slurs!", (ftnlen)
14369 			    128, (ftnlen)48);
14370 		    stop1_();
14371 		}
14372 		++a1ll_2.iccount;
14373 		readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
14374 			ftnlen)1);
14375 		if (numint == 1) {
14376 		    if (i_nint(&fnum) > 30) {
14377 			i__1 = a1ll_2.iccount - 1;
14378 			i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14379 				a1ll_2.nbars + 1;
14380 			errmsg_(lineq, &i__1, &i__4, "Magnitude of slur heig"
14381 				"ht adjustment cannot exceed 30!", (ftnlen)128,
14382 				 (ftnlen)53);
14383 			stop1_();
14384 		    }
14385 		} else if (numint == 2) {
14386 		    if (dabs(fnum) > 6.3f) {
14387 			i__1 = a1ll_2.iccount - 1;
14388 			i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14389 				a1ll_2.nbars + 1;
14390 			errmsg_(lineq, &i__1, &i__4, "Slur horiz shift must "
14391 				"be in range (-6.3,6.3)!", (ftnlen)128, (
14392 				ftnlen)45);
14393 			stop1_();
14394 		    }
14395 		} else {
14396 
14397 /*  Third signed integer, must be a midslur or curve spec. */
14398 
14399 		    if (dabs(fnum) > 31.f) {
14400 			i__1 = a1ll_2.iccount - 1;
14401 			i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14402 				a1ll_2.nbars + 1;
14403 			errmsg_(lineq, &i__1, &i__4, "Slur midheight must be"
14404 				" in the range (-31,31)!", (ftnlen)128, (
14405 				ftnlen)45);
14406 			stop1_();
14407 		    }
14408 		    if (*(unsigned char *)durq == ':') {
14409 
14410 /*  Expecting curve parameters.  Get two numbers */
14411 
14412 			for (i__ = 1; i__ <= 2; ++i__) {
14413 			    ++a1ll_2.iccount;
14414 			    fnum = (real) (*(unsigned char *)&lineq[
14415 				    a1ll_2.iccount - 1] - 48);
14416 			    if ((r__1 = fnum - 3.5f, dabs(r__1)) > 3.6f) {
14417 				i__1 = c1omnotes_1.ibarcnt -
14418 					c1omnotes_1.ibaroff + a1ll_2.nbars +
14419 					1;
14420 				errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur"
14421 					" curve parameter must be in range (0"
14422 					",7)!", (ftnlen)128, (ftnlen)44);
14423 				stop1_();
14424 			    }
14425 /* L41: */
14426 			}
14427 			++a1ll_2.iccount;
14428 		    }
14429 		}
14430 		--a1ll_2.iccount;
14431 		goto L8;
14432 	    } else if (*(unsigned char *)dumq == 's') {
14433 
14434 /* What follows should be one or two signed numbers for adjustment of line break */
14435 /* slur, end of 1st segment or start of second. */
14436 
14437 		if (comslur_1.fontslur) {
14438 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14439 			    a1ll_2.nbars + 1;
14440 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "May not use line"
14441 			    "break slur options with font-based slurs!", (
14442 			    ftnlen)128, (ftnlen)57);
14443 		    stop1_();
14444 		}
14445 		g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
14446 			1);
14447 		if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) {
14448 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14449 			    a1ll_2.nbars + 1;
14450 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character m"
14451 			    "ust be \"+\" or \"-\"!", (ftnlen)128, (ftnlen)34);
14452 		    stop1_();
14453 		}
14454 		++a1ll_2.iccount;
14455 		readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)128, (
14456 			ftnlen)1);
14457 		if (i_nint(&fnum) > 30) {
14458 		    i__1 = a1ll_2.iccount - 1;
14459 		    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14460 			    a1ll_2.nbars + 1;
14461 		    errmsg_(lineq, &i__1, &i__4, "Magnitude of slur height a"
14462 			    "djustment cannot exceed 30!", (ftnlen)128, (
14463 			    ftnlen)53);
14464 		    stop1_();
14465 		}
14466 		if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
14467 		    ++a1ll_2.iccount;
14468 		    readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)128,
14469 			     (ftnlen)1);
14470 		    if (dabs(fnum) > 6.3f) {
14471 			i__1 = a1ll_2.iccount - 1;
14472 			i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14473 				a1ll_2.nbars + 1;
14474 			errmsg_(lineq, &i__1, &i__4, "Slur horiz shift must "
14475 				"be in range (-6.3,6.3)!", (ftnlen)128, (
14476 				ftnlen)45);
14477 			stop1_();
14478 		    }
14479 		}
14480 		--a1ll_2.iccount;
14481 		goto L8;
14482 	    } else if (*(unsigned char *)dumq == 'H' && iposn > 1) {
14483 		i__1 = a1ll_2.iccount;
14484 		if (s_cmp(lineq + i__1, "H", a1ll_2.iccount + 1 - i__1, (
14485 			ftnlen)1) == 0) {
14486 		    ++a1ll_2.iccount;
14487 		}
14488 		goto L8;
14489 	    }
14490 	} else if (*(unsigned char *)charq == '?') {
14491 	    getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
14492 	    if (*(unsigned char *)durq == ' ') {
14493 		--a1ll_2.iccount;
14494 	    } else {
14495 		if (*(unsigned char *)durq != '-') {
14496 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14497 			    a1ll_2.nbars + 1;
14498 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expecting \"-\"!",
14499 			     (ftnlen)128, (ftnlen)14);
14500 		    stop1_();
14501 		}
14502 		getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1)
14503 			;
14504 		if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) {
14505 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14506 			    a1ll_2.nbars + 1;
14507 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expecting number!"
14508 			    , (ftnlen)128, (ftnlen)17);
14509 		    stop1_();
14510 		}
14511 		readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
14512 			ftnlen)1);
14513 		--a1ll_2.iccount;
14514 	    }
14515 	} else if (*(unsigned char *)charq >= 48 && *(unsigned char *)charq <=
14516 		 57 || i_indx("#-nx_", charq, (ftnlen)5, (ftnlen)1) > 0) {
14517 
14518 /*  We have a figure.  Must come AFTER the note it goes under */
14519 
14520 	    if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] == 0 && (! a1ll_2.firstline
14521 		    || a1ll_2.lenbr0 == 0 || a1ll_2.lenbar == a1ll_2.lenbr0))
14522 		    {
14523 
14524 /*  Figure before first note in block */
14525 
14526 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14527 			a1ll_2.nbars + 1;
14528 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot put figure be"
14529 			"fore first note in block!", (ftnlen)128, (ftnlen)45);
14530 		stop1_();
14531 	    }
14532 	    if (*(unsigned char *)charq == 'x') {
14533 		indxb = i_indx(lineq + (a1ll_2.iccount - 1), " ", 128 - (
14534 			a1ll_2.iccount - 1), (ftnlen)1);
14535 		if (indxb < 5) {
14536 		    i__1 = a1ll_2.iccount + indxb - 1;
14537 		    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14538 			    a1ll_2.nbars + 1;
14539 		    errmsg_(lineq, &i__1, &i__4, "Cannot have a blank here i"
14540 			    "n floating figure!", (ftnlen)128, (ftnlen)44);
14541 		    stop1_();
14542 		}
14543 	    }
14544 	    if (compage_1.usefig) {
14545 		*ifig = 1;
14546 	    }
14547 L5:
14548 	    g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
14549 	    if (i_indx(" 0123456789#-nx_.:+s", charq, (ftnlen)20, (ftnlen)1)
14550 		    == 0) {
14551 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14552 			a1ll_2.nbars + 1;
14553 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"
14554 			" figure!", (ftnlen)128, (ftnlen)28);
14555 		stop1_();
14556 	    } else if (*(unsigned char *)charq == '+') {
14557 
14558 /* vertical offset, must be integer, then blank */
14559 
14560 		g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)
14561 			1);
14562 		if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) == 0) {
14563 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14564 			    a1ll_2.nbars + 1;
14565 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Integer for vert"
14566 			    "ical offset expected here!", (ftnlen)128, (ftnlen)
14567 			    42);
14568 		    stop1_();
14569 		}
14570 		readnum_(lineq, &a1ll_2.iccount, charq, &fnum, (ftnlen)128, (
14571 			ftnlen)1);
14572 		if (*(unsigned char *)charq != ' ') {
14573 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14574 			    a1ll_2.nbars + 1;
14575 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Vertical offset "
14576 			    "must terminate figure!", (ftnlen)128, (ftnlen)38);
14577 		    stop1_();
14578 		}
14579 		--a1ll_2.iccount;
14580 		goto L5;
14581 	    } else if (*(unsigned char *)charq == 's') {
14582 		comligfont_1.isligfont = TRUE_;
14583 	    }
14584 	    if (*(unsigned char *)charq != ' ') {
14585 		goto L5;
14586 	    }
14587 	} else if (*(unsigned char *)charq == '[') {
14588 	    if (c1omget_1.fbon) {
14589 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14590 			a1ll_2.nbars + 1;
14591 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Started forced beam "
14592 			"while another was open!", (ftnlen)128, (ftnlen)43);
14593 		stop1_();
14594 	    }
14595 	    c1omget_1.fbon = TRUE_;
14596 L17:
14597 	    g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
14598 	    if (i_indx("uljhf:", charq, (ftnlen)6, (ftnlen)1) > 0) {
14599 		goto L17;
14600 	    } else if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) > 0) {
14601 		++a1ll_2.iccount;
14602 		readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
14603 			ftnlen)1);
14604 		--a1ll_2.iccount;
14605 		goto L17;
14606 	    } else if (*(unsigned char *)charq == 'm') {
14607 
14608 /*  Forced multiplicity, next char should be 1-4 */
14609 
14610 		g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)
14611 			1);
14612 		if (i_indx("1234", charq, (ftnlen)4, (ftnlen)1) == 0) {
14613 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14614 			    a1ll_2.nbars + 1;
14615 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced multiplic"
14616 			    "ity for a beam must be 1, 2, 3, or 4!", (ftnlen)
14617 			    128, (ftnlen)53);
14618 		    stop1_();
14619 		}
14620 		goto L17;
14621 	    } else if (*(unsigned char *)charq != ' ') {
14622 		if (i_indx("0123456789", charq, (ftnlen)10, (ftnlen)1) > 0) {
14623 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14624 			    a1ll_2.nbars + 1;
14625 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"[\", dig"
14626 			    "its must now be preceeded by \"+\" or \"-\"!", (
14627 			    ftnlen)128, (ftnlen)54);
14628 		    s_wsle(&io___621);
14629 		    do_lio(&c__9, &c__1, "You will have to edit older source"
14630 			    "s to meet this rqmt,", (ftnlen)54);
14631 		    e_wsle();
14632 		    s_wsle(&io___622);
14633 		    do_lio(&c__9, &c__1, "but it was needed to allow 2-digit"
14634 			    " height adjustments.", (ftnlen)54);
14635 		    e_wsle();
14636 		    s_wsle(&io___623);
14637 		    do_lio(&c__9, &c__1, "Sorry for the inconvenience.  --Th"
14638 			    "e Management", (ftnlen)46);
14639 		    e_wsle();
14640 		} else {
14641 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14642 			    a1ll_2.nbars + 1;
14643 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"
14644 			    "r after [!", (ftnlen)128, (ftnlen)26);
14645 		}
14646 		stop1_();
14647 	    }
14648 	} else if (*(unsigned char *)charq == ']') {
14649 	    if (! c1omget_1.fbon) {
14650 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14651 			a1ll_2.nbars + 1;
14652 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced beam stop wit"
14653 			"h no corresponding start!", (ftnlen)128, (ftnlen)45);
14654 		stop1_();
14655 	    }
14656 	    g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
14657 	    if (*(unsigned char *)charq == '-') {
14658 		i__1 = a1ll_2.iccount;
14659 		if (s_cmp(lineq + i__1, "[ ", a1ll_2.iccount + 2 - i__1, (
14660 			ftnlen)2) != 0) {
14661 		    i__1 = a1ll_2.iccount + 1;
14662 		    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14663 			    a1ll_2.nbars + 1;
14664 		    errmsg_(lineq, &i__1, &i__4, "Only sequence allowed here"
14665 			    " is \"[ \"!", (ftnlen)128, (ftnlen)35);
14666 		    stop1_();
14667 		} else {
14668 		    a1ll_2.iccount += 2;
14669 		}
14670 	    } else if (*(unsigned char *)charq == '[') {
14671 		i__1 = a1ll_2.iccount;
14672 		if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, (
14673 			ftnlen)1) != 0) {
14674 		    i__1 = a1ll_2.iccount + 1;
14675 		    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14676 			    a1ll_2.nbars + 1;
14677 		    errmsg_(lineq, &i__1, &i__4, "This character must be a b"
14678 			    "lank!", (ftnlen)128, (ftnlen)31);
14679 		    stop1_();
14680 		}
14681 	    } else {
14682 
14683 /*  Forced beam is really ending */
14684 
14685 		c1omget_1.fbon = FALSE_;
14686 		if (*(unsigned char *)charq == 'j') {
14687 		    i__1 = a1ll_2.iccount;
14688 		    if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, (
14689 			    ftnlen)1) != 0) {
14690 			i__1 = a1ll_2.iccount + 1;
14691 			i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14692 				a1ll_2.nbars + 1;
14693 			errmsg_(lineq, &i__1, &i__4, "This character must be"
14694 				" a blank!", (ftnlen)128, (ftnlen)31);
14695 			stop1_();
14696 		    }
14697 		} else if (*(unsigned char *)charq != ' ') {
14698 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14699 			    a1ll_2.nbars + 1;
14700 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"]\" must be fo"
14701 			    "llowed by blank, \"j\", \"-\", or \"[\"!", (
14702 			    ftnlen)128, (ftnlen)48);
14703 		    stop1_();
14704 		}
14705 	    }
14706 	} else if (*(unsigned char *)charq == 'D') {
14707 
14708 /*  Dynamic mark */
14709 
14710 	    if (a1ll_2.nnl[c1ommvl_1.ivx - 1] == 0) {
14711 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14712 			a1ll_2.nbars + 1;
14713 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"D\" must not come "
14714 			"before any notes have been entered!", (ftnlen)128, (
14715 			ftnlen)53);
14716 		stop1_();
14717 	    }
14718 	    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
14719 		    1;
14720 	    checkdyn_(lineq, &a1ll_2.iccount, &i__1, (ftnlen)128);
14721 	} else if (i_indx("lhw", charq, (ftnlen)3, (ftnlen)1) > 0) {
14722 
14723 /*  Save position for later check */
14724 
14725 	    icclhw = a1ll_2.iccount;
14726 	    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
14727 	    if (i_indx("0123456789.+- ", durq, (ftnlen)14, (ftnlen)1) == 0) {
14728 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14729 			a1ll_2.nbars + 1;
14730 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"
14731 			"ter \"l\", \"w\", or \"h\"!", (ftnlen)128, (ftnlen)41)
14732 			;
14733 		stop1_();
14734 	    }
14735 	    c1omget_1.isheadr = c1omget_1.isheadr || *(unsigned char *)charq
14736 		    == 'h';
14737 	    if (i_indx(" +-", durq, (ftnlen)3, (ftnlen)1) > 0) {
14738 
14739 /*  There is a header (or lower string?) */
14740 
14741 		if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
14742 
14743 /*  User-defined vert offset (\internote). */
14744 
14745 		    if (*(unsigned char *)charq != 'h') {
14746 			i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14747 				a1ll_2.nbars + 1;
14748 			errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+\" or \""
14749 				"-\" not permitted here!", (ftnlen)128, (
14750 				ftnlen)30);
14751 			stop1_();
14752 		    }
14753 
14754 /*  Have "h" followed by +/- .  Check for digit. */
14755 /*     Can blow durq since not using fnum for now, but... */
14756 
14757 		    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
14758 			    ftnlen)1);
14759 		    if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0)
14760 			    {
14761 			i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14762 				a1ll_2.nbars + 1;
14763 			errmsg_(lineq, &a1ll_2.iccount, &i__1, "There must b"
14764 				"e a digit here!", (ftnlen)128, (ftnlen)27);
14765 			stop1_();
14766 		    }
14767 
14768 /*  Have "h" followed by +/- followed by a digit.  No need to get the number. */
14769 
14770 /*           call readnum(lineq,iccount,durq,fnum) */
14771 		}
14772 		if (*(unsigned char *)charq != 'w') {
14773 
14774 /*  Header or lower string. */
14775 
14776 		    if (icclhw != 1) {
14777 			i__1 = a1ll_2.iccount - 1;
14778 			i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14779 				a1ll_2.nbars + 1;
14780 			errmsg_(lineq, &i__1, &i__4, "\"h\" or \"l\" must be"
14781 				" first character in line!", (ftnlen)128, (
14782 				ftnlen)43);
14783 			stop1_();
14784 		    }
14785 
14786 /*  Read past the next line, which has the string. */
14787 
14788 		    read10_(charq, &c1omget_1.lastchar, (ftnlen)1);
14789 		    ++c1omget_1.nline;
14790 		    a1ll_2.iccount = 128;
14791 		} else {
14792 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14793 			    a1ll_2.nbars + 1;
14794 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol \"w\" (wi"
14795 			    "dth) must be followed by a digit!", (ftnlen)128, (
14796 			    ftnlen)47);
14797 		    stop1_();
14798 		}
14799 	    } else {
14800 
14801 /*  Height or width change spec.  Check if at start of piece. */
14802 
14803 		if (c1omnotes_1.ibarcnt > 0) {
14804 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14805 			    a1ll_2.nbars + 1;
14806 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol must go a"
14807 			    "t top of first input block!", (ftnlen)128, (
14808 			    ftnlen)43);
14809 		    stop1_();
14810 		}
14811 		readnum_(lineq, &a1ll_2.iccount, durq, &dimen, (ftnlen)128, (
14812 			ftnlen)1);
14813 
14814 /*  Check units.  Convert to points */
14815 
14816 		if (*(unsigned char *)durq == ' ' || *(unsigned char *)durq ==
14817 			 'p') {
14818 		    dimen += .5f;
14819 		} else if (*(unsigned char *)durq == 'i') {
14820 		    dimen = dimen * 72 + .5f;
14821 		} else if (*(unsigned char *)durq == 'm') {
14822 		    dimen = dimen / 25.4f * 72 + .5f;
14823 		} else {
14824 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14825 			    a1ll_2.nbars + 1;
14826 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal unit; mu"
14827 			    "st be \"p\",\"i\",or\"m\"!", (ftnlen)128, (ftnlen)
14828 			    36);
14829 		    stop1_();
14830 		}
14831 		if (*(unsigned char *)charq == 'h') {
14832 		    compage_1.ptheight = (real) ((integer) dimen);
14833 		} else {
14834 		    compage_1.widthpt = (real) ((integer) dimen);
14835 		}
14836 	    }
14837 	} else if (*(unsigned char *)charq == 'm') {
14838 
14839 /*  Time signature change.  Only allow at beginning of block. */
14840 /*    mtrnuml, mtrdenl (logical) and p (printable) will be input. */
14841 /*    mtrnuml=0 initially. (In common) */
14842 
14843 /*  Check whether at beginning of a block */
14844 
14845 	    if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) {
14846 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14847 			a1ll_2.nbars + 1;
14848 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Meter change only OK"
14849 			" in voice 1, at start of block!", (ftnlen)128, (
14850 			ftnlen)51);
14851 		s_wsle(&io___626);
14852 		do_lio(&c__9, &c__1, "voice number is", (ftnlen)15);
14853 		do_lio(&c__3, &c__1, (char *)&c1ommvl_1.ivx, (ftnlen)sizeof(
14854 			integer));
14855 		e_wsle();
14856 		stop1_();
14857 	    }
14858 	    a1ll_2.newmeter = TRUE_;
14859 	    readmeter_(lineq, &a1ll_2.iccount, &a1ll_2.mtrnuml, &mtrdenl, (
14860 		    ftnlen)128);
14861 	    if (a1ll_2.mtrnuml == 0) {
14862 		i__1 = a1ll_2.iccount - 1;
14863 		i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14864 			a1ll_2.nbars + 1;
14865 		errmsg_(lineq, &i__1, &i__4, "Digit 0 not allowed here!", (
14866 			ftnlen)128, (ftnlen)25);
14867 		stop1_();
14868 /*        else if (mtrdenl .eq. 1) then */
14869 /* c */
14870 /* c  Kluge!!! */
14871 /* c */
14872 /*          mtrdenl = 2 */
14873 /*          mtrnuml = 2*mtrnuml */
14874 	    }
14875 	    readmeter_(lineq, &a1ll_2.iccount, &mtrnmp, &mtrdnp, (ftnlen)128);
14876 
14877 /*  Read past printed time signature; not used in pmxa. */
14878 
14879 	    lenbeat = i1fnodur_(&mtrdenl, "x", (ftnlen)1);
14880 	    lenmult = 1;
14881 	    if (mtrdenl == 2) {
14882 		lenbeat = 16;
14883 		lenmult = 2;
14884 	    }
14885 	    a1ll_2.lenbar = lenmult * a1ll_2.mtrnuml * lenbeat;
14886 	    a1ll_2.mtrnuml = 0;
14887 	} else if (*(unsigned char *)charq == 'C') {
14888 	    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
14889 	    if (! (i_indx("tsmanrbf", durq, (ftnlen)8, (ftnlen)1) > 0 || *(
14890 		    unsigned char *)durq >= 48 && *(unsigned char *)durq <=
14891 		    55)) {
14892 /*     *      (ichar(durq).ge.48 .and. ichar(durq).le.54))) then */
14893 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14894 			a1ll_2.nbars + 1;
14895 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have t,s,m,a,n,"
14896 			"r,b,f or 1-7 after C!", (ftnlen)128, (ftnlen)41);
14897 /*     *           'Must have t,s,m,a,n,r,b,f or 1-6 after C!') */
14898 		stop1_();
14899 	    }
14900 	    c1omnotes_1.gotclef = TRUE_;
14901 	} else if (*(unsigned char *)charq == 'R') {
14902 	    if (c1ommvl_1.ivx != 1) {
14903 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14904 			a1ll_2.nbars + 1;
14905 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Repeats can only go "
14906 			"in voice 1!", (ftnlen)128, (ftnlen)31);
14907 		stop1_();
14908 	    }
14909 L10:
14910 	    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
14911 	    if (i_indx("lrdDbz", durq, (ftnlen)6, (ftnlen)1) > 0) {
14912 		goto L10;
14913 	    }
14914 	    if (*(unsigned char *)durq != ' ') {
14915 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14916 			a1ll_2.nbars + 1;
14917 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"
14918 			"ter \"R\" (repeat/double bar)!", (ftnlen)128, (ftnlen)
14919 			48);
14920 		stop1_();
14921 	    }
14922 	} else if (*(unsigned char *)charq == 'V') {
14923 
14924 /*  Ending */
14925 
14926 	    if (a1ll_2.iv != 1) {
14927 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14928 			a1ll_2.nbars + 1;
14929 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Voltas are only allo"
14930 			"wed in voice #1!", (ftnlen)128, (ftnlen)36);
14931 		stop1_();
14932 	    } else if (c1omget_1.isvolt) {
14933 		s_wsle(&io___632);
14934 		e_wsle();
14935 		s_wsle(&io___633);
14936 		do_lio(&c__9, &c__1, "*******WARNING********", (ftnlen)22);
14937 		e_wsle();
14938 		s_wsfe(&io___634);
14939 		do_fio(&c__1, "*******WARNING********", (ftnlen)22);
14940 		e_wsfe();
14941 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14942 			a1ll_2.nbars + 1;
14943 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "There is more than o"
14944 			"ne volta in this input block.!", (ftnlen)128, (ftnlen)
14945 			50);
14946 		s_wsle(&io___635);
14947 		do_lio(&c__9, &c__1, "This may work in a score, but WILL NOT"
14948 			" work in parts.", (ftnlen)53);
14949 		e_wsle();
14950 		s_wsle(&io___636);
14951 		do_lio(&c__9, &c__1, "Safest to have only 1 volta per block,"
14952 			" at the start of the block", (ftnlen)64);
14953 		e_wsle();
14954 		s_wsfe(&io___637);
14955 		do_fio(&c__1, "This may work in a score, but WILL NOT work i"
14956 			"n parts.", (ftnlen)53);
14957 		e_wsfe();
14958 		s_wsfe(&io___638);
14959 		do_fio(&c__1, "Safest to have only 1 volta per block, at the"
14960 			" start of the block", (ftnlen)64);
14961 		e_wsfe();
14962 	    }
14963 	    c1omget_1.isvolt = TRUE_;
14964 	    lvoltxt = 0;
14965 L11:
14966 	    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
14967 	    if (*(unsigned char *)durq != ' ') {
14968 		goto L11;
14969 	    }
14970 	} else if (*(unsigned char *)charq == 'B') {
14971 	} else if (*(unsigned char *)charq == 'P') {
14972 	    if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) {
14973 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
14974 			a1ll_2.nbars + 1;
14975 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only allowed at begi"
14976 			"nning of block!", (ftnlen)128, (ftnlen)35);
14977 		stop1_();
14978 	    }
14979 L16:
14980 	    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
14981 	    if (*(unsigned char *)durq == 'l' || *(unsigned char *)durq ==
14982 		    'r' || *(unsigned char *)durq >= 48 && *(unsigned char *)
14983 		    durq <= 57) {
14984 		goto L16;
14985 	    }
14986 	    if (*(unsigned char *)durq == 'c') {
14987 
14988 /*  Expect a centered name, and it has to be last option */
14989 
14990 		g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
14991 			1);
14992 		if (*(unsigned char *)durq == '"') {
14993 
14994 /*  Quoted name, go to next quote mark */
14995 
14996 		    for (++a1ll_2.iccount; a1ll_2.iccount <= 127;
14997 			    ++a1ll_2.iccount) {
14998 			if (*(unsigned char *)&lineq[a1ll_2.iccount - 1] ==
14999 				'"') {
15000 			    goto L36;
15001 			}
15002 /* L35: */
15003 		    }
15004 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15005 			    a1ll_2.nbars + 1;
15006 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Missing close qu"
15007 			    "ote after page number command (P)!", (ftnlen)128,
15008 			    (ftnlen)50);
15009 		    stop1_();
15010 L36:
15011 		    ;
15012 		} else if (*(unsigned char *)durq != ' ') {
15013 
15014 /*  Space-delimited name, look for next blank */
15015 
15016 		    for (++a1ll_2.iccount; a1ll_2.iccount <= 127;
15017 			    ++a1ll_2.iccount) {
15018 			if (*(unsigned char *)&lineq[a1ll_2.iccount - 1] ==
15019 				' ') {
15020 			    goto L38;
15021 			}
15022 /* L37: */
15023 		    }
15024 L38:
15025 		    ;
15026 		}
15027 	    } else if (*(unsigned char *)durq != ' ') {
15028 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15029 			a1ll_2.nbars + 1;
15030 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\",\"r\",\""
15031 			"c\" or digit allowed after \"P\"!", (ftnlen)128, (
15032 			ftnlen)44);
15033 		stop1_();
15034 	    }
15035 	} else if (*(unsigned char *)charq == 'W') {
15036 	    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
15037 	    if (i_indx(".0123456789", durq, (ftnlen)11, (ftnlen)1) == 0) {
15038 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15039 			a1ll_2.nbars + 1;
15040 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected a number to"
15041 			" start here!", (ftnlen)128, (ftnlen)32);
15042 		stop1_();
15043 	    }
15044 	    readnum_(lineq, &a1ll_2.iccount, durq, &c1omnotes_1.wminnh[
15045 		    c1omnotes_1.ibarcnt + a1ll_2.nbars], (ftnlen)128, (ftnlen)
15046 		    1);
15047 	} else if (*(unsigned char *)charq == 'T') {
15048 
15049 /*  Titles */
15050 
15051 	    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
15052 	    if (i_indx("itc", durq, (ftnlen)3, (ftnlen)1) == 0) {
15053 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15054 			a1ll_2.nbars + 1;
15055 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must put \"i\", \""
15056 			"t\", or \"c\" after \"T\"!", (ftnlen)128, (ftnlen)36);
15057 		stop1_();
15058 	    }
15059 	    i__1 = i_indx("itc", durq, (ftnlen)3, (ftnlen)1) - 1;
15060 	    c1omget_1.ihead += pow_ii(&c__2, &i__1);
15061 
15062 /*  Maybe a number after 'Tt', but ignore here.  Read past string on next line. */
15063 
15064 	    read10_(charq, &c1omget_1.lastchar, (ftnlen)1);
15065 	    ++c1omget_1.nline;
15066 	    a1ll_2.iccount = 128;
15067 	} else if (*(unsigned char *)charq == 'A') {
15068 L27:
15069 	    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
15070 	    if (i_indx("rbsdeK", durq, (ftnlen)6, (ftnlen)1) > 0) {
15071 		goto L27;
15072 	    } else if (*(unsigned char *)durq == 'v') {
15073 		if (c1omnotes_1.ibarcnt == 0) {
15074 		    comnvst_1.novshrinktop = TRUE_;
15075 		}
15076 		goto L27;
15077 	    } else if (*(unsigned char *)durq == 'a') {
15078 		g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
15079 			1);
15080 		if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) {
15081 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15082 			    a1ll_2.nbars + 1;
15083 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"Aa\", ne"
15084 			    "ed decimal number!", (ftnlen)128, (ftnlen)32);
15085 		    stop1_();
15086 		}
15087 		readnum_(lineq, &a1ll_2.iccount, durq, &c1ommvl_1.fbar, (
15088 			ftnlen)128, (ftnlen)1);
15089 		--a1ll_2.iccount;
15090 		goto L27;
15091 	    } else if (*(unsigned char *)durq == 'i') {
15092 		g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
15093 			1);
15094 
15095 /*  Local interstaff correction.  Set to -1. if not specifiec, or after use, */
15096 /*  or anytime except at top, since pmxb handles all times except at top. */
15097 
15098 		readnum_(lineq, &a1ll_2.iccount, durq, &tintstf, (ftnlen)128,
15099 			(ftnlen)1);
15100 		if (c1omnotes_1.ibarcnt == 0) {
15101 		    compage_1.fintstf = tintstf;
15102 		}
15103 		--a1ll_2.iccount;
15104 		goto L27;
15105 	    } else if (*(unsigned char *)durq == 'I') {
15106 
15107 /*  Global interstaff correction.  Use in place of fintstf if fintstf<0 */
15108 
15109 		g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
15110 			1);
15111 		readnum_(lineq, &a1ll_2.iccount, durq, &compage_1.gintstf, (
15112 			ftnlen)128, (ftnlen)1);
15113 		--a1ll_2.iccount;
15114 		goto L27;
15115 	    } else if (*(unsigned char *)durq == 'o') {
15116 		*optimize = TRUE_;
15117 		goto L27;
15118 	    } else if (*(unsigned char *)durq == 'S') {
15119 /* 130324 */
15120 /*          do 50 iiv = 1 , nv */
15121 		i__1 = comkeys_1.noinst;
15122 		for (iiv = 1; iiv <= i__1; ++iiv) {
15123 		    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
15124 			    ftnlen)1);
15125 		    if (i_indx("-0st", durq, (ftnlen)4, (ftnlen)1) == 0) {
15126 			i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15127 				a1ll_2.nbars + 1;
15128 			errmsg_(lineq, &a1ll_2.iccount, &i__4, "After \"AS\""
15129 				", need nv instances of \"s,t,-,0\"!", (ftnlen)
15130 				128, (ftnlen)43);
15131 			stop1_();
15132 		    }
15133 		    if (*(unsigned char *)durq == '-' || *(unsigned char *)
15134 			    durq == 's') {
15135 			comsize_1.isize[iiv - 1] = 1;
15136 		    } else if (*(unsigned char *)durq == 't') {
15137 			comsize_1.isize[iiv - 1] = 2;
15138 		    }
15139 /* L50: */
15140 		}
15141 		goto L27;
15142 	    } else if (*(unsigned char *)durq == 'p') {
15143 		comslur_1.fontslur = FALSE_;
15144 L42:
15145 		g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
15146 			1);
15147 		if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
15148 
15149 /*  Characters to change defaults for ps slurs */
15150 
15151 		    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
15152 			    ftnlen)1);
15153 		    if (i_indx("shtc", durq, (ftnlen)4, (ftnlen)1) == 0) {
15154 			i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15155 				a1ll_2.nbars + 1;
15156 			errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only letters"
15157 				" allowed here are \"s\",\"h\",\"t\",\"c\"!", (
15158 				ftnlen)128, (ftnlen)46);
15159 			stop1_();
15160 		    }
15161 
15162 /*  Now check for another default modifier */
15163 
15164 		    goto L42;
15165 		} else if (i_indx("lh", durq, (ftnlen)2, (ftnlen)1) > 0) {
15166 
15167 /*  Flags for optional linebreak ties or header specials */
15168 
15169 		    goto L42;
15170 		} else {
15171 		    --a1ll_2.iccount;
15172 		}
15173 		goto L27;
15174 	    } else if (*(unsigned char *)durq == 'N') {
15175 
15176 /*  Override default name for a part file. Must have part number, then */
15177 /*    partname in quotes. Must be on line by itself, and start in column 1. */
15178 /*    Will only be passed thru to scor2prt. */
15179 
15180 		if (a1ll_2.iccount != 2) {
15181 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15182 			    a1ll_2.nbars + 1;
15183 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must star"
15184 			    "t in column 1!", (ftnlen)128, (ftnlen)28);
15185 		    stop1_();
15186 		}
15187 		ndxquote = i_indx(lineq, "\"", (ftnlen)128, (ftnlen)1);
15188 		if (ndxquote < 4 || ndxquote > 5 || i_indx("123456789", lineq
15189 			+ 2, (ftnlen)9, (ftnlen)1) == 0 || ndxquote == 5 &&
15190 			i_indx("012", lineq + 3, (ftnlen)3, (ftnlen)1) == 0) {
15191 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15192 			    a1ll_2.nbars + 1;
15193 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must be f"
15194 			    "ollowed by inst. #, then quote!", (ftnlen)128, (
15195 			    ftnlen)45);
15196 		    stop1_();
15197 		}
15198 		i__1 = ndxquote;
15199 		ndxquote = i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1);
15200 		if (ndxquote == 0) {
15201 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15202 			    a1ll_2.nbars + 1;
15203 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "In \"AN\", file "
15204 			    "name must be in quotes!", (ftnlen)128, (ftnlen)37)
15205 			    ;
15206 		    stop1_();
15207 		}
15208 		a1ll_2.iccount = 128;
15209 	    } else if (*(unsigned char *)durq == 'T') {
15210 		comnvst_1.cstuplet = TRUE_;
15211 	    } else if (*(unsigned char *)durq == 'R') {
15212 
15213 /*  Get full name of normal include file; must occupy remainder of line */
15214 
15215 		i__1 = a1ll_2.iccount;
15216 		getpmxmod_(&c_false, lineq + i__1, 128 - i__1);
15217 		a1ll_2.iccount = 128;
15218 	    } else if (*(unsigned char *)durq == 'c') {
15219 		g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
15220 			1);
15221 		if (i_indx("l4", durq, (ftnlen)2, (ftnlen)1) == 0) {
15222 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15223 			    a1ll_2.nbars + 1;
15224 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\" or"
15225 			    " \"4\" is allowed here!", (ftnlen)128, (ftnlen)32)
15226 			    ;
15227 		    stop1_();
15228 		}
15229 		if (*(unsigned char *)durq == 'l') {
15230 		    compage_1.hoffpt = -25.f;
15231 		    compage_1.voffpt = -45.f;
15232 		} else if (*(unsigned char *)durq == '4') {
15233 		    compage_1.ptheight = 745.f;
15234 		    compage_1.widthpt = 499.f;
15235 		    compage_1.hoffpt = -24.f;
15236 		    compage_1.voffpt = -24.f;
15237 		}
15238 		goto L27;
15239 	    } else if (*(unsigned char *)durq != ' ') {
15240 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15241 			a1ll_2.nbars + 1;
15242 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"A\" must fol"
15243 			"low one of the letters abcdeiINprRsST!", (ftnlen)128,
15244 			(ftnlen)56);
15245 		s_wsle(&io___643);
15246 		do_lio(&c__9, &c__1, "For AS, since ver. 2.7, must only have"
15247 			" noinst args.", (ftnlen)51);
15248 		e_wsle();
15249 		s_wsfe(&io___644);
15250 		do_fio(&c__1, "For AS, since ver. 2.7, must only have noinst"
15251 			" args.", (ftnlen)51);
15252 		e_wsfe();
15253 		stop1_();
15254 	    }
15255 	} else if (*(unsigned char *)charq == 'K') {
15256 
15257 /*  Rules and function of K command */
15258 
15259 /*  Only 1 K +/-n +/-m  allowed per block if n.ne.0 (transposition).  isig1 is */
15260 /*  initial sig, and must be passed to pmxb because it is needed when topfile */
15261 /*  is called, which is before the K+n+m command is read in pmxb.  Also, we */
15262 /*  compute and save ibrkch and newkey for each syst, accounting for key changes, */
15263 /*  then adjust fbar to make poenom much more accurate. */
15264 /*  Jan 02: Now K-0+[n] is used to transpose e.g. from f to f#. */
15265 
15266 L77:
15267 	    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
15268 /*        if (index('+-i',durq) .eq. 0) then */
15269 	    if (i_indx("+-in", durq, (ftnlen)4, (ftnlen)1) == 0) {
15270 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15271 			a1ll_2.nbars + 1;
15272 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"K\" (transpose or "
15273 			"key change) must be followed by \"+,-,i,n\"!", (
15274 			ftnlen)128, (ftnlen)60);
15275 		stop1_();
15276 	    }
15277 	    if (*(unsigned char *)durq == 'n') {
15278 		goto L77;
15279 	    }
15280 	    if (*(unsigned char *)durq != 'i') {
15281 
15282 /* Normal key change and/or transposition) */
15283 
15284 /*          iccount = iccount+1 */
15285 		num1 = 44 - *(unsigned char *)durq;
15286 
15287 /*  num1= +1 or -1 */
15288 
15289 		ztrans = num1 == -1;
15290 		g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
15291 			1);
15292 		if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) {
15293 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15294 			    a1ll_2.nbars + 1;
15295 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st +/- must be "
15296 			    "followed by a number!", (ftnlen)128, (ftnlen)37);
15297 		    stop1_();
15298 		}
15299 /*          iccount = iccount+1 */
15300 		readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
15301 			ftnlen)1);
15302 		num1 = i_nint(&fnum) * num1;
15303 		ztrans = ztrans && num1 == 0;
15304 		if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
15305 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15306 			    a1ll_2.nbars + 1;
15307 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st number aft"
15308 			    "er \"K\" must be followed by \"+,-\"!", (ftnlen)
15309 			    128, (ftnlen)47);
15310 		    stop1_();
15311 		}
15312 		++a1ll_2.iccount;
15313 		num2 = 44 - *(unsigned char *)durq;
15314 		readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
15315 			ftnlen)1);
15316 		num2 *= (integer) (fnum + .1f);
15317 		if (num1 == 0 && ! ztrans) {
15318 
15319 /*  Key change, only one per block allowed */
15320 
15321 		    if (comkeys_1.iskchb) {
15322 			i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15323 				a1ll_2.nbars + 1;
15324 			errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only one key"
15325 				" change allowed per input block!", (ftnlen)
15326 				128, (ftnlen)44);
15327 			stop1_();
15328 		    }
15329 		    comkeys_1.iskchb = TRUE_;
15330 		    ++comkeys_1.nkeys;
15331 		    comkeys_1.kchmid[comkeys_1.nkeys - 1] = a1ll_2.itsofar[
15332 			    c1ommvl_1.ivx - 1] % a1ll_2.lenbar != 0;
15333 
15334 /*  Make ibrkch = barnum-1 if at start of bar, so fsyst advances ok at linebreak. */
15335 
15336 		    comkeys_1.ibrkch[comkeys_1.nkeys - 1] =
15337 			    c1omnotes_1.ibarcnt + a1ll_2.nbars;
15338 		    if (comkeys_1.kchmid[comkeys_1.nkeys - 1]) {
15339 			++comkeys_1.ibrkch[comkeys_1.nkeys - 1];
15340 		    }
15341 		    comkeys_1.newkey[comkeys_1.nkeys - 1] = num2 +
15342 			    comkeys_1.idsig;
15343 /* 130316 */
15344 /*            do 43 iinst = 1 , noinst */
15345 		    commidisig_1.midisig = comkeys_1.newkey[comkeys_1.nkeys -
15346 			    1];
15347 /* 43          continue */
15348 		} else {
15349 
15350 /*  Transposition */
15351 
15352 		    *fulltrans = TRUE_;
15353 		    if (c1omnotes_1.ibarcnt > 0) {
15354 			i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15355 				a1ll_2.nbars + 1;
15356 			errmsg_(lineq, &a1ll_2.iccount, &i__1, "Transpositio"
15357 				"n must be at top of first input block!", (
15358 				ftnlen)128, (ftnlen)50);
15359 			stop1_();
15360 		    }
15361 		    comkeys_1.isig1 = num2;
15362 		    comkeys_1.idsig = comkeys_1.isig1 - comkeys_1.newkey[0];
15363 
15364 /*  idsig is the difference between sig after transposition, and sig in setup. */
15365 /*  It may alter # of accid's in key changes if there is transposition. */
15366 
15367 		}
15368 	    } else {
15369 
15370 /*  110522/110529 */
15371 /*  Instrument-wise transposition Ki[iInstTrans][+/-][iTransAmt][+/-][iTransKey] */
15372 /*    and repeat i[...] for multiple instruments. Store info here if ibarcnt=0 */
15373 /*    so can pass to topfile (via comInstTrans), which is called before getnote. */
15374 /*    Otherwise, will store info from getnote. Initialize EarlyTransOn and */
15375 /*    LaterInstTrans to .false. in blockdata. Set EarlyTransOn from here; */
15376 /*    LaterInstTrans from g1etnote. Zero both out after use. nInstTrans really */
15377 /*    only needed for instrument-signatures, not transpositions. iTransAmt is */
15378 /*    ALWAYS active per instrument. Set up instno(iv) so can fetch iTransAmt for */
15379 /*    each staff. */
15380 
15381 /*          if (fulltrans) then */
15382 /*            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, */
15383 /*     *       'Cannot yet combine full and instrument transposition!') */
15384 /*            call stop1() */
15385 /*          end if */
15386 /* durq='i' */
15387 		getitransinfo_(&c_true, &c1omnotes_1.ibarcnt, lineq, &
15388 			a1ll_2.iccount, &c1omnotes_1.ibaroff, &a1ll_2.nbars, &
15389 			comkeys_1.noinst, &a1ll_2.iv, (ftnlen)128);
15390 	    }
15391 	} else if (*(unsigned char *)charq == '|') {
15392 
15393 /*  Optional bar symbol */
15394 
15395 	    if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar != 0) {
15396 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15397 			a1ll_2.nbars + 1;
15398 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar line marker out "
15399 			"of place!", (ftnlen)128, (ftnlen)29);
15400 		stop1_();
15401 	    } else if (comkeys_1.shifton) {
15402 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15403 			a1ll_2.nbars + 1;
15404 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"
15405 			"defined shift still on!", (ftnlen)128, (ftnlen)43);
15406 		stop1_();
15407 	    }
15408 	} else if (*(unsigned char *)charq == '/') {
15409 	    if (comkeys_1.ornrpt) {
15410 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15411 			a1ll_2.nbars + 1;
15412 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Block ended"
15413 			" with repeated ornament still on!", (ftnlen)128, (
15414 			ftnlen)53);
15415 		comkeys_1.ornrpt = FALSE_;
15416 	    }
15417 	    if (comkeys_1.stickys) {
15418 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15419 			a1ll_2.nbars + 1;
15420 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Block ended"
15421 			" with sticky stemshrink still on!", (ftnlen)128, (
15422 			ftnlen)53);
15423 		comkeys_1.stickys = FALSE_;
15424 	    }
15425 	    if (c1omget_1.fbon) {
15426 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15427 			a1ll_2.nbars + 1;
15428 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block ended with for"
15429 			"ced beam open!", (ftnlen)128, (ftnlen)34);
15430 		stop1_();
15431 	    } else if (comkeys_1.shifton) {
15432 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15433 			a1ll_2.nbars + 1;
15434 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"
15435 			"defined shift still on!", (ftnlen)128, (ftnlen)43);
15436 		stop1_();
15437 	    } else if (c1omnotes_1.gotclef) {
15438 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15439 			a1ll_2.nbars + 1;
15440 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "May not enter clef a"
15441 			"t end of input block!", (ftnlen)128, (ftnlen)41);
15442 		stop1_();
15443 	    }
15444 	    comkeys_1.barend = FALSE_;
15445 
15446 /*  Perform time checks */
15447 
15448 	    if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar != 0) {
15449 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15450 			a1ll_2.nbars + 1;
15451 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block duration not d"
15452 			"ivisible by lenbar!", (ftnlen)128, (ftnlen)39);
15453 		s_wsle(&io___648);
15454 		do_lio(&c__9, &c__1, "lenbar is ", (ftnlen)10);
15455 		do_lio(&c__3, &c__1, (char *)&a1ll_2.lenbar, (ftnlen)sizeof(
15456 			integer));
15457 		e_wsle();
15458 		stop1_();
15459 	    } else if (c1ommvl_1.ivx > 1 && a1ll_2.itsofar[c1ommvl_1.ivx - 1]
15460 		    != a1ll_2.itsofar[0]) {
15461 		s_wsle(&io___649);
15462 		e_wsle();
15463 		s_wsle(&io___650);
15464 		do_lio(&c__9, &c__1, "# of bars in voice 1, current voice:", (
15465 			ftnlen)36);
15466 		i__1 = a1ll_2.itsofar[0] / a1ll_2.lenbar;
15467 		do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer));
15468 		i__4 = a1ll_2.itsofar[c1ommvl_1.ivx - 1] / a1ll_2.lenbar;
15469 		do_lio(&c__3, &c__1, (char *)&i__4, (ftnlen)sizeof(integer));
15470 		e_wsle();
15471 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15472 			a1ll_2.nbars + 1;
15473 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block duration not e"
15474 			"qual to voice 1!", (ftnlen)128, (ftnlen)36);
15475 		stop1_();
15476 	    }
15477 	    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
15478 	    if (*(unsigned char *)durq == ' ' && a1ll_2.iv == a1ll_2.nv) {
15479 
15480 /*  End of input block */
15481 
15482 		*loop = FALSE_;
15483 	    } else {
15484 
15485 /*  Start a new voice */
15486 
15487 		if (a1ll_2.lenbr0 != 0 && a1ll_2.firstline) {
15488 		    a1ll_2.lenbar = a1ll_2.lenbr0;
15489 		}
15490 		a1ll_2.nbars = 0;
15491 		if (*(unsigned char *)durq == ' ') {
15492 
15493 /*  New voice is on next staff */
15494 
15495 		    ++a1ll_2.iv;
15496 		    c1ommvl_1.ivx = a1ll_2.iv;
15497 		} else {
15498 
15499 /*  New voice is on same staff.  Set up for it */
15500 
15501 		    c1ommvl_1.ivx = a1ll_2.nv + 1;
15502 		    i__1 = a1ll_2.nv;
15503 		    for (iiv = 1; iiv <= i__1; ++iiv) {
15504 			if (c1ommvl_1.nvmx[iiv - 1] == 2) {
15505 			    ++c1ommvl_1.ivx;
15506 			}
15507 /* L23: */
15508 		    }
15509 		    if (c1ommvl_1.ivx > 24) {
15510 			s_wsfe(&io___651);
15511 			do_fio(&c__1, "Cannot have more than", (ftnlen)21);
15512 			do_fio(&c__1, (char *)&c__24, (ftnlen)sizeof(integer))
15513 				;
15514 			do_fio(&c__1, " lines of music at once", (ftnlen)23);
15515 			e_wsfe();
15516 			stop1_();
15517 		    }
15518 		    c1ommvl_1.nvmx[a1ll_2.iv - 1] = 2;
15519 		    c1ommvl_1.ivmx[a1ll_2.iv + 23] = c1ommvl_1.ivx;
15520 		    a1ll_2.itsofar[c1ommvl_1.ivx - 1] = 0;
15521 		    a1ll_2.nnl[c1ommvl_1.ivx - 1] = 0;
15522 		    for (j = 1; j <= 200; ++j) {
15523 			a1ll_2.rest[c1ommvl_1.ivx + j * 24 - 25] = FALSE_;
15524 			c1ommvl_1.nacc[c1ommvl_1.ivx + j * 24 - 25] = 0;
15525 /* L24: */
15526 		    }
15527 
15528 /*  For midi stuff, record that there is a 2nd line of music in this voice */
15529 
15530 		    if (commidi_1.ismidi) {
15531 			commidi_1.twoline[a1ll_2.iv - 1] = TRUE_;
15532 		    }
15533 		}
15534 	    }
15535 	    a1ll_2.iccount = 128;
15536 	} else if (*(unsigned char *)charq == 'S') {
15537 
15538 /*  New nsyst: for use with partmaker scor2prt, for parts w/ diff # of systs. */
15539 
15540 	    if (c1omnotes_1.ibarcnt > 0) {
15541 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15542 			a1ll_2.nbars + 1;
15543 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"S\" can only be in"
15544 			" first input block!", (ftnlen)128, (ftnlen)37);
15545 		stop1_();
15546 	    }
15547 	    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
15548 	    if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) == 0) {
15549 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15550 			a1ll_2.nbars + 1;
15551 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "A digit must follow"
15552 			" \"S\"!", (ftnlen)128, (ftnlen)24);
15553 		stop1_();
15554 	    }
15555 	    readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (ftnlen)128, (
15556 		    ftnlen)1);
15557 	    compage_1.nsyst = i_nint(&fnsyst);
15558 L14:
15559 	    if (*(unsigned char *)durq == 'P') {
15560 
15561 /*  New npages for parts. */
15562 
15563 		g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
15564 			1);
15565 		if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) == 0) {
15566 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15567 			    a1ll_2.nbars + 1;
15568 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have a numb"
15569 			    "er here!", (ftnlen)128, (ftnlen)24);
15570 		    stop1_();
15571 		}
15572 		readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (ftnlen)128, (
15573 			ftnlen)1);
15574 		compage_1.npages = i_nint(&fnsyst);
15575 		goto L14;
15576 	    } else if (*(unsigned char *)durq == 'm') {
15577 
15578 /*  Reset musize (musicsize). */
15579 
15580 		g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
15581 			1);
15582 		if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) == 0) {
15583 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15584 			    a1ll_2.nbars + 1;
15585 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have a numb"
15586 			    "er here!", (ftnlen)128, (ftnlen)24);
15587 		    stop1_();
15588 		}
15589 		readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (ftnlen)128, (
15590 			ftnlen)1);
15591 		commus_1.musize = i_nint(&fnsyst);
15592 		c1omnotes_1.wheadpt = commus_1.whead20 * commus_1.musize;
15593 		goto L14;
15594 	    } else if (*(unsigned char *)durq != ' ') {
15595 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15596 			a1ll_2.nbars + 1;
15597 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character "
15598 			"in \"S\" symbol!", (ftnlen)128, (ftnlen)32);
15599 		stop1_();
15600 	    }
15601 	} else if (*(unsigned char *)charq == 'L') {
15602 	    ++compage_1.nflb;
15603 	    compage_1.ibarflb[compage_1.nflb] = c1omnotes_1.ibarcnt +
15604 		    a1ll_2.nbars + 1;
15605 	    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
15606 	    if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
15607 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15608 			a1ll_2.nbars + 1;
15609 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need integer to defi"
15610 			"ne forced line break!", (ftnlen)128, (ftnlen)41);
15611 		stop1_();
15612 	    }
15613 	    readnum_(lineq, &a1ll_2.iccount, durq, &sysflb, (ftnlen)128, (
15614 		    ftnlen)1);
15615 	    compage_1.isysflb[compage_1.nflb] = i_nint(&sysflb);
15616 	    if (compage_1.nflb > 1) {
15617 
15618 /*  Check if new number is > prior one */
15619 
15620 		if (compage_1.isysflb[compage_1.nflb] <= compage_1.isysflb[
15621 			compage_1.nflb - 1]) {
15622 		    i__1 = a1ll_2.iccount - 1;
15623 		    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15624 			    a1ll_2.nbars + 1;
15625 		    errmsg_(lineq, &i__1, &i__4, "You already forced a line "
15626 			    "break at a later line!", (ftnlen)128, (ftnlen)48);
15627 		    stop1_();
15628 		}
15629 	    }
15630 	    if (compage_1.npages == 0) {
15631 		s_wsle(&io___655);
15632 		e_wsle();
15633 		s_wsle(&io___656);
15634 		do_lio(&c__9, &c__1, "WARNING! You forced a line break at li"
15635 			"ne ", (ftnlen)41);
15636 		do_lio(&c__3, &c__1, (char *)&compage_1.isysflb[
15637 			compage_1.nflb], (ftnlen)sizeof(integer));
15638 		do_lio(&c__9, &c__1, " but npage = 0.  Continue?", (ftnlen)26)
15639 			;
15640 		e_wsle();
15641 		s_rsfe(&io___657);
15642 		do_fio(&c__1, charq, (ftnlen)1);
15643 		e_rsfe();
15644 		if (i_indx("yY", charq, (ftnlen)2, (ftnlen)1) == 0) {
15645 		    stop1_();
15646 		}
15647 	    } else if (compage_1.isysflb[compage_1.nflb] > compage_1.nsyst) {
15648 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15649 			a1ll_2.nbars + 1;
15650 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced line break at"
15651 			" line num > nsyst!", (ftnlen)128, (ftnlen)38);
15652 		stop1_();
15653 	    } else if (i_indx(" PM", durq, (ftnlen)3, (ftnlen)1) == 0) {
15654 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15655 			a1ll_2.nbars + 1;
15656 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have \" \", \""
15657 			"P\", or \"M\" here!", (ftnlen)128, (ftnlen)32);
15658 		stop1_();
15659 	    }
15660 	    if (*(unsigned char *)durq == 'P') {
15661 
15662 /*  Forced page break here, get page number. */
15663 
15664 		g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
15665 			1);
15666 		if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
15667 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15668 			    a1ll_2.nbars + 1;
15669 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need integer to "
15670 			    "define forced page break!", (ftnlen)128, (ftnlen)
15671 			    41);
15672 		    stop1_();
15673 		}
15674 		readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
15675 			ftnlen)1);
15676 		++compage_1.nfpb;
15677 		compage_1.ipagfpb[compage_1.nfpb] = i_nint(&fnum);
15678 		compage_1.isysfpb[compage_1.nfpb] = compage_1.isysflb[
15679 			compage_1.nflb];
15680 		if (compage_1.ipagfpb[compage_1.nfpb] > compage_1.npages) {
15681 		    i__1 = a1ll_2.iccount - 1;
15682 		    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15683 			    a1ll_2.nbars + 1;
15684 		    errmsg_(lineq, &i__1, &i__4, "Forced page break at page "
15685 			    "num > npages!", (ftnlen)128, (ftnlen)39);
15686 		    stop1_();
15687 		} else if (compage_1.nfpb > 1) {
15688 		    if (compage_1.ipagfpb[compage_1.nfpb] <=
15689 			    compage_1.ipagfpb[compage_1.nfpb - 1]) {
15690 			i__1 = a1ll_2.iccount - 1;
15691 			i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15692 				a1ll_2.nbars + 1;
15693 			errmsg_(lineq, &i__1, &i__4, "Forced page break numb"
15694 				"ers must increase!", (ftnlen)128, (ftnlen)40);
15695 			stop1_();
15696 		    }
15697 		}
15698 	    }
15699 	    if (i_indx(" M", durq, (ftnlen)2, (ftnlen)1) == 0) {
15700 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15701 			a1ll_2.nbars + 1;
15702 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"
15703 			" linebreak symbol!", (ftnlen)128, (ftnlen)38);
15704 		stop1_();
15705 	    } else if (*(unsigned char *)durq == 'M') {
15706 		++compage_1.nmovbrk;
15707 		compage_1.isysmb[compage_1.nmovbrk] = compage_1.isysflb[
15708 			compage_1.nflb];
15709 		g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
15710 			1);
15711 L31:
15712 		if (*(unsigned char *)durq == '+') {
15713 
15714 /*  Vertical spacing, read past number. */
15715 
15716 		    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
15717 			    ftnlen)1);
15718 		    if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0)
15719 			    {
15720 			i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15721 				a1ll_2.nbars + 1;
15722 			errmsg_(lineq, &a1ll_2.iccount, &i__1, "Integer requ"
15723 				"ired here!", (ftnlen)128, (ftnlen)22);
15724 			stop1_();
15725 		    }
15726 		    readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128,
15727 			     (ftnlen)1);
15728 		    goto L31;
15729 		} else if (*(unsigned char *)durq == 'i') {
15730 
15731 /*  Change indentation, */
15732 
15733 		    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
15734 			    ftnlen)1);
15735 		    if (i_indx(".123456789", durq, (ftnlen)10, (ftnlen)1) ==
15736 			    0) {
15737 			i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15738 				a1ll_2.nbars + 1;
15739 			errmsg_(lineq, &a1ll_2.iccount, &i__1, "Decimal numb"
15740 				"er required here!", (ftnlen)128, (ftnlen)29);
15741 			stop1_();
15742 		    }
15743 
15744 /*  fracsys was initialized in block data to all 0.'s */
15745 
15746 		    readnum_(lineq, &a1ll_2.iccount, durq, &compage_1.fracsys[
15747 			    compage_1.nmovbrk - 1], (ftnlen)128, (ftnlen)1);
15748 		    goto L31;
15749 		} else if (*(unsigned char *)durq == 'c') {
15750 		    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
15751 			    ftnlen)1);
15752 		    goto L31;
15753 		} else if (*(unsigned char *)durq == 'r') {
15754 		    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
15755 			    ftnlen)1);
15756 		    if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
15757 			i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15758 				a1ll_2.nbars + 1;
15759 			errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have"
15760 				" \"+\" or \"-\" after \"r\" as movement brea"
15761 				"k option!", (ftnlen)128, (ftnlen)56);
15762 			stop1_();
15763 		    }
15764 		    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
15765 			    ftnlen)1);
15766 		    goto L31;
15767 		} else if (*(unsigned char *)durq == 'n') {
15768 
15769 /*  Change # of voices.  Input ninow, iorig(1...ninow).  Will use names, */
15770 /*  staves per inst. and clefs  corr. to iorig in original list of instruments. */
15771 
15772 		    a1ll_2.nv = 0;
15773 		    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
15774 			    ftnlen)1);
15775 		    if (*(unsigned char *)durq == ':') {
15776 
15777 /*  Signals a 2-digit number, get next two characters */
15778 
15779 			g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
15780 				ftnlen)1);
15781 			g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
15782 				ftnlen)1);
15783 			if (i_indx("12", durq, (ftnlen)2, (ftnlen)1) == 0 ||
15784 				i_indx("0123456789", dumq, (ftnlen)10, (
15785 				ftnlen)1) == 0) {
15786 			    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
15787 				    + a1ll_2.nbars + 1;
15788 /* Writing concatenation */
15789 			    i__8[0] = 34, a__3[0] = "Illegal new number of i"
15790 				    "nstruments ";
15791 			    i__8[1] = 1, a__3[1] = durq;
15792 			    i__8[2] = 1, a__3[2] = dumq;
15793 			    i__8[3] = 19, a__3[3] = " at movement break!";
15794 			    s_cat(ch__3, a__3, i__8, &c__4, (ftnlen)55);
15795 			    errmsg_(lineq, &a1ll_2.iccount, &i__1, ch__3, (
15796 				    ftnlen)128, (ftnlen)55);
15797 			    stop1_();
15798 			}
15799 			i__1 = a1ll_2.iccount - 2;
15800 			ici__1.icierr = 0;
15801 			ici__1.iciend = 0;
15802 			ici__1.icirnum = 1;
15803 			ici__1.icirlen = a1ll_2.iccount - i__1;
15804 			ici__1.iciunit = lineq + i__1;
15805 			ici__1.icifmt = "(i2)";
15806 			s_rsfi(&ici__1);
15807 			do_fio(&c__1, (char *)&ninow, (ftnlen)sizeof(integer))
15808 				;
15809 			e_rsfi();
15810 		    } else {
15811 
15812 /*  durq is a single digit number for noinow */
15813 
15814 			if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) ==
15815 				 0) {
15816 			    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
15817 				    + a1ll_2.nbars + 1;
15818 /* Writing concatenation */
15819 			    i__2[0] = 34, a__1[0] = "Illegal new number of i"
15820 				    "nstruments ";
15821 			    i__2[1] = 1, a__1[1] = durq;
15822 			    i__2[2] = 19, a__1[2] = " at movement break!";
15823 			    s_cat(ch__4, a__1, i__2, &c__3, (ftnlen)54);
15824 			    errmsg_(lineq, &a1ll_2.iccount, &i__1, ch__4, (
15825 				    ftnlen)128, (ftnlen)54);
15826 			    stop1_();
15827 			}
15828 			ninow = *(unsigned char *)durq - 48;
15829 		    }
15830 		    if (ninow > comkeys_1.noinst) {
15831 			i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15832 				a1ll_2.nbars + 1;
15833 			errmsg_(lineq, &a1ll_2.iccount, &i__1, "New number o"
15834 				"f instruments must be <= original!", (ftnlen)
15835 				128, (ftnlen)46);
15836 			stop1_();
15837 		    }
15838 		    i__1 = ninow;
15839 		    for (iinow = 1; iinow <= i__1; ++iinow) {
15840 			g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
15841 				ftnlen)1);
15842 			if (*(unsigned char *)durq == ':') {
15843 
15844 /*  Signals a 2-digit number */
15845 
15846 			    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)
15847 				    128, (ftnlen)1);
15848 			    g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)
15849 				    128, (ftnlen)1);
15850 			    if (i_indx("12", durq, (ftnlen)2, (ftnlen)1) == 0
15851 				    || i_indx("0123456789", dumq, (ftnlen)10,
15852 				    (ftnlen)1) == 0) {
15853 				i__4 = c1omnotes_1.ibarcnt -
15854 					c1omnotes_1.ibaroff + a1ll_2.nbars +
15855 					1;
15856 /* Writing concatenation */
15857 				i__8[0] = 34, a__3[0] = "Illegal 2-digit ins"
15858 					"trument number ";
15859 				i__8[1] = 1, a__3[1] = durq;
15860 				i__8[2] = 1, a__3[2] = dumq;
15861 				i__8[3] = 19, a__3[3] = " at movement break!";
15862 				s_cat(ch__3, a__3, i__8, &c__4, (ftnlen)55);
15863 				errmsg_(lineq, &a1ll_2.iccount, &i__4, ch__3,
15864 					(ftnlen)128, (ftnlen)55);
15865 				stop1_();
15866 			    }
15867 			    i__4 = a1ll_2.iccount - 2;
15868 			    ici__1.icierr = 0;
15869 			    ici__1.iciend = 0;
15870 			    ici__1.icirnum = 1;
15871 			    ici__1.icirlen = a1ll_2.iccount - i__4;
15872 			    ici__1.iciunit = lineq + i__4;
15873 			    ici__1.icifmt = "(i2)";
15874 			    s_rsfi(&ici__1);
15875 			    do_fio(&c__1, (char *)&iorig, (ftnlen)sizeof(
15876 				    integer));
15877 			    e_rsfi();
15878 			} else {
15879 
15880 /*  durq is a single digit number for iorig */
15881 
15882 			    if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)
15883 				    1) == 0) {
15884 				i__4 = c1omnotes_1.ibarcnt -
15885 					c1omnotes_1.ibaroff + a1ll_2.nbars +
15886 					1;
15887 /* Writing concatenation */
15888 				i__2[0] = 26, a__1[0] = "Illegal instrument "
15889 					"number ";
15890 				i__2[1] = 1, a__1[1] = durq;
15891 				i__2[2] = 19, a__1[2] = " at movement break!";
15892 				s_cat(ch__5, a__1, i__2, &c__3, (ftnlen)46);
15893 				errmsg_(lineq, &a1ll_2.iccount, &i__4, ch__5,
15894 					(ftnlen)128, (ftnlen)46);
15895 				stop1_();
15896 			    }
15897 			    iorig = *(unsigned char *)durq - 48;
15898 			}
15899 			if (iorig > comkeys_1.noinst) {
15900 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
15901 				    + a1ll_2.nbars + 1;
15902 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "New inst"
15903 				    "rument number must be <= original noinst!"
15904 				    , (ftnlen)128, (ftnlen)49);
15905 			    stop1_();
15906 			}
15907 			a1ll_2.nv += c1omget_1.nsperi[iorig - 1];
15908 /* L63: */
15909 		    }
15910 		    i__1 = a1ll_2.nv;
15911 		    for (iiv = 1; iiv <= i__1; ++iiv) {
15912 
15913 /*  Get clef names */
15914 
15915 			g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
15916 				ftnlen)1);
15917 			if (! (i_indx("tsmanrbf", durq, (ftnlen)8, (ftnlen)1)
15918 				> 0 || *(unsigned char *)durq >= 48 && *(
15919 				unsigned char *)durq <= 55)) {
15920 			    i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
15921 				    + a1ll_2.nbars + 1;
15922 			    errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must hav"
15923 				    "e t,s,m,a,n,r,b,f or 1-7 as clef symbol "
15924 				    "here!", (ftnlen)128, (ftnlen)53);
15925 			    stop1_();
15926 			}
15927 
15928 /*  Initialize new voices */
15929 
15930 			c1ommvl_1.nvmx[iiv - 1] = 1;
15931 			c1ommvl_1.ivmx[iiv - 1] = iiv;
15932 			a1ll_2.itsofar[iiv - 1] = 0;
15933 			a1ll_2.nnl[iiv - 1] = 0;
15934 			for (j = 1; j <= 200; ++j) {
15935 			    a1ll_2.rest[iiv + j * 24 - 25] = FALSE_;
15936 /* L62: */
15937 			}
15938 /* L61: */
15939 		    }
15940 
15941 /*  Loop back up, this might not be last option in M */
15942 
15943 		    g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
15944 			    ftnlen)1);
15945 		    goto L31;
15946 		} else if (*(unsigned char *)durq != ' ') {
15947 		    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15948 			    a1ll_2.nbars + 1;
15949 		    errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"
15950 			    "r after Movement break symbol!", (ftnlen)128, (
15951 			    ftnlen)46);
15952 		    stop1_();
15953 		}
15954 		if (compage_1.fracsys[compage_1.nmovbrk - 1] < .001f) {
15955 
15956 /*  Since fracsys was not explicitly set, set it to prior value. */
15957 
15958 		    if (compage_1.nmovbrk == 1) {
15959 			compage_1.fracsys[compage_1.nmovbrk - 1] =
15960 				c1omget_1.fracindent;
15961 		    } else {
15962 			compage_1.fracsys[compage_1.nmovbrk - 1] =
15963 				compage_1.fracsys[compage_1.nmovbrk - 2];
15964 		    }
15965 		}
15966 	    }
15967 
15968 /*  Just before exiting if-block for forced line breaks, set counter to use when */
15969 /*  dealing with vertical space calcs */
15970 
15971 	    compage_1.nistaff[compage_1.nflb] = a1ll_2.nv - 1;
15972 	} else if (*(unsigned char *)charq == 'F') {
15973 	    compage_1.usefig = FALSE_;
15974 	} else if (*(unsigned char *)charq == 'X') {
15975 	    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
15976 		    1;
15977 	    g1etx_(lineq, &a1ll_2.iccount, &c_true, &comkeys_1.shifton, &i__1,
15978 		     &c1omnotes_1.udsp[c1omnotes_1.ibarcnt + a1ll_2.nbars], &
15979 		    c1omnotes_1.wheadpt, (ftnlen)128);
15980 	} else if (*(unsigned char *)charq == 'I') {
15981 
15982 /*  MIDI settings. */
15983 
15984 	    if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) {
15985 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15986 			a1ll_2.nbars + 1;
15987 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "MIDI stuff only allo"
15988 			"wed at start of block!", (ftnlen)128, (ftnlen)42);
15989 		stop1_();
15990 	    }
15991 	    if (a1ll_2.nv > 15) {
15992 		i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
15993 			a1ll_2.nbars + 1;
15994 		errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry but MIDI does "
15995 			"not work with more than 15 voices!", (ftnlen)128, (
15996 			ftnlen)54);
15997 		stop1_();
15998 	    }
15999 	    commidi_1.ismidi = TRUE_;
16000 /*        call getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, */
16001 	    getmidi_(&comkeys_1.noinst, lineq, &a1ll_2.iccount, &
16002 		    c1omnotes_1.ibarcnt, &c1omnotes_1.ibaroff, &a1ll_2.nbars,
16003 		    &a1ll_2.lenbar, &mtrdenl, &c_true, (ftnlen)128);
16004 	} else if (*(unsigned char *)charq == 'M') {
16005 	    setmac_(lineq, &a1ll_2.iccount, &c1omnotes_1.ibarcnt, &
16006 		    c1omnotes_1.ibaroff, &a1ll_2.nbars, charq, durq, &
16007 		    c1ommvl_1.ivx, &c1omget_1.nline, (ftnlen)128, (ftnlen)1, (
16008 		    ftnlen)1);
16009 	} else if (i_indx(",.", charq, (ftnlen)2, (ftnlen)1) > 0) {
16010 
16011 /*  Continued rhythmic shortcut */
16012 
16013 	    idotform = i_indx(". ,", charq, (ftnlen)3, (ftnlen)1);
16014 	    if (idotform == 1) {
16015 
16016 /*  Change duration of prior note */
16017 
16018 		a1ll_2.itsofar[c1ommvl_1.ivx - 1] -= a1ll_2.nodur[
16019 			c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 -
16020 			25];
16021 		a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
16022 			24 - 25] = a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[
16023 			c1ommvl_1.ivx - 1] * 24 - 25] * 3 / 2;
16024 		a1ll_2.itsofar[c1ommvl_1.ivx - 1] += a1ll_2.nodur[
16025 			c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 -
16026 			25];
16027 	    }
16028 	    ++idotform;
16029 	    numnum = 1;
16030 	    cdot = TRUE_;
16031 	    goto L1;
16032 	} else {
16033 	    s_wsle(&io___661);
16034 	    do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11);
16035 	    i__1 = *(unsigned char *)charq;
16036 	    do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer));
16037 	    e_wsle();
16038 	    i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
16039 		    1;
16040 	    errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character is not al"
16041 		    "lowed here!", (ftnlen)128, (ftnlen)35);
16042 	    s_wsle(&io___662);
16043 	    do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11);
16044 	    i__1 = *(unsigned char *)charq;
16045 	    do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer));
16046 	    e_wsle();
16047 	    stop1_();
16048 	}
16049     }
16050     return 0;
16051 } /* g1etnote_ */
16052 
g1etset_(integer * nv,integer * noinst,integer * mtrnuml,integer * mtrdenl,integer * mtrnmp,integer * mtrdnp,real * xmtrnum0,integer * newkey,integer * npages,integer * nsyst,integer * musize,logical * bottreb)16053 /* Subroutine */ int g1etset_(integer *nv, integer *noinst, integer *mtrnuml,
16054 	integer *mtrdenl, integer *mtrnmp, integer *mtrdnp, real *xmtrnum0,
16055 	integer *newkey, integer *npages, integer *nsyst, integer *musize,
16056 	logical *bottreb)
16057 {
16058     /* System generated locals */
16059     address a__1[2], a__2[3];
16060     integer i__1, i__2[2], i__3[3];
16061     real r__1;
16062     char ch__1[3], ch__2[1], ch__3[50];
16063 
16064     /* Builtin functions */
16065     integer s_cmp(char *, char *, ftnlen, ftnlen), s_wsle(cilist *), do_lio(
16066 	    integer *, integer *, char *, ftnlen), e_wsle(void), i_nint(real *
16067 	    ), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(
16068 	    void), i_indx(char *, char *, ftnlen, ftnlen);
16069     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
16070 
16071     /* Local variables */
16072     static integer i__, iv;
16073     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
16074     extern /* Subroutine */ int stop1_(void);
16075     static char lineq[128];
16076     static integer lpath, iinst;
16077     extern doublereal readin_(char *, integer *, integer *, ftnlen);
16078     extern /* Subroutine */ int getbuf_(char *, ftnlen), errmsg_(char *,
16079 	    integer *, integer *, char *, ftnlen, ftnlen), printl_(char *,
16080 	    ftnlen);
16081     static logical newway;
16082     static integer iccount;
16083 
16084     /* Fortran I/O blocks */
16085     static cilist io___665 = { 0, 6, 0, 0, 0 };
16086     static cilist io___666 = { 0, 6, 0, "(1x,a46,i3)", 0 };
16087     static cilist io___667 = { 0, 6, 0, "(a)", 0 };
16088     static cilist io___670 = { 0, 6, 0, "(a)", 0 };
16089     static cilist io___671 = { 0, 6, 0, "(a)", 0 };
16090     static cilist io___672 = { 0, 6, 0, 0, 0 };
16091 
16092 
16093 
16094 /*  Get the first line */
16095 
16096     iccount = 0;
16097     c1omget_1.nline = 1;
16098 L9:
16099     getbuf_(lineq, (ftnlen)128);
16100     if (*(unsigned char *)lineq == '%') {
16101 	++c1omget_1.nline;
16102 	goto L9;
16103     }
16104     if (s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) == 0) {
16105 
16106 /*  Have TeX input until next line that starts with '---' */
16107 
16108 L3:
16109 	++c1omget_1.nline;
16110 	getbuf_(lineq, (ftnlen)128);
16111 	if (inbuff_1.ilbuf > inbuff_1.nlbuf) {
16112 	    goto L1;
16113 	}
16114 	goto L2;
16115 L1:
16116 	s_wsle(&io___665);
16117 	do_lio(&c__9, &c__1, "You did not terminate type 0 TeX input with \""
16118 		"---\"", (ftnlen)49);
16119 	e_wsle();
16120 	stop1_();
16121 L2:
16122 	if (s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) != 0) {
16123 	    goto L3;
16124 	}
16125 
16126 /*  Force a new line read on first call to readin */
16127 
16128 	iccount = 128;
16129     }
16130 
16131 /*  Here, lineq and nline are first non-TeX lines. */
16132 
16133     r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
16134     *nv = i_nint(&r__1);
16135     if (*nv > 24) {
16136 	s_wsfe(&io___666);
16137 	do_fio(&c__1, "In setup data, number of voices cannot exceed", (
16138 		ftnlen)45);
16139 	do_fio(&c__1, (char *)&c__24, (ftnlen)sizeof(integer));
16140 	e_wsfe();
16141 	stop1_();
16142     }
16143     r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
16144     *noinst = i_nint(&r__1);
16145     if (*noinst > *nv) {
16146 	s_wsfe(&io___667);
16147 	do_fio(&c__1, "In setup data, cannot have more instruments than stav"
16148 		"es", (ftnlen)55);
16149 	e_wsfe();
16150 	stop1_();
16151     }
16152     newway = *noinst <= 0;
16153     if (newway) {
16154 	*noinst = -(*noinst);
16155     }
16156     i__1 = *noinst;
16157     for (iinst = 1; iinst <= i__1; ++iinst) {
16158 
16159 /*  Seve # of staves per inst in case later drop some inst's. */
16160 
16161 	if (newway) {
16162 	    r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
16163 	    c1omget_1.nsperi[iinst - 1] = i_nint(&r__1);
16164 	} else if (iinst > 1) {
16165 	    c1omget_1.nsperi[iinst - 1] = 1;
16166 	} else {
16167 	    c1omget_1.nsperi[iinst - 1] = *nv - *noinst + 1;
16168 	}
16169 /* L10: */
16170     }
16171     r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
16172     *mtrnuml = i_nint(&r__1);
16173     r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
16174     *mtrdenl = i_nint(&r__1);
16175 /* c */
16176 /* c  Kluge!!! */
16177 /* c */
16178 /*      if (mtrdenl .eq. 1) then */
16179 /*        mtrdenl = 2 */
16180 /*        mtrnuml = mtrnuml*2 */
16181 /*      end if */
16182     r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
16183     *mtrnmp = i_nint(&r__1);
16184     r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
16185     *mtrdnp = i_nint(&r__1);
16186     if (*mtrnmp == 0 && *mtrdnp >= 8) {
16187 	s_wsfe(&io___670);
16188 	do_fio(&c__1, "In setup data, with mtrnmp=0, mtrdnp must be <8", (
16189 		ftnlen)47);
16190 	e_wsfe();
16191 	stop1_();
16192     }
16193     *xmtrnum0 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
16194     r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
16195     *newkey = i_nint(&r__1);
16196 /* 130316 */
16197 /*      do 11 iinst = 1 , noinst */
16198     commidisig_1.midisig = *newkey;
16199 /* 11    continue */
16200     r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
16201     *npages = i_nint(&r__1);
16202     r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
16203     *nsyst = i_nint(&r__1);
16204     r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
16205     *musize = i_nint(&r__1);
16206     c1omget_1.fracindent = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)
16207 	    128);
16208     if (c1omget_1.fracindent >= 1.f) {
16209 	s_wsfe(&io___671);
16210 	do_fio(&c__1, "In setup data, fracindent must be <1", (ftnlen)36);
16211 	e_wsfe();
16212 	stop1_();
16213     }
16214     if (*npages > *nsyst) {
16215 	s_wsle(&io___672);
16216 	do_lio(&c__9, &c__1, "Error in input file: npages > nsyst", (ftnlen)
16217 		35);
16218 	e_wsle();
16219 	stop1_();
16220     } else if ((*musize - 16) * (*musize - 20) * (*musize - 24) * (*musize -
16221 	    29) != 0) {
16222 	printl_("Musicsize must be 16, 20, 24, or 29", (ftnlen)35);
16223 	stop1_();
16224     }
16225 
16226 /*  Next noinst non-comment lines are names of instruments. */
16227 
16228     i__1 = abs(*noinst);
16229     for (i__ = 1; i__ <= i__1; ++i__) {
16230 L5:
16231 	getbuf_(lineq, (ftnlen)128);
16232 	++c1omget_1.nline;
16233 	if (*(unsigned char *)lineq == '%') {
16234 	    goto L5;
16235 	}
16236 /* L4: */
16237     }
16238 
16239 /*  Mext non-comment line has nv clef names */
16240 
16241 L6:
16242     getbuf_(lineq, (ftnlen)128);
16243     ++c1omget_1.nline;
16244     if (*(unsigned char *)lineq == '%') {
16245 	goto L6;
16246     }
16247     i__1 = *nv;
16248     for (iv = 1; iv <= i__1; ++iv) {
16249 /*        if (index('brnamstf0123456',lineq(iv:iv)) .eq. 0) then */
16250 	if (i_indx("brnamstf01234567", lineq + (iv - 1), (ftnlen)16, (ftnlen)
16251 		1) == 0) {
16252 	    errmsg_(lineq, &iv, &c__0, "There should be a clef symbol here!",
16253 		    (ftnlen)128, (ftnlen)35);
16254 	    stop1_();
16255 	}
16256 /* L7: */
16257     }
16258     i__1 = *nv;
16259     if (s_cmp(lineq + i__1, " ", *nv + 1 - i__1, (ftnlen)1) != 0) {
16260 	i__1 = *nv + 1;
16261 	errmsg_(lineq, &i__1, &c__0, "There should be a blank here!", (ftnlen)
16262 		128, (ftnlen)29);
16263 	stop1_();
16264     }
16265 
16266 /* Set flag if voice 1 is treble, since it affects vertical spacing */
16267 
16268     *bottreb = *(unsigned char *)lineq == 't';
16269 
16270 /*  Mext non-comment line has path name */
16271 
16272 L8:
16273     getbuf_(lineq, (ftnlen)128);
16274     ++c1omget_1.nline;
16275     if (*(unsigned char *)lineq == '%') {
16276 	goto L8;
16277     }
16278     lpath = i_indx(lineq, " ", (ftnlen)128, (ftnlen)1) - 1;
16279 /* Writing concatenation */
16280     i__2[0] = 2, a__1[0] = "/:";
16281     chax_(ch__2, (ftnlen)1, &c__92);
16282     i__2[1] = 1, a__1[1] = ch__2;
16283     s_cat(ch__1, a__1, i__2, &c__2, (ftnlen)3);
16284     if (i_indx(ch__1, lineq + (lpath - 1), (ftnlen)3, (ftnlen)1) == 0) {
16285 /* Writing concatenation */
16286 	i__3[0] = 47, a__2[0] = "Last character of pathname is not \"/\",\""
16287 		":\", or \"";
16288 	chax_(ch__2, (ftnlen)1, &c__92);
16289 	i__3[1] = 1, a__2[1] = ch__2;
16290 	i__3[2] = 2, a__2[2] = "\"!";
16291 	s_cat(ch__3, a__2, i__3, &c__3, (ftnlen)50);
16292 	errmsg_(lineq, &lpath, &c__0, ch__3, (ftnlen)128, (ftnlen)50);
16293 	stop1_();
16294     }
16295     return 0;
16296 } /* g1etset_ */
16297 
g1etx_(char * lineq,integer * iccount,logical * notxtup,logical * shifton,integer * ibar,real * udsp,real * wheadpt,ftnlen lineq_len)16298 /* Subroutine */ int g1etx_(char *lineq, integer *iccount, logical *notxtup,
16299 	logical *shifton, integer *ibar, real *udsp, real *wheadpt, ftnlen
16300 	lineq_len)
16301 {
16302     /* System generated locals */
16303     integer i__1;
16304 
16305     /* Builtin functions */
16306     integer i_indx(char *, char *, ftnlen, ftnlen);
16307 
16308     /* Local variables */
16309     static real fnum;
16310     static char dumq[1];
16311     extern /* Subroutine */ int stop1_(void);
16312     static char charq[1];
16313     static integer ipbsc, npbsc;
16314     static logical number;
16315     extern /* Subroutine */ int errmsg_(char *, integer *, integer *, char *,
16316 	    ftnlen, ftnlen), readnum_(char *, integer *, char *, real *,
16317 	    ftnlen, ftnlen), g1etchar_(char *, integer *, char *, ftnlen,
16318 	    ftnlen);
16319 
16320 
16321 /*  Parse "X" commands.  Ignore all "B"; "P" means to ignore whole symbol. */
16322 /*  In scor2prt, must strip out "P", copy only "B" and "P"-type "X"-symbols. */
16323 
16324     number = FALSE_;
16325     npbsc = 0;
16326 L1:
16327     g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
16328     if (i_indx("PBS:", charq, (ftnlen)4, (ftnlen)1) > 0) {
16329 
16330 /*  Continue checking here even if "P". */
16331 
16332 	ipbsc = i_indx("PBS:", charq, (ftnlen)4, (ftnlen)1);
16333 	if (bit_test(npbsc,ipbsc)) {
16334 	    errmsg_(lineq, iccount, ibar, "Only one allowed per symbol!", (
16335 		    ftnlen)128, (ftnlen)28);
16336 	    stop1_();
16337 /*        else if (.not.notxtup .and. ipbsc.gt.2) then */
16338 /*          call errmsg(lineq,iccount,ibar,'Not allowed in xtuplet!') */
16339 /*          call stop1() */
16340 	}
16341 	npbsc = bit_set(npbsc,ipbsc);
16342 	goto L1;
16343     } else if (i_indx("+-.0123456789", charq, (ftnlen)13, (ftnlen)1) > 0) {
16344 	number = TRUE_;
16345 	if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) > 0) {
16346 	    g1etchar_(lineq, iccount, dumq, (ftnlen)128, (ftnlen)1);
16347 	    if (i_indx(".0123456789", dumq, (ftnlen)11, (ftnlen)1) == 0) {
16348 		errmsg_(lineq, iccount, ibar, "Expected a number here!", (
16349 			ftnlen)128, (ftnlen)23);
16350 		stop1_();
16351 	    }
16352 	}
16353 	readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
16354 	if (*(unsigned char *)charq == '-') {
16355 	    fnum = -fnum;
16356 	}
16357 	if (*(unsigned char *)dumq != 'p') {
16358 	    --(*iccount);
16359 	    fnum *= *wheadpt;
16360 	}
16361 	goto L1;
16362     } else if (*(unsigned char *)charq != ' ') {
16363 	errmsg_(lineq, iccount, ibar, "Not allowed in \"X\" symbol!", (ftnlen)
16364 		128, (ftnlen)26);
16365 	stop1_();
16366     }
16367 
16368 /*  Done with parsing.  Other checks */
16369 
16370     if ((6 & npbsc) == 6 || (24 & npbsc) == 24) {
16371 	i__1 = *iccount - 1;
16372 	errmsg_(lineq, &i__1, ibar, "Cannot have both \"P\" and \"B\" or \""
16373 		"S\" and \":\"!", (ftnlen)128, (ftnlen)44);
16374 	stop1_();
16375     }
16376     if (bit_test(npbsc,4)) {
16377 	if (number) {
16378 	    if (*shifton) {
16379 		i__1 = *iccount - 1;
16380 		errmsg_(lineq, &i__1, ibar, "Started a group shift without s"
16381 			"topping prior one!", (ftnlen)128, (ftnlen)49);
16382 		stop1_();
16383 	    } else {
16384 		*shifton = TRUE_;
16385 	    }
16386 	} else {
16387 	    if (! (*shifton)) {
16388 		i__1 = *iccount - 1;
16389 		errmsg_(lineq, &i__1, ibar, "Ended a group shift without sta"
16390 			"rting one!", (ftnlen)128, (ftnlen)41);
16391 		stop1_();
16392 	    } else {
16393 		*shifton = FALSE_;
16394 	    }
16395 	}
16396     }
16397 
16398 /*  P off, S off, c off => normal user-defined space.  Add to udsp (later fsyst) */
16399 
16400     if ((npbsc & 26) == 0) {
16401 	*udsp += fnum;
16402     }
16403     if (! number && ! bit_test(npbsc,4)) {
16404 	i__1 = *iccount - 1;
16405 	errmsg_(lineq, &i__1, ibar, "Must have either a number or a colon "
16406 		"in \"X\" symbol!", (ftnlen)128, (ftnlen)51);
16407 	stop1_();
16408     }
16409     return 0;
16410 } /* g1etx_ */
16411 
16412 /*      integer*4 function mytime() */
16413 /*      CHARACTER(10) tq */
16414 /*      CALL DATE_AND_TIME(TIME=tq) */
16415 /*      read(tq,'(2i2,f6.3)')ih,im,ts */
16416 /*      mytime = 1000*(ts+60*(im+60*ih)) */
16417 /*      return */
16418 /*      end */
getbuf_(char * lineq,ftnlen lineq_len)16419 /* Subroutine */ int getbuf_(char *lineq, ftnlen lineq_len)
16420 {
16421     /* System generated locals */
16422     integer i__1;
16423 
16424     /* Builtin functions */
16425     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
16426 
16427     i__1 = inbuff_1.ipbuf;
16428     s_copy(lineq, inbuff_1.bufq + i__1, lineq_len, inbuff_1.ipbuf +
16429 	    inbuff_1.lbuf[inbuff_1.ilbuf - 1] - i__1);
16430     inbuff_1.ipbuf += inbuff_1.lbuf[inbuff_1.ilbuf - 1];
16431     ++inbuff_1.ilbuf;
16432     return 0;
16433 } /* getbuf_ */
16434 
getchar_(char * lineq,integer * iccount,char * charq,ftnlen lineq_len,ftnlen charq_len)16435 /* Subroutine */ int getchar_(char *lineq, integer *iccount, char *charq,
16436 	ftnlen lineq_len, ftnlen charq_len)
16437 {
16438     /* Builtin functions */
16439     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
16440 
16441     /* Local variables */
16442     static integer ndxm;
16443     extern /* Subroutine */ int mrec1_(char *, integer *, integer *, ftnlen),
16444 	    read10_(char *, logical *, ftnlen);
16445 
16446 
16447 /*  Gets the next character out of lineq*128.  If pointer iccount=128 on entry, */
16448 /*  then reads in a new line.  Resets iccount.  Ends program if no more input. */
16449 
16450     if (*iccount == 128) {
16451 	read10_(lineq, &comget_1.lastchar, (ftnlen)128);
16452 	if (comget_1.lastchar) {
16453 	    return 0;
16454 	}
16455 	if (! commac_1.endmac) {
16456 	    *iccount = 0;
16457 	} else {
16458 	    commac_1.endmac = FALSE_;
16459 	    *iccount = commac_1.icchold;
16460 	    s_copy(lineq, commac_1.lnholdq, (ftnlen)128, (ftnlen)128);
16461 	}
16462 	if (commac_1.mrecord) {
16463 	    mrec1_(lineq, iccount, &ndxm, (ftnlen)128);
16464 	}
16465     }
16466     ++(*iccount);
16467     *(unsigned char *)charq = *(unsigned char *)&lineq[*iccount - 1];
16468     return 0;
16469 /* L999: */
16470     comget_1.lastchar = TRUE_;
16471     return 0;
16472 } /* getchar_ */
16473 
getdyn_(integer * ivx,integer * ip,integer * irest,integer * iornq,char * lineq,integer * iccount,ftnlen lineq_len)16474 /* Subroutine */ int getdyn_(integer *ivx, integer *ip, integer *irest,
16475 	integer *iornq, char *lineq, integer *iccount, ftnlen lineq_len)
16476 {
16477     /* System generated locals */
16478     address a__1[3];
16479     integer i__1, i__2[3], i__3;
16480     real r__1;
16481     char ch__1[4], ch__2[1];
16482     icilist ici__1;
16483 
16484     /* Builtin functions */
16485     integer s_cmp(char *, char *, ftnlen, ftnlen), i_indx(char *, char *,
16486 	    ftnlen, ftnlen);
16487     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
16488 	     char **, integer *, integer *, ftnlen);
16489     integer s_rsfi(icilist *), do_fio(integer *, char *, ftnlen), e_rsfi(void)
16490 	    , i_nint(real *);
16491 
16492     /* Local variables */
16493     static integer ipm, iend;
16494     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
16495     static integer idno, idyn;
16496     static real fnum;
16497     static char durq[1];
16498     static integer idno1;
16499     extern /* Subroutine */ int stop1_(void), printl_(char *, ftnlen),
16500 	    readnum_(char *, integer *, char *, real *, ftnlen, ftnlen),
16501 	    setbits_(integer *, integer *, integer *, integer *);
16502     static char dynsymq[4];
16503 
16504 
16505 /*  Get info for dynamic mark.  Enter after getting "D", iccount sits on "D" */
16506 /*  Bits in idyndat are as follows */
16507 /*    00-03 ivx */
16508 /*    04-11 ip */
16509 /*    12-15 code for type of mark */
16510 /*      0 => arbitrary text */
16511 /*      1-12 => pppp,ppp,pp,p,mp,mf,f,fp,sfz,ff,fff,ffff */
16512 /*      If (.not. fontslur) */
16513 /*        13 => hairpin start, 14,15 => <,> (ending) */
16514 /*      else */
16515 /*         13 < start, 14 > start, 15 ending */
16516 /*      end if */
16517 /*    16    flag for vertical offset */
16518 /*    17-23 vertical offset + 64 , \internote */
16519 /*    31    Hairpin start (0), stop (1) */
16520 
16521 /*  idynda2 */
16522 
16523 /*    00    flag for horizontal offset */
16524 /*    01-09 (horizontal offset)/10 + 25.6 notehead widths */
16525 /*    10  5th bit for ivx (5/15/10) */
16526 
16527     *irest = bit_set(*irest,26);
16528     ++comdyn_1.ndyn;
16529     idyn = *ivx;
16530     comdyn_1.idynda2[comdyn_1.ndyn - 1] = 0;
16531     if (*ivx >= 16) {
16532 	setbits_(&comdyn_1.idynda2[comdyn_1.ndyn - 1], &c__1, &c__10, &c__1);
16533     }
16534     setbits_(&idyn, &c__8, &c__4, ip);
16535     i__1 = *iccount;
16536     if (s_cmp(lineq + i__1, "\"", *iccount + 1 - i__1, (ftnlen)1) == 0) {
16537 
16538 /*  text-dynamic */
16539 
16540 	++comdyn_1.ntxtdyn;
16541 	i__1 = *iccount + 1;
16542 	iend = *iccount + i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1) +
16543 		2;
16544 	i__1 = *iccount + 1;
16545 	s_copy(comdyn_1.txtdynq + (comdyn_1.ntxtdyn - 1 << 7), lineq + i__1, (
16546 		ftnlen)128, iend - 2 - i__1);
16547 
16548 /* c  Store ivx, ip in bits 0-11 */
16549 /*  Store ivx, ip in bits 0-12 */
16550 
16551 /*        ivxiptxt(ntxtdyn) = idyn */
16552 	comdyn_1.ivxiptxt[comdyn_1.ntxtdyn - 1] = *ivx + (*ip << 5);
16553 	ipm = i_indx("- +", lineq + (iend - 1), (ftnlen)3, (ftnlen)1);
16554 	idno = 0;
16555     } else {
16556 
16557 /*  Word-group or hairpin */
16558 
16559 	for (iend = *iccount + 2; iend <= 128; ++iend) {
16560 	    ipm = i_indx("- +", lineq + (iend - 1), (ftnlen)3, (ftnlen)1);
16561 
16562 /*  Exit the loop at first blank, "+", or "-" */
16563 
16564 	    if (ipm > 0) {
16565 		goto L2;
16566 	    }
16567 /* L1: */
16568 	}
16569 L2:
16570 	i__1 = *iccount;
16571 	ici__1.icierr = 0;
16572 	ici__1.iciend = 0;
16573 	ici__1.icirnum = 1;
16574 	ici__1.icirlen = iend - 1 - i__1;
16575 	ici__1.iciunit = lineq + i__1;
16576 /* Writing concatenation */
16577 	i__2[0] = 2, a__1[0] = "(a";
16578 	i__3 = iend + 47 - *iccount;
16579 	chax_(ch__2, (ftnlen)1, &i__3);
16580 	i__2[1] = 1, a__1[1] = ch__2;
16581 	i__2[2] = 1, a__1[2] = ")";
16582 	ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1);
16583 	s_rsfi(&ici__1);
16584 	do_fio(&c__1, dynsymq, (ftnlen)4);
16585 	e_rsfi();
16586 	idno = (i_indx("ppppppp pp  p   mp  mf  f   fp  sfz ff  fff ffff    "
16587 		"<   >   ", dynsymq, (ftnlen)60, (ftnlen)4) + 3) / 4;
16588 
16589 /*  Save for later down */
16590 
16591 	idno1 = idno;
16592     }
16593 
16594 /*  Set flag to check level later if in beam */
16595 
16596     *iornq = bit_set(*iornq,23);
16597     if (idno >= 14) {
16598 
16599 /*  Hairpin here.  Check if opposite type from one that's already on */
16600 
16601 	if (idno == 14 && bit_test(comdyn_1.listdecresc,*ivx) || idno == 15 &&
16602 		 bit_test(comdyn_1.listcresc,*ivx)) {
16603 	    printl_(" ", (ftnlen)1);
16604 	    printl_("Started one kind of hairpin while other is on", (ftnlen)
16605 		    45);
16606 	    stop1_();
16607 	}
16608 
16609 /*  Start or stop? */
16610 
16611 	if (bit_test(comdyn_1.listcresc,*ivx) || bit_test(
16612 		comdyn_1.listdecresc,*ivx)) {
16613 
16614 /*  Cresc/decresc is on, this is an ending. If fontslur, leave idno as is. */
16615 
16616 	    if (! comslur_1.fontslur) {
16617 		idno = 15;
16618 	    }
16619 	} else if (comslur_1.fontslur) {
16620 
16621 /*  Start of font slur */
16622 
16623 	    idno = 13;
16624 	} else {
16625 
16626 /*  Start of postscript slur */
16627 
16628 	    --idno;
16629 	}
16630     }
16631 
16632 /*  Now that we used list[de]cresc, update */
16633 
16634     if (idno >= 13) {
16635 	if (idno == 15 || comslur_1.fontslur && idno == 14) {
16636 
16637 /*  Something's ending */
16638 
16639 	    if (bit_test(comdyn_1.listcresc,*ivx)) {
16640 
16641 /*  It's a cresc! */
16642 
16643 		comdyn_1.listcresc = bit_clear(comdyn_1.listcresc,*ivx);
16644 	    } else {
16645 		comdyn_1.listdecresc = bit_clear(comdyn_1.listdecresc,*ivx);
16646 	    }
16647 	} else {
16648 
16649 /*  Something's starting */
16650 
16651 	    if (idno1 == 14) {
16652 
16653 /*  It's a cresc! */
16654 
16655 		comdyn_1.listcresc = bit_set(comdyn_1.listcresc,*ivx);
16656 	    } else {
16657 		comdyn_1.listdecresc = bit_set(comdyn_1.listdecresc,*ivx);
16658 	    }
16659 	}
16660     }
16661     setbits_(&idyn, &c__4, &c__12, &idno);
16662     *iccount = iend;
16663     if (ipm != 2) {
16664 
16665 /*  There is a vertical shift */
16666 
16667 	idyn = bit_set(idyn,16);
16668 	++(*iccount);
16669 	readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
16670 	idno = i_nint(&fnum);
16671 	i__1 = (ipm - 2) * idno + 64;
16672 	setbits_(&idyn, &c__7, &c__17, &i__1);
16673 	ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1);
16674 	if (ipm != 2) {
16675 
16676 /*  There is a horizontal shift */
16677 
16678 /*          idynda2(ndyn) = ibset(idyn,23) */
16679 	    comdyn_1.idynda2[comdyn_1.ndyn - 1] = bit_set(comdyn_1.idynda2[
16680 		    comdyn_1.ndyn - 1],0);
16681 	    ++(*iccount);
16682 	    readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
16683 	    r__1 = fnum * 10;
16684 	    idno = i_nint(&r__1);
16685 	    i__1 = (ipm - 2) * idno + 256;
16686 	    setbits_(&comdyn_1.idynda2[comdyn_1.ndyn - 1], &c__9, &c__1, &
16687 		    i__1);
16688 	}
16689 
16690 /*  iccount should be on the blank at the end of the entire symbol */
16691 
16692     }
16693     comdyn_1.idyndat[comdyn_1.ndyn - 1] = idyn;
16694     return 0;
16695 } /* getdyn_ */
16696 
getfig_(integer * itoff,char * charq,char * lineq,integer * iccount,logical * isfig,integer * itfig,integer * itsofar,integer * nodur,char * figq,integer * ivupfig,integer * nfigs,ftnlen charq_len,ftnlen lineq_len,ftnlen figq_len)16697 /* Subroutine */ int getfig_(integer *itoff, char *charq, char *lineq,
16698 	integer *iccount, logical *isfig, integer *itfig, integer *itsofar,
16699 	integer *nodur, char *figq, integer *ivupfig, integer *nfigs, ftnlen
16700 	charq_len, ftnlen lineq_len, ftnlen figq_len)
16701 {
16702     /* System generated locals */
16703     address a__1[2];
16704     integer i__1[2];
16705     icilist ici__1;
16706 
16707     /* Builtin functions */
16708     integer s_rsfi(icilist *), do_fio(integer *, char *, ftnlen), e_rsfi(void)
16709 	    ;
16710     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
16711     integer i_indx(char *, char *, ftnlen, ftnlen);
16712     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
16713     integer i_nint(real *);
16714 
16715     /* Local variables */
16716     static integer lfig, loff, noff;
16717     static real fnum;
16718     extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen,
16719 	    ftnlen), readnum_(char *, integer *, char *, real *, ftnlen,
16720 	    ftnlen);
16721     extern integer ifnodur_(integer *, char *, ftnlen);
16722 
16723 
16724 /* As of 11/26/08, trapped extra figures in getnote, so no need here. */
16725 
16726 /*      if (ivx .gt. 2) then */
16727 /* c */
16728 /* c  Read past the figure */
16729 /* c */
16730 /* 6       call getchar(lineq,iccount,charq) */
16731 /*        if (charq .ne. ' ') go to 6 */
16732 /*        return */
16733 /*      end if */
16734     ++(*nfigs);
16735     *ivupfig = 0;
16736     *itoff = 0;
16737     if (*(unsigned char *)charq == 'x') {
16738 
16739 /*  Floating figure. */
16740 
16741 	getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
16742 	ici__1.icierr = 0;
16743 	ici__1.iciend = 0;
16744 	ici__1.icirnum = 1;
16745 	ici__1.icirlen = 1;
16746 	ici__1.iciunit = charq;
16747 	ici__1.icifmt = "(i1)";
16748 	s_rsfi(&ici__1);
16749 	do_fio(&c__1, (char *)&noff, (ftnlen)sizeof(integer));
16750 	e_rsfi();
16751 	getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
16752 	ici__1.icierr = 0;
16753 	ici__1.iciend = 0;
16754 	ici__1.icirnum = 1;
16755 	ici__1.icirlen = 1;
16756 	ici__1.iciunit = charq;
16757 	ici__1.icifmt = "(i1)";
16758 	s_rsfi(&ici__1);
16759 	do_fio(&c__1, (char *)&loff, (ftnlen)sizeof(integer));
16760 	e_rsfi();
16761 	*itoff = noff * ifnodur_(&loff, "x", (ftnlen)1);
16762 	getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
16763     } else {
16764 
16765 /*  Figure on a note */
16766 
16767 	*isfig = TRUE_;
16768     }
16769     *itfig = *itsofar + *itoff - *nodur;
16770     lfig = 1;
16771     s_copy(figq, charq, (ftnlen)10, (ftnlen)1);
16772 L5:
16773     getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
16774 /*      if (charq .ne. ' ') then */
16775     if (i_indx(" +", charq, (ftnlen)2, (ftnlen)1) == 0) {
16776 /* Writing concatenation */
16777 	i__1[0] = lfig, a__1[0] = figq;
16778 	i__1[1] = 1, a__1[1] = charq;
16779 	s_cat(figq, a__1, i__1, &c__2, (ftnlen)10);
16780 	++lfig;
16781 	goto L5;
16782     } else if (*(unsigned char *)charq == '+') {
16783 
16784 /*  Get vertical offset for figure. Next character after number has to be blank. */
16785 
16786 	++(*iccount);
16787 	readnum_(lineq, iccount, charq, &fnum, (ftnlen)128, (ftnlen)1);
16788 	*ivupfig = i_nint(&fnum);
16789     }
16790     return 0;
16791 } /* getfig_ */
16792 
getgrace_(integer * ivx,integer * nnl,char * lineq,integer * iccount,integer * islur,integer * iornq,integer * ipl,integer * ndlev,integer * lastlev,integer * iv,integer * nv,ftnlen lineq_len)16793 /* Subroutine */ int getgrace_(integer *ivx, integer *nnl, char *lineq,
16794 	integer *iccount, integer *islur, integer *iornq, integer *ipl,
16795 	integer *ndlev, integer *lastlev, integer *iv, integer *nv, ftnlen
16796 	lineq_len)
16797 {
16798     /* System generated locals */
16799     integer i__1;
16800 
16801     /* Builtin functions */
16802     integer i_indx(char *, char *, ftnlen, ftnlen), i_nint(real *);
16803 
16804     /* Local variables */
16805     static integer iclastlev, kv, ing, ioct;
16806     static real fnum;
16807     static char durq[1], charq[1];
16808     extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen,
16809 	    ftnlen), readnum_(char *, integer *, char *, real *, ftnlen,
16810 	    ftnlen);
16811     extern integer ifnolev_(char *, integer *, integer *, ftnlen);
16812 
16813 
16814 /* Grace, comes *before* main note: */
16815 /* UNLESS there's an 'A' or 'W' after the 'G' */
16816 /*   ngrace = # of grace note groups so far in block */
16817 /*   ivg(ngrace), ipg(ngrace) */
16818 /*   nng(ngrace) = # of notes in this group: default = 1 */
16819 /*   ngstrt(ngrace) = starting position in nolevg of levels for this grace */
16820 /*   multg(ngrace) = multiplicity: default = 1;  input as 'm(digit)' */
16821 /*   upg(ngrace) = logical for beam or stem dirn: default T, input'u,l' */
16822 /*   slurg(ngrace) = logical for slur; default F, input 's' */
16823 /*   slashg(ngrace) = T if slash; default is F, input 'x' */
16824 /* These data MUST precede note name of first note */
16825 /*   nolevg, naccg: lists of levels and accid's, indexed as described above. */
16826 
16827     /* Parameter adjustments */
16828     ndlev -= 25;
16829     ipl -= 25;
16830     --iornq;
16831     islur -= 25;
16832     --nnl;
16833 
16834     /* Function Body */
16835     ++comgrace_1.ngrace;
16836     comgrace_1.ivg[comgrace_1.ngrace - 1] = *ivx;
16837     comgrace_1.ipg[comgrace_1.ngrace - 1] = nnl[*ivx] + 1;
16838     if (comgrace_1.ngrace == 1) {
16839 	comgrace_1.ngstrt[comgrace_1.ngrace - 1] = 1;
16840     } else {
16841 	comgrace_1.ngstrt[comgrace_1.ngrace - 1] = comgrace_1.ngstrt[
16842 		comgrace_1.ngrace - 2] + comgrace_1.nng[comgrace_1.ngrace - 2]
16843 		;
16844     }
16845     islur[*ivx + (nnl[*ivx] + 1) * 24] = bit_set(islur[*ivx + (nnl[*ivx] + 1)
16846 	    * 24],4);
16847     comgrace_1.nng[comgrace_1.ngrace - 1] = 1;
16848     comgrace_1.multg[comgrace_1.ngrace - 1] = 1;
16849     comgrace_1.upg[comgrace_1.ngrace - 1] = TRUE_;
16850     comgrace_1.slurg[comgrace_1.ngrace - 1] = FALSE_;
16851     comgrace_1.slashg[comgrace_1.ngrace - 1] = FALSE_;
16852 L18:
16853     getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
16854     if (i_indx("WA", charq, (ftnlen)2, (ftnlen)1) > 0) {
16855 
16856 /*  Grace is on note that was already done, so shift flags forward one note. */
16857 /*  This puts flag on actual note with grace; later for W will go ahead one more. */
16858 
16859 	comgrace_1.ipg[comgrace_1.ngrace - 1] = nnl[*ivx];
16860 	islur[*ivx + (nnl[*ivx] + 1) * 24] = bit_clear(islur[*ivx + (nnl[*ivx]
16861 		 + 1) * 24],4);
16862 	islur[*ivx + nnl[*ivx] * 24] = bit_set(islur[*ivx + nnl[*ivx] * 24],4)
16863 		;
16864 	if (comgrace_1.slurg[comgrace_1.ngrace - 1]) {
16865 	    iornq[*ivx + nnl[*ivx] * 24] = bit_set(iornq[*ivx + nnl[*ivx] *
16866 		    24],24);
16867 	}
16868 	if (*(unsigned char *)charq == 'A') {
16869 
16870 /*  close After, clear way-after bit, to ensure priority of most recent A/W */
16871 
16872 	    ipl[*ivx + nnl[*ivx] * 24] = bit_set(bit_clear(ipl[*ivx + nnl[*
16873 		    ivx] * 24],31),29);
16874 	} else {
16875 
16876 /*  Way after; later assign to following note, and position like normal grace. */
16877 
16878 	    ipl[*ivx + nnl[*ivx] * 24] = bit_set(bit_clear(ipl[*ivx + nnl[*
16879 		    ivx] * 24],29),31);
16880 	}
16881     } else if (*(unsigned char *)charq == 'm') {
16882 	getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
16883 	comgrace_1.multg[comgrace_1.ngrace - 1] = *(unsigned char *)charq -
16884 		48;
16885     } else if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) > 0) {
16886 	readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
16887 	--(*iccount);
16888 	comgrace_1.nng[comgrace_1.ngrace - 1] = i_nint(&fnum);
16889     } else if (*(unsigned char *)charq == 'l') {
16890 	comgrace_1.upg[comgrace_1.ngrace - 1] = FALSE_;
16891     } else if (*(unsigned char *)charq == 's') {
16892 	comgrace_1.slurg[comgrace_1.ngrace - 1] = TRUE_;
16893 	if (nnl[*ivx] > 0) {
16894 
16895 /*  If A- or W-grace, set signal to start slur on main note. */
16896 
16897 	    if (bit_test(ipl[*ivx + nnl[*ivx] * 24],31) || bit_test(ipl[*ivx
16898 		    + nnl[*ivx] * 24],29)) {
16899 		iornq[*ivx + nnl[*ivx] * 24] = bit_set(iornq[*ivx + nnl[*ivx]
16900 			* 24],24);
16901 	    }
16902 	}
16903     } else if (*(unsigned char *)charq == 'x') {
16904 	comgrace_1.slashg[comgrace_1.ngrace - 1] = TRUE_;
16905     } else if (*(unsigned char *)charq == 'u') {
16906     } else if (*(unsigned char *)charq == 'X') {
16907 
16908 /* Space before main note of grace. Number will come next. */
16909 
16910 	++(*iccount);
16911 	readnum_(lineq, iccount, durq, &comgrace_1.graspace[comgrace_1.ngrace
16912 		- 1], (ftnlen)128, (ftnlen)1);
16913 	--(*iccount);
16914     }
16915     if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == 0) {
16916 	goto L18;
16917     }
16918 
16919 /*  At this point, charq is first note name in grace */
16920 
16921     i__1 = comgrace_1.ngstrt[comgrace_1.ngrace - 1] + comgrace_1.nng[
16922 	    comgrace_1.ngrace - 1] - 1;
16923     for (ing = comgrace_1.ngstrt[comgrace_1.ngrace - 1]; ing <= i__1; ++ing) {
16924 	comgrace_1.naccg[ing - 1] = 0;
16925 	ioct = 0;
16926 	if (ing > comgrace_1.ngstrt[comgrace_1.ngrace - 1]) {
16927 L55:
16928 	    getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
16929 	    if (*(unsigned char *)charq == ' ') {
16930 		goto L55;
16931 	    }
16932 	}
16933 	iclastlev = 0;
16934 L9:
16935 	getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
16936 	if (*(unsigned char *)durq != ' ') {
16937 	    if (*(unsigned char *)durq == '+') {
16938 		*lastlev += 7;
16939 		iclastlev += 7;
16940 	    } else if (*(unsigned char *)durq == '-') {
16941 		*lastlev += -7;
16942 		iclastlev += -7;
16943 	    } else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) {
16944 		if (comgrace_1.naccg[ing - 1] == 0) {
16945 		    comgrace_1.naccg[ing - 1] = i_indx("fsn", durq, (ftnlen)3,
16946 			     (ftnlen)1);
16947 		} else {
16948 
16949 /*  Double accidental */
16950 
16951 		    comgrace_1.naccg[ing - 1] = bit_set(comgrace_1.naccg[ing
16952 			    - 1],2);
16953 		}
16954 	    } else {
16955 		ioct = *(unsigned char *)durq - 48;
16956 	    }
16957 	    goto L9;
16958 	}
16959 	if (ioct > 0) {
16960 	    *lastlev = ifnolev_(charq, &ioct, &cominsttrans_1.itransamt[
16961 		    cominsttrans_1.instno[*iv - 1] - 1], (ftnlen)1);
16962 	} else {
16963 	    if (nnl[*ivx] == 0 && ing == comgrace_1.ngstrt[comgrace_1.ngrace
16964 		    - 1]) {
16965 		if (*ivx <= *nv) {
16966 		    kv = 1;
16967 		} else {
16968 		    kv = 2;
16969 		}
16970 		*lastlev = ndlev[*iv + kv * 24] + iclastlev;
16971 	    }
16972 	    *lastlev = *lastlev - 3 + (ifnolev_(charq, &c__10, &
16973 		    cominsttrans_1.itransamt[cominsttrans_1.instno[*iv - 1] -
16974 		    1], (ftnlen)1) - *lastlev + 3) % 7;
16975 	}
16976 	comgrace_1.nolevg[ing - 1] = *lastlev;
16977 /* L19: */
16978     }
16979 
16980 /*  Grace could come before first note of block, so reset end level. */
16981 
16982     if (nnl[*ivx] == 0) {
16983 	if (*ivx <= *nv) {
16984 	    kv = 1;
16985 	} else {
16986 	    kv = 2;
16987 	}
16988 	ndlev[*iv + kv * 24] = *lastlev;
16989     }
16990     return 0;
16991 } /* getgrace_ */
16992 
getitransinfo_(logical * from1,integer * ibarcnt,char * lineq,integer * iccount,integer * ibaroff,integer * nbars,integer * noinst,integer * iv,ftnlen lineq_len)16993 /* Subroutine */ int getitransinfo_(logical *from1, integer *ibarcnt, char *
16994 	lineq, integer *iccount, integer *ibaroff, integer *nbars, integer *
16995 	noinst, integer *iv, ftnlen lineq_len)
16996 {
16997     /* System generated locals */
16998     integer i__1;
16999 
17000     /* Builtin functions */
17001     integer i_indx(char *, char *, ftnlen, ftnlen), i_nint(real *);
17002 
17003     /* Local variables */
17004     static integer ikey;
17005     static real fnum;
17006     static char durq[1];
17007     extern /* Subroutine */ int stop1_(void);
17008     static integer instn;
17009     static logical store;
17010     extern /* Subroutine */ int errmsg_(char *, integer *, integer *, char *,
17011 	    ftnlen, ftnlen);
17012     static integer itramt;
17013     extern /* Subroutine */ int readnum_(char *, integer *, char *, real *,
17014 	    ftnlen, ftnlen), g1etchar_(char *, integer *, char *, ftnlen,
17015 	    ftnlen);
17016 
17017 /* ccccccccccccccccccccccc */
17018 /* c */
17019 /* c GetiTransInfo.for */
17020 /* c */
17021 /* ccccccccccccccccccccccc */
17022 
17023 /*  Called from both g1etnote and getnote, after first 'i' in Ki[...] */
17024 /*  On entry, iccount points to last char retrieved, which is 'i' */
17025 
17026 /*  From1: locgical, true if called from g1etnote */
17027 /*  ibarcnt: tells whether to set EarlyTransOn to true. */
17028 /*  EarlyTransOn set false in blkdata, true here, back to false in topfile. */
17029 
17030 /*  110522/110529 */
17031 /*  Instrument-wise transposition Ki[iInstTrans][+/-][iTransAmt][+/-][iTransKey] */
17032 /*    and repeat i[...] for multiple instruments. Store info in g1etnot if ibarcnt=0 */
17033 /*    so can pass to topfile (via comInstTrans), which is called before getnote. */
17034 /*    Otherwise, will store info from getnote. Initialize EarlyTransOn and */
17035 /*    LaterInstTrans to .false. in blockdata. Set EarlyTransOn from g1etnote; */
17036 /*    LaterInstTrans from getnote. Zero both out after use. nInstTrans really */
17037 /*    only needed for instrument-signatures, not transpositions. iTransAmt is */
17038 /*    ALWAYS active per instrument. Set up instno(iv) so can fetch iTransAmt for */
17039 /*    each staff. */
17040 
17041 /*  iTransAmt stored as fn of instrument #, not like iTransKey which is */
17042 /*    fn. of nm, just a counter, where corr. inst num is iInstTrans(nm). This */
17043 /*    simplifies use of iTransAmt for all calls to ifnolev. */
17044 
17045     *(unsigned char *)durq = 'x';
17046 /* Can't initialize in declaration stmt, only works onc */
17047     if (! cominsttrans_1.earlytranson) {
17048 	cominsttrans_1.earlytranson = *from1 && *ibarcnt == 0;
17049     }
17050     store = cominsttrans_1.earlytranson && *ibarcnt == 0 || *ibarcnt > 0 && !
17051 	    (*from1);
17052     cominsttrans_1.laterinsttrans = ! (*from1) && *ibarcnt > 0;
17053     if (store) {
17054 	cominsttrans_1.ninsttrans = 0;
17055     }
17056 L1:
17057     if (*(unsigned char *)durq == ' ') {
17058 	return 0;
17059     }
17060     g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
17061     if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
17062 	i__1 = *ibarcnt - *ibaroff + *nbars + 1;
17063 	errmsg_(lineq, iccount, &i__1, "There must be an instrument number h"
17064 		"ere!", (ftnlen)128, (ftnlen)40);
17065 	stop1_();
17066     }
17067     if (store) {
17068 	++cominsttrans_1.ninsttrans;
17069     }
17070     readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
17071     instn = i_nint(&fnum);
17072     if (instn > *noinst) {
17073 	i__1 = *ibarcnt - *ibaroff + *nbars + 1;
17074 	errmsg_(lineq, iccount, &i__1, "Instrument number out of range!", (
17075 		ftnlen)128, (ftnlen)31);
17076 	stop1_();
17077     }
17078     if (store) {
17079 	cominsttrans_1.iinsttrans[cominsttrans_1.ninsttrans - 1] = instn;
17080     }
17081 
17082 /*  durq is +/- following inst # (for iTransAmt), iccount is on it. */
17083 
17084     if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
17085 	i__1 = *ibarcnt - *ibaroff + *nbars + 1;
17086 	errmsg_(lineq, iccount, &i__1, "1st character after instrument numbe"
17087 		"r must be \"+,-\"!", (ftnlen)128, (ftnlen)52);
17088 	stop1_();
17089     }
17090     itramt = 44 - *(unsigned char *)durq;
17091 /* +1/-1 for itramt */
17092     g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
17093     if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) {
17094 	i__1 = *ibarcnt - *ibaroff + *nbars + 1;
17095 	errmsg_(lineq, iccount, &i__1, "There must be a transposition amount"
17096 		" here!", (ftnlen)128, (ftnlen)42);
17097 	stop1_();
17098     }
17099     readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
17100     if (store) {
17101 	cominsttrans_1.itransamt[instn - 1] = i_nint(&fnum) * itramt;
17102     }
17103 
17104 /*  durq is +/- following iTransAmt (for iTransKey), iccount is on it. */
17105 
17106     if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
17107 	i__1 = *ibarcnt - *ibaroff + *nbars + 1;
17108 	errmsg_(lineq, iccount, &i__1, "1st character after transposition am"
17109 		"ount must be \"+,-\"!", (ftnlen)128, (ftnlen)55);
17110 	stop1_();
17111     }
17112     ikey = 44 - *(unsigned char *)durq;
17113 /* +1/-1 */
17114     g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
17115     if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) {
17116 	i__1 = *ibarcnt - *ibaroff + *nbars + 1;
17117 	errmsg_(lineq, iccount, &i__1, "There must be a key indicator here!",
17118 		(ftnlen)128, (ftnlen)35);
17119 	stop1_();
17120     }
17121     readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
17122     if (store) {
17123 	cominsttrans_1.itranskey[cominsttrans_1.ninsttrans - 1] = i_nint(&
17124 		fnum) * ikey;
17125     }
17126 
17127 /*  durq is now 1st character after iTransKey, should be either 'i' or ' ' */
17128 
17129     if (*(unsigned char *)durq != 'i' && *(unsigned char *)durq != ' ') {
17130 	i__1 = *ibarcnt - *ibaroff + *nbars + 1;
17131 	errmsg_(lineq, iccount, &i__1, "There must be blank or \"i\" here!", (
17132 		ftnlen)128, (ftnlen)32);
17133 	stop1_();
17134     }
17135     goto L1;
17136 } /* getitransinfo_ */
17137 
getmidi_(integer * noinstarg,char * lineq,integer * iccount,integer * ibarcnt,integer * ibaroff,integer * nbars,integer * lenbar,integer * mtrdenl,logical * first,ftnlen lineq_len)17138 /* Subroutine */ int getmidi_(integer *noinstarg, char *lineq, integer *
17139 	iccount, integer *ibarcnt, integer *ibaroff, integer *nbars, integer *
17140 	lenbar, integer *mtrdenl, logical *first, ftnlen lineq_len)
17141 {
17142     /* Initialized data */
17143 
17144     static shortint midinum[26] = { 1,5,7,13,20,25,33,41,42,43,44,57,58,59,61,
17145 	    65,66,67,68,69,71,72,74,75,8,55 };
17146 
17147     /* System generated locals */
17148     address a__1[2];
17149     integer i__1, i__2[2], i__3, i__4;
17150     real r__1;
17151 
17152     /* Builtin functions */
17153     integer i_indx(char *, char *, ftnlen, ftnlen), i_nint(real *);
17154     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
17155     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
17156 
17157     /* Local variables */
17158     static real pausemid;
17159     extern /* Subroutine */ int midievent_(char *, integer *, integer *,
17160 	    ftnlen);
17161     static integer icm, ipm;
17162     static real qpm;
17163     static integer ivx;
17164     static real fnum;
17165     static char durq[1];
17166     extern /* Subroutine */ int stop1_(void);
17167     static integer iname, numb16;
17168     static char instq[2];
17169     extern /* Subroutine */ int errmsg_(char *, integer *, integer *, char *,
17170 	    ftnlen, ftnlen), addmidi_(integer *, integer *, integer *,
17171 	    integer *, real *, logical *, logical *), getchar_(char *,
17172 	    integer *, char *, ftnlen, ftnlen), readnum_(char *, integer *,
17173 	    char *, real *, ftnlen, ftnlen);
17174 
17175     /* Fortran I/O blocks */
17176     static cilist io___719 = { 0, 6, 0, "(a)", 0 };
17177     static cilist io___720 = { 0, 15, 0, "(a)", 0 };
17178 
17179 
17180 /*      subroutine getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, */
17181 
17182 /*  Use this from both pmxa and pmxb to input and check midi data. "first" tells */
17183 /*  whether pmxa or pmxb.  If .not.first, then tempo and pause commands cause */
17184 /*  things to be written immediately into the midi storage buffers. */
17185 
17186 
17187 /*  immac(i) is the index of i-th macro, i=1,nmac.  Also make a list containing */
17188 /*   nmidsec  section starts and stops based on PLAYING macros (not recording). */
17189 
17190 
17191 /*      Instrument codes */
17192 
17193 /*         XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbXtuXfrXsoXalXteX */
17194 
17195 /*           bsXobXbaXclXflXreXctXvo */
17196 
17197 L1:
17198     getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
17199     if (*(unsigned char *)durq == 't') {
17200 
17201 /*  Tempo in beats ber minute */
17202 
17203 	getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
17204 	if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) {
17205 	    i__1 = *ibarcnt - *ibaroff + *nbars + 1;
17206 	    errmsg_(lineq, iccount, &i__1, "Expected an integer here for the"
17207 		    " pause!", (ftnlen)128, (ftnlen)39);
17208 	    stop1_();
17209 /*        else if (mmacrec) then */
17210 /*          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, */
17211 /*     *      'Cannot change MIDI tempo while recording a MidiMacro!') */
17212 /*          call stop1() */
17213 	}
17214 	readnum_(lineq, iccount, durq, &qpm, (ftnlen)128, (ftnlen)1);
17215 	--(*iccount);
17216 	if (! (*first)) {
17217 	    i__1 = i_nint(&qpm);
17218 	    midievent_("t", &i__1, &c__0, (ftnlen)1);
17219 	    commmac_1.gottempo = TRUE_;
17220 	}
17221 	goto L1;
17222     } else if (*(unsigned char *)durq == 'p') {
17223 
17224 /*  Insert a pause.  pausemid = pause in 1/4's */
17225 
17226 	getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
17227 	if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) {
17228 	    i__1 = *ibarcnt - *ibaroff + *nbars + 1;
17229 	    errmsg_(lineq, iccount, &i__1, "Expected a number here for the p"
17230 		    "ause!", (ftnlen)128, (ftnlen)37);
17231 	    stop1_();
17232 	}
17233 	readnum_(lineq, iccount, durq, &pausemid, (ftnlen)128, (ftnlen)1);
17234 	--(*iccount);
17235 	if (! (*first)) {
17236 
17237 /*  Compute a meter for the pause.  This is only to keep MidiNotate on track. */
17238 /*  Round pause to nearest 16th.  Let denominator always be 16. */
17239 
17240 	    r__1 = pausemid * 4;
17241 	    numb16 = i_nint(&r__1);
17242 	    midievent_("m", &numb16, &c__16, (ftnlen)1);
17243 
17244 /*  Put in pausemid beats of rest */
17245 
17246 	    i__1 = commidi_1.numchan - 1;
17247 	    for (icm = 0; icm <= i__1; ++icm) {
17248 		r__1 = numb16 * 4.f;
17249 		addmidi_(&icm, &c__0, &c__0, &c__0, &r__1, &c_true, &c_false);
17250 /* L3: */
17251 	    }
17252 	    r__1 = pausemid * 240;
17253 	    comevent_1.miditime += i_nint(&r__1);
17254 
17255 /*  Restore meter */
17256 
17257 	    i__1 = *mtrdenl * *lenbar / 64;
17258 	    midievent_("m", &i__1, mtrdenl, (ftnlen)1);
17259 	}
17260 	goto L1;
17261     } else if (*(unsigned char *)durq == 'i') {
17262 
17263 /* c  Instrument numbers or letters.  Expect nv of them. */
17264 /*  Instrument numbers or letters.  Expect noinst of them. */
17265 
17266 /*        do 2 ivx = 1 , nv */
17267 	i__1 = *noinstarg;
17268 	for (ivx = 1; ivx <= i__1; ++ivx) {
17269 	    getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
17270 	    if (*(unsigned char *)durq > 96) {
17271 
17272 /*  It's a lowercase letter.  Get another, find corr. instrument #. */
17273 
17274 		*(unsigned char *)instq = *(unsigned char *)durq;
17275 		getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
17276 /* Writing concatenation */
17277 		i__2[0] = 1, a__1[0] = instq;
17278 		i__2[1] = 1, a__1[1] = durq;
17279 		s_cat(instq, a__1, i__2, &c__2, (ftnlen)2);
17280 		iname = i_indx("XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbXtuX"
17281 			"frXsoXalXteXbsXobXbaXclXflXreXctXvo", instq, (ftnlen)
17282 			79, (ftnlen)2) / 3;
17283 		if (iname == 0) {
17284 		    i__3 = *ibarcnt - *ibaroff + *nbars + 1;
17285 		    errmsg_(lineq, iccount, &i__3, "Unrecognized 2-letter mi"
17286 			    "di instrument name!", (ftnlen)128, (ftnlen)43);
17287 		    stop1_();
17288 		}
17289 		commidi_1.midinst[ivx - 1] = midinum[iname - 1] - 1;
17290 	    } else {
17291 
17292 /*  Expect a number, followed by ":" if that is followed by another number. */
17293 /*  I.e., if after call to readnum, durq is not ":", it must be either blank */
17294 /*  or next instrument letter. */
17295 
17296 		if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
17297 		    i__3 = *ibarcnt - *ibaroff + *nbars + 1;
17298 		    errmsg_(lineq, iccount, &i__3, "Expected a midi instrume"
17299 			    "nt number here!", (ftnlen)128, (ftnlen)39);
17300 		    stop1_();
17301 		}
17302 		readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
17303 		commidi_1.midinst[ivx - 1] = i_nint(&fnum) - 1;
17304 		if (commidi_1.midinst[ivx - 1] < 0 || commidi_1.midinst[ivx -
17305 			1] > 255) {
17306 		    i__3 = *iccount - 1;
17307 		    i__4 = *ibarcnt - *ibaroff + *nbars + 1;
17308 		    errmsg_(lineq, &i__3, &i__4, "Midi instrument number mus"
17309 			    "t be in range 1-128!", (ftnlen)128, (ftnlen)46);
17310 		    stop1_();
17311 		}
17312 		if (*(unsigned char *)durq != ':') {
17313 		    --(*iccount);
17314 		}
17315 	    }
17316 /* L2: */
17317 	}
17318 	goto L1;
17319     } else if (*(unsigned char *)durq == 'v') {
17320 
17321 /* Get volumes for each instrument.  Expect nv of them. */
17322 /*    Follow same pattern as for insttrument numbers above. */
17323 
17324 /*        do 7 ivx = 1 , nv */
17325 	i__1 = *noinstarg;
17326 	for (ivx = 1; ivx <= i__1; ++ivx) {
17327 	    getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
17328 	    if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
17329 		i__3 = *ibarcnt - *ibaroff + *nbars + 1;
17330 		errmsg_(lineq, iccount, &i__3, "Expected a midi velocity num"
17331 			"ber here!", (ftnlen)128, (ftnlen)37);
17332 		stop1_();
17333 	    }
17334 	    readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
17335 	    commvel_1.midivel[ivx - 1] = i_nint(&fnum) - 1;
17336 	    if (commvel_1.midivel[ivx - 1] < 0 || commvel_1.midivel[ivx - 1]
17337 		    > 127) {
17338 		i__3 = *iccount - 1;
17339 		i__4 = *ibarcnt - *ibaroff + *nbars + 1;
17340 		errmsg_(lineq, &i__3, &i__4, "Midi velocity must be in range"
17341 			" 1-128!", (ftnlen)128, (ftnlen)37);
17342 		stop1_();
17343 	    }
17344 	    if (*(unsigned char *)durq != ':') {
17345 		--(*iccount);
17346 	    }
17347 /* L7: */
17348 	}
17349 	goto L1;
17350     } else if (*(unsigned char *)durq == 'b') {
17351 
17352 /* Get balance for each instrument.  Expect nv of them. */
17353 /*    Follow same pattern as for instrument numbers above. */
17354 
17355 /*        do 8 ivx = 1 , nv */
17356 	i__1 = *noinstarg;
17357 	for (ivx = 1; ivx <= i__1; ++ivx) {
17358 	    getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
17359 	    if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
17360 		i__3 = *ibarcnt - *ibaroff + *nbars + 1;
17361 		errmsg_(lineq, iccount, &i__3, "Expected a balance number he"
17362 			"re!", (ftnlen)128, (ftnlen)31);
17363 		stop1_();
17364 	    }
17365 	    readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
17366 	    commvel_1.midibal[ivx - 1] = i_nint(&fnum) - 1;
17367 	    if (commvel_1.midibal[ivx - 1] < 0 || commvel_1.midibal[ivx - 1]
17368 		    > 127) {
17369 		i__3 = *iccount - 1;
17370 		i__4 = *ibarcnt - *ibaroff + *nbars + 1;
17371 		errmsg_(lineq, &i__3, &i__4, "Midi balance must be in range "
17372 			"1-128!", (ftnlen)128, (ftnlen)36);
17373 		stop1_();
17374 	    }
17375 	    if (*(unsigned char *)durq != ':') {
17376 		--(*iccount);
17377 	    }
17378 /* L8: */
17379 	}
17380 	goto L1;
17381     } else if (*(unsigned char *)durq == 'T') {
17382 
17383 /* Get transposition for each instrument.  Expect nv of them. */
17384 /*    Follow similar pattern as above, but separator is +|-. */
17385 
17386 /*        do 9 ivx = 1 , nv */
17387 	i__1 = *noinstarg;
17388 	for (ivx = 1; ivx <= i__1; ++ivx) {
17389 	    getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
17390 	    ipm = i_indx("-+", durq, (ftnlen)2, (ftnlen)1);
17391 	    if (ipm == 0) {
17392 		i__3 = *ibarcnt - *ibaroff + *nbars + 1;
17393 		errmsg_(lineq, iccount, &i__3, "Expected \"+\" or \"-\" for "
17394 			"midi transposition here!", (ftnlen)128, (ftnlen)48);
17395 		stop1_();
17396 	    }
17397 	    ipm = (ipm << 1) - 3;
17398 	    getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
17399 	    if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) {
17400 		i__3 = *ibarcnt - *ibaroff + *nbars + 1;
17401 		errmsg_(lineq, iccount, &i__3, "Expected a number here!", (
17402 			ftnlen)128, (ftnlen)23);
17403 		stop1_();
17404 	    }
17405 	    readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
17406 	    commvel_1.miditran[ivx - 1] = ipm * i_nint(&fnum);
17407 /*          if (mod(miditran(ivx),12).ne. 0) then */
17408 /*            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, */
17409 /*     *         'Midi transposition limited to multiples of 12!') */
17410 /*            call stop1() */
17411 /*          end if */
17412 	    --(*iccount);
17413 /* L9: */
17414 	}
17415 	goto L1;
17416     } else if (*(unsigned char *)durq == 'g') {
17417 	getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
17418 	if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) {
17419 	    i__1 = *ibarcnt - *ibaroff + *nbars + 1;
17420 	    errmsg_(lineq, iccount, &i__1, "Expected an integer here for the"
17421 		    " midi gap!", (ftnlen)128, (ftnlen)42);
17422 	    stop1_();
17423 	}
17424 	readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
17425 	commidi_1.mgap = i_nint(&fnum);
17426 	--(*iccount);
17427 	goto L1;
17428     } else if (*(unsigned char *)durq == 'M') {
17429 
17430 /*  MidiMacros */
17431 
17432 	getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
17433 	if (*(unsigned char *)durq == 'R') {
17434 
17435 /*  Start recording */
17436 
17437 	    if (commmac_1.mmacrec) {
17438 		i__1 = *ibarcnt - *ibaroff + *nbars + 1;
17439 		errmsg_(lineq, iccount, &i__1, "You tried to record a MidiMa"
17440 			"cro while already recording!", (ftnlen)128, (ftnlen)
17441 			56);
17442 		stop1_();
17443 	    }
17444 	    commmac_1.mmacrec = TRUE_;
17445 	    getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
17446 	    if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
17447 		i__1 = *ibarcnt - *ibaroff + *nbars + 1;
17448 		errmsg_(lineq, iccount, &i__1, "Expected MidiMacro ID number"
17449 			" here!", (ftnlen)128, (ftnlen)34);
17450 		stop1_();
17451 	    }
17452 	    readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
17453 	    --(*iccount);
17454 	    if (! (*first)) {
17455 		commmac_1.immac = i_nint(&fnum);
17456 		if (commmac_1.immac > 20) {
17457 		    i__1 = *ibarcnt - *ibaroff + *nbars + 1;
17458 		    errmsg_(lineq, iccount, &i__1, "MidiMacro ID cannot exce"
17459 			    "ed 20!", (ftnlen)128, (ftnlen)30);
17460 		    stop1_();
17461 		}
17462 
17463 /*  Save the start time */
17464 
17465 		commmac_1.mmactime[commmac_1.immac - 1] = comevent_1.miditime;
17466 		i__1 = commidi_1.numchan;
17467 		for (icm = 0; icm <= i__1; ++icm) {
17468 		    if (icm < commidi_1.numchan) {
17469 			if (commidi_1.restpend[icm]) {
17470 
17471 /*  Adjust if there's a rest at end of prior section.  Insert dummy turnoff. */
17472 /*    (This causes two turn-offs in a row, which testmidi sees as an error). */
17473 
17474 /*  Before:    section1  ------rest-------  section2(to be recorded) */
17475 /*  After:     section1  rest1  now  rest2  section2(recorded) */
17476 
17477 			    addmidi_(&icm, &c__30, &c__0, &c__0, &
17478 				    commidi_1.trest[icm], &c_false, &c_true);
17479 			    commidi_1.trest[icm] = 0.f;
17480 			    commidi_1.restpend[icm] = FALSE_;
17481 			}
17482 		    } else {
17483 			if (comevent_1.miditime > comevent_1.lasttime) {
17484 
17485 /*  Insert a dummy turnoff in conductor track */
17486 
17487 			    r__1 = (comevent_1.miditime - comevent_1.lasttime)
17488 				     / 15.f;
17489 			    addmidi_(&icm, &c__30, &c__0, &c__0, &r__1, &
17490 				    c_false, &c_true);
17491 			    comevent_1.lasttime = comevent_1.miditime;
17492 			}
17493 		    }
17494 		    commmac_1.mmacstrt[icm + commmac_1.immac * 25 - 25] =
17495 			    commidi_1.imidi[icm] + 1;
17496 /* L4: */
17497 		}
17498 	    }
17499 	    goto L1;
17500 	} else if (i_indx("123456789P", durq, (ftnlen)10, (ftnlen)1) == 0) {
17501 
17502 /*  End recording; close the open macro.  Get immac from common. */
17503 
17504 	    if (! commmac_1.mmacrec) {
17505 		i__1 = *iccount - 1;
17506 		i__3 = *ibarcnt - *ibaroff + *nbars + 1;
17507 		errmsg_(lineq, &i__1, &i__3, "You tried to end a MidiMacro b"
17508 			"efore starting one!", (ftnlen)128, (ftnlen)49);
17509 		stop1_();
17510 	    }
17511 	    commmac_1.mmacrec = FALSE_;
17512 	    --(*iccount);
17513 	    if (! (*first)) {
17514 
17515 /*  Save the macro duration */
17516 
17517 		commmac_1.mmactime[commmac_1.immac - 1] = comevent_1.miditime
17518 			- commmac_1.mmactime[commmac_1.immac - 1];
17519 		i__1 = commidi_1.numchan;
17520 		for (icm = 0; icm <= i__1; ++icm) {
17521 		    if (icm < commidi_1.numchan) {
17522 			if (commidi_1.restpend[icm]) {
17523 			    addmidi_(&icm, &c__30, &c__0, &c__0, &
17524 				    commidi_1.trest[icm], &c_false, &c_true);
17525 			    commidi_1.trest[icm] = 0.f;
17526 			    commidi_1.restpend[icm] = FALSE_;
17527 			}
17528 		    } else {
17529 			if (comevent_1.miditime > comevent_1.lasttime) {
17530 
17531 /*  Insert a dummy turnoff in conductor track if needed. */
17532 
17533 			    r__1 = (comevent_1.miditime - comevent_1.lasttime)
17534 				     / 15.f;
17535 			    addmidi_(&icm, &c__30, &c__0, &c__0, &r__1, &
17536 				    c_false, &c_true);
17537 			    comevent_1.lasttime = comevent_1.miditime;
17538 			}
17539 		    }
17540 		    commmac_1.mmacend[icm + commmac_1.immac * 25 - 25] =
17541 			    commidi_1.imidi[icm];
17542 /* L5: */
17543 		}
17544 	    }
17545 	    if (*(unsigned char *)durq != ' ') {
17546 		goto L1;
17547 	    }
17548 	} else if (*(unsigned char *)durq == 'P') {
17549 
17550 /*  Play Back a Macro */
17551 
17552 	    getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
17553 	    if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
17554 		i__1 = *ibarcnt - *ibaroff + *nbars + 1;
17555 		errmsg_(lineq, iccount, &i__1, "Expected MidiMacro ID number"
17556 			" here!", (ftnlen)128, (ftnlen)34);
17557 		stop1_();
17558 	    }
17559 	    if (commmac_1.mmacrec) {
17560 		i__1 = *ibarcnt - *ibaroff + *nbars + 1;
17561 		errmsg_(lineq, iccount, &i__1, "You tried to play a MidiMacr"
17562 			"o before ending recording!", (ftnlen)128, (ftnlen)54);
17563 		stop1_();
17564 	    }
17565 	    readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
17566 	    --(*iccount);
17567 	    if (! (*first)) {
17568 		commmac_1.immac = i_nint(&fnum);
17569 		if (commmac_1.mmactime[commmac_1.immac - 1] == 0) {
17570 		    i__1 = *ibarcnt - *ibaroff + *nbars + 1;
17571 		    errmsg_(lineq, iccount, &i__1, "Cannot play a MIDI macro"
17572 			    " before recording it!", (ftnlen)128, (ftnlen)45);
17573 		    stop1_();
17574 		}
17575 		i__1 = commidi_1.numchan;
17576 		for (icm = 0; icm <= i__1; ++icm) {
17577 		    if (icm < commidi_1.numchan) {
17578 			if (commidi_1.restpend[icm]) {
17579 			    addmidi_(&icm, &c__30, &c__0, &c__0, &
17580 				    commidi_1.trest[icm], &c_false, &c_true);
17581 			    commidi_1.trest[icm] = 0.f;
17582 			    commidi_1.restpend[icm] = FALSE_;
17583 			}
17584 		    } else {
17585 			if (comevent_1.miditime > comevent_1.lasttime) {
17586 
17587 /*  Insert a dummy turnoff in conductor track */
17588 
17589 			    r__1 = (comevent_1.miditime - comevent_1.lasttime)
17590 				     / 15.f;
17591 			    addmidi_(&icm, &c__30, &c__0, &c__0, &r__1, &
17592 				    c_false, &c_true);
17593 			}
17594 		    }
17595 		    commmac_1.msecend[icm + commmac_1.nmidsec * 25 - 25] =
17596 			    commidi_1.imidi[icm];
17597 		    commmac_1.msecstrt[icm + (commmac_1.nmidsec + 1) * 25 -
17598 			    25] = commmac_1.mmacstrt[icm + commmac_1.immac *
17599 			    25 - 25];
17600 		    commmac_1.msecend[icm + (commmac_1.nmidsec + 1) * 25 - 25]
17601 			     = commmac_1.mmacend[icm + commmac_1.immac * 25 -
17602 			    25];
17603 		    commmac_1.msecstrt[icm + (commmac_1.nmidsec + 2) * 25 -
17604 			    25] = commidi_1.imidi[icm] + 1;
17605 /* L6: */
17606 		}
17607 		commmac_1.nmidsec += 2;
17608 
17609 /*  Update running time */
17610 
17611 		comevent_1.miditime += commmac_1.mmactime[commmac_1.immac - 1]
17612 			;
17613 		comevent_1.lasttime = comevent_1.miditime;
17614 	    }
17615 	    goto L1;
17616 	} else {
17617 	    i__1 = *ibarcnt - *ibaroff + *nbars + 1;
17618 	    errmsg_(lineq, iccount, &i__1, "Illegal character in MidiMacro s"
17619 		    "ub-command!", (ftnlen)128, (ftnlen)43);
17620 	    stop1_();
17621 	}
17622     } else if (*(unsigned char *)durq == 'd') {
17623 	commidi_1.debugmidi = TRUE_;
17624 	goto L1;
17625     } else if (*(unsigned char *)durq != ' ') {
17626 	i__1 = *ibarcnt - *ibaroff + *nbars + 1;
17627 	errmsg_(lineq, iccount, &i__1, "Illegal character in MIDI input data!"
17628 		, (ftnlen)128, (ftnlen)37);
17629 	s_wsfe(&io___719);
17630 	do_fio(&c__1, "May be too many args to i,v,b, or T. As of Ver. 2.7, "
17631 		"should be noinst, not nv", (ftnlen)77);
17632 	e_wsfe();
17633 	s_wsfe(&io___720);
17634 	do_fio(&c__1, "May be too many args to i,v,b, or T. As of Ver. 2.7, "
17635 		"should be noinst, not nv", (ftnlen)77);
17636 	e_wsfe();
17637 	stop1_();
17638     }
17639     if (! commmac_1.gottempo && ! (*first)) {
17640 
17641 /*  If no tempo is set on first call on the pmxb pass, then set it */
17642 
17643 	midievent_("t", &c__96, &c__0, (ftnlen)1);
17644 	commmac_1.gottempo = TRUE_;
17645     }
17646     return 0;
17647 } /* getmidi_ */
17648 
getnote_(logical * loop)17649 /* Subroutine */ int getnote_(logical *loop)
17650 {
17651     /* System generated locals */
17652     address a__1[2], a__2[3], a__3[5], a__4[6], a__5[8], a__6[13];
17653     integer i__1, i__2, i__3, i__4[2], i__5[3], i__6[5], i__7[6], i__8[8],
17654 	    i__9[13];
17655     real r__1;
17656     char ch__1[1], ch__2[12], ch__3[10], ch__4[13], ch__5[1], ch__6[69],
17657 	    ch__7[11], ch__8[3], ch__9[9], ch__10[61], ch__11[8], ch__12[82],
17658 	    ch__13[83], ch__14[62], ch__15[122], ch__16[15], ch__17[59],
17659 	    ch__18[70], ch__19[36];
17660     icilist ici__1;
17661 
17662     /* Builtin functions */
17663     integer i_indx(char *, char *, ftnlen, ftnlen), s_wsfe(cilist *), do_fio(
17664 	    integer *, char *, ftnlen), e_wsfe(void);
17665     double r_mod(real *, real *);
17666     integer s_cmp(char *, char *, ftnlen, ftnlen), s_wsle(cilist *), do_lio(
17667 	    integer *, integer *, char *, ftnlen), e_wsle(void), i_nint(real *
17668 	    ), lbit_shift(integer, integer);
17669     /* Subroutine */ int s_stop(char *, ftnlen);
17670     double log(doublereal);
17671     integer s_rsfi(icilist *), e_rsfi(void);
17672     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen),
17673 	     s_copy(char *, char *, ftnlen, ftnlen);
17674     integer s_wsfi(icilist *), e_wsfi(void);
17675 
17676     /* Local variables */
17677     static integer lentemp;
17678     extern /* Subroutine */ int g1etchar_(char *, integer *, char *, ftnlen,
17679 	    ftnlen), getgrace_(integer *, integer *, char *, integer *,
17680 	    integer *, integer *, integer *, integer *, integer *, integer *,
17681 	    integer *, ftnlen);
17682     extern integer igetbits_(integer *, integer *, integer *);
17683     static integer idotform;
17684     extern /* Subroutine */ int newvoice_(integer *, char *, logical *,
17685 	    ftnlen);
17686     static integer j;
17687     extern /* Subroutine */ int readmeter_(char *, integer *, integer *,
17688 	    integer *, ftnlen), midievent_(char *, integer *, integer *,
17689 	    ftnlen);
17690     static integer ic, jv, kv, ipm, ivf, ndx;
17691     static real dum;
17692     static integer iiv, iis, isl, iip, npg1, num1, iadj, nadj, lclf;
17693     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
17694     static logical cdot;
17695     static integer nole, ioct;
17696     static real fnum;
17697     static char dotq[1], durq[1], dumq[1];
17698     extern /* Subroutine */ int getx_(char *, integer *, integer *, logical *,
17699 	     real *, integer *, integer *, integer *, integer *, integer *,
17700 	    integer *, integer *, char *, integer *, ftnlen, ftnlen);
17701     static integer itup, nnnl, ntup, ndxm, nfig1;
17702     extern /* Subroutine */ int mrec1_(char *, integer *, integer *, ftnlen);
17703     static integer ipg1r;
17704     extern /* Subroutine */ int stop1_(void);
17705     static integer lhead;
17706     static char charq[1], lineq[128];
17707     static logical moved;
17708     static integer ndoub;
17709     static char tempq[24];
17710     extern /* Subroutine */ int sslur_(char *, integer *, integer *, integer *
17711 	    , integer *, integer *, integer *, integer *, integer *, logical *
17712 	    , integer *, char *, ftnlen, ftnlen);
17713     static integer ifnum, nvold, iinow, iinst;
17714     extern /* Subroutine */ int getitransinfo_(logical *, integer *, char *,
17715 	    integer *, integer *, integer *, integer *, integer *, ftnlen);
17716     static logical quoted;
17717     static char hdlndq[59];
17718     extern integer lenstr_(char *, integer *, ftnlen);
17719     static integer numnum;
17720     extern /* Subroutine */ int getorn_(char *, integer *, integer *, integer
17721 	    *, logical *, integer *, integer *, integer *, logical *, logical
17722 	    *, integer *, ftnlen);
17723     static integer nnlivx;
17724     extern /* Subroutine */ int littex_(integer *, integer *, integer *,
17725 	    logical *, char *, integer *, ftnlen), getfig_(integer *, char *,
17726 	    char *, integer *, logical *, integer *, integer *, integer *,
17727 	    char *, integer *, integer *, ftnlen, ftnlen, ftnlen);
17728     static integer nactmp;
17729     extern /* Subroutine */ int getdyn_(integer *, integer *, integer *,
17730 	    integer *, char *, integer *, ftnlen), getbuf_(char *, ftnlen);
17731     extern integer ncmidf_(char *, ftnlen);
17732     static integer nnliiv;
17733     extern /* Subroutine */ int printl_(char *, ftnlen);
17734     static integer ibaroff, lenbeat;
17735     extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen,
17736 	    ftnlen), getmidi_(integer *, char *, integer *, integer *,
17737 	    integer *, integer *, integer *, integer *, logical *, ftnlen),
17738 	    readnum_(char *, integer *, char *, real *, ftnlen, ftnlen);
17739     static integer iofforn;
17740     extern /* Subroutine */ int setbits_(integer *, integer *, integer *,
17741 	    integer *), chkpm4ac_(char *, integer *, integer *, logical *,
17742 	    ftnlen);
17743     static integer numshft;
17744     static real xofforn;
17745     extern integer ifnolev_(char *, integer *, integer *, ftnlen), ifnodur_(
17746 	    integer *, char *, ftnlen);
17747     static real fmovbrk;
17748     extern integer numclef_(char *, ftnlen);
17749     static integer itother;
17750     extern /* Subroutine */ int spsslur_(char *, integer *, integer *,
17751 	    integer *, integer *, integer *, integer *, integer *, integer *,
17752 	    integer *, logical *, integer *, char *, ftnlen, ftnlen);
17753     static integer lvoltxt, ltopnam, namstrt;
17754     static real tintstf;
17755 
17756     /* Fortran I/O blocks */
17757     static cilist io___724 = { 0, 11, 0, "(a)", 0 };
17758     static cilist io___732 = { 0, 6, 0, 0, 0 };
17759     static cilist io___746 = { 0, 6, 0, 0, 0 };
17760     static cilist io___747 = { 0, 6, 0, 0, 0 };
17761     static cilist io___752 = { 0, 6, 0, 0, 0 };
17762     static cilist io___754 = { 0, 6, 0, 0, 0 };
17763     static cilist io___755 = { 0, 6, 0, 0, 0 };
17764     static cilist io___758 = { 0, 6, 0, 0, 0 };
17765     static cilist io___764 = { 0, 11, 0, "(a)", 0 };
17766     static cilist io___765 = { 0, 11, 0, "(a)", 0 };
17767     static cilist io___768 = { 0, 11, 0, "(a)", 0 };
17768     static cilist io___769 = { 0, 11, 0, "(a)", 0 };
17769     static cilist io___770 = { 0, 11, 0, "(a11,i2,a)", 0 };
17770     static cilist io___771 = { 0, 11, 0, "(a9,i2,a)", 0 };
17771     static cilist io___773 = { 0, 11, 0, "(a8,i1,a3)", 0 };
17772     static cilist io___774 = { 0, 11, 0, "(a9,i2,a4)", 0 };
17773     static cilist io___775 = { 0, 11, 0, "(a8,i1,a)", 0 };
17774     static cilist io___776 = { 0, 11, 0, "(a9,i2,a)", 0 };
17775     static cilist io___777 = { 0, 6, 0, 0, 0 };
17776     static cilist io___778 = { 0, 6, 0, 0, 0 };
17777     static cilist io___791 = { 0, 6, 0, 0, 0 };
17778     static cilist io___793 = { 0, 11, 0, "(a)", 0 };
17779     static cilist io___794 = { 0, 11, 0, "(a)", 0 };
17780     static cilist io___795 = { 0, 11, 0, "(a)", 0 };
17781     static cilist io___796 = { 0, 11, 0, "(a)", 0 };
17782     static cilist io___798 = { 0, 11, 0, "(a)", 0 };
17783     static cilist io___801 = { 0, 11, 0, "(a)", 0 };
17784     static cilist io___802 = { 0, 11, 0, "(a)", 0 };
17785     static cilist io___803 = { 0, 11, 0, "(a)", 0 };
17786     static cilist io___804 = { 0, 11, 0, "(a)", 0 };
17787     static cilist io___805 = { 0, 11, 0, "(a)", 0 };
17788     static cilist io___806 = { 0, 11, 0, "(a)", 0 };
17789     static cilist io___807 = { 0, 11, 0, "(a)", 0 };
17790     static cilist io___808 = { 0, 11, 0, "(a)", 0 };
17791 
17792 
17793 
17794 /*  nvmx is either 1 or 2.  ivmx(iv,1)=iv, ; ivmx(iv,2)>nv if defined */
17795 /*  ivx is current ivmx, and is the index for all notes, acc's etc. */
17796 
17797     cdot = FALSE_;
17798 L1:
17799     getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
17800     if (comget_1.lastchar) {
17801 	return 0;
17802     }
17803     if (*(unsigned char *)charq == ' ') {
17804 	goto L1;
17805     }
17806     if (*(unsigned char *)charq == '%') {
17807 
17808 /*  Check for a bar number format: */
17809 
17810 	if (all_1.iccount == 1 && *(unsigned char *)&lineq[1] == ' ' &&
17811 		i_indx("bB1234567890", lineq + 2, (ftnlen)12, (ftnlen)1) > 0)
17812 		{
17813 	    if (comlast_1.islast) {
17814 		s_wsfe(&io___724);
17815 		do_fio(&c__1, lineq, lenstr_(lineq, &c__128, (ftnlen)128));
17816 		e_wsfe();
17817 	    }
17818 	}
17819 	all_1.iccount = 128;
17820 	goto L1;
17821     }
17822 
17823 /*  Closing repeat iff charq='/' and the prev. char was 'R' with 'd' or 'r' */
17824 
17825     if (comget_1.rptprev) {
17826 	comget_1.rptnd1 = *(unsigned char *)charq == '/';
17827 	comget_1.rptprev = FALSE_;
17828     }
17829 
17830 /*  Repeat at end of a piece */
17831 
17832     if (*(unsigned char *)charq >= 97 && *(unsigned char *)charq <= 103 || *(
17833 	    unsigned char *)charq == 'r') {
17834 	if (cdot) {
17835 	    goto L28;
17836 	}
17837 
17838 /*  This is a note/rest. */
17839 
17840 	idotform = 0;
17841 	numnum = 0;
17842 
17843 /*  If start of line of music, set pitch from previous */
17844 
17845 	if (commvl_1.ivx <= all_1.nv) {
17846 	    kv = 1;
17847 	} else {
17848 	    kv = 2;
17849 	}
17850 	if (all_1.nnl[commvl_1.ivx - 1] == 0) {
17851 	    comnotes_1.lastlev = comnotes_1.ndlev[all_1.iv + kv * 24 - 25];
17852 	}
17853 
17854 /*  notcrd is used to tell if orn. goes on main note or chord note */
17855 
17856 /*        notcrd = .true.   !Move dow.  Was not observed if dotted shortcut. */
17857 
17858 /*  Increase note count, then loop 'til blank. Label 28 is for dotted shortcuts. */
17859 
17860 L28:
17861 
17862 /*  Moved this from just above, 2 Feb 02 */
17863 
17864 	comnotes_1.notcrd = TRUE_;
17865 	++all_1.nnl[commvl_1.ivx - 1];
17866 	if (comget_1.ornrpt) {
17867 
17868 /*  Replicate ornament bits, also bit 23 for beam handling if chord. */
17869 
17870 	    all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1]
17871 		    |= all_1.iornq[commvl_1.ivx - 1];
17872 	    if ((all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24
17873 		    - 1] & 32896) > 0) {
17874 
17875 /*  This is a trill (bit 7 or 15) so must dup the parameters */
17876 
17877 		++comtrill_1.ntrill;
17878 		comtrill_1.ivtrill[comtrill_1.ntrill - 1] = commvl_1.ivx;
17879 		comtrill_1.iptrill[comtrill_1.ntrill - 1] = all_1.nnl[
17880 			commvl_1.ivx - 1];
17881 		comtrill_1.xnsktr[comtrill_1.ntrill - 1] = comtrill_1.xnsktr[
17882 			comtrill_1.ntrill - 2];
17883 	    }
17884 	}
17885 	if (comget_1.stickys) {
17886 
17887 /*  Grab stemlength shortening parameters from prior note */
17888 
17889 	    all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] =
17890 		     bit_set(all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx
17891 		    - 1] * 24 - 25],27);
17892 	    i__1 = igetbits_(&all_1.mult[commvl_1.ivx + (all_1.nnl[
17893 		    commvl_1.ivx - 1] - 1) * 24 - 25], &c__3, &c__28);
17894 	    setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
17895 		    24 - 25], &c__3, &c__28, &i__1);
17896 	}
17897 	if (comfb_1.autofbon && comfb_1.tautofb > comtol_1.tol && !
17898 		comget_1.fbon) {
17899 
17900 /*  Doing auto forced beams, and period has been set, so check if this note */
17901 /*    starts a period. */
17902 
17903 /*          if (mod(1.*itsofar(ivx),tautofb) .lt. tol) then */
17904 	    r__1 = all_1.itsofar[commvl_1.ivx - 1] - comfb_1.t1autofb;
17905 	    if (r_mod(&r__1, &comfb_1.tautofb) < comtol_1.tol) {
17906 
17907 /*  Start a forced beam here */
17908 
17909 		++comfb_1.nfb[commvl_1.ivx - 1];
17910 		comget_1.fbon = TRUE_;
17911 		*(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[
17912 			commvl_1.ivx - 1] * 24 - 25] = 'x';
17913 		comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] *
17914 			24 - 25] = (real) all_1.itsofar[commvl_1.ivx - 1];
17915 	    }
17916 	}
17917 	if (comget_1.fbon) {
17918 	    all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] =
17919 		    bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
17920 		    1] * 24 - 25],30);
17921 	}
17922 	*(unsigned char *)dotq = 'x';
17923 	if (*(unsigned char *)charq == 'r') {
17924 	    all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
17925 		    = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
17926 		    commvl_1.ivx - 1] * 24 - 25],0);
17927 	}
17928 	if (bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
17929 		24 - 25],0)) {
17930 
17931 /*  Rest stuff.  First check if previous note was full-bar-pause */
17932 
17933 	    i__1 = all_1.iccount;
17934 	    if (s_cmp(lineq + i__1, " ", all_1.iccount + 1 - i__1, (ftnlen)1)
17935 		    == 0 && all_1.nnl[commvl_1.ivx - 1] > 1) {
17936 		if (bit_test(all_1.islur[commvl_1.ivx + (all_1.nnl[
17937 			commvl_1.ivx - 1] - 1) * 24 - 25],19)) {
17938 		    all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
17939 			    24 - 25] = bit_set(all_1.islur[commvl_1.ivx +
17940 			    all_1.nnl[commvl_1.ivx - 1] * 24 - 25],19);
17941 		}
17942 	    }
17943 
17944 /*  Set default rest level at 0 unless 2 voices/staff in which case it's -4 or 2 */
17945 /*  for voice a or b.  Set a-types at 0 as encountered and adjust later */
17946 /*  after '//'.  (Override heights will be set to 100+offset) */
17947 
17948 	    if (commvl_1.ivx <= all_1.nv) {
17949 		all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
17950 			25] = 0;
17951 	    } else {
17952 		all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
17953 			25] = 2;
17954 	    }
17955 	}
17956 L2:
17957 	getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
17958 	ic = *(unsigned char *)durq;
17959 	if (ic <= 57 && ic >= 48) {
17960 
17961 /*  Digit */
17962 
17963 	    if (numnum == 0) {
17964 		comnotes_1.nnodur = ic - 48;
17965 		numnum = 1;
17966 		goto L2;
17967 	    } else if (numnum == 1) {
17968 		ioct = ic - 48;
17969 		numnum = 2;
17970 		goto L2;
17971 	    } else {
17972 		s_wsle(&io___732);
17973 		do_lio(&c__9, &c__1, ">2 digits in note sym., ivx,nn:", (
17974 			ftnlen)31);
17975 		do_lio(&c__3, &c__1, (char *)&commvl_1.ivx, (ftnlen)sizeof(
17976 			integer));
17977 		do_lio(&c__3, &c__1, (char *)&all_1.nnl[commvl_1.ivx - 1], (
17978 			ftnlen)sizeof(integer));
17979 		e_wsle();
17980 		stop1_();
17981 	    }
17982 	} else if (*(unsigned char *)durq == 'd') {
17983 	    *(unsigned char *)dotq = *(unsigned char *)durq;
17984 	    i__1 = all_1.iccount;
17985 	    if (s_cmp(lineq + i__1, "d", all_1.iccount + 1 - i__1, (ftnlen)1)
17986 		    == 0) {
17987 
17988 /*  Double dot. */
17989 
17990 		++all_1.iccount;
17991 		all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
17992 			25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[
17993 			commvl_1.ivx - 1] * 24 - 25],3);
17994 	    }
17995 	    i__1 = all_1.iccount;
17996 	    if (i_indx("+-", lineq + i__1, (ftnlen)2, all_1.iccount + 1 -
17997 		    i__1) > 0) {
17998 
17999 /*  move a dot, unless next char is not part of a number */
18000 
18001 		i__1 = all_1.iccount + 1;
18002 		if (i_indx("0123456789.", lineq + i__1, (ftnlen)11,
18003 			all_1.iccount + 2 - i__1) == 0) {
18004 		    goto L2;
18005 		}
18006 		all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
18007 			25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
18008 			commvl_1.ivx - 1] * 24 - 25],19);
18009 		getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
18010 		++comcc_1.ndotmv[commvl_1.ivx - 1];
18011 		++all_1.iccount;
18012 		readnum_(lineq, &all_1.iccount, dumq, &comcc_1.updot[
18013 			commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] * 24
18014 			- 25], (ftnlen)128, (ftnlen)1);
18015 		if (*(unsigned char *)durq == '-') {
18016 		    comcc_1.updot[commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx
18017 			    - 1] * 24 - 25] = -comcc_1.updot[commvl_1.ivx +
18018 			    comcc_1.ndotmv[commvl_1.ivx - 1] * 24 - 25];
18019 		}
18020 		if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
18021 
18022 /*  Vertical shift also */
18023 
18024 		    ++all_1.iccount;
18025 		    readnum_(lineq, &all_1.iccount, durq, &comcc_1.rtdot[
18026 			    commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] *
18027 			    24 - 25], (ftnlen)128, (ftnlen)1);
18028 		    if (*(unsigned char *)dumq == '-') {
18029 			comcc_1.rtdot[commvl_1.ivx + comcc_1.ndotmv[
18030 				commvl_1.ivx - 1] * 24 - 25] = -comcc_1.rtdot[
18031 				commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx -
18032 				1] * 24 - 25];
18033 		    }
18034 		} else {
18035 		    comcc_1.rtdot[commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx
18036 			    - 1] * 24 - 25] = 0.f;
18037 		}
18038 		--all_1.iccount;
18039 	    }
18040 	    goto L2;
18041 	} else if (*(unsigned char *)durq == 'p') {
18042 
18043 /*  Full-bar rest as pause */
18044 
18045 	    all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
18046 		    = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[
18047 		    commvl_1.ivx - 1] * 24 - 25],19);
18048 	    goto L2;
18049 	} else if (*(unsigned char *)durq == 'b') {
18050 
18051 /*  Blank rest */
18052 
18053 	    all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
18054 		    = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[
18055 		    commvl_1.ivx - 1] * 24 - 25],29);
18056 	    goto L2;
18057 	} else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) {
18058 
18059 /*  Accidental */
18060 
18061 	    if (all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
18062 		    25] == 0) {
18063 
18064 /*  No accidental has been set yet */
18065 
18066 		all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
18067 			25] = i_indx("fsn", durq, (ftnlen)3, (ftnlen)1);
18068 	    } else {
18069 
18070 /*  Repeated accid, so must be double */
18071 
18072 		all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
18073 			25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[
18074 			commvl_1.ivx - 1] * 24 - 25],2);
18075 	    }
18076 	    goto L2;
18077 	} else if (*(unsigned char *)durq == 'i') {
18078 
18079 /*  Set flag for MIDI-only accidental. */
18080 
18081 	    all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] =
18082 		     bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx
18083 		    - 1] * 24 - 25],17);
18084 	    goto L2;
18085 	} else if (*(unsigned char *)durq == 'c') {
18086 
18087 /*  Set flags for cautionary accidental */
18088 
18089 	    all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
18090 		    = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
18091 		    commvl_1.ivx - 1] * 24 - 25],31);
18092 	    all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] =
18093 		     bit_set(all_1.iornq[commvl_1.ivx + all_1.nnl[
18094 		    commvl_1.ivx - 1] * 24 - 1],31);
18095 	    goto L2;
18096 	} else if (i_indx("+-<>", durq, (ftnlen)4, (ftnlen)1) > 0) {
18097 	    ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2;
18098 	    if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx
18099 		    - 1] * 24 - 25],0)) {
18100 
18101 /*  A note, not a rest. */
18102 
18103 		chkpm4ac_(lineq, &all_1.iccount, &all_1.nacc[commvl_1.ivx +
18104 			all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &moved, (
18105 			ftnlen)128);
18106 		if (moved) {
18107 		    goto L2;
18108 		}
18109 
18110 /*  Octave jump with a note */
18111 
18112 		if (numnum < 2) {
18113 		    comnotes_1.lastlev += ipm * 7;
18114 		} else {
18115 		    ioct += ipm;
18116 		}
18117 		goto L2;
18118 	    } else {
18119 
18120 /*  Override default height of a rest */
18121 
18122 		++all_1.iccount;
18123 		readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (
18124 			ftnlen)1);
18125 		i__1 = all_1.iccount - 2;
18126 		if (s_cmp(lineq + i__1, ".", all_1.iccount - 1 - i__1, (
18127 			ftnlen)1) == 0) {
18128 
18129 /*  Kluge in case there is a shortcut ".". It will have been sucked up by */
18130 /*  readnum.  (Same doesn't hold for ",") */
18131 
18132 		    all_1.iccount += -2;
18133 		    goto L2;
18134 		}
18135 		all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
18136 			25] = ipm * i_nint(&fnum) + 100;
18137 
18138 /*  There may be more characters for this rest */
18139 
18140 		--all_1.iccount;
18141 		goto L2;
18142 	    }
18143 	} else if (*(unsigned char *)durq == 'x') {
18144 
18145 /*  Xtuplet.  Count number of doubled notes (for unequal xtups) */
18146 
18147 	    if (bit_test(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18148 		     * 24 - 25],18)) {
18149 		ndoub = 1;
18150 	    } else {
18151 		ndoub = 0;
18152 	    }
18153 
18154 /*  Will set all durations to 0 except last one.  Set flag on this note. */
18155 
18156 	    all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
18157 		    = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
18158 		    commvl_1.ivx - 1] * 24 - 25],28);
18159 
18160 /*  Next input will be digit */
18161 
18162 	    ++all_1.iccount;
18163 	    readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
18164 		    1);
18165 	    ntup = i_nint(&fnum);
18166 	    if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) {
18167 
18168 /*  Double xtup note to make an un= xtup. Here xtup number already set but may also */
18169 /*    have this command before. */
18170 
18171 		all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
18172 			25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[
18173 			commvl_1.ivx - 1] * 24 - 25],18);
18174 		if (*(unsigned char *)durq == 'F') {
18175 		    all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
18176 			    24 - 25] = bit_set(all_1.nacc[commvl_1.ivx +
18177 			    all_1.nnl[commvl_1.ivx - 1] * 24 - 25],19);
18178 		}
18179 		ndoub = 1;
18180 		getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
18181 	    } else if (*(unsigned char *)durq == 'd') {
18182 		all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
18183 			25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[
18184 			commvl_1.ivx - 1] * 24 - 25],27);
18185 		getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
18186 	    }
18187 
18188 /*  Only other possibilities here are ' ' or 'n' */
18189 
18190 	    if (*(unsigned char *)durq == 'n') {
18191 
18192 /*  Alter xtup number */
18193 
18194 		i__1 = all_1.iccount;
18195 		if (s_cmp(lineq + i__1, " ", all_1.iccount + 1 - i__1, (
18196 			ftnlen)1) == 0) {
18197 
18198 /*  If the only modifier is 'n', cancel the number */
18199 
18200 		    all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
18201 			    24 - 25] = bit_set(all_1.islur[commvl_1.ivx +
18202 			    all_1.nnl[commvl_1.ivx - 1] * 24 - 25],31);
18203 		} else {
18204 		    numshft = 0;
18205 L30:
18206 		    getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
18207 			    ftnlen)1);
18208 		    if (*(unsigned char *)durq == 'f') {
18209 
18210 /*  Flip up-down-ness */
18211 
18212 			all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18213 				 * 24 - 25] = bit_set(all_1.irest[
18214 				commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
18215 				24 - 25],14);
18216 			goto L30;
18217 		    } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
18218 
18219 /*  Vertical or horiz shift */
18220 
18221 			++numshft;
18222 			iofforn = 1;
18223 			if (*(unsigned char *)durq == '-') {
18224 			    iofforn = -1;
18225 			}
18226 			++all_1.iccount;
18227 			readnum_(lineq, &all_1.iccount, durq, &xofforn, (
18228 				ftnlen)128, (ftnlen)1);
18229 			--all_1.iccount;
18230 			if (numshft == 1) {
18231 
18232 /*  Vertical shift */
18233 
18234 			    iofforn = iofforn * i_nint(&xofforn) + 16;
18235 
18236 /*  Turn on bit 1; set bits 2-6 to iofforn */
18237 
18238 			    all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx
18239 				    - 1] * 24 - 25] |= (iofforn << 2) + 2;
18240 			} else {
18241 
18242 /*  Horizontal shift */
18243 
18244 			    r__1 = xofforn * 10;
18245 			    iofforn = iofforn * i_nint(&r__1) + 16;
18246 			    all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx
18247 				    - 1] * 24 - 25] = bit_set(all_1.irest[
18248 				    commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18249 				     * 24 - 25],7);
18250 			    setbits_(&all_1.irest[commvl_1.ivx + all_1.nnl[
18251 				    commvl_1.ivx - 1] * 24 - 25], &c__5, &
18252 				    c__9, &iofforn);
18253 			}
18254 			goto L30;
18255 		    } else if (*(unsigned char *)durq == 's') {
18256 
18257 /* Slope adjustment for bracket */
18258 
18259 			all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18260 				* 24 - 25] = bit_set(all_1.mult[commvl_1.ivx
18261 				+ all_1.nnl[commvl_1.ivx - 1] * 24 - 25],4);
18262 			getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
18263 				ftnlen)1);
18264 			iofforn = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) -
18265 				2;
18266 			++all_1.iccount;
18267 			readnum_(lineq, &all_1.iccount, durq, &xofforn, (
18268 				ftnlen)128, (ftnlen)1);
18269 			--all_1.iccount;
18270 			r__1 = iofforn * xofforn + 16;
18271 			iofforn = i_nint(&r__1);
18272 			setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[
18273 				commvl_1.ivx - 1] * 24 - 25], &c__5, &c__5, &
18274 				iofforn);
18275 		    } else if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1)
18276 			     > 0) {
18277 
18278 /*  Replacement printed number */
18279 
18280 			readnum_(lineq, &all_1.iccount, durq, &xofforn, (
18281 				ftnlen)128, (ftnlen)1);
18282 			i__1 = i_nint(&xofforn);
18283 			setbits_(&all_1.nacc[commvl_1.ivx + all_1.nnl[
18284 				commvl_1.ivx - 1] * 24 - 25], &c__5, &c__22, &
18285 				i__1);
18286 			--all_1.iccount;
18287 			goto L30;
18288 		    }
18289 		}
18290 	    }
18291 
18292 /*  Set note level of 1st note of xtup, provided not a rest */
18293 
18294 	    if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx
18295 		    - 1] * 24 - 25],0)) {
18296 		if (numnum == 2) {
18297 		    comnotes_1.lastlev = ifnolev_(charq, &ioct, &
18298 			    cominsttrans_1.itransamt[cominsttrans_1.instno[
18299 			    all_1.iv - 1] - 1], (ftnlen)1);
18300 		    all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
18301 			    24 - 25] = comnotes_1.lastlev;
18302 		} else {
18303 		    comnotes_1.lastlev = comnotes_1.lastlev - 3 + (ifnolev_(
18304 			    charq, &c__10, &cominsttrans_1.itransamt[
18305 			    cominsttrans_1.instno[all_1.iv - 1] - 1], (ftnlen)
18306 			    1) - comnotes_1.lastlev + 3) % 7;
18307 		    all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
18308 			    24 - 25] = comnotes_1.lastlev;
18309 		}
18310 	    }
18311 	    for (comnotes_1.npreslur = comnotes_1.npreslur;
18312 		    comnotes_1.npreslur >= 1; --comnotes_1.npreslur) {
18313 
18314 /*  Set note level for preslur on starting note of xtuplet */
18315 
18316 		setbits_(&all_1.isdat2[all_1.nsdat - comnotes_1.npreslur], &
18317 			c__7, &c__19, &comnotes_1.lastlev);
18318 /* L40: */
18319 	    }
18320 	    numnum = 0;
18321 	    all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
18322 		    = 0;
18323 	    i__1 = ntup;
18324 	    for (itup = 2; itup <= i__1; ++itup) {
18325 		if (comget_1.ornrpt) {
18326 		    all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
18327 			    24 - 1] |= all_1.iornq[commvl_1.ivx + (all_1.nnl[
18328 			    commvl_1.ivx - 1] - 1) * 24 - 1] & 10026991;
18329 		    if ((all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
18330 			    1] * 24 - 1] & 32896) > 0) {
18331 
18332 /*  This is a trill (bit 7 or 15) so must dup the parameters */
18333 
18334 			++comtrill_1.ntrill;
18335 			comtrill_1.ivtrill[comtrill_1.ntrill - 1] =
18336 				commvl_1.ivx;
18337 			comtrill_1.iptrill[comtrill_1.ntrill - 1] = all_1.nnl[
18338 				commvl_1.ivx - 1];
18339 			comtrill_1.xnsktr[comtrill_1.ntrill - 1] =
18340 				comtrill_1.xnsktr[comtrill_1.ntrill - 2];
18341 		    }
18342 		}
18343 		++all_1.nnl[commvl_1.ivx - 1];
18344 		if (comget_1.fbon) {
18345 		    all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24
18346 			    - 25] = bit_set(all_1.ipl[commvl_1.ivx +
18347 			    all_1.nnl[commvl_1.ivx - 1] * 24 - 25],30);
18348 		}
18349 L7:
18350 		getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1)
18351 			;
18352 		if (*(unsigned char *)charq == ' ') {
18353 		    goto L7;
18354 		} else if (*(unsigned char *)charq == '%') {
18355 		    all_1.iccount = 128;
18356 		    goto L7;
18357 		} else if (*(unsigned char *)charq == 'o') {
18358 
18359 /*  Ornament in xtuplet.  "o" symbol must come AFTER the affected note */
18360 
18361 		    if (comnotes_1.notcrd) {
18362 			nole = all_1.nolev[commvl_1.ivx + (all_1.nnl[
18363 				commvl_1.ivx - 1] - 1) * 24 - 25];
18364 		    } else {
18365 			nole = 127 & lbit_shift(comtrill_1.icrdat[
18366 				comtrill_1.ncrd - 1], (ftnlen)-12);
18367 		    }
18368 		    i__2 = all_1.nnl[commvl_1.ivx - 1] - 1;
18369 		    getorn_(lineq, &all_1.iccount, &all_1.iornq[commvl_1.ivx
18370 			    + (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 1], &
18371 			    all_1.iornq[commvl_1.ivx - 1], &comget_1.ornrpt, &
18372 			    comgrace_1.noffseg, &i__2, &commvl_1.ivx, &
18373 			    c_false, &comnotes_1.notcrd, &nole, (ftnlen)128);
18374 		    goto L7;
18375 		} else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0)
18376 			{
18377 		    nnlivx = all_1.nnl[commvl_1.ivx - 1] - 1;
18378 		    if (*(unsigned char *)charq == '(' || *(unsigned char *)
18379 			    charq == '{') {
18380 
18381 /*  Detected preslur in xtuplet loop, non-chord note */
18382 
18383 			++nnlivx;
18384 			++comnotes_1.npreslur;
18385 		    }
18386 		    all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set(
18387 			    all_1.islur[commvl_1.ivx + nnlivx * 24 - 25],0);
18388 		    if (*(unsigned char *)charq == 't') {
18389 			all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] =
18390 				bit_set(all_1.islur[commvl_1.ivx + nnlivx *
18391 				24 - 25],1);
18392 		    }
18393 		    if (commvl_1.ivx <= all_1.nv) {
18394 			kv = 1;
18395 		    } else {
18396 			kv = 2;
18397 		    }
18398 		    if (comslur_1.fontslur) {
18399 			sslur_(lineq, &all_1.iccount, &all_1.iv, &kv, &nnlivx,
18400 				 all_1.isdat1, all_1.isdat2, all_1.isdat3, &
18401 				all_1.nsdat, &comnotes_1.notcrd, &all_1.nolev[
18402 				commvl_1.ivx + nnlivx * 24 - 25], charq, (
18403 				ftnlen)128, (ftnlen)1);
18404 		    } else {
18405 			spsslur_(lineq, &all_1.iccount, &all_1.iv, &kv, &
18406 				nnlivx, all_1.isdat1, all_1.isdat2,
18407 				all_1.isdat3, all_1.isdat4, &all_1.nsdat, &
18408 				comnotes_1.notcrd, &all_1.nolev[commvl_1.ivx
18409 				+ nnlivx * 24 - 25], charq, (ftnlen)128, (
18410 				ftnlen)1);
18411 		    }
18412 		    goto L7;
18413 		} else if (*(unsigned char *)charq == 'G') {
18414 
18415 /* Kluge to get grace in xtup at right location */
18416 
18417 		    --all_1.nnl[commvl_1.ivx - 1];
18418 		    getgrace_(&commvl_1.ivx, all_1.nnl, lineq, &all_1.iccount,
18419 			     all_1.islur, all_1.iornq, all_1.ipl,
18420 			    comnotes_1.ndlev, &comnotes_1.lastlev, &all_1.iv,
18421 			    &all_1.nv, (ftnlen)128);
18422 		    ++all_1.nnl[commvl_1.ivx - 1];
18423 		    goto L7;
18424 		} else if (*(unsigned char *)charq == *(unsigned char *)
18425 			all_1.sq) {
18426 		    littex_(all_1.islur, &all_1.nnl[commvl_1.ivx - 1], &
18427 			    commvl_1.ivx, &comas3_1.topmods, lineq, &
18428 			    all_1.iccount, (ftnlen)128);
18429 		    goto L7;
18430 		} else if (i_indx("0123456789#-nx_", charq, (ftnlen)15, (
18431 			ftnlen)1) > 0) {
18432 
18433 /*  Figure.  Must come AFTER the first note of xtup */
18434 
18435 		    ivf = 1;
18436 		    if (commvl_1.ivx > 1) {
18437 			if (comfig_1.ivxfig2 == 0) {
18438 			    comfig_1.ivxfig2 = commvl_1.ivx;
18439 			} else if (commvl_1.ivx != comfig_1.ivxfig2) {
18440 			    s_wsle(&io___746);
18441 			    e_wsle();
18442 			    s_wsle(&io___747);
18443 			    do_lio(&c__9, &c__1, "Figures not allowed in >1 "
18444 				    "voice above first", (ftnlen)43);
18445 			    e_wsle();
18446 			    s_stop("", (ftnlen)0);
18447 			}
18448 			ivf = 2;
18449 		    }
18450 		    nfig1 = comfig_1.nfigs[ivf - 1] + 1;
18451 		    getfig_(&comgrace_1.itoff[ivf + (nfig1 << 1) - 3], charq,
18452 			    lineq, &all_1.iccount, &all_1.isfig[ivf + (
18453 			    all_1.nnl[commvl_1.ivx - 1] - 1 << 1) - 3], &
18454 			    comfig_1.itfig[ivf + (nfig1 << 1) - 3], &
18455 			    all_1.itsofar[commvl_1.ivx - 1], &c__0,
18456 			    comfig_1.figq + (ivf + (nfig1 << 1) - 3) * 10, &
18457 			    comfig_1.ivupfig[ivf + (nfig1 << 1) - 3], &
18458 			    comfig_1.nfigs[ivf - 1], (ftnlen)1, (ftnlen)128, (
18459 			    ftnlen)10);
18460 		    goto L7;
18461 		} else if (*(unsigned char *)charq == 'X') {
18462 /* Computing MAX */
18463 		    i__2 = 1, i__3 = all_1.nnl[commvl_1.ivx - 1] - 1;
18464 		    getx_(lineq, &all_1.iccount, &all_1.irest[commvl_1.ivx +
18465 			    max(i__2,i__3) * 24 - 25], &comnotes_1.shifton, &
18466 			    comask_1.wheadpt, &all_1.iornq[commvl_1.ivx +
18467 			    all_1.nnl[commvl_1.ivx - 1] * 24 - 1], &
18468 			    commvl_1.ivx, &all_1.irest[commvl_1.ivx +
18469 			    all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &
18470 			    all_1.itsofar[commvl_1.ivx - 1], &ntup, &itup, &
18471 			    comnotes_1.nnodur, dotq, &ndoub, (ftnlen)128, (
18472 			    ftnlen)1);
18473 		    goto L7;
18474 		} else if (*(unsigned char *)charq == 'z') {
18475 
18476 /*  Chord note in xtup.  Goes with *prior* note. */
18477 
18478 		    comnotes_1.notcrd = FALSE_;
18479 		    ++comtrill_1.ncrd;
18480 		    all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - 1)
18481 			     * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + (
18482 			    all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25],10);
18483 		    numnum = 0;
18484 /*              icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8)) */
18485 		    comtrill_1.icrdat[comtrill_1.ncrd - 1] = all_1.nnl[
18486 			    commvl_1.ivx - 1] - 1;
18487 		    i__2 = commvl_1.ivx % 16;
18488 		    setbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__4, &
18489 			    c__8, &i__2);
18490 		    if (commvl_1.ivx >= 16) {
18491 			comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
18492 				comtrill_1.icrdat[comtrill_1.ncrd - 1],28);
18493 		    }
18494 		    comtrill_1.icrdorn[comtrill_1.ncrd - 1] = 0;
18495 
18496 /*  Get note name */
18497 
18498 		    getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (
18499 			    ftnlen)1);
18500 
18501 /*  Get optional inputs */
18502 
18503 L34:
18504 		    getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
18505 			    ftnlen)1);
18506 
18507 /*  When chord note is done, will get ' ', making ndx=0, so go past this block */
18508 
18509 		    ndx = i_indx("fsn+-<>12345678reic", durq, (ftnlen)19, (
18510 			    ftnlen)1);
18511 		    if (ndx > 0) {
18512 			if (ndx <= 3) {
18513 			    if (! bit_test(comtrill_1.icrdat[comtrill_1.ncrd
18514 				    - 1],19)) {
18515 				comtrill_1.icrdat[comtrill_1.ncrd - 1] =
18516 					bit_set(comtrill_1.icrdat[
18517 					comtrill_1.ncrd - 1],19);
18518 				comtrill_1.icrdat[comtrill_1.ncrd - 1] |= ndx
18519 					<< 20;
18520 			    } else {
18521 				comtrill_1.icrdat[comtrill_1.ncrd - 1] =
18522 					bit_set(comtrill_1.icrdat[
18523 					comtrill_1.ncrd - 1],22);
18524 			    }
18525 			} else if (ndx == 19) {
18526 
18527 /*  Set flags for cautionary accidental */
18528 
18529 			    comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
18530 				    comtrill_1.icrdat[comtrill_1.ncrd - 1],31)
18531 				    ;
18532 			    all_1.iornq[commvl_1.ivx + (all_1.nnl[
18533 				    commvl_1.ivx - 1] - 1) * 24 - 1] =
18534 				    bit_set(all_1.iornq[commvl_1.ivx + (
18535 				    all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 1]
18536 				    ,31);
18537 			} else if (ndx <= 7) {
18538 
18539 /* +/-/</> Check whether octave or accidental shift */
18540 
18541 			    nactmp = 0;
18542 			    chkpm4ac_(lineq, &all_1.iccount, &nactmp, &moved,
18543 				    (ftnlen)128);
18544 			    if (moved) {
18545 
18546 /*  Transfer accidental shift values */
18547 
18548 				i__2 = igetbits_(&nactmp, &c__6, &c__4);
18549 				setbits_(&comtrill_1.icrdot[comtrill_1.ncrd -
18550 					1], &c__6, &c__14, &i__2);
18551 				i__2 = igetbits_(&nactmp, &c__7, &c__10);
18552 				setbits_(&comtrill_1.icrdot[comtrill_1.ncrd -
18553 					1], &c__7, &c__20, &i__2);
18554 			    } else {
18555 				if (*(unsigned char *)durq == '+') {
18556 				    comnotes_1.lastlev += 7;
18557 				} else if (*(unsigned char *)durq == '-') {
18558 				    comnotes_1.lastlev += -7;
18559 				}
18560 			    }
18561 			} else if (*(unsigned char *)durq == 'e') {
18562 			    comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
18563 				    comtrill_1.icrdat[comtrill_1.ncrd - 1],23)
18564 				    ;
18565 			    all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx
18566 				    - 1] * 24 - 25] = bit_set(all_1.irest[
18567 				    commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18568 				     * 24 - 25],27);
18569 			} else if (*(unsigned char *)durq == 'r') {
18570 			    comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
18571 				    comtrill_1.icrdat[comtrill_1.ncrd - 1],24)
18572 				    ;
18573 			    all_1.irest[commvl_1.ivx + (all_1.nnl[
18574 				    commvl_1.ivx - 1] - 1) * 24 - 25] =
18575 				    bit_set(all_1.irest[commvl_1.ivx + (
18576 				    all_1.nnl[commvl_1.ivx - 1] - 1) * 24 -
18577 				    25],20);
18578 			} else if (*(unsigned char *)durq == 'i') {
18579 
18580 /*  Midi-only accidental */
18581 
18582 			    comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
18583 				    comtrill_1.icrdat[comtrill_1.ncrd - 1],27)
18584 				    ;
18585 			} else {
18586 
18587 /* must be a number, save it in ioct */
18588 
18589 			    numnum = 1;
18590 			    ioct = ndx - 7;
18591 			}
18592 			goto L34;
18593 		    }
18594 		    if (numnum == 1) {
18595 			comnotes_1.lastlev = ifnolev_(charq, &ioct, &
18596 				cominsttrans_1.itransamt[
18597 				cominsttrans_1.instno[all_1.iv - 1] - 1], (
18598 				ftnlen)1);
18599 		    } else {
18600 			comnotes_1.lastlev = comnotes_1.lastlev - 3 + (
18601 				ifnolev_(charq, &c__10, &
18602 				cominsttrans_1.itransamt[
18603 				cominsttrans_1.instno[all_1.iv - 1] - 1], (
18604 				ftnlen)1) - comnotes_1.lastlev + 3) % 7;
18605 		    }
18606 		    comtrill_1.icrdat[comtrill_1.ncrd - 1] |=
18607 			    comnotes_1.lastlev << 12;
18608 		    for (comnotes_1.npreslur = comnotes_1.npreslur;
18609 			    comnotes_1.npreslur >= 1; --comnotes_1.npreslur) {
18610 
18611 /*  Set note level for preslur on chord note in xtup */
18612 
18613 			setbits_(&all_1.isdat2[all_1.nsdat -
18614 				comnotes_1.npreslur], &c__7, &c__19, &
18615 				comnotes_1.lastlev);
18616 
18617 /*  Following lines copied from loop for non-xtup, chord note, preslur */
18618 /*  Initially I assigned the slur(s) to next note, so fix. */
18619 
18620 			all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18621 				 * 24 - 25] = bit_clear(all_1.islur[
18622 				commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
18623 				24 - 25],0);
18624 			all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx -
18625 				1] - 1) * 24 - 25] = bit_set(all_1.islur[
18626 				commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] -
18627 				1) * 24 - 25],0);
18628 			all_1.isdat2[all_1.nsdat - comnotes_1.npreslur] =
18629 				bit_set(all_1.isdat2[all_1.nsdat -
18630 				comnotes_1.npreslur],0);
18631 			i__2 = igetbits_(&all_1.isdat1[all_1.nsdat -
18632 				comnotes_1.npreslur], &c__8, &c__3) - 1;
18633 			setbits_(&all_1.isdat1[all_1.nsdat -
18634 				comnotes_1.npreslur], &c__8, &c__3, &i__2);
18635 /* L41: */
18636 		    }
18637 		    goto L7;
18638 		} else if (*(unsigned char *)charq == '?') {
18639 
18640 /*  Arpeggio */
18641 
18642 		    if (bit_test(all_1.ipl[commvl_1.ivx + (all_1.nnl[
18643 			    commvl_1.ivx - 1] - 1) * 24 - 25],10)) {
18644 
18645 /*  This is a chordal note.  Set a bit in icrdat.  But if *main* (spacing) note */
18646 /*  of chord, will not set icrdat(25), but iornq(27) */
18647 
18648 			comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
18649 				comtrill_1.icrdat[comtrill_1.ncrd - 1],25);
18650 		    } else {
18651 			all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx -
18652 				1] - 1) * 24 - 1] = bit_set(all_1.iornq[
18653 				commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] -
18654 				1) * 24 - 1],27);
18655 		    }
18656 
18657 /*  Check for shift */
18658 
18659 		    getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
18660 			    ftnlen)1);
18661 		    if (*(unsigned char *)durq == ' ') {
18662 			--all_1.iccount;
18663 		    } else {
18664 
18665 /*  durq must be "-" */
18666 
18667 			++all_1.iccount;
18668 			readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)
18669 				128, (ftnlen)1);
18670 			--all_1.iccount;
18671 
18672 /*  record the shift */
18673 
18674 			++comarpshift_1.numarpshift;
18675 			comarpshift_1.ivarpshift[comarpshift_1.numarpshift -
18676 				1] = commvl_1.ivx;
18677 			comarpshift_1.iparpshift[comarpshift_1.numarpshift -
18678 				1] = all_1.nnl[commvl_1.ivx - 1] - 1;
18679 			comarpshift_1.arpshift[comarpshift_1.numarpshift - 1]
18680 				= fnum;
18681 		    }
18682 		    goto L7;
18683 		} else if (*(unsigned char *)charq == 'D') {
18684 		    i__2 = all_1.nnl[commvl_1.ivx - 1] - 1;
18685 		    getdyn_(&commvl_1.ivx, &i__2, &all_1.irest[commvl_1.ivx +
18686 			    (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25], &
18687 			    all_1.iornq[commvl_1.ivx + (all_1.nnl[
18688 			    commvl_1.ivx - 1] - 1) * 24 - 1], lineq, &
18689 			    all_1.iccount, (ftnlen)128);
18690 		    goto L7;
18691 /* +++ */
18692 		} else if (*(unsigned char *)charq == ']') {
18693 
18694 /*  Multiplicity up-down, must have '][ ' */
18695 
18696 		    all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] -
18697 			    1) * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx
18698 			    + (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25],20)
18699 			    ;
18700 		    all_1.iccount += 2;
18701 		    goto L7;
18702 /* c+++ */
18703 		}
18704 
18705 /*  End of loop for xtup options. If here, charq must be a (non-crd) note name. */
18706 /*  or rest */
18707 
18708 		if (*(unsigned char *)charq == 'r') {
18709 
18710 /*  Rest in xtup */
18711 
18712 		    all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
18713 			    24 - 25] = bit_set(all_1.irest[commvl_1.ivx +
18714 			    all_1.nnl[commvl_1.ivx - 1] * 24 - 25],0);
18715 		    i__2 = all_1.iccount;
18716 		    if (i_indx("+-b", lineq + i__2, (ftnlen)3, all_1.iccount
18717 			    + 1 - i__2) > 0) {
18718 			getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
18719 				ftnlen)1);
18720 			if (*(unsigned char *)durq == 'b') {
18721 
18722 /*  Blank rest in middle of xtup */
18723 
18724 			    all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx
18725 				    - 1] * 24 - 25] = bit_set(all_1.islur[
18726 				    commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18727 				     * 24 - 25],29);
18728 			} else {
18729 
18730 /*  Override height of embedded xtup rest */
18731 
18732 			    ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) -
18733 				    2;
18734 			    ++all_1.iccount;
18735 			    readnum_(lineq, &all_1.iccount, durq, &fnum, (
18736 				    ftnlen)128, (ftnlen)1);
18737 			    all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx
18738 				    - 1] * 24 - 25] = ipm * i_nint(&fnum) +
18739 				    100;
18740 			    --all_1.iccount;
18741 			}
18742 		    } else if (commvl_1.ivx <= all_1.nv) {
18743 			all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18744 				 * 24 - 25] = 0;
18745 		    } else {
18746 			all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18747 				 * 24 - 25] = 2;
18748 		    }
18749 		}
18750 		comnotes_1.notcrd = TRUE_;
18751 L8:
18752 		getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
18753 		if (*(unsigned char *)durq != ' ') {
18754 		    if (i_indx("+-<>", durq, (ftnlen)4, (ftnlen)1) > 0) {
18755 
18756 /*  Accidental horizontal shift */
18757 
18758 			chkpm4ac_(lineq, &all_1.iccount, &all_1.nacc[
18759 				commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
18760 				24 - 25], &moved, (ftnlen)128);
18761 			if (! moved) {
18762 			    if (*(unsigned char *)durq == '+') {
18763 				comnotes_1.lastlev += 7;
18764 			    } else if (*(unsigned char *)durq == '-') {
18765 				comnotes_1.lastlev += -7;
18766 			    }
18767 			}
18768 		    } else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0)
18769 			    {
18770 			if (all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx
18771 				- 1] * 24 - 25] == 0) {
18772 
18773 /*  No accid set yet */
18774 
18775 			    all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx
18776 				    - 1] * 24 - 25] = i_indx("fsn", durq, (
18777 				    ftnlen)3, (ftnlen)1);
18778 			} else {
18779 
18780 /*  Symbol must be repeated, so it's a double */
18781 
18782 			    all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx
18783 				    - 1] * 24 - 25] = bit_set(all_1.nacc[
18784 				    commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18785 				     * 24 - 25],2);
18786 			}
18787 		    } else if (*(unsigned char *)durq == 'i') {
18788 
18789 /*  Set flag for midi-only accidental */
18790 
18791 			all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18792 				* 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx
18793 				+ all_1.nnl[commvl_1.ivx - 1] * 24 - 25],17);
18794 		    } else if (*(unsigned char *)durq == 'c') {
18795 
18796 /*  Set flags for cautionary accidental */
18797 
18798 			all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18799 				 * 24 - 25] = bit_set(all_1.irest[
18800 				commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
18801 				24 - 25],31);
18802 			all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18803 				 * 24 - 1] = bit_set(all_1.iornq[commvl_1.ivx
18804 				+ all_1.nnl[commvl_1.ivx - 1] * 24 - 1],31);
18805 		    } else if (i_indx("ul", durq, (ftnlen)2, (ftnlen)1) > 0) {
18806 
18807 /*  Force stem direction for non-beamed xtup note */
18808 
18809 			all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18810 				 * 24 - 25] = bit_set(all_1.islur[
18811 				commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
18812 				24 - 25],30);
18813 			if (*(unsigned char *)durq == 'u') {
18814 			    all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx
18815 				    - 1] * 24 - 25] = bit_set(all_1.islur[
18816 				    commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18817 				     * 24 - 25],17);
18818 			}
18819 		    } else if (*(unsigned char *)durq == 'e') {
18820 
18821 /*  Left-shift main xtup note */
18822 
18823 			all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
18824 				 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx +
18825 				all_1.nnl[commvl_1.ivx - 1] * 24 - 25],8);
18826 			all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18827 				 * 24 - 25] = bit_set(all_1.irest[
18828 				commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
18829 				24 - 25],27);
18830 		    } else if (*(unsigned char *)durq == 'r') {
18831 
18832 /*  Right-shift main xtup note */
18833 
18834 			all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
18835 				 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx +
18836 				all_1.nnl[commvl_1.ivx - 1] * 24 - 25],9);
18837 			all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18838 				 * 24 - 25] = bit_set(all_1.irest[
18839 				commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
18840 				24 - 25],20);
18841 		    } else if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) {
18842 
18843 /*  Double an xtup note to make an unequal xtup */
18844 
18845 			all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18846 				* 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx
18847 				+ all_1.nnl[commvl_1.ivx - 1] * 24 - 25],18);
18848 			if (*(unsigned char *)durq == 'F') {
18849 			    all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx
18850 				    - 1] * 24 - 25] = bit_set(all_1.nacc[
18851 				    commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18852 				     * 24 - 25],19);
18853 			}
18854 			++ndoub;
18855 		    } else if (*(unsigned char *)durq == 'd') {
18856 
18857 /*  Dotted xtup note */
18858 
18859 			all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18860 				* 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx
18861 				+ all_1.nnl[commvl_1.ivx - 1] * 24 - 25],27);
18862 		    } else {
18863 
18864 /*  Must be an octave number */
18865 
18866 			i__2 = *(unsigned char *)durq - 48;
18867 			comnotes_1.lastlev = ifnolev_(charq, &i__2, &
18868 				cominsttrans_1.itransamt[
18869 				cominsttrans_1.instno[all_1.iv - 1] - 1], (
18870 				ftnlen)1);
18871 		    }
18872 		    goto L8;
18873 		}
18874 		if (itup < ntup) {
18875 
18876 /*  Last note is handled *after* flowing out of the xtup if block, but still */
18877 /*    within block for a note-rest.  Set note level now (rest already done). */
18878 /*    Could have problem here if rests & doubled notes are combined in xtup, */
18879 /*    since might exit the loop at the wrong place.  Worry about it later. */
18880 
18881 		    if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[
18882 			    commvl_1.ivx - 1] * 24 - 25],0)) {
18883 			comnotes_1.lastlev = comnotes_1.lastlev - 3 + (
18884 				ifnolev_(charq, &c__10, &
18885 				cominsttrans_1.itransamt[
18886 				cominsttrans_1.instno[all_1.iv - 1] - 1], (
18887 				ftnlen)1) - comnotes_1.lastlev + 3) % 7;
18888 			all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
18889 				 * 24 - 25] = comnotes_1.lastlev;
18890 		    }
18891 		    all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
18892 			    24 - 25] = 0;
18893 		    for (comnotes_1.npreslur = comnotes_1.npreslur;
18894 			    comnotes_1.npreslur >= 1; --comnotes_1.npreslur) {
18895 
18896 /*  Set note level for preslur on internal xtup note */
18897 
18898 			setbits_(&all_1.isdat2[all_1.nsdat -
18899 				comnotes_1.npreslur], &c__7, &c__19, &
18900 				comnotes_1.lastlev);
18901 /* L42: */
18902 		    }
18903 		}
18904 		if (itup == ntup - ndoub) {
18905 		    goto L12;
18906 		}
18907 /* L6: */
18908 	    }
18909 L12:
18910 	    if (comget_1.ornrpt) {
18911 		all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
18912 			1] |= all_1.iornq[commvl_1.ivx + (all_1.nnl[
18913 			commvl_1.ivx - 1] - 1) * 24 - 1] & 10026991;
18914 		if ((all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
18915 			24 - 1] & 32896) > 0) {
18916 
18917 /*  This is a trill (bit 7 or 15) so must dup the parameters */
18918 
18919 		    ++comtrill_1.ntrill;
18920 		    comtrill_1.ivtrill[comtrill_1.ntrill - 1] = commvl_1.ivx;
18921 		    comtrill_1.iptrill[comtrill_1.ntrill - 1] = all_1.nnl[
18922 			    commvl_1.ivx - 1];
18923 		    comtrill_1.xnsktr[comtrill_1.ntrill - 1] =
18924 			    comtrill_1.xnsktr[comtrill_1.ntrill - 2];
18925 		}
18926 	    }
18927 
18928 /*  End of if-block for xtuplet input */
18929 
18930 	} else if (*(unsigned char *)durq == 'm') {
18931 
18932 /*  Multi-bar rest: next 1 or two digits are # of bars. */
18933 /*  For some purposes, pretend its one bar only */
18934 
18935 	    all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
18936 		    = all_1.lenbar;
18937 	    comgrace_1.ibarmbr = all_1.nbars + 1;
18938 	    comgrace_1.mbrest = 0;
18939 	    comgrace_1.xb4mbr = 0.f;
18940 L20:
18941 	    getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
18942 	    if (*(unsigned char *)durq >= 48 && *(unsigned char *)durq <= 57)
18943 		    {
18944 		comgrace_1.mbrest = comgrace_1.mbrest * 10 + *(unsigned char *
18945 			)durq - 48;
18946 		goto L20;
18947 	    }
18948 	} else if (i_indx("ul", durq, (ftnlen)2, (ftnlen)1) > 0) {
18949 
18950 /*  Set stem flipper */
18951 
18952 	    all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
18953 		    = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[
18954 		    commvl_1.ivx - 1] * 24 - 25],30);
18955 	    if (*(unsigned char *)durq == 'u') {
18956 		all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
18957 			25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[
18958 			commvl_1.ivx - 1] * 24 - 25],17);
18959 	    }
18960 	    goto L2;
18961 	} else if (*(unsigned char *)durq == 'a') {
18962 
18963 /*  "Alone", i.e., prohibit beam */
18964 
18965 	    all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
18966 		    = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[
18967 		    commvl_1.ivx - 1] * 24 - 25],18);
18968 	    goto L2;
18969 	} else if (*(unsigned char *)durq == 'r') {
18970 
18971 /*  Right offset by one notehead */
18972 
18973 	    all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] =
18974 		    bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
18975 		    1] * 24 - 25],9);
18976 	    all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
18977 		    = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
18978 		    commvl_1.ivx - 1] * 24 - 25],20);
18979 	    goto L2;
18980 	} else if (*(unsigned char *)durq == 'e') {
18981 
18982 /*  Left offset by one notehead */
18983 
18984 	    all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] =
18985 		    bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
18986 		    1] * 24 - 25],8);
18987 	    all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
18988 		    = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
18989 		    commvl_1.ivx - 1] * 24 - 25],27);
18990 	    goto L2;
18991 	} else if (*(unsigned char *)durq == 'S') {
18992 
18993 /*  Stemlength change.  Get -dstemlen in \internotes.  Allowable values are .5 to 4 */
18994 /*    Set mult(27).  Map value to 0 to 7, store in mult(28-30).  Later convert to */
18995 /*    interbeams = internotes*2/3. */
18996 
18997 	    all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] =
18998 		     bit_set(all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx
18999 		    - 1] * 24 - 25],27);
19000 	    getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
19001 	    if (*(unsigned char *)durq == ':') {
19002 
19003 /*  End stickyS.  Grab data now from prior note, since we have to shut off stickyS. */
19004 
19005 		i__1 = igetbits_(&all_1.mult[commvl_1.ivx + (all_1.nnl[
19006 			commvl_1.ivx - 1] - 1) * 24 - 25], &c__3, &c__28);
19007 		setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
19008 			1] * 24 - 25], &c__3, &c__28, &i__1);
19009 		comget_1.stickys = FALSE_;
19010 		goto L2;
19011 	    }
19012 
19013 /*  If durq .ne. ':' then iccount is now on the start of the number */
19014 
19015 	    readnum_(lineq, &all_1.iccount, durq, &dum, (ftnlen)128, (ftnlen)
19016 		    1);
19017 	    r__1 = (dum - .5f) * 2;
19018 	    i__1 = i_nint(&r__1);
19019 	    setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
19020 		    24 - 25], &c__3, &c__28, &i__1);
19021 	    if (*(unsigned char *)durq == ':') {
19022 		comget_1.stickys = TRUE_;
19023 	    } else {
19024 		--all_1.iccount;
19025 	    }
19026 	    goto L2;
19027 	} else if (*(unsigned char *)durq == ',') {
19028 
19029 /*  2:1 pattern */
19030 
19031 	    idotform = 3;
19032 
19033 /*  Now flow to duration setting, as if durq=' ' */
19034 
19035 	} else if (*(unsigned char *)durq == '.') {
19036 
19037 /*  Dotted pattern.  Close out note.  Mult time by 3/4. */
19038 /*  Set time for next note to 1/4.  Start the note. */
19039 
19040 	    idotform = 1;
19041 	} else if (*(unsigned char *)durq == 'o') {
19042 
19043 /*  Suppress rest centering */
19044 
19045 	    all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
19046 		    = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
19047 		    commvl_1.ivx - 1] * 24 - 25],25);
19048 	    goto L2;
19049 	} else if (*(unsigned char *)durq == 'L') {
19050 
19051 /*  With keyboard rest option, look left */
19052 
19053 	    all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] =
19054 		     bit_set(all_1.iornq[commvl_1.ivx + all_1.nnl[
19055 		    commvl_1.ivx - 1] * 24 - 1],30);
19056 	    goto L2;
19057 	} else if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) {
19058 
19059 /*  Double note for xtup.  Must check here in case "D" came before "x" or on */
19060 /*  last note of xtup.   Need to flag it in pmxa since affects horiz. spacing. */
19061 
19062 	    all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] =
19063 		     bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx
19064 		    - 1] * 24 - 25],18);
19065 	    if (*(unsigned char *)durq == 'F') {
19066 		all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
19067 			25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[
19068 			commvl_1.ivx - 1] * 24 - 25],19);
19069 	    }
19070 	    goto L2;
19071 	} else if (*(unsigned char *)durq == 'A') {
19072 
19073 /*  Accidental option */
19074 
19075 	    getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
19076 
19077 	    if (*(unsigned char *)durq == 'o') {
19078 
19079 /*  Ordered accidentals in a chord.  Mark the main note. */
19080 
19081 		all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
19082 			25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[
19083 			commvl_1.ivx - 1] * 24 - 25],28);
19084 	    } else {
19085 
19086 /*  Only other possibility is +-<> . Set tag, reduce iccount and loop to get #'s */
19087 
19088 		all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
19089 			25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[
19090 			commvl_1.ivx - 1] * 24 - 25],29);
19091 		--all_1.iccount;
19092 	    }
19093 	    goto L2;
19094 	} else if (*(unsigned char *)durq != ' ') {
19095 	    s_wsle(&io___752);
19096 	    do_lio(&c__9, &c__1, "Illegal character in note: ", (ftnlen)27);
19097 	    do_lio(&c__9, &c__1, durq, (ftnlen)1);
19098 	    do_lio(&c__9, &c__1, ", ivx,nn:", (ftnlen)9);
19099 	    do_lio(&c__3, &c__1, (char *)&commvl_1.ivx, (ftnlen)sizeof(
19100 		    integer));
19101 	    do_lio(&c__3, &c__1, (char *)&all_1.nnl[commvl_1.ivx - 1], (
19102 		    ftnlen)sizeof(integer));
19103 	    e_wsle();
19104 	    stop1_();
19105 	}
19106 
19107 /*  Done with note/rest options.  Set level and duration. */
19108 
19109 	if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
19110 		* 24 - 25],0)) {
19111 	    if (numnum == 2) {
19112 		comnotes_1.lastlev = ifnolev_(charq, &ioct, &
19113 			cominsttrans_1.itransamt[cominsttrans_1.instno[
19114 			all_1.iv - 1] - 1], (ftnlen)1);
19115 		all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
19116 			25] = comnotes_1.lastlev;
19117 	    } else {
19118 		comnotes_1.lastlev = comnotes_1.lastlev - 3 + (ifnolev_(charq,
19119 			 &c__10, &cominsttrans_1.itransamt[
19120 			cominsttrans_1.instno[all_1.iv - 1] - 1], (ftnlen)1)
19121 			- comnotes_1.lastlev + 3) % 7;
19122 		all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
19123 			25] = comnotes_1.lastlev;
19124 	    }
19125 	    for (comnotes_1.npreslur = comnotes_1.npreslur;
19126 		    comnotes_1.npreslur >= 1; --comnotes_1.npreslur) {
19127 
19128 /*  Set level for preslur on normal note, non-chord */
19129 
19130 		setbits_(&all_1.isdat2[all_1.nsdat - comnotes_1.npreslur], &
19131 			c__7, &c__19, &comnotes_1.lastlev);
19132 /* L43: */
19133 	    }
19134 	}
19135 	if (idotform > 0) {
19136 	    if (idotform == 1) {
19137 		all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
19138 			25] = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1) *
19139 			3 / 2;
19140 	    } else if (idotform == 2) {
19141 		all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
19142 			25] = all_1.nodur[commvl_1.ivx + (all_1.nnl[
19143 			commvl_1.ivx - 1] - 1) * 24 - 25] / 3;
19144 	    } else if (idotform == 3) {
19145 		all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
19146 			25] = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1);
19147 	    } else if (idotform == 4) {
19148 		all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
19149 			25] = all_1.nodur[commvl_1.ivx + (all_1.nnl[
19150 			commvl_1.ivx - 1] - 1) * 24 - 25] / 2;
19151 	    }
19152 	} else if (bit_test(all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx
19153 		- 1] * 24 - 25],19)) {
19154 
19155 /*  Set duration of full-bar rest as pause */
19156 
19157 	    all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
19158 		    = all_1.lenbar;
19159 
19160 /*  Use a one-line function to set nnodur.  It gives inverse of ifnodur. */
19161 
19162 	    i__1 = (integer) (log(all_1.lenbar + .1f) / .69315f) + 48;
19163 	    chax_(ch__1, (ftnlen)1, &i__1);
19164 	    comnotes_1.nnodur = i_indx("62514x0x37", ch__1, (ftnlen)10, (
19165 		    ftnlen)1) - 1;
19166 	} else if (comgrace_1.ibarmbr != all_1.nbars + 1) {
19167 	    all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
19168 		    = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1);
19169 	    if (bit_test(all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
19170 		    1] * 24 - 25],3)) {
19171 		all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
19172 			25] = all_1.nodur[commvl_1.ivx + all_1.nnl[
19173 			commvl_1.ivx - 1] * 24 - 25] * 7 / 6;
19174 	    }
19175 	}
19176 	if (comnotes_1.shifton && ! bit_test(all_1.irest[commvl_1.ivx +
19177 		all_1.nnl[commvl_1.ivx - 1] * 24 - 25],16)) {
19178 
19179 /*  Shift is on, and this is not first shifted note.  Check for duration change */
19180 
19181 	    if (all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
19182 		    25] != all_1.nodur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx
19183 		    - 1] - 1) * 24 - 25]) {
19184 
19185 /*  Must stop and restart the offset. */
19186 
19187 		all_1.irest[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - 1) *
19188 			 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + (
19189 			all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25],17);
19190 		all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
19191 			25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
19192 			commvl_1.ivx - 1] * 24 - 25],16);
19193 		++comudsp_1.nudoff[commvl_1.ivx - 1];
19194 		comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[commvl_1.ivx
19195 			- 1] * 24 - 25] = comudsp_1.udoff[commvl_1.ivx + (
19196 			comudsp_1.nudoff[commvl_1.ivx - 1] - 1) * 24 - 25];
19197 	    }
19198 	}
19199 	all_1.itsofar[commvl_1.ivx - 1] += all_1.nodur[commvl_1.ivx +
19200 		all_1.nnl[commvl_1.ivx - 1] * 24 - 25];
19201 	if (comfb_1.autofbon && comfb_1.tautofb > comtol_1.tol &&
19202 		comget_1.fbon) {
19203 
19204 /*  Check to see if need to terminate auto forced beam */
19205 
19206 	    r__1 = all_1.itsofar[commvl_1.ivx - 1] - comfb_1.t1autofb;
19207 	    if (r_mod(&r__1, &comfb_1.tautofb) < comtol_1.tol) {
19208 
19209 /*  Terminate autofb */
19210 
19211 		comfb_1.t2fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] *
19212 			24 - 25] = (real) all_1.itsofar[commvl_1.ivx - 1];
19213 		comget_1.fbon = FALSE_;
19214 	    }
19215 	}
19216 	if ((all_1.itsofar[commvl_1.ivx - 1] - all_1.lenb0) % all_1.lenbar ==
19217 		0) {
19218 
19219 /*  Finished a bar */
19220 
19221 	    ++all_1.nbars;
19222 	    all_1.nib[commvl_1.ivx + all_1.nbars * 24 - 25] = all_1.nnl[
19223 		    commvl_1.ivx - 1];
19224 	    if (all_1.firstgulp && all_1.lenb0 != 0 && all_1.nbars == 1) {
19225 
19226 /*  Just finished the pickup bar for this voice. */
19227 
19228 		all_1.lenbar = all_1.lenb1;
19229 	    }
19230 	}
19231 	if (idotform == 1) {
19232 	    getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
19233 	    idotform = 2;
19234 	    numnum = 1;
19235 	    goto L28;
19236 	} else if (idotform == 3) {
19237 	    getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
19238 	    idotform = 4;
19239 	    numnum = 1;
19240 	    goto L28;
19241 	}
19242 
19243 /*  End of sub block for note-rest */
19244 
19245     } else if (*(unsigned char *)charq == 'z') {
19246 
19247 /*  Chord note.  Must have note name, may have octave#,+,-,s,f,n,d */
19248 /*  Actually the 'd' is not used, since time value comes from */
19249 /*    basic note. Unless dot is to be shifted! */
19250 /*  Doesn't increase # of notes, so must handle separately */
19251 /*  ncrd: index of crd */
19252 /*  Set bit 10 of ipl on main note as flag */
19253 /*  Bits in icrdat: */
19254 /*     0-7   ip within voice */
19255 /*     8-11  ivx */
19256 /*     12-18 note level */
19257 /*     19    accidental? */
19258 /*     20-22 accidental value (1=natural, 2=flat, 3=sharp, 6=dflat, 7=dsharp) */
19259 /*     23    shift left */
19260 /*     24    shift right */
19261 /*     25    arpeggio start or stop */
19262 /*     26    flag for moved dot (here, not icrdot, since this is always reset!) */
19263 /*     27    Midi-only accidental */
19264 /*     29    Tag for accidental shift...means add to autoshifts. */
19265 /*     31    Cautionary accidental */
19266 
19267 /*  Bits in icrdot: */
19268 /*     0-6   10*abs(vertical dot shift in \internote) + 64 */
19269 /*     7-13  10*abs(horizontal dot shift in \internote) + 64 */
19270 /*     14-19 vert accidental shift-32 */
19271 /*     20-26 20*(horiz accidental shift+3.2) */
19272 /*     27-29 top-down level rank of chord note w/accid. Set in crdaccs. */
19273 
19274 /*  Bits in icrdorn are same as in iornq, even tho most orns won't go in crds. */
19275 
19276 	++comtrill_1.ncrd;
19277 	all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] =
19278 		bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
19279 		 24 - 25],10);
19280 	numnum = 0;
19281 /*        icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8)) */
19282 	comtrill_1.icrdat[comtrill_1.ncrd - 1] = all_1.nnl[commvl_1.ivx - 1];
19283 	i__1 = commvl_1.ivx % 16;
19284 	setbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__4, &c__8, &i__1)
19285 		;
19286 	if (commvl_1.ivx >= 16) {
19287 	    comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
19288 		    comtrill_1.icrdat[comtrill_1.ncrd - 1],28);
19289 	}
19290 	comtrill_1.icrdot[comtrill_1.ncrd - 1] = 0;
19291 	comtrill_1.icrdorn[comtrill_1.ncrd - 1] = 0;
19292 
19293 /*  Get note name */
19294 
19295 	getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
19296 
19297 /*  Get optional inputs */
19298 
19299 L25:
19300 	getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
19301 /*        ndx = index('fsn+-<>12345678rediA',durq) */
19302 	ndx = i_indx("fsn+-<>12345678rediAc", durq, (ftnlen)21, (ftnlen)1);
19303 	if (ndx == 20) {
19304 
19305 /*  Expect +|-|<|> , set tag, loop */
19306 
19307 	    comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
19308 		    comtrill_1.icrdat[comtrill_1.ncrd - 1],29);
19309 	    goto L25;
19310 	} else if (ndx > 0) {
19311 	    if (ndx <= 3) {
19312 		if (! bit_test(comtrill_1.icrdat[comtrill_1.ncrd - 1],19)) {
19313 		    comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
19314 			    comtrill_1.icrdat[comtrill_1.ncrd - 1],19);
19315 		    comtrill_1.icrdat[comtrill_1.ncrd - 1] |= ndx << 20;
19316 		} else {
19317 		    comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
19318 			    comtrill_1.icrdat[comtrill_1.ncrd - 1],22);
19319 		}
19320 	    } else if (ndx == 21) {
19321 
19322 /*  Set flags for cautionary accidental */
19323 
19324 		comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
19325 			comtrill_1.icrdat[comtrill_1.ncrd - 1],31);
19326 		all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
19327 			1] = bit_set(all_1.iornq[commvl_1.ivx + all_1.nnl[
19328 			commvl_1.ivx - 1] * 24 - 1],31);
19329 	    } else if (ndx <= 7) {
19330 
19331 /* +/-/</> Check whether octave or accidental shift */
19332 
19333 		nactmp = 0;
19334 		chkpm4ac_(lineq, &all_1.iccount, &nactmp, &moved, (ftnlen)128)
19335 			;
19336 		if (moved) {
19337 
19338 /*  Transfer accidental shift values */
19339 
19340 		    i__1 = igetbits_(&nactmp, &c__6, &c__4);
19341 		    setbits_(&comtrill_1.icrdot[comtrill_1.ncrd - 1], &c__6, &
19342 			    c__14, &i__1);
19343 		    i__1 = igetbits_(&nactmp, &c__7, &c__10);
19344 		    setbits_(&comtrill_1.icrdot[comtrill_1.ncrd - 1], &c__7, &
19345 			    c__20, &i__1);
19346 		} else {
19347 		    if (*(unsigned char *)durq == '+') {
19348 			comnotes_1.lastlev += 7;
19349 		    } else if (*(unsigned char *)durq == '-') {
19350 			comnotes_1.lastlev += -7;
19351 		    }
19352 		}
19353 	    } else if (*(unsigned char *)durq == 'e') {
19354 		comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
19355 			comtrill_1.icrdat[comtrill_1.ncrd - 1],23);
19356 		all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
19357 			25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
19358 			commvl_1.ivx - 1] * 24 - 25],27);
19359 	    } else if (*(unsigned char *)durq == 'r') {
19360 		comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
19361 			comtrill_1.icrdat[comtrill_1.ncrd - 1],24);
19362 		all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
19363 			25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
19364 			commvl_1.ivx - 1] * 24 - 25],20);
19365 	    } else if (*(unsigned char *)durq == 'i') {
19366 
19367 /*  Midi-only accidental on chord note */
19368 
19369 		comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
19370 			comtrill_1.icrdat[comtrill_1.ncrd - 1],27);
19371 	    } else if (*(unsigned char *)durq == 'd') {
19372 
19373 /*  Must keep 'd' optional (backward compatibility), unless it is moved! */
19374 
19375 		i__1 = all_1.iccount;
19376 		if (i_indx("+-", lineq + i__1, (ftnlen)2, all_1.iccount + 1 -
19377 			i__1) > 0) {
19378 
19379 /*  move a dot, unless next char is not part of a number */
19380 
19381 		    i__1 = all_1.iccount + 1;
19382 		    if (i_indx("0123456789.", lineq + i__1, (ftnlen)11,
19383 			    all_1.iccount + 2 - i__1) == 0) {
19384 			goto L25;
19385 		    }
19386 		    comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
19387 			    comtrill_1.icrdat[comtrill_1.ncrd - 1],26);
19388 		    getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
19389 			    ftnlen)1);
19390 		    ++all_1.iccount;
19391 		    readnum_(lineq, &all_1.iccount, dumq, &fnum, (ftnlen)128,
19392 			    (ftnlen)1);
19393 		    if (*(unsigned char *)durq == '+') {
19394 			r__1 = fnum * 10;
19395 			comtrill_1.icrdot[comtrill_1.ncrd - 1] |= i_nint(&
19396 				r__1) + 64;
19397 		    } else {
19398 			r__1 = fnum * 10;
19399 			comtrill_1.icrdot[comtrill_1.ncrd - 1] |= -i_nint(&
19400 				r__1) + 64;
19401 		    }
19402 		    if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
19403 
19404 /*  Vertical shift specified also */
19405 
19406 			++all_1.iccount;
19407 			readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)
19408 				128, (ftnlen)1);
19409 			if (*(unsigned char *)dumq == '+') {
19410 			    r__1 = fnum * 10;
19411 			    ifnum = i_nint(&r__1) + 64;
19412 			} else {
19413 			    r__1 = fnum * 10;
19414 			    ifnum = -i_nint(&r__1) + 64;
19415 			}
19416 		    } else {
19417 			ifnum = 64;
19418 		    }
19419 		    comtrill_1.icrdot[comtrill_1.ncrd - 1] |= ifnum << 7;
19420 		    --all_1.iccount;
19421 		}
19422 	    } else {
19423 
19424 /* must be a single digit, save it in ioct */
19425 
19426 		numnum = 1;
19427 		ioct = ndx - 7;
19428 	    }
19429 	    goto L25;
19430 	}
19431 	if (numnum == 1) {
19432 	    comnotes_1.lastlev = ifnolev_(charq, &ioct, &
19433 		    cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv -
19434 		    1] - 1], (ftnlen)1);
19435 	} else {
19436 	    comnotes_1.lastlev = comnotes_1.lastlev - 3 + (ifnolev_(charq, &
19437 		    c__10, &cominsttrans_1.itransamt[cominsttrans_1.instno[
19438 		    all_1.iv - 1] - 1], (ftnlen)1) - comnotes_1.lastlev + 3) %
19439 		     7;
19440 	}
19441 	comtrill_1.icrdat[comtrill_1.ncrd - 1] |= comnotes_1.lastlev << 12;
19442 	for (comnotes_1.npreslur = comnotes_1.npreslur; comnotes_1.npreslur >=
19443 		 1; --comnotes_1.npreslur) {
19444 	    setbits_(&all_1.isdat2[all_1.nsdat - comnotes_1.npreslur], &c__7,
19445 		    &c__19, &comnotes_1.lastlev);
19446 
19447 /*  Set level for chord note. */
19448 /*  Initially I assigned the slur(s) to next note, so fix. */
19449 
19450 	    all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24
19451 		    - 25] = bit_clear(all_1.islur[commvl_1.ivx + (all_1.nnl[
19452 		    commvl_1.ivx - 1] + 1) * 24 - 25],0);
19453 	    all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
19454 		    = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[
19455 		    commvl_1.ivx - 1] * 24 - 25],0);
19456 	    all_1.isdat2[all_1.nsdat - comnotes_1.npreslur] = bit_set(
19457 		    all_1.isdat2[all_1.nsdat - comnotes_1.npreslur],0);
19458 	    i__1 = igetbits_(&all_1.isdat1[all_1.nsdat - comnotes_1.npreslur],
19459 		     &c__8, &c__3) - 1;
19460 	    setbits_(&all_1.isdat1[all_1.nsdat - comnotes_1.npreslur], &c__8,
19461 		    &c__3, &i__1);
19462 /* L44: */
19463 	}
19464 	if (comnotes_1.notcrd) {
19465 
19466 /*  This is the first chord note in this chord. */
19467 
19468 /* Computing MIN */
19469 	    i__1 = all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
19470 		    24 - 25];
19471 	    comtrill_1.minlev = min(i__1,comnotes_1.lastlev);
19472 /* Computing MAX */
19473 	    i__1 = all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
19474 		    24 - 25];
19475 	    comtrill_1.maxlev = max(i__1,comnotes_1.lastlev);
19476 	} else {
19477 	    comtrill_1.minlev = min(comtrill_1.minlev,comnotes_1.lastlev);
19478 	    comtrill_1.maxlev = max(comtrill_1.maxlev,comnotes_1.lastlev);
19479 	}
19480 	comnotes_1.notcrd = FALSE_;
19481     } else if (*(unsigned char *)charq == 'G') {
19482 	getgrace_(&commvl_1.ivx, all_1.nnl, lineq, &all_1.iccount,
19483 		all_1.islur, all_1.iornq, all_1.ipl, comnotes_1.ndlev, &
19484 		comnotes_1.lastlev, &all_1.iv, &all_1.nv, (ftnlen)128);
19485 
19486 /* Grace, comes *before* main note: */
19487 /* UNLESS there's an 'A' or 'W' after the 'G' */
19488 /*   ngrace = # of grace note groups so far in block */
19489 /*   ivg(ngrace), ipg(ngrace) */
19490 /*   nng(ngrace) = # of notes in this group: default = 1 */
19491 /*   ngstrt(ngrace) = starting position in nolevg of levels for this grace */
19492 /*   multg(ngrace) = multiplicity: default = 1;  input as 'm(digit)' */
19493 /*   upg(ngrace) = logical for beam or stem dirn: default T, input'u,l' */
19494 /*   slurg(ngrace) = logical for slur; default F, input 's' */
19495 /*   slashg(ngrace) = T if slash; default is F, input 'x' */
19496 /* These data MUST precede note name of first note */
19497 /*   nolevg, naccg: lists of levels and accid's, indexed as described above. */
19498 
19499 /*        ngrace = ngrace+1 */
19500 /*        ivg(ngrace) = ivx */
19501 /*        ipg(ngrace) = nnl(ivx)+1 */
19502 /*        if (ngrace .eq. 1) then */
19503 /*          ngstrt(ngrace) = 1 */
19504 /*        else */
19505 /*          ngstrt(ngrace) = ngstrt(ngrace-1)+nng(ngrace-1) */
19506 /*        end if */
19507 /*        islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),4) */
19508 /*        nng(ngrace) = 1 */
19509 /*        multg(ngrace) = 1 */
19510 /*        upg(ngrace) = .true. */
19511 /*        slurg(ngrace) = .false. */
19512 /*        slashg(ngrace) = .false. */
19513 /* 18      call getchar(lineq,iccount,charq) */
19514 /*        if (index('WA',charq) .gt. 0) then */
19515 /* c */
19516 /* c  Grace is on note that was already done, so shift flags forward one note. */
19517 /* c  This puts flag on actual note with grace; later for W will go ahead one more. */
19518 /* c */
19519 /*          ipg(ngrace) = nnl(ivx) */
19520 /*          islur(ivx,nnl(ivx)+1) = ibclr(islur(ivx,nnl(ivx)+1),4) */
19521 /*          islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),4) */
19522 /*          if (slurg(ngrace)) */
19523 /*     *        iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),24) */
19524 /*          if (charq .eq. 'A') then */
19525 /* c */
19526 /* c  close After, clear way-after bit, to ensure priority of most recent A/W */
19527 /* c */
19528 /*            ipl(ivx,nnl(ivx)) = ibset(ibclr(ipl(ivx,nnl(ivx)),31),29) */
19529 /*          else */
19530 /* c */
19531 /* c  Way after; later assign to following note, and position like normal grace. */
19532 /* c */
19533 /*            ipl(ivx,nnl(ivx)) = ibset(ibclr(ipl(ivx,nnl(ivx)),29),31) */
19534 /*          end if */
19535 /*        else if (charq .eq. 'm') then */
19536 /*          call getchar(lineq,iccount,charq) */
19537 /*          multg(ngrace) = ichar(charq)-48 */
19538 /*        else if (index('123456789',charq) .gt. 0) then */
19539 /*          call readnum(lineq,iccount,durq,fnum) */
19540 /*          iccount = iccount-1 */
19541 /*          nng(ngrace) = nint(fnum) */
19542 /*        else if (charq .eq. 'l') then */
19543 /*          upg(ngrace) = .false. */
19544 /*        else if (charq .eq. 's') then */
19545 /*          slurg(ngrace) = .true. */
19546 /*          if (nnl(ivx) .gt. 0) then */
19547 /* c */
19548 /* c  If A- or W-grace, set signal to start slur on main note. */
19549 /* c */
19550 /*            if(btest(ipl(ivx,nnl(ivx)),31) .or. */
19551 /*     *                 btest(ipl(ivx,nnl(ivx)),29)) */
19552 /*     *         iornq(ivx,nnl(ivx))=ibset(iornq(ivx,nnl(ivx)),24) */
19553 /*          end if */
19554 /*        else if (charq .eq. 'x') then */
19555 /*          slashg(ngrace) = .true. */
19556 /*        else if (charq .eq. 'u') then */
19557 /*        else if (charq .eq. 'X') then */
19558 /* c */
19559 /* c Space before main note of grace. Number will come next. */
19560 /* c */
19561 /*          iccount = iccount+1 */
19562 /*          call readnum(lineq,iccount,durq,graspace(ngrace)) */
19563 /*          iccount = iccount-1 */
19564 /*        end if */
19565 /*        if (index('abcdefg',charq) .eq. 0) go to 18 */
19566 /* c */
19567 /* c  At this point, charq is first note name in grace */
19568 /* c */
19569 /*        do 19 ing = ngstrt(ngrace), ngstrt(ngrace)+nng(ngrace)-1 */
19570 /*          naccg(ing) = 0 */
19571 /*          ioct = 0 */
19572 /*          if (ing .gt. ngstrt(ngrace)) then */
19573 /* 55          call getchar(lineq,iccount,charq) */
19574 /*            if (charq .eq. ' ') go to 55 */
19575 /*          endif */
19576 /*          iclastlev = 0 */
19577 /* 9         call getchar(lineq,iccount,durq) */
19578 /*          if (durq .ne. ' ') then */
19579 /*            if (durq.eq.'+') then */
19580 /*              lastlev = lastlev+7 */
19581 /*              iclastlev = iclastlev+7 */
19582 /*            else if (durq.eq.'-') then */
19583 /*              lastlev = lastlev-7 */
19584 /*              iclastlev = iclastlev-7 */
19585 /*            else if (index('fsn',durq) .gt. 0) then */
19586 /*              if (naccg(ing) .eq. 0) then */
19587 /*                naccg(ing) = index('fsn',durq) */
19588 /*              else */
19589 /* c */
19590 /* c  Double accidental */
19591 /* c */
19592 /*                naccg(ing) = ibset(naccg(ing),2) */
19593 /*              end if */
19594 /*            else */
19595 /*              ioct = ichar(durq)-48 */
19596 /*            end if */
19597 /*            go to 9 */
19598 /*          end if */
19599 /*          if (ioct .gt. 0) then */
19600 /*            lastlev = ifnolev(charq,ioct) */
19601 /*          else */
19602 /*            if (nnl(ivx).eq.0 .and. ing.eq.ngstrt(ngrace)) then */
19603 /*              if (ivx .le. nv) then */
19604 /*                kv = 1 */
19605 /*              else */
19606 /*                kv = 2 */
19607 /*              end if */
19608 /*              lastlev = ndlev(iv,kv)+iclastlev */
19609 /*            end if */
19610 /*            lastlev = lastlev-3+mod(ifnolev(charq,10)-lastlev+3,7) */
19611 /*          end if */
19612 /*          nolevg(ing) = lastlev */
19613 /* 19      continue */
19614 /* c */
19615 /* c  Grace could come before first note of block, so reset end level. */
19616 /* c */
19617 /*        if (nnl(ivx).eq.0) then */
19618 /*          if (ivx .le. nv) then */
19619 /*            kv = 1 */
19620 /*          else */
19621 /*            kv = 2 */
19622 /*          end if */
19623 /*          ndlev(iv,kv) = lastlev */
19624 /*        end if */
19625     } else if (*(unsigned char *)charq == *(unsigned char *)all_1.sq) {
19626 
19627 /*  Literal TeX string */
19628 
19629 	i__1 = all_1.nnl[commvl_1.ivx - 1] + 1;
19630 	littex_(all_1.islur, &i__1, &commvl_1.ivx, &comas3_1.topmods, lineq, &
19631 		all_1.iccount, (ftnlen)128);
19632     } else if (*(unsigned char *)charq == 'o') {
19633 
19634 /*  Ornament on non-xtup note.  Symbol must come AFTER the affected note */
19635 
19636 	if (comnotes_1.notcrd) {
19637 	    nole = all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
19638 		    24 - 25];
19639 	} else {
19640 	    nole = 127 & lbit_shift(comtrill_1.icrdat[comtrill_1.ncrd - 1], (
19641 		    ftnlen)-12);
19642 	}
19643 	getorn_(lineq, &all_1.iccount, &all_1.iornq[commvl_1.ivx + all_1.nnl[
19644 		commvl_1.ivx - 1] * 24 - 1], &all_1.iornq[commvl_1.ivx - 1], &
19645 		comget_1.ornrpt, &comgrace_1.noffseg, &all_1.nnl[commvl_1.ivx
19646 		- 1], &commvl_1.ivx, &c_true, &comnotes_1.notcrd, &nole, (
19647 		ftnlen)128);
19648     } else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0) {
19649 	nnlivx = all_1.nnl[commvl_1.ivx - 1];
19650 	if (*(unsigned char *)charq == '(' || *(unsigned char *)charq == '{')
19651 		{
19652 
19653 /* Detect preslur on normal non-chord note */
19654 
19655 	    ++nnlivx;
19656 	    ++comnotes_1.npreslur;
19657 	}
19658 	all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set(all_1.islur[
19659 		commvl_1.ivx + nnlivx * 24 - 25],0);
19660 	if (*(unsigned char *)charq == 't') {
19661 	    all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set(
19662 		    all_1.islur[commvl_1.ivx + nnlivx * 24 - 25],1);
19663 	}
19664 	if (commvl_1.ivx <= all_1.nv) {
19665 	    kv = 1;
19666 	} else {
19667 	    kv = 2;
19668 	}
19669 	if (comslur_1.fontslur) {
19670 	    sslur_(lineq, &all_1.iccount, &all_1.iv, &kv, &nnlivx,
19671 		    all_1.isdat1, all_1.isdat2, all_1.isdat3, &all_1.nsdat, &
19672 		    comnotes_1.notcrd, &all_1.nolev[commvl_1.ivx + nnlivx *
19673 		    24 - 25], charq, (ftnlen)128, (ftnlen)1);
19674 	} else {
19675 	    spsslur_(lineq, &all_1.iccount, &all_1.iv, &kv, &nnlivx,
19676 		    all_1.isdat1, all_1.isdat2, all_1.isdat3, all_1.isdat4, &
19677 		    all_1.nsdat, &comnotes_1.notcrd, &all_1.nolev[
19678 		    commvl_1.ivx + nnlivx * 24 - 25], charq, (ftnlen)128, (
19679 		    ftnlen)1);
19680 	}
19681     } else if (*(unsigned char *)charq == '?') {
19682 
19683 /*  Arpeggio */
19684 
19685 	if (bit_test(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
19686 		24 - 25],10)) {
19687 
19688 /*  This is a chordal note.  Set a bit in icrdat.  But if *main* (spacing) note */
19689 /*  of chord, will not set icrdat(25), but iornq(27) */
19690 
19691 	    comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
19692 		    comtrill_1.icrdat[comtrill_1.ncrd - 1],25);
19693 	} else {
19694 	    all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] =
19695 		     bit_set(all_1.iornq[commvl_1.ivx + all_1.nnl[
19696 		    commvl_1.ivx - 1] * 24 - 1],27);
19697 	}
19698 
19699 /*  Check for shift */
19700 
19701 	getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
19702 	if (*(unsigned char *)durq == ' ') {
19703 	    --all_1.iccount;
19704 	} else {
19705 
19706 /*  durq must be "-" */
19707 
19708 	    ++all_1.iccount;
19709 	    readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
19710 		    1);
19711 	    --all_1.iccount;
19712 
19713 /*  record the shift */
19714 
19715 	    ++comarpshift_1.numarpshift;
19716 	    comarpshift_1.ivarpshift[comarpshift_1.numarpshift - 1] =
19717 		    commvl_1.ivx;
19718 	    comarpshift_1.iparpshift[comarpshift_1.numarpshift - 1] =
19719 		    all_1.nnl[commvl_1.ivx - 1];
19720 	    comarpshift_1.arpshift[comarpshift_1.numarpshift - 1] = fnum;
19721 	}
19722     } else if (i_indx("0123456789#-nx_", charq, (ftnlen)15, (ftnlen)1) > 0) {
19723 
19724 /*  We have a figure.  Must come AFTER the note it goes under */
19725 
19726 	ivf = 1;
19727 	if (commvl_1.ivx > 1) {
19728 	    if (comfig_1.ivxfig2 == 0) {
19729 		comfig_1.ivxfig2 = commvl_1.ivx;
19730 	    } else if (commvl_1.ivx != comfig_1.ivxfig2) {
19731 		s_wsle(&io___754);
19732 		e_wsle();
19733 		s_wsle(&io___755);
19734 		do_lio(&c__9, &c__1, "Figures not allowed in >1 voice above "
19735 			"first", (ftnlen)43);
19736 		e_wsle();
19737 		s_stop("", (ftnlen)0);
19738 	    }
19739 	    ivf = 2;
19740 	}
19741 	nfig1 = comfig_1.nfigs[ivf - 1] + 1;
19742 	getfig_(&comgrace_1.itoff[ivf + (nfig1 << 1) - 3], charq, lineq, &
19743 		all_1.iccount, &all_1.isfig[ivf + (all_1.nnl[commvl_1.ivx - 1]
19744 		 << 1) - 3], &comfig_1.itfig[ivf + (nfig1 << 1) - 3], &
19745 		all_1.itsofar[commvl_1.ivx - 1], &all_1.nodur[commvl_1.ivx +
19746 		all_1.nnl[commvl_1.ivx - 1] * 24 - 25], comfig_1.figq + (ivf
19747 		+ (nfig1 << 1) - 3) * 10, &comfig_1.ivupfig[ivf + (nfig1 << 1)
19748 		 - 3], &comfig_1.nfigs[ivf - 1], (ftnlen)1, (ftnlen)128, (
19749 		ftnlen)10);
19750     } else if (*(unsigned char *)charq == '[') {
19751 
19752 /*  Start forced beam.  Record barno & time since start of inp. blk.  Set signal */
19753 
19754 	++comfb_1.nfb[commvl_1.ivx - 1];
19755 	comget_1.fbon = TRUE_;
19756 	*(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[
19757 		commvl_1.ivx - 1] * 24 - 25] = 'x';
19758 	comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 - 25] =
19759 		 (real) all_1.itsofar[commvl_1.ivx - 1];
19760 	nadj = 0;
19761 	if (comfb_1.autofbon) {
19762 	    comfb_1.autofbon = FALSE_;
19763 	}
19764 L17:
19765 	getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
19766 	if (i_indx("ulf", charq, (ftnlen)3, (ftnlen)1) > 0) {
19767 	    *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[
19768 		    commvl_1.ivx - 1] * 24 - 25] = *(unsigned char *)charq;
19769 	    goto L17;
19770 	} else if (*(unsigned char *)charq == 'j') {
19771 
19772 /*  Continuing a jumped beam here */
19773 
19774 	    all_1.irest[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24
19775 		    - 25] = bit_set(all_1.irest[commvl_1.ivx + (all_1.nnl[
19776 		    commvl_1.ivx - 1] + 1) * 24 - 25],24);
19777 
19778 /*  Set flag to watch for END of this forced beam, so can set flag rest(30) on */
19779 /*  NEXT note as signal to start a new notes group there. */
19780 
19781 	    combjmp_1.isbj2 = TRUE_;
19782 	    goto L17;
19783 	} else if (*(unsigned char *)charq == 'h') {
19784 	    all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24
19785 		    - 25] = bit_set(all_1.islur[commvl_1.ivx + (all_1.nnl[
19786 		    commvl_1.ivx - 1] + 1) * 24 - 25],2);
19787 	    goto L17;
19788 	} else if (*(unsigned char *)charq == 'm') {
19789 
19790 /*  Force multiplicity.  Next input is digit */
19791 
19792 	    getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
19793 	    all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24
19794 		    - 25] = bit_set(all_1.islur[commvl_1.ivx + (all_1.nnl[
19795 		    commvl_1.ivx - 1] + 1) * 24 - 25],21);
19796 	    i__1 = *(unsigned char *)charq - 48;
19797 	    setbits_(&all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1]
19798 		    + 1) * 24 - 25], &c__3, &c__22, &i__1);
19799 	    goto L17;
19800 	} else if (*(unsigned char *)charq == ':') {
19801 
19802 /*  Start auto forced beam pattern */
19803 
19804 	    comfb_1.autofbon = TRUE_;
19805 
19806 /*  When forced later beam ends, check whether tautofv <=0; if so set it. */
19807 
19808 	    comfb_1.tautofb = (real) (-all_1.itsofar[commvl_1.ivx - 1]);
19809 	    comfb_1.t1autofb = (real) all_1.itsofar[commvl_1.ivx - 1];
19810 	    goto L17;
19811 	} else if (*(unsigned char *)charq != ' ') {
19812 
19813 /*  Must be '+/-' for height or slope shift */
19814 
19815 	    ++nadj;
19816 
19817 /*  nadj = 1,2, or 3 for normal start level, slope, or beam-thk start level. */
19818 
19819 	    ++all_1.iccount;
19820 	    readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
19821 		    1);
19822 	    --all_1.iccount;
19823 	    iadj = i_nint(&fnum);
19824 	    if (*(unsigned char *)charq == '-') {
19825 		iadj = -iadj;
19826 	    }
19827 	    if (nadj == 1) {
19828 
19829 /*  This is a level shift.  Note if 0 was entered, iadj = 30 */
19830 
19831 		i__1 = iadj + 30;
19832 		setbits_(&all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx -
19833 			1] + 1) * 24 - 25], &c__6, &c__11, &i__1);
19834 	    } else if (nadj == 2) {
19835 
19836 /*  Must be a slope shift */
19837 
19838 		i__1 = iadj + 30;
19839 		setbits_(&all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx -
19840 			1] + 1) * 24 - 25], &c__6, &c__17, &i__1);
19841 	    } else {
19842 
19843 /*  Beam-thk fine tune */
19844 
19845 		setbits_(&all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx
19846 			- 1] + 1) * 24 - 25], &c__2, &c__27, &iadj);
19847 	    }
19848 	    goto L17;
19849 	}
19850     } else if (*(unsigned char *)charq == ']') {
19851 	if (comfb_1.autofbon && comfb_1.tautofb < comtol_1.tol) {
19852 	    comfb_1.tautofb = all_1.itsofar[commvl_1.ivx - 1] +
19853 		    comfb_1.tautofb;
19854 	}
19855 	getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
19856 	if (i_indx("j ", charq, (ftnlen)2, (ftnlen)1) > 0) {
19857 
19858 /*  Since ']' comes AFTER note, itsofar has been updated.  Set ending signal. */
19859 
19860 	    comfb_1.t2fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 -
19861 		    25] = (real) all_1.itsofar[commvl_1.ivx - 1];
19862 	    comget_1.fbon = FALSE_;
19863 	    if (*(unsigned char *)charq == 'j') {
19864 		all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
19865 			25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
19866 			commvl_1.ivx - 1] * 24 - 25],23);
19867 	    }
19868 	    if (combjmp_1.isbj2) {
19869 
19870 /*  This is the end of a fb segment of a jump beam.  Set flag on NEXT note to */
19871 /*  force start of new notes group, provided this is not last note in bar. */
19872 
19873 		if (all_1.itsofar[commvl_1.ivx - 1] % all_1.lenbar != 0) {
19874 		    all_1.irest[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] +
19875 			    1) * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx
19876 			    + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],30)
19877 			    ;
19878 		}
19879 		combjmp_1.isbj2 = FALSE_;
19880 	    }
19881 	} else if (*(unsigned char *)charq == '[') {
19882 
19883 /*  Multiplicity down-up signal */
19884 
19885 	    all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
19886 		    = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[
19887 		    commvl_1.ivx - 1] * 24 - 25],20);
19888 	} else if (*(unsigned char *)charq == '-') {
19889 
19890 /*  Set signals for gap in single-slope beam [...]-[...] */
19891 
19892 	    all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] =
19893 		     bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx
19894 		    - 1] * 24 - 25],20);
19895 	    all_1.nacc[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24
19896 		    - 25] = bit_set(all_1.nacc[commvl_1.ivx + (all_1.nnl[
19897 		    commvl_1.ivx - 1] + 1) * 24 - 25],21);
19898 
19899 /*  Next two characters must be "[ ".  Skip over them. */
19900 
19901 	    all_1.iccount += 2;
19902 	}
19903     } else if (*(unsigned char *)charq == 'D') {
19904 	getdyn_(&commvl_1.ivx, &all_1.nnl[commvl_1.ivx - 1], &all_1.irest[
19905 		commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &
19906 		all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
19907 		1], lineq, &all_1.iccount, (ftnlen)128);
19908     } else if (*(unsigned char *)charq == 'h') {
19909 
19910 /*  Heading or height.  For heading, only OK if at start of block */
19911 /*  Check whether at beginning of a block */
19912 
19913 	if (all_1.iv != 1 || all_1.nnl[0] != 0) {
19914 	    s_wsle(&io___758);
19915 	    do_lio(&c__9, &c__1, "You entered \"h\" not at beginning of block"
19916 		    , (ftnlen)41);
19917 	    e_wsle();
19918 	    stop1_();
19919 	}
19920 	getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
19921 	comhead_1.ihdvrt = 0;
19922 	if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
19923 
19924 /* Vertical offset */
19925 
19926 	    ++all_1.iccount;
19927 	    readnum_(lineq, &all_1.iccount, charq, &fnum, (ftnlen)128, (
19928 		    ftnlen)1);
19929 	    comhead_1.ihdvrt = fnum + .1f;
19930 	    if (*(unsigned char *)durq == '-') {
19931 		comhead_1.ihdvrt = -comhead_1.ihdvrt;
19932 	    }
19933 	    *(unsigned char *)durq = *(unsigned char *)charq;
19934 	}
19935 	if (*(unsigned char *)durq != ' ') {
19936 
19937 /*  Height symbol.  Read past (until next blank) */
19938 
19939 L3:
19940 	    getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
19941 	    if (*(unsigned char *)durq != ' ') {
19942 		goto L3;
19943 	    }
19944 	} else {
19945 
19946 /*  Set flag for header & read it in */
19947 
19948 	    comhead_1.ihdht = 16;
19949 	    getbuf_(comhead_1.headrq, (ftnlen)80);
19950 	    all_1.iccount = 128;
19951 	}
19952     } else if (*(unsigned char *)charq == 'L') {
19953 
19954 /*  Linebreak, already handled in pmxa, but check for movement break */
19955 
19956 	++all_1.iccount;
19957 	readnum_(lineq, &all_1.iccount, durq, &fmovbrk, (ftnlen)128, (ftnlen)
19958 		1);
19959 	if (*(unsigned char *)durq == 'P') {
19960 	    ++all_1.iccount;
19961 	    readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
19962 		    1);
19963 	}
19964 	if (*(unsigned char *)durq == 'M') {
19965 	    comget_1.movbrk = i_nint(&fmovbrk);
19966 	    comget_1.movgap = 0;
19967 	    comget_1.parmov = -1.f;
19968 	    getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
19969 L31:
19970 	    if (*(unsigned char *)durq == '+') {
19971 
19972 /*  Get vertical space (\internotes) */
19973 
19974 		++all_1.iccount;
19975 		readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (
19976 			ftnlen)1);
19977 		comget_1.movgap = i_nint(&fnum);
19978 		goto L31;
19979 	    } else if (*(unsigned char *)durq == 'i') {
19980 		++all_1.iccount;
19981 		readnum_(lineq, &all_1.iccount, durq, &comget_1.parmov, (
19982 			ftnlen)128, (ftnlen)1);
19983 		goto L31;
19984 	    } else if (*(unsigned char *)durq == 'c') {
19985 		comnotes_1.nobar1 = TRUE_;
19986 		getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
19987 		goto L31;
19988 	    } else if (*(unsigned char *)durq == 'r') {
19989 
19990 /*  "rename" can be set on or off. */
19991 
19992 		getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
19993 		comnvi_1.rename = *(unsigned char *)durq == '+';
19994 		getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
19995 		goto L31;
19996 	    } else if (*(unsigned char *)durq == 'n') {
19997 
19998 /*  Change # of voices.  Input ninow, iiorig(1...ninow).  Will use names, */
19999 /*  staves per inst. and clefs  corr. to iiorig in original list of instruments. */
20000 
20001 		nvold = all_1.nv;
20002 		all_1.nv = 0;
20003 		comnvi_1.rename = TRUE_;
20004 		getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
20005 		if (*(unsigned char *)durq == ':') {
20006 		    all_1.iccount += 2;
20007 		    i__1 = all_1.iccount - 2;
20008 		    ici__1.icierr = 0;
20009 		    ici__1.iciend = 0;
20010 		    ici__1.icirnum = 1;
20011 		    ici__1.icirlen = all_1.iccount - i__1;
20012 		    ici__1.iciunit = lineq + i__1;
20013 		    ici__1.icifmt = "(i2)";
20014 		    s_rsfi(&ici__1);
20015 		    do_fio(&c__1, (char *)&comnotes_1.ninow, (ftnlen)sizeof(
20016 			    integer));
20017 		    e_rsfi();
20018 		} else {
20019 		    comnotes_1.ninow = *(unsigned char *)durq - 48;
20020 		}
20021 		iiv = 0;
20022 		i__1 = comnotes_1.ninow;
20023 		for (iinow = 1; iinow <= i__1; ++iinow) {
20024 		    getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
20025 			    ftnlen)1);
20026 		    if (*(unsigned char *)durq == ':') {
20027 			all_1.iccount += 2;
20028 			i__2 = all_1.iccount - 2;
20029 			ici__1.icierr = 0;
20030 			ici__1.iciend = 0;
20031 			ici__1.icirnum = 1;
20032 			ici__1.icirlen = all_1.iccount - i__2;
20033 			ici__1.iciunit = lineq + i__2;
20034 			ici__1.icifmt = "(i2)";
20035 			s_rsfi(&ici__1);
20036 			do_fio(&c__1, (char *)&comnvi_1.iiorig[iinow - 1], (
20037 				ftnlen)sizeof(integer));
20038 			e_rsfi();
20039 		    } else {
20040 			comnvi_1.iiorig[iinow - 1] = *(unsigned char *)durq -
20041 				48;
20042 		    }
20043 		    comnvi_1.nspern[iinow - 1] = comnvi_1.nsperi[
20044 			    comnvi_1.iiorig[iinow - 1] - 1];
20045 		    all_1.nv += comnvi_1.nspern[iinow - 1];
20046 		    *(unsigned char *)&all_1.sepsymq[iiv + comnvi_1.nspern[
20047 			    iinow - 1] - 1] = '&';
20048 		    if (comnvi_1.nspern[iinow - 1] > 1) {
20049 			i__2 = comnvi_1.nspern[iinow - 1] - 1;
20050 			for (iis = 1; iis <= i__2; ++iis) {
20051 			    *(unsigned char *)&all_1.sepsymq[iiv + iis - 1] =
20052 				    '|';
20053 /* L64: */
20054 			}
20055 		    }
20056 		    iiv += comnvi_1.nspern[iinow - 1];
20057 /* L63: */
20058 		}
20059 
20060 /* 120818 Per Rainer's suggestion, defer changing \nbinstruments until issuing \newmovement */
20061 
20062 /*            if (islast) then */
20063 /*              if (ninow .lt. 10) then */
20064 /*                write(11,'(a)')sq//'newnoi{'//chax(ninow+48)//'}%' */
20065 /*              else */
20066 /*                write(11,'(a8,i2,a2)')sq//'newnoi{',ninow,'}%' */
20067 /*              end if */
20068 /*            end if */
20069 		if (all_1.nv == 1 && nvold > 1) {
20070 		    if (comlast_1.islast) {
20071 			s_wsfe(&io___764);
20072 /* Writing concatenation */
20073 			i__4[0] = 1, a__1[0] = all_1.sq;
20074 			i__4[1] = 11, a__1[1] = "nostartrule";
20075 			s_cat(ch__2, a__1, i__4, &c__2, (ftnlen)12);
20076 			do_fio(&c__1, ch__2, (ftnlen)12);
20077 			e_wsfe();
20078 		    }
20079 		} else if (all_1.nv > 1 && nvold == 1) {
20080 		    if (comlast_1.islast) {
20081 			s_wsfe(&io___765);
20082 /* Writing concatenation */
20083 			i__4[0] = 1, a__1[0] = all_1.sq;
20084 			i__4[1] = 9, a__1[1] = "startrule";
20085 			s_cat(ch__3, a__1, i__4, &c__2, (ftnlen)10);
20086 			do_fio(&c__1, ch__3, (ftnlen)10);
20087 			e_wsfe();
20088 		    }
20089 		}
20090 		iiv = 0;
20091 		i__1 = comnotes_1.ninow;
20092 		for (iinow = 1; iinow <= i__1; ++iinow) {
20093 		    i__2 = comnvi_1.nspern[iinow - 1];
20094 		    for (iis = 1; iis <= i__2; ++iis) {
20095 			++iiv;
20096 
20097 /*  May not really need to re-enter clefs, but it's easier to program since */
20098 /*  clef names are not saved but are needed in newvoice to set ncmidcc. */
20099 
20100 			getchar_(lineq, &all_1.iccount, comclefq_1.clefq + (
20101 				iiv - 1), (ftnlen)128, (ftnlen)1);
20102 			newvoice_(&iiv, comclefq_1.clefq + (iiv - 1), &c_true,
20103 				 (ftnlen)1);
20104 			if (comnvi_1.nspern[iinow - 1] == 1) {
20105 			    i__3 = numclef_(comclefq_1.clefq + (iiv - 1), (
20106 				    ftnlen)1) + 48;
20107 			    chax_(ch__1, (ftnlen)1, &i__3);
20108 			    s_copy(hdlndq, ch__1, (ftnlen)59, (ftnlen)1);
20109 			    lclf = 1;
20110 			} else if (iis == 1) {
20111 /* Writing concatenation */
20112 			    i__4[0] = 1, a__1[0] = "{";
20113 			    i__3 = numclef_(comclefq_1.clefq + (iiv - 1), (
20114 				    ftnlen)1) + 48;
20115 			    chax_(ch__1, (ftnlen)1, &i__3);
20116 			    i__4[1] = 1, a__1[1] = ch__1;
20117 			    s_cat(hdlndq, a__1, i__4, &c__2, (ftnlen)59);
20118 			    lclf = 2;
20119 			} else if (iis < comnvi_1.nspern[iinow - 1]) {
20120 /* Writing concatenation */
20121 			    i__4[0] = lclf, a__1[0] = hdlndq;
20122 			    i__3 = numclef_(comclefq_1.clefq + (iiv - 1), (
20123 				    ftnlen)1) + 48;
20124 			    chax_(ch__1, (ftnlen)1, &i__3);
20125 			    i__4[1] = 1, a__1[1] = ch__1;
20126 			    s_cat(hdlndq, a__1, i__4, &c__2, (ftnlen)59);
20127 			    ++lclf;
20128 			} else {
20129 /* Writing concatenation */
20130 			    i__5[0] = lclf, a__2[0] = hdlndq;
20131 			    i__3 = numclef_(comclefq_1.clefq + (iiv - 1), (
20132 				    ftnlen)1) + 48;
20133 			    chax_(ch__1, (ftnlen)1, &i__3);
20134 			    i__5[1] = 1, a__2[1] = ch__1;
20135 			    i__5[2] = 1, a__2[2] = "}";
20136 			    s_cat(hdlndq, a__2, i__5, &c__3, (ftnlen)59);
20137 			    lclf += 2;
20138 			}
20139 /* L61: */
20140 		    }
20141 
20142 /*  setstaffs & setclef go by instrument, not voice */
20143 
20144 		    if (comlast_1.islast) {
20145 			if (iinow < 10) {
20146 			    s_wsfe(&io___768);
20147 /* Writing concatenation */
20148 			    i__6[0] = 1, a__3[0] = all_1.sq;
20149 			    i__6[1] = 9, a__3[1] = "setstaffs";
20150 			    i__2 = iinow + 48;
20151 			    chax_(ch__1, (ftnlen)1, &i__2);
20152 			    i__6[2] = 1, a__3[2] = ch__1;
20153 			    i__3 = comnvi_1.nspern[iinow - 1] + 48;
20154 			    chax_(ch__5, (ftnlen)1, &i__3);
20155 			    i__6[3] = 1, a__3[3] = ch__5;
20156 			    i__6[4] = 1, a__3[4] = "%";
20157 			    s_cat(ch__4, a__3, i__6, &c__5, (ftnlen)13);
20158 			    do_fio(&c__1, ch__4, (ftnlen)13);
20159 			    e_wsfe();
20160 			    s_wsfe(&io___769);
20161 /* Writing concatenation */
20162 			    i__6[0] = 1, a__3[0] = all_1.sq;
20163 			    i__6[1] = 7, a__3[1] = "setclef";
20164 			    i__2 = iinow + 48;
20165 			    chax_(ch__1, (ftnlen)1, &i__2);
20166 			    i__6[2] = 1, a__3[2] = ch__1;
20167 			    i__6[3] = lclf, a__3[3] = hdlndq;
20168 			    i__6[4] = 1, a__3[4] = "%";
20169 			    s_cat(ch__6, a__3, i__6, &c__5, (ftnlen)69);
20170 			    do_fio(&c__1, ch__6, lclf + 10);
20171 			    e_wsfe();
20172 			} else {
20173 			    s_wsfe(&io___770);
20174 /* Writing concatenation */
20175 			    i__4[0] = 1, a__1[0] = all_1.sq;
20176 			    i__4[1] = 10, a__1[1] = "setstaffs{";
20177 			    s_cat(ch__7, a__1, i__4, &c__2, (ftnlen)11);
20178 			    do_fio(&c__1, ch__7, (ftnlen)11);
20179 			    do_fio(&c__1, (char *)&iinow, (ftnlen)sizeof(
20180 				    integer));
20181 /* Writing concatenation */
20182 			    i__5[0] = 1, a__2[0] = "}";
20183 			    i__2 = comnvi_1.nspern[iinow - 1] + 48;
20184 			    chax_(ch__1, (ftnlen)1, &i__2);
20185 			    i__5[1] = 1, a__2[1] = ch__1;
20186 			    i__5[2] = 1, a__2[2] = "%";
20187 			    s_cat(ch__8, a__2, i__5, &c__3, (ftnlen)3);
20188 			    do_fio(&c__1, ch__8, (ftnlen)3);
20189 			    e_wsfe();
20190 			    s_wsfe(&io___771);
20191 /* Writing concatenation */
20192 			    i__4[0] = 1, a__1[0] = all_1.sq;
20193 			    i__4[1] = 8, a__1[1] = "setclef{";
20194 			    s_cat(ch__9, a__1, i__4, &c__2, (ftnlen)9);
20195 			    do_fio(&c__1, ch__9, (ftnlen)9);
20196 			    do_fio(&c__1, (char *)&iinow, (ftnlen)sizeof(
20197 				    integer));
20198 /* Writing concatenation */
20199 			    i__5[0] = 1, a__2[0] = "}";
20200 			    i__5[1] = lclf, a__2[1] = hdlndq;
20201 			    i__5[2] = 1, a__2[2] = "%";
20202 			    s_cat(ch__10, a__2, i__5, &c__3, (ftnlen)61);
20203 			    do_fio(&c__1, ch__10, lclf + 2);
20204 			    e_wsfe();
20205 			}
20206 		    }
20207 /* L60: */
20208 		}
20209 
20210 /*  Loop back up, this may not be last option in M.  Note flow out if durq=' ' */
20211 
20212 		getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
20213 		goto L31;
20214 	    }
20215 
20216 /*  Write instrument names */
20217 
20218 	    if (! comnvi_1.rename) {
20219 		i__1 = comnotes_1.ninow;
20220 		for (iinst = 1; iinst <= i__1; ++iinst) {
20221 		    if (comlast_1.islast) {
20222 			if (iinst < 10) {
20223 			    s_wsfe(&io___773);
20224 /* Writing concatenation */
20225 			    i__4[0] = 1, a__1[0] = all_1.sq;
20226 			    i__4[1] = 7, a__1[1] = "setname";
20227 			    s_cat(ch__11, a__1, i__4, &c__2, (ftnlen)8);
20228 			    do_fio(&c__1, ch__11, (ftnlen)8);
20229 			    do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(
20230 				    integer));
20231 			    do_fio(&c__1, "{}%", (ftnlen)3);
20232 			    e_wsfe();
20233 			} else {
20234 			    s_wsfe(&io___774);
20235 /* Writing concatenation */
20236 			    i__4[0] = 1, a__1[0] = all_1.sq;
20237 			    i__4[1] = 8, a__1[1] = "setname{";
20238 			    s_cat(ch__9, a__1, i__4, &c__2, (ftnlen)9);
20239 			    do_fio(&c__1, ch__9, (ftnlen)9);
20240 			    do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(
20241 				    integer));
20242 			    do_fio(&c__1, "}{}%", (ftnlen)4);
20243 			    e_wsfe();
20244 			}
20245 		    }
20246 /* L62: */
20247 		}
20248 	    } else {
20249 		i__1 = comnotes_1.ninow;
20250 		for (iinst = 1; iinst <= i__1; ++iinst) {
20251 		    if (comlast_1.islast) {
20252 			if (iinst < 10) {
20253 			    s_wsfe(&io___775);
20254 /* Writing concatenation */
20255 			    i__4[0] = 1, a__1[0] = all_1.sq;
20256 			    i__4[1] = 7, a__1[1] = "setname";
20257 			    s_cat(ch__11, a__1, i__4, &c__2, (ftnlen)8);
20258 			    do_fio(&c__1, ch__11, (ftnlen)8);
20259 			    do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(
20260 				    integer));
20261 /* Writing concatenation */
20262 			    i__5[0] = 1, a__2[0] = "{";
20263 			    i__5[1] = comtop_1.lnam[comnvi_1.iiorig[iinst - 1]
20264 				     - 1], a__2[1] = comtop_1.inameq + (
20265 				    comnvi_1.iiorig[iinst - 1] - 1) * 79;
20266 			    i__5[2] = 2, a__2[2] = "}%";
20267 			    s_cat(ch__12, a__2, i__5, &c__3, (ftnlen)82);
20268 			    do_fio(&c__1, ch__12, comtop_1.lnam[
20269 				    comnvi_1.iiorig[iinst - 1] - 1] + 3);
20270 			    e_wsfe();
20271 			} else {
20272 			    s_wsfe(&io___776);
20273 /* Writing concatenation */
20274 			    i__4[0] = 1, a__1[0] = all_1.sq;
20275 			    i__4[1] = 8, a__1[1] = "setname{";
20276 			    s_cat(ch__9, a__1, i__4, &c__2, (ftnlen)9);
20277 			    do_fio(&c__1, ch__9, (ftnlen)9);
20278 			    do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(
20279 				    integer));
20280 /* Writing concatenation */
20281 			    i__5[0] = 2, a__2[0] = "}{";
20282 			    i__5[1] = comtop_1.lnam[comnvi_1.iiorig[iinst - 1]
20283 				     - 1], a__2[1] = comtop_1.inameq + (
20284 				    comnvi_1.iiorig[iinst - 1] - 1) * 79;
20285 			    i__5[2] = 2, a__2[2] = "}%";
20286 			    s_cat(ch__13, a__2, i__5, &c__3, (ftnlen)83);
20287 			    do_fio(&c__1, ch__13, comtop_1.lnam[
20288 				    comnvi_1.iiorig[iinst - 1] - 1] + 4);
20289 			    e_wsfe();
20290 			}
20291 		    }
20292 /* L65: */
20293 		}
20294 		comnvi_1.rename = FALSE_;
20295 	    }
20296 	}
20297     } else if (*(unsigned char *)charq == '|') {
20298 
20299 /*  End of bar symbol.  Check about end of bar hardspace. */
20300 
20301 	if (bit_test(all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1]
20302 		+ 1) * 24 - 1],26)) {
20303 
20304 /*  There was a hardspace followed by a bar line.  Remove it from the hardspace */
20305 /*  list, store with shifts instead, set special bit.  Need to repeat this code */
20306 /*  at '/'. */
20307 
20308 	    all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
20309 		    = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
20310 		    commvl_1.ivx - 1] * 24 - 25],18);
20311 	    ++comudsp_1.nudoff[commvl_1.ivx - 1];
20312 	    comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[commvl_1.ivx - 1]
20313 		    * 24 - 25] = comudsp_1.udsp[comudsp_1.nudsp - 1];
20314 	    --comudsp_1.nudsp;
20315 	    all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24
20316 		    - 1] = bit_clear(all_1.iornq[commvl_1.ivx + (all_1.nnl[
20317 		    commvl_1.ivx - 1] + 1) * 24 - 1],26);
20318 	}
20319     } else if (i_indx("wS", charq, (ftnlen)2, (ftnlen)1) > 0) {
20320 
20321 /*  Width symbol or new nsyst.  Read past (until blank) */
20322 
20323 L4:
20324 	getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
20325 	if (*(unsigned char *)durq != ' ') {
20326 	    goto L4;
20327 	}
20328     } else if (*(unsigned char *)charq == 'l') {
20329 
20330 /*  Lower string.  Only OK if at start of block */
20331 /*  Check whether at beginning of a block */
20332 
20333 	if (all_1.iv != 1 || all_1.nnl[0] != 0) {
20334 	    s_wsle(&io___777);
20335 	    do_lio(&c__9, &c__1, "You entered \"l\" not at beginning of block"
20336 		    , (ftnlen)41);
20337 	    e_wsle();
20338 	    stop1_();
20339 	}
20340 
20341 /*  Set flag for lower string & read it in */
20342 
20343 	comhead_1.lower = TRUE_;
20344 	getbuf_(comhead_1.lowerq, (ftnlen)80);
20345 	all_1.iccount = 128;
20346     } else if (*(unsigned char *)charq == 'm') {
20347 
20348 /*  Meter change.  Only allow at beginning of block. */
20349 /*    mtrnuml, mtrdenl (logical) and p (printable) will be input. */
20350 /*    mtrnuml=0 initially. (In common) */
20351 
20352 /*  Check whether at beginning of a block */
20353 
20354 	if (all_1.iv != 1 || all_1.nnl[0] != 0) {
20355 	    s_wsle(&io___778);
20356 	    do_lio(&c__9, &c__1, "You entered \"m\" not at beginning of block"
20357 		    , (ftnlen)41);
20358 	    e_wsle();
20359 	    stop1_();
20360 	}
20361 	readmeter_(lineq, &all_1.iccount, &all_1.mtrnuml, &all_1.mtrdenl, (
20362 		ftnlen)128);
20363 	readmeter_(lineq, &all_1.iccount, &all_1.mtrnmp, &all_1.mtrdnp, (
20364 		ftnlen)128);
20365 	lenbeat = ifnodur_(&all_1.mtrdenl, "x", (ftnlen)1);
20366 	if (all_1.mtrdenl == 2) {
20367 	    lenbeat = 16;
20368 	}
20369 	all_1.lenbar = all_1.mtrnuml * lenbeat;
20370 	if (all_1.mtrdenl == 2) {
20371 	    all_1.lenbar <<= 1;
20372 	}
20373 	all_1.lenb1 = all_1.lenbar;
20374 	all_1.lenb0 = 0;
20375 	if (commidi_1.ismidi) {
20376 	    midievent_("m", &all_1.mtrnuml, &all_1.mtrdenl, (ftnlen)1);
20377 	}
20378     } else if (*(unsigned char *)charq == 'C') {
20379 
20380 /*  Clef change on next note.  Set bits 11-15.  Won't allow in 2nd line of music. */
20381 
20382 	if (all_1.nnl[all_1.iv - 1] > 0) {
20383 	    ++comcc_1.ncc[all_1.iv - 1];
20384 	}
20385 	comcc_1.tcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 - 25] = (real)
20386 		all_1.itsofar[all_1.iv - 1];
20387 	isl = bit_set(all_1.islur[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) *
20388 		24 - 25],11);
20389 	getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
20390 
20391 /*  Store clef number, or 7 if clef number = 9 (French violin clef) */
20392 
20393 /* Computing MIN */
20394 	i__1 = numclef_(durq, (ftnlen)1);
20395 	isl |= min(i__1,7) << 12;
20396 	comcc_1.ncmidcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 - 25] =
20397 		ncmidf_(durq, (ftnlen)1);
20398 
20399 /*  Set marker on note with lowest voice # starting at same time. */
20400 
20401 	if (all_1.iv == 1) {
20402 	    isl = bit_set(isl,15);
20403 	} else {
20404 	    i__1 = all_1.iv;
20405 	    for (iiv = 1; iiv <= i__1; ++iiv) {
20406 		nnliiv = all_1.nnl[iiv - 1];
20407 		if (iiv == all_1.iv) {
20408 		    ++nnliiv;
20409 		}
20410 		itother = 0;
20411 		i__2 = nnliiv;
20412 		for (iip = 1; iip <= i__2; ++iip) {
20413 		    if (itother < all_1.itsofar[all_1.iv - 1]) {
20414 			itother += all_1.nodur[iiv + iip * 24 - 25];
20415 			goto L14;
20416 		    } else if (itother == all_1.itsofar[all_1.iv - 1]) {
20417 			all_1.islur[iiv + iip * 24 - 25] = bit_set(
20418 				all_1.islur[iiv + iip * 24 - 25],15);
20419 			goto L15;
20420 		    }
20421 L14:
20422 		    ;
20423 		}
20424 /* L13: */
20425 	    }
20426 L15:
20427 	    ;
20428 	}
20429 
20430 /*  Need 'or' since may have set bit 15 in the above loop */
20431 
20432 	all_1.islur[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) * 24 - 25] = isl
20433 		| all_1.islur[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) * 24 -
20434 		25];
20435     } else if (*(unsigned char *)charq == 'R') {
20436 
20437 /*  Repeats.  set bits 5, 6, and/or 8 of islur(1,ip+1) */
20438 
20439 L10:
20440 	getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
20441 
20442 /*  Save designator in case it's a terminal Rr or Rd */
20443 
20444 	if (*(unsigned char *)durq == 'l') {
20445 	    all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(all_1.islur[(
20446 		    all_1.nnl[0] + 1) * 24 - 24],5);
20447 	    goto L10;
20448 	} else if (i_indx("rdDbz", durq, (ftnlen)5, (ftnlen)1) > 0) {
20449 	    if (*(unsigned char *)durq == 'r') {
20450 		all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(
20451 			all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],6);
20452 	    } else if (*(unsigned char *)durq == 'd') {
20453 		all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(
20454 			all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],8);
20455 	    } else if (*(unsigned char *)durq == 'D') {
20456 		all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(
20457 			all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],26);
20458 	    } else if (*(unsigned char *)durq == 'b') {
20459 		all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(
20460 			all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],25);
20461 	    } else if (*(unsigned char *)durq == 'z') {
20462 		all_1.iornq[(all_1.nnl[0] + 1) * 24] = bit_set(all_1.iornq[(
20463 			all_1.nnl[0] + 1) * 24],29);
20464 	    }
20465 	    comget_1.rptprev = TRUE_;
20466 	    *(unsigned char *)comget_1.rptfq1 = *(unsigned char *)durq;
20467 	    goto L10;
20468 	}
20469     } else if (*(unsigned char *)charq == 'V') {
20470 
20471 /*  Ending */
20472 
20473 	nnnl = all_1.nnl[0] + 1;
20474 	lvoltxt = 0;
20475 L11:
20476 	getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
20477 	if (*(unsigned char *)durq == 'b' || *(unsigned char *)durq == 'x') {
20478 
20479 /*  End Volta, set bit9, and bit10 on if 'b' (end w/ box) */
20480 
20481 	    all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * 24 - 24],
20482 		    9);
20483 	    if (*(unsigned char *)durq == 'b') {
20484 		all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * 24 -
20485 			24],10);
20486 	    }
20487 	    goto L11;
20488 	} else if (*(unsigned char *)durq != ' ') {
20489 
20490 /*  Start volta; Get text */
20491 
20492 	    if (lvoltxt == 0) {
20493 
20494 /*  First character for text */
20495 
20496 		lvoltxt = 1;
20497 		all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * 24 -
20498 			24],7);
20499 		++comgrace_1.nvolt;
20500 		s_copy(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20, durq,
20501 			 (ftnlen)20, (ftnlen)1);
20502 	    } else {
20503 /* Writing concatenation */
20504 		i__4[0] = lvoltxt, a__1[0] = comgrace_1.voltxtq + (
20505 			comgrace_1.nvolt - 1) * 20;
20506 		i__4[1] = 1, a__1[1] = durq;
20507 		s_cat(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20, a__1,
20508 			i__4, &c__2, (ftnlen)20);
20509 		++lvoltxt;
20510 	    }
20511 	    goto L11;
20512 	}
20513     } else if (*(unsigned char *)charq == 'B') {
20514 	combc_1.bcspec = ! combc_1.bcspec;
20515     } else if (*(unsigned char *)charq == 'P') {
20516 
20517 /*  Page numbers.  Print stuff right now. */
20518 
20519 	npg1 = 0;
20520 
20521 /*  Will use ltopnam to signal whether there's a centered heading */
20522 
20523 	ltopnam = 0;
20524 	ipg1r = 0;
20525 L16:
20526 	getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
20527 	if (*(unsigned char *)durq >= 48 && *(unsigned char *)durq <= 57) {
20528 	    npg1 = npg1 * 10 + *(unsigned char *)durq - 48;
20529 	    goto L16;
20530 	} else if (*(unsigned char *)durq == 'l') {
20531 	    if (npg1 == 0 || npg1 % 2 == 1) {
20532 		ipg1r = 1;
20533 	    }
20534 	    goto L16;
20535 	} else if (*(unsigned char *)durq == 'r') {
20536 	    if (npg1 > 0 && npg1 % 2 == 0) {
20537 		ipg1r = 1;
20538 	    }
20539 	    goto L16;
20540 	} else if (*(unsigned char *)durq == 'c') {
20541 
20542 /*  Top-centered name.  Assume this is last option.  Read the name. */
20543 /*  May surround name in double quotes (to allow blanks). */
20544 
20545 	    getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
20546 	    if (*(unsigned char *)durq == ' ') {
20547 		ltopnam = lenstr_(comtrans_1.cheadq, &c__60, (ftnlen)60);
20548 	    } else {
20549 		namstrt = all_1.iccount;
20550 		if (*(unsigned char *)durq == '"') {
20551 
20552 /*  Using quote delimiters. */
20553 
20554 		    quoted = TRUE_;
20555 		    ++namstrt;
20556 		} else {
20557 		    quoted = FALSE_;
20558 		}
20559 		for (all_1.iccount = namstrt + 1; all_1.iccount <= 128;
20560 			++all_1.iccount) {
20561 		    if (quoted && *(unsigned char *)&lineq[all_1.iccount - 1]
20562 			    == '"' || ! quoted && *(unsigned char *)&lineq[
20563 			    all_1.iccount - 1] == ' ') {
20564 			goto L36;
20565 		    }
20566 
20567 /*  On exit, iccount is OK, and name is in (namstrt:iccount-1) */
20568 
20569 /* L35: */
20570 		}
20571 		s_wsle(&io___791);
20572 		do_lio(&c__9, &c__1, "Awww, cmon, should not be here.", (
20573 			ftnlen)31);
20574 		e_wsle();
20575 		stop1_();
20576 L36:
20577 		ltopnam = all_1.iccount - namstrt;
20578 		s_copy(comtrans_1.cheadq, lineq + (namstrt - 1), (ftnlen)60,
20579 			all_1.iccount - 1 - (namstrt - 1));
20580 	    }
20581 	}
20582 
20583 /*  Done getting data, now assemble the command */
20584 
20585 	if (npg1 == 0) {
20586 	    npg1 = 1;
20587 	}
20588 
20589 /*  2/23/03 Don't use \atnextline if on first page and only one system */
20590 
20591 /*        if (ipage.gt.1 .or. nsystp(1).gt.1) then */
20592 /* Writing concatenation */
20593 	i__7[0] = 1, a__4[0] = all_1.sq;
20594 	i__7[1] = 3, a__4[1] = "def";
20595 	i__7[2] = 1, a__4[2] = all_1.sq;
20596 	i__7[3] = 11, a__4[3] = "atnextline{";
20597 	i__7[4] = 1, a__4[4] = all_1.sq;
20598 	i__7[5] = 10, a__4[5] = "toppageno{";
20599 	s_cat(hdlndq, a__4, i__7, &c__6, (ftnlen)59);
20600 	lhead = 27;
20601 /*        else */
20602 /*          hdlndq = sq//'toppageno{' */
20603 /*          lhead = 11 */
20604 /*        end if */
20605 	if (npg1 < 10) {
20606 
20607 /*  Note we are overwriting the last "{" */
20608 
20609 	    ici__1.icierr = 0;
20610 	    ici__1.icirnum = 1;
20611 	    ici__1.icirlen = 1;
20612 	    ici__1.iciunit = hdlndq + (lhead - 1);
20613 	    ici__1.icifmt = "(i1)";
20614 	    s_wsfi(&ici__1);
20615 	    do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer));
20616 	    e_wsfi();
20617 	} else if (npg1 < 100) {
20618 	    lhead += 3;
20619 	    i__1 = lhead - 3;
20620 	    ici__1.icierr = 0;
20621 	    ici__1.icirnum = 1;
20622 	    ici__1.icirlen = lhead - i__1;
20623 	    ici__1.iciunit = hdlndq + i__1;
20624 	    ici__1.icifmt = "(i2,a1)";
20625 	    s_wsfi(&ici__1);
20626 	    do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer));
20627 	    do_fio(&c__1, "}", (ftnlen)1);
20628 	    e_wsfi();
20629 	} else {
20630 	    lhead += 4;
20631 	    i__1 = lhead - 4;
20632 	    ici__1.icierr = 0;
20633 	    ici__1.icirnum = 1;
20634 	    ici__1.icirlen = lhead - i__1;
20635 	    ici__1.iciunit = hdlndq + i__1;
20636 	    ici__1.icifmt = "(i3,a1)";
20637 	    s_wsfi(&ici__1);
20638 	    do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer));
20639 	    do_fio(&c__1, "}", (ftnlen)1);
20640 	    e_wsfi();
20641 	}
20642 /* Writing concatenation */
20643 	i__5[0] = lhead, a__2[0] = hdlndq;
20644 	i__1 = ipg1r + 48;
20645 	chax_(ch__1, (ftnlen)1, &i__1);
20646 	i__5[1] = 1, a__2[1] = ch__1;
20647 	i__5[2] = 1, a__2[2] = "{";
20648 	s_cat(hdlndq, a__2, i__5, &c__3, (ftnlen)59);
20649 	lhead += 2;
20650 /*        if (ipage.gt.1 .or. nsystp(1).gt.1) then */
20651 	if (ltopnam == 0) {
20652 	    if (comlast_1.islast) {
20653 		s_wsfe(&io___793);
20654 /* Writing concatenation */
20655 		i__4[0] = lhead, a__1[0] = hdlndq;
20656 		i__4[1] = 3, a__1[1] = "}}%";
20657 		s_cat(ch__14, a__1, i__4, &c__2, (ftnlen)62);
20658 		do_fio(&c__1, ch__14, lhead + 3);
20659 		e_wsfe();
20660 	    }
20661 	} else {
20662 	    if (comlast_1.islast) {
20663 		s_wsfe(&io___794);
20664 /* Writing concatenation */
20665 		i__5[0] = lhead, a__2[0] = hdlndq;
20666 		i__5[1] = ltopnam, a__2[1] = comtrans_1.cheadq;
20667 		i__5[2] = 3, a__2[2] = "}}%";
20668 		s_cat(ch__15, a__2, i__5, &c__3, (ftnlen)122);
20669 		do_fio(&c__1, ch__15, lhead + ltopnam + 3);
20670 		e_wsfe();
20671 	    }
20672 	}
20673 /*        else */
20674 /*          if (ltopnam .eq. 0) then */
20675 /*            if (islast) write(11,'(a)')hdlndq(1:lhead)//'}%' */
20676 /*          else */
20677 /*            if (islast) */
20678 /*     *          write(11,'(a)')hdlndq(1:lhead)//cheadq(1:ltopnam)//'}%' */
20679 /*          end if */
20680 /*        end if */
20681     } else if (*(unsigned char *)charq == 'W') {
20682 
20683 /*  Just eat the number that must follow, it was used in pmxa */
20684 
20685 	++all_1.iccount;
20686 	readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
20687     } else if (*(unsigned char *)charq == 'T') {
20688 	comtitl_1.headlog = TRUE_;
20689 	comtitl_1.inhead = 0;
20690 	getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
20691 	if (*(unsigned char *)durq == 'i') {
20692 	    getbuf_(comtitl_1.instrq, (ftnlen)120);
20693 
20694 /*  A kluge for parts from separate score file for later movements. */
20695 
20696 	    if (*(unsigned char *)comtitl_1.instrq == ' ') {
20697 		comtitl_1.headlog = FALSE_;
20698 	    }
20699 	    s_copy(comtrans_1.cheadq, comtitl_1.instrq, (ftnlen)60, (ftnlen)
20700 		    120);
20701 	} else if (*(unsigned char *)durq == 't') {
20702 	    getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
20703 
20704 /*  Optionally can include extra vertical \internotes above inbothd */
20705 
20706 	    if (i_indx("-+0123456789", durq, (ftnlen)12, (ftnlen)1) > 0) {
20707 		ipm = 1;
20708 		if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
20709 
20710 /*  Don't trust readnum to round this negative integer properly */
20711 
20712 		    ++all_1.iccount;
20713 		    if (*(unsigned char *)durq == '-') {
20714 			ipm = -1;
20715 		    }
20716 		}
20717 		readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (
20718 			ftnlen)1);
20719 		comtitl_1.inhead = ipm * i_nint(&fnum);
20720 	    }
20721 	    getbuf_(comtitl_1.titleq, (ftnlen)120);
20722 	} else {
20723 	    getbuf_(comtitl_1.compoq, (ftnlen)120);
20724 	}
20725 	comtitl_1.inhead += cominbot_1.inbothd;
20726 	all_1.iccount = 128;
20727     } else if (*(unsigned char *)charq == 'A') {
20728 
20729 /*  Accidental handling etc. */
20730 
20731 L27:
20732 	getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
20733 	if (*(unsigned char *)durq == 'r') {
20734 	    if (comlast_1.islast) {
20735 		commidi_1.relacc = TRUE_;
20736 		s_wsfe(&io___795);
20737 /* Writing concatenation */
20738 		i__4[0] = 1, a__1[0] = all_1.sq;
20739 		i__4[1] = 14, a__1[1] = "relativeaccid%";
20740 		s_cat(ch__16, a__1, i__4, &c__2, (ftnlen)15);
20741 		do_fio(&c__1, ch__16, (ftnlen)15);
20742 		e_wsfe();
20743 	    }
20744 	} else if (*(unsigned char *)durq == 's') {
20745 	    spfacs_1.bacfac = 1e6f;
20746 	} else if (*(unsigned char *)durq == 'b') {
20747 	    if (comlast_1.islast) {
20748 		s_wsfe(&io___796);
20749 /* Writing concatenation */
20750 		i__4[0] = 1, a__1[0] = all_1.sq;
20751 		i__4[1] = 9, a__1[1] = "bigaccid%";
20752 		s_cat(ch__3, a__1, i__4, &c__2, (ftnlen)10);
20753 		do_fio(&c__1, ch__3, (ftnlen)10);
20754 		e_wsfe();
20755 	    }
20756 	    spfacs_1.accfac = spfacs_1.bacfac;
20757 	} else if (*(unsigned char *)durq == 'a') {
20758 	    getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
20759 	    readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
20760 		    1);
20761 	    --all_1.iccount;
20762 	} else if (*(unsigned char *)durq == 'i') {
20763 	    getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
20764 	    readnum_(lineq, &all_1.iccount, durq, &tintstf, (ftnlen)128, (
20765 		    ftnlen)1);
20766 	    if (! all_1.firstgulp) {
20767 		comget_1.fintstf = tintstf;
20768 	    }
20769 
20770 /*  Local corrections for first page were handled by pmxa */
20771 
20772 	    --all_1.iccount;
20773 	} else if (*(unsigned char *)durq == 'I') {
20774 	    getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
20775 	    readnum_(lineq, &all_1.iccount, durq, &comget_1.gintstf, (ftnlen)
20776 		    128, (ftnlen)1);
20777 	    --all_1.iccount;
20778 	} else if (*(unsigned char *)durq == 'd') {
20779 	    comarp_1.lowdot = TRUE_;
20780 	} else if (*(unsigned char *)durq == 'o') {
20781 	} else if (*(unsigned char *)durq == 'S') {
20782 /* 130324 */
20783 /*          do 50 iiv = 1 , nv */
20784 	    i__1 = comkeys_2.noinst;
20785 	    for (iiv = 1; iiv <= i__1; ++iiv) {
20786 		getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
20787 		if (i_indx("-s", durq, (ftnlen)2, (ftnlen)1) > 0) {
20788 		    comfig_1.fullsize[iiv - 1] = .8f;
20789 		} else if (*(unsigned char *)durq == 't') {
20790 		    comfig_1.fullsize[iiv - 1] = .64f;
20791 		} else {
20792 /*              fullsize(ivx) = 1.0 */
20793 		    comfig_1.fullsize[iiv - 1] = 1.f;
20794 		}
20795 /* L50: */
20796 	    }
20797 	} else if (*(unsigned char *)durq == 'e') {
20798 
20799 /*  Line-spacing equalization */
20800 
20801 	    comget_1.equalize = TRUE_;
20802 
20803 /*  The following redefinition of \parskip was put into pmx.tex in version 2.25 or so. */
20804 /*    But it causes problems with some older scores and when excerpts are combined */
20805 /*    with LaTeX.  So as of 2.352 we write it here. */
20806 
20807 	    s_wsfe(&io___798);
20808 /* Writing concatenation */
20809 	    i__8[0] = 1, a__5[0] = all_1.sq;
20810 	    i__8[1] = 6, a__5[1] = "global";
20811 	    i__8[2] = 1, a__5[2] = all_1.sq;
20812 	    i__8[3] = 19, a__5[3] = "parskip 0pt plus 12";
20813 	    i__8[4] = 1, a__5[4] = all_1.sq;
20814 	    i__8[5] = 19, a__5[5] = "Interligne minus 99";
20815 	    i__8[6] = 1, a__5[6] = all_1.sq;
20816 	    i__8[7] = 11, a__5[7] = "Interligne%";
20817 	    s_cat(ch__17, a__5, i__8, &c__8, (ftnlen)59);
20818 	    do_fio(&c__1, ch__17, (ftnlen)59);
20819 	    e_wsfe();
20820 	    s_copy(tempq, all_1.sepsymq, (ftnlen)24, (ftnlen)1);
20821 	    lentemp = 1;
20822 	    i__1 = all_1.nv - 1;
20823 	    for (iiv = 2; iiv <= i__1; ++iiv) {
20824 /* Writing concatenation */
20825 		i__4[0] = lentemp, a__1[0] = tempq;
20826 		i__4[1] = 1, a__1[1] = all_1.sepsymq + (iiv - 1);
20827 		s_cat(tempq, a__1, i__4, &c__2, (ftnlen)24);
20828 		++lentemp;
20829 /* L51: */
20830 	    }
20831 	    s_wsfe(&io___801);
20832 /* Writing concatenation */
20833 	    i__9[0] = 1, a__6[0] = all_1.sq;
20834 	    i__9[1] = 3, a__6[1] = "def";
20835 	    i__9[2] = 1, a__6[2] = all_1.sq;
20836 	    i__9[3] = 8, a__6[3] = "upstrut{";
20837 	    i__9[4] = 1, a__6[4] = all_1.sq;
20838 	    i__9[5] = 6, a__6[5] = "znotes";
20839 	    i__9[6] = lentemp, a__6[6] = tempq;
20840 	    i__9[7] = 1, a__6[7] = all_1.sq;
20841 	    i__9[8] = 10, a__6[8] = "zcharnote{";
20842 	    i__9[9] = 1, a__6[9] = all_1.sq;
20843 	    i__9[10] = 9, a__6[10] = "upamt}{~}";
20844 	    i__9[11] = 1, a__6[11] = all_1.sq;
20845 	    i__9[12] = 4, a__6[12] = "en}%";
20846 	    s_cat(ch__18, a__6, i__9, &c__13, (ftnlen)70);
20847 	    do_fio(&c__1, ch__18, lentemp + 46);
20848 	    e_wsfe();
20849 	} else if (*(unsigned char *)durq == 'v') {
20850 
20851 /*  Toggle usevshrink */
20852 
20853 	    comlast_1.usevshrink = ! comlast_1.usevshrink;
20854 	} else if (*(unsigned char *)durq == 'p') {
20855 
20856 /*  Postscript slurs. fontslur is already false (set in g1etnote) */
20857 
20858 	    if (! comslur_1.wrotepsslurdefaults) {
20859 
20860 /*  Set postscrirpt slur adjustment defaults */
20861 
20862 		s_wsfe(&io___802);
20863 /* Writing concatenation */
20864 		i__7[0] = 1, a__4[0] = all_1.sq;
20865 		i__7[1] = 12, a__4[1] = "Nosluradjust";
20866 		i__7[2] = 1, a__4[2] = all_1.sq;
20867 		i__7[3] = 11, a__4[3] = "Notieadjust";
20868 		i__7[4] = 1, a__4[4] = all_1.sq;
20869 		i__7[5] = 10, a__4[5] = "nohalfties";
20870 		s_cat(ch__19, a__4, i__7, &c__6, (ftnlen)36);
20871 		do_fio(&c__1, ch__19, (ftnlen)36);
20872 		e_wsfe();
20873 		comslur_1.wrotepsslurdefaults = TRUE_;
20874 	    }
20875 L52:
20876 	    g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
20877 /* might be "+", "-", "h" or */
20878 	    if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
20879 
20880 /*  Characters to change defaults for ps slurs */
20881 
20882 		g1etchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)
20883 			1);
20884 /* charq will be "s,t,h,c */
20885 		if (*(unsigned char *)durq == '+') {
20886 		    if (*(unsigned char *)charq == 's') {
20887 			s_wsfe(&io___803);
20888 /* Writing concatenation */
20889 			i__4[0] = 1, a__1[0] = all_1.sq;
20890 			i__4[1] = 10, a__1[1] = "Sluradjust";
20891 			s_cat(ch__7, a__1, i__4, &c__2, (ftnlen)11);
20892 			do_fio(&c__1, ch__7, (ftnlen)11);
20893 			e_wsfe();
20894 		    } else if (*(unsigned char *)charq == 't') {
20895 			s_wsfe(&io___804);
20896 /* Writing concatenation */
20897 			i__4[0] = 1, a__1[0] = all_1.sq;
20898 			i__4[1] = 9, a__1[1] = "Tieadjust";
20899 			s_cat(ch__3, a__1, i__4, &c__2, (ftnlen)10);
20900 			do_fio(&c__1, ch__3, (ftnlen)10);
20901 			e_wsfe();
20902 		    } else if (*(unsigned char *)charq == 'h') {
20903 			s_wsfe(&io___805);
20904 /* Writing concatenation */
20905 			i__4[0] = 1, a__1[0] = all_1.sq;
20906 			i__4[1] = 8, a__1[1] = "halfties";
20907 			s_cat(ch__9, a__1, i__4, &c__2, (ftnlen)9);
20908 			do_fio(&c__1, ch__9, (ftnlen)9);
20909 			e_wsfe();
20910 		    } else {
20911 			comslur_1.slurcurve += 1;
20912 			if (comslur_1.slurcurve > 3.1f) {
20913 			    printl_("WARNING!", (ftnlen)8);
20914 			    printl_("Default slur curvature advanced past HH"
20915 				    ", resetting", (ftnlen)50);
20916 			    comslur_1.slurcurve = 3.f;
20917 			}
20918 		    }
20919 		} else {
20920 		    if (*(unsigned char *)charq == 's') {
20921 			s_wsfe(&io___806);
20922 /* Writing concatenation */
20923 			i__4[0] = 1, a__1[0] = all_1.sq;
20924 			i__4[1] = 12, a__1[1] = "Nosluradjust";
20925 			s_cat(ch__4, a__1, i__4, &c__2, (ftnlen)13);
20926 			do_fio(&c__1, ch__4, (ftnlen)13);
20927 			e_wsfe();
20928 		    } else if (*(unsigned char *)charq == 't') {
20929 			s_wsfe(&io___807);
20930 /* Writing concatenation */
20931 			i__4[0] = 1, a__1[0] = all_1.sq;
20932 			i__4[1] = 11, a__1[1] = "Notieadjust";
20933 			s_cat(ch__2, a__1, i__4, &c__2, (ftnlen)12);
20934 			do_fio(&c__1, ch__2, (ftnlen)12);
20935 			e_wsfe();
20936 		    } else if (*(unsigned char *)charq == 'h') {
20937 			s_wsfe(&io___808);
20938 /* Writing concatenation */
20939 			i__4[0] = 1, a__1[0] = all_1.sq;
20940 			i__4[1] = 10, a__1[1] = "nohalfties";
20941 			s_cat(ch__7, a__1, i__4, &c__2, (ftnlen)11);
20942 			do_fio(&c__1, ch__7, (ftnlen)11);
20943 			e_wsfe();
20944 		    } else {
20945 			comslur_1.slurcurve += -1;
20946 			if (comslur_1.slurcurve < -1.1f) {
20947 			    printl_("WARNING!", (ftnlen)8);
20948 			    printl_("Default slur curvature decremented belo"
20949 				    "w f, resetting", (ftnlen)53);
20950 			    comslur_1.slurcurve = -1.f;
20951 			}
20952 		    }
20953 		}
20954 		goto L52;
20955 /* Check for another set of default changes */
20956 	    } else if (*(unsigned char *)durq == 'l') {
20957 
20958 /*  Set optional linebreak ties */
20959 
20960 		comnotes_1.optlinebreakties = TRUE_;
20961 		goto L52;
20962 	    } else if (*(unsigned char *)durq == 'h') {
20963 
20964 /*  Set flag to write header special on every page */
20965 
20966 		comnotes_1.headerspecial = TRUE_;
20967 		goto L52;
20968 	    } else {
20969 		--all_1.iccount;
20970 	    }
20971 	} else if (*(unsigned char *)durq == 'K') {
20972 
20973 /* Toggle keyboard rest placement flag */
20974 
20975 	    comkbdrests_1.kbdrests = ! comkbdrests_1.kbdrests;
20976 	} else if (*(unsigned char *)durq == 'c') {
20977 	    g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
20978 
20979 /* Just eat the input; it was used in pmax */
20980 
20981 	    goto L27;
20982 	}
20983 	if (i_indx("NR", durq, (ftnlen)2, (ftnlen)1) > 0) {
20984 
20985 /*  Override default part names for scor2prt, or normal include file. */
20986 /*  Just bypass rest of input line */
20987 
20988 	    all_1.iccount = 128;
20989 	} else if (*(unsigned char *)durq != ' ') {
20990 	    goto L27;
20991 	}
20992     } else if (*(unsigned char *)charq == 'K') {
20993 L77:
20994 	getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
20995 	if (*(unsigned char *)durq == 'n') {
20996 	    comignorenats_1.ignorenats = TRUE_;
20997 	    goto L77;
20998 	}
20999 	if (*(unsigned char *)durq != 'i') {
21000 
21001 /* Normal, full-score key change and/or transposition */
21002 
21003 	    num1 = 44 - *(unsigned char *)durq;
21004 	    ++all_1.iccount;
21005 	    readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
21006 		    1);
21007 	    num1 *= i_nint(&fnum);
21008 
21009 /*  On exit, durq='+','-'.  But only need isig if after start, else done in pmxa */
21010 
21011 	    ++all_1.iccount;
21012 	    readnum_(lineq, &all_1.iccount, charq, &fnum, (ftnlen)128, (
21013 		    ftnlen)1);
21014 	    if (commidi_1.ismidi) {
21015 		commidisig_1.midisig = i_nint(&fnum);
21016 		if (*(unsigned char *)durq == '-') {
21017 		    commidisig_1.midisig = -commidisig_1.midisig;
21018 		}
21019 /* 130317 */
21020 		commidisig_1.midisig += comtop_1.idsig;
21021 		midievent_("k", &commidisig_1.midisig, &c__0, (ftnlen)1);
21022 	    }
21023 /* 70        continue */
21024 	    if (num1 == 0) {
21025 
21026 /*  Key change, not transposition. */
21027 
21028 		all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) *
21029 			24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + (
21030 			all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],28);
21031 		comtop_1.lastisig = comtop_1.isig;
21032 		comtop_1.isig = i_nint(&fnum);
21033 		if (*(unsigned char *)durq == '-') {
21034 		    comtop_1.isig = -comtop_1.isig;
21035 		}
21036 		comtop_1.isig += comtop_1.idsig;
21037 		if (commidi_1.ismidi) {
21038 		    midievent_("k", &comtop_1.isig, &c__0, (ftnlen)1);
21039 		}
21040 	    } else {
21041 
21042 /*  num1 .ne. 0, so transposition, so must be at beginning.  isig came with K... */
21043 /*  but was passed to pmxb through pmxtex.dat.  isig0 comes from setup data */
21044 /*  (signature before transposition).  idsig must be added to future key changes. */
21045 
21046 		jv = 0;
21047 		while(jv < 24) {
21048 		    ++jv;
21049 		    cominsttrans_1.itransamt[jv - 1] = num1;
21050 		}
21051 		comtop_1.idsig = comtop_1.isig - comtop_1.isig0;
21052 	    }
21053 	} else {
21054 
21055 /* Instrument specific transposition. */
21056 
21057 	    getitransinfo_(&c_false, &combibarcnt_1.ibarcnt, lineq, &
21058 		    all_1.iccount, &ibaroff, &all_1.nbars, &comkeys_2.noinst,
21059 		    &all_1.iv, (ftnlen)128);
21060 
21061 /*  The sig parameters will have been set 1st time but that's OK */
21062 
21063 	}
21064     } else if (*(unsigned char *)charq == '/') {
21065 	if (bit_test(all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1]
21066 		+ 1) * 24 - 1],26)) {
21067 
21068 /*  There was a hardspace followed by end of block.  Remove it from the hardspace */
21069 /*  list, store with shifts instead, set special bit.  This code also at '|' */
21070 
21071 	    all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
21072 		    = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
21073 		    commvl_1.ivx - 1] * 24 - 25],18);
21074 	    ++comudsp_1.nudoff[commvl_1.ivx - 1];
21075 	    comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[commvl_1.ivx - 1]
21076 		    * 24 - 25] = comudsp_1.udsp[comudsp_1.nudsp - 1];
21077 	    --comudsp_1.nudsp;
21078 	    all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24
21079 		    - 1] = bit_clear(all_1.iornq[commvl_1.ivx + (all_1.nnl[
21080 		    commvl_1.ivx - 1] + 1) * 24 - 1],26);
21081 	}
21082 	getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
21083 
21084 /*  Save ending note level: */
21085 
21086 	if (commvl_1.ivx <= all_1.nv) {
21087 
21088 /*  This is the first line of music on this staff.  If previous block had only 1 */
21089 /*  voice, save last pitch from line 1 of prev. block to line 2, in case a */
21090 /*  2nd line is started just below */
21091 
21092 	    if (! comnotes_1.was2[all_1.iv - 1]) {
21093 		comnotes_1.ndlev[all_1.iv + 23] = comnotes_1.ndlev[all_1.iv -
21094 			1];
21095 	    }
21096 	    comnotes_1.was2[all_1.iv - 1] = FALSE_;
21097 	    comnotes_1.ndlev[all_1.iv - 1] = comnotes_1.lastlev;
21098 	} else {
21099 
21100 /*  This is the 2nd line of music on this staff. */
21101 
21102 	    comnotes_1.was2[all_1.iv - 1] = TRUE_;
21103 	    comnotes_1.ndlev[all_1.iv + 23] = comnotes_1.lastlev;
21104 	}
21105 	if (*(unsigned char *)durq == ' ' && all_1.iv == all_1.nv) {
21106 
21107 /*  End of input block */
21108 
21109 	    *loop = FALSE_;
21110 	} else {
21111 
21112 /*  Start a new line of music */
21113 
21114 	    if (all_1.lenb0 != 0 && all_1.firstgulp) {
21115 		all_1.lenbar = all_1.lenb0;
21116 	    }
21117 	    all_1.nbars = 0;
21118 	    if (*(unsigned char *)durq == ' ') {
21119 
21120 /*  New line of music is on next staff */
21121 
21122 		++all_1.iv;
21123 		commvl_1.ivx = all_1.iv;
21124 	    } else {
21125 
21126 /*  durq must be 2nd '/'.  New line of music is on same staff.  Set up for it */
21127 
21128 		commvl_1.ivx = all_1.nv + 1;
21129 		i__1 = all_1.nv;
21130 		for (iiv = 1; iiv <= i__1; ++iiv) {
21131 		    if (commvl_1.nvmx[iiv - 1] == 2) {
21132 			++commvl_1.ivx;
21133 		    }
21134 /* L23: */
21135 		}
21136 		commvl_1.nvmx[all_1.iv - 1] = 2;
21137 		commvl_1.ivmx[all_1.iv + 23] = commvl_1.ivx;
21138 		all_1.itsofar[commvl_1.ivx - 1] = 0;
21139 		all_1.nnl[commvl_1.ivx - 1] = 0;
21140 		comfb_1.nfb[commvl_1.ivx - 1] = 0;
21141 		comudsp_1.nudoff[commvl_1.ivx - 1] = 0;
21142 		comcc_1.ndotmv[commvl_1.ivx - 1] = 0;
21143 		for (j = 1; j <= 200; ++j) {
21144 		    all_1.irest[commvl_1.ivx + j * 24 - 25] = 0;
21145 		    all_1.islur[commvl_1.ivx + j * 24 - 25] = 0;
21146 		    all_1.nacc[commvl_1.ivx + j * 24 - 25] = 0;
21147 		    all_1.iornq[commvl_1.ivx + j * 24 - 1] = 0;
21148 		    all_1.ipl[commvl_1.ivx + j * 24 - 25] = 0;
21149 		    all_1.mult[commvl_1.ivx + j * 24 - 25] = 0;
21150 /* L24: */
21151 		}
21152 
21153 /*  Go back and lower the rests in voice "a" that don't have over-ridden heights */
21154 
21155 		i__1 = all_1.nnl[all_1.iv - 1];
21156 		for (j = 1; j <= i__1; ++j) {
21157 		    if (bit_test(all_1.irest[all_1.iv + j * 24 - 25],0) &&
21158 			    all_1.nolev[all_1.iv + j * 24 - 25] == 0) {
21159 			all_1.nolev[all_1.iv + j * 24 - 25] = -4;
21160 		    }
21161 /* L26: */
21162 		}
21163 	    }
21164 	}
21165 	all_1.iccount = 128;
21166     } else if (*(unsigned char *)charq == 'X') {
21167 
21168 /*  3rd arg is only for termination of group shifts.  Use "max" to avoid zero index, */
21169 /*    which only happens for normal X at block start, and we took special measures to */
21170 /*    keep group shifts for crossing block boundaries. */
21171 
21172 /* Computing MAX */
21173 	i__1 = 1, i__2 = all_1.nnl[commvl_1.ivx - 1];
21174 	getx_(lineq, &all_1.iccount, &all_1.irest[commvl_1.ivx + max(i__1,
21175 		i__2) * 24 - 25], &comnotes_1.shifton, &comask_1.wheadpt, &
21176 		all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) *
21177 		 24 - 1], &commvl_1.ivx, &all_1.irest[commvl_1.ivx + (
21178 		all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25], &all_1.itsofar[
21179 		commvl_1.ivx - 1], &c__0, &c__0, &c__0, " ", &ndoub, (ftnlen)
21180 		128, (ftnlen)1);
21181     } else if (*(unsigned char *)charq == 'I') {
21182 
21183 /*  Midi controls. */
21184 
21185 /*        call getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, */
21186 	getmidi_(&comkeys_2.noinst, lineq, &all_1.iccount, &
21187 		combibarcnt_1.ibarcnt, &ibaroff, &all_1.nbars, &all_1.lenbar,
21188 		&all_1.mtrdenl, &c_false, (ftnlen)128);
21189     } else if (*(unsigned char *)charq == 'M') {
21190 
21191 /*  Macro action */
21192 
21193 	getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
21194 	if (i_indx("RS", charq, (ftnlen)2, (ftnlen)1) > 0) {
21195 
21196 /*  Record or save a macro.  Get the number of the macro. */
21197 
21198 	    getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
21199 	    readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
21200 		    1);
21201 	    commac_1.macnum = i_nint(&fnum);
21202 	    commac_1.macuse = bit_set(commac_1.macuse,commac_1.macnum);
21203 	    if (*(unsigned char *)charq == 'R') {
21204 		mrec1_(lineq, &all_1.iccount, &ndxm, (ftnlen)128);
21205 	    } else {
21206 
21207 /*  Save (Record but don't activate) */
21208 
21209 L5:
21210 		mrec1_(lineq, &all_1.iccount, &ndxm, (ftnlen)128);
21211 		if (commac_1.mrecord) {
21212 		    getbuf_(lineq, (ftnlen)128);
21213 		    all_1.iccount = 0;
21214 		    goto L5;
21215 		}
21216 		all_1.iccount = all_1.iccount + ndxm + 1;
21217 	    }
21218 	} else if (*(unsigned char *)charq == 'P') {
21219 
21220 /*  Playback the macro */
21221 
21222 	    getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
21223 	    readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
21224 		    1);
21225 	    commac_1.macnum = i_nint(&fnum);
21226 	    commac_1.icchold = all_1.iccount;
21227 	    s_copy(commac_1.lnholdq, lineq, (ftnlen)128, (ftnlen)128);
21228 	    all_1.iccount = 128;
21229 	    c1ommac_1.ilmac = c1ommac_1.il1mac[commac_1.macnum - 1];
21230 	    commac_1.mplay = TRUE_;
21231 	}
21232     } else if (i_indx(",.", charq, (ftnlen)2, (ftnlen)1) > 0) {
21233 
21234 /*  Continued rhythmic shortcut */
21235 
21236 	idotform = i_indx(". ,", charq, (ftnlen)3, (ftnlen)1);
21237 	if (idotform == 1) {
21238 
21239 /*  Check for start of forced beam on 2nd member of dotform=1 shortcut */
21240 
21241 	    if (comget_1.fbon) {
21242 		if (comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1]
21243 			* 24 - 25] == (real) all_1.itsofar[commvl_1.ivx - 1])
21244 			{
21245 		    comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1]
21246 			    * 24 - 25] += all_1.nodur[commvl_1.ivx +
21247 			    all_1.nnl[commvl_1.ivx - 1] * 24 - 25] / 2;
21248 		}
21249 	    }
21250 
21251 /*  Change duration of prior note */
21252 
21253 	    all_1.itsofar[commvl_1.ivx - 1] -= all_1.nodur[commvl_1.ivx +
21254 		    all_1.nnl[commvl_1.ivx - 1] * 24 - 25];
21255 	    all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
21256 		    = all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
21257 		     24 - 25] * 3 / 2;
21258 	    all_1.itsofar[commvl_1.ivx - 1] += all_1.nodur[commvl_1.ivx +
21259 		    all_1.nnl[commvl_1.ivx - 1] * 24 - 25];
21260 	}
21261 	++idotform;
21262 	numnum = 1;
21263 	cdot = TRUE_;
21264 	goto L1;
21265     }
21266     return 0;
21267 } /* getnote_ */
21268 
getorn_(char * lineq,integer * iccount,integer * iornq,integer * iornq0,logical * ornrpt,integer * noffseg,integer * ip,integer * ivx,logical * noxtup,logical * notcrd,integer * nole,ftnlen lineq_len)21269 /* Subroutine */ int getorn_(char *lineq, integer *iccount, integer *iornq,
21270 	integer *iornq0, logical *ornrpt, integer *noffseg, integer *ip,
21271 	integer *ivx, logical *noxtup, logical *notcrd, integer *nole, ftnlen
21272 	lineq_len)
21273 {
21274     /* System generated locals */
21275     integer i__1;
21276     real r__1;
21277 
21278     /* Builtin functions */
21279     integer i_indx(char *, char *, ftnlen, ftnlen), i_nint(real *), s_wsle(
21280 	    cilist *), do_lio(integer *, integer *, char *, ftnlen), e_wsle(
21281 	    void);
21282 
21283     /* Local variables */
21284     static real fnum;
21285     static integer korn;
21286     static char durq[1];
21287     extern /* Subroutine */ int stop1_(void);
21288     static char charq[1];
21289     static integer iorni;
21290     static logical negseg;
21291     extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen,
21292 	    ftnlen), readnum_(char *, integer *, char *, real *, ftnlen,
21293 	    ftnlen);
21294     static integer iofforn;
21295     extern /* Subroutine */ int setbits_(integer *, integer *, integer *,
21296 	    integer *);
21297     static real xofforn;
21298 
21299     /* Fortran I/O blocks */
21300     static cilist io___820 = { 0, 6, 0, 0, 0 };
21301 
21302 
21303 
21304 /*  iornq: Main note.  Do not alter if chord note, except turn on bit 23 */
21305 /*  iornq0: Store iorni + bit 23, in case of repeated ornaments */
21306 /*  iorni: Internal use, 1st 21 bits of iornq or icrdorn, dep. on notcrd. */
21307 /*  noffseg: horiz. offset for segno */
21308 /*  nole: level of note w/ orn, used to ID the note/orn if there's a level shift. */
21309 
21310 
21311 /*  Bits 0-13: (stmgx+Tupf._), 14: Down fermata, was F, 15: Trill w/o "tr", was U */
21312 /*  16-18 Editorial sharp, flat, natural "oes,f,n"; 19-20: >^, 21 ? for ed. accid. */
21313 
21314     getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
21315     if (i_indx("bc", charq, (ftnlen)2, (ftnlen)1) > 0) {
21316 
21317 /*  caesura or breath, handle specially and exit. Set up data in ibcdata(1...nbc) */
21318 /*      ivx(0-3,28), ip(4-12), */
21319 /*      vshift (vshift+32 in bits 13-18), */
21320 /*      hshift (nint(10*vshift)+128 in bits 19-26) */
21321 /*      bit 27 = 0 if caesura, 1 if breath */
21322 /*      bit 28: 5th bit of ivx */
21323 
21324 	*iornq = bit_set(*iornq,28);
21325 	++comcb_1.nbc;
21326 /*        ibcdata(nbc) = ivx+16*ip */
21327 	comcb_1.ibcdata[comcb_1.nbc - 1] = *ivx % 16 + (*ip << 4);
21328 	if (*ivx >= 16) {
21329 	    comcb_1.ibcdata[comcb_1.nbc - 1] = bit_set(comcb_1.ibcdata[
21330 		    comcb_1.nbc - 1],28);
21331 	}
21332 	if (*(unsigned char *)charq == 'b') {
21333 	    comcb_1.ibcdata[comcb_1.nbc - 1] = bit_set(comcb_1.ibcdata[
21334 		    comcb_1.nbc - 1],27);
21335 	}
21336 	getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
21337 	if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
21338 
21339 /*  We have a vertical shift, get it */
21340 
21341 	    ++(*iccount);
21342 	    readnum_(lineq, iccount, charq, &fnum, (ftnlen)128, (ftnlen)1);
21343 	    if (*(unsigned char *)durq == '-') {
21344 		fnum = -fnum;
21345 	    }
21346 	    r__1 = fnum + 32;
21347 	    i__1 = i_nint(&r__1);
21348 	    setbits_(&comcb_1.ibcdata[comcb_1.nbc - 1], &c__6, &c__13, &i__1);
21349 	    if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) > 0) {
21350 
21351 /*  Horizontal shift, get it */
21352 
21353 		++(*iccount);
21354 		readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
21355 		if (*(unsigned char *)charq == '-') {
21356 		    fnum = -fnum;
21357 		}
21358 		r__1 = fnum * 10;
21359 		i__1 = i_nint(&r__1) + 128;
21360 		setbits_(&comcb_1.ibcdata[comcb_1.nbc - 1], &c__8, &c__19, &
21361 			i__1);
21362 	    }
21363 	}
21364 	return 0;
21365     }
21366 
21367 /*  Set signal on main note that some note at this time has ornament.  ONLY used */
21368 /*  in beamstrt to activate further tests for whether ihornb is needed. */
21369 
21370     *iornq = bit_set(*iornq,23);
21371 
21372 /*  Isolate 21 bits defining exisiting ornaments */
21373 
21374     if (*notcrd) {
21375 	iorni = 4194303 & *iornq;
21376     } else {
21377 	iorni = 4194303 & comtrill_1.icrdorn[comtrill_1.ncrd - 1];
21378     }
21379     korn = i_indx("stmgx+Tupf._)e:XXX>^", charq, (ftnlen)20, (ftnlen)1);
21380     if (korn != 15) {
21381 	iorni = bit_set(iorni,korn);
21382     }
21383 
21384 /*  Note that korn=0 => charq='(', and we set bit 0.  if "e" (14), alter later */
21385 /*    as follows: korn=16-18 for sfn, and or 21 for bare ?. */
21386 /*  When this if-block is done, korn will = bit# of actual ornament (unless "?"). */
21387 
21388     if (korn == 15) {
21389 
21390 /* c  Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-20 prev iornq */
21391 /*  Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-21 prev iornq */
21392 
21393 /*        iorni = ior(iorni,iand(iornq0,1638383)) */
21394 	iorni |= *iornq0 & 3735535;
21395 	*ornrpt = FALSE_;
21396 	getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
21397 
21398 /*  durq will be ' ' */
21399 
21400     } else if (korn == 14) {
21401 
21402 /*  Editorial accidental */
21403 
21404 	getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
21405 /*        korn = 15+index('sfn',durq) */
21406 	korn = i_indx("sfn?", durq, (ftnlen)4, (ftnlen)1) + 15;
21407 	if (korn == 19) {
21408 	    korn = 21;
21409 	}
21410 	iorni = bit_set(bit_clear(iorni,14),korn);
21411 	getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
21412 	if (*(unsigned char *)durq == '?') {
21413 
21414 /*  This is "oe[s|f|n]?".  Set 21st bit also. */
21415 
21416 	    iorni = bit_set(iorni,21);
21417 	    korn += 6;
21418 	    getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
21419 	}
21420 /*        iorni = ibset(ibclr(iorni,14),korn) */
21421     } else if (korn == 4 && *noxtup) {
21422 
21423 /*  segno. Check in pmxa for just 1/block & notcrd.  Get horiz. offset in points */
21424 
21425 	*noffseg = 0;
21426 	negseg = FALSE_;
21427 	getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
21428 	if (*(unsigned char *)durq != ' ') {
21429 
21430 /*  Segno shift is specified */
21431 
21432 	    if (*(unsigned char *)durq == '-') {
21433 		negseg = TRUE_;
21434 		getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
21435 	    }
21436 	    readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
21437 	    *noffseg = (integer) fnum;
21438 	    if (negseg) {
21439 		*noffseg = -(*noffseg);
21440 	    }
21441 	}
21442     } else if (korn == 7) {
21443 
21444 /*  Trill.  Check in pmxa for notcrd.  Default is 1 noteskip long, with "tr" */
21445 
21446 	++comtrill_1.ntrill;
21447 	comtrill_1.ivtrill[comtrill_1.ntrill - 1] = *ivx;
21448 	comtrill_1.iptrill[comtrill_1.ntrill - 1] = *ip;
21449 	comtrill_1.xnsktr[comtrill_1.ntrill - 1] = 1.f;
21450 	getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
21451 	if (*(unsigned char *)durq == 't') {
21452 
21453 /*  Convert to new internal symbol for non-'"tr" trill */
21454 
21455 	    korn = 15;
21456 	    iorni = bit_set(bit_clear(iorni,7),15);
21457 	    getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
21458 	}
21459 	if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) > 0) {
21460 
21461 /*  We have a number for the length */
21462 
21463 	    readnum_(lineq, iccount, durq, &comtrill_1.xnsktr[
21464 		    comtrill_1.ntrill - 1], (ftnlen)128, (ftnlen)1);
21465 	}
21466     } else if (korn == 10 && *noxtup) {
21467 
21468 /*  Fermata */
21469 
21470 	getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
21471 	if (*(unsigned char *)durq == 'd') {
21472 	    korn = 14;
21473 	    iorni = bit_set(bit_clear(iorni,10),14);
21474 	    getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
21475 	}
21476     } else {
21477 	getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
21478     }
21479     if (i_indx("+- :", durq, (ftnlen)4, (ftnlen)1) == 0) {
21480 	s_wsle(&io___820);
21481 	do_lio(&c__9, &c__1, "Unexpected character at end of ornament: ", (
21482 		ftnlen)41);
21483 	do_lio(&c__9, &c__1, durq, (ftnlen)1);
21484 	e_wsle();
21485 	stop1_();
21486     }
21487     if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
21488 
21489 /*  Shift ornament up or down */
21490 
21491 	++comtrill_1.nudorn;
21492 
21493 /*  Set bit 25 in iorni as a signal.  This may not really be necessary. */
21494 
21495 	iorni = bit_set(iorni,25);
21496 
21497 /*  Assemble info to put in kudorn(nudorn) Bits 0-7:ip, 8-11:ivx, 12-18:nolev, */
21498 /*     19-24: type of ornament to be shifted, 25-30: shift+32, 31:h-shft present */
21499 
21500 	xofforn = (real) (44 - *(unsigned char *)durq);
21501 	++(*iccount);
21502 	readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
21503 	r__1 = xofforn * fnum;
21504 	iofforn = i_nint(&r__1);
21505 	comtrill_1.kudorn[comtrill_1.nudorn - 1] = *ip + (*ivx % 16 << 8) + (*
21506 		nole << 12) + (korn << 19) + (iofforn + 32 << 25);
21507 	comivxudorn_1.ivxudorn[comtrill_1.nudorn - 1] = *ivx;
21508 	if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
21509 
21510 /*  Horizontal shift */
21511 
21512 	    comtrill_1.kudorn[comtrill_1.nudorn - 1] = bit_set(
21513 		    comtrill_1.kudorn[comtrill_1.nudorn - 1],31);
21514 	    xofforn = (real) (44 - *(unsigned char *)durq);
21515 	    ++(*iccount);
21516 	    readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
21517 	    r__1 = xofforn * fnum;
21518 	    comtrill_1.ornhshft[comtrill_1.nudorn - 1] = (real) i_nint(&r__1);
21519 	}
21520     } else if (*(unsigned char *)durq == ':') {
21521 
21522 /*  Turn on repeated ornaments */
21523 
21524 	*ornrpt = TRUE_;
21525 
21526 /*  Save the ornament value just set */
21527 
21528 	*iornq0 = iorni;
21529     }
21530     if (*notcrd) {
21531 	*iornq |= iorni;
21532     } else {
21533 	comtrill_1.icrdorn[comtrill_1.ncrd - 1] |= iorni;
21534     }
21535     return 0;
21536 } /* getorn_ */
21537 
getpmxmod_(logical * global,char * includeq,ftnlen includeq_len)21538 /* Subroutine */ int getpmxmod_(logical *global, char *includeq, ftnlen
21539 	includeq_len)
21540 {
21541     /* System generated locals */
21542     address a__1[3], a__2[2];
21543     integer i__1[3], i__2[2], i__3;
21544     char ch__1[114], ch__2[106], ch__3[108], ch__4[88];
21545     olist o__1;
21546     cllist cl__1;
21547     inlist ioin__1;
21548 
21549     /* Builtin functions */
21550     integer f_inqu(inlist *);
21551     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
21552     integer s_wsle(cilist *), e_wsle(void), s_wsfe(cilist *), e_wsfe(void);
21553     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
21554     integer f_open(olist *), s_rsfe(cilist *), do_fio(integer *, char *,
21555 	    ftnlen), e_rsfe(void), f_clos(cllist *);
21556 
21557     /* Local variables */
21558     static integer ilbufmod, ipbufmod, lenbufmod, lenmodline;
21559     static char pmxmoddirq[80];
21560     static integer lpmxmoddirq;
21561     extern /* Subroutine */ int stop1_(void);
21562     static integer ilbuff;
21563     extern /* Subroutine */ int getenv_(char *, char *, ftnlen, ftnlen);
21564     static logical fexist;
21565     extern integer lenstr_(char *, integer *, ftnlen);
21566     extern /* Subroutine */ int printl_(char *, ftnlen);
21567     static char lnholdq[128];
21568 
21569     /* Fortran I/O blocks */
21570     static cilist io___826 = { 0, 6, 0, 0, 0 };
21571     static cilist io___827 = { 0, 15, 0, "()", 0 };
21572     static cilist io___831 = { 0, 18, 1, "(a)", 0 };
21573 
21574 
21575 
21576 /*  If global=.true., checks for environment variable with path to pmx.mod. */
21577 /*    Then, if variable exists and points to pmx.mod, insert lines from */
21578 /*    pmx.mod into buffer */
21579 /*  If global=.false., checks for existence of includeq and uses it. */
21580 
21581 /*  lenbuf0 = total length of bufq on entry */
21582 /*  lbuf(i) = length of line (i) */
21583 /*  nlbuf = number of lines stored in bufq */
21584 /*  ilbuf = index of first line after setup stuff (on entry). In general, index of */
21585 /*          next line to be sucked from buffer. */
21586 /*  ilbufmod = counter for lines in pmx.mod as they are grabbed. */
21587 /*             Starts at ilbuf. Points to position of next line after */
21588 /*             pmx.mod stuff in bufq on exiting loop 1 */
21589 /*  ilbuff = transient counter for shifting operations */
21590 /*  ipbuf = on entry, points to last character in setup stuff. In general, points */
21591 /*          to last character of most recent line sucked from buffer. */
21592 /*  ipbufmod = points to last character of most recent inserted line */
21593 /*             from pmx.mod */
21594 
21595     c1omget_1.line1pmxmod = inbuff_1.ilbuf;
21596     if (! (*global)) {
21597 	ioin__1.inerr = 0;
21598 	ioin__1.infilen = includeq_len;
21599 	ioin__1.infile = includeq;
21600 	ioin__1.inex = &fexist;
21601 	ioin__1.inopen = 0;
21602 	ioin__1.innum = 0;
21603 	ioin__1.innamed = 0;
21604 	ioin__1.inname = 0;
21605 	ioin__1.inacc = 0;
21606 	ioin__1.inseq = 0;
21607 	ioin__1.indir = 0;
21608 	ioin__1.infmt = 0;
21609 	ioin__1.inform = 0;
21610 	ioin__1.inunf = 0;
21611 	ioin__1.inrecl = 0;
21612 	ioin__1.innrec = 0;
21613 	ioin__1.inblank = 0;
21614 	f_inqu(&ioin__1);
21615 
21616 /*  Transfer includeq to temporary char variable with known length */
21617 
21618 	s_copy(pmxmoddirq, includeq, (ftnlen)80, includeq_len);
21619 	lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80);
21620 	s_wsle(&io___826);
21621 	e_wsle();
21622 	s_wsfe(&io___827);
21623 	e_wsfe();
21624 	if (! fexist) {
21625 /* Writing concatenation */
21626 	    i__1[0] = 15, a__1[0] = "Could not find ";
21627 	    i__1[1] = lpmxmoddirq, a__1[1] = pmxmoddirq;
21628 	    i__1[2] = 19, a__1[2] = ", checking further.";
21629 	    s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)114);
21630 	    printl_(ch__1, lpmxmoddirq + 34);
21631 
21632 /*  File named includeq doesn't not exist. Get directory from PMXMODDIR and */
21633 /*    see if it's there */
21634 
21635 	    getenv_("PMXMODDIR", pmxmoddirq, (ftnlen)9, (ftnlen)80);
21636 	    lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80);
21637 	    if (lpmxmoddirq > 0) {
21638 /* Writing concatenation */
21639 		i__2[0] = lpmxmoddirq, a__2[0] = pmxmoddirq;
21640 		i__2[1] = includeq_len, a__2[1] = includeq;
21641 		s_cat(pmxmoddirq, a__2, i__2, &c__2, (ftnlen)80);
21642 		lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80);
21643 	    } else {
21644 		printl_("No other directory defined by PMXMODDIR, stopping", (
21645 			ftnlen)49);
21646 		stop1_();
21647 	    }
21648 	    ioin__1.inerr = 0;
21649 	    ioin__1.infilen = 80;
21650 	    ioin__1.infile = pmxmoddirq;
21651 	    ioin__1.inex = &fexist;
21652 	    ioin__1.inopen = 0;
21653 	    ioin__1.innum = 0;
21654 	    ioin__1.innamed = 0;
21655 	    ioin__1.inname = 0;
21656 	    ioin__1.inacc = 0;
21657 	    ioin__1.inseq = 0;
21658 	    ioin__1.indir = 0;
21659 	    ioin__1.infmt = 0;
21660 	    ioin__1.inform = 0;
21661 	    ioin__1.inunf = 0;
21662 	    ioin__1.inrecl = 0;
21663 	    ioin__1.innrec = 0;
21664 	    ioin__1.inblank = 0;
21665 	    f_inqu(&ioin__1);
21666 	    if (! fexist) {
21667 /* Writing concatenation */
21668 		i__1[0] = 15, a__1[0] = "Could not find ";
21669 		i__1[1] = lpmxmoddirq, a__1[1] = pmxmoddirq;
21670 		i__1[2] = 11, a__1[2] = ", stopping.";
21671 		s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)106);
21672 		printl_(ch__2, lpmxmoddirq + 26);
21673 		stop1_();
21674 	    }
21675 	}
21676 /* Writing concatenation */
21677 	i__2[0] = 28, a__2[0] = "Opening normal include file ";
21678 	i__2[1] = lpmxmoddirq, a__2[1] = pmxmoddirq;
21679 	s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)108);
21680 	printl_(ch__3, lpmxmoddirq + 28);
21681 	o__1.oerr = 0;
21682 	o__1.ounit = 18;
21683 	o__1.ofnmlen = 80;
21684 	o__1.ofnm = pmxmoddirq;
21685 	o__1.orl = 0;
21686 	o__1.osta = 0;
21687 	o__1.oacc = 0;
21688 	o__1.ofm = 0;
21689 	o__1.oblnk = 0;
21690 	f_open(&o__1);
21691     } else {
21692 
21693 /*  Check for existence of pmx.mod */
21694 
21695 	getenv_("PMXMODDIR", pmxmoddirq, (ftnlen)9, (ftnlen)80);
21696 	lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80);
21697 	if (lpmxmoddirq == 0) {
21698 	    return 0;
21699 	}
21700 /* Writing concatenation */
21701 	i__2[0] = lpmxmoddirq, a__2[0] = pmxmoddirq;
21702 	i__2[1] = 7, a__2[1] = "pmx.mod";
21703 	s_cat(pmxmoddirq, a__2, i__2, &c__2, (ftnlen)80);
21704 	lpmxmoddirq += 7;
21705 	ioin__1.inerr = 0;
21706 	ioin__1.infilen = 80;
21707 	ioin__1.infile = pmxmoddirq;
21708 	ioin__1.inex = &fexist;
21709 	ioin__1.inopen = 0;
21710 	ioin__1.innum = 0;
21711 	ioin__1.innamed = 0;
21712 	ioin__1.inname = 0;
21713 	ioin__1.inacc = 0;
21714 	ioin__1.inseq = 0;
21715 	ioin__1.indir = 0;
21716 	ioin__1.infmt = 0;
21717 	ioin__1.inform = 0;
21718 	ioin__1.inunf = 0;
21719 	ioin__1.inrecl = 0;
21720 	ioin__1.innrec = 0;
21721 	ioin__1.inblank = 0;
21722 	f_inqu(&ioin__1);
21723 	if (! fexist) {
21724 	    return 0;
21725 	}
21726 /* Writing concatenation */
21727 	i__2[0] = 28, a__2[0] = "Opening global include file ";
21728 	i__2[1] = lpmxmoddirq, a__2[1] = pmxmoddirq;
21729 	s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)108);
21730 	printl_(ch__3, lpmxmoddirq + 28);
21731 	o__1.oerr = 0;
21732 	o__1.ounit = 18;
21733 	o__1.ofnmlen = lpmxmoddirq;
21734 	o__1.ofnm = pmxmoddirq;
21735 	o__1.orl = 0;
21736 	o__1.osta = 0;
21737 	o__1.oacc = 0;
21738 	o__1.ofm = 0;
21739 	o__1.oblnk = 0;
21740 	f_open(&o__1);
21741     }
21742     printl_("Adding include data", (ftnlen)19);
21743 
21744 /*  Read lines in from pmx.mod one at a time */
21745 
21746     ipbufmod = inbuff_1.ipbuf;
21747     lenbufmod = c1omget_1.lenbuf0;
21748     for (ilbufmod = inbuff_1.ilbuf; ilbufmod <= 4000; ++ilbufmod) {
21749 	i__3 = s_rsfe(&io___831);
21750 	if (i__3 != 0) {
21751 	    goto L3;
21752 	}
21753 	i__3 = do_fio(&c__1, lnholdq, (ftnlen)128);
21754 	if (i__3 != 0) {
21755 	    goto L3;
21756 	}
21757 	i__3 = e_rsfe();
21758 	if (i__3 != 0) {
21759 	    goto L3;
21760 	}
21761 
21762 /*  A line was read. Slide all existing lengths from here forward ahead by 1 */
21763 
21764 	i__3 = ilbufmod;
21765 	for (ilbuff = inbuff_1.nlbuf; ilbuff >= i__3; --ilbuff) {
21766 	    inbuff_1.lbuf[ilbuff] = inbuff_1.lbuf[ilbuff - 1];
21767 /* L2: */
21768 	}
21769 
21770 /*  Get length of line from include file */
21771 
21772 	lenmodline = lenstr_(lnholdq, &c__128, (ftnlen)128);
21773 	if (lenmodline == 0) {
21774 
21775 /*  Blank line.  Make it a single blank with length 1 */
21776 
21777 	    lenmodline = 1;
21778 	    s_copy(lnholdq, " ", (ftnlen)128, (ftnlen)1);
21779 	}
21780 	inbuff_1.lbuf[ilbufmod - 1] = (shortint) lenmodline;
21781 	printl_(lnholdq, lenmodline);
21782 
21783 /*  Insert new stuff into bufq */
21784 
21785 	i__3 = ipbufmod;
21786 /* Writing concatenation */
21787 	i__1[0] = ipbufmod, a__1[0] = inbuff_1.bufq;
21788 	i__1[1] = lenmodline, a__1[1] = lnholdq;
21789 	i__1[2] = lenbufmod - i__3, a__1[2] = inbuff_1.bufq + i__3;
21790 	s_cat(inbuff_1.bufq, a__1, i__1, &c__3, (ftnlen)65536);
21791 
21792 /*  Update internal parameters */
21793 
21794 	ipbufmod += inbuff_1.lbuf[ilbufmod - 1];
21795 	lenbufmod += inbuff_1.lbuf[ilbufmod - 1];
21796 	++inbuff_1.nlbuf;
21797 /* L1: */
21798     }
21799 L3:
21800 /* Writing concatenation */
21801     i__2[0] = 8, a__2[0] = "Closing ";
21802     i__2[1] = lpmxmoddirq, a__2[1] = pmxmoddirq;
21803     s_cat(ch__4, a__2, i__2, &c__2, (ftnlen)88);
21804     printl_(ch__4, lpmxmoddirq + 8);
21805     cl__1.cerr = 0;
21806     cl__1.cunit = 18;
21807     cl__1.csta = 0;
21808     f_clos(&cl__1);
21809     c1omget_1.linesinpmxmod = c1omget_1.linesinpmxmod + ilbufmod -
21810 	    inbuff_1.ilbuf;
21811     c1omget_1.lenbuf0 = lenbufmod;
21812 
21813 /*  Fix Andre's error reporting problem 101211 leading to log(neg#) due */
21814 /*  to nline being 2 bigger than it should be */
21815 
21816     c1omget_1.nline += -2;
21817 
21818     return 0;
21819 } /* getpmxmod_ */
21820 
getset_(integer * nv,integer * noinst,integer * mtrnuml,integer * mtrdenl,integer * mtrnmp,integer * mtrdnp,real * xmtrnum0,integer * npages,integer * nsyst,integer * musicsize,real * fracindent,logical * istype0,char * inameq,char * clefq,char * sepsymq,char * pathnameq,integer * lpath,integer * isig0,ftnlen inameq_len,ftnlen clefq_len,ftnlen sepsymq_len,ftnlen pathnameq_len)21821 /* Subroutine */ int getset_(integer *nv, integer *noinst, integer *mtrnuml,
21822 	integer *mtrdenl, integer *mtrnmp, integer *mtrdnp, real *xmtrnum0,
21823 	integer *npages, integer *nsyst, integer *musicsize, real *fracindent,
21824 	 logical *istype0, char *inameq, char *clefq, char *sepsymq, char *
21825 	pathnameq, integer *lpath, integer *isig0, ftnlen inameq_len, ftnlen
21826 	clefq_len, ftnlen sepsymq_len, ftnlen pathnameq_len)
21827 {
21828     /* System generated locals */
21829     integer i__1, i__2;
21830     real r__1;
21831     olist o__1;
21832 
21833     /* Builtin functions */
21834     integer s_cmp(char *, char *, ftnlen, ftnlen), f_open(olist *), s_wsfe(
21835 	    cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void),
21836 	    i_nint(real *), i_indx(char *, char *, ftnlen, ftnlen);
21837 
21838     /* Local variables */
21839     static integer i__, iv, ivi, nline;
21840     static char lineq[128];
21841     static integer iinst, jinst;
21842     extern doublereal readin_(char *, integer *, integer *, ftnlen);
21843     extern /* Subroutine */ int getbuf_(char *, ftnlen);
21844     static logical newway;
21845     static integer iccount, nvsofar;
21846 
21847     /* Fortran I/O blocks */
21848     static cilist io___837 = { 0, 17, 0, "(a)", 0 };
21849 
21850 
21851 
21852 /*  Get the first line */
21853 
21854     /* Parameter adjustments */
21855     --sepsymq;
21856     --clefq;
21857     inameq -= 79;
21858 
21859     /* Function Body */
21860     iccount = 0;
21861 L9:
21862     getbuf_(lineq, (ftnlen)128);
21863     if (*(unsigned char *)lineq == '%') {
21864 	goto L9;
21865     }
21866     *istype0 = s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) == 0;
21867     if (*istype0) {
21868 
21869 /*  Have TeX input until next line that starts with '---'.  Save in scratch. */
21870 
21871 	o__1.oerr = 0;
21872 	o__1.ounit = 17;
21873 	o__1.ofnm = 0;
21874 	o__1.orl = 0;
21875 	o__1.osta = "SCRATCH";
21876 	o__1.oacc = 0;
21877 	o__1.ofm = 0;
21878 	o__1.oblnk = 0;
21879 	f_open(&o__1);
21880 L3:
21881 	getbuf_(lineq, (ftnlen)128);
21882 	if (s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) != 0) {
21883 	    s_wsfe(&io___837);
21884 	    do_fio(&c__1, lineq, (ftnlen)128);
21885 	    e_wsfe();
21886 	    goto L3;
21887 	}
21888 
21889 /*  Force a new line read on first call to readin */
21890 
21891 	iccount = 128;
21892     }
21893 
21894 /*  Here, lineq is first line w/ numerical setup data. */
21895 
21896     r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
21897     *nv = i_nint(&r__1);
21898     r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
21899     *noinst = i_nint(&r__1);
21900     newway = *noinst <= 0;
21901     if (newway) {
21902 	*noinst = -(*noinst);
21903     }
21904     i__1 = *noinst;
21905     for (iinst = 1; iinst <= i__1; ++iinst) {
21906 
21907 /*  Seve # of staves per inst in case later drop some inst's. */
21908 
21909 	if (newway) {
21910 
21911 /*  Read in nvi for each instrument */
21912 
21913 	    r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
21914 	    comnvi_1.nsperi[iinst - 1] = i_nint(&r__1);
21915 	} else if (iinst > 1) {
21916 	    comnvi_1.nsperi[iinst - 1] = 1;
21917 	} else {
21918 	    comnvi_1.nsperi[iinst - 1] = *nv - *noinst + 1;
21919 	}
21920 	comnvi_1.iiorig[iinst - 1] = iinst;
21921 	comnvi_1.nspern[iinst - 1] = comnvi_1.nsperi[iinst - 1];
21922 /* L2: */
21923     }
21924     r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
21925     *mtrnuml = i_nint(&r__1);
21926     r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
21927     *mtrdenl = i_nint(&r__1);
21928 /* c */
21929 /* c  Kluge to make mtrdenl work */
21930 /* c */
21931 /*      if (mtrdenl .eq. 1) then */
21932 /*        mtrdenl = 2 */
21933 /*        mtrnuml = mtrnuml*2 */
21934 /*      end if */
21935     r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
21936     *mtrnmp = i_nint(&r__1);
21937     r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
21938     *mtrdnp = i_nint(&r__1);
21939     *xmtrnum0 = readin_(lineq, &iccount, &nline, (ftnlen)128);
21940 
21941 /*  Original key sig (before any trnasposition) in next position.  Transposed */
21942 /*  sig for topfile was transferred thru pmxtex.dat.  Need isig0 for key */
21943 /*  changes if transposed. */
21944 
21945     r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
21946     *isig0 = i_nint(&r__1);
21947 /* 130316 */
21948 /*      do 11 iinst = 1 , noinst */
21949 /*        midisig(iinst) = isig0 */
21950     commidisig_1.midisig = *isig0;
21951 /* 11    continue */
21952     r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
21953     *npages = i_nint(&r__1);
21954     r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
21955     *nsyst = i_nint(&r__1);
21956     r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
21957     *musicsize = i_nint(&r__1);
21958     *fracindent = readin_(lineq, &iccount, &nline, (ftnlen)128);
21959 
21960 /*  Next noinst non-comment lines are names of instruments. */
21961 
21962     i__1 = *noinst;
21963     for (i__ = 1; i__ <= i__1; ++i__) {
21964 L5:
21965 	getbuf_(inameq + i__ * 79, (ftnlen)79);
21966 	if (*(unsigned char *)&inameq[i__ * 79] == '%') {
21967 	    goto L5;
21968 	}
21969 /* L4: */
21970     }
21971 
21972 /*  Mext non-comment line has nv clef names */
21973 
21974 L6:
21975     getbuf_(lineq, (ftnlen)128);
21976     if (*(unsigned char *)lineq == '%') {
21977 	goto L6;
21978     }
21979     iv = 0;
21980     nvsofar = 0;
21981     i__1 = *noinst;
21982     for (jinst = 1; jinst <= i__1; ++jinst) {
21983 	nvsofar += comnvi_1.nsperi[jinst - 1];
21984 	i__2 = comnvi_1.nsperi[jinst - 1];
21985 	for (ivi = 1; ivi <= i__2; ++ivi) {
21986 	    ++iv;
21987 	    *(unsigned char *)&clefq[iv] = *(unsigned char *)&lineq[iv - 1];
21988 	    if (iv == nvsofar) {
21989 		*(unsigned char *)&sepsymq[iv] = '&';
21990 	    } else {
21991 		*(unsigned char *)&sepsymq[iv] = '|';
21992 	    }
21993 /* L10: */
21994 	}
21995 /* L1: */
21996     }
21997 
21998 /*  Mext non-comment line has path name */
21999 
22000 L8:
22001     getbuf_(pathnameq, (ftnlen)40);
22002     if (*(unsigned char *)pathnameq == '%') {
22003 	goto L8;
22004     }
22005     *lpath = i_indx(pathnameq, " ", (ftnlen)40, (ftnlen)1) - 1;
22006     return 0;
22007 } /* getset_ */
22008 
getsquez_(integer * n,integer * ntot,real * space,real * tnote,real * to)22009 doublereal getsquez_(integer *n, integer *ntot, real *space, real *tnote,
22010 	real *to)
22011 {
22012     /* System generated locals */
22013     integer i__1;
22014     real ret_val, r__1, r__2;
22015 
22016     /* Local variables */
22017     static integer in;
22018     static real tend, tgovern;
22019 
22020 
22021 /*  Get the squez factor by checking space against tgovern=minimum duration */
22022 /*    of all notes sounding at time of n-th note in the list. */
22023 /*  The starting time of base increment is to(n) and ending time is to(n)+space */
22024 /*  Sounding notes are those that start at or before to(n) .and. end at or */
22025 /*    after tend=to(n)+space */
22026 /*  Since notes are ordered by increasing start times, as soon as we find one */
22027 /*    that starts too late, we are done checking. */
22028 
22029     /* Parameter adjustments */
22030     --to;
22031     --tnote;
22032 
22033     /* Function Body */
22034     tgovern = 1e3f;
22035     tend = to[*n] + *space;
22036     i__1 = *ntot;
22037     for (in = 1; in <= i__1; ++in) {
22038 
22039 /*  Since to() is ordered by start times, exit loop after first note that */
22040 /*    starts later than note of interest. */
22041 
22042 	if (to[in] > to[*n] + comtol_1.tol) {
22043 	    goto L2;
22044 	}
22045 	if (to[in] + tnote[in] > tend - comtol_1.tol) {
22046 
22047 /*  If here, this note overlaps and must be tested. */
22048 
22049 /* Computing MIN */
22050 	    r__1 = tgovern, r__2 = tnote[in];
22051 	    tgovern = dmin(r__1,r__2);
22052 	}
22053 /* L1: */
22054     }
22055 L2:
22056     ret_val = *space / tgovern;
22057     return ret_val;
22058 } /* getsquez_ */
22059 
getx_(char * lineq,integer * iccount,integer * irest,logical * shifton,real * wheadpt,integer * iornq1,integer * ivx,integer * irest1,integer * itsofar,integer * ntup,integer * itup,integer * nnodur,char * dotq,integer * ndoub,ftnlen lineq_len,ftnlen dotq_len)22060 /* Subroutine */ int getx_(char *lineq, integer *iccount, integer *irest,
22061 	logical *shifton, real *wheadpt, integer *iornq1, integer *ivx,
22062 	integer *irest1, integer *itsofar, integer *ntup, integer *itup,
22063 	integer *nnodur, char *dotq, integer *ndoub, ftnlen lineq_len, ftnlen
22064 	dotq_len)
22065 {
22066     /* Builtin functions */
22067     integer i_indx(char *, char *, ftnlen, ftnlen);
22068 
22069     /* Local variables */
22070     static logical ess;
22071     static real fnum;
22072     static char durq[1], charq[1];
22073     static logical colon, number;
22074     static integer nextbl;
22075     extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen,
22076 	    ftnlen), readnum_(char *, integer *, char *, real *, ftnlen,
22077 	    ftnlen);
22078     extern integer ifnodur_(integer *, char *, ftnlen);
22079 
22080 
22081 /*  Parse "X" commands.  Ignore all "B"; "P" means to ignore whole symbol. */
22082 /*  In scor2prt, must strip out "P", copy only "B" and "P"-type "X"-symbols. */
22083 /*  Since during getnote phase time is integer itsofar, which is not updated */
22084 /*    during xtups, we use itup and ntup to get actual time.  On entry, ntup=0 if */
22085 /*    not in xtup. */
22086 
22087     colon = FALSE_;
22088     ess = FALSE_;
22089     number = FALSE_;
22090     nextbl = *iccount + i_indx(lineq + (*iccount - 1), " ", 128 - (*iccount -
22091 	    1), (ftnlen)1) - 1;
22092     if (i_indx(lineq + (*iccount - 1), "P", nextbl - (*iccount - 1), (ftnlen)
22093 	    1) > 0) {
22094 
22095 /*  "Parts only", ignore entire symbol */
22096 
22097 	*iccount = nextbl;
22098 	return 0;
22099     }
22100 L1:
22101     getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
22102     if (*(unsigned char *)charq == 'B') {
22103 
22104 /*  "Both parts and score," ignore character */
22105 
22106 	goto L1;
22107     } else if (*(unsigned char *)charq == ':') {
22108 	colon = TRUE_;
22109 	goto L1;
22110     } else if (*(unsigned char *)charq == 'S') {
22111 	ess = TRUE_;
22112 	goto L1;
22113     } else if (i_indx("+-.0123456789", charq, (ftnlen)13, (ftnlen)1) > 0) {
22114 	number = TRUE_;
22115 	if (*(unsigned char *)charq == '-') {
22116 	    ++(*iccount);
22117 	}
22118 	readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
22119 	if (*(unsigned char *)charq == '-') {
22120 	    fnum = -fnum;
22121 	}
22122 	if (*(unsigned char *)durq != 'p') {
22123 	    fnum *= *wheadpt;
22124 	    --(*iccount);
22125 	}
22126 	goto L1;
22127     }
22128 
22129 /*  charq must be blank, so done parsing */
22130 
22131     if (! ess && ! colon) {
22132 
22133 /*  Ordinary hardspace.  Goes before next note. */
22134 /*   (Later, at "|" or "/", check for presence and switch to udoff if there!) */
22135 
22136 	++comudsp_1.nudsp;
22137 	*iornq1 = bit_set(*iornq1,26);
22138 	comudsp_1.udsp[comudsp_1.nudsp - 1] = fnum;
22139 	comudsp_1.tudsp[comudsp_1.nudsp - 1] = (real) (*itsofar);
22140 	if (*ntup > 0) {
22141 	    comudsp_1.tudsp[comudsp_1.nudsp - 1] += (real) (*itup - 1 + *
22142 		    ndoub) / *ntup * ifnodur_(nnodur, dotq, (ftnlen)1);
22143 	}
22144 /*     *                       +float(itup-1)/ntup*ifnodur(nnodur,dotq) */
22145     } else if (! number) {
22146 
22147 /*  Must be "X:"  End a group offset. */
22148 
22149 	*irest = bit_set(*irest,17);
22150 	*shifton = FALSE_;
22151 	return 0;
22152     } else {
22153 
22154 /*  Only other possibility is start offset, "S" for single, ':' for multiple */
22155 
22156 	++comudsp_1.nudoff[*ivx - 1];
22157 	comudsp_1.udoff[*ivx + comudsp_1.nudoff[*ivx - 1] * 24 - 25] = fnum;
22158 	if (ess) {
22159 	    *irest1 = bit_set(*irest1,15);
22160 	} else {
22161 	    *irest1 = bit_set(*irest1,16);
22162 	    *shifton = TRUE_;
22163 	}
22164     }
22165     return 0;
22166 } /* getx_ */
22167 
i1fnodur_(integer * idur,char * dotq,ftnlen dotq_len)22168 integer i1fnodur_(integer *idur, char *dotq, ftnlen dotq_len)
22169 {
22170     /* System generated locals */
22171     integer ret_val;
22172 
22173     /* Builtin functions */
22174     integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char
22175 	    *, ftnlen);
22176 
22177     /* Local variables */
22178     extern /* Subroutine */ int stop1_(void);
22179 
22180     /* Fortran I/O blocks */
22181     static cilist io___856 = { 0, 6, 0, 0, 0 };
22182     static cilist io___857 = { 0, 6, 0, 0, 0 };
22183 
22184 
22185     if (*idur == 6) {
22186 	ret_val = 1;
22187     } else if (*idur == 3) {
22188 	ret_val = 2;
22189     } else if (*idur == 1) {
22190 	ret_val = 4;
22191     } else if (*idur == 8) {
22192 	ret_val = 8;
22193     } else if (*idur == 4) {
22194 	ret_val = 16;
22195     } else if (*idur == 2) {
22196 	ret_val = 32;
22197     } else if (*idur == 0) {
22198 	ret_val = 64;
22199     } else if (*idur == 16) {
22200 
22201 /*  Only used for denominator of time signatures, not for notes */
22202 
22203 	ret_val = 4;
22204     } else if (*idur == 9) {
22205 	ret_val = 128;
22206     } else {
22207 	s_wsle(&io___856);
22208 	e_wsle();
22209 	s_wsle(&io___857);
22210 	do_lio(&c__9, &c__1, "You entered an invalid note-length value:", (
22211 		ftnlen)41);
22212 	do_lio(&c__3, &c__1, (char *)&(*idur), (ftnlen)sizeof(integer));
22213 	e_wsle();
22214 	stop1_();
22215     }
22216     if (*(unsigned char *)dotq == 'd') {
22217 	ret_val = ret_val * 3 / 2;
22218     }
22219     return ret_val;
22220 } /* i1fnodur_ */
22221 
22222 /*      integer*4 function longi(ishort) */
22223 /*      integer*2 ishort */
22224 /*      longi = ishort */
22225 /*      return */
22226 /*      end */
iashft_(integer * nacc)22227 integer iashft_(integer *nacc)
22228 {
22229     /* Initialized data */
22230 
22231     static integer ias[6] = { -1,1,0,0,-2,2 };
22232 
22233     /* System generated locals */
22234     integer ret_val;
22235 
22236     ret_val = ias[(0 + (0 + (*nacc - 1 << 2))) / 4];
22237     return ret_val;
22238 } /* iashft_ */
22239 
ifnodur_(integer * idur,char * dotq,ftnlen dotq_len)22240 integer ifnodur_(integer *idur, char *dotq, ftnlen dotq_len)
22241 {
22242     /* System generated locals */
22243     integer ret_val;
22244 
22245     /* Builtin functions */
22246     integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
22247 	    e_wsle(void);
22248     /* Subroutine */ int s_stop(char *, ftnlen);
22249 
22250     /* Fortran I/O blocks */
22251     static cilist io___859 = { 0, 6, 0, 0, 0 };
22252 
22253 
22254     if (*idur == 6) {
22255 	ret_val = 1;
22256     } else if (*idur == 3) {
22257 	ret_val = 2;
22258     } else if (*idur == 1) {
22259 	ret_val = 4;
22260     } else if (*idur == 8) {
22261 	ret_val = 8;
22262     } else if (*idur == 4) {
22263 	ret_val = 16;
22264     } else if (*idur == 2) {
22265 	ret_val = 32;
22266     } else if (*idur == 0) {
22267 	ret_val = 64;
22268     } else if (*idur == 9) {
22269 	ret_val = 128;
22270     } else if (*idur == 16) {
22271 
22272 /*  Only used for denominator of time signatures, not for notes */
22273 
22274 	ret_val = 4;
22275     } else {
22276 	s_wsle(&io___859);
22277 	do_lio(&c__9, &c__1, "You entered an invalid note value", (ftnlen)33);
22278 	e_wsle();
22279 	s_stop("", (ftnlen)0);
22280     }
22281     if (*(unsigned char *)dotq == 'd') {
22282 	ret_val = ret_val * 3 / 2;
22283     }
22284     return ret_val;
22285 } /* ifnodur_ */
22286 
ifnolev_(char * noq,integer * oct,integer * ntrans,ftnlen noq_len)22287 integer ifnolev_(char *noq, integer *oct, integer *ntrans, ftnlen noq_len)
22288 {
22289     /* System generated locals */
22290     integer ret_val;
22291 
22292     ret_val = *oct * 7 + (*(unsigned char *)noq - 92) % 7 + 1 + *ntrans;
22293     return ret_val;
22294 } /* ifnolev_ */
22295 
22296 /*      subroutine report(nsdat,isdat1,isdat2) */
22297 /*      integer*4 isdat1(202),isdat2(202) */
22298 /*      write(*,'(a)') */
22299 /*     *  ' isd on? iv  kv   ip  id ud1 ud2 ndx ivo iho lev crd lhd rhd' */
22300 /*      do 1 isdat = 1 , nsdat */
22301 /*        isdata = isdat1(isdat) */
22302 /*        ionoff = igetbits(isdata,1,11) */
22303 /* c        iv = iand(7,isdata) */
22304 /*        iv = igetbits(isdata,5,13) */
22305 /*        kv = igetbits(isdata,1,12)+1 */
22306 /*        ip = igetbits(isdata,8,3) */
22307 /*        idcode = igetbits(isdata,7,19) */
22308 /*        iud1 = igetbits(isdata,1,26) */
22309 /*        iud2 = igetbits(isdata,1,27) */
22310 /*        ndxslur = igetbits(isdata,4,28) */
22311 /*        isdatb = isdat2(isdat) */
22312 /*        ivo = igetbits(isdatb,6,6)-32 */
22313 /*        iho = igetbits(isdatb,7,12)-64 */
22314 /*        lev = igetbits(isdatb,7,19) */
22315 /*        icrd = igetbits(isdatb,1,0) */
22316 /*        lhd = igetbits(isdatb,1,1) */
22317 /*        irhd = igetbits(isdatb,7,2) */
22318 /*        write(*,'(17i4)')isdat,ionoff,iv,kv,ip,idcode,iud1,iud2,ndxslur, */
22319 /*     *                     ivo,iho,lev,icrd,lhd,irhd */
22320 /* 1     continue */
22321 /*      print* */
22322 /*      return */
22323 /*      end */
igetbits_(integer * isdata,integer * iwidbit,integer * ishift)22324 integer igetbits_(integer *isdata, integer *iwidbit, integer *ishift)
22325 {
22326     /* System generated locals */
22327     integer ret_val;
22328 
22329     /* Builtin functions */
22330     integer pow_ii(integer *, integer *), lbit_shift(integer, integer);
22331 
22332 
22333 /*  Extracts integer given by iwidbit bits of isdata, shifted by ishift, and */
22334 /*  then added to ioff */
22335 
22336     ret_val = pow_ii(&c__2, iwidbit) - 1 & lbit_shift(*isdata, -(*ishift));
22337     return ret_val;
22338 } /* igetbits_ */
22339 
igetvarlen_(shortint * mmidi,integer * icm,integer * imidi,integer * nbytes)22340 integer igetvarlen_(shortint *mmidi, integer *icm, integer *imidi, integer *
22341 	nbytes)
22342 {
22343     /* System generated locals */
22344     integer ret_val;
22345 
22346     /* Builtin functions */
22347     integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
22348 	    e_wsle(void);
22349 
22350     /* Local variables */
22351     extern /* Subroutine */ int stop1_(void);
22352 
22353     /* Fortran I/O blocks */
22354     static cilist io___860 = { 0, 6, 0, 0, 0 };
22355 
22356 
22357 
22358 /*  Gets variable-length integer starting in mmidi at imidi+1. Returns nbytes. */
22359 
22360     /* Parameter adjustments */
22361     mmidi -= 25;
22362 
22363     /* Function Body */
22364     ret_val = 0;
22365     for (*nbytes = 1; *nbytes <= 4; ++(*nbytes)) {
22366 	ret_val = (ret_val << 7) + (127 & mmidi[*icm + (*imidi + *nbytes) *
22367 		25]);
22368 /*     *               +iand(127,longi(mmidi(icm,imidi+nbytes))) */
22369 	if (! bit_test(mmidi[*icm + (*imidi + *nbytes) * 25],7)) {
22370 	    return ret_val;
22371 	}
22372 /*        if (.not.btest(longi(mmidi(icm,imidi+nbytes)),7)) return */
22373 /* L1: */
22374     }
22375     s_wsle(&io___860);
22376     do_lio(&c__9, &c__1, "Messup in igetvarlen", (ftnlen)20);
22377     e_wsle();
22378     stop1_();
22379     return ret_val;
22380 } /* igetvarlen_ */
22381 
isdotted_(integer * nodur,integer * ivx,integer * ip)22382 logical isdotted_(integer *nodur, integer *ivx, integer *ip)
22383 {
22384     /* System generated locals */
22385     real r__1;
22386     logical ret_val;
22387 
22388     /* Builtin functions */
22389     double log(doublereal), r_mod(real *, real *);
22390 
22391 
22392 /*  Function returns true if note is dotted or double-dotted. */
22393 /*    Return false for any xtuplet. */
22394 
22395     /* Parameter adjustments */
22396     nodur -= 25;
22397 
22398     /* Function Body */
22399     if (nodur[*ivx + *ip * 24] == 0) {
22400 	ret_val = FALSE_;
22401 	return ret_val;
22402     } else if (*ip > 1) {
22403 	if (nodur[*ivx + (*ip - 1) * 24] == 0) {
22404 	    ret_val = FALSE_;
22405 	    return ret_val;
22406 	}
22407     }
22408 
22409 /*  Ruled out all xtups, so is dotted or double-dotted if not a power of 2. */
22410 
22411     r__1 = log((real) nodur[*ivx + *ip * 24]) / .69314718f + comtol_1.tol *
22412 	    .5f;
22413     ret_val = r_mod(&r__1, &c_b807) > comtol_1.tol;
22414     return ret_val;
22415 } /* isdotted_ */
22416 
isetvarlen_(integer * idur,integer * nbytes)22417 integer isetvarlen_(integer *idur, integer *nbytes)
22418 {
22419     /* System generated locals */
22420     integer ret_val, i__1;
22421 
22422     /* Builtin functions */
22423     integer pow_ii(integer *, integer *), lbit_shift(integer, integer),
22424 	    s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
22425 	    e_wsle(void);
22426 
22427     /* Local variables */
22428     extern /* Subroutine */ int stop1_(void);
22429     static integer itemp;
22430 
22431     /* Fortran I/O blocks */
22432     static cilist io___862 = { 0, 6, 0, 0, 0 };
22433 
22434 
22435     ret_val = 0;
22436     itemp = *idur;
22437     for (*nbytes = 1; *nbytes <= 4; ++(*nbytes)) {
22438 	i__1 = *nbytes - 1;
22439 	ret_val += (itemp & 127) * pow_ii(&c__256, &i__1);
22440 	itemp = lbit_shift(itemp, (ftnlen)-7);
22441 	if (itemp > 0) {
22442 	    i__1 = (*nbytes << 3) + 7;
22443 	    ret_val += pow_ii(&c__2, &i__1);
22444 	} else {
22445 	    return ret_val;
22446 	}
22447 /* L1: */
22448     }
22449     s_wsle(&io___862);
22450     do_lio(&c__9, &c__1, "Problem in function isetvarlen", (ftnlen)30);
22451     e_wsle();
22452     stop1_();
22453     return ret_val;
22454 } /* isetvarlen_ */
22455 
istring_(integer * i__,char * string,integer * len,ftnlen string_len)22456 /* Subroutine */ int istring_(integer *i__, char *string, integer *len,
22457 	ftnlen string_len)
22458 {
22459     /* System generated locals */
22460     address a__1[3], a__2[2];
22461     integer i__1[3], i__2[2];
22462     real r__1;
22463     char ch__1[1], ch__2[4];
22464     icilist ici__1;
22465 
22466     /* Builtin functions */
22467     double r_lg10(real *);
22468     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
22469 	     char **, integer *, integer *, ftnlen);
22470     integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
22471 	    ;
22472 
22473 
22474 /*  Returns string with integer only if length is 1, otherwise enclosed in */
22475 /*   brackets. */
22476 
22477     if (*i__ != 0) {
22478 	r__1 = abs(*i__) * 1.0001f;
22479 	*len = r_lg10(&r__1) + 1;
22480 	if (*i__ < 0) {
22481 	    ++(*len);
22482 	}
22483     } else {
22484 	s_copy(string, "0", string_len, (ftnlen)1);
22485 	*len = 1;
22486 	return 0;
22487     }
22488     if (*len == 1) {
22489 	*(unsigned char *)&ch__1[0] = *i__ + 48;
22490 	s_copy(string, ch__1, string_len, (ftnlen)1);
22491     } else {
22492 	s_copy(string, "{", string_len, (ftnlen)1);
22493 	ici__1.icierr = 0;
22494 	ici__1.icirnum = 1;
22495 	ici__1.icirlen = *len;
22496 	ici__1.iciunit = string + 1;
22497 /* Writing concatenation */
22498 	i__1[0] = 2, a__1[0] = "(i";
22499 	*(unsigned char *)&ch__1[0] = *len + 48;
22500 	i__1[1] = 1, a__1[1] = ch__1;
22501 	i__1[2] = 1, a__1[2] = ")";
22502 	ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)4), ch__2);
22503 	s_wsfi(&ici__1);
22504 	do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer));
22505 	e_wsfi();
22506 /* Writing concatenation */
22507 	i__2[0] = *len + 1, a__2[0] = string;
22508 	i__2[1] = 1, a__2[1] = "}";
22509 	s_cat(string, a__2, i__2, &c__2, string_len);
22510 	*len += 2;
22511     }
22512     return 0;
22513 } /* istring_ */
22514 
lenstr_(char * string,integer * n,ftnlen string_len)22515 integer lenstr_(char *string, integer *n, ftnlen string_len)
22516 {
22517     /* System generated locals */
22518     integer ret_val;
22519 
22520     for (ret_val = *n; ret_val >= 1; --ret_val) {
22521 	if (*(unsigned char *)&string[ret_val - 1] != ' ') {
22522 	    return ret_val;
22523 	}
22524 /* L1: */
22525     }
22526     ret_val = 0;
22527     return ret_val;
22528 } /* lenstr_ */
22529 
levrn_(integer * nolev,integer * irest,integer * iud,integer * ncm,integer * mult)22530 integer levrn_(integer *nolev, integer *irest, integer *iud, integer *ncm,
22531 	integer *mult)
22532 {
22533     /* System generated locals */
22534     integer ret_val;
22535 
22536     /* Local variables */
22537     static integer ioff;
22538 
22539 
22540 /*  Used for placing numbers in xtups.  Returns note level if not a rest, */
22541 /*  else level of top or bottom of rest symbol opposite beam.  iud=-1 for upstm. */
22542 
22543     if (! bit_test(*irest,0)) {
22544 	ret_val = *nolev;
22545     } else {
22546 
22547 /*  Restlevel is -4, 0, 2 or 100+offset.  First get offset from 1-voice default. */
22548 
22549 	if (*mult > 0) {
22550 	    if (*mult == 2) {
22551 		ioff = (*iud << 1) - 1;
22552 	    } else if (*mult != 4) {
22553 		ioff = *iud * *mult;
22554 	    } else {
22555 		ioff = (*iud << 2) + 1;
22556 	    }
22557 	} else {
22558 
22559 /*  May need to futz with this later for non-beamed xtups (quarter, half rests) */
22560 
22561 	    ioff = *iud << 1;
22562 	}
22563 	ret_val = (*nolev + 20) % 100 - 20 + *ncm + ioff;
22564     }
22565     return ret_val;
22566 } /* levrn_ */
22567 
lfmt1_(real * x)22568 integer lfmt1_(real *x)
22569 {
22570     /* System generated locals */
22571     integer ret_val;
22572     real r__1;
22573 
22574     /* Builtin functions */
22575     double r_sign(real *, real *), r_lg10(real *);
22576 
22577     /* Local variables */
22578     static real y;
22579 
22580 
22581 /*  Computes total length of an "f" format with one decimal place. */
22582 /*  First round to nearest 0.1 */
22583 
22584     if (dabs(*x) < .001f) {
22585 	ret_val = 2;
22586     } else {
22587 	r__1 = (integer) (dabs(*x) * 10 + .5f) * .1f;
22588 	y = r_sign(&r__1, x);
22589 	r__1 = dabs(y) * 1000 + .001f;
22590 	ret_val = (integer) r_lg10(&r__1);
22591 	if (y < 0.f) {
22592 	    ++ret_val;
22593 	}
22594     }
22595     return ret_val;
22596 } /* lfmt1_ */
22597 
linebreakties_(integer * isdat1,integer * isdat2,integer * isdat3,integer * isdat4,integer * nsdat,logical * ispstie,char * sepsymq,ftnlen sepsymq_len)22598 /* Subroutine */ int linebreakties_(integer *isdat1, integer *isdat2, integer
22599 	*isdat3, integer *isdat4, integer *nsdat, logical *ispstie, char *
22600 	sepsymq, ftnlen sepsymq_len)
22601 {
22602     /* System generated locals */
22603     address a__1[2], a__2[3], a__3[5], a__4[4];
22604     integer i__1, i__2[2], i__3[3], i__4[5], i__5[4];
22605     real r__1;
22606     char ch__1[1], ch__2[1];
22607 
22608     /* Builtin functions */
22609     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
22610     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
22611 
22612     /* Local variables */
22613     extern integer igetbits_(integer *, integer *, integer *);
22614     extern /* Subroutine */ int writflot_(real *, char *, integer *, ftnlen);
22615     static integer iv, kv, ncm;
22616     static logical tie;
22617     static integer iiv;
22618     static char udq[1];
22619     static integer ndx, ilb12;
22620     static real hoff;
22621     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
22622     static integer imid, ihoff, isdat, ivoff, lnote;
22623     static char noteq[8];
22624     static integer idcode, islhgt;
22625     extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer
22626 	    *, ftnlen);
22627     static integer lnoten;
22628     static char notexq[128];
22629 
22630     /* Fortran I/O blocks */
22631     static cilist io___884 = { 0, 11, 0, "(a)", 0 };
22632 
22633 
22634 
22635 /*  This is called twice from pmxb after having input an entire block, before */
22636 /*    making a bar that starts a new system.  So nsdat reflects all slur starts */
22637 /*    and stops in new block, while listslur, which is only set when bars are */
22638 /*    made, reflects only open slurs from the old block.  So we must check */
22639 /*    listslur to find open ties, not all nsdat. */
22640 /*  First of two calls (ispstie=.false. on entry) terminates tie at end of line. */
22641 /*    Second (ispstie=.true. on entry) restarts tie at start of new line. Only */
22642 /*    need data from original tie-start for both of these. Tie/slur data from */
22643 /*    closing of full tie are not used except for shape alterations. */
22644 
22645 /*      do 1 ndx = 0 , 11 */
22646     /* Parameter adjustments */
22647     --sepsymq;
22648     --isdat4;
22649     --isdat3;
22650     --isdat2;
22651     --isdat1;
22652 
22653     /* Function Body */
22654     for (ndx = 0; ndx <= 23; ++ndx) {
22655 	if (bit_test(comslur_1.listslur,ndx)) {
22656 
22657 /*  Slur or tie with index ndx is open. Find the one with right ndxb, see if tie */
22658 
22659 	    i__1 = *nsdat;
22660 	    for (isdat = 1; isdat <= i__1; ++isdat) {
22661 /*            if (igetbits(isdat1(isdat),4,28) .ne. ndx) go to 2 ! Wrong index */
22662 		if (igetbits_(&isdat1[isdat], &c__4, &c__28) + (igetbits_(&
22663 			isdat1[isdat], &c__1, &c__18) << 4) != ndx) {
22664 		    goto L2;
22665 		}
22666 /* Wron */
22667 		if (! bit_test(isdat1[isdat],11)) {
22668 		    goto L2;
22669 		}
22670 /* Bypass if stop */
22671 		if (bit_test(isdat2[isdat],3)) {
22672 		    goto L3;
22673 		}
22674 /* "st" */
22675 		idcode = igetbits_(&isdat1[isdat], &c__7, &c__19);
22676 		if (idcode == 1) {
22677 		    goto L3;
22678 		}
22679 /* "t" */
22680 		tie = FALSE_;
22681 		goto L5;
22682 L2:
22683 		;
22684 	    }
22685 	}
22686 	goto L1;
22687 L3:
22688 	tie = TRUE_;
22689 L5:
22690 
22691 /*  A slur or tie is open, with index ndx */
22692 
22693 	iv = igetbits_(&isdat1[isdat], &c__5, &c__13);
22694 	kv = igetbits_(&isdat1[isdat], &c__1, &c__12) + 1;
22695 	*(unsigned char *)udq = 'd';
22696 	if (bit_test(isdat1[isdat],27)) {
22697 	    *(unsigned char *)udq = 'u';
22698 	}
22699 /* Writing concatenation */
22700 	chax_(ch__1, (ftnlen)1, &c__92);
22701 	i__2[0] = 1, a__1[0] = ch__1;
22702 	i__2[1] = 6, a__1[1] = "znotes";
22703 	s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
22704 	lnote = 7;
22705 	i__1 = iv - 1;
22706 	for (iiv = 1; iiv <= i__1; ++iiv) {
22707 /* Writing concatenation */
22708 	    i__2[0] = lnote, a__1[0] = notexq;
22709 	    i__2[1] = 1, a__1[1] = sepsymq + iiv;
22710 	    s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
22711 	    ++lnote;
22712 /* L4: */
22713 	}
22714 	if (kv == 2) {
22715 /* Writing concatenation */
22716 	    i__3[0] = lnote, a__2[0] = notexq;
22717 	    chax_(ch__1, (ftnlen)1, &c__92);
22718 	    i__3[1] = 1, a__2[1] = ch__1;
22719 	    i__3[2] = 9, a__2[2] = "nextvoice";
22720 	    s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128);
22721 	    lnote += 10;
22722 	}
22723 
22724 /*  Compute horiz and vert offsets */
22725 
22726 /*        nolev = igetbits(isdat2(isdat),7,19) */
22727 	islhgt = igetbits_(&isdat3[isdat], &c__8, &c__14);
22728 	ilb12 = 0;
22729 	if (*ispstie) {
22730 	    ilb12 = 1;
22731 	}
22732 	i__1 = ilb12 << 4;
22733 	ivoff = igetbits_(&isdat4[isdat], &c__6, &i__1) - 32;
22734 	if (ivoff == -32) {
22735 	    ivoff = 0;
22736 	}
22737 /*        nolev = nolev+ivoff */
22738 	islhgt += ivoff;
22739 	i__1 = (ilb12 << 4) + 6;
22740 	ihoff = igetbits_(&isdat4[isdat], &c__7, &i__1) - 64;
22741 /* This is 10X */
22742 	if (ihoff == -64) {
22743 	    ihoff = 0;
22744 	}
22745 
22746 /*  Add starting stuff for command */
22747 
22748 	if (! (*ispstie)) {
22749 /* End 1st segment */
22750 /* Writing concatenation */
22751 	    i__3[0] = lnote, a__2[0] = notexq;
22752 	    chax_(ch__1, (ftnlen)1, &c__92);
22753 	    i__3[1] = 1, a__2[1] = ch__1;
22754 	    i__3[2] = 8, a__2[2] = "roffset{";
22755 	    s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128);
22756 	    lnote += 9;
22757 /*          hoff = ihoff*.1-.5 */
22758 /*          hoff = ihoff*.1-.8 */
22759 	    hoff = ihoff * .1f - .4f;
22760 	    if (hoff < 0.f) {
22761 		hoff = -hoff;
22762 /* Writing concatenation */
22763 		i__2[0] = lnote, a__1[0] = notexq;
22764 		i__2[1] = 1, a__1[1] = "-";
22765 		s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
22766 		++lnote;
22767 	    }
22768 	    writflot_(&hoff, notexq, &lnote, (ftnlen)128);
22769 /* Writing concatenation */
22770 	    i__2[0] = lnote, a__1[0] = notexq;
22771 	    i__2[1] = 2, a__1[1] = "}{";
22772 	    s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
22773 	    lnote += 2;
22774 	} else {
22775 /* Writing concatenation */
22776 	    i__4[0] = lnote, a__3[0] = notexq;
22777 	    chax_(ch__1, (ftnlen)1, &c__92);
22778 	    i__4[1] = 1, a__3[1] = ch__1;
22779 	    i__4[2] = 5, a__3[2] = "off{-";
22780 	    chax_(ch__2, (ftnlen)1, &c__92);
22781 	    i__4[3] = 1, a__3[3] = ch__2;
22782 	    i__4[4] = 14, a__3[4] = "afterruleskip}";
22783 	    s_cat(notexq, a__3, i__4, &c__5, (ftnlen)128);
22784 	    lnote += 21;
22785 
22786 /* 091025 add dotting for 2nd segment if needed */
22787 
22788 	    if (bit_test(isdat2[isdat],4)) {
22789 /* Writing concatenation */
22790 		chax_(ch__1, (ftnlen)1, &c__92);
22791 		i__3[0] = 1, a__2[0] = ch__1;
22792 		i__3[1] = 6, a__2[1] = "dotted";
22793 		i__3[2] = lnote, a__2[2] = notexq;
22794 		s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128);
22795 		lnote += 7;
22796 	    }
22797 	}
22798 	if (*ispstie && tie) {
22799 /* Writing concatenation */
22800 	    i__5[0] = lnote, a__4[0] = notexq;
22801 	    chax_(ch__1, (ftnlen)1, &c__92);
22802 	    i__5[1] = 1, a__4[1] = ch__1;
22803 	    i__5[2] = 8, a__4[2] = "tieforis";
22804 	    i__5[3] = 1, a__4[3] = udq;
22805 	    s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128);
22806 	    lnote += 10;
22807 	}
22808 	if (bit_test(isdat3[isdat],0)) {
22809 
22810 /*  Curvature tweak on termination of 1st seg */
22811 
22812 	    imid = igetbits_(&isdat3[isdat], &c__6, &c__2) - 32;
22813 
22814 /*  Invoke macro (from pmx.tex) that redefines \tslur as r'qd.  mapping: */
22815 /*       Abs(imid)  Postscript slur type */
22816 /*          1          f */
22817 /*          4          h */
22818 /*          5          H */
22819 /*          6         HH */
22820 
22821 /* Writing concatenation */
22822 	    i__5[0] = lnote, a__4[0] = notexq;
22823 	    chax_(ch__1, (ftnlen)1, &c__92);
22824 	    i__5[1] = 1, a__4[1] = ch__1;
22825 	    i__5[2] = 7, a__4[2] = "psforts";
22826 	    i__1 = imid + 48;
22827 	    chax_(ch__2, (ftnlen)1, &i__1);
22828 	    i__5[3] = 1, a__4[3] = ch__2;
22829 	    s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128);
22830 	    lnote += 9;
22831 
22832 /*  Zero out the flag in case there's a different curv on term of 2nd, */
22833 
22834 	    isdat3[isdat] = bit_clear(isdat3[isdat],0);
22835 	}
22836 
22837 /*  Add the command name */
22838 
22839 	if (*ispstie) {
22840 /* Writing concatenation */
22841 	    i__5[0] = lnote, a__4[0] = notexq;
22842 	    chax_(ch__1, (ftnlen)1, &c__92);
22843 	    i__5[1] = 1, a__4[1] = ch__1;
22844 	    i__5[2] = 2, a__4[2] = "is";
22845 	    i__5[3] = 1, a__4[3] = udq;
22846 	    s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128);
22847 	    lnote += 4;
22848 	} else if (tie) {
22849 /* Writing concatenation */
22850 	    i__3[0] = lnote, a__2[0] = notexq;
22851 	    chax_(ch__1, (ftnlen)1, &c__92);
22852 	    i__3[1] = 1, a__2[1] = ch__1;
22853 	    i__3[2] = 4, a__2[2] = "ttie";
22854 	    s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128);
22855 	    lnote += 5;
22856 	} else {
22857 /* Writing concatenation */
22858 	    i__3[0] = lnote, a__2[0] = notexq;
22859 	    chax_(ch__1, (ftnlen)1, &c__92);
22860 	    i__3[1] = 1, a__2[1] = ch__1;
22861 	    i__3[2] = 5, a__2[2] = "tslur";
22862 	    s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128);
22863 	    lnote += 6;
22864 	}
22865 
22866 /*  Add index */
22867 
22868 /*        if (11-ndx .lt. 10) then */
22869 /*          notexq = notexq(1:lnote)//chax(59-ndx) */
22870 /*          lnote = lnote+1 */
22871 /*        else */
22872 /*          notexq = notexq(1:lnote)//'{1'//chax(49-ndx)//'}' */
22873 /*          lnote = lnote+4 */
22874 /*        end if */
22875 	if (23 - ndx < 10) {
22876 /* Writing concatenation */
22877 	    i__2[0] = lnote, a__1[0] = notexq;
22878 	    i__1 = 71 - ndx;
22879 	    chax_(ch__1, (ftnlen)1, &i__1);
22880 	    i__2[1] = 1, a__1[1] = ch__1;
22881 	    s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
22882 	    ++lnote;
22883 	} else if (23 - ndx < 20) {
22884 /* Writing concatenation */
22885 	    i__5[0] = lnote, a__4[0] = notexq;
22886 	    i__5[1] = 2, a__4[1] = "{1";
22887 	    i__1 = 61 - ndx;
22888 	    chax_(ch__1, (ftnlen)1, &i__1);
22889 	    i__5[2] = 1, a__4[2] = ch__1;
22890 	    i__5[3] = 1, a__4[3] = "}";
22891 	    s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128);
22892 	    lnote += 4;
22893 	} else {
22894 /* Writing concatenation */
22895 	    i__5[0] = lnote, a__4[0] = notexq;
22896 	    i__5[1] = 2, a__4[1] = "{2";
22897 	    i__1 = 51 - ndx;
22898 	    chax_(ch__1, (ftnlen)1, &i__1);
22899 	    i__5[2] = 1, a__4[2] = ch__1;
22900 	    i__5[3] = 1, a__4[3] = "}";
22901 	    s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128);
22902 	    lnote += 4;
22903 	}
22904 	if (*ispstie || ! tie) {
22905 
22906 /*  Add note name for slur height */
22907 
22908 	    comoct_1.noctup = 0;
22909 	    ncm = igetbits_(&isdat3[isdat], &c__8, &c__22);
22910 	    if (ncm == 23) {
22911 		comoct_1.noctup = -2;
22912 	    }
22913 /*          call notefq(noteq,lnoten,nolev,ncm) */
22914 	    notefq_(noteq, &lnoten, &islhgt, &ncm, (ftnlen)8);
22915 /* Writing concatenation */
22916 	    i__5[0] = lnote, a__4[0] = notexq;
22917 	    i__5[1] = 1, a__4[1] = "{";
22918 	    i__5[2] = lnoten, a__4[2] = noteq;
22919 	    i__5[3] = 1, a__4[3] = "}";
22920 	    s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128);
22921 	    lnote = lnote + 1 + lnoten + 1;
22922 	}
22923 	if (*ispstie) {
22924 
22925 /*  Horizontal shift start of new thing */
22926 
22927 /* Writing concatenation */
22928 	    i__2[0] = lnote, a__1[0] = notexq;
22929 	    i__2[1] = 1, a__1[1] = "{";
22930 	    s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
22931 	    ++lnote;
22932 /*          ihoff = ihoff-13 */
22933 	    if (tie) {
22934 		ihoff += -12;
22935 	    } else {
22936 		ihoff += -7;
22937 	    }
22938 	    if (ihoff < 0) {
22939 		ihoff = -ihoff;
22940 /* Writing concatenation */
22941 		i__2[0] = lnote, a__1[0] = notexq;
22942 		i__2[1] = 1, a__1[1] = "-";
22943 		s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
22944 		++lnote;
22945 	    }
22946 	    r__1 = ihoff * .1f;
22947 	    writflot_(&r__1, notexq, &lnote, (ftnlen)128);
22948 /* Writing concatenation */
22949 	    i__2[0] = lnote, a__1[0] = notexq;
22950 	    i__2[1] = 1, a__1[1] = "}";
22951 	    s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
22952 	    ++lnote;
22953 	}
22954 
22955 /*  Add closing stuff */
22956 
22957 	if (*ispstie) {
22958 /* Writing concatenation */
22959 	    i__4[0] = lnote, a__3[0] = notexq;
22960 	    chax_(ch__1, (ftnlen)1, &c__92);
22961 	    i__4[1] = 1, a__3[1] = ch__1;
22962 	    i__4[2] = 4, a__3[2] = "off{";
22963 	    chax_(ch__2, (ftnlen)1, &c__92);
22964 	    i__4[3] = 1, a__3[3] = ch__2;
22965 	    i__4[4] = 14, a__3[4] = "afterruleskip}";
22966 	    s_cat(notexq, a__3, i__4, &c__5, (ftnlen)128);
22967 	    lnote += 20;
22968 	} else {
22969 /* Writing concatenation */
22970 	    i__2[0] = lnote, a__1[0] = notexq;
22971 	    i__2[1] = 1, a__1[1] = "}";
22972 	    s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
22973 	    ++lnote;
22974 	}
22975 /* Writing concatenation */
22976 	i__3[0] = lnote, a__2[0] = notexq;
22977 	chax_(ch__1, (ftnlen)1, &c__92);
22978 	i__3[1] = 1, a__2[1] = ch__1;
22979 	i__3[2] = 3, a__2[2] = "en%";
22980 	s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128);
22981 	lnote += 4;
22982 	s_wsfe(&io___884);
22983 	do_fio(&c__1, notexq, lnote);
22984 	e_wsfe();
22985 L1:
22986 	;
22987     }
22988     *ispstie = ! (*ispstie);
22989     return 0;
22990 } /* linebreakties_ */
22991 
littex_(integer * islur,integer * nnl,integer * iv,logical * topmods,char * lineq,integer * iccount,ftnlen lineq_len)22992 /* Subroutine */ int littex_(integer *islur, integer *nnl, integer *iv,
22993 	logical *topmods, char *lineq, integer *iccount, ftnlen lineq_len)
22994 {
22995     /* System generated locals */
22996     address a__1[2], a__2[3];
22997     integer i__1[2], i__2[3];
22998     char ch__1[1], ch__2[129];
22999     olist o__1;
23000 
23001     /* Builtin functions */
23002     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
23003     integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char
23004 	    *, ftnlen), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen),
23005 	    e_wsfe(void), f_open(olist *);
23006 
23007     /* Local variables */
23008     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
23009     static char durq[1];
23010     extern /* Subroutine */ int stop1_(void);
23011     static logical merge;
23012     static integer itype;
23013     extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen,
23014 	    ftnlen);
23015 
23016     /* Fortran I/O blocks */
23017     static cilist io___888 = { 0, 6, 0, 0, 0 };
23018     static cilist io___889 = { 0, 6, 0, 0, 0 };
23019     static cilist io___890 = { 0, 15, 0, "(/,a)", 0 };
23020     static cilist io___891 = { 0, 11, 0, "(a)", 0 };
23021     static cilist io___892 = { 0, 16, 0, "(a)", 0 };
23022 
23023 
23024     /* Parameter adjustments */
23025     islur -= 25;
23026 
23027     /* Function Body */
23028     merge = FALSE_;
23029     if (comgrace_1.nlit > 0) {
23030 	merge = *iv == comgrace_1.ivlit[comgrace_1.nlit - 1] && *nnl ==
23031 		comgrace_1.iplit[comgrace_1.nlit - 1];
23032     }
23033     ++comgrace_1.nlit;
23034     comgrace_1.ivlit[comgrace_1.nlit - 1] = *iv;
23035     comgrace_1.iplit[comgrace_1.nlit - 1] = *nnl;
23036     itype = 1;
23037 L17:
23038     getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
23039     chax_(ch__1, (ftnlen)1, &c__92);
23040     if (*(unsigned char *)durq == *(unsigned char *)&ch__1[0]) {
23041 	++itype;
23042 	goto L17;
23043     }
23044 /* Writing concatenation */
23045     chax_(ch__1, (ftnlen)1, &c__92);
23046     i__1[0] = 1, a__1[0] = ch__1;
23047     i__1[1] = 1, a__1[1] = durq;
23048     s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__1, i__1, &c__2, (
23049 	    ftnlen)128);
23050     comgrace_1.lenlit[comgrace_1.nlit - 1] = 2;
23051 L18:
23052     getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
23053     chax_(ch__1, (ftnlen)1, &c__92);
23054     if (*(unsigned char *)durq == *(unsigned char *)&ch__1[0]) {
23055 	getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
23056 	if (*(unsigned char *)durq != ' ') {
23057 
23058 /*  Starting a new tex command within the string */
23059 
23060 /* Writing concatenation */
23061 	    i__2[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__2[0] =
23062 		    comgrace_1.litq + (comgrace_1.nlit - 1 << 7);
23063 	    chax_(ch__1, (ftnlen)1, &c__92);
23064 	    i__2[1] = 1, a__2[1] = ch__1;
23065 	    i__2[2] = 1, a__2[2] = durq;
23066 	    s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__2, i__2, &
23067 		    c__3, (ftnlen)128);
23068 	    comgrace_1.lenlit[comgrace_1.nlit - 1] += 2;
23069 	    goto L18;
23070 	}
23071     } else {
23072 /* Writing concatenation */
23073 	i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] =
23074 		comgrace_1.litq + (comgrace_1.nlit - 1 << 7);
23075 	i__1[1] = 1, a__1[1] = durq;
23076 	s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__1, i__1, &c__2,
23077 		 (ftnlen)128);
23078 	++comgrace_1.lenlit[comgrace_1.nlit - 1];
23079 	goto L18;
23080     }
23081 
23082 /*  If here, just read backslash-blank so string is done */
23083 
23084     if (itype == 1) {
23085 	islur[*iv + *nnl * 24] = bit_set(islur[*iv + *nnl * 24],16);
23086 	if (merge) {
23087 
23088 /*  There are 2 separate strings on the same note, so merge them. */
23089 
23090 	    --comgrace_1.nlit;
23091 /* Writing concatenation */
23092 	    i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] =
23093 		    comgrace_1.litq + (comgrace_1.nlit - 1 << 7);
23094 	    i__1[1] = comgrace_1.lenlit[comgrace_1.nlit], a__1[1] =
23095 		    comgrace_1.litq + (comgrace_1.nlit << 7);
23096 	    s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__1, i__1, &
23097 		    c__2, (ftnlen)128);
23098 	    comgrace_1.lenlit[comgrace_1.nlit - 1] += comgrace_1.lenlit[
23099 		    comgrace_1.nlit];
23100 	    if (comgrace_1.lenlit[comgrace_1.nlit - 1] > 128) {
23101 		s_wsle(&io___888);
23102 		e_wsle();
23103 		s_wsle(&io___889);
23104 		do_lio(&c__9, &c__1, "Merged type-1 TeX strings longer than "
23105 			"128 characters", (ftnlen)52);
23106 		e_wsle();
23107 		s_wsfe(&io___890);
23108 		do_fio(&c__1, "Merged type-1 TeX strings longer than 128 cha"
23109 			"racters", (ftnlen)52);
23110 		e_wsfe();
23111 		stop1_();
23112 	    }
23113 	}
23114     } else {
23115 	if (itype == 3) {
23116 
23117 /*  Write the string NOW */
23118 
23119 	    if (comlast_1.islast) {
23120 		s_wsfe(&io___891);
23121 /* Writing concatenation */
23122 		i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] =
23123 			comgrace_1.litq + (comgrace_1.nlit - 1 << 7);
23124 		i__1[1] = 1, a__1[1] = "%";
23125 		s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)129);
23126 		do_fio(&c__1, ch__2, comgrace_1.lenlit[comgrace_1.nlit - 1] +
23127 			1);
23128 		e_wsfe();
23129 	    }
23130 	} else {
23131 
23132 /*  Must go at top */
23133 
23134 	    if (! (*topmods)) {
23135 		*topmods = TRUE_;
23136 		o__1.oerr = 0;
23137 		o__1.ounit = 16;
23138 		o__1.ofnm = 0;
23139 		o__1.orl = 0;
23140 		o__1.osta = "SCRATCH";
23141 		o__1.oacc = 0;
23142 		o__1.ofm = 0;
23143 		o__1.oblnk = 0;
23144 		f_open(&o__1);
23145 	    }
23146 
23147 /*  Must write '%' here rather than later, in case string ends with blank. */
23148 
23149 	    s_wsfe(&io___892);
23150 /* Writing concatenation */
23151 	    i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] =
23152 		    comgrace_1.litq + (comgrace_1.nlit - 1 << 7);
23153 	    i__1[1] = 1, a__1[1] = "%";
23154 	    s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)129);
23155 	    do_fio(&c__1, ch__2, comgrace_1.lenlit[comgrace_1.nlit - 1] + 1);
23156 	    e_wsfe();
23157 	}
23158 	--comgrace_1.nlit;
23159     }
23160     return 0;
23161 } /* littex_ */
23162 
llen_(char * strq,integer * n,ftnlen strq_len)23163 integer llen_(char *strq, integer *n, ftnlen strq_len)
23164 {
23165     /* System generated locals */
23166     integer ret_val;
23167 
23168     for (ret_val = *n; ret_val >= 0; --ret_val) {
23169 	if (*(unsigned char *)&strq[ret_val - 1] != ' ') {
23170 	    return ret_val;
23171 	}
23172 /* L1: */
23173     }
23174     return ret_val;
23175 } /* llen_ */
23176 
log2_(integer * n)23177 integer log2_(integer *n)
23178 {
23179     /* System generated locals */
23180     integer ret_val;
23181 
23182     /* Builtin functions */
23183     double log(doublereal);
23184 
23185 
23186 /* 5/25/08 Modify to allow more slurs */
23187 
23188 /*        log2 = alog(1.*n)/0.6931472+.0001 */
23189 /*        log2 = dlog(1.d0*n)/0.693147181d0+.00000001d0 */
23190     ret_val = (integer) (log(*n * 1.) / .693147181 + 2e-8);
23191     return ret_val;
23192 } /* log2_ */
23193 
logbeam_(integer * numnew,integer * nip1,integer * nip2)23194 /* Subroutine */ int logbeam_(integer *numnew, integer *nip1, integer *nip2)
23195 {
23196     /* System generated locals */
23197     integer i__1, i__2, i__3;
23198     real r__1;
23199     char ch__1[1];
23200 
23201     /* Builtin functions */
23202     double log(doublereal);
23203 
23204     /* Local variables */
23205     extern integer igetbits_(integer *, integer *, integer *);
23206     static integer ib, iip;
23207     static real sum;
23208     static integer iip1;
23209     extern integer log2_(integer *);
23210     static integer iiip;
23211     extern /* Character */ VOID ulfq_(char *, ftnlen, real *, integer *);
23212     extern integer ncmid_(integer *, integer *);
23213     static integer ndoub, multx, nrests, numnow;
23214     static logical isxtup;
23215     extern /* Subroutine */ int setbits_(integer *, integer *, integer *,
23216 	    integer *);
23217 
23218     all_1.ibm1[commvl_1.ivx + *numnew * 24 - 25] = *nip1;
23219     all_1.ibm2[commvl_1.ivx + *numnew * 24 - 25] = *nip2;
23220     numnow = *numnew;
23221     if (*numnew > 1) {
23222 
23223 /*  If it starts before any others, must put it in order */
23224 
23225 	for (ib = *numnew - 1; ib >= 1; --ib) {
23226 	    if (all_1.ibm1[commvl_1.ivx + ib * 24 - 25] < *nip1) {
23227 		goto L12;
23228 	    }
23229 	    all_1.ibm1[commvl_1.ivx + (ib + 1) * 24 - 25] = all_1.ibm1[
23230 		    commvl_1.ivx + ib * 24 - 25];
23231 	    all_1.ibm2[commvl_1.ivx + (ib + 1) * 24 - 25] = all_1.ibm2[
23232 		    commvl_1.ivx + ib * 24 - 25];
23233 	    *(unsigned char *)&all_1.ulq[commvl_1.ivx + (ib + 1) * 24 - 25] =
23234 		    *(unsigned char *)&all_1.ulq[commvl_1.ivx + ib * 24 - 25];
23235 	    all_1.ibm1[commvl_1.ivx + ib * 24 - 25] = *nip1;
23236 	    all_1.ibm2[commvl_1.ivx + ib * 24 - 25] = *nip2;
23237 	    numnow = ib;
23238 /* L11: */
23239 	}
23240 L12:
23241 	;
23242     }
23243     sum = 0.f;
23244 
23245 /* Beam has non-xtup within */
23246 
23247     nrests = 0;
23248     isxtup = FALSE_;
23249     i__1 = *nip2;
23250     for (iip = *nip1; iip <= i__1; ++iip) {
23251 	if (bit_test(all_1.islur[commvl_1.ivx + *nip1 * 24 - 25],21)) {
23252 
23253 /*  Forced multiplicity */
23254 
23255 /*          mult(ivx,iip) = igetbits(islur(ivx,nip1),3,22) */
23256 	    i__2 = igetbits_(&all_1.islur[commvl_1.ivx + *nip1 * 24 - 25], &
23257 		    c__3, &c__22) + 8;
23258 	    setbits_(&all_1.mult[commvl_1.ivx + iip * 24 - 25], &c__4, &c__0,
23259 		    &i__2);
23260 	} else if (! isxtup) {
23261 	    if (all_1.nodur[commvl_1.ivx + iip * 24 - 25] > 0) {
23262 /*            mult(ivx,iip) = 4-log2(nodur(ivx,iip)) */
23263 		i__2 = 4 - log2_(&all_1.nodur[commvl_1.ivx + iip * 24 - 25])
23264 			+ 8;
23265 		setbits_(&all_1.mult[commvl_1.ivx + iip * 24 - 25], &c__4, &
23266 			c__0, &i__2);
23267 	    } else {
23268 
23269 /*  Start xtup within forced beam */
23270 
23271 		isxtup = TRUE_;
23272 		iip1 = iip;
23273 	    }
23274 	} else if (isxtup && all_1.nodur[commvl_1.ivx + iip * 24 - 25] > 0) {
23275 
23276 /*  End of xtup within forced beam.  Must count doubled notes */
23277 
23278 	    ndoub = 0;
23279 	    i__2 = iip;
23280 	    for (iiip = iip1; iiip <= i__2; ++iiip) {
23281 		if (bit_test(all_1.nacc[commvl_1.ivx + iiip * 24 - 25],18)) {
23282 		    ++ndoub;
23283 		}
23284 /* L1: */
23285 	    }
23286 	    multx = (integer) ((log(iip + 1.f - iip1 + ndoub) * .952f - log(
23287 		    all_1.nodur[commvl_1.ivx + iip * 24 - 25] / 2.f)) /
23288 		    .69315f + 13.429f) - 10;
23289 	    i__2 = iip;
23290 	    for (iiip = iip1; iiip <= i__2; ++iiip) {
23291 /*            mult(ivx,iiip) = multx */
23292 		i__3 = multx + 8;
23293 		setbits_(&all_1.mult[commvl_1.ivx + iiip * 24 - 25], &c__4, &
23294 			c__0, &i__3);
23295 
23296 /*  Note the following still works after making mult only the 1st 4 bits. */
23297 
23298 		if (bit_test(all_1.nacc[commvl_1.ivx + iiip * 24 - 25],18)) {
23299 		    --all_1.mult[commvl_1.ivx + iiip * 24 - 25];
23300 		}
23301 		if (bit_test(all_1.nacc[commvl_1.ivx + iiip * 24 - 25],19)) {
23302 		    ++all_1.mult[commvl_1.ivx + iiip * 24 - 25];
23303 		} else if (iiip > 1) {
23304 		    if (bit_test(all_1.nacc[commvl_1.ivx + (iiip - 1) * 24 -
23305 			    25],19)) {
23306 			++all_1.mult[commvl_1.ivx + iiip * 24 - 25];
23307 		    }
23308 		}
23309 /* L74: */
23310 	    }
23311 	    isxtup = FALSE_;
23312 	}
23313 	if (bit_test(all_1.irest[commvl_1.ivx + iip * 24 - 25],0)) {
23314 	    ++nrests;
23315 	} else {
23316 	    sum += all_1.nolev[commvl_1.ivx + iip * 24 - 25];
23317 	}
23318 /* L9: */
23319     }
23320 
23321 /*  Set beam up-down-ness */
23322 
23323     if (comfb_1.ifb > 0 && *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx +
23324 	    max(1,comfb_1.ifb) * 24 - 25] != 'x') {
23325 	if (*(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.ifb * 24
23326 		- 25] == 'f') {
23327 
23328 /*  Get default, then trade "l" and "u" */
23329 
23330 	    r__1 = sum / (*nip2 - *nip1 + 1 - nrests);
23331 	    i__1 = ncmid_(&all_1.iv, nip1);
23332 	    ulfq_(ch__1, (ftnlen)1, &r__1, &i__1);
23333 	    *(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] = (
23334 		    char) (225 - *(unsigned char *)&ch__1[0]);
23335 	} else {
23336 	    *(unsigned char *)&all_1.ulq[commvl_1.ivx + comfb_1.ifb * 24 - 25]
23337 		     = *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx +
23338 		    comfb_1.ifb * 24 - 25];
23339 	}
23340 
23341 /*  This probably works only because forced beams are done first, so they */
23342 /*  don't have to be re-sorted within each voice. ???? */
23343 
23344     } else if (commvl_1.nvmx[all_1.iv - 1] == 2) {
23345 
23346 /*  Multi-voice per staff */
23347 
23348 	if (commvl_1.ivx <= all_1.nv) {
23349 	    *(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] =
23350 		    'l';
23351 	} else {
23352 	    *(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] =
23353 		    'u';
23354 	}
23355     } else {
23356 
23357 /*  Defaults */
23358 
23359 	r__1 = sum / (*nip2 - *nip1 + 1 - nrests);
23360 	i__1 = ncmid_(&all_1.iv, nip1);
23361 	ulfq_(ch__1, (ftnlen)1, &r__1, &i__1);
23362 	*(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] = *(
23363 		unsigned char *)&ch__1[0];
23364     }
23365     return 0;
23366 } /* logbeam_ */
23367 
m1rec1_(char * lineq,integer * iccount,integer * ibarcnt,integer * ibaroff,integer * nbars,integer * ndxm,ftnlen lineq_len)23368 /* Subroutine */ int m1rec1_(char *lineq, integer *iccount, integer *ibarcnt,
23369 	integer *ibaroff, integer *nbars, integer *ndxm, ftnlen lineq_len)
23370 {
23371     /* System generated locals */
23372     integer i__1, i__2;
23373 
23374     /* Builtin functions */
23375     integer i_indx(char *, char *, ftnlen, ftnlen), s_cmp(char *, char *,
23376 	    ftnlen, ftnlen);
23377 
23378     /* Local variables */
23379     extern /* Subroutine */ int stop1_(void), errmsg_(char *, integer *,
23380 	    integer *, char *, ftnlen, ftnlen);
23381     extern integer ntindex_(char *, char *, integer *, ftnlen, ftnlen);
23382 
23383 
23384 /*  This is called when (a) macro recording is just starting and */
23385 /*  (b) at the start of a new line, if recording is on */
23386 
23387     inbuff_1.lbuf[0] = inbuff_1.lbuf[0];
23388     if (! commac_1.mrecord) {
23389 
23390 /*  Starting the macro */
23391 
23392 	c1ommac_1.ip1mac[commac_1.macnum - 1] = inbuff_1.ipbuf -
23393 		inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount;
23394 	c1ommac_1.il1mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1;
23395 	c1ommac_1.ic1mac[commac_1.macnum - 1] = *iccount;
23396 	commac_1.mrecord = TRUE_;
23397     }
23398     if (*iccount < 128) {
23399 	i__1 = *iccount;
23400 	*ndxm = i_indx(lineq + i__1, "M", 128 - i__1, (ftnlen)1);
23401 	if (*ndxm > 0) {
23402 	    i__1 = *iccount;
23403 	    i__2 = 128 - *iccount;
23404 	    *ndxm = ntindex_(lineq + i__1, "M", &i__2, 128 - i__1, (ftnlen)1);
23405 	}
23406 	if (*ndxm > 0) {
23407 
23408 /*  This line ends the macro. */
23409 
23410 	    i__1 = *iccount + *ndxm;
23411 	    if (s_cmp(lineq + i__1, " ", *iccount + *ndxm + 1 - i__1, (ftnlen)
23412 		    1) != 0) {
23413 		i__1 = *iccount + *ndxm + 1;
23414 		i__2 = *ibarcnt - *ibaroff + *nbars + 1;
23415 		errmsg_(lineq, &i__1, &i__2, "Improper macro termination!", (
23416 			ftnlen)128, (ftnlen)27);
23417 		stop1_();
23418 	    }
23419 	    c1ommac_1.ip2mac[commac_1.macnum - 1] = inbuff_1.ipbuf -
23420 		    inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount + *ndxm;
23421 	    c1ommac_1.il2mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1;
23422 	    commac_1.mrecord = FALSE_;
23423 	}
23424     }
23425     return 0;
23426 } /* m1rec1_ */
23427 
make1bar_(integer * ibmrep,real * tglp1,real * tstart,logical * cwrest,real * squez,integer * istop,integer * numbms,integer * istart)23428 /* Subroutine */ int make1bar_(integer *ibmrep, real *tglp1, real *tstart,
23429 	logical *cwrest, real *squez, integer *istop, integer *numbms,
23430 	integer *istart)
23431 {
23432     /* System generated locals */
23433     integer i__1, i__2, i__3, i__4, i__5, i__6;
23434     real r__1, r__2;
23435 
23436     /* Builtin functions */
23437     integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char
23438 	    *, ftnlen), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen),
23439 	    e_wsfe(void);
23440 
23441     /* Local variables */
23442     extern /* Subroutine */ int findbeam_(integer *, integer *, integer *);
23443     extern integer igetbits_(integer *, integer *, integer *);
23444     extern doublereal getsquez_(integer *, integer *, real *, real *, real *);
23445     static integer ib, in, ip, kp, kv, ib1, ib2, ip1, cnn[24], inj, iin, iiv,
23446 	    isl;
23447     static real xit[24];
23448     extern doublereal feon_(real *);
23449     static integer irep;
23450     static real tmin;
23451     static integer iivx, itbb1, itbb2, itbb3, inip1;
23452     static real tglp2;
23453     extern /* Subroutine */ int addfb_(integer *, integer *, real *, real *,
23454 	    real *, char *, integer *, ftnlen);
23455     static integer mapfb[16];
23456     static real deskb;
23457     extern doublereal fnote_(integer *, integer *, integer *, integer *);
23458     static real eskzb;
23459     static integer ibrep;
23460     static real tminn;
23461     static integer nxtup, nip1fb, nip2fb, ib1now, ib2now, ifbadd;
23462     static real t1xtup[20];
23463     static integer nfbbar;
23464     static logical infbmx[24];
23465     static integer ifbnow[24], numnew;
23466     static logical inxtup[24];
23467     static integer mapnow, nxtnow[24];
23468     static real xsquez;
23469     extern /* Subroutine */ int logbeam_(integer *, integer *, integer *),
23470 	    setbits_(integer *, integer *, integer *, integer *);
23471 
23472     /* Fortran I/O blocks */
23473     static cilist io___937 = { 0, 6, 0, 0, 0 };
23474     static cilist io___938 = { 0, 6, 0, 0, 0 };
23475     static cilist io___939 = { 0, 15, 0, "(/a)", 0 };
23476 
23477 
23478 
23479 /*  Above are factors for grace note, clef spacing. (fraction of wheadpt) */
23480 /*  In 1.04, moved to block data subprogram */
23481 
23482     /* Parameter adjustments */
23483     --istart;
23484     --numbms;
23485     --istop;
23486     --squez;
23487     --cwrest;
23488     --tstart;
23489 
23490     /* Function Body */
23491     if (commidi_1.ismidi) {
23492 
23493 /*  Initialize for this bar the accidental counter for the midi file. */
23494 /*    naccim(icm) = # of accidentals from earlier in the bar */
23495 
23496 	i__1 = all_1.nv;
23497 	for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
23498 	    i__2 = commvl_1.nvmx[all_1.iv - 1];
23499 	    for (kv = 1; kv <= i__2; ++kv) {
23500 		commidi_1.naccim[commidi_1.midchan[all_1.iv + kv * 24 - 25]] =
23501 			 0;
23502 /* L45: */
23503 	    }
23504 	}
23505     }
23506 
23507 /*  Time from start of gulp to end of bar, used with forced beams */
23508 
23509     tglp2 = (real) (all_1.lenb0 + all_1.ibar * all_1.lenb1);
23510     if (all_1.lenb0 > 0) {
23511 	tglp2 -= all_1.lenb1;
23512     }
23513     *tglp1 = tglp2 - all_1.lenbar;
23514 
23515 /*  infbmx will only be true if in xtup that is NOT in explicit forced beam. */
23516 
23517     i__2 = all_1.nv;
23518     for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) {
23519 	i__1 = commvl_1.nvmx[all_1.iv - 1];
23520 	for (kv = 1; kv <= i__1; ++kv) {
23521 	    commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
23522 	    cwrest[commvl_1.ivx] = FALSE_;
23523 	    infbmx[commvl_1.ivx - 1] = FALSE_;
23524 	    inxtup[commvl_1.ivx - 1] = FALSE_;
23525 	    if (all_1.ibar > 1) {
23526 		all_1.nn[commvl_1.ivx - 1] = all_1.nib[commvl_1.ivx +
23527 			all_1.ibar * 24 - 25] - all_1.nib[commvl_1.ivx + (
23528 			all_1.ibar - 1) * 24 - 25];
23529 	    } else {
23530 		all_1.nn[commvl_1.ivx - 1] = all_1.nib[commvl_1.ivx +
23531 			all_1.ibar * 24 - 25];
23532 	    }
23533 /* L1: */
23534 	}
23535     }
23536 
23537 /* initialize list note counter, time(iv), curr. note(iv).  The loop to 4 */
23538 /*   ONLY initializes each voice. */
23539 
23540     in = 1;
23541     nxtup = 0;
23542     comarp_1.narp = 0;
23543     i__1 = all_1.nv;
23544     for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
23545 	i__2 = commvl_1.nvmx[all_1.iv - 1];
23546 	for (kv = 1; kv <= i__2; ++kv) {
23547 	    commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
23548 	    comcwrf_1.cwrferm[commvl_1.ivx - 1] = FALSE_;
23549 	    cnn[commvl_1.ivx - 1] = 1;
23550 	    all_1.ivxo[in - 1] = commvl_1.ivx;
23551 	    all_1.ipo[in - 1] = cnn[commvl_1.ivx - 1];
23552 	    all_1.tnote[in - 1] = fnote_(all_1.nodur, &commvl_1.ivx, &c__1,
23553 		    all_1.nacc);
23554 	    all_1.to[in - 1] = 0.f;
23555 	    xit[commvl_1.ivx - 1] = all_1.tnote[in - 1];
23556 
23557 /*  Note that xit(ivx) is to END of note in voice, but it1xtup is start time. */
23558 
23559 	    if (all_1.nodur[commvl_1.ivx + all_1.ipo[in - 1] * 24 - 25] == 0)
23560 		    {
23561 
23562 /*  First note of xtuplet at start of bar in voice ivx. */
23563 
23564 		++nxtup;
23565 		nxtnow[commvl_1.ivx - 1] = nxtup;
23566 		inxtup[commvl_1.ivx - 1] = TRUE_;
23567 		t1xtup[nxtup - 1] = 0.f;
23568 
23569 /*  Xtup at start of bar.  If no explicit forced beam, start one, set */
23570 /*  signal infbmx, and save number ifbnow for use at termination. */
23571 
23572 		if (comfb_1.nfb[commvl_1.ivx - 1] > 0) {
23573 		    i__3 = comfb_1.nfb[commvl_1.ivx - 1];
23574 		    for (comfb_1.ifb = 1; comfb_1.ifb <= i__3; ++comfb_1.ifb)
23575 			    {
23576 			if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25]
23577 				 > *tglp1 + xit[commvl_1.ivx - 1] +
23578 				comtol_1.tol) {
23579 
23580 /*  No explicit fb here; so exit loop and insert one. */
23581 
23582 			    goto L61;
23583 			} else if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb *
23584 				24 - 25] < *tglp1 + xit[commvl_1.ivx - 1] +
23585 				comtol_1.tol && comfb_1.t2fb[commvl_1.ivx +
23586 				comfb_1.ifb * 24 - 25] > *tglp1 + xit[
23587 				commvl_1.ivx - 1] + comtol_1.tol) {
23588 
23589 /*  IS explicit fb here; must NOT insert one */
23590 
23591 			    goto L62;
23592 			}
23593 /* L60: */
23594 		    }
23595 		}
23596 L61:
23597 
23598 /*  If here, xtup isn't in explicit fb, so must insert one */
23599 
23600 		infbmx[commvl_1.ivx - 1] = TRUE_;
23601 		r__1 = t1xtup[nxtup - 1] + *tglp1;
23602 		addfb_(comfb_1.nfb, &commvl_1.ivx, &r__1, comfb_1.t1fb,
23603 			comfb_1.t2fb, comfb_1.ulfbq, &ifbadd, (ftnlen)1);
23604 		ifbnow[commvl_1.ivx - 1] = ifbadd;
23605 	    }
23606 L62:
23607 	    if ((r__1 = xit[commvl_1.ivx - 1] - all_1.lenbar, dabs(r__1)) <
23608 		    comtol_1.tol) {
23609 		xit[commvl_1.ivx - 1] = 1e3f;
23610 	    }
23611 	    ++in;
23612 /* L4: */
23613 	}
23614     }
23615 
23616 /*  Build the list:  This is a manual loop starting at 5 */
23617 
23618 L5:
23619 
23620 /*  Determine which voice comes next from end of notes done so far. */
23621 /*  tmin is the earliest ending time of notes done so far */
23622 
23623     tmin = 1e3f;
23624     i__2 = all_1.nv;
23625     for (iiv = 1; iiv <= i__2; ++iiv) {
23626 	i__1 = commvl_1.nvmx[iiv - 1];
23627 	for (kv = 1; kv <= i__1; ++kv) {
23628 	    iivx = commvl_1.ivmx[iiv + kv * 24 - 25];
23629 /* Computing MIN */
23630 	    r__1 = tmin, r__2 = xit[iivx - 1];
23631 	    tminn = dmin(r__1,r__2);
23632 	    if (tminn < tmin - comtol_1.tol) {
23633 		tmin = tminn;
23634 		commvl_1.ivx = iivx;
23635 	    }
23636 /* L6: */
23637 	}
23638     }
23639     if ((r__1 = tmin - 1e3f, dabs(r__1)) < comtol_1.tol) {
23640 	goto L7;
23641     }
23642     all_1.ivxo[in - 1] = commvl_1.ivx;
23643     ++cnn[commvl_1.ivx - 1];
23644     all_1.ipo[in - 1] = cnn[commvl_1.ivx - 1];
23645     all_1.to[in - 1] = tmin;
23646 
23647 /*  Check if this voice is done */
23648 
23649     all_1.tnote[in - 1] = fnote_(all_1.nodur, &commvl_1.ivx, &cnn[
23650 	    commvl_1.ivx - 1], all_1.nacc);
23651     if (cnn[commvl_1.ivx - 1] == all_1.nn[commvl_1.ivx - 1]) {
23652 	xit[commvl_1.ivx - 1] = 1e3f;
23653     } else {
23654 	xit[commvl_1.ivx - 1] += all_1.tnote[in - 1];
23655     }
23656 
23657 /*  Flag xtups */
23658 
23659     if (all_1.nodur[commvl_1.ivx + cnn[commvl_1.ivx - 1] * 24 - 25] == 0) {
23660 	if (! inxtup[commvl_1.ivx - 1]) {
23661 
23662 /*  First note of xtup, not at start of bar. */
23663 
23664 	    ++nxtup;
23665 	    nxtnow[commvl_1.ivx - 1] = nxtup;
23666 	    inxtup[commvl_1.ivx - 1] = TRUE_;
23667 	    t1xtup[nxtup - 1] = xit[commvl_1.ivx - 1] - all_1.tnote[in - 1];
23668 
23669 /*  (Note: can't be on last note in voice, so xit(ivx) <> 1000) */
23670 /*  Put xtuplet in a forced beam if not already in forced beam */
23671 
23672 	    if (comfb_1.nfb[commvl_1.ivx - 1] > 0) {
23673 		i__1 = comfb_1.nfb[commvl_1.ivx - 1];
23674 		for (comfb_1.ifb = 1; comfb_1.ifb <= i__1; ++comfb_1.ifb) {
23675 		    if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] > *
23676 			    tglp1 + xit[commvl_1.ivx - 1] + comtol_1.tol) {
23677 
23678 /*  NO explicit bm; put one in */
23679 
23680 			goto L71;
23681 		    } else if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 -
23682 			    25] < *tglp1 + xit[commvl_1.ivx - 1] +
23683 			    comtol_1.tol && comfb_1.t2fb[commvl_1.ivx +
23684 			    comfb_1.ifb * 24 - 25] > *tglp1 + xit[
23685 			    commvl_1.ivx - 1] + comtol_1.tol) {
23686 
23687 /*  IS explicit bm.  Don't put one */
23688 
23689 			goto L72;
23690 		    }
23691 /* L70: */
23692 		}
23693 	    }
23694 L71:
23695 
23696 /*  If here, no explicit bm, so put one in */
23697 
23698 	    infbmx[commvl_1.ivx - 1] = TRUE_;
23699 	    r__1 = t1xtup[nxtup - 1] + *tglp1;
23700 	    addfb_(comfb_1.nfb, &commvl_1.ivx, &r__1, comfb_1.t1fb,
23701 		    comfb_1.t2fb, comfb_1.ulfbq, &ifbadd, (ftnlen)1);
23702 	    ifbnow[commvl_1.ivx - 1] = ifbadd;
23703 	}
23704 L72:
23705 	;
23706     } else if (inxtup[commvl_1.ivx - 1]) {
23707 
23708 /*  This test is sufficient because already know nodur>0 */
23709 
23710 	inxtup[commvl_1.ivx - 1] = FALSE_;
23711 	if (infbmx[commvl_1.ivx - 1]) {
23712 
23713 /*  Xtup is in auto-forced beam, so end it */
23714 
23715 	    comfb_1.t2fb[commvl_1.ivx + ifbnow[commvl_1.ivx - 1] * 24 - 25] =
23716 		    t1xtup[nxtnow[commvl_1.ivx - 1] - 1] + all_1.nodur[
23717 		    commvl_1.ivx + cnn[commvl_1.ivx - 1] * 24 - 25] + *tglp1;
23718 	    infbmx[commvl_1.ivx - 1] = FALSE_;
23719 	}
23720     }
23721     if (bit_test(all_1.irest[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25]
23722 	    ,24) || bit_test(all_1.irest[all_1.ivxo[in - 1] + all_1.ipo[in -
23723 	    1] * 24 - 25],30)) {
23724 
23725 /*  For staff jumped beam, flag the first note (lowest voice) at same time. */
23726 /*  Later will start new notes group here. */
23727 
23728 	inj = in;
23729 	if (all_1.ivxo[in - 1] > 1) {
23730 	    for (iin = in - 1; iin >= 1; --iin) {
23731 		if (all_1.to[iin - 1] + comtol_1.tol < all_1.to[in - 1]) {
23732 		    goto L41;
23733 		}
23734 		if ((r__1 = all_1.to[iin - 1] - all_1.to[in - 1], dabs(r__1))
23735 			< comtol_1.tol) {
23736 		    inj = iin;
23737 		    goto L40;
23738 		}
23739 L40:
23740 		;
23741 	    }
23742 	}
23743 L41:
23744 	all_1.irest[all_1.ivxo[inj - 1] + all_1.ipo[inj - 1] * 24 - 25] =
23745 		bit_set(all_1.irest[all_1.ivxo[inj - 1] + all_1.ipo[inj - 1] *
23746 		 24 - 25],29);
23747     }
23748     ++in;
23749     goto L5;
23750 L7:
23751     comntot_1.ntot = in - 1;
23752     i__1 = comntot_1.ntot - 1;
23753     for (in = 1; in <= i__1; ++in) {
23754 	all_1.tno[in - 1] = all_1.to[in] - all_1.to[in - 1];
23755 /* L8: */
23756     }
23757     all_1.tno[comntot_1.ntot - 1] = all_1.tnote[comntot_1.ntot - 1];
23758 
23759 /*  Debug writes */
23760 
23761 /*      write(*,'()') */
23762 /*      write(*,'(a)')' Greetings from PMXB' */
23763 /*      write(*,'(16i5)')(ivxo(in),in=1,ntot) */
23764 /*      write(*,'(16i5)')(ipo(in),in=1,ntot) */
23765 /*      write(*,'(16f5.1)')(to(in),in=1,ntot) */
23766 /*      write(*,'(16f5.1)')(tno(in),in=1,ntot) */
23767 /*      write(*,'(16i5)')(nodur(ivxo(in),ipo(in)),in=1,ntot) */
23768 /*      write(*,'(16f5.1)')(fnote(nodur,ivxo(in),ipo(in),nacc),in=1,ntot) */
23769 
23770 /*  Done w/ list. Loop for parsing into note blocks: */
23771 
23772     ib = 1;
23773     istart[1] = 1;
23774     comnsp_2.space[0] = 0.f;
23775     in = 1;
23776 
23777 /*  A manual loop to set space(ib) and istop(ib) */
23778 
23779 L9:
23780 /* Computing MIN */
23781     i__1 = in + 1;
23782     commvl_1.ivx = all_1.ivxo[min(i__1,comntot_1.ntot) - 1];
23783 /* Computing MIN */
23784     i__1 = in + 1;
23785     ip = all_1.ipo[min(i__1,comntot_1.ntot) - 1];
23786     isl = all_1.islur[commvl_1.ivx + ip * 24 - 25];
23787     if (in == comntot_1.ntot || (commvl_1.ivx == 1 && ((isl & 67109216) > 0 ||
23788 	     bit_test(all_1.ipl[ip * 24 - 24],28) || bit_test(all_1.iornq[ip *
23789 	     24],4)) || bit_test(isl,15)) || bit_test(all_1.irest[
23790 	    commvl_1.ivx + ip * 24 - 25],29)) {
23791 /*    *      .or. ornq(1,ip).eq.'g')) .or. btest(isl,15) )) then */
23792 /*  Bits 1-13: stmgx+Tupf._) */
23793 /*  14: Down fermata, was F */
23794 /*  15: Trill w/o "tr", was U */
23795 
23796 /*  Checking for start of 2nd part of jumped beam */
23797 
23798 
23799 /*  Bar end, segno, int. rpt or sig change, clef,end of 1st part of jumped beam; */
23800 /*    flow out of if-loop and into block-wrapup */
23801 
23802 /*  10/18/97:  Problem with clef alignment.  Got isl{15} set on lowest-numbered */
23803 /*  voice, but it wasn't first in the list at the same time.  So check if */
23804 /*  prior notes in list have same time */
23805 /*  5/25/98: This stuff causes trouble with just "c2 Ct c", maybe when clef */
23806 /*  changes on last note in the list? */
23807 
23808 	if (bit_test(isl,15) && in < comntot_1.ntot) {
23809 	    for (iin = in; iin >= 1; --iin) {
23810 		if (all_1.tno[iin - 1] > comtol_1.tol) {
23811 		    in = iin;
23812 		    all_1.islur[commvl_1.ivx + ip * 24 - 25] = bit_clear(
23813 			    all_1.islur[commvl_1.ivx + ip * 24 - 25],15);
23814 		    all_1.islur[all_1.ivxo[in] + all_1.ipo[in] * 24 - 25] =
23815 			    bit_set(all_1.islur[all_1.ivxo[in] + all_1.ipo[in]
23816 			     * 24 - 25],15);
23817 		    goto L51;
23818 		}
23819 /* L50: */
23820 	    }
23821 L51:
23822 	    ;
23823 	}
23824 	if (comnsp_2.space[ib - 1] < comtol_1.tol) {
23825 	    comnsp_2.space[ib - 1] = all_1.tno[in - 1];
23826 	    squez[ib] = 1.f;
23827 	}
23828 	istop[ib] = in;
23829     } else if (comnsp_2.space[ib - 1] < comtol_1.tol) {
23830 
23831 /*  space hasn't been set yet, so tentatively set: */
23832 
23833 	comnsp_2.space[ib - 1] = all_1.tno[in - 1];
23834 	if (comnsp_2.space[ib - 1] < comtol_1.tol) {
23835 	    ++in;
23836 	} else {
23837 	    squez[ib] = getsquez_(&in, &comntot_1.ntot, &comnsp_2.space[ib -
23838 		    1], all_1.tnote, all_1.to);
23839 	    istop[ib] = in;
23840 	}
23841 	goto L9;
23842     } else if (all_1.tno[in] < comtol_1.tol) {
23843 
23844 /*  This is not the last note in the group, so */
23845 
23846 	++in;
23847 	goto L9;
23848     } else if ((r__1 = all_1.tno[in] - comnsp_2.space[ib - 1], dabs(r__1)) <
23849 	    comtol_1.tol) {
23850 	i__1 = in + 1;
23851 	xsquez = getsquez_(&i__1, &comntot_1.ntot, &comnsp_2.space[ib - 1],
23852 		all_1.tnote, all_1.to);
23853 	if ((r__1 = xsquez - squez[ib], dabs(r__1)) < comtol_1.tol) {
23854 
23855 /*  Keep spacing the same, update tentative stop point */
23856 
23857 	    ++in;
23858 	    istop[ib] = in;
23859 	    goto L9;
23860 	}
23861     }
23862 
23863 /* At this point istart and istop are good, so finalize block */
23864 
23865     tstart[ib] = all_1.to[istart[ib] - 1];
23866     if (istop[ib] == comntot_1.ntot) {
23867 	goto L15;
23868     }
23869     ++ib;
23870     istart[ib] = istop[ib - 1] + 1;
23871     in = istart[ib];
23872 
23873 /* Set tentative block space and squeeze-factor for upcoming block */
23874 
23875     comnsp_2.space[ib - 1] = all_1.tno[in - 1];
23876     if (comnsp_2.space[ib - 1] > comtol_1.tol) {
23877 	squez[ib] = getsquez_(&in, &comntot_1.ntot, &comnsp_2.space[ib - 1],
23878 		all_1.tnote, all_1.to);
23879     }
23880     istop[ib] = in;
23881     goto L9;
23882 L15:
23883     comnsp_2.nb = ib;
23884 
23885 /*  Invert the list of places into ipl(0-7), making it easier to analyze a voice */
23886 
23887     i__1 = comntot_1.ntot;
23888     for (in = 1; in <= i__1; ++in) {
23889 
23890 /* ??? This may fix extra \loff's (bit 8 of ipl) in measures with >255 notes. */
23891 
23892 /*        ipl(ivxo(in),ipo(in)) = ior(ipl(ivxo(in),ipo(in)),in) */
23893 	comipl2_1.ipl2[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] = in;
23894 /* L13: */
23895     }
23896 
23897 /*  Compute elemskips from start of bar to each note in the bar, for beam slopes */
23898 
23899     eskzb = 0.f;
23900     ib = 1;
23901     i__1 = comntot_1.ntot;
23902     for (in = 1; in <= i__1; ++in) {
23903 	if (in == istart[ib]) {
23904 	    r__1 = comnsp_2.space[ib - 1] / squez[ib];
23905 	    deskb = squez[ib] * feon_(&r__1);
23906 	} else if (all_1.tno[in - 2] > comtol_1.tol) {
23907 	    eskzb += deskb;
23908 	}
23909 	all_1.eskz[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] = eskzb;
23910 	comeskz2_1.eskz2[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] =
23911 		eskzb;
23912 	if (in == istop[ib]) {
23913 	    eskzb += deskb;
23914 	    ++ib;
23915 	}
23916 /* L30: */
23917     }
23918 
23919 /*  Debug writes */
23920 
23921 /*      print* */
23922 /*      write(*,'(16f5.1)')(eskz(ivxo(in),ipo(in)),in=1,ntot) */
23923 /*      print*,'PMXB has now got blocks' */
23924 /*      write(*,'(16i5)')(istart(ib),ib=1,nb) */
23925 /*      write(*,'(16i5)')(istop(ib),ib=1,nb) */
23926 /*      write(*,'(16f5.1)')(space(ib),ib=1,nb) */
23927 /*      write(*,'(16f5.1)')(squez(ib),ib=1,nb) */
23928 /*      write(*,'(16f5.1)')(fnote(nodur,ivxo(in),ipo(in),nacc),in=1,ntot) */
23929 /* c     write(*,'(26i3)')(iand(islur(ivxo(in),ipo(in)),30720)/2048, */
23930 /*    *                  in=1,ntot) */
23931 /*     write(*,'(1x,26a3)')(ornq(ivxo(in),ipo(in)),in=1,ntot) */
23932 
23933 
23934 /*  Analyze for beams. */
23935 
23936     i__1 = all_1.nv;
23937     for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
23938 	i__2 = commvl_1.nvmx[all_1.iv - 1];
23939 	for (kv = 1; kv <= i__2; ++kv) {
23940 	    commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
23941 	    numbms[commvl_1.ivx] = 0;
23942 	    mapfb[0] = 0;
23943 	    mapfb[1] = 0;
23944 	    mapfb[2] = 0;
23945 	    mapfb[3] = 0;
23946 
23947 /*  First forced beams. */
23948 
23949 	    if (comfb_1.nfb[commvl_1.ivx - 1] > 0) {
23950 
23951 /*  tglp2 is time from start of gulp to end of current bar. */
23952 
23953 		nfbbar = 0;
23954 		i__3 = comfb_1.nfb[commvl_1.ivx - 1];
23955 		for (comfb_1.ifb = 1; comfb_1.ifb <= i__3; ++comfb_1.ifb) {
23956 		    if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] >
23957 			    tglp2 - comtol_1.tol) {
23958 			goto L81;
23959 		    }
23960 		    ++nfbbar;
23961 		    ++numbms[commvl_1.ivx];
23962 		    numnew = numbms[commvl_1.ivx];
23963 
23964 /*  Times from beginning of bar */
23965 
23966 		    itbb1 = (integer) (comfb_1.t1fb[commvl_1.ivx +
23967 			    comfb_1.ifb * 24 - 25] - *tglp1 + comtol_1.tol);
23968 		    itbb2 = (integer) (comfb_1.t2fb[commvl_1.ivx +
23969 			    comfb_1.ifb * 24 - 25] - *tglp1 + comtol_1.tol);
23970 		    i__4 = all_1.nn[commvl_1.ivx - 1];
23971 		    for (ip = 1; ip <= i__4; ++ip) {
23972 			if ((integer) (all_1.to[comipl2_1.ipl2[commvl_1.ivx +
23973 				ip * 24 - 25] - 1] + comtol_1.tol) == itbb1) {
23974 			    nip1fb = ip;
23975 			    i__5 = all_1.nn[commvl_1.ivx - 1];
23976 			    for (ip1 = ip; ip1 <= i__5; ++ip1) {
23977 				inip1 = comipl2_1.ipl2[commvl_1.ivx + ip1 *
23978 					24 - 25];
23979 				if ((r__1 = all_1.to[inip1 - 1] + all_1.tnote[
23980 					inip1 - 1] - itbb2, dabs(r__1)) <
23981 					comtol_1.tol) {
23982 				    nip2fb = ip1;
23983 				    itbb3 = itbb2 - 2;
23984 				    goto L85;
23985 				}
23986 /* L84: */
23987 			    }
23988 			}
23989 /* L83: */
23990 		    }
23991 		    s_wsle(&io___937);
23992 		    e_wsle();
23993 		    s_wsle(&io___938);
23994 		    do_lio(&c__9, &c__1, "Timing problem w/ forced beams", (
23995 			    ftnlen)30);
23996 		    e_wsle();
23997 		    s_wsfe(&io___939);
23998 		    do_fio(&c__1, "Timing problem w/ forced beams", (ftnlen)
23999 			    30);
24000 		    e_wsfe();
24001 L85:
24002 		    logbeam_(&numnew, &nip1fb, &nip2fb);
24003 
24004 /*  Set up mapfb for forced beam just logged: */
24005 
24006 		    ib1 = itbb1 / 2;
24007 		    ib2 = itbb3 / 2;
24008 		    ibrep = all_1.lenbar / *ibmrep / 2;
24009 		    i__4 = *ibmrep;
24010 		    for (irep = 1; irep <= i__4; ++irep) {
24011 /* Computing MAX */
24012 			i__5 = 0, i__6 = ib1 - (irep - 1) * ibrep;
24013 			ib1now = max(i__5,i__6);
24014 /* Computing MIN */
24015 			i__5 = irep * ibrep - 1, i__6 = ib2 - (irep - 1) *
24016 				ibrep;
24017 			ib2now = min(i__5,i__6);
24018 			mapnow = 0;
24019 			i__5 = ib2now;
24020 			for (ib = ib1now; ib <= i__5; ++ib) {
24021 			    mapnow = bit_set(mapnow,ib);
24022 /* L87: */
24023 			}
24024 			mapfb[irep - 1] |= mapnow;
24025 /* L86: */
24026 		    }
24027 
24028 /*  Since we are cycling thru forced beams, for those that start with a rest and */
24029 /*    have height & slope adjustments, move adjustments to next note. */
24030 /*  060924: Copy to ALL later notes in fb, in case there's more than 1 rest at */
24031 /*    start of beam */
24032 
24033 		    if (bit_test(all_1.irest[commvl_1.ivx + nip1fb * 24 - 25],
24034 			    0)) {
24035 /*              call setbits(ipl(ivx,nip1fb+1),6,11, */
24036 /*     *                 igetbits(ipl(ivx,nip1fb),6,11)) */
24037 /*              call setbits(ipl(ivx,nip1fb+1),6,17, */
24038 /*     *                 igetbits(ipl(ivx,nip1fb),6,17)) */
24039 /*              call setbits(islur(ivx,nip1fb+1),2,27, */
24040 /*     *                 igetbits(islur(ivx,nip1fb),2,27)) */
24041 			i__4 = nip2fb;
24042 			for (kp = nip1fb + 1; kp <= i__4; ++kp) {
24043 			    i__5 = igetbits_(&all_1.ipl[commvl_1.ivx + nip1fb
24044 				    * 24 - 25], &c__6, &c__11);
24045 			    setbits_(&all_1.ipl[commvl_1.ivx + kp * 24 - 25],
24046 				    &c__6, &c__11, &i__5);
24047 			    i__5 = igetbits_(&all_1.ipl[commvl_1.ivx + nip1fb
24048 				    * 24 - 25], &c__6, &c__17);
24049 			    setbits_(&all_1.ipl[commvl_1.ivx + kp * 24 - 25],
24050 				    &c__6, &c__17, &i__5);
24051 			    i__5 = igetbits_(&all_1.islur[commvl_1.ivx +
24052 				    nip1fb * 24 - 25], &c__2, &c__27);
24053 			    setbits_(&all_1.islur[commvl_1.ivx + kp * 24 - 25]
24054 				    , &c__2, &c__27, &i__5);
24055 /* L88: */
24056 			}
24057 		    }
24058 /* L80: */
24059 		}
24060 L81:
24061 
24062 /*  Slide down, reduce nfb(ivx).  This lets us count up from 1 for each new bar. */
24063 /*  Remember, makeabar is called 1/bar, and it calls findbeam once per voice. */
24064 
24065 		if (nfbbar > 0) {
24066 		    comfb_1.nfb[commvl_1.ivx - 1] -= nfbbar;
24067 		    i__3 = comfb_1.nfb[commvl_1.ivx - 1];
24068 		    for (comfb_1.ifb = 1; comfb_1.ifb <= i__3; ++comfb_1.ifb)
24069 			    {
24070 			comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] =
24071 				comfb_1.t1fb[commvl_1.ivx + (comfb_1.ifb +
24072 				nfbbar) * 24 - 25];
24073 			comfb_1.t2fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] =
24074 				comfb_1.t2fb[commvl_1.ivx + (comfb_1.ifb +
24075 				nfbbar) * 24 - 25];
24076 			*(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx +
24077 				comfb_1.ifb * 24 - 25] = *(unsigned char *)&
24078 				comfb_1.ulfbq[commvl_1.ivx + (comfb_1.ifb +
24079 				nfbbar) * 24 - 25];
24080 /* L82: */
24081 		    }
24082 		}
24083 	    }
24084 	    comfb_1.ifb = 0;
24085 
24086 /*  Done with forced beam masks for this bar and voice.  Now get normal beams. */
24087 
24088 	    findbeam_(ibmrep, &numbms[1], mapfb);
24089 /* L20: */
24090 	}
24091     }
24092     return 0;
24093 } /* make1bar_ */
24094 
make2bar_(integer * ninow,real * tglp1,real * tstart,logical * cwrest,real * squez,integer * istop,integer * numbms,integer * istart,char * clefq,ftnlen clefq_len)24095 /* Subroutine */ int make2bar_(integer *ninow, real *tglp1, real *tstart,
24096 	logical *cwrest, real *squez, integer *istop, integer *numbms,
24097 	integer *istart, char *clefq, ftnlen clefq_len)
24098 {
24099     /* System generated locals */
24100     address a__1[6], a__2[2], a__3[5], a__4[3], a__5[4], a__6[8], a__7[7];
24101     integer i__1, i__2, i__3[6], i__4[2], i__5[5], i__6[3], i__7, i__8[4],
24102 	    i__9, i__10[8], i__11, i__12, i__13[7];
24103     real r__1, r__2;
24104     logical L__1;
24105     char ch__1[80], ch__2[82], ch__3[12], ch__4[1], ch__5[17], ch__6[16],
24106 	    ch__7[11], ch__8[10], ch__9[44], ch__10[81], ch__11[113], ch__12[
24107 	    3], ch__13[9], ch__14[129], ch__15[6], ch__16[5], ch__17[4],
24108 	    ch__18[14], ch__19[22];
24109     cilist ci__1;
24110 
24111     /* Builtin functions */
24112     integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
24113 	    ;
24114     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
24115     integer s_wsfe(cilist *), e_wsfe(void), lbit_shift(integer, integer),
24116 	    i_nint(real *), s_wsle(cilist *), do_lio(integer *, integer *,
24117 	    char *, ftnlen), e_wsle(void);
24118     /* Subroutine */ int s_stop(char *, ftnlen);
24119     integer pow_ii(integer *, integer *);
24120     double r_lg10(real *);
24121     integer s_cmp(char *, char *, ftnlen, ftnlen);
24122 
24123     /* Local variables */
24124     extern integer igetbits_(integer *, integer *, integer *);
24125     extern logical isdotted_(integer *, integer *, integer *);
24126     extern /* Subroutine */ int beamstrt_(char *, integer *, integer *,
24127 	    integer *, real *, real *, integer *, ftnlen);
24128     static real ptsavail;
24129     extern /* Subroutine */ int dopsslur_(integer *, integer *, integer *,
24130 	    integer *, integer *, integer *, integer *, integer *, integer *,
24131 	    integer *, logical *, integer *, char *, integer *, char *,
24132 	    integer *, integer *, integer *, integer *, real *, integer *,
24133 	    ftnlen, ftnlen), midievent_(char *, integer *, integer *, ftnlen);
24134     static real stemshort;
24135     static integer ib, ig, il, in, ip, kv;
24136     extern /* Subroutine */ int adjusteskz_(integer *, real *, integer *,
24137 	    integer *, real *);
24138     static integer iib, icm, ing, len;
24139     static real esk, xnd;
24140     static integer ivf, iiv;
24141     static real wgr, pts;
24142     static logical secondgrace;
24143     extern integer log2_(integer *);
24144     extern /* Subroutine */ int chkkbdrests_(integer *, integer *, integer *,
24145 	    integer *, integer *, integer *, integer *, integer *, integer *,
24146 	    integer *, integer *, integer *, real *, real *, integer *,
24147 	    integer *, integer *, integer *, integer *);
24148     static integer iacc, kacc, macc, ifig[2], icrd, ndig;
24149     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
24150     extern doublereal feon_(real *);
24151     static integer lcwr[24];
24152     extern /* Character */ VOID udqq_(char *, ftnlen, integer *, integer *,
24153 	    integer *, integer *, integer *, integer *);
24154     static char cwrq[79*24];
24155     static real ptgr[37], spgr, ptsl, zero, tnow;
24156     static integer nodu;
24157     extern /* Subroutine */ int eskb4_(integer *, integer *, integer *,
24158 	    integer *, real *, real *, real *, integer *, real *), stop1_(
24159 	    void), doacc_(integer *, integer *, char *, integer *, integer *,
24160 	    integer *, integer *, logical *, ftnlen);
24161     static logical isacc;
24162     static integer nclef, iaskb[24];
24163     static logical iscln, issig;
24164     static integer nornb[24];
24165     static logical isarp, isdot;
24166     static integer lnote;
24167     static char noteq[8];
24168     static logical iscwr;
24169     static char soutq[80];
24170     static integer lsout, itrpt, itsig;
24171     extern integer ncmid_(integer *, integer *);
24172     static integer iirpt, lclow;
24173     extern /* Subroutine */ int dodyn_(integer *, integer *, integer *,
24174 	    integer *, integer *, integer *, integer *, integer *, integer *,
24175 	    logical *, integer *, integer *, char *, integer *, logical *,
24176 	    char *, integer *, ftnlen, ftnlen), docrd_(integer *, integer *,
24177 	    integer *, integer *, integer *, real *, char *, integer *, char *
24178 	    , integer *, integer *, integer *, integer *, logical *, integer *
24179 	    , integer *, integer *, real *, logical *, integer *, ftnlen,
24180 	    ftnlen), putcb_(integer *, integer *, char *, integer *, ftnlen),
24181 	    beamn1_(char *, integer *, ftnlen), notex_(char *, integer *,
24182 	    ftnlen);
24183     static logical iscacc;
24184     extern /* Subroutine */ int addask_(real *, real *, real *, real *, real *
24185 	    , real *, logical *);
24186     static logical isclef, isflag, isaccs, bspend, isgaft;
24187     static real ptclef[24];
24188     static integer ihornb[576]	/* was [24][24] */;
24189     static real eskndg[24], ptsndg[24];
24190     static logical rpndot;
24191     static char notexq[79];
24192     static logical stemup, beamon1[24];
24193     static integer ibmcnt1[24], lnoten;
24194     extern /* Subroutine */ int wsclef_(integer *, integer *, char *, integer
24195 	    *, ftnlen);
24196     static real eonsqz;
24197     extern /* Subroutine */ int precrd_(integer *, integer *, integer *,
24198 	    integer *, integer *, integer *, char *, logical *, integer *,
24199 	    ftnlen), chkarp_(integer *, integer *, integer *, integer *,
24200 	    logical *, logical *);
24201     static integer ibmchk;
24202     static real taccfac, esksav, ptsadd;
24203     static integer ihshft;
24204     extern /* Subroutine */ int addstr_(char *, integer *, char *, integer *,
24205 	    ftnlen, ftnlen);
24206     static integer lchead;
24207     extern integer lenstr_(char *, integer *, ftnlen);
24208     static integer islhgt;
24209     static real offnsk;
24210     extern /* Subroutine */ int putfig_(integer *, integer *, real *, logical
24211 	    *, char *, integer *, ftnlen), putarp_(real *, integer *, integer
24212 	    *, integer *, integer *, char *, integer *, ftnlen), doslur_(
24213 	    integer *, integer *, integer *, integer *, integer *, integer *,
24214 	    integer *, integer *, integer *, logical *, integer *, char *,
24215 	    integer *, char *, integer *, integer *, integer *, integer *,
24216 	    real *, integer *, ftnlen, ftnlen);
24217     static integer iphold;
24218     extern /* Subroutine */ int dograce_(integer *, integer *, real *, char *,
24219 	     integer *, integer *, integer *, integer *, integer *, logical *,
24220 	     logical *, integer *, integer *, integer *, integer *, integer *,
24221 	     integer *, real *, char *, integer *, ftnlen, ftnlen), notefq_(
24222 	    char *, integer *, integer *, integer *, ftnlen), addmidi_(
24223 	    integer *, integer *, integer *, integer *, real *, logical *,
24224 	    logical *), putorn_(integer *, integer *, integer *, integer *,
24225 	    integer *, char *, integer *, integer *, integer *, integer *,
24226 	    integer *, integer *, integer *, real *, char *, integer *,
24227 	    integer *, integer *, logical *, logical *, ftnlen, ftnlen),
24228 	    dotmov_(real *, real *, char *, integer *, integer *, ftnlen),
24229 	    beamend_(char *, integer *, ftnlen), beamid_(char *, integer *,
24230 	    ftnlen);
24231     static logical isgrace;
24232     static integer icashft;
24233     static real ptbneed;
24234     static integer itleft, itendb;
24235     extern integer iashft_(integer *);
24236     static real ptsneed;
24237     extern /* Subroutine */ int clefsym_(integer *, char *, integer *,
24238 	    integer *, ftnlen);
24239     static logical isrshft, isfirst, nofirst;
24240     extern /* Subroutine */ int endslur_(logical *, logical *, integer *,
24241 	    integer *, integer *, integer *, integer *, char *, integer *,
24242 	    logical *, ftnlen);
24243     static char slurudq[1];
24244     extern /* Subroutine */ int putshft_(integer *, logical *, char *,
24245 	    integer *, ftnlen), setbits_(integer *, integer *, integer *,
24246 	    integer *);
24247     static integer itright, nolevc, ivlast;
24248     extern /* Subroutine */ int istring_(integer *, char *, integer *, ftnlen)
24249 	    ;
24250     static integer mtrspc;
24251     static real wheadpt1;
24252 
24253     /* Fortran I/O blocks */
24254     static icilist io___959 = { 0, noteq, 0, "(1H{,i3,1H})", 5, 1 };
24255     static icilist io___961 = { 0, noteq, 0, "(1H{,i2,1H})", 4, 1 };
24256     static icilist io___962 = { 0, noteq, 0, "(i1)", 1, 1 };
24257     static cilist io___965 = { 0, 11, 0, "(a)", 0 };
24258     static cilist io___966 = { 0, 11, 0, "(a)", 0 };
24259     static cilist io___969 = { 0, 11, 0, "(a)", 0 };
24260     static icilist io___972 = { 0, soutq+8, 0, "(f4.1)", 4, 1 };
24261     static icilist io___973 = { 0, soutq+8, 0, "(f4.2)", 4, 1 };
24262     static icilist io___974 = { 0, soutq+10, 0, "(i2)", 2, 1 };
24263     static icilist io___975 = { 0, soutq+11, 0, "(i1)", 1, 1 };
24264     static cilist io___980 = { 0, 6, 0, 0, 0 };
24265     static cilist io___981 = { 0, 6, 0, 0, 0 };
24266     static cilist io___1001 = { 0, 6, 0, 0, 0 };
24267     static cilist io___1017 = { 0, 11, 0, "(a)", 0 };
24268     static cilist io___1018 = { 0, 11, 0, "(a)", 0 };
24269     static cilist io___1019 = { 0, 11, 0, "(a)", 0 };
24270     static cilist io___1020 = { 0, 11, 0, "(a)", 0 };
24271     static cilist io___1021 = { 0, 11, 0, "(a)", 0 };
24272     static cilist io___1022 = { 0, 6, 0, 0, 0 };
24273     static cilist io___1023 = { 0, 11, 0, "(a)", 0 };
24274     static cilist io___1024 = { 0, 11, 0, "(a)", 0 };
24275     static cilist io___1025 = { 0, 11, 0, "(a)", 0 };
24276     static icilist io___1029 = { 0, notexq+11, 0, "(i2)", 2, 1 };
24277     static icilist io___1035 = { 0, notexq+6, 0, "(f3.1)", 3, 1 };
24278     static icilist io___1036 = { 0, notexq+6, 0, "(f4.1)", 4, 1 };
24279     static icilist io___1038 = { 0, notexq+5, 0, "(f3.1)", 3, 1 };
24280     static icilist io___1039 = { 0, notexq+5, 0, "(f4.1)", 4, 1 };
24281     static cilist io___1041 = { 0, 6, 0, 0, 0 };
24282     static cilist io___1042 = { 0, 11, 0, "(a)", 0 };
24283     static cilist io___1043 = { 0, 11, 0, "(a)", 0 };
24284     static icilist io___1050 = { 0, notexq, 0, "(f4.2)", 79, 1 };
24285     static cilist io___1053 = { 0, 6, 0, 0, 0 };
24286     static cilist io___1066 = { 0, 11, 0, "(a)", 0 };
24287     static cilist io___1069 = { 0, 11, 0, "(a)", 0 };
24288     static cilist io___1072 = { 0, 11, 0, "(a)", 0 };
24289     static cilist io___1074 = { 0, 11, 0, "(a)", 0 };
24290 
24291 
24292 
24293 /*  Factors for grace note, clef spacing. (fraction of wheadpt) */
24294 /*  In 1.04, moved to block data subprogram */
24295 
24296 /* 130316 */
24297 
24298 
24299 /*  Set up main ib loop within which a block (notes group) is written */
24300 
24301     /* Parameter adjustments */
24302     --clefq;
24303     --istart;
24304     --numbms;
24305     --istop;
24306     --squez;
24307     --cwrest;
24308     --tstart;
24309 
24310     /* Function Body */
24311     i__1 = all_1.nv;
24312     for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
24313 	i__2 = commvl_1.nvmx[all_1.iv - 1];
24314 	for (kv = 1; kv <= i__2; ++kv) {
24315 	    commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
24316 	    all_1.ibmcnt[commvl_1.ivx - 1] = 1;
24317 	    ibmcnt1[commvl_1.ivx - 1] = 1;
24318 	    all_1.beamon[commvl_1.ivx - 1] = FALSE_;
24319 	    beamon1[commvl_1.ivx - 1] = FALSE_;
24320 	    nornb[commvl_1.ivx - 1] = 0;
24321 	    iaskb[commvl_1.ivx - 1] = 1;
24322 	    comxtup_1.vxtup[commvl_1.ivx - 1] = FALSE_;
24323 	    comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_;
24324 /* L25: */
24325 	}
24326     }
24327     comas1_1.naskb = 0;
24328     ifig[0] = 1;
24329     ifig[1] = 1;
24330     comxtup_1.ixtup = 0;
24331     bspend = FALSE_;
24332     iscwr = FALSE_;
24333     rpndot = FALSE_;
24334     i__2 = comnsp_2.nb;
24335     for (ib = 1; ib <= i__2; ++ib) {
24336 
24337 /*  Check for segno */
24338 
24339 	if (bit_test(all_1.iornq[all_1.ipo[istart[ib] - 1] * 24],4) &&
24340 		all_1.ivxo[istart[ib] - 1] == 1) {
24341 	    if (comgrace_1.noffseg <= -10) {
24342 		s_wsfi(&io___959);
24343 		do_fio(&c__1, (char *)&comgrace_1.noffseg, (ftnlen)sizeof(
24344 			integer));
24345 		e_wsfi();
24346 		lnoten = 5;
24347 	    } else if (comgrace_1.noffseg < 0 || comgrace_1.noffseg >= 10) {
24348 		s_wsfi(&io___961);
24349 		do_fio(&c__1, (char *)&comgrace_1.noffseg, (ftnlen)sizeof(
24350 			integer));
24351 		e_wsfi();
24352 		lnoten = 4;
24353 	    } else {
24354 		s_wsfi(&io___962);
24355 		do_fio(&c__1, (char *)&comgrace_1.noffseg, (ftnlen)sizeof(
24356 			integer));
24357 		e_wsfi();
24358 		lnoten = 1;
24359 	    }
24360 /* Writing concatenation */
24361 	    i__3[0] = 1, a__1[0] = all_1.sq;
24362 	    i__3[1] = 6, a__1[1] = "znotes";
24363 	    i__3[2] = 1, a__1[2] = all_1.sq;
24364 	    i__3[3] = 6, a__1[3] = "segnoo";
24365 	    i__3[4] = lnoten, a__1[4] = noteq;
24366 	    i__3[5] = 1, a__1[5] = "9";
24367 	    s_cat(notexq, a__1, i__3, &c__6, (ftnlen)79);
24368 	    lnote = lnoten + 15;
24369 	    i__1 = all_1.nv;
24370 	    for (all_1.iv = 2; all_1.iv <= i__1; ++all_1.iv) {
24371 		if (lnote > 60) {
24372 		    if (comlast_1.islast) {
24373 			s_wsfe(&io___965);
24374 /* Writing concatenation */
24375 			i__4[0] = lnote, a__2[0] = notexq;
24376 			i__4[1] = 1, a__2[1] = "%";
24377 			s_cat(ch__1, a__2, i__4, &c__2, (ftnlen)80);
24378 			do_fio(&c__1, ch__1, lnote + 1);
24379 			e_wsfe();
24380 		    }
24381 /* Writing concatenation */
24382 		    i__5[0] = 1, a__3[0] = all_1.sepsymq + (all_1.iv - 2);
24383 		    i__5[1] = 1, a__3[1] = all_1.sq;
24384 		    i__5[2] = 6, a__3[2] = "segnoo";
24385 		    i__5[3] = lnoten, a__3[3] = noteq;
24386 		    i__5[4] = 1, a__3[4] = "9";
24387 		    s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
24388 		    lnote = lnoten + 9;
24389 		} else {
24390 /* Writing concatenation */
24391 		    i__3[0] = lnote, a__1[0] = notexq;
24392 		    i__3[1] = 1, a__1[1] = all_1.sepsymq + (all_1.iv - 2);
24393 		    i__3[2] = 1, a__1[2] = all_1.sq;
24394 		    i__3[3] = 6, a__1[3] = "segnoo";
24395 		    i__3[4] = lnoten, a__1[4] = noteq;
24396 		    i__3[5] = 1, a__1[5] = "9";
24397 		    s_cat(notexq, a__1, i__3, &c__6, (ftnlen)79);
24398 		    lnote = lnote + lnoten + 9;
24399 		}
24400 /* L130: */
24401 	    }
24402 	    if (comlast_1.islast) {
24403 		s_wsfe(&io___966);
24404 /* Writing concatenation */
24405 		i__6[0] = lnote, a__4[0] = notexq;
24406 		i__6[1] = 1, a__4[1] = all_1.sq;
24407 		i__6[2] = 2, a__4[2] = "en";
24408 		s_cat(ch__2, a__4, i__6, &c__3, (ftnlen)82);
24409 		do_fio(&c__1, ch__2, lnote + 3);
24410 		e_wsfe();
24411 	    }
24412 	    lnote = 0;
24413 	}
24414 
24415 /*  Check for new clefs */
24416 
24417 	isclef = FALSE_;
24418 	if (bit_test(all_1.islur[all_1.ivxo[istart[ib] - 1] + all_1.ipo[
24419 		istart[ib] - 1] * 24 - 25],15)) {
24420 
24421 /*  In preceding line, fl32 gave wrong result for ... .gt.0 !!! */
24422 
24423 	    i__1 = istop[ib];
24424 	    for (in = istart[ib]; in <= i__1; ++in) {
24425 		if (bit_test(all_1.islur[all_1.ivxo[in - 1] + all_1.ipo[in -
24426 			1] * 24 - 25],11)) {
24427 		    i__7 = lbit_shift(all_1.islur[all_1.ivxo[in - 1] +
24428 			    all_1.ipo[in - 1] * 24 - 25], (ftnlen)-12) & 7;
24429 		    wsclef_(&all_1.ivxo[in - 1], ninow, clefq + 1, &i__7, (
24430 			    ftnlen)1);
24431 		}
24432 /* L140: */
24433 	    }
24434 	    if (comlast_1.islast) {
24435 		s_wsfe(&io___969);
24436 /* Writing concatenation */
24437 		i__4[0] = 1, a__2[0] = all_1.sq;
24438 		i__4[1] = 11, a__2[1] = "pmxnewclefs";
24439 		s_cat(ch__3, a__2, i__4, &c__2, (ftnlen)12);
24440 		do_fio(&c__1, ch__3, (ftnlen)12);
24441 		e_wsfe();
24442 	    }
24443 	    isclef = TRUE_;
24444 	}
24445 
24446 /*  Start a notes group.  We're just gonna define every one using pnotes{n}, */
24447 /*    where \def\pnotes#1{\vnotes#1\elemskip} */
24448 
24449 /* Writing concatenation */
24450 	i__4[0] = 1, a__2[0] = all_1.sq;
24451 	i__4[1] = 7, a__2[1] = "pnotes{";
24452 	s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80);
24453 	r__1 = comnsp_2.space[ib - 1] / squez[ib];
24454 	eonsqz = squez[ib] * feon_(&r__1);
24455 	if (eonsqz > 9.995f) {
24456 	    s_wsfi(&io___972);
24457 	    do_fio(&c__1, (char *)&eonsqz, (ftnlen)sizeof(real));
24458 	    e_wsfi();
24459 	} else if (eonsqz > .995f) {
24460 	    s_wsfi(&io___973);
24461 	    do_fio(&c__1, (char *)&eonsqz, (ftnlen)sizeof(real));
24462 	    e_wsfi();
24463 	} else if (eonsqz > .095f) {
24464 /* Writing concatenation */
24465 	    i__4[0] = 8, a__2[0] = soutq;
24466 	    i__4[1] = 2, a__2[1] = "0.";
24467 	    s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80);
24468 	    s_wsfi(&io___974);
24469 	    r__1 = eonsqz * 100;
24470 	    i__1 = i_nint(&r__1);
24471 	    do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
24472 	    e_wsfi();
24473 	} else {
24474 /* Writing concatenation */
24475 	    i__4[0] = 8, a__2[0] = soutq;
24476 	    i__4[1] = 3, a__2[1] = "0.0";
24477 	    s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80);
24478 	    s_wsfi(&io___975);
24479 	    r__1 = eonsqz * 100;
24480 	    i__1 = i_nint(&r__1);
24481 	    do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
24482 	    e_wsfi();
24483 	}
24484 /* Writing concatenation */
24485 	i__4[0] = 12, a__2[0] = soutq;
24486 	i__4[1] = 1, a__2[1] = "}";
24487 	s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80);
24488 	lsout = 13;
24489 
24490 /*  Check whole block, flag accidentals etc that are too close, one per *time*. */
24491 /*  Note about bar starts and after rpt's/boublebars: There is an afterruleskip */
24492 /*    (fbar*wheadpt) following, but rpts seem to occupy some of that gap, so */
24493 /*    (dotsfac*wheadpt) is presumed to be filled up. */
24494 
24495 	in = istart[ib] - 1;
24496 	itrpt = -1;
24497 	itsig = -1;
24498 
24499 /*  Begin big manual loop over notes in this block; ends at 112 */
24500 
24501 L111:
24502 	++in;
24503 	if (in > istop[ib]) {
24504 	    goto L112;
24505 	}
24506 	ip = all_1.ipo[in - 1];
24507 	commvl_1.ivx = all_1.ivxo[in - 1];
24508 	if (commvl_1.ivx <= all_1.nv) {
24509 	    all_1.iv = commvl_1.ivx;
24510 	} else {
24511 	    i__1 = all_1.nv;
24512 	    for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
24513 		if (commvl_1.nvmx[all_1.iv - 1] == 2 && commvl_1.ivmx[
24514 			all_1.iv + 23] == commvl_1.ivx) {
24515 		    goto L129;
24516 		}
24517 /* L128: */
24518 	    }
24519 	    s_wsle(&io___980);
24520 	    do_lio(&c__9, &c__1, "Trouble finding iv!, ivx,nvmx,ivmx:", (
24521 		    ftnlen)35);
24522 	    do_lio(&c__3, &c__1, (char *)&commvl_1.ivx, (ftnlen)sizeof(
24523 		    integer));
24524 	    do_lio(&c__3, &c__1, (char *)&commvl_1.nvmx[0], (ftnlen)sizeof(
24525 		    integer));
24526 	    do_lio(&c__3, &c__1, (char *)&commvl_1.nvmx[1], (ftnlen)sizeof(
24527 		    integer));
24528 	    e_wsle();
24529 	    s_wsle(&io___981);
24530 	    do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[0], (ftnlen)sizeof(
24531 		    integer));
24532 	    do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[24], (ftnlen)sizeof(
24533 		    integer));
24534 	    do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[1], (ftnlen)sizeof(
24535 		    integer));
24536 	    do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[25], (ftnlen)sizeof(
24537 		    integer));
24538 	    e_wsle();
24539 	    s_stop("", (ftnlen)0);
24540 	}
24541 L129:
24542 
24543 /*  Call precrd here so we know how much space to add for accid's in chords */
24544 /*    After calling precrd, icashft>0 means there is a shifted chordal accid (incl. */
24545 /*    main note. */
24546 
24547 /*  To call precrd, need up-downness, so must track if in beam. */
24548 
24549 /*  Deal w/ staff-jumping beams later */
24550 /*         if ((numbms(ivx).gt.0 .and. ibmcnt(ivx).le.numbms(ivx) */
24551 /*     *          .and. ibm1(ivx,ibmcnt(ivx)) .eq. ip) .or. */
24552 /*     *          btest(nacc(ivx,ip),21)) then */
24553 /*           if (.not.btest(irest(ivx,ip),24)) then */
24554 	if (numbms[commvl_1.ivx] > 0 && ibmcnt1[commvl_1.ivx - 1] <= numbms[
24555 		commvl_1.ivx] && all_1.ibm1[commvl_1.ivx + ibmcnt1[
24556 		commvl_1.ivx - 1] * 24 - 25] == ip) {
24557 	    beamon1[commvl_1.ivx - 1] = TRUE_;
24558 	}
24559 	icashft = 0;
24560 	if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) {
24561 
24562 /*  There is a chord on this note. Need up-down-ness in precrd to auto shift for 2nds. */
24563 
24564 	    if (beamon1[commvl_1.ivx - 1]) {
24565 		precrd_(&commvl_1.ivx, &ip, &all_1.nolev[commvl_1.ivx + ip *
24566 			24 - 25], &all_1.nacc[commvl_1.ivx + ip * 24 - 25], &
24567 			all_1.ipl[commvl_1.ivx + ip * 24 - 25], &all_1.irest[
24568 			commvl_1.ivx + ip * 24 - 25], all_1.ulq + (
24569 			commvl_1.ivx + ibmcnt1[commvl_1.ivx - 1] * 24 - 25), &
24570 			c_false, &icashft, (ftnlen)1);
24571 	    } else {
24572 		i__1 = ncmid_(&all_1.iv, &ip);
24573 		udqq_(ch__4, (ftnlen)1, &all_1.nolev[commvl_1.ivx + ip * 24 -
24574 			25], &i__1, &all_1.islur[commvl_1.ivx + ip * 24 - 25],
24575 			 &commvl_1.nvmx[all_1.iv - 1], &commvl_1.ivx, &
24576 			all_1.nv);
24577 		precrd_(&commvl_1.ivx, &ip, &all_1.nolev[commvl_1.ivx + ip *
24578 			24 - 25], &all_1.nacc[commvl_1.ivx + ip * 24 - 25], &
24579 			all_1.ipl[commvl_1.ivx + ip * 24 - 25], &all_1.irest[
24580 			commvl_1.ivx + ip * 24 - 25], ch__4, &c_false, &
24581 			icashft, (ftnlen)1);
24582 	    }
24583 	}
24584 
24585 /*  Turn beam off? */
24586 
24587 	if (beamon1[commvl_1.ivx - 1] && all_1.ibm2[commvl_1.ivx + ibmcnt1[
24588 		commvl_1.ivx - 1] * 24 - 25] == ip) {
24589 	    beamon1[commvl_1.ivx - 1] = FALSE_;
24590 	    ++ibmcnt1[commvl_1.ivx - 1];
24591 	}
24592 
24593 /*  Remember, rpts & internal sigs can only come at start of (internal) block */
24594 
24595 	isacc = (all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 3) > 0 && !
24596 		bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],17) && !
24597 		bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10);
24598 
24599 /*  i.e., do not set for chord. Now check for "(" as ornament on main note, */
24600 
24601 /* !!!  Need to do this for chord notes too.  Maybe in chkarp? */
24602 
24603 	isaccs = isacc || bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],0);
24604 
24605 /*  5/15/02 Add check for ) ornament of prior note. */
24606 /*  5/16 Nope...fails when grace intervenes. */
24607 /*        if (ip .gt. 1) then */
24608 /*          isaccs = isaccs .or. btest(iornq(ivx,ip-1),13) */
24609 /*        end if */
24610 	isarp = bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],27);
24611 	iscacc = FALSE_;
24612 	if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) {
24613 
24614 /*  There is a chord here; check for arpeggios and accidentals. Note accid shifts are */
24615 /*    not of concern here, only whether there's an accid, whick causes iscacc=.true. */
24616 
24617 	    iscacc = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], &
24618 		    c__3, &c__0) > 0 && ! bit_test(all_1.nacc[commvl_1.ivx +
24619 		    ip * 24 - 25],17);
24620 	    chkarp_(&comtrill_1.ncrd, comtrill_1.icrdat, &commvl_1.ivx, &ip, &
24621 		    iscacc, &isarp);
24622 	}
24623 
24624 /*  When we get motivated, will do spacing for arpeggios here. */
24625 
24626 	if (commvl_1.ivx == 1 && (all_1.islur[commvl_1.ivx + ip * 24 - 25] &
24627 		96) > 0) {
24628 	    itrpt = i_nint(&all_1.to[in - 1]);
24629 	}
24630 	issig = bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],28);
24631 	if (commvl_1.ivx == 1 && issig) {
24632 	    itsig = i_nint(&all_1.to[in - 1]);
24633 	}
24634 	isgrace = bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],4) && !
24635 		bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],29) && !
24636 		bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],31);
24637 	isgaft = FALSE_;
24638 	if (ip > 1) {
24639 	    xnd = all_1.tnote[comipl2_1.ipl2[commvl_1.ivx + (ip - 1) * 24 -
24640 		    25] - 1];
24641 	    isgaft = bit_test(all_1.ipl[commvl_1.ivx + (ip - 1) * 24 - 25],29)
24642 		     || bit_test(all_1.ipl[commvl_1.ivx + (ip - 1) * 24 - 25],
24643 		    31);
24644 	    isgrace = isgrace || isgaft;
24645 	}
24646 	iscln = isclef && bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],
24647 		11);
24648 
24649 /*  Is prev. note non-beamed, up-stemmed, & flagged? Recall if ip>1, have nd */
24650 
24651 	isflag = ip > 1 && xnd > comtol_1.tol && xnd < 16.f - comtol_1.tol;
24652 	if (isflag) {
24653 	    i__7 = ip - 1;
24654 	    i__1 = ncmid_(&all_1.iv, &i__7);
24655 	    udqq_(ch__4, (ftnlen)1, &all_1.nolev[commvl_1.ivx + (ip - 1) * 24
24656 		    - 25], &i__1, &all_1.islur[commvl_1.ivx + (ip - 1) * 24 -
24657 		    25], &commvl_1.nvmx[all_1.iv - 1], &commvl_1.ivx, &
24658 		    all_1.nv);
24659 	    isflag = ! bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25]
24660 		    ,0) && *(unsigned char *)&ch__4[0] == 'u';
24661 	}
24662 	if (isflag) {
24663 	    i__1 = numbms[commvl_1.ivx];
24664 	    for (ibmchk = 1; ibmchk <= i__1; ++ibmchk) {
24665 		if (ip - 1 < all_1.ibm1[commvl_1.ivx + ibmchk * 24 - 25]) {
24666 		    goto L117;
24667 
24668 /*  Add check for non-beamed xtuplets. May be problem with stem direction. */
24669 
24670 /*            else if (ip-1.le.ibm2(ivx,ibmchk)) then */
24671 		} else if (ip - 1 <= all_1.ibm2[commvl_1.ivx + ibmchk * 24 -
24672 			25] && ! bit_test(all_1.islur[commvl_1.ivx +
24673 			all_1.ibm1[commvl_1.ivx + ibmchk * 24 - 25] * 24 - 25]
24674 			,18)) {
24675 		    isflag = FALSE_;
24676 		    goto L117;
24677 		}
24678 /* L116: */
24679 	    }
24680 	}
24681 L117:
24682 
24683 /*  If isflag, then won't need to check for dot on prev. note. */
24684 
24685 /*  5/16/02 ???  Try using this for ) ornament. */
24686 
24687 	isflag = isflag || bit_test(all_1.iornq[commvl_1.ivx + (ip - 1) * 24
24688 		- 1],13);
24689 	isdot = ip > 1;
24690 	if (isdot) {
24691 	    i__1 = ip - 1;
24692 	    isdot = isdotted_(all_1.nodur, &commvl_1.ivx, &i__1);
24693 	}
24694 	isrshft = ip > 1;
24695 	if (isrshft) {
24696 	    isrshft = bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],
24697 		    20);
24698 	}
24699 	if (! (isaccs || isgrace || iscln || isflag || isrshft || isdot ||
24700 		bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],26) ||
24701 		bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],21) ||
24702 		isarp || bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],27)
24703 		 || iscacc)) {
24704 	    goto L111;
24705 	}
24706 
24707 /*  Here is an accid,grace,clef,flag,rtshft,dot,udsp,arpeg,left-shift. */
24708 /*  Compute pts, the total occupied space including prior notehead. */
24709 
24710 /* 130324 */
24711 /*        wheadpt1 = wheadpt*fullsize(iv) */
24712 	wheadpt1 = comask_1.wheadpt * comfig_1.fullsize[cominsttrans_1.instno[
24713 		all_1.iv - 1] - 1];
24714 	pts = wheadpt1;
24715 
24716 /*  Set up for possible cautionary accidental here */
24717 
24718 	if (isaccs || iscacc) {
24719 	    if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],31)) {
24720 		taccfac = spfacs_1.accfac;
24721 	    } else {
24722 		taccfac = spfacs_1.accfac * 1.4f;
24723 /* cautionary accidental */
24724 	    }
24725 	}
24726 	if (isgrace) {
24727 	    secondgrace = FALSE_;
24728 	    i__1 = comgrace_1.ngrace;
24729 	    for (ig = 1; ig <= i__1; ++ig) {
24730 		if (! isgaft) {
24731 		    if (comgrace_1.ipg[ig - 1] == ip && comgrace_1.ivg[ig - 1]
24732 			     == commvl_1.ivx) {
24733 			goto L123;
24734 		    }
24735 		} else if (ip > 1) {
24736 		    if (comgrace_1.ipg[ig - 1] == ip - 1 && comgrace_1.ivg[ig
24737 			    - 1] == commvl_1.ivx) {
24738 			goto L123;
24739 		    }
24740 		}
24741 /* L122: */
24742 	    }
24743 	    s_wsle(&io___1001);
24744 	    do_lio(&c__9, &c__1, "Problem finding grace index in makeabar", (
24745 		    ftnlen)39);
24746 	    e_wsle();
24747 	    s_stop("", (ftnlen)0);
24748 L123:
24749 
24750 /*  wgr = distance to backspace (in headwidths), less main acc. */
24751 /*  ptgr = same in pts,+ main acc.  Not used for after-grace. Distance to backspace. */
24752 /*  spgr = total space needed (w/o main acc). */
24753 /*   Also, spgr is same for b4 or after, but xb4fac-space will be in diff. place. */
24754 
24755 	    if (comgrace_1.nng[ig - 1] == 1) {
24756 		wgr = spfacs_1.grafac;
24757 		if (comgrace_1.multg[ig - 1] == 0) {
24758 		    wgr += -.4f;
24759 		}
24760 	    } else {
24761 		wgr = comgrace_1.nng[ig - 1] * spfacs_1.emgfac;
24762 		i__1 = comgrace_1.nng[ig - 1];
24763 		for (ing = 2; ing <= i__1; ++ing) {
24764 		    if (comgrace_1.naccg[comgrace_1.ngstrt[ig - 1] - 1 + ing
24765 			    - 1] > 0) {
24766 			wgr += spfacs_1.acgfac;
24767 		    }
24768 /* L126: */
24769 		}
24770 	    }
24771 	    if (comgrace_1.graspace[ig - 1] > 0.f) {
24772 
24773 /*  User-defined space before grace */
24774 
24775 		wgr += comgrace_1.graspace[ig - 1];
24776 	    }
24777 	    ptgr[ig - 1] = wgr * wheadpt1;
24778 	    spgr = ptgr[ig - 1] + spfacs_1.xb4fac * wheadpt1;
24779 
24780 /* !!! May need to mod for chord accid's */
24781 
24782 	    if (isaccs || iscacc) {
24783 		ptgr[ig - 1] += taccfac * wheadpt1;
24784 	    }
24785 	    if (comgrace_1.naccg[comgrace_1.ngstrt[ig - 1] - 1] > 0) {
24786 		spgr += wheadpt1 * spfacs_1.agc1fac;
24787 	    }
24788 	    pts += spgr;
24789 
24790 /*  Special check for after-grace on ip-1 and normal on ip. Must go back thru */
24791 /*   loop again for the normal grace. */
24792 
24793 	    if (isgaft && ig < comgrace_1.ngrace && ! secondgrace) {
24794 		if (comgrace_1.ipg[ig] == ip) {
24795 		    secondgrace = TRUE_;
24796 		    ++ig;
24797 		    goto L123;
24798 		}
24799 	    }
24800 	}
24801 	if (iscln) {
24802 	    pts += spfacs_1.clefac * wheadpt1;
24803 
24804 /*  How far to backspace when printing the clef */
24805 
24806 	    ptclef[commvl_1.ivx - 1] = 0.f;
24807 
24808 /* !!! May need to mod for chord accid's */
24809 
24810 	    if (isaccs || iscacc) {
24811 		ptclef[commvl_1.ivx - 1] += taccfac * wheadpt1;
24812 	    }
24813 	    if (isgrace) {
24814 		ptclef[commvl_1.ivx - 1] += spgr;
24815 	    }
24816 	}
24817 	if (isrshft) {
24818 	    pts += spfacs_1.rtshfac * wheadpt1;
24819 	} else if (isflag) {
24820 	    pts += spfacs_1.flagfac * wheadpt1;
24821 	} else if (isdot) {
24822 	    pts += spfacs_1.dotfac * wheadpt1;
24823 	}
24824 	if ((r__1 = all_1.to[in - 1] - itrpt, dabs(r__1)) < comtol_1.tol) {
24825 
24826 /*  Repeat, need a little extra space */
24827 
24828 	    pts += spfacs_1.dotsfac * wheadpt1;
24829 	}
24830 	if (isarp) {
24831 	    pts += spfacs_1.arpfac * wheadpt1;
24832 	}
24833 
24834 /*  Add in padding space */
24835 
24836 	pts += spfacs_1.xspfac * wheadpt1;
24837 
24838 /*  Now done with all items needing space except accidentals, */
24839 /*    accidental shifts, and left-notehead-shifts, and will later */
24840 /*    subtract a notehead if at start of bar. */
24841 
24842 /*  Get available space in elemskips (esk) */
24843 
24844 /*        isfirst = ip.eq.1 .or. to(in).eq.itrpt .or. */
24845 /*     *        to(in) .eq. itsig */
24846 	isfirst = ip == 1 || (r__1 = all_1.to[in - 1] - itrpt, dabs(r__1)) <
24847 		comtol_1.tol || (r__2 = all_1.to[in - 1] - itsig, dabs(r__2))
24848 		< comtol_1.tol;
24849 	if (isfirst) {
24850 
24851 /*  At start of bar or after repeat sign or new signature */
24852 
24853 /*          if (to(in) .eq. itsig) then */
24854 	    if ((r__1 = all_1.to[in - 1] - itsig, dabs(r__1)) < comtol_1.tol)
24855 		    {
24856 		esk = 0.f;
24857 	    } else {
24858 		esk = comask_1.fbar;
24859 	    }
24860 	} else {
24861 
24862 /*  Not 1st note of bar */
24863 
24864 	    esk = all_1.eskz[commvl_1.ivx + ip * 24 - 25] - all_1.eskz[
24865 		    commvl_1.ivx + (ip - 1) * 24 - 25];
24866 	}
24867 	if (isgrace) {
24868 
24869 /*  Since graces can be very long, cannot assume no interference if prior */
24870 /*  note uses >1 noteskip.  So must get elsk's back to prior note, whether or */
24871 /*  not it used only one noteskip. */
24872 /*  <<But if it was xtup. don't need to call eskb4.>>???? */
24873 
24874 /*  10/8/05 Kluge to not zero out esk if in xtup */
24875 
24876 	    esksav = esk;
24877 /* Computing MAX */
24878 	    i__1 = 1, i__7 = ip - 2;
24879 	    if ((ip <= 2 || all_1.nodur[commvl_1.ivx + max(i__1,i__7) * 24 -
24880 		    25] > 0) && (r__1 = all_1.to[in - 1] - itsig, dabs(r__1))
24881 		    > comtol_1.tol) {
24882 		eskb4_(&ip, &commvl_1.ivx, &in, &ib, comnsp_2.space, &tstart[
24883 			1], &comask_1.fbar, &itrpt, &esk);
24884 	    }
24885 /*     *                                to(in).ne.itsig) */
24886 	    if (dabs(esk) < comtol_1.tol) {
24887 		esk = esksav;
24888 	    }
24889 	}
24890 
24891 /*  Done getting available elemskips.  Remove headwidth if first.  Must do here */
24892 /*  rather than earlier since check uses isfirst */
24893 
24894 	if (isfirst) {
24895 	    pts -= wheadpt1;
24896 	}
24897 
24898 /*  Deal with accidental shifts and left-notehead shifts */
24899 
24900 	if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) {
24901 
24902 /*  In a chord */
24903 
24904 	    ptsl = 0.f;
24905 	    if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],27)) {
24906 		ptsl = wheadpt1;
24907 	    }
24908 /* Computing MAX */
24909 	    r__1 = ptsl, r__2 = icashft * .05f * wheadpt1;
24910 	    ptsadd = dmax(r__1,r__2);
24911 
24912 /*  Note: may have icashft=-20000 (if shftmin=-1000 in crdacc) but that's OK */
24913 
24914 	} else {
24915 
24916 /*  Not in a chord */
24917 
24918 	    ihshft = 0;
24919 	    if (isaccs) {
24920 		ihshft = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], &
24921 			c__7, &c__10);
24922 /*            if (ihshft .ne. 0) ihshft = max(0,64-ihshft) */
24923 		if (ihshft != 0) {
24924 /* Computing MAX */
24925 		    i__1 = 0, i__7 = 107 - ihshft;
24926 		    ihshft = max(i__1,i__7);
24927 		}
24928 	    }
24929 
24930 /* Check for left-shifted main note */
24931 
24932 	    if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8)) {
24933 		ihshft = max(20,ihshft);
24934 	    }
24935 	    ptsadd = ihshft * .05f * wheadpt1;
24936 	}
24937 	pts += ptsadd;
24938 	if (isgrace) {
24939 	    ptgr[ig - 1] += ptsadd;
24940 	}
24941 	if (iscln) {
24942 	    ptclef[commvl_1.ivx - 1] += ptsadd;
24943 	}
24944 
24945 /*  Left-shifted, non-chord note before? */
24946 
24947 	if (ip > 1) {
24948 	    if (! bit_test(all_1.ipl[commvl_1.ivx + (ip - 1) * 24 - 25],10) &&
24949 		     bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],
24950 		    27)) {
24951 		pts -= wheadpt1;
24952 	    }
24953 	}
24954 
24955 /*  Try big accidentals first */
24956 
24957 	ptbneed = pts;
24958 	if (isaccs || iscacc) {
24959 	    ptbneed += wheadpt1 * spfacs_1.bacfac;
24960 	}
24961 	if (comask_1.poenom * esk > ptbneed) {
24962 
24963 /*  Set flag for big accidental */
24964 
24965 	    if (isacc) {
24966 		all_1.nacc[commvl_1.ivx + ip * 24 - 25] = bit_set(all_1.nacc[
24967 			commvl_1.ivx + ip * 24 - 25],3);
24968 	    }
24969 	    goto L99;
24970 	}
24971 
24972 /*  Cannot use big, so try small */
24973 
24974 	ptsneed = pts;
24975 	if (isaccs || iscacc) {
24976 	    ptsneed += taccfac * wheadpt1;
24977 	}
24978 	if (comask_1.poenom * esk < ptsneed) {
24979 	    addask_(&all_1.to[in - 1], &ptsneed, &esk, &comask_1.fixednew, &
24980 		    comask_1.scaldold, &c_b762, &c_false);
24981 	}
24982 L99:
24983 	if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],26)) {
24984 
24985 /*  User-defined space.  Warning, "zero" may change value in addask! */
24986 
24987 	    zero = 0.f;
24988 	    addask_(&all_1.to[in - 1], &ptsneed, &zero, &comask_1.fixednew, &
24989 		    comask_1.scaldold, tglp1, &c_true);
24990 	}
24991 
24992 /*  End of big manual loop over "in" for accidental checking */
24993 
24994 	goto L111;
24995 L112:
24996 
24997 /* End of ask analysis for this block. */
24998 
24999 /* Adjust eskz if there are added spaces. Corrects length of xtup brackets. */
25000 
25001 	if (comas1_1.naskb > 0) {
25002 	    adjusteskz_(&ib, &squez[1], &istart[1], &istop[1], &
25003 		    comask_1.poenom);
25004 	}
25005 
25006 /* Check for internal repeat or sig change. */
25007 
25008 	if (ib > 1 && all_1.ivxo[istart[ib] - 1] == 1) {
25009 	    iirpt = all_1.islur[all_1.ipo[istart[ib] - 1] * 24 - 24] &
25010 		    67109216;
25011 	    if (iirpt > 0) {
25012 
25013 /* Internal repeat */
25014 
25015 		if (comlast_1.islast) {
25016 		    s_wsfe(&io___1017);
25017 /* Writing concatenation */
25018 		    i__8[0] = 1, a__5[0] = all_1.sq;
25019 		    i__8[1] = 7, a__5[1] = "advance";
25020 		    i__8[2] = 1, a__5[2] = all_1.sq;
25021 		    i__8[3] = 8, a__5[3] = "barno-1%";
25022 		    s_cat(ch__5, a__5, i__8, &c__4, (ftnlen)17);
25023 		    do_fio(&c__1, ch__5, (ftnlen)17);
25024 		    e_wsfe();
25025 		}
25026 		if (iirpt == 96) {
25027 		    if (comlast_1.islast) {
25028 			s_wsfe(&io___1018);
25029 /* Writing concatenation */
25030 			i__4[0] = 1, a__2[0] = all_1.sq;
25031 			i__4[1] = 15, a__2[1] = "leftrightrepeat";
25032 			s_cat(ch__6, a__2, i__4, &c__2, (ftnlen)16);
25033 			do_fio(&c__1, ch__6, (ftnlen)16);
25034 			e_wsfe();
25035 		    }
25036 		    comask_1.fixednew += spfacs_1.lrrptfac * comask_1.wheadpt;
25037 		} else if (bit_test(iirpt,5)) {
25038 		    if (comlast_1.islast) {
25039 			s_wsfe(&io___1019);
25040 /* Writing concatenation */
25041 			i__4[0] = 1, a__2[0] = all_1.sq;
25042 			i__4[1] = 10, a__2[1] = "leftrepeat";
25043 			s_cat(ch__7, a__2, i__4, &c__2, (ftnlen)11);
25044 			do_fio(&c__1, ch__7, (ftnlen)11);
25045 			e_wsfe();
25046 		    }
25047 		    comask_1.fixednew += spfacs_1.rptfac * comask_1.wheadpt;
25048 		} else if (bit_test(iirpt,6)) {
25049 		    if (comlast_1.islast) {
25050 			s_wsfe(&io___1020);
25051 /* Writing concatenation */
25052 			i__4[0] = 1, a__2[0] = all_1.sq;
25053 			i__4[1] = 11, a__2[1] = "rightrepeat";
25054 			s_cat(ch__3, a__2, i__4, &c__2, (ftnlen)12);
25055 			do_fio(&c__1, ch__3, (ftnlen)12);
25056 			e_wsfe();
25057 		    }
25058 		    comask_1.fixednew += spfacs_1.rptfac * comask_1.wheadpt;
25059 		} else if (bit_test(iirpt,8)) {
25060 		    if (comlast_1.islast) {
25061 			s_wsfe(&io___1021);
25062 /* Writing concatenation */
25063 			i__4[0] = 1, a__2[0] = all_1.sq;
25064 			i__4[1] = 9, a__2[1] = "doublebar";
25065 			s_cat(ch__8, a__2, i__4, &c__2, (ftnlen)10);
25066 			do_fio(&c__1, ch__8, (ftnlen)10);
25067 			e_wsfe();
25068 		    }
25069 		} else {
25070 		    s_wsle(&io___1022);
25071 		    do_lio(&c__9, &c__1, "Unexpected mid-bar repeat command "
25072 			    "R*", (ftnlen)36);
25073 		    e_wsle();
25074 		    stop1_();
25075 		}
25076 		comask_1.scaldold -= comask_1.fbar;
25077 	    }
25078 	    if (bit_test(all_1.ipl[all_1.ipo[istart[ib] - 1] * 24 - 24],28)) {
25079 
25080 /*  Internal signature change. */
25081 
25082 /* Writing concatenation */
25083 		i__4[0] = 1, a__2[0] = all_1.sq;
25084 		i__4[1] = 17, a__2[1] = "generalsignature{";
25085 		s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
25086 		lnote = 18;
25087 		if (comtop_1.isig < 0) {
25088 /* Writing concatenation */
25089 		    i__4[0] = lnote, a__2[0] = notexq;
25090 		    i__4[1] = 1, a__2[1] = "-";
25091 		    s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
25092 		    ++lnote;
25093 		}
25094 		if (comlast_1.islast) {
25095 		    s_wsfe(&io___1023);
25096 /* Writing concatenation */
25097 		    i__6[0] = lnote, a__4[0] = notexq;
25098 		    i__1 = abs(comtop_1.isig) + 48;
25099 		    chax_(ch__4, (ftnlen)1, &i__1);
25100 		    i__6[1] = 1, a__4[1] = ch__4;
25101 		    i__6[2] = 2, a__4[2] = "}%";
25102 		    s_cat(ch__2, a__4, i__6, &c__3, (ftnlen)82);
25103 		    do_fio(&c__1, ch__2, lnote + 3);
25104 		    e_wsfe();
25105 		}
25106 		if (comlast_1.islast && comignorenats_1.ignorenats) {
25107 		    s_wsfe(&io___1024);
25108 /* Writing concatenation */
25109 		    i__4[0] = 1, a__2[0] = all_1.sq;
25110 		    i__4[1] = 11, a__2[1] = "ignorenats%";
25111 		    s_cat(ch__3, a__2, i__4, &c__2, (ftnlen)12);
25112 		    do_fio(&c__1, ch__3, (ftnlen)12);
25113 		    e_wsfe();
25114 		}
25115 		if (comlast_1.islast) {
25116 		    s_wsfe(&io___1025);
25117 /* Writing concatenation */
25118 		    i__3[0] = 1, a__1[0] = all_1.sq;
25119 		    i__3[1] = 14, a__1[1] = "zchangecontext";
25120 		    i__3[2] = 1, a__1[2] = all_1.sq;
25121 		    i__3[3] = 12, a__1[3] = "addspace{-.5";
25122 		    i__3[4] = 1, a__1[4] = all_1.sq;
25123 		    i__3[5] = 15, a__1[5] = "afterruleskip}%";
25124 		    s_cat(ch__9, a__1, i__3, &c__6, (ftnlen)44);
25125 		    do_fio(&c__1, ch__9, (ftnlen)44);
25126 		    e_wsfe();
25127 		}
25128 		lnote = 0;
25129 	    }
25130 	}
25131 	comnsp_2.flgndb = FALSE_;
25132 
25133 /*  Done with start-of-block stuff.  Begin main loop over voices. */
25134 
25135 	i__1 = all_1.nv;
25136 	for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
25137 	    i__7 = commvl_1.nvmx[all_1.iv - 1];
25138 	    for (kv = 1; kv <= i__7; ++kv) {
25139 		commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
25140 		icm = commidi_1.midchan[all_1.iv + kv * 24 - 25];
25141 
25142 /*  A rather klugey way to set flag for figure in this voice */
25143 /*  Must always check figbass before figchk. */
25144 
25145 		if (all_1.figbass) {
25146 		    ivf = 0;
25147 		    if (commvl_1.ivx == 1) {
25148 			ivf = 1;
25149 		    } else if (commvl_1.ivx == comfig_1.ivxfig2) {
25150 			ivf = 2;
25151 		    }
25152 		    if (ivf > 0) {
25153 			all_1.figchk[ivf - 1] = comfig_1.nfigs[ivf - 1] > 0;
25154 		    }
25155 		}
25156 		if (commvl_1.ivx > 1) {
25157 		    if (commvl_1.ivx <= all_1.nv) {
25158 			addstr_(all_1.sepsymq + (all_1.iv - 2), &c__1, soutq,
25159 				&lsout, (ftnlen)1, (ftnlen)80);
25160 		    } else {
25161 /* Writing concatenation */
25162 			i__4[0] = 1, a__2[0] = all_1.sq;
25163 			i__4[1] = 9, a__2[1] = "nextvoice";
25164 			s_cat(ch__8, a__2, i__4, &c__2, (ftnlen)10);
25165 			addstr_(ch__8, &c__10, soutq, &lsout, (ftnlen)10, (
25166 				ftnlen)80);
25167 		    }
25168 		}
25169 		if (comhead_1.ihdht > 0 && commvl_1.ivx == all_1.nv) {
25170 
25171 /*  Write header.  First adjust height if needed to miss barno. */
25172 
25173 		    if (comask_1.bar1syst && all_1.iline != 1) {
25174 			comhead_1.ihdht = comsln_1.irzbnd + 15 +
25175 				comsln_1.isnx;
25176 		    }
25177 
25178 /*  Add user-defined vertical shift */
25179 
25180 		    comhead_1.ihdht += comhead_1.ihdvrt;
25181 		    lchead = lenstr_(comhead_1.headrq, &c__80, (ftnlen)80);
25182 /* Writing concatenation */
25183 		    i__4[0] = 1, a__2[0] = all_1.sq;
25184 		    i__4[1] = 10, a__2[1] = "zcharnote{";
25185 		    s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
25186 		    s_wsfi(&io___1029);
25187 		    do_fio(&c__1, (char *)&comhead_1.ihdht, (ftnlen)sizeof(
25188 			    integer));
25189 		    e_wsfi();
25190 /* Writing concatenation */
25191 		    i__3[0] = 13, a__1[0] = notexq;
25192 		    i__3[1] = 2, a__1[1] = "}{";
25193 		    i__3[2] = 1, a__1[2] = all_1.sq;
25194 		    i__3[3] = 7, a__1[3] = "bigfont";
25195 		    i__3[4] = 1, a__1[4] = all_1.sq;
25196 		    i__3[5] = 10, a__1[5] = "kern-30pt ";
25197 		    s_cat(notexq, a__1, i__3, &c__6, (ftnlen)79);
25198 		    addstr_(notexq, &c__34, soutq, &lsout, (ftnlen)79, (
25199 			    ftnlen)80);
25200 /* Writing concatenation */
25201 		    i__4[0] = lchead, a__2[0] = comhead_1.headrq;
25202 		    i__4[1] = 1, a__2[1] = "}";
25203 		    s_cat(ch__10, a__2, i__4, &c__2, (ftnlen)81);
25204 		    i__9 = lchead + 1;
25205 		    addstr_(ch__10, &i__9, soutq, &lsout, lchead + 1, (ftnlen)
25206 			    80);
25207 		    comhead_1.ihdht = 0;
25208 		}
25209 		if (comhead_1.lower && commvl_1.ivx == all_1.nv) {
25210 		    lclow = lenstr_(comhead_1.lowerq, &c__80, (ftnlen)80);
25211 /* Writing concatenation */
25212 		    i__10[0] = 1, a__6[0] = all_1.sq;
25213 		    i__10[1] = 14, a__6[1] = "zcharnote{-6}{";
25214 		    i__10[2] = 1, a__6[2] = all_1.sq;
25215 		    i__10[3] = 5, a__6[3] = "tempo";
25216 		    i__10[4] = 1, a__6[4] = all_1.sq;
25217 		    i__10[5] = 10, a__6[5] = "kern-10pt ";
25218 		    i__10[6] = lclow, a__6[6] = comhead_1.lowerq;
25219 		    i__10[7] = 1, a__6[7] = "}";
25220 		    s_cat(ch__11, a__6, i__10, &c__8, (ftnlen)113);
25221 		    i__9 = lclow + 33;
25222 		    addstr_(ch__11, &i__9, soutq, &lsout, lclow + 33, (ftnlen)
25223 			    80);
25224 		    comhead_1.lower = FALSE_;
25225 		}
25226 		tnow = tstart[ib];
25227 		nofirst = TRUE_;
25228 
25229 /*  Done setting up voice ivx for start of block ib.  Loop over notes in voice. */
25230 
25231 		i__9 = istop[ib];
25232 		for (all_1.jn = istart[ib]; all_1.jn <= i__9; ++all_1.jn) {
25233 		    if (all_1.ivxo[all_1.jn - 1] != commvl_1.ivx) {
25234 			goto L10;
25235 		    }
25236 		    ip = all_1.ipo[all_1.jn - 1];
25237 
25238 /*  May have problem with not initializing islhgt, so do it here */
25239 
25240 		    islhgt = 0;
25241 
25242 		    if (nofirst) {
25243 			comoct_1.noctup = 0;
25244 			if (ncmid_(&all_1.iv, &ip) == 23) {
25245 			    comoct_1.noctup = -2;
25246 			}
25247 			nofirst = FALSE_;
25248 		    }
25249 
25250 /*  Check for internal floating figure (before last note of group). */
25251 
25252 L12:
25253 		    if (all_1.figbass) {
25254 			if (commvl_1.ivx == 1 || commvl_1.ivx ==
25255 				comfig_1.ivxfig2) {
25256 			    ivf = 1;
25257 			    if (commvl_1.ivx > 1) {
25258 				ivf = 2;
25259 			    }
25260 			    if (all_1.figchk[ivf - 1] && (real)
25261 				    comfig_1.itfig[ivf + (ifig[ivf - 1] << 1)
25262 				    - 3] < tnow - comtol_1.tol) {
25263 
25264 /*  Bypassed figure location. Backup, place fig, return. */
25265 
25266 				offnsk = (tnow - comfig_1.itfig[ivf + (ifig[
25267 					ivf - 1] << 1) - 3]) / comnsp_2.space[
25268 					ib - 1];
25269 				putfig_(&ivf, &ifig[ivf - 1], &offnsk, &
25270 					all_1.figchk[ivf - 1], soutq, &lsout,
25271 					(ftnlen)80);
25272 				goto L12;
25273 			    }
25274 			}
25275 		    }
25276 
25277 /*  Put in \sk if needed */
25278 
25279 		    if (all_1.to[all_1.jn - 1] > tnow + comtol_1.tol) {
25280 /* Writing concatenation */
25281 			i__4[0] = 1, a__2[0] = all_1.sq;
25282 			i__4[1] = 2, a__2[1] = "sk";
25283 			s_cat(ch__12, a__2, i__4, &c__2, (ftnlen)3);
25284 			addstr_(ch__12, &c__3, soutq, &lsout, (ftnlen)3, (
25285 				ftnlen)80);
25286 			tnow += comnsp_2.space[ib - 1];
25287 			goto L12;
25288 		    }
25289 
25290 /*  Check for user-defined shifts */
25291 
25292 		    if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],15)
25293 			    || bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
25294 			    25],16)) {
25295 			putshft_(&commvl_1.ivx, &c_true, soutq, &lsout, (
25296 				ftnlen)80);
25297 		    }
25298 L21:
25299 		    if (iaskb[commvl_1.ivx - 1] <= comas1_1.naskb && tnow >
25300 			    comas1_1.task[iaskb[commvl_1.ivx - 1] - 1] -
25301 			    comtol_1.tol) {
25302 			if (comas1_1.task[iaskb[commvl_1.ivx - 1] - 1] >
25303 				tstart[ib] - comtol_1.tol) {
25304 
25305 /*  Insert placeholder for accidental skip */
25306 
25307 /* Writing concatenation */
25308 			    i__4[0] = 1, a__2[0] = all_1.sq;
25309 			    i__4[1] = 8, a__2[1] = "ask     ";
25310 			    s_cat(ch__13, a__2, i__4, &c__2, (ftnlen)9);
25311 			    addstr_(ch__13, &c__9, soutq, &lsout, (ftnlen)9, (
25312 				    ftnlen)80);
25313 			    ++comas2_1.nasksys;
25314 			    comas2_1.wasksys[comas2_1.nasksys - 1] =
25315 				    comas1_1.wask[iaskb[commvl_1.ivx - 1] - 1]
25316 				    ;
25317 			    if (comas1_1.wask[iaskb[commvl_1.ivx - 1] - 1] >
25318 				    0.f) {
25319 				comas2_1.elasksys[comas2_1.nasksys - 1] =
25320 					comas1_1.elask[iaskb[commvl_1.ivx - 1]
25321 					 - 1];
25322 			    } else {
25323 
25324 /*  This is a signal to permit negative ask's.  Should really have elask>=0. */
25325 
25326 				comas2_1.elasksys[comas2_1.nasksys - 1] =
25327 					-comas1_1.elask[iaskb[commvl_1.ivx -
25328 					1] - 1];
25329 			    }
25330 			}
25331 
25332 /*  May have skipped some task's in earlier blocks (due to void voice) */
25333 
25334 			++iaskb[commvl_1.ivx - 1];
25335 			goto L21;
25336 		    }
25337 		    if (all_1.figbass) {
25338 			if (commvl_1.ivx == 1 || commvl_1.ivx ==
25339 				comfig_1.ivxfig2) {
25340 			    ivf = 1;
25341 			    if (commvl_1.ivx > 1) {
25342 				ivf = 2;
25343 			    }
25344 			    if (all_1.figchk[ivf - 1] && (r__1 =
25345 				    comfig_1.itfig[ivf + (ifig[ivf - 1] << 1)
25346 				    - 3] - tnow, dabs(r__1)) < comtol_1.tol) {
25347 
25348 /*  Figure on a note.  NB: later special check for late figs. */
25349 
25350 				putfig_(&ivf, &ifig[ivf - 1], &c_b762, &
25351 					all_1.figchk[ivf - 1], soutq, &lsout,
25352 					(ftnlen)80);
25353 			    }
25354 			}
25355 		    }
25356 
25357 /*  Check for new clef here. */
25358 
25359 		    if (isclef && bit_test(all_1.islur[commvl_1.ivx + ip * 24
25360 			    - 25],11)) {
25361 /*     print*,'At clef insertion, ptclef:',ptclef(iv) */
25362 			if (ptclef[all_1.iv - 1] > 0.f) {
25363 /* Writing concatenation */
25364 			    i__4[0] = 1, a__2[0] = all_1.sq;
25365 			    i__4[1] = 5, a__2[1] = "off{-";
25366 			    s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
25367 			    if (ptclef[all_1.iv - 1] < 9.95f) {
25368 				s_wsfi(&io___1035);
25369 				do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], (
25370 					ftnlen)sizeof(real));
25371 				e_wsfi();
25372 				lnote = 9;
25373 			    } else {
25374 				s_wsfi(&io___1036);
25375 				do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], (
25376 					ftnlen)sizeof(real));
25377 				e_wsfi();
25378 				lnote = 10;
25379 			    }
25380 /* Writing concatenation */
25381 			    i__4[0] = lnote, a__2[0] = notexq;
25382 			    i__4[1] = 3, a__2[1] = "pt}";
25383 			    s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
25384 			    lnote += 3;
25385 			    addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79,
25386 				     (ftnlen)80);
25387 /*     print*,'Just added: ',notexq(1:lnote) */
25388 			}
25389 			clefsym_(&all_1.islur[all_1.iv + ip * 24 - 25],
25390 				notexq, &lnote, &nclef, (ftnlen)79);
25391 			addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (
25392 				ftnlen)80);
25393 			if (ptclef[all_1.iv - 1] > 0.f) {
25394 /* Writing concatenation */
25395 			    i__4[0] = 1, a__2[0] = all_1.sq;
25396 			    i__4[1] = 4, a__2[1] = "off{";
25397 			    s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
25398 			    if (ptclef[all_1.iv - 1] < 9.95f) {
25399 				s_wsfi(&io___1038);
25400 				do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], (
25401 					ftnlen)sizeof(real));
25402 				e_wsfi();
25403 				lnote = 8;
25404 			    } else {
25405 				s_wsfi(&io___1039);
25406 				do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], (
25407 					ftnlen)sizeof(real));
25408 				e_wsfi();
25409 				lnote = 9;
25410 			    }
25411 /* Writing concatenation */
25412 			    i__4[0] = lnote, a__2[0] = notexq;
25413 			    i__4[1] = 3, a__2[1] = "pt}";
25414 			    s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
25415 			    lnote += 3;
25416 			    addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79,
25417 				     (ftnlen)80);
25418 			}
25419 		    }
25420 
25421 /*  Checking for literal TeX string BEFORE starting beams!! */
25422 
25423 		    if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],16))
25424 			     {
25425 			i__11 = comgrace_1.nlit;
25426 			for (il = 1; il <= i__11; ++il) {
25427 			    if (comgrace_1.iplit[il - 1] == ip &&
25428 				    comgrace_1.ivlit[il - 1] == commvl_1.ivx)
25429 				    {
25430 				goto L125;
25431 			    }
25432 /* L124: */
25433 			}
25434 			s_wsle(&io___1041);
25435 			do_lio(&c__9, &c__1, "Problem finding index for lite"
25436 				"ral string", (ftnlen)40);
25437 			e_wsle();
25438 			stop1_();
25439 L125:
25440 
25441 /*  Write a type 1 tex string. */
25442 
25443 			if (comgrace_1.lenlit[il - 1] < 71) {
25444 
25445 /*  Add normally */
25446 
25447 			    addstr_(comgrace_1.litq + (il - 1 << 7), &
25448 				    comgrace_1.lenlit[il - 1], soutq, &lsout,
25449 				    (ftnlen)128, (ftnlen)80);
25450 			} else {
25451 
25452 /*  Longer than 71.  Write souq, Write string, start new soutq. */
25453 
25454 			    if (comlast_1.islast) {
25455 				s_wsfe(&io___1042);
25456 /* Writing concatenation */
25457 				i__4[0] = lsout, a__2[0] = soutq;
25458 				i__4[1] = 1, a__2[1] = "%";
25459 				s_cat(ch__10, a__2, i__4, &c__2, (ftnlen)81);
25460 				do_fio(&c__1, ch__10, lsout + 1);
25461 				e_wsfe();
25462 			    }
25463 			    if (comlast_1.islast) {
25464 				s_wsfe(&io___1043);
25465 /* Writing concatenation */
25466 				i__4[0] = comgrace_1.lenlit[il - 1], a__2[0] =
25467 					 comgrace_1.litq + (il - 1 << 7);
25468 				i__4[1] = 1, a__2[1] = "%";
25469 				s_cat(ch__14, a__2, i__4, &c__2, (ftnlen)129);
25470 				do_fio(&c__1, ch__14, comgrace_1.lenlit[il -
25471 					1] + 1);
25472 				e_wsfe();
25473 			    }
25474 			    lsout = 0;
25475 			}
25476 		    }
25477 
25478 /*  Arpeggio on a main (non-chordal) note? */
25479 
25480 		    if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],27))
25481 			    {
25482 /*              call putarp(tnow,iv,ip,nolev(ivx,ip),ncmid(iv,ip), */
25483 			i__11 = ncmid_(&all_1.iv, &ip);
25484 			putarp_(&tnow, &commvl_1.ivx, &ip, &all_1.nolev[
25485 				commvl_1.ivx + ip * 24 - 25], &i__11, soutq, &
25486 				lsout, (ftnlen)80);
25487 		    }
25488 
25489 /*  See if a beam starts here */
25490 
25491 		    if (numbms[commvl_1.ivx] > 0 && all_1.ibmcnt[commvl_1.ivx
25492 			    - 1] <= numbms[commvl_1.ivx] && all_1.ibm1[
25493 			    commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] *
25494 			    24 - 25] == ip || bit_test(all_1.nacc[
25495 			    commvl_1.ivx + ip * 24 - 25],21)) {
25496 			if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
25497 				25],24)) {
25498 
25499 /*  Not a jump start */
25500 
25501 			    if (comkbdrests_1.kbdrests && bit_test(
25502 				    all_1.irest[commvl_1.ivx + ip * 24 - 25],
25503 				    0) && ! bit_test(all_1.islur[commvl_1.ivx
25504 				    + ip * 24 - 25],29) && commvl_1.nvmx[
25505 				    all_1.iv - 1] == 2 && all_1.nolev[
25506 				    commvl_1.ivx + ip * 24 - 25] <= 50) {
25507 				chkkbdrests_(&ip, &all_1.iv, &commvl_1.ivx,
25508 					all_1.nn, all_1.iornq, all_1.islur,
25509 					all_1.irest, all_1.nolev,
25510 					commvl_1.ivmx, all_1.nib, &all_1.nv, &
25511 					all_1.ibar, &tnow, &comtol_1.tol,
25512 					all_1.nodur, &c__2,
25513 					comkbdrests_1.levtopr,
25514 					comkbdrests_1.levbotr, all_1.mult);
25515 			    }
25516 			    beamstrt_(notexq, &lnote, nornb, ihornb,
25517 				    comnsp_2.space, &squez[1], &ib, (ftnlen)
25518 				    79);
25519 
25520 /*  Shift beam start if notehead was shifted */
25521 
25522 			    if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 -
25523 				    25],8)) {
25524 /* Writing concatenation */
25525 				i__4[0] = 1, a__2[0] = all_1.sq;
25526 				i__4[1] = 5, a__2[1] = "loff{";
25527 				s_cat(ch__15, a__2, i__4, &c__2, (ftnlen)6);
25528 				addstr_(ch__15, &c__6, soutq, &lsout, (ftnlen)
25529 					6, (ftnlen)80);
25530 			    } else if (bit_test(all_1.ipl[commvl_1.ivx + ip *
25531 				    24 - 25],9)) {
25532 /* Writing concatenation */
25533 				i__4[0] = 1, a__2[0] = all_1.sq;
25534 				i__4[1] = 5, a__2[1] = "roff{";
25535 				s_cat(ch__15, a__2, i__4, &c__2, (ftnlen)6);
25536 				addstr_(ch__15, &c__6, soutq, &lsout, (ftnlen)
25537 					6, (ftnlen)80);
25538 			    }
25539 			    if (lnote > 0) {
25540 				addstr_(notexq, &lnote, soutq, &lsout, (
25541 					ftnlen)79, (ftnlen)80);
25542 			    }
25543 			    if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 -
25544 				    25],8) || bit_test(all_1.ipl[commvl_1.ivx
25545 				    + ip * 24 - 25],9)) {
25546 				addstr_("}", &c__1, soutq, &lsout, (ftnlen)1,
25547 					(ftnlen)80);
25548 			    }
25549 			} else {
25550 
25551 /*  Jump start.  Set marker for second part of a jump beam. Note ivbj2 was set */
25552 /*  to 0 at end of first part of jump beam */
25553 
25554 			    combjmp_1.ivbj2 = commvl_1.ivx;
25555 
25556 /*  Check for xtup since we bypassed beamstrt wherein vxtup is normally set */
25557 
25558 			    if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
25559 				    25],28) && strtmid_1.ixrest[commvl_1.ivx
25560 				    - 1] != 2) {
25561 				comxtup_1.vxtup[commvl_1.ivx - 1] = TRUE_;
25562 			    }
25563 
25564 /*  Since beamstrt is not called, and drawbm is normally set there, need to set */
25565 /*    it here.  This could cause problems if someone tries a staff-jumping, */
25566 /*    unbarred beam, which I'll deal with when it comes up. */
25567 
25568 			    comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_;
25569 			}
25570 			if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0) {
25571 			    all_1.beamon[commvl_1.ivx - 1] = TRUE_;
25572 			    bspend = TRUE_;
25573 			    if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24
25574 				    - 25],24)) {
25575 				bspend = TRUE_;
25576 			    }
25577 			}
25578 		    }
25579 
25580 /*  Setup for chords and possible slurs in chords */
25581 
25582 		    if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) {
25583 
25584 /*  There is a chord on this note. Just rerun precrd. Klunky, but saves */
25585 /*    me from tracking down errors instroduced when I moved 1st call */
25586 /*    forward for accidental spacing analysis. */
25587 
25588 			if (all_1.beamon[commvl_1.ivx - 1]) {
25589 			    precrd_(&commvl_1.ivx, &ip, &all_1.nolev[
25590 				    commvl_1.ivx + ip * 24 - 25], &all_1.nacc[
25591 				    commvl_1.ivx + ip * 24 - 25], &all_1.ipl[
25592 				    commvl_1.ivx + ip * 24 - 25], &
25593 				    all_1.irest[commvl_1.ivx + ip * 24 - 25],
25594 				    all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[
25595 				    commvl_1.ivx - 1] * 24 - 25), &c_true, &
25596 				    icashft, (ftnlen)1);
25597 			} else {
25598 			    i__11 = ncmid_(&all_1.iv, &ip);
25599 			    udqq_(ch__4, (ftnlen)1, &all_1.nolev[commvl_1.ivx
25600 				    + ip * 24 - 25], &i__11, &all_1.islur[
25601 				    commvl_1.ivx + ip * 24 - 25], &
25602 				    commvl_1.nvmx[all_1.iv - 1], &
25603 				    commvl_1.ivx, &all_1.nv);
25604 			    precrd_(&commvl_1.ivx, &ip, &all_1.nolev[
25605 				    commvl_1.ivx + ip * 24 - 25], &all_1.nacc[
25606 				    commvl_1.ivx + ip * 24 - 25], &all_1.ipl[
25607 				    commvl_1.ivx + ip * 24 - 25], &
25608 				    all_1.irest[commvl_1.ivx + ip * 24 - 25],
25609 				    ch__4, &c_true, &icashft, (ftnlen)1);
25610 			}
25611 		    }
25612 
25613 /*  Is there slur or grace activity? */
25614 
25615 		    isgrace = bit_test(all_1.islur[commvl_1.ivx + ip * 24 -
25616 			    25],4);
25617 		    if (ip > 1) {
25618 			isgrace = isgrace || bit_test(all_1.ipl[commvl_1.ivx
25619 				+ (ip - 1) * 24 - 25],31);
25620 		    }
25621 
25622 /*  isgrace if not 1st note in bar and previous note has Way-after grace. */
25623 
25624 		    if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],0)
25625 			    || isgrace) {
25626 			if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],
25627 				0)) {
25628 			    if (comslur_1.fontslur) {
25629 
25630 /*  Call routine for non-postscript slurs */
25631 
25632 				i__11 = ncmid_(&all_1.iv, &ip);
25633 				doslur_(&all_1.nolev[commvl_1.ivx + ip * 24 -
25634 					25], all_1.isdat1, all_1.isdat2,
25635 					all_1.isdat3, &all_1.nsdat, &ip, &
25636 					all_1.iv, &kv, &all_1.nv, &
25637 					all_1.beamon[commvl_1.ivx - 1], &
25638 					i__11, soutq, &lsout, all_1.ulq + (
25639 					commvl_1.ivx + all_1.ibmcnt[
25640 					commvl_1.ivx - 1] * 24 - 25), &
25641 					all_1.islur[commvl_1.ivx + ip * 24 -
25642 					25], &all_1.ipl[commvl_1.ivx + ip *
25643 					24 - 25], &all_1.iornq[commvl_1.ivx +
25644 					ip * 24 - 1], &islhgt, &all_1.tnote[
25645 					comipl2_1.ipl2[commvl_1.ivx + ip * 24
25646 					- 25] - 1], &all_1.nacc[commvl_1.ivx
25647 					+ ip * 24 - 25], (ftnlen)80, (ftnlen)
25648 					1);
25649 			    } else {
25650 
25651 /*  Postscript slurs */
25652 
25653 				i__11 = ncmid_(&all_1.iv, &ip);
25654 				dopsslur_(&all_1.nolev[commvl_1.ivx + ip * 24
25655 					- 25], all_1.isdat1, all_1.isdat2,
25656 					all_1.isdat3, all_1.isdat4, &
25657 					all_1.nsdat, &ip, &all_1.iv, &kv, &
25658 					all_1.nv, &all_1.beamon[commvl_1.ivx
25659 					- 1], &i__11, soutq, &lsout,
25660 					all_1.ulq + (commvl_1.ivx +
25661 					all_1.ibmcnt[commvl_1.ivx - 1] * 24 -
25662 					25), &all_1.islur[commvl_1.ivx + ip *
25663 					24 - 25], &all_1.ipl[commvl_1.ivx +
25664 					ip * 24 - 25], &all_1.iornq[
25665 					commvl_1.ivx + ip * 24 - 1], &islhgt,
25666 					&all_1.tnote[comipl2_1.ipl2[
25667 					commvl_1.ivx + ip * 24 - 25] - 1], &
25668 					all_1.nacc[commvl_1.ivx + ip * 24 -
25669 					25], (ftnlen)80, (ftnlen)1);
25670 			    }
25671 			}
25672 			if (isgrace) {
25673 
25674 /* Grace note. */
25675 
25676 			    iphold = ip;
25677 			    isgrace = FALSE_;
25678 			    if (ip > 1) {
25679 				isgrace = bit_test(all_1.ipl[commvl_1.ivx + (
25680 					ip - 1) * 24 - 25],31);
25681 			    }
25682 			    if (isgrace) {
25683 				--iphold;
25684 			    }
25685 			    isgrace = isgrace || ! bit_test(all_1.ipl[
25686 				    commvl_1.ivx + ip * 24 - 25],31) && !
25687 				    bit_test(all_1.ipl[commvl_1.ivx + ip * 24
25688 				    - 25],29);
25689 
25690 /* Place grace now if (a) Way-after from prev note and ip>1 or (b) Pre-grace */
25691 /*   on current note.  Do A-grace on current note, and W-grace at barend, later. */
25692 
25693 			    if (isgrace) {
25694 				i__11 = ncmid_(&all_1.iv, &ip);
25695 				i__12 = ncmid_(&all_1.iv, &ip);
25696 				dograce_(&commvl_1.ivx, &iphold, ptgr, soutq,
25697 					&lsout, &i__11, &all_1.nacc[
25698 					commvl_1.ivx + ip * 24 - 25], &ig, &
25699 					all_1.ipl[commvl_1.ivx + iphold * 24
25700 					- 25], &c_false, &all_1.beamon[
25701 					commvl_1.ivx - 1], &all_1.nolev[
25702 					commvl_1.ivx + ip * 24 - 25], &i__12,
25703 					&all_1.islur[commvl_1.ivx + ip * 24 -
25704 					25], &commvl_1.nvmx[all_1.iv - 1], &
25705 					all_1.nv, &all_1.ibmcnt[commvl_1.ivx
25706 					- 1], &all_1.tnote[comipl2_1.ipl2[
25707 					commvl_1.ivx + ip * 24 - 25] - 1],
25708 					all_1.ulq, &cominsttrans_1.instno[
25709 					all_1.iv - 1], (ftnlen)80, (ftnlen)1);
25710 /* 130324 */
25711 /*     *                 tnote(ipl2(ivx,ip)),ulq) */
25712 				if (comgrace_1.slurg[ig - 1]) {
25713 
25714 /* Terminate slur started in dograce.  Get direction of main note stem */
25715 
25716 				    if (! all_1.beamon[commvl_1.ivx - 1]) {
25717 
25718 /*  Separate note.  Get stem direction. */
25719 
25720 					i__11 = ncmid_(&all_1.iv, &ip);
25721 					udqq_(ch__4, (ftnlen)1, &all_1.nolev[
25722 						commvl_1.ivx + ip * 24 - 25],
25723 						&i__11, &all_1.islur[
25724 						commvl_1.ivx + ip * 24 - 25],
25725 						&commvl_1.nvmx[all_1.iv - 1],
25726 						&commvl_1.ivx, &all_1.nv);
25727 					stemup = *(unsigned char *)&ch__4[0]
25728 						== 'u';
25729 				    } else {
25730 
25731 /*  In a beam */
25732 
25733 					stemup = *(unsigned char *)&all_1.ulq[
25734 						commvl_1.ivx + all_1.ibmcnt[
25735 						commvl_1.ivx - 1] * 24 - 25]
25736 						== 'u';
25737 				    }
25738 
25739 /*  Stop the shift if whole note */
25740 
25741 				    stemup = stemup || all_1.tnote[
25742 					    comipl2_1.ipl2[commvl_1.ivx + ip *
25743 					     24 - 25] - 1] > 63.f;
25744 				    L__1 = ! comgrace_1.upg[ig - 1];
25745 				    i__11 = ncmid_(&all_1.iv, &ip);
25746 				    endslur_(&stemup, &L__1, &all_1.nolev[
25747 					    commvl_1.ivx + ip * 24 - 25], &
25748 					    c__0, &comslur_1.ndxslur, &c__0, &
25749 					    i__11, soutq, &lsout, &
25750 					    comslur_1.fontslur, (ftnlen)80);
25751 				}
25752 			    }
25753 			}
25754 			if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],
25755 				24)) {
25756 
25757 /*  Start slur on main note for After- or Way-after-grace. */
25758 
25759 /* ????                ndxslur = log2(33554431-listslur) */
25760 			    i__11 = 16777215 - comslur_1.listslur;
25761 			    comslur_1.ndxslur = log2_(&i__11);
25762 
25763 /*  Get note name */
25764 
25765 			    i__11 = ncmid_(&all_1.iv, &ip);
25766 			    notefq_(noteq, &lnoten, &all_1.nolev[commvl_1.ivx
25767 				    + ip * 24 - 25], &i__11, (ftnlen)8);
25768 
25769 /*  Get slur direction */
25770 
25771 			    *(unsigned char *)slurudq = 'u';
25772 			    if (! all_1.beamon[commvl_1.ivx - 1]) {
25773 				i__11 = ncmid_(&all_1.iv, &ip);
25774 				udqq_(ch__4, (ftnlen)1, &all_1.nolev[
25775 					commvl_1.ivx + ip * 24 - 25], &i__11,
25776 					&all_1.islur[commvl_1.ivx + ip * 24 -
25777 					25], &commvl_1.nvmx[all_1.iv - 1], &
25778 					commvl_1.ivx, &all_1.nv);
25779 				if (*(unsigned char *)&ch__4[0] == 'u') {
25780 				    *(unsigned char *)slurudq = 'd';
25781 				}
25782 			    } else {
25783 				if (*(unsigned char *)&all_1.ulq[commvl_1.ivx
25784 					+ all_1.ibmcnt[commvl_1.ivx - 1] * 24
25785 					- 25] == 'u') {
25786 				    *(unsigned char *)slurudq = 'd';
25787 				}
25788 			    }
25789 
25790 /* c  Replace ndxslur by 11-ndxslur when printing only. */
25791 /*  Replace ndxslur by 23-ndxslur when printing only. */
25792 
25793 /*                if (11-ndxslur .lt. 10) then */
25794 			    if (23 - comslur_1.ndxslur < 10) {
25795 /*                  notexq = sq//'islur'//slurudq//chax(59-ndxslur) */
25796 /* Writing concatenation */
25797 				i__5[0] = 1, a__3[0] = all_1.sq;
25798 				i__5[1] = 5, a__3[1] = "islur";
25799 				i__5[2] = 1, a__3[2] = slurudq;
25800 				i__11 = 71 - comslur_1.ndxslur;
25801 				chax_(ch__4, (ftnlen)1, &i__11);
25802 				i__5[3] = 1, a__3[3] = ch__4;
25803 				i__5[4] = lnoten, a__3[4] = noteq;
25804 				s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
25805 				i__11 = lnoten + 8;
25806 				addstr_(notexq, &i__11, soutq, &lsout, (
25807 					ftnlen)79, (ftnlen)80);
25808 			    } else if (23 - comslur_1.ndxslur < 20) {
25809 /* Writing concatenation */
25810 				i__13[0] = 1, a__7[0] = all_1.sq;
25811 				i__13[1] = 5, a__7[1] = "islur";
25812 				i__13[2] = 1, a__7[2] = slurudq;
25813 				i__13[3] = 2, a__7[3] = "{1";
25814 				i__11 = 61 - comslur_1.ndxslur;
25815 				chax_(ch__4, (ftnlen)1, &i__11);
25816 				i__13[4] = 1, a__7[4] = ch__4;
25817 				i__13[5] = 1, a__7[5] = "}";
25818 				i__13[6] = lnoten, a__7[6] = noteq;
25819 				s_cat(notexq, a__7, i__13, &c__7, (ftnlen)79);
25820 				i__11 = lnoten + 11;
25821 				addstr_(notexq, &i__11, soutq, &lsout, (
25822 					ftnlen)79, (ftnlen)80);
25823 			    } else {
25824 /* Writing concatenation */
25825 				i__13[0] = 1, a__7[0] = all_1.sq;
25826 				i__13[1] = 5, a__7[1] = "islur";
25827 				i__13[2] = 1, a__7[2] = slurudq;
25828 				i__13[3] = 2, a__7[3] = "{2";
25829 				i__11 = 51 - comslur_1.ndxslur;
25830 				chax_(ch__4, (ftnlen)1, &i__11);
25831 				i__13[4] = 1, a__7[4] = ch__4;
25832 				i__13[5] = 1, a__7[5] = "}";
25833 				i__13[6] = lnoten, a__7[6] = noteq;
25834 				s_cat(notexq, a__7, i__13, &c__7, (ftnlen)79);
25835 				i__11 = lnoten + 11;
25836 				addstr_(notexq, &i__11, soutq, &lsout, (
25837 					ftnlen)79, (ftnlen)80);
25838 			    }
25839 /*                call setbits(ipl(ivx,ip),4,23,ndxslur) */
25840 			    setbits_(&all_1.ipl[commvl_1.ivx + ip * 24 - 25],
25841 				    &c__5, &c__23, &comslur_1.ndxslur);
25842 			    if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 -
25843 				    25],31)) {
25844 				comslur_1.listslur = bit_set(
25845 					comslur_1.listslur,comslur_1.ndxslur);
25846 			    }
25847 
25848 /*  Starting slur on W-grace on THIS note.  Record ndxslur. */
25849 
25850 			}
25851 		    }
25852 
25853 /*  Process dynamic marks */
25854 
25855 		    if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],26))
25856 			     {
25857 			i__11 = ncmid_(&all_1.iv, &ip);
25858 			L__1 = all_1.nodur[commvl_1.ivx + ip * 24 - 25] >= 64;
25859 			dodyn_(&commvl_1.ivx, &ip, &all_1.nolev[commvl_1.ivx
25860 				+ ip * 24 - 25], &i__11, &all_1.ipl[
25861 				commvl_1.ivx + ip * 24 - 25], &all_1.islur[
25862 				commvl_1.ivx + ip * 24 - 25], &all_1.irest[
25863 				commvl_1.ivx + ip * 24 - 25], &commvl_1.nvmx[
25864 				all_1.iv - 1], &all_1.nv, &all_1.beamon[
25865 				commvl_1.ivx - 1], ihornb, nornb, all_1.ulq, &
25866 				all_1.ibmcnt[commvl_1.ivx - 1], &L__1, soutq,
25867 				&lsout, (ftnlen)1, (ftnlen)80);
25868 		    }
25869 
25870 /*  Check for chord notes.  Moved up from below, 10/27/96 so chord orns done 1st. */
25871 
25872 		    if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) {
25873 
25874 /*  Need a duration to set type of note head */
25875 
25876 /*             if (.not. vxtup(ivx)) then */
25877 
25878 /*  Clumsy test, but vxtup is not set until main note is processed. */
25879 
25880 			if (! (comxtup_1.vxtup[commvl_1.ivx - 1] || bit_test(
25881 				all_1.irest[commvl_1.ivx + ip * 24 - 25],28)))
25882 				 {
25883 			    nodu = all_1.nodur[commvl_1.ivx + ip * 24 - 25];
25884 /*              else if (mult(ivx,ip) .lt. 0) then */
25885 			} else if ((all_1.mult[commvl_1.ivx + ip * 24 - 25] &
25886 				15) - 8 < 0) {
25887 			    nodu = 32;
25888 			} else {
25889 			    nodu = 16;
25890 			}
25891 			i__11 = ncmid_(&all_1.iv, &ip);
25892 			L__1 = bit_test(all_1.nacc[commvl_1.ivx + ip * 24 -
25893 				25],27);
25894 			docrd_(&commvl_1.ivx, &ip, &nodu, &i__11, &all_1.iv, &
25895 				tnow, soutq, &lsout, all_1.ulq, &all_1.ibmcnt[
25896 				commvl_1.ivx - 1], &all_1.islur[commvl_1.ivx
25897 				+ ip * 24 - 25], &commvl_1.nvmx[all_1.iv - 1],
25898 				 &all_1.nv, &all_1.beamon[commvl_1.ivx - 1], &
25899 				all_1.nolev[commvl_1.ivx + ip * 24 - 25],
25900 				ihornb, nornb, &all_1.stemlen, &L__1, &
25901 				all_1.nacc[commvl_1.ivx + ip * 24 - 25], (
25902 				ftnlen)80, (ftnlen)1);
25903 		    }
25904 
25905 /*  Now that chords are done, add stuff to midi file */
25906 
25907 		    if (commidi_1.ismidi) {
25908 			i__11 = all_1.nolev[commvl_1.ivx + ip * 24 - 25] +
25909 				commvel_1.miditran[cominsttrans_1.instno[
25910 				all_1.iv - 1] - 1];
25911 			i__12 = all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 7;
25912 			L__1 = bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
25913 				25],0);
25914 			addmidi_(&icm, &i__11, &i__12, &commidisig_1.midisig,
25915 				&all_1.tnote[comipl2_1.ipl2[commvl_1.ivx + ip
25916 				* 24 - 25] - 1], &L__1, &c_false);
25917 		    }
25918 /* 130316 */
25919 /*     *          nolev(ivx,ip)-iTransAmt(instno(iv)), */
25920 /*     *          iand(nacc(ivx,ip),7),midisig(instno(iv)), */
25921 
25922 /*  Check for breath or caesura */
25923 
25924 		    if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],28))
25925 			    {
25926 			putcb_(&commvl_1.ivx, &ip, notexq, &lnote, (ftnlen)79)
25927 				;
25928 			addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (
25929 				ftnlen)80);
25930 		    }
25931 
25932 /*  Check for main-note ornaments. ')' on dotted notes go in with note, not here. */
25933 /*  Bits 0-13: (stmgx+Tupf._) ; 14: Down fermata, was F */
25934 /*  15: Trill w/o "tr", was U , 16-18 edit. accid., 19-21 TBD */
25935 
25936 		    isacc = (all_1.iornq[commvl_1.ivx + ip * 24 - 1] &
25937 			    4194287) > 0;
25938 
25939 /*  isacc=.true. if any ornament except segno */
25940 
25941 		    if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13)
25942 			    && all_1.nodur[commvl_1.ivx + ip * 24 - 25] > 0) {
25943 
25944 /*  If ).  is only ornament, bypass.  If with others, temporarirly zero the bit. */
25945 
25946 			i__11 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 -
25947 				25]);
25948 			if (pow_ii(&c__2, &i__11) != all_1.nodur[commvl_1.ivx
25949 				+ ip * 24 - 25]) {
25950 			    if ((all_1.iornq[commvl_1.ivx + ip * 24 - 1] &
25951 				    516079) == 0) {
25952 
25953 /*  ). is the only non-segno ornament */
25954 
25955 				isacc = FALSE_;
25956 			    } else {
25957 
25958 /*  There are other ornaments in addition */
25959 
25960 				rpndot = TRUE_;
25961 				all_1.iornq[commvl_1.ivx + ip * 24 - 1] =
25962 					bit_clear(all_1.iornq[commvl_1.ivx +
25963 					ip * 24 - 1],13);
25964 			    }
25965 			}
25966 		    }
25967 		    if (isacc && ! comcwrf_1.cwrferm[commvl_1.ivx - 1]) {
25968 
25969 /*  Check for centered whole-bar rest with fermata (bits 10 or 14). */
25970 
25971 			if ((all_1.iornq[commvl_1.ivx + ip * 24 - 1] & 17408)
25972 				> 0 && bit_test(all_1.irest[commvl_1.ivx + ip
25973 				* 24 - 25],0) && all_1.nodur[commvl_1.ivx +
25974 				ip * 24 - 25] == all_1.lenbar && ! (
25975 				all_1.firstgulp && all_1.ibar == 1 &&
25976 				all_1.lenb0 > 0)) {
25977 			    comcwrf_1.cwrferm[commvl_1.ivx - 1] = TRUE_;
25978 			    goto L30;
25979 			}
25980 			i__11 = ncmid_(&all_1.iv, &ip);
25981 			L__1 = bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25]
25982 				,10);
25983 			putorn_(&all_1.iornq[commvl_1.ivx + ip * 24 - 1], &
25984 				all_1.nolev[commvl_1.ivx + ip * 24 - 25], &
25985 				all_1.nolev[commvl_1.ivx + ip * 24 - 25], &
25986 				all_1.nodur[commvl_1.ivx + ip * 24 - 25],
25987 				nornb, all_1.ulq, &all_1.ibmcnt[commvl_1.ivx
25988 				- 1], &commvl_1.ivx, &i__11, &all_1.islur[
25989 				commvl_1.ivx + ip * 24 - 25], &commvl_1.nvmx[
25990 				all_1.iv - 1], &all_1.nv, ihornb, &
25991 				all_1.stemlen, notexq, &lnote, &ip, &islhgt, &
25992 				all_1.beamon[commvl_1.ivx - 1], &L__1, (
25993 				ftnlen)1, (ftnlen)79);
25994 			addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (
25995 				ftnlen)80);
25996 		    }
25997 		    if (rpndot) {
25998 			all_1.iornq[commvl_1.ivx + ip * 24 - 1] = bit_set(
25999 				all_1.iornq[commvl_1.ivx + ip * 24 - 1],13);
26000 			rpndot = FALSE_;
26001 		    }
26002 L30:
26003 
26004 /*  Check for main note accidental */
26005 
26006 		    if ((all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 3) > 0 && !
26007 			     bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],
26008 			    17)) {
26009 			ihshft = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24
26010 				- 25], &c__7, &c__10);
26011 			if (ihshft != 0) {
26012 			    ihshft += -107;
26013 			}
26014 			if (! bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],
26015 				10) && bit_test(all_1.ipl[commvl_1.ivx + ip *
26016 				24 - 25],8)) {
26017 			    ihshft += -20;
26018 			}
26019 
26020 /* Not a chord, and left-shifted main note, so left-shift accid */
26021 
26022 			i__11 = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24
26023 				- 25], &c__6, &c__4);
26024 			i__12 = ncmid_(&all_1.iv, &ip);
26025 			L__1 = bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
26026 				25],31);
26027 			doacc_(&ihshft, &i__11, notexq, &lnote, &all_1.nacc[
26028 				commvl_1.ivx + ip * 24 - 25], &all_1.nolev[
26029 				commvl_1.ivx + ip * 24 - 25], &i__12, &L__1, (
26030 				ftnlen)79);
26031 			addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (
26032 				ftnlen)80);
26033 		    }
26034 
26035 /*  Lower dot for lower-voice notes.  Conditions are: */
26036 /*   1. Dotted time value */
26037 /*   2. Lower voice of two */
26038 /*   3. Note is on a line */
26039 /*   4. Not a rest */
26040 /* .  5. Flag (lowdot) is set to true */
26041 /*   6. Not in an xtuplet */
26042 
26043 		    if (comarp_1.lowdot && commvl_1.nvmx[all_1.iv - 1] == 2 &&
26044 			     commvl_1.ivx <= all_1.nv && all_1.nodur[
26045 			    commvl_1.ivx + ip * 24 - 25] != 0) {
26046 			i__11 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 -
26047 				25]);
26048 			if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
26049 				25],0) && pow_ii(&c__2, &i__11) !=
26050 				all_1.nodur[commvl_1.ivx + ip * 24 - 25] && (
26051 				all_1.nolev[commvl_1.ivx + ip * 24 - 25] -
26052 				ncmid_(&commvl_1.ivx, &ip)) % 2 == 0) {
26053 			    if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
26054 				    25],19)) {
26055 
26056 /*  Note already in movdot list.  Drop by 2. */
26057 
26058 				comcc_1.updot[commvl_1.ivx + (comcc_1.ndotmv[
26059 					commvl_1.ivx - 1] + 1) * 24 - 25] +=
26060 					-2.f;
26061 			    } else {
26062 
26063 /*  Not in list so just move it right now */
26064 
26065 				i__11 = igetbits_(&all_1.islur[commvl_1.ivx +
26066 					ip * 24 - 25], &c__1, &c__3);
26067 				dotmov_(&c_b761, &c_b762, soutq, &lsout, &
26068 					i__11, (ftnlen)80);
26069 			    }
26070 			}
26071 		    }
26072 
26073 /*  Check for dotted notes with moved dots */
26074 
26075 		    if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],19))
26076 			     {
26077 			++comcc_1.ndotmv[commvl_1.ivx - 1];
26078 			i__11 = igetbits_(&all_1.islur[commvl_1.ivx + ip * 24
26079 				- 25], &c__1, &c__3);
26080 			dotmov_(&comcc_1.updot[commvl_1.ivx + comcc_1.ndotmv[
26081 				commvl_1.ivx - 1] * 24 - 25], &comcc_1.rtdot[
26082 				commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx -
26083 				1] * 24 - 25], soutq, &lsout, &i__11, (ftnlen)
26084 				80);
26085 		    }
26086 
26087 /*  Stemlength shortening? */
26088 
26089 		    if (bit_test(all_1.mult[commvl_1.ivx + ip * 24 - 25],27))
26090 			    {
26091 			stemshort = 4.66f - (igetbits_(&all_1.mult[
26092 				commvl_1.ivx + ip * 24 - 25], &c__3, &c__28)
26093 				+ 1) * .667f * .5f;
26094 /* Writing concatenation */
26095 			i__4[0] = 1, a__2[0] = all_1.sq;
26096 			i__4[1] = 11, a__2[1] = "stemlength{";
26097 			s_cat(ch__3, a__2, i__4, &c__2, (ftnlen)12);
26098 			addstr_(ch__3, &c__12, soutq, &lsout, (ftnlen)12, (
26099 				ftnlen)80);
26100 			s_wsfi(&io___1050);
26101 			do_fio(&c__1, (char *)&stemshort, (ftnlen)sizeof(real)
26102 				);
26103 			e_wsfi();
26104 /* Writing concatenation */
26105 			i__4[0] = 4, a__2[0] = notexq;
26106 			i__4[1] = 1, a__2[1] = "}";
26107 			s_cat(ch__16, a__2, i__4, &c__2, (ftnlen)5);
26108 			addstr_(ch__16, &c__5, soutq, &lsout, (ftnlen)5, (
26109 				ftnlen)80);
26110 		    } else if (ip > 1) {
26111 			if (bit_test(all_1.mult[commvl_1.ivx + (ip - 1) * 24
26112 				- 25],27)) {
26113 /* Writing concatenation */
26114 			    i__4[0] = 1, a__2[0] = all_1.sq;
26115 			    i__4[1] = 16, a__2[1] = "stemlength{4.66}";
26116 			    s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)17);
26117 			    addstr_(ch__5, &c__17, soutq, &lsout, (ftnlen)17,
26118 				    (ftnlen)80);
26119 			}
26120 
26121 /*  Cancel shortening.  Looks like it gets automatically restored if new inst. or */
26122 /*    new line, so no need to worry about affecting other lines */
26123 
26124 		    }
26125 
26126 /*  Zero out slur-height marker for raising ornaments */
26127 
26128 		    islhgt = 0;
26129 
26130 /*  Now start with spacing notes.  Is a beam start pending? */
26131 
26132 		    if (bspend && all_1.ibm2[commvl_1.ivx + all_1.ibmcnt[
26133 			    commvl_1.ivx - 1] * 24 - 25] > all_1.ibm1[
26134 			    commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] *
26135 			    24 - 25]) {
26136 			if (strtmid_1.ixrest[commvl_1.ivx - 1] == 4) {
26137 
26138 /*  Special path for single note at end of otherwise beamed xtup */
26139 
26140 			    strtmid_1.ixrest[commvl_1.ivx - 1] = 0;
26141 			} else {
26142 			    if (comkbdrests_1.kbdrests && bit_test(
26143 				    all_1.irest[commvl_1.ivx + ip * 24 - 25],
26144 				    0) && ! bit_test(all_1.islur[commvl_1.ivx
26145 				    + ip * 24 - 25],29) && commvl_1.nvmx[
26146 				    all_1.iv - 1] == 2 && all_1.nolev[
26147 				    commvl_1.ivx + ip * 24 - 25] <= 50) {
26148 				chkkbdrests_(&ip, &all_1.iv, &commvl_1.ivx,
26149 					all_1.nn, all_1.iornq, all_1.islur,
26150 					all_1.irest, all_1.nolev,
26151 					commvl_1.ivmx, all_1.nib, &all_1.nv, &
26152 					all_1.ibar, &tnow, &comtol_1.tol,
26153 					all_1.nodur, &c__2,
26154 					comkbdrests_1.levtopr,
26155 					comkbdrests_1.levbotr, all_1.mult);
26156 			    }
26157 			    beamn1_(notexq, &lnote, (ftnlen)79);
26158 			}
26159 			bspend = FALSE_;
26160 
26161 /*  Is a beam ending? */
26162 
26163 		    } else if (numbms[commvl_1.ivx] > 0 && all_1.ibmcnt[
26164 			    commvl_1.ivx - 1] <= numbms[commvl_1.ivx] && (
26165 			    all_1.ibm2[commvl_1.ivx + all_1.ibmcnt[
26166 			    commvl_1.ivx - 1] * 24 - 25] == ip || bit_test(
26167 			    all_1.nacc[commvl_1.ivx + ip * 24 - 25],20))) {
26168 /*     *           .and. ibm2(ivx,ibmcnt(ivx)) .eq. ip) then */
26169 			if (bspend) {
26170 
26171 /*  Must be a single-note ending of a jump-beam */
26172 
26173 			    bspend = FALSE_;
26174 			}
26175 			beamend_(notexq, &lnote, (ftnlen)79);
26176 			if (! bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25]
26177 				,20)) {
26178 			    comxtup_1.vxtup[commvl_1.ivx - 1] = FALSE_;
26179 			    nornb[commvl_1.ivx - 1] = 0;
26180 			    ++all_1.ibmcnt[commvl_1.ivx - 1];
26181 			    all_1.beamon[commvl_1.ivx - 1] = FALSE_;
26182 			}
26183 
26184 /*  Or if we're in the middle of a beam */
26185 
26186 		    } else if (numbms[commvl_1.ivx] > 0 && all_1.beamon[
26187 			    commvl_1.ivx - 1]) {
26188 
26189 /*  Added 130127 */
26190 
26191 			if (comkbdrests_1.kbdrests && bit_test(all_1.irest[
26192 				commvl_1.ivx + ip * 24 - 25],0) && ! bit_test(
26193 				all_1.islur[commvl_1.ivx + ip * 24 - 25],29)
26194 				&& commvl_1.nvmx[all_1.iv - 1] == 2 &&
26195 				all_1.nolev[commvl_1.ivx + ip * 24 - 25] <=
26196 				50) {
26197 			    chkkbdrests_(&ip, &all_1.iv, &commvl_1.ivx,
26198 				    all_1.nn, all_1.iornq, all_1.islur,
26199 				    all_1.irest, all_1.nolev, commvl_1.ivmx,
26200 				    all_1.nib, &all_1.nv, &all_1.ibar, &tnow,
26201 				    &comtol_1.tol, all_1.nodur, &c__2,
26202 				    comkbdrests_1.levtopr,
26203 				    comkbdrests_1.levbotr, all_1.mult);
26204 			}
26205 			beamid_(notexq, &lnote, (ftnlen)79);
26206 
26207 /*      Or whole-bar rest */
26208 
26209 		    } else if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
26210 			    25],0) && all_1.nodur[commvl_1.ivx + ip * 24 - 25]
26211 			     == all_1.lenbar && ! (all_1.firstgulp &&
26212 			    all_1.ibar == 1 && all_1.lenb0 > 0) && ! bit_test(
26213 			    all_1.irest[commvl_1.ivx + ip * 24 - 25],25) && !
26214 			    bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],
26215 			    29)) {
26216 
26217 /*  Rule out pickup bar, blank rests, non-centered.  Remember islur b19=> rp */
26218 
26219 			cwrest[commvl_1.ivx] = TRUE_;
26220 			iscwr = TRUE_;
26221 			notex_(cwrq + (commvl_1.ivx - 1) * 79, &lcwr[
26222 				commvl_1.ivx - 1], (ftnlen)79);
26223 			tnow += all_1.lenbar;
26224 			goto L10;
26225 		    } else if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0) {
26226 
26227 /*  Before writing note or rest, check for keyboard rest height adjustment. */
26228 /*  Conditions are 0. This is a non-blank rest */
26229 /*                 1. kbdrests = .true. */
26230 /*                 2. There are two voices on the staff */
26231 /*                 3. No user-def height adjustments have been applied (nolev<50) */
26232 /* c                 4. Not last note in bar */
26233 /* c                 5. Followed by note (add better test later) */
26234 
26235 			if (comkbdrests_1.kbdrests && bit_test(all_1.irest[
26236 				commvl_1.ivx + ip * 24 - 25],0) && ! bit_test(
26237 				all_1.islur[commvl_1.ivx + ip * 24 - 25],29)
26238 				&& commvl_1.nvmx[all_1.iv - 1] == 2 &&
26239 				all_1.nolev[commvl_1.ivx + ip * 24 - 25] <=
26240 				50) {
26241 /*     *             nolev(ivx,ip).le.50 .and. ip.ne.nn(ivx) */
26242 /*     *            .and. .not.(btest(irest(ivx,ip+1),0))) then */
26243 
26244 /*  130127 Replaced following code with a subroutine */
26245 
26246 /* c  Get reference level: next following note if no intervening blank rests, */
26247 /* c    otherwise next prior note. */
26248 /* c */
26249 /* c               levnext = nolev(ivx,ip+1)-ncmid(iv,ip)+4   ! Relative to bottom line */
26250 /*                if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then */
26251 /* c */
26252 /* c  Not the last note and not "look-left" for level */
26253 /* c */
26254 /*                  do 8 kkp = ip+1 , nn(ivx) */
26255 /*                    if (btest(islur(ivx,kkp),29)) go to 4 */
26256 /*                    if (.not.btest(irest(ivx,kkp),0)) then */
26257 /*                      levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line */
26258 /*                      go to 9 */
26259 /*                    end if */
26260 /* 8                 continue */
26261 /*                end if */
26262 /* 4               continue */
26263 /* c */
26264 /* c  If here, there were no following notes or came to a blank rest, or */
26265 /* c    "look-left" option set. So look before */
26266 /* c */
26267 /*                if (ip .eq. 1) go to 2 ! Get out if this is the first note. */
26268 /*                do 3 kkp = ip-1, 1, -1 */
26269 /*                  if (.not.btest(irest(ivx,kkp),0)) then */
26270 /*                    levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line */
26271 /*                    go to 9 */
26272 /*                  end if */
26273 /* 3               continue */
26274 /*                go to 2  ! Pretty odd, should never be here, but get out if so. */
26275 /* 9               continue */
26276 /* c */
26277 /* c  Find note in other voice at same time */
26278 /* c */
26279 /*                iupdown = sign(1,ivx-nv-1) */
26280 /*                ivother = ivmx(iv,(3-iupdown)/2) */
26281 /*                tother = 0. */
26282 /*                do 5 kkp = 1 , nib(ivother,ibar) */
26283 /*                  if (abs(tother-tnow) .lt. tol) go to 6 */
26284 /*                  tother = tother+nodur(ivother,kkp) */
26285 /* 5               continue */
26286 /* c */
26287 /* c  If here, then no note starts in other voice at same time, so set default */
26288 /* c */
26289 /*                levother = -iupdown*50 */
26290 /*                go to 7 */
26291 /* 6               continue */
26292 /* c */
26293 /* c  If here, have just identified a simultaneous note or rest in other voice */
26294 /* c */
26295 /*                if (.not.btest(irest(ivother,kkp),0)) then ! Not a rest, use it */
26296 /*                  levother = nolev(ivother,kkp)-ncmid(iv,ip)+4 */
26297 /*                else */
26298 /*                  if (nodur(ivother,kkp) .eq. nodur(ivx,ip)) then */
26299 /* c */
26300 /* c  Rest in other voice has same duration, get out (so defualt spacing is used) */
26301 /* c */
26302 /*                    go to 2 */
26303 /*                  end if */
26304 /*                  levother = -iupdown*50 */
26305 /*                end if */
26306 /* 7               continue */
26307 /*                indxr = log2(nodur(ivx,ip))+1 */
26308 /*                if (iupdown .lt. 0) then */
26309 /*                  levtop = levtopr(indxr) */
26310 /*                  iraise1 = levother-levtop-3  ! Based on other note */
26311 /*                  iraise2 = levnext-levtop     ! Based on following note */
26312 /*                  if (indxr.eq.5 .and. levnext.lt.1) iraise2=iraise2+2 */
26313 /*                  iraise = min(iraise1,iraise2) */
26314 /*                  if (mod(iraise+50,2).eq.1 .and. */
26315 /*     *                iraise+levtop.gt.-1) iraise = iraise-1 */
26316 /*                else */
26317 /*                  levbot = levbotr(indxr) */
26318 /*                  iraise1 = levother-levbot+3 */
26319 /*                  iraise2 = levnext-levbot */
26320 /*                  if (indxr.eq.5 .and. levnext.gt.8) iraise2=iraise2-1 */
26321 /*                  iraise = max(iraise1,iraise2) */
26322 /*                  if (mod(iraise+50,2).eq.1 .and. */
26323 /*     *                iraise+levbot.le.9) iraise = iraise-1 */
26324 /*                end if */
26325 /*                nolev(ivx,ip) = 100+iraise */
26326 
26327 /*  The new subroutine call, to replace above code */
26328 
26329 			    chkkbdrests_(&ip, &all_1.iv, &commvl_1.ivx,
26330 				    all_1.nn, all_1.iornq, all_1.islur,
26331 				    all_1.irest, all_1.nolev, commvl_1.ivmx,
26332 				    all_1.nib, &all_1.nv, &all_1.ibar, &tnow,
26333 				    &comtol_1.tol, all_1.nodur, &c__1,
26334 				    comkbdrests_1.levtopr,
26335 				    comkbdrests_1.levbotr, all_1.mult);
26336 			}
26337 /* L2: */
26338 
26339 /*  Write a separate note or rest */
26340 
26341 			notex_(notexq, &lnote, (ftnlen)79);
26342 		    }
26343 
26344 /*  Right offset?  This may cause trouble */
26345 
26346 		    if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8)) {
26347 /* Writing concatenation */
26348 			i__4[0] = 1, a__2[0] = all_1.sq;
26349 			i__4[1] = 5, a__2[1] = "loff{";
26350 			s_cat(ch__15, a__2, i__4, &c__2, (ftnlen)6);
26351 			addstr_(ch__15, &c__6, soutq, &lsout, (ftnlen)6, (
26352 				ftnlen)80);
26353 		    } else if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25]
26354 			    ,9)) {
26355 /* Writing concatenation */
26356 			i__4[0] = 1, a__2[0] = all_1.sq;
26357 			i__4[1] = 5, a__2[1] = "roff{";
26358 			s_cat(ch__15, a__2, i__4, &c__2, (ftnlen)6);
26359 			addstr_(ch__15, &c__6, soutq, &lsout, (ftnlen)6, (
26360 				ftnlen)80);
26361 		    }
26362 		    if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0 && lnote > 0)
26363 			    {
26364 			addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (
26365 				ftnlen)80);
26366 		    }
26367 		    if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8) ||
26368 			    bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],9)
26369 			    ) {
26370 			addstr_("}", &c__1, soutq, &lsout, (ftnlen)1, (ftnlen)
26371 				80);
26372 		    }
26373 
26374 /*  Terminate user-defined offsets.  Fix format */
26375 
26376 		    if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],15)
26377 			    || bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
26378 			    25],17)) {
26379 			putshft_(&commvl_1.ivx, &c_false, soutq, &lsout, (
26380 				ftnlen)80);
26381 		    }
26382 
26383 /*  Deal with After- and Way-after-graces.  First, if end of bar, compute space */
26384 /*    needed since it wasn't done during general ask-checks. If extra space is */
26385 /*    rq'd, convert GW to GA.  Therefore GW at end of bar never needs extra sp. */
26386 /*    But will still need to add extra space as hardspace. */
26387 
26388 		    if (ip == all_1.nn[commvl_1.ivx - 1] && (bit_test(
26389 			    all_1.ipl[commvl_1.ivx + ip * 24 - 25],31) ||
26390 			    bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],
26391 			    29))) {
26392 			i__11 = comgrace_1.ngrace;
26393 			for (ig = 1; ig <= i__11; ++ig) {
26394 			    if (comgrace_1.ipg[ig - 1] == ip &&
26395 				    comgrace_1.ivg[ig - 1] == commvl_1.ivx) {
26396 				goto L78;
26397 			    }
26398 /* L77: */
26399 			}
26400 			s_wsle(&io___1053);
26401 			do_lio(&c__9, &c__1, "Problem finding grace index "
26402 				"at \"do 77\"", (ftnlen)38);
26403 			e_wsle();
26404 			stop1_();
26405 L78:
26406 
26407 /*  Get elemskip to end of bar.  WON'T WORK IF XTUPS !! */
26408 
26409 			esk = 0.f;
26410 			i__11 = comnsp_2.nb;
26411 			for (iib = ib; iib <= i__11; ++iib) {
26412 			    if (iib == ib) {
26413 				itleft = i_nint(&all_1.to[comipl2_1.ipl2[
26414 					commvl_1.ivx + ip * 24 - 25] - 1]);
26415 			    } else {
26416 				itleft = i_nint(&tstart[ib]);
26417 			    }
26418 			    if (iib < comnsp_2.nb) {
26419 				itright = i_nint(&tstart[iib + 1]);
26420 			    } else {
26421 				itright = all_1.lenbar;
26422 			    }
26423 			    esk += feon_(&comnsp_2.space[ib - 1]) * (itright
26424 				    - itleft) / comnsp_2.space[ib - 1];
26425 /* L40: */
26426 			}
26427 			ptsavail = comask_1.poenom * esk - comask_1.wheadpt;
26428 			if (comgrace_1.nng[ig - 1] == 1) {
26429 			    wgr = spfacs_1.grafac;
26430 			} else {
26431 			    wgr = comgrace_1.nng[ig - 1] * spfacs_1.emgfac;
26432 			    i__11 = comgrace_1.nng[ig - 1];
26433 			    for (ing = 1; ing <= i__11; ++ing) {
26434 				if (comgrace_1.naccg[comgrace_1.ngstrt[ig - 1]
26435 					 - 1 + ing - 1] > 0) {
26436 				    wgr += spfacs_1.acgfac;
26437 				}
26438 /* L41: */
26439 			    }
26440 			}
26441 			ptgr[ig - 1] = wgr * comask_1.wheadpt;
26442 			ptsneed = (wgr + .5f) * comask_1.wheadpt;
26443 			ptsndg[commvl_1.ivx - 1] = 0.f;
26444 			if (ptsavail < ptsneed) {
26445 			    ptsndg[commvl_1.ivx - 1] = ptsneed;
26446 			    eskndg[commvl_1.ivx - 1] = esk;
26447 			    if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 -
26448 				    25],31)) {
26449 
26450 /*  Convert GW to GA */
26451 
26452 				all_1.ipl[commvl_1.ivx + ip * 24 - 25] =
26453 					bit_set(bit_clear(all_1.ipl[
26454 					commvl_1.ivx + ip * 24 - 25],31),29);
26455 			    }
26456 			}
26457 		    }
26458 
26459 /*  Check for GA */
26460 
26461 		    if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],29)) {
26462 			i__11 = ncmid_(&all_1.iv, &ip);
26463 			dograce_(&commvl_1.ivx, &ip, ptgr, soutq, &lsout, &
26464 				i__11, &all_1.nacc[commvl_1.ivx + ip * 24 -
26465 				25], &ig, &all_1.ipl[commvl_1.ivx + ip * 24 -
26466 				25], &c_false, &c_false, &c__0, &c__0, &c__0,
26467 				&c__0, &c__0, &c__0, &c_b762, all_1.ulq, &
26468 				cominsttrans_1.instno[all_1.iv - 1], (ftnlen)
26469 				80, (ftnlen)1);
26470 		    }
26471 /* 130324 */
26472 /*     *            .false.,0,0,0,0,0,0,0.,ulq) */
26473 
26474 /*  Update running time */
26475 
26476 		    tnow += comnsp_2.space[ib - 1];
26477 L10:
26478 		    ;
26479 		}
26480 
26481 /*  Have finished last note in this voice and block */
26482 
26483 		r__1 = all_1.to[istop[ib] - 1] + comnsp_2.space[ib - 1];
26484 		itendb = i_nint(&r__1);
26485 		if (all_1.figbass && commvl_1.ivx == 1 || commvl_1.ivx ==
26486 			comfig_1.ivxfig2) {
26487 		    ivf = 1;
26488 		    if (commvl_1.ivx > 1) {
26489 			ivf = 2;
26490 		    }
26491 L17:
26492 		    if (all_1.figchk[ivf - 1] && comfig_1.itfig[ivf + (ifig[
26493 			    ivf - 1] << 1) - 3] < itendb) {
26494 
26495 /*  There's at least one figure left. offnsk could be <0 */
26496 
26497 			offnsk = (tnow - comfig_1.itfig[ivf + (ifig[ivf - 1]
26498 				<< 1) - 3]) / comnsp_2.space[ib - 1];
26499 			putfig_(&ivf, &ifig[ivf - 1], &offnsk, &all_1.figchk[
26500 				ivf - 1], soutq, &lsout, (ftnlen)80);
26501 			goto L17;
26502 		    }
26503 		}
26504 
26505 /*  Check for flag, dot, or upstem on last note of bar. */
26506 
26507 		if (ib == comnsp_2.nb) {
26508 		    ip = all_1.ipo[comipl2_1.ipl2[commvl_1.ivx + all_1.nn[
26509 			    commvl_1.ivx - 1] * 24 - 25] - 1];
26510 		    comnsp_2.flgndv[commvl_1.ivx - 1] = 0.f;
26511 		    if ((r__1 = all_1.tnote[comipl2_1.ipl2[commvl_1.ivx + ip *
26512 			     24 - 25] - 1] - comnsp_2.space[ib - 1], dabs(
26513 			    r__1)) < comtol_1.tol) {
26514 			if (comnsp_2.space[ib - 1] < 16.f - comtol_1.tol) {
26515 
26516 /*  Note in last space, smaller than a quarter note. */
26517 
26518 			    i__9 = ncmid_(&all_1.iv, &ip);
26519 			    udqq_(ch__4, (ftnlen)1, &all_1.nolev[commvl_1.ivx
26520 				    + ip * 24 - 25], &i__9, &all_1.islur[
26521 				    commvl_1.ivx + ip * 24 - 25], &
26522 				    commvl_1.nvmx[all_1.iv - 1], &
26523 				    commvl_1.ivx, &all_1.nv);
26524 			    if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24
26525 				    - 25],0) && *(unsigned char *)&ch__4[0] ==
26526 				     'u' || isdotted_(all_1.nodur, &
26527 				    commvl_1.ivx, &ip)) {
26528 
26529 /*  Upstem non-rest, or dotted */
26530 
26531 /* Computing MAX */
26532 				i__9 = 1, i__11 = numbms[commvl_1.ivx];
26533 				if (numbms[commvl_1.ivx] > 0 && ip ==
26534 					all_1.ibm2[commvl_1.ivx + max(i__9,
26535 					i__11) * 24 - 25] && ! isdotted_(
26536 					all_1.nodur, &commvl_1.ivx, &ip)) {
26537 
26538 /*  In beam and not dotted, so use smaller space */
26539 
26540 				    comnsp_2.flgndv[commvl_1.ivx - 1] =
26541 					    spfacs_1.upstmfac;
26542 				} else {
26543 				    comnsp_2.flgndv[commvl_1.ivx - 1] =
26544 					    spfacs_1.flagfac;
26545 				}
26546 			    }
26547 			} else {
26548 
26549 /*  Last space, nonflagged (no beam) only worry dot or up */
26550 
26551 			    if (isdotted_(all_1.nodur, &commvl_1.ivx, &ip)) {
26552 				comnsp_2.flgndv[commvl_1.ivx - 1] =
26553 					spfacs_1.flagfac;
26554 			    } else /* if(complicated condition) */ {
26555 				i__9 = ncmid_(&all_1.iv, &ip);
26556 				udqq_(ch__4, (ftnlen)1, &all_1.nolev[
26557 					commvl_1.ivx + ip * 24 - 25], &i__9, &
26558 					all_1.islur[commvl_1.ivx + ip * 24 -
26559 					25], &commvl_1.nvmx[all_1.iv - 1], &
26560 					commvl_1.ivx, &all_1.nv);
26561 				if (all_1.tnote[comipl2_1.ipl2[commvl_1.ivx +
26562 					ip * 24 - 25] - 1] < 64.f && *(
26563 					unsigned char *)&ch__4[0] == 'u') {
26564 
26565 /*  Upstem on last note , non-flagged */
26566 
26567 				    comnsp_2.flgndv[commvl_1.ivx - 1] =
26568 					    spfacs_1.upstmfac;
26569 				}
26570 			    }
26571 			}
26572 		    }
26573 
26574 /*  Check for right-shifted chordal note */
26575 
26576 		    if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],20))
26577 			     {
26578 			comnsp_2.flgndv[commvl_1.ivx - 1] = spfacs_1.rtshfac;
26579 		    }
26580 		    comnsp_2.flgndb = comnsp_2.flgndb || comnsp_2.flgndv[
26581 			    commvl_1.ivx - 1] > 0.f;
26582 		    if (commidi_1.ismidi) {
26583 
26584 /*  For midi, set flags for accidentals on last note of bar.  Assume they affect */
26585 /*    first note of next bar whether or not tied. */
26586 /*  Note has already been done, so next entry into addmidi is 1st in new bar. */
26587 /*  First do main note, then chord notes */
26588 
26589 /*  Gyrations needed to account for multi-bar tied full-bar notes? */
26590 /* c  Old old    lbacc(icm) = iand(nacc(ivx,ip),7) */
26591 /*   New old    if (lbacc(icm).eq.0) lbacc(icm) = iand(nacc(ivx,ip),7) */
26592 
26593 			if ((all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 7) > 0)
26594 				 {
26595 
26596 /*  Explicit accidental on last main note in bar */
26597 
26598 			    i__9 = comslm_1.naccbl[icm];
26599 			    for (kacc = 1; kacc <= i__9; ++kacc) {
26600 				if (comslm_1.laccbl[icm + kacc * 25 - 25] ==
26601 					all_1.nolev[commvl_1.ivx + ip * 24 -
26602 					25]) {
26603 				    goto L56;
26604 				}
26605 /* L55: */
26606 			    }
26607 			    ++comslm_1.naccbl[icm];
26608 			    comslm_1.laccbl[icm + comslm_1.naccbl[icm] * 25 -
26609 				    25] = all_1.nolev[commvl_1.ivx + ip * 24
26610 				    - 25];
26611 			    i__9 = all_1.nacc[commvl_1.ivx + ip * 24 - 25] &
26612 				    7;
26613 			    comslm_1.jaccbl[icm + comslm_1.naccbl[icm] * 25 -
26614 				    25] = iashft_(&i__9);
26615 			}
26616 L56:
26617 			if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],
26618 				10) && commidi_1.crdacc) {
26619 			    i__9 = comtrill_1.icrd2;
26620 			    for (icrd = comtrill_1.icrd1; icrd <= i__9;
26621 				    ++icrd) {
26622 				iacc = igetbits_(&comtrill_1.icrdat[icrd - 1],
26623 					 &c__3, &c__20);
26624 				if (iacc > 0) {
26625 
26626 /*  Explicit accidental on chord note at end of bar */
26627 
26628 				    nolevc = igetbits_(&comtrill_1.icrdat[
26629 					    icrd - 1], &c__7, &c__12);
26630 				    i__11 = comslm_1.naccbl[icm];
26631 				    for (kacc = 1; kacc <= i__11; ++kacc) {
26632 					if (comslm_1.laccbl[icm + kacc * 25 -
26633 						25] == nolevc) {
26634 					    goto L59;
26635 					}
26636 /* L58: */
26637 				    }
26638 				    ++comslm_1.naccbl[icm];
26639 				    comslm_1.laccbl[icm + comslm_1.naccbl[icm]
26640 					     * 25 - 25] = nolevc;
26641 				    comslm_1.jaccbl[icm + comslm_1.naccbl[icm]
26642 					     * 25 - 25] = iashft_(&iacc);
26643 				}
26644 L59:
26645 /* L57: */
26646 				;
26647 			    }
26648 			}
26649 /*              if (lbacc(icm).eq.0 .and. accb4(icm)) then */
26650 			i__9 = commidi_1.naccim[icm];
26651 			for (kacc = 1; kacc <= i__9; ++kacc) {
26652 
26653 /*  If naccim(icm)>0, */
26654 /*  possible implicit accidental from earlier in the bar.  Check for prior accid */
26655 /*  in this bar at relevant note levels, main and chord notes.  Only act if no */
26656 /*  explicit action from just above.  Assuming any accid on last note in bar, */
26657 /*  either explicit or implicit, has same effect on 1st note of next bar. */
26658 
26659 			    if (all_1.nolev[commvl_1.ivx + ip * 24 - 25] ==
26660 				    commidi_1.laccim[icm + kacc * 25 - 25]) {
26661 				goto L66;
26662 			    }
26663 			    if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 -
26664 				    25],10)) {
26665 				i__11 = comtrill_1.icrd2;
26666 				for (icrd = comtrill_1.icrd1; icrd <= i__11;
26667 					++icrd) {
26668 				    if ((lbit_shift(comtrill_1.icrdat[icrd -
26669 					    1], (ftnlen)-12) & 127) ==
26670 					    commidi_1.laccim[icm + kacc * 25
26671 					    - 25]) {
26672 					goto L66;
26673 				    }
26674 /* L67: */
26675 				}
26676 			    }
26677 			    goto L65;
26678 L66:
26679 
26680 /*  So far we know there is a main or chord note at level laccim(icm,kacc). So */
26681 /*   it will get a bl-accid if it didn't just already get one. */
26682 
26683 			    i__11 = comslm_1.naccbl[icm];
26684 			    for (macc = 1; macc <= i__11; ++macc) {
26685 				if (comslm_1.laccbl[icm + macc * 25 - 25] ==
26686 					commidi_1.laccim[icm + kacc * 25 - 25]
26687 					) {
26688 				    goto L65;
26689 				}
26690 /* L68: */
26691 			    }
26692 			    ++comslm_1.naccbl[icm];
26693 			    comslm_1.laccbl[icm + comslm_1.naccbl[icm] * 25 -
26694 				    25] = commidi_1.laccim[icm + kacc * 25 -
26695 				    25];
26696 			    comslm_1.jaccbl[icm + comslm_1.naccbl[icm] * 25 -
26697 				    25] = commidi_1.jaccim[icm + kacc * 25 -
26698 				    25];
26699 L65:
26700 			    ;
26701 			}
26702 		    }
26703 		}
26704 /* L11: */
26705 	    }
26706 	}
26707 
26708 /*  Close out the notes group */
26709 
26710 /* Writing concatenation */
26711 	i__4[0] = 1, a__2[0] = all_1.sq;
26712 	i__4[1] = 2, a__2[1] = "en";
26713 	s_cat(ch__12, a__2, i__4, &c__2, (ftnlen)3);
26714 	addstr_(ch__12, &c__3, soutq, &lsout, (ftnlen)3, (ftnlen)80);
26715 	if (comlast_1.islast && lsout > 0) {
26716 	    s_wsfe(&io___1066);
26717 /* Writing concatenation */
26718 	    i__4[0] = lsout, a__2[0] = soutq;
26719 	    i__4[1] = 1, a__2[1] = "%";
26720 	    s_cat(ch__10, a__2, i__4, &c__2, (ftnlen)81);
26721 	    do_fio(&c__1, ch__10, lsout + 1);
26722 	    e_wsfe();
26723 	}
26724 /* L16: */
26725     }
26726 
26727 /*  Check for way-after graces at end of bar.  We could not link these to notes */
26728 /*  as in midbar since there is no note following grace!  Also, set flag if */
26729 /*  hardspace is needed. Also, save nvmx, ivmx for use in space checks on reloop. */
26730 
26731     isgrace = FALSE_;
26732     i__2 = all_1.nv;
26733     for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) {
26734 	comnsp_2.nvmxsav[all_1.iv - 1] = commvl_1.nvmx[all_1.iv - 1];
26735 	i__7 = commvl_1.nvmx[all_1.iv - 1];
26736 	for (kv = 1; kv <= i__7; ++kv) {
26737 	    comnsp_2.ivmxsav[all_1.iv + kv * 24 - 25] = commvl_1.ivmx[
26738 		    all_1.iv + kv * 24 - 25];
26739 	    commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
26740 	    comnsp_2.ptsgnd = 0.f;
26741 	    if ((bit_test(all_1.ipl[commvl_1.ivx + all_1.nn[commvl_1.ivx - 1]
26742 		    * 24 - 25],29) || bit_test(all_1.ipl[commvl_1.ivx +
26743 		    all_1.nn[commvl_1.ivx - 1] * 24 - 25],31)) && ptsndg[
26744 		    commvl_1.ivx - 1] > 0.f) {
26745 		comnsp_2.flgndb = TRUE_;
26746 		if (ptsndg[commvl_1.ivx - 1] > comnsp_2.ptsgnd) {
26747 		    comnsp_2.ptsgnd = ptsndg[commvl_1.ivx - 1];
26748 		    comnsp_2.eskgnd = eskndg[commvl_1.ivx - 1];
26749 		}
26750 	    }
26751 	    if (bit_test(all_1.ipl[commvl_1.ivx + all_1.nn[commvl_1.ivx - 1] *
26752 		     24 - 25],31)) {
26753 
26754 /*  This voice has a way-after grace here at end of bar */
26755 
26756 		if (! isgrace) {
26757 
26758 /*  This is the first one, so set up the string */
26759 
26760 		    isgrace = TRUE_;
26761 		    ivlast = 1;
26762 /* Writing concatenation */
26763 		    i__4[0] = 1, a__2[0] = all_1.sq;
26764 		    i__4[1] = 6, a__2[1] = "znotes";
26765 		    s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80);
26766 		    lsout = 7;
26767 		}
26768 		i__1 = all_1.iv - 1;
26769 		for (iiv = ivlast; iiv <= i__1; ++iiv) {
26770 		    addstr_(all_1.sepsymq + (iiv - 1), &c__1, soutq, &lsout, (
26771 			    ftnlen)1, (ftnlen)80);
26772 /* L76: */
26773 		}
26774 		ivlast = all_1.iv;
26775 
26776 /*  No need to put in 'nextvoice', even if 2 lines/staff */
26777 
26778 		i__1 = ncmid_(&all_1.iv, &all_1.nn[commvl_1.ivx - 1]);
26779 		dograce_(&commvl_1.ivx, &all_1.nn[commvl_1.ivx - 1], ptgr,
26780 			soutq, &lsout, &i__1, &all_1.nacc[commvl_1.ivx +
26781 			all_1.nn[commvl_1.ivx - 1] * 24 - 25], &ig, &
26782 			all_1.ipl[commvl_1.ivx + all_1.nn[commvl_1.ivx - 1] *
26783 			24 - 25], &c_true, &c_false, &c__0, &c__0, &c__0, &
26784 			c__0, &c__0, &c__0, &c_b762, all_1.ulq, &
26785 			cominsttrans_1.instno[all_1.iv - 1], (ftnlen)80, (
26786 			ftnlen)1);
26787 /* 130324 */
26788 /*     *      .false.,0,0,0,0,0,0,0.,ulq) */
26789 	    }
26790 /* L75: */
26791 	}
26792     }
26793     if (isgrace) {
26794 /* Writing concatenation */
26795 	i__4[0] = 1, a__2[0] = all_1.sq;
26796 	i__4[1] = 3, a__2[1] = "en%";
26797 	s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)4);
26798 	addstr_(ch__17, &c__4, soutq, &lsout, (ftnlen)4, (ftnlen)80);
26799 	if (comlast_1.islast && lsout > 0) {
26800 	    s_wsfe(&io___1069);
26801 	    do_fio(&c__1, soutq, lsout);
26802 	    e_wsfe();
26803 	}
26804     }
26805     lsout = 0;
26806 
26807 /*  Write multibar rest.  Assuming nv = 1  and do not worry about cwbrest */
26808 /*  This has to be the only use of atnextbar */
26809 
26810 /*      if (ibar .eq. ibarmbr) then */
26811     if (all_1.ibar == comgrace_1.ibarmbr && comlast_1.islast) {
26812 /*        call addstr(sq//'def'//sq//'atnextbar{'//sq//'znotes'//sq// */
26813 /*     *              'mbrest{',30,soutq,lsout) */
26814 /*        ndig = int(alog10(mbrest+.01))+1 */
26815 /*        write(soutq(31:33),'(i'//chax(48+ndig)//')')mbrest */
26816 /*        lsout = lsout+ndig */
26817 /*        call addstr('}{',2,soutq,lsout) */
26818 /*        mtrspc = .5+xb4mbr */
26819 /*        xb4mbr = 0. */
26820 /*        if (mtrspc .eq. 0) then */
26821 /*          ndig = 1 */
26822 /*        else */
26823 /*          ndig = int(alog10(mtrspc+.01))+1 */
26824 /*        end if */
26825 /*        write(soutq(lsout+1:lsout+2),'(i'//chax(48+ndig)//')')mtrspc */
26826 /*        lsout = lsout+ndig */
26827 /*        call addstr('}0'//sq//'en}%',7,soutq,lsout) */
26828 /*        if (islast) write(11,'(a)')soutq(1:lsout) */
26829 /*        lsout = 0 */
26830 /*        ndig = int(alog10(mbrest-1+.01))+1 */
26831 /*        if (mbrest.eq.1) ndig=1 */
26832 /*        if (islast) write(11,'(a14,i'//chax(48+ndig)//',a1)') */
26833 /*     *      sq//'advance'//sq//'barno',mbrest-1,'%' */
26834 /* ++ */
26835 /* Writing concatenation */
26836 	i__3[0] = 1, a__1[0] = all_1.sq;
26837 	i__3[1] = 3, a__1[1] = "def";
26838 	i__3[2] = 1, a__1[2] = all_1.sq;
26839 	i__3[3] = 10, a__1[3] = "atnextbar{";
26840 	i__3[4] = 1, a__1[4] = all_1.sq;
26841 	i__3[5] = 6, a__1[5] = "znotes";
26842 	s_cat(soutq, a__1, i__3, &c__6, (ftnlen)80);
26843 	lsout = 22;
26844 /* Writing concatenation */
26845 	i__4[0] = 1, a__2[0] = all_1.sq;
26846 	i__4[1] = 6, a__2[1] = "mbrest";
26847 	s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
26848 	lnote = 7;
26849 	istring_(&comgrace_1.mbrest, noteq, &len, (ftnlen)8);
26850 /* Writing concatenation */
26851 	i__4[0] = lnote, a__2[0] = notexq;
26852 	i__4[1] = len, a__2[1] = noteq;
26853 	s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
26854 	lnote += len;
26855 	mtrspc = comgrace_1.xb4mbr + .5f;
26856 	comgrace_1.xb4mbr = 0.f;
26857 	istring_(&mtrspc, noteq, &len, (ftnlen)8);
26858 /* Writing concatenation */
26859 	i__6[0] = lnote, a__4[0] = notexq;
26860 	i__6[1] = len, a__4[1] = noteq;
26861 	i__6[2] = 1, a__4[2] = "0";
26862 	s_cat(notexq, a__4, i__6, &c__3, (ftnlen)79);
26863 	lnote = lnote + len + 1;
26864 	i__7 = all_1.nv;
26865 	for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) {
26866 	    addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (ftnlen)80);
26867 	    if (all_1.iv < all_1.nv) {
26868 		addstr_(all_1.sepsymq + (all_1.iv - 1), &c__1, soutq, &lsout,
26869 			(ftnlen)1, (ftnlen)80);
26870 	    }
26871 /* L62: */
26872 	}
26873 /* Writing concatenation */
26874 	i__4[0] = 1, a__2[0] = all_1.sq;
26875 	i__4[1] = 4, a__2[1] = "en}%";
26876 	s_cat(ch__16, a__2, i__4, &c__2, (ftnlen)5);
26877 	addstr_(ch__16, &c__5, soutq, &lsout, (ftnlen)5, (ftnlen)80);
26878 	s_wsfe(&io___1072);
26879 	do_fio(&c__1, soutq, lsout);
26880 	e_wsfe();
26881 	lsout = 0;
26882 	if (comgrace_1.mbrest > 1) {
26883 	    r__1 = comgrace_1.mbrest - 1 + .01f;
26884 	    ndig = (integer) r_lg10(&r__1) + 1;
26885 	    ci__1.cierr = 0;
26886 	    ci__1.ciunit = 11;
26887 /* Writing concatenation */
26888 	    i__6[0] = 6, a__4[0] = "(a14,i";
26889 	    i__7 = ndig + 48;
26890 	    chax_(ch__4, (ftnlen)1, &i__7);
26891 	    i__6[1] = 1, a__4[1] = ch__4;
26892 	    i__6[2] = 4, a__4[2] = ",a1)";
26893 	    ci__1.cifmt = (s_cat(ch__7, a__4, i__6, &c__3, (ftnlen)11), ch__7)
26894 		    ;
26895 	    s_wsfe(&ci__1);
26896 /* Writing concatenation */
26897 	    i__8[0] = 1, a__5[0] = all_1.sq;
26898 	    i__8[1] = 7, a__5[1] = "advance";
26899 	    i__8[2] = 1, a__5[2] = all_1.sq;
26900 	    i__8[3] = 5, a__5[3] = "barno";
26901 	    s_cat(ch__18, a__5, i__8, &c__4, (ftnlen)14);
26902 	    do_fio(&c__1, ch__18, (ftnlen)14);
26903 	    i__2 = comgrace_1.mbrest - 1;
26904 	    do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
26905 	    do_fio(&c__1, "%", (ftnlen)1);
26906 	    e_wsfe();
26907 	}
26908     } else if (iscwr) {
26909 
26910 /*  Centered whole-bar rests */
26911 
26912 /* Writing concatenation */
26913 	i__3[0] = 1, a__1[0] = all_1.sq;
26914 	i__3[1] = 3, a__1[1] = "def";
26915 	i__3[2] = 1, a__1[2] = all_1.sq;
26916 	i__3[3] = 10, a__1[3] = "atnextbar{";
26917 	i__3[4] = 1, a__1[4] = all_1.sq;
26918 	i__3[5] = 6, a__1[5] = "znotes";
26919 	s_cat(ch__19, a__1, i__3, &c__6, (ftnlen)22);
26920 	addstr_(ch__19, &c__22, soutq, &lsout, (ftnlen)22, (ftnlen)80);
26921 	i__7 = all_1.nv;
26922 	for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) {
26923 	    lnote = 0;
26924 	    i__2 = commvl_1.nvmx[all_1.iv - 1];
26925 	    for (kv = 1; kv <= i__2; ++kv) {
26926 		commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
26927 		if (cwrest[commvl_1.ivx]) {
26928 		    if (lnote == 0) {
26929 /* Writing concatenation */
26930 			i__4[0] = 1, a__2[0] = all_1.sq;
26931 			i__4[1] = 10, a__2[1] = "centerbar{";
26932 			s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
26933 			lnote = 11;
26934 		    }
26935 		    if (! comcwrf_1.cwrferm[commvl_1.ivx - 1]) {
26936 			if (lcwr[commvl_1.ivx - 1] >= 11 && *(unsigned char *)
26937 				&cwrq[(commvl_1.ivx - 1) * 79 + 10] != 'p') {
26938 
26939 /*  Kluge to use new definitions for centered, stacked rests */
26940 
26941 			    if (s_cmp(cwrq + ((commvl_1.ivx - 1) * 79 + 1),
26942 				    "liftpause", (ftnlen)9, (ftnlen)9) == 0 ||
26943 				     s_cmp(cwrq + ((commvl_1.ivx - 1) * 79 +
26944 				    1), "liftPAuse", (ftnlen)9, (ftnlen)9) ==
26945 				    0) {
26946 				*(unsigned char *)&cwrq[(commvl_1.ivx - 1) *
26947 					79 + 9] = 'c';
26948 			    }
26949 			}
26950 /* Writing concatenation */
26951 			i__4[0] = lnote, a__2[0] = notexq;
26952 			i__4[1] = lcwr[commvl_1.ivx - 1], a__2[1] = cwrq + (
26953 				commvl_1.ivx - 1) * 79;
26954 			s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
26955 			lnote += lcwr[commvl_1.ivx - 1];
26956 		    } else {
26957 
26958 /*  Fermata on centered rest.  Will need to fix up level. */
26959 /*  12/6/07 shift it left so it's centered over rest */
26960 
26961 /*                notexq = notexq(1:lnote) */
26962 /*     *                   //sq//'fermataup7'//cwrq(ivx)(1:lcwr(ivx)) */
26963 /*                lnote = lnote+11+lcwr(ivx) */
26964 
26965 /* Writing concatenation */
26966 			i__3[0] = lnote, a__1[0] = notexq;
26967 			i__3[1] = 1, a__1[1] = all_1.sq;
26968 			i__3[2] = 13, a__1[2] = "loffset{.39}{";
26969 			i__3[3] = 1, a__1[3] = all_1.sq;
26970 			i__3[4] = 11, a__1[4] = "fermataup7}";
26971 			i__3[5] = lcwr[commvl_1.ivx - 1], a__1[5] = cwrq + (
26972 				commvl_1.ivx - 1) * 79;
26973 			s_cat(notexq, a__1, i__3, &c__6, (ftnlen)79);
26974 			lnote = lnote + 26 + lcwr[commvl_1.ivx - 1];
26975 			comcwrf_1.cwrferm[commvl_1.ivx - 1] = FALSE_;
26976 		    }
26977 		}
26978 /* L61: */
26979 	    }
26980 	    if (lnote > 0) {
26981 /* Writing concatenation */
26982 		i__4[0] = lnote, a__2[0] = notexq;
26983 		i__4[1] = 1, a__2[1] = "}";
26984 		s_cat(ch__1, a__2, i__4, &c__2, (ftnlen)80);
26985 		i__2 = lnote + 1;
26986 		addstr_(ch__1, &i__2, soutq, &lsout, lnote + 1, (ftnlen)80);
26987 	    }
26988 	    if (all_1.iv != all_1.nv) {
26989 		addstr_(all_1.sepsymq + (all_1.iv - 1), &c__1, soutq, &lsout,
26990 			(ftnlen)1, (ftnlen)80);
26991 	    }
26992 /* L60: */
26993 	}
26994 /* Writing concatenation */
26995 	i__4[0] = 1, a__2[0] = all_1.sq;
26996 	i__4[1] = 3, a__2[1] = "en}";
26997 	s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)4);
26998 	addstr_(ch__17, &c__4, soutq, &lsout, (ftnlen)4, (ftnlen)80);
26999 	if (comlast_1.islast && lsout > 0) {
27000 	    s_wsfe(&io___1074);
27001 /* Writing concatenation */
27002 	    i__4[0] = lsout, a__2[0] = soutq;
27003 	    i__4[1] = 1, a__2[1] = "%";
27004 	    s_cat(ch__10, a__2, i__4, &c__2, (ftnlen)81);
27005 	    do_fio(&c__1, ch__10, lsout + 1);
27006 	    e_wsfe();
27007 	}
27008     }
27009 
27010 /*  End of block for centered whole-bar rests and multi-bar rests */
27011 
27012 /*  If at end of block, save durations of last notes in bar, for possible use */
27013 /*  if clef changes at start of next bar */
27014 
27015     if (all_1.ibar == all_1.nbars) {
27016 	i__7 = all_1.nv;
27017 	for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) {
27018 	    i__2 = commvl_1.nvmx[all_1.iv - 1];
27019 	    for (kv = 1; kv <= i__2; ++kv) {
27020 		commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
27021 /*          prevtn(ivx) = tnote(iand(ipl(ivx,nn(ivx)),255)) */
27022 		comnsp_2.prevtn[commvl_1.ivx - 1] = all_1.tnote[
27023 			comipl2_1.ipl2[commvl_1.ivx + all_1.nn[commvl_1.ivx -
27024 			1] * 24 - 25] - 1];
27025 /* L63: */
27026 	    }
27027 	}
27028     }
27029 
27030 /*  Update time for midi.  This is only used for the event track */
27031 
27032     if (commidi_1.ismidi) {
27033 	comevent_1.miditime += all_1.lenbar * 15;
27034 
27035 /*  If pickup, write the real time signature to the event track.  Cannot use */
27036 /*    mtrnuml since it was reset to 0, have to recompute it */
27037 
27038 	if (all_1.lenb0 == all_1.lenbar) {
27039 	    i__2 = all_1.mtrdenl * all_1.lenb1 / 64;
27040 	    midievent_("m", &i__2, &all_1.mtrdenl, (ftnlen)1);
27041 	}
27042     }
27043     return 0;
27044 } /* make2bar_ */
27045 
makeabar_(void)27046 /* Subroutine */ int makeabar_(void)
27047 {
27048     /* System generated locals */
27049     integer i__1, i__2;
27050     real r__1, r__2, r__3;
27051 
27052     /* Builtin functions */
27053     integer i_nint(real *);
27054 
27055     /* Local variables */
27056     extern /* Subroutine */ int catspace_(real *, real *, integer *);
27057     static real elsperns;
27058     extern doublereal getsquez_(integer *, integer *, real *, real *, real *);
27059     static integer ib, in, kv, cnn[24];
27060     static real xit[24];
27061     static integer ilnc;
27062     static real tmin;
27063     static integer nnsk, ntot;
27064     extern doublereal f1eon_(real *);
27065     extern /* Subroutine */ int stop1_(void);
27066     static real space[80];
27067     extern doublereal fnote_(integer *, integer *, integer *, integer *);
27068     static real tminn, tnote[600];
27069     static integer istop[80];
27070     static real squez[80];
27071     static integer istart[80];
27072     extern /* Subroutine */ int printl_(char *, ftnlen);
27073     static integer ivnext;
27074     static real tstart[80], xsquez;
27075 
27076 
27077 /*  On input, have pseudo-durations in nodur(ivx,ip).  Not real durations for */
27078 /*    xtups, since only last note of xtup gets non-zero nodur, which */
27079 /*    corresponds to single note of full length of xtup. */
27080 /*  In this subroutine we make an ordered list of all notes in all voices. */
27081 /*    ilnc      = list note counter */
27082 /*    ivxo(ilnc), ipo(ilnc) = voice# and position in voice of ilnc-th note. */
27083 /*    to(ilnc)  = real start time of note in PMX-units (64=whole note) */
27084 /*    tno(ilnc) = time to next event in the bar. */
27085 /*    tnote(ilnc) = actual duration of note */
27086 /*  Then run thru list, grouping consecutive notes into \notes groups ib. */
27087 /*    space(ib) = real time unit for the \notes group */
27088 /*    squez(ib) = factor on space to get effective space.  This will be 1 if */
27089 /*                there is a note exactly spanning each interval of space, and */
27090 /*                <1 if not. */
27091 /*  Details:  let eon = elemskips per noteskip (like length).  Basic formula is */
27092 /*    eon = sqrt(space/2.) */
27093 /*  If tgovern >= space, then */
27094 /*    eon = sqrt(tgovern/2)*(space/tgovern) = space/sqrt(2*tgovern). */
27095 /*  Time needed to give this eon using basic formula is */
27096 /*    teq = space**2/tgovern */
27097 /*  Factor on space to get teq is */
27098 /*    squez(ib) = space/tgovern */
27099 /*  The eon for each ib can then be computed based on time of space*squez. */
27100 /*  Iff squez = 1, there is a note spanning every increment in the \notes group. */
27101 
27102 /*    tnminb = minimum time span in the bar for increments spanned by notes, */
27103 /*             i.e., with squez=1.  Use after parsing into line to decide if */
27104 /*             spacing needs to be "flattened" among notes groups. */
27105 
27106     linecom_1.elskb = 0.f;
27107     linecom_1.tnminb[c1omnotes_1.ibarcnt - 1] = 1e3f;
27108     i__1 = a1ll_2.nv;
27109     for (a1ll_2.iv = 1; a1ll_2.iv <= i__1; ++a1ll_2.iv) {
27110 	i__2 = c1ommvl_1.nvmx[a1ll_2.iv - 1];
27111 	for (kv = 1; kv <= i__2; ++kv) {
27112 	    c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25];
27113 	    if (a1ll_2.ibar > 1) {
27114 		a1ll_2.nn[c1ommvl_1.ivx - 1] = a1ll_2.nib[c1ommvl_1.ivx +
27115 			a1ll_2.ibar * 24 - 25] - a1ll_2.nib[c1ommvl_1.ivx + (
27116 			a1ll_2.ibar - 1) * 24 - 25];
27117 	    } else {
27118 		a1ll_2.nn[c1ommvl_1.ivx - 1] = a1ll_2.nib[c1ommvl_1.ivx +
27119 			a1ll_2.ibar * 24 - 25];
27120 	    }
27121 /* L1: */
27122 	}
27123     }
27124 
27125 /* initialize list note counter, time(iv), curr. note(iv) */
27126 
27127     ilnc = 1;
27128     i__2 = a1ll_2.nv;
27129     for (a1ll_2.iv = 1; a1ll_2.iv <= i__2; ++a1ll_2.iv) {
27130 	i__1 = c1ommvl_1.nvmx[a1ll_2.iv - 1];
27131 	for (kv = 1; kv <= i__1; ++kv) {
27132 	    c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25];
27133 	    cnn[c1ommvl_1.ivx - 1] = 1;
27134 	    a1ll_2.ivxo[ilnc - 1] = c1ommvl_1.ivx;
27135 	    a1ll_2.ipo[ilnc - 1] = 1;
27136 	    a1ll_2.to[ilnc - 1] = 0.f;
27137 	    tnote[ilnc - 1] = fnote_(a1ll_2.nodur, &c1ommvl_1.ivx, &c__1,
27138 		    c1ommvl_1.nacc);
27139 	    xit[c1ommvl_1.ivx - 1] = tnote[ilnc - 1];
27140 	    if ((r__1 = xit[c1ommvl_1.ivx - 1] - a1ll_2.lenbar, dabs(r__1)) <
27141 		    comtol_1.tol) {
27142 		xit[c1ommvl_1.ivx - 1] = 1e3f;
27143 	    }
27144 	    ++ilnc;
27145 /* L4: */
27146 	}
27147     }
27148 
27149 /*  Build the list */
27150 
27151 L5:
27152 
27153 /*  Determine which voice comes next from end of notes done so far. */
27154 /*  tmin is the earliest ending time of notes done so far */
27155 
27156     tmin = 1e3f;
27157     i__1 = a1ll_2.nv;
27158     for (a1ll_2.iv = 1; a1ll_2.iv <= i__1; ++a1ll_2.iv) {
27159 	i__2 = c1ommvl_1.nvmx[a1ll_2.iv - 1];
27160 	for (kv = 1; kv <= i__2; ++kv) {
27161 	    c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25];
27162 /* Computing MIN */
27163 	    r__1 = tmin, r__2 = xit[c1ommvl_1.ivx - 1];
27164 	    tminn = dmin(r__1,r__2);
27165 	    if (tminn < tmin) {
27166 		tmin = tminn;
27167 		ivnext = c1ommvl_1.ivx;
27168 	    }
27169 /* L6: */
27170 	}
27171     }
27172     if (tmin > 999.f) {
27173 	goto L7;
27174     }
27175     a1ll_2.ivxo[ilnc - 1] = ivnext;
27176     ++cnn[ivnext - 1];
27177     a1ll_2.ipo[ilnc - 1] = cnn[ivnext - 1];
27178     a1ll_2.to[ilnc - 1] = tmin;
27179 
27180 /*  Check if this voice is done */
27181 
27182     tnote[ilnc - 1] = fnote_(a1ll_2.nodur, &ivnext, &cnn[ivnext - 1],
27183 	    c1ommvl_1.nacc);
27184     if (cnn[ivnext - 1] == a1ll_2.nn[ivnext - 1]) {
27185 	xit[ivnext - 1] = 1e3f;
27186     } else {
27187 	xit[ivnext - 1] += tnote[ilnc - 1];
27188     }
27189     ++ilnc;
27190     goto L5;
27191 L7:
27192     ntot = ilnc - 1;
27193     if (ntot > 600) {
27194 	printl_(" ", (ftnlen)1);
27195 	printl_("Cannot have more than 600 notes per bar, stopping", (ftnlen)
27196 		49);
27197 	stop1_();
27198     }
27199     i__2 = ntot - 1;
27200     for (in = 1; in <= i__2; ++in) {
27201 	a1ll_2.tno[in - 1] = a1ll_2.to[in] - a1ll_2.to[in - 1];
27202 /* L8: */
27203     }
27204     a1ll_2.tno[ntot - 1] = fnote_(a1ll_2.nodur, &a1ll_2.ivxo[ntot - 1], &
27205 	    a1ll_2.ipo[ntot - 1], c1ommvl_1.nacc);
27206     tnote[ntot - 1] = a1ll_2.tno[ntot - 1];
27207 
27208 /*  Debug writes */
27209 
27210 /*      write(*,'()') */
27211 /*      write(*,'(16i5)')(ivxo(in),in=1,ntot) */
27212 /*      write(*,'(16i5)')(ipo(in),in=1,ntot) */
27213 /*      write(*,'(16f5.1)')(to(in),in=1,ntot) */
27214 /*      write(*,'(16f5.1)')(tno(in),in=1,ntot) */
27215 /*      write(*,'(16i5)')(nodur(ivxo(in),ipo(in)),in=1,ntot) */
27216 /*      write(*,'(16f5.1)')(tnote(in),in=1,ntot) */
27217 
27218 /*  Done w/ list.  Initialize loop for building note blocks: */
27219 
27220     ib = 1;
27221     istart[0] = 1;
27222     space[0] = 0.f;
27223     in = 1;
27224 
27225 /*  Start the loop */
27226 
27227 L9:
27228     if (in == ntot) {
27229 	if (space[ib - 1] < comtol_1.tol) {
27230 	    space[ib - 1] = a1ll_2.tno[in - 1];
27231 
27232 /*  Last gap in bar is spanned by a note, so cannot need a squeeze. */
27233 
27234 	    squez[ib - 1] = 1.f;
27235 	}
27236 	istop[ib - 1] = ntot;
27237 
27238 /* From here flow out of this if block and into block-setup */
27239 
27240     } else if (space[ib - 1] < comtol_1.tol) {
27241 
27242 /* space hasn't been set yet, so tentatively set: */
27243 
27244 	space[ib - 1] = a1ll_2.tno[in - 1];
27245 	if (space[ib - 1] < comtol_1.tol) {
27246 	    ++in;
27247 	} else {
27248 
27249 /*  Tentative space tno(in) is non-zero. Set squez, which will be kept (since */
27250 /*    it is a unique property of the particular increment starting here) : */
27251 
27252 	    squez[ib - 1] = getsquez_(&in, &ntot, &space[ib - 1], tnote,
27253 		    a1ll_2.to);
27254 	    istop[ib - 1] = in;
27255 	}
27256 	goto L9;
27257     } else if (a1ll_2.tno[in] < comtol_1.tol) {
27258 
27259 /* This is not the last note in the space, so */
27260 
27261 	++in;
27262 	goto L9;
27263     } else if ((r__1 = a1ll_2.tno[in] - space[ib - 1], dabs(r__1)) <
27264 	    comtol_1.tol) {
27265 
27266 /*  Next increment has same space.  Does it have same squez? */
27267 
27268 	i__2 = in + 1;
27269 	xsquez = getsquez_(&i__2, &ntot, &space[ib - 1], tnote, a1ll_2.to);
27270 
27271 /*  If it does have the same squez, loop, otherwise flow out */
27272 
27273 	if ((r__1 = xsquez - squez[ib - 1], dabs(r__1)) < comtol_1.tol) {
27274 
27275 /* Keep spacing the same, update tentative stop point */
27276 
27277 	    ++in;
27278 	    istop[ib - 1] = in;
27279 	    goto L9;
27280 	}
27281     }
27282 
27283 /* At this point istart, istop, space, and squez are good, so close out block */
27284 
27285     tstart[ib - 1] = a1ll_2.to[istart[ib - 1] - 1];
27286 
27287 /*  Compute elemskips assuming no flattening to increase min space.  The formula */
27288 /*  is only correct if f1eon(t) = sqrt(t/2); more generally (after possible */
27289 /*  flattening in pmxb), elsperns = squez*feon(space/squez) */
27290 
27291     r__1 = space[ib - 1] * squez[ib - 1];
27292     elsperns = f1eon_(&r__1);
27293     if (istop[ib - 1] == ntot) {
27294 	r__1 = (a1ll_2.lenbar - tstart[ib - 1]) / space[ib - 1];
27295 	nnsk = i_nint(&r__1);
27296     } else {
27297 	r__1 = (a1ll_2.to[istop[ib - 1]] - tstart[ib - 1]) / space[ib - 1];
27298 	nnsk = i_nint(&r__1);
27299     }
27300     linecom_1.elskb += elsperns * nnsk;
27301     if (c1omnotes_1.nptr[c1omnotes_1.ibarcnt] > c1omnotes_1.nptr[
27302 	    c1omnotes_1.ibarcnt - 1]) {
27303 	catspace_(&space[ib - 1], &squez[ib - 1], &nnsk);
27304     } else {
27305 
27306 /*  This is the first entry for this bar */
27307 
27308 	c1omnotes_1.nnpd[c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1] - 1] =
27309 		nnsk;
27310 	c1omnotes_1.durb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1] - 1] =
27311 		space[ib - 1];
27312 	c1omnotes_1.sqzb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1] - 1] =
27313 		squez[ib - 1];
27314 	++c1omnotes_1.nptr[c1omnotes_1.ibarcnt];
27315     }
27316 
27317 /*  Update minimum space spanned by a note */
27318 
27319     if ((r__1 = squez[ib - 1] - 1, dabs(r__1)) < comtol_1.tol) {
27320 /* Computing MIN */
27321 	r__2 = linecom_1.tnminb[c1omnotes_1.ibarcnt - 1], r__3 = space[ib - 1]
27322 		;
27323 	linecom_1.tnminb[c1omnotes_1.ibarcnt - 1] = dmin(r__2,r__3);
27324     }
27325     if (istop[ib - 1] == ntot) {
27326 	goto L15;
27327     }
27328 
27329 /*  End of spatial accounting for now */
27330 
27331     ++ib;
27332     istart[ib - 1] = istop[ib - 2] + 1;
27333     in = istart[ib - 1];
27334 
27335 /* Set tentative block space for new block */
27336 
27337     space[ib - 1] = a1ll_2.tno[in - 1];
27338     if (space[ib - 1] > comtol_1.tol) {
27339 	squez[ib - 1] = getsquez_(&in, &ntot, &space[ib - 1], tnote,
27340 		a1ll_2.to);
27341     }
27342     istop[ib - 1] = in;
27343     goto L9;
27344 L15:
27345 /*     nb = ib */
27346 
27347 /*  Debug writes */
27348 
27349 /*      write(*,'(16i5)')(istart(ib),ib=1,nb) */
27350 /*      write(*,'(16i5)')(istop(ib),ib=1,nb) */
27351 /*      write(*,'(16f5.1)')(space(ib),ib=1,nb) */
27352 /*      write(*,'(16f5.1)')(squez(ib),ib=1,nb) */
27353 
27354     return 0;
27355 } /* makeabar_ */
27356 
midievent_(char * typeq,integer * in1,integer * in2,ftnlen typeq_len)27357 /* Subroutine */ int midievent_(char *typeq, integer *in1, integer *in2,
27358 	ftnlen typeq_len)
27359 {
27360     /* System generated locals */
27361     integer i__1;
27362     real r__1;
27363 
27364     /* Builtin functions */
27365     integer lbit_shift(integer, integer), i_nint(real *), s_wsle(cilist *),
27366 	    do_lio(integer *, integer *, char *, ftnlen), e_wsle(void);
27367 
27368     /* Local variables */
27369     static integer i__;
27370     extern integer isetvarlen_(integer *, integer *), log2_(integer *);
27371     static integer idur;
27372     extern /* Subroutine */ int stop1_(void);
27373     static integer nbytes, misperq;
27374 
27375     /* Fortran I/O blocks */
27376     static cilist io___1098 = { 0, 6, 0, 0, 0 };
27377 
27378 
27379 
27380 /*  We now store "conductor" events in mmidi(numchan,.), and count bytes */
27381 /*    with imidi(numchan) */
27382 
27383     i__1 = comevent_1.miditime - comevent_1.lasttime;
27384     idur = isetvarlen_(&i__1, &nbytes);
27385     commidi_1.imidi[commidi_1.numchan] = commidi_1.imidi[commidi_1.numchan] +
27386 	    nbytes + 1;
27387     i__1 = nbytes;
27388     for (i__ = 1; i__ <= i__1; ++i__) {
27389 	commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
27390 		commidi_1.numchan] - i__) * 25 - 25] = (shortint) (idur % 256)
27391 		;
27392 	idur = lbit_shift(idur, (ftnlen)-8);
27393 /* L1: */
27394     }
27395     commidi_1.mmidi[commidi_1.numchan + commidi_1.imidi[commidi_1.numchan] *
27396 	    25 - 25] = 255;
27397     if (*(unsigned char *)typeq == 't') {
27398 
27399 /*  Tempo event.  in1 = quarters per minute (integer) */
27400 
27401 	commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
27402 		commidi_1.numchan] + 1) * 25 - 25] = 81;
27403 	commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
27404 		commidi_1.numchan] + 2) * 25 - 25] = 3;
27405 	r__1 = 6e7f / *in1;
27406 	misperq = i_nint(&r__1);
27407 	for (i__ = 1; i__ <= 3; ++i__) {
27408 	    commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
27409 		    commidi_1.numchan] + 6 - i__) * 25 - 25] = (shortint) (
27410 		    misperq % 256);
27411 	    misperq = lbit_shift(misperq, (ftnlen)-8);
27412 /* L2: */
27413 	}
27414 	commidi_1.imidi[commidi_1.numchan] += 5;
27415     } else if (*(unsigned char *)typeq == 'm') {
27416 
27417 /*  Meter event.  in1=numerator, in2=denom (power of 2) */
27418 
27419 	commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
27420 		commidi_1.numchan] + 1) * 25 - 25] = 88;
27421 	commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
27422 		commidi_1.numchan] + 2) * 25 - 25] = 4;
27423 	commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
27424 		commidi_1.numchan] + 3) * 25 - 25] = (shortint) (*in1);
27425 	if (*in2 > 0) {
27426 	    commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
27427 		    commidi_1.numchan] + 4) * 25 - 25] = (shortint) log2_(in2)
27428 		    ;
27429 	} else {
27430 	    commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
27431 		    commidi_1.numchan] + 4) * 25 - 25] = 0;
27432 	}
27433 	commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
27434 		commidi_1.numchan] + 5) * 25 - 25] = 24;
27435 	commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
27436 		commidi_1.numchan] + 6) * 25 - 25] = 8;
27437 	commidi_1.imidi[commidi_1.numchan] += 6;
27438     } else if (*(unsigned char *)typeq == 'k') {
27439 
27440 /*  Keychange event.  in1 = isig */
27441 
27442 	commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
27443 		commidi_1.numchan] + 1) * 25 - 25] = 89;
27444 	commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
27445 		commidi_1.numchan] + 2) * 25 - 25] = 2;
27446 	commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
27447 		commidi_1.numchan] + 3) * 25 - 25] = (shortint) ((*in1 + 256)
27448 		% 256);
27449 	commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
27450 		commidi_1.numchan] + 4) * 25 - 25] = 0;
27451 	commidi_1.imidi[commidi_1.numchan] += 4;
27452     } else {
27453 	s_wsle(&io___1098);
27454 	do_lio(&c__9, &c__1, "Program flameout in midievent", (ftnlen)29);
27455 	e_wsle();
27456 	stop1_();
27457     }
27458     comevent_1.lasttime = comevent_1.miditime;
27459     return 0;
27460 } /* midievent_ */
27461 
moveln_(integer * iuin,integer * iuout,logical * done)27462 /* Subroutine */ int moveln_(integer *iuin, integer *iuout, logical *done)
27463 {
27464     /* System generated locals */
27465     integer i__1;
27466 
27467     /* Builtin functions */
27468     integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void),
27469 	     s_wsfe(cilist *), e_wsfe(void);
27470 
27471     /* Local variables */
27472     extern integer llen_(char *, integer *, ftnlen);
27473     static char outq[129];
27474     static integer lenout;
27475 
27476     /* Fortran I/O blocks */
27477     static cilist io___1099 = { 0, 0, 1, "(a)", 0 };
27478     static cilist io___1102 = { 0, 0, 0, "(a)", 0 };
27479 
27480 
27481     *done = FALSE_;
27482     io___1099.ciunit = *iuin;
27483     i__1 = s_rsfe(&io___1099);
27484     if (i__1 != 0) {
27485 	goto L1;
27486     }
27487     i__1 = do_fio(&c__1, outq, (ftnlen)129);
27488     if (i__1 != 0) {
27489 	goto L1;
27490     }
27491     i__1 = e_rsfe();
27492     if (i__1 != 0) {
27493 	goto L1;
27494     }
27495     lenout = llen_(outq, &c__129, (ftnlen)129);
27496     io___1102.ciunit = *iuout;
27497     s_wsfe(&io___1102);
27498     do_fio(&c__1, outq, lenout);
27499     e_wsfe();
27500     return 0;
27501 L1:
27502     *done = TRUE_;
27503     return 0;
27504 } /* moveln_ */
27505 
mrec1_(char * lineq,integer * iccount,integer * ndxm,ftnlen lineq_len)27506 /* Subroutine */ int mrec1_(char *lineq, integer *iccount, integer *ndxm,
27507 	ftnlen lineq_len)
27508 {
27509     /* System generated locals */
27510     integer i__1, i__2;
27511 
27512     /* Builtin functions */
27513     integer i_indx(char *, char *, ftnlen, ftnlen);
27514 
27515     /* Local variables */
27516     extern integer ntindex_(char *, char *, integer *, ftnlen, ftnlen);
27517 
27518 
27519 /*  This is called when (a) macro recording is just starting and */
27520 /*  (b) at the start of a new line, if recording is on */
27521 
27522     if (! commac_1.mrecord) {
27523 
27524 /*  Starting the macro */
27525 
27526 	c1ommac_1.ip1mac[commac_1.macnum - 1] = inbuff_1.ipbuf -
27527 		inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount;
27528 	c1ommac_1.il1mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1;
27529 	c1ommac_1.ic1mac[commac_1.macnum - 1] = *iccount;
27530 	commac_1.mrecord = TRUE_;
27531     }
27532     if (*iccount < 128) {
27533 	i__1 = *iccount;
27534 	*ndxm = i_indx(lineq + i__1, "M", 128 - i__1, (ftnlen)1);
27535 	if (*ndxm > 0) {
27536 	    i__1 = *iccount;
27537 	    i__2 = 128 - *iccount;
27538 	    *ndxm = ntindex_(lineq + i__1, "M", &i__2, 128 - i__1, (ftnlen)1);
27539 	}
27540 	if (*ndxm > 0) {
27541 
27542 /*  This line ends the macro. */
27543 
27544 	    c1ommac_1.ip2mac[commac_1.macnum - 1] = inbuff_1.ipbuf -
27545 		    inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount + *ndxm;
27546 	    c1ommac_1.il2mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1;
27547 	    commac_1.mrecord = FALSE_;
27548 	}
27549     }
27550     return 0;
27551 } /* mrec1_ */
27552 
ncmid_(integer * iv,integer * ip)27553 integer ncmid_(integer *iv, integer *ip)
27554 {
27555     /* System generated locals */
27556     integer ret_val;
27557 
27558     /* Builtin functions */
27559     integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
27560 	    e_wsle(void);
27561     /* Subroutine */ int s_stop(char *, ftnlen);
27562 
27563     /* Local variables */
27564     static integer icc;
27565     static real xtime;
27566 
27567     /* Fortran I/O blocks */
27568     static cilist io___1105 = { 0, 6, 0, 0, 0 };
27569 
27570 
27571     if (comcc_1.ncc[*iv - 1] == 1) {
27572 	ret_val = comcc_1.ncmidcc[*iv - 1];
27573     } else {
27574 	xtime = all_2.to[comipl2_1.ipl2[commvl_1.ivx + *ip * 24 - 25] - 1];
27575 	for (icc = comcc_1.ncc[*iv - 1]; icc >= 1; --icc) {
27576 	    if (xtime > comcc_1.tcc[*iv + icc * 24 - 25] - comtol_1.tol) {
27577 		ret_val = comcc_1.ncmidcc[*iv + icc * 24 - 25];
27578 		return ret_val;
27579 	    }
27580 /* L1: */
27581 	}
27582 	s_wsle(&io___1105);
27583 	do_lio(&c__9, &c__1, "Problem in ncmid()", (ftnlen)18);
27584 	e_wsle();
27585 	s_stop("", (ftnlen)0);
27586     }
27587     return ret_val;
27588 } /* ncmid_ */
27589 
ncmidf_(char * clefq,ftnlen clefq_len)27590 integer ncmidf_(char *clefq, ftnlen clefq_len)
27591 {
27592     /* System generated locals */
27593     integer ret_val;
27594 
27595     /* Builtin functions */
27596     integer i_indx(char *, char *, ftnlen, ftnlen);
27597 
27598 
27599 /*  Return middle line of a clef */
27600 
27601 /*      if (clefq.eq.'t' .or. clefq.eq.'0') then */
27602 /*        ncmidf = 35 */
27603 /*      else if (clefq.eq.'s' .or. clefq.eq.'1') then */
27604 /*        ncmidf = 33 */
27605 /*      else if (clefq.eq.'m' .or. clefq.eq.'2') then */
27606 /*        ncmidf = 31 */
27607 /*      else if (clefq.eq.'a' .or. clefq.eq.'3') then */
27608 /*        ncmidf = 29 */
27609 /*      else if (clefq.eq.'n' .or. clefq.eq.'4') then */
27610 /*        ncmidf = 27 */
27611 /*      else if (clefq.eq.'r' .or. clefq.eq.'5') then */
27612 /*        ncmidf = 25 */
27613 /*      else if (clefq.eq.'f' .or. clefq.eq.'7') then */
27614 /*        ncmidf = 37 */
27615 /*      else */
27616 /*        ncmidf = 23 */
27617 /*      end if */
27618     ret_val = (i_indx(" b6r5n4a3m2s1t0f7", clefq, (ftnlen)17, (ftnlen)1) / 2
27619 	    << 1) + 21;
27620     return ret_val;
27621 } /* ncmidf_ */
27622 
newvoice_(integer * jv,char * clefq,logical * change,ftnlen clefq_len)27623 /* Subroutine */ int newvoice_(integer *jv, char *clefq, logical *change,
27624 	ftnlen clefq_len)
27625 {
27626     static integer j;
27627     extern integer ncmidf_(char *, ftnlen);
27628 
27629     commvl_1.nvmx[*jv - 1] = 1;
27630     commvl_1.ivmx[*jv - 1] = *jv;
27631     all_1.itsofar[*jv - 1] = 0;
27632     all_1.nnl[*jv - 1] = 0;
27633     comfb_1.nfb[*jv - 1] = 0;
27634     if (all_1.firstgulp || *change) {
27635 	comcc_1.ncmidcc[*jv - 1] = ncmidf_(clefq, (ftnlen)1);
27636     } else {
27637 	comcc_1.ncmidcc[*jv - 1] = comcc_1.ncmidcc[*jv + comcc_1.ncc[*jv - 1]
27638 		* 24 - 25];
27639     }
27640     comcc_1.tcc[*jv - 1] = 0.f;
27641     comcc_1.ncc[*jv - 1] = 1;
27642     comudsp_1.nudoff[*jv - 1] = 0;
27643     comcc_1.ndotmv[*jv - 1] = 0;
27644     for (j = 1; j <= 200; ++j) {
27645 	all_1.irest[*jv + j * 24 - 25] = 0;
27646 	all_1.islur[*jv + j * 24 - 25] = 0;
27647 	all_1.ipl[*jv + j * 24 - 25] = 0;
27648 	all_1.nacc[*jv + j * 24 - 25] = 0;
27649 	all_1.iornq[*jv + j * 24 - 1] = 0;
27650 	all_1.mult[*jv + j * 24 - 25] = 0;
27651 	if (*jv <= 2) {
27652 	    all_1.isfig[*jv + (j << 1) - 3] = FALSE_;
27653 	}
27654 /* L5: */
27655     }
27656     return 0;
27657 } /* newvoice_ */
27658 
notefq_(char * noteq,integer * lnote,integer * nolev,integer * ncmid,ftnlen noteq_len)27659 /* Subroutine */ int notefq_(char *noteq, integer *lnote, integer *nolev,
27660 	integer *ncmid, ftnlen noteq_len)
27661 {
27662     /* System generated locals */
27663     integer i__1;
27664     char ch__1[1], ch__2[1];
27665     icilist ici__1;
27666 
27667     /* Builtin functions */
27668     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
27669     integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
27670 	    ;
27671 
27672     /* Local variables */
27673     static integer nupfroma, i__;
27674     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
27675     static integer iname, ioctup;
27676     static char noteqt[1];
27677     extern /* Character */ VOID upcaseq_(char *, ftnlen, char *, ftnlen);
27678 
27679 
27680 /*  Returns name of note level with octave transpositions, updates noctup. */
27681 
27682     nupfroma = (*nolev + 1) % 7;
27683     iname = nupfroma + 97;
27684     ioctup = (*nolev + 1) / 7 - 4;
27685     chax_(ch__1, (ftnlen)1, &iname);
27686     *(unsigned char *)noteqt = *(unsigned char *)&ch__1[0];
27687     if (*ncmid == 23) {
27688 	upcaseq_(ch__1, (ftnlen)1, noteqt, (ftnlen)1);
27689 	*(unsigned char *)noteqt = *(unsigned char *)&ch__1[0];
27690     }
27691     if (ioctup == comoct_1.noctup) {
27692 	s_copy(noteq, noteqt, (ftnlen)8, (ftnlen)1);
27693 	*lnote = 1;
27694 
27695 /*  Must ALWAYS check if lnote=1 for use with functions requiring a blank */
27696 
27697     } else if (ioctup > comoct_1.noctup) {
27698 
27699 /*  Raise octave.  Encase in {} */
27700 
27701 	ici__1.icierr = 0;
27702 	ici__1.icirnum = 1;
27703 	ici__1.icirlen = 8;
27704 	ici__1.iciunit = noteq;
27705 	ici__1.icifmt = "(8a1)";
27706 	s_wsfi(&ici__1);
27707 	do_fio(&c__1, "{", (ftnlen)1);
27708 	i__1 = ioctup - 1;
27709 	for (i__ = comoct_1.noctup; i__ <= i__1; ++i__) {
27710 	    chax_(ch__2, (ftnlen)1, &c__39);
27711 	    *(unsigned char *)&ch__1[0] = *(unsigned char *)&ch__2[0];
27712 	    do_fio(&c__1, ch__1, (ftnlen)1);
27713 	}
27714 	do_fio(&c__1, noteqt, (ftnlen)1);
27715 	do_fio(&c__1, "}", (ftnlen)1);
27716 	e_wsfi();
27717 	*lnote = ioctup + 3 - comoct_1.noctup;
27718 	comoct_1.noctup = ioctup;
27719     } else {
27720 
27721 /*  Lower octave */
27722 
27723 	ici__1.icierr = 0;
27724 	ici__1.icirnum = 1;
27725 	ici__1.icirlen = 8;
27726 	ici__1.iciunit = noteq;
27727 	ici__1.icifmt = "(8a1)";
27728 	s_wsfi(&ici__1);
27729 	do_fio(&c__1, "{", (ftnlen)1);
27730 	i__1 = comoct_1.noctup - 1;
27731 	for (i__ = ioctup; i__ <= i__1; ++i__) {
27732 	    chax_(ch__2, (ftnlen)1, &c__96);
27733 	    *(unsigned char *)&ch__1[0] = *(unsigned char *)&ch__2[0];
27734 	    do_fio(&c__1, ch__1, (ftnlen)1);
27735 	}
27736 	do_fio(&c__1, noteqt, (ftnlen)1);
27737 	do_fio(&c__1, "}", (ftnlen)1);
27738 	e_wsfi();
27739 	*lnote = comoct_1.noctup + 3 - ioctup;
27740 	comoct_1.noctup = ioctup;
27741     }
27742     return 0;
27743 } /* notefq_ */
27744 
notex_(char * notexq,integer * lnote,ftnlen notexq_len)27745 /* Subroutine */ int notex_(char *notexq, integer *lnote, ftnlen notexq_len)
27746 {
27747     /* System generated locals */
27748     address a__1[4], a__2[3], a__3[5], a__4[2], a__5[8];
27749     integer i__1, i__2, i__3[4], i__4[3], i__5[5], i__6[2], i__7[8];
27750     real r__1;
27751     char ch__1[1];
27752 
27753     /* Builtin functions */
27754     integer i_nint(real *);
27755     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen),
27756 	     s_copy(char *, char *, ftnlen, ftnlen);
27757     integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
27758 	    , pow_ii(integer *, integer *), i_sign(integer *, integer *);
27759 
27760     /* Local variables */
27761     extern /* Subroutine */ int addblank_(char *, integer *, ftnlen);
27762     static real raisedot;
27763     static integer ip;
27764     static char udq[1];
27765     extern integer log2_(integer *);
27766     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
27767     static logical even;
27768     static integer nole, ldot, nodu;
27769     static char dotq[4];
27770     extern /* Character */ VOID udqq_(char *, ftnlen, integer *, integer *,
27771 	    integer *, integer *, integer *, integer *);
27772     static real zmin;
27773     static char numq[2];
27774     extern integer ncmid_(integer *, integer *);
27775     static real fnole;
27776     static char noteq[8];
27777     static integer lrest;
27778     static char restq[40];
27779     extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer
27780 	    *, ftnlen);
27781     static integer lnoten;
27782 
27783     /* Fortran I/O blocks */
27784     static icilist io___1124 = { 0, noteq, 0, "(i2)", 2, 1 };
27785     static icilist io___1128 = { 0, numq, 0, "(i2)", 2, 1 };
27786     static icilist io___1129 = { 0, noteq+1, 0, "(i2)", 2, 1 };
27787     static icilist io___1130 = { 0, noteq+1, 0, "(i3)", 3, 1 };
27788 
27789 
27790 
27791 /*  Returns non-beamed full note name */
27792 
27793     ip = all_1.ipo[all_1.jn - 1];
27794     nole = all_1.nolev[commvl_1.ivx + ip * 24 - 25];
27795 
27796 /*  Check for special situations with 2nds (see precrd) */
27797 
27798     if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],30)) {
27799 	--nole;
27800     } else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],31)) {
27801 	++nole;
27802     }
27803     nodu = all_1.nodur[commvl_1.ivx + ip * 24 - 25];
27804     if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
27805 	i__1 = ncmid_(&all_1.iv, &ip);
27806 	udqq_(ch__1, (ftnlen)1, &nole, &i__1, &all_1.islur[commvl_1.ivx + ip *
27807 		 24 - 25], &commvl_1.nvmx[all_1.iv - 1], &commvl_1.ivx, &
27808 		all_1.nv);
27809 	*(unsigned char *)udq = *(unsigned char *)&ch__1[0];
27810     }
27811 
27812 /*  Check figure level */
27813 
27814 /*      if (figbass .and. isfig(ivx,ip) */
27815 /*     *                    .and. .not.btest(irest(ivx,ip),0)) then */
27816     if (all_1.figbass && ! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],
27817 	    0) && (commvl_1.ivx == 1 && all_1.isfig[(ip << 1) - 2] ||
27818 	    commvl_1.ivx == comfig_1.ivxfig2 && all_1.isfig[(ip << 1) - 1])) {
27819 	if (*(unsigned char *)udq == 'u' || nodu >= 64) {
27820 
27821 /*  Upper or no stem, fnole (in noleunits) set by notehead */
27822 
27823 	    fnole = (real) nole;
27824 	} else {
27825 
27826 /*  Lower stem, fnole set by bottom of stem */
27827 
27828 	    fnole = nole - all_1.stemlen;
27829 	}
27830 	zmin = fnole - ncmid_(&commvl_1.ivx, &ip) + 4;
27831 	if (commvl_1.ivx == 1) {
27832 /* Computing MAX */
27833 	    r__1 = 4 - zmin;
27834 	    i__1 = all_1.ifigdr[(all_1.iline << 1) - 2], i__2 = i_nint(&r__1);
27835 	    all_1.ifigdr[(all_1.iline << 1) - 2] = max(i__1,i__2);
27836 	} else {
27837 /* Computing MAX */
27838 	    r__1 = 4 - zmin;
27839 	    i__1 = all_1.ifigdr[(all_1.iline << 1) - 1], i__2 = i_nint(&r__1);
27840 	    all_1.ifigdr[(all_1.iline << 1) - 1] = max(i__1,i__2);
27841 	}
27842     }
27843     if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
27844 	i__1 = ncmid_(&all_1.iv, &ip);
27845 	notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
27846 	if (lnoten == 1) {
27847 	    addblank_(noteq, &lnoten, (ftnlen)8);
27848 	}
27849 	if (nodu == 1) {
27850 /* Writing concatenation */
27851 	    i__3[0] = 1, a__1[0] = all_1.sq;
27852 	    i__3[1] = 4, a__1[1] = "cccc";
27853 	    i__3[2] = 1, a__1[2] = udq;
27854 	    i__3[3] = lnoten, a__1[3] = noteq;
27855 	    s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
27856 	    *lnote = lnoten + 6;
27857 	} else if (nodu == 2) {
27858 /* Writing concatenation */
27859 	    i__3[0] = 1, a__1[0] = all_1.sq;
27860 	    i__3[1] = 3, a__1[1] = "ccc";
27861 	    i__3[2] = 1, a__1[2] = udq;
27862 	    i__3[3] = lnoten, a__1[3] = noteq;
27863 	    s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
27864 	    *lnote = lnoten + 5;
27865 	} else if (nodu == 4) {
27866 /* Writing concatenation */
27867 	    i__3[0] = 1, a__1[0] = all_1.sq;
27868 	    i__3[1] = 2, a__1[1] = "cc";
27869 	    i__3[2] = 1, a__1[2] = udq;
27870 	    i__3[3] = lnoten, a__1[3] = noteq;
27871 	    s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
27872 	    *lnote = lnoten + 4;
27873 	} else if (nodu == 8) {
27874 /* Writing concatenation */
27875 	    i__3[0] = 1, a__1[0] = all_1.sq;
27876 	    i__3[1] = 1, a__1[1] = "c";
27877 	    i__3[2] = 1, a__1[2] = udq;
27878 	    i__3[3] = lnoten, a__1[3] = noteq;
27879 	    s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
27880 	    *lnote = lnoten + 3;
27881 	} else if (nodu == 16) {
27882 /* Writing concatenation */
27883 	    i__3[0] = 1, a__1[0] = all_1.sq;
27884 	    i__3[1] = 1, a__1[1] = "q";
27885 	    i__3[2] = 1, a__1[2] = udq;
27886 	    i__3[3] = lnoten, a__1[3] = noteq;
27887 	    s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
27888 	    *lnote = lnoten + 3;
27889 	} else if (nodu == 32) {
27890 /* Writing concatenation */
27891 	    i__3[0] = 1, a__1[0] = all_1.sq;
27892 	    i__3[1] = 1, a__1[1] = "h";
27893 	    i__3[2] = 1, a__1[2] = udq;
27894 	    i__3[3] = lnoten, a__1[3] = noteq;
27895 	    s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
27896 	    *lnote = lnoten + 3;
27897 	} else if (nodu == 64) {
27898 /* Writing concatenation */
27899 	    i__4[0] = 1, a__2[0] = all_1.sq;
27900 	    i__4[1] = 2, a__2[1] = "wh";
27901 	    i__4[2] = lnoten, a__2[2] = noteq;
27902 	    s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79);
27903 	    *lnote = lnoten + 3;
27904 	} else if (nodu == 128) {
27905 /*          notexq =sq//'zbreve'//noteq(1:lnoten)//sq//'sk' */
27906 /*          lnote = lnoten+10 */
27907 /* Writing concatenation */
27908 	    i__4[0] = 1, a__2[0] = all_1.sq;
27909 	    i__4[1] = 5, a__2[1] = "breve";
27910 	    i__4[2] = lnoten, a__2[2] = noteq;
27911 	    s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79);
27912 	    *lnote = lnoten + 6;
27913 	} else {
27914 	    s_copy(dotq, "p", (ftnlen)4, (ftnlen)1);
27915 	    ldot = 1;
27916 	    if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13)) {
27917 
27918 /*  Dotted note with ')' ornament */
27919 
27920 		s_copy(dotq, "m", (ftnlen)4, (ftnlen)1);
27921 	    } else if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],3)) {
27922 
27923 /*  Double dot */
27924 
27925 		s_copy(dotq, "pp", (ftnlen)4, (ftnlen)2);
27926 		ldot = 2;
27927 	    }
27928 	    if (nodu >= 192) {
27929 /* Writing concatenation */
27930 		i__3[0] = 1, a__1[0] = all_1.sq;
27931 		i__3[1] = 5, a__1[1] = "breve";
27932 		i__3[2] = ldot, a__1[2] = dotq;
27933 		i__3[3] = lnoten, a__1[3] = noteq;
27934 		s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
27935 		*lnote = lnoten + 6 + ldot;
27936 	    } else if (nodu >= 96) {
27937 /* Writing concatenation */
27938 		i__3[0] = 1, a__1[0] = all_1.sq;
27939 		i__3[1] = 2, a__1[1] = "wh";
27940 		i__3[2] = ldot, a__1[2] = dotq;
27941 		i__3[3] = lnoten, a__1[3] = noteq;
27942 		s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
27943 		*lnote = lnoten + 3 + ldot;
27944 	    } else if (nodu >= 48) {
27945 /* Writing concatenation */
27946 		i__5[0] = 1, a__3[0] = all_1.sq;
27947 		i__5[1] = 1, a__3[1] = "h";
27948 		i__5[2] = 1, a__3[2] = udq;
27949 		i__5[3] = ldot, a__3[3] = dotq;
27950 		i__5[4] = lnoten, a__3[4] = noteq;
27951 		s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
27952 		*lnote = lnoten + 3 + ldot;
27953 	    } else if (nodu >= 24) {
27954 /* Writing concatenation */
27955 		i__5[0] = 1, a__3[0] = all_1.sq;
27956 		i__5[1] = 1, a__3[1] = "q";
27957 		i__5[2] = 1, a__3[2] = udq;
27958 		i__5[3] = ldot, a__3[3] = dotq;
27959 		i__5[4] = lnoten, a__3[4] = noteq;
27960 		s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
27961 		*lnote = lnoten + 3 + ldot;
27962 	    } else if (nodu >= 12) {
27963 /* Writing concatenation */
27964 		i__5[0] = 1, a__3[0] = all_1.sq;
27965 		i__5[1] = 1, a__3[1] = "c";
27966 		i__5[2] = 1, a__3[2] = udq;
27967 		i__5[3] = ldot, a__3[3] = dotq;
27968 		i__5[4] = lnoten, a__3[4] = noteq;
27969 		s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
27970 		*lnote = lnoten + 3 + ldot;
27971 	    } else if (nodu >= 6) {
27972 /* Writing concatenation */
27973 		i__5[0] = 1, a__3[0] = all_1.sq;
27974 		i__5[1] = 2, a__3[1] = "cc";
27975 		i__5[2] = 1, a__3[2] = udq;
27976 		i__5[3] = ldot, a__3[3] = dotq;
27977 		i__5[4] = lnoten, a__3[4] = noteq;
27978 		s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
27979 		*lnote = lnoten + 4 + ldot;
27980 		compoi_1.ispoi = TRUE_;
27981 	    } else {
27982 /* Writing concatenation */
27983 		i__5[0] = 1, a__3[0] = all_1.sq;
27984 		i__5[1] = 3, a__3[1] = "ccc";
27985 		i__5[2] = 1, a__3[2] = udq;
27986 		i__5[3] = ldot, a__3[3] = dotq;
27987 		i__5[4] = lnoten, a__3[4] = noteq;
27988 		s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
27989 		*lnote = lnoten + 5 + ldot;
27990 		compoi_1.ispoi = TRUE_;
27991 	    }
27992 	    if (*(unsigned char *)dotq == 'm') {
27993 
27994 /*  Need another call to the note, in case the first one has octave shifts */
27995 
27996 		if (lnoten == 2) {
27997 /* Writing concatenation */
27998 		    i__3[0] = *lnote, a__1[0] = notexq;
27999 		    i__3[1] = 1, a__1[1] = "{";
28000 		    i__3[2] = 1, a__1[2] = noteq + 1;
28001 		    i__3[3] = 1, a__1[3] = "}";
28002 		    s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
28003 		    *lnote += 3;
28004 		} else {
28005 		    i__1 = lnoten - 2;
28006 /* Writing concatenation */
28007 		    i__6[0] = *lnote, a__4[0] = notexq;
28008 		    i__6[1] = lnoten - 1 - i__1, a__4[1] = noteq + i__1;
28009 		    s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
28010 		    ++(*lnote);
28011 		}
28012 	    }
28013 	}
28014     } else if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29)) {
28015 
28016 /*  Blank rest */
28017 
28018 /* Writing concatenation */
28019 	i__6[0] = 1, a__4[0] = all_1.sq;
28020 	i__6[1] = 2, a__4[1] = "sk";
28021 	s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
28022 	*lnote = 3;
28023     } else {
28024 
28025 /*  Non-blank rest */
28026 
28027 	*lnote = 0;
28028 	nole = (nole + 20) % 100 - 20;
28029 
28030 /*  Kluge to get pause symbol for rp: */
28031 
28032 	if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],19)) {
28033 	    nodu = 64;
28034 	}
28035 	if (nodu <= 28) {
28036 
28037 /*  Normal rest < or = double-dotted quarter */
28038 
28039 	    lrest = 3;
28040 	    if (nodu > 14) {
28041 /* Writing concatenation */
28042 		i__6[0] = 1, a__4[0] = all_1.sq;
28043 		i__6[1] = 2, a__4[1] = "qp";
28044 		s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
28045 	    } else if (nodu > 7) {
28046 /* Writing concatenation */
28047 		i__6[0] = 1, a__4[0] = all_1.sq;
28048 		i__6[1] = 2, a__4[1] = "ds";
28049 		s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
28050 	    } else if (nodu > 3) {
28051 /* Writing concatenation */
28052 		i__6[0] = 1, a__4[0] = all_1.sq;
28053 		i__6[1] = 2, a__4[1] = "qs";
28054 		s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
28055 	    } else if (nodu > 1) {
28056 /* Writing concatenation */
28057 		i__6[0] = 1, a__4[0] = all_1.sq;
28058 		i__6[1] = 2, a__4[1] = "hs";
28059 		s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
28060 	    } else {
28061 /* Writing concatenation */
28062 		i__6[0] = 1, a__4[0] = all_1.sq;
28063 		i__6[1] = 3, a__4[1] = "qqs";
28064 		s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
28065 		lrest = 4;
28066 	    }
28067 /*          if (2**log2(nodu) .ne. nodu) then */
28068 /* c */
28069 /* c  One or two dots on rest */
28070 /* c */
28071 /*            restq = restq(1:3)//'p' */
28072 /*            lrest = 4 */
28073 /*            if (2*nodu .gt. 3*2**log2(nodu)) then */
28074 /* c */
28075 /* c  Double dotted rest */
28076 /* c */
28077 /*              restq = restq(1:4)//'p' */
28078 /*              lrest = 5 */
28079 /*            end if */
28080 /*          end if */
28081 	    s_copy(notexq, restq, (ftnlen)79, (ftnlen)40);
28082 	    *lnote = lrest;
28083 
28084 /*  At this point notexq=restq,lnote=lrest are name of rest.  Now raise if necc. */
28085 
28086 	    if (nole != 0) {
28087 		if (abs(nole) < 10) {
28088 		    i__1 = abs(nole) + 48;
28089 		    chax_(ch__1, (ftnlen)1, &i__1);
28090 		    s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1);
28091 		    lnoten = 1;
28092 		} else {
28093 		    s_wsfi(&io___1124);
28094 		    i__1 = abs(nole);
28095 		    do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
28096 		    e_wsfi();
28097 		    lnoten = 2;
28098 		}
28099 		if (nole > 0) {
28100 /* Writing concatenation */
28101 		    i__5[0] = 1, a__3[0] = all_1.sq;
28102 		    i__5[1] = 5, a__3[1] = "raise";
28103 		    i__5[2] = lnoten, a__3[2] = noteq;
28104 		    i__5[3] = 1, a__3[3] = all_1.sq;
28105 		    i__5[4] = 9, a__3[4] = "internote";
28106 		    s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
28107 		} else {
28108 /* Writing concatenation */
28109 		    i__5[0] = 1, a__3[0] = all_1.sq;
28110 		    i__5[1] = 5, a__3[1] = "lower";
28111 		    i__5[2] = lnoten, a__3[2] = noteq;
28112 		    i__5[3] = 1, a__3[3] = all_1.sq;
28113 		    i__5[4] = 9, a__3[4] = "internote";
28114 		    s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
28115 		}
28116 		*lnote = lnoten + 16;
28117 /*            if (2**log2(nodu) .ne. nodu) then */
28118 /* c */
28119 /* c  Have dot in raised rest.  must put in hbox! */
28120 /* c */
28121 /*              notexq = notexq(1:lnote)//sq//'hbox{' */
28122 /*              lnote = lnote+6 */
28123 /*            end if */
28124 /* Writing concatenation */
28125 		i__6[0] = *lnote, a__4[0] = notexq;
28126 		i__6[1] = lrest, a__4[1] = restq;
28127 		s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
28128 		*lnote += lrest;
28129 /*            if (2**log2(nodu) .ne. nodu) then */
28130 /*              notexq = notexq(1:lnote)//'}' */
28131 /*              lnote = lnote+1 */
28132 /*            end if */
28133 	    }
28134 	    i__1 = log2_(&nodu);
28135 	    if (pow_ii(&c__2, &i__1) != nodu) {
28136 
28137 /*  Deal with dots (on rests shorter than half rest) */
28138 
28139 /* Writing concatenation */
28140 		i__6[0] = 1, a__4[0] = all_1.sq;
28141 		i__6[1] = 2, a__4[1] = "pt";
28142 		s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
28143 		lrest = 3;
28144 		i__1 = log2_(&nodu);
28145 		if (nodu << 1 > pow_ii(&c__2, &i__1) * 3) {
28146 /* Writing concatenation */
28147 		    i__6[0] = 1, a__4[0] = all_1.sq;
28148 		    i__6[1] = 3, a__4[1] = "ppt";
28149 		    s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
28150 		    lrest = 4;
28151 		}
28152 		nole += 4;
28153 		raisedot = 0.f;
28154 
28155 /*  Tweak dot positions for special cases */
28156 
28157 		even = (nole + 100) % 2 == 0;
28158 /*            if (.not.even.and.nodu.gt.8.and. */
28159 /*     *          (nole.lt.0.or.nole.gt.8)) then */
28160 		if (! even && (nole < 0 || nole > 8)) {
28161 		    raisedot = 1.f;
28162 		}
28163 		if (nole >= 10 || nole <= -1) {
28164 		    s_wsfi(&io___1128);
28165 		    do_fio(&c__1, (char *)&nole, (ftnlen)sizeof(integer));
28166 		    e_wsfi();
28167 /* Writing concatenation */
28168 		    i__3[0] = lrest, a__1[0] = restq;
28169 		    i__3[1] = 1, a__1[1] = "{";
28170 		    i__3[2] = 2, a__1[2] = numq;
28171 		    i__3[3] = 1, a__1[3] = "}";
28172 		    s_cat(restq, a__1, i__3, &c__4, (ftnlen)40);
28173 		    lrest += 4;
28174 		} else {
28175 /* Writing concatenation */
28176 		    i__6[0] = lrest, a__4[0] = restq;
28177 		    i__1 = nole + 48;
28178 		    chax_(ch__1, (ftnlen)1, &i__1);
28179 		    i__6[1] = 1, a__4[1] = ch__1;
28180 		    s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
28181 		    ++lrest;
28182 		}
28183 		if (raisedot > 0.f) {
28184 /* Writing concatenation */
28185 		    i__7[0] = 1, a__5[0] = all_1.sq;
28186 		    i__7[1] = 5, a__5[1] = "raise";
28187 		    i__7[2] = 1, a__5[2] = all_1.sq;
28188 		    i__7[3] = 9, a__5[3] = "internote";
28189 		    i__7[4] = 1, a__5[4] = all_1.sq;
28190 		    i__7[5] = 5, a__5[5] = "hbox{";
28191 		    i__7[6] = lrest, a__5[6] = restq;
28192 		    i__7[7] = 1, a__5[7] = "}";
28193 		    s_cat(restq, a__5, i__7, &c__8, (ftnlen)40);
28194 		    lrest += 23;
28195 		}
28196 /* Writing concatenation */
28197 		i__6[0] = lrest, a__4[0] = restq;
28198 		i__6[1] = *lnote, a__4[1] = notexq;
28199 		s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
28200 		*lnote += lrest;
28201 	    }
28202 	} else {
28203 
28204 /*  Half rest or longer */
28205 
28206 	    if (nole == 0) {
28207 
28208 /*  Half or longer rest is not raised or lowered */
28209 
28210 		if (nodu <= 56) {
28211 /* Writing concatenation */
28212 		    i__6[0] = 1, a__4[0] = all_1.sq;
28213 		    i__6[1] = 6, a__4[1] = "hpause";
28214 		    s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
28215 		    *lnote = 7;
28216 		} else if (nodu <= 112) {
28217 		    if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],
28218 			    19) || bit_test(all_1.irest[commvl_1.ivx + ip *
28219 			    24 - 25],25)) {
28220 /* Writing concatenation */
28221 			i__6[0] = 1, a__4[0] = all_1.sq;
28222 			i__6[1] = 5, a__4[1] = "pause";
28223 			s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
28224 		    } else {
28225 /* Writing concatenation */
28226 			i__6[0] = 1, a__4[0] = all_1.sq;
28227 			i__6[1] = 5, a__4[1] = "pausc";
28228 			s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
28229 		    }
28230 		    *lnote = 6;
28231 		} else {
28232 /* Writing concatenation */
28233 		    i__6[0] = 1, a__4[0] = all_1.sq;
28234 		    i__6[1] = 5, a__4[1] = "PAuse";
28235 		    s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
28236 		    *lnote = 6;
28237 		}
28238 		i__1 = log2_(&nodu);
28239 		if (pow_ii(&c__2, &i__1) != nodu) {
28240 
28241 /*  Dotted rest, hpause or longer */
28242 
28243 /* Writing concatenation */
28244 		    i__6[0] = *lnote, a__4[0] = notexq;
28245 		    i__6[1] = 1, a__4[1] = "p";
28246 		    s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
28247 		    ++(*lnote);
28248 		    i__1 = log2_(&nodu);
28249 		    if (nodu << 1 > pow_ii(&c__2, &i__1) * 3) {
28250 
28251 /*  Double dotted long rest */
28252 
28253 /* Writing concatenation */
28254 			i__6[0] = *lnote, a__4[0] = notexq;
28255 			i__6[1] = 1, a__4[1] = "p";
28256 			s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
28257 			++(*lnote);
28258 		    }
28259 		}
28260 	    } else {
28261 
28262 /*  Raised or lowered half or whole rest */
28263 
28264 		if (nodu == 32) {
28265 /* Writing concatenation */
28266 		    i__6[0] = 1, a__4[0] = all_1.sq;
28267 		    i__6[1] = 10, a__4[1] = "lifthpause";
28268 		    s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
28269 		    *lnote = 11;
28270 		} else if (nodu == 48) {
28271 /* Writing concatenation */
28272 		    i__6[0] = 1, a__4[0] = all_1.sq;
28273 		    i__6[1] = 11, a__4[1] = "lifthpausep";
28274 		    s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
28275 		    *lnote = 12;
28276 		} else if (nodu == 56) {
28277 /* Writing concatenation */
28278 		    i__6[0] = 1, a__4[0] = all_1.sq;
28279 		    i__6[1] = 12, a__4[1] = "lifthpausepp";
28280 		    s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
28281 		    *lnote = 13;
28282 		} else if (nodu == 64) {
28283 /* Writing concatenation */
28284 		    i__6[0] = 1, a__4[0] = all_1.sq;
28285 		    i__6[1] = 9, a__4[1] = "liftpause";
28286 		    s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
28287 		    *lnote = 10;
28288 		} else if (nodu == 96) {
28289 /* Writing concatenation */
28290 		    i__6[0] = 1, a__4[0] = all_1.sq;
28291 		    i__6[1] = 10, a__4[1] = "liftpausep";
28292 		    s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
28293 		    *lnote = 11;
28294 		} else if (nodu == 112) {
28295 /* Writing concatenation */
28296 		    i__6[0] = 1, a__4[0] = all_1.sq;
28297 		    i__6[1] = 11, a__4[1] = "liftpausepp";
28298 		    s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
28299 		    *lnote = 12;
28300 		} else if (nodu == 128) {
28301 /* Writing concatenation */
28302 		    i__6[0] = 1, a__4[0] = all_1.sq;
28303 		    i__6[1] = 9, a__4[1] = "liftPAuse";
28304 		    s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
28305 		    *lnote = 10;
28306 		} else {
28307 
28308 /*  Assume dotted double whole rest */
28309 
28310 /* Writing concatenation */
28311 		    i__6[0] = 1, a__4[0] = all_1.sq;
28312 		    i__6[1] = 10, a__4[1] = "liftPAusep";
28313 		    s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
28314 		    *lnote = 11;
28315 		}
28316 
28317 /*  Set up height spec */
28318 
28319 		i__1 = abs(nole) / 2;
28320 		nole = i_sign(&i__1, &nole);
28321 		if (nole <= 9 && nole >= 0) {
28322 		    i__1 = nole + 48;
28323 		    chax_(ch__1, (ftnlen)1, &i__1);
28324 		    s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1);
28325 		    lnoten = 1;
28326 		} else {
28327 		    s_copy(noteq, "{", (ftnlen)8, (ftnlen)1);
28328 		    if (nole >= -9) {
28329 			s_wsfi(&io___1129);
28330 			do_fio(&c__1, (char *)&nole, (ftnlen)sizeof(integer));
28331 			e_wsfi();
28332 			lnoten = 3;
28333 		    } else {
28334 			s_wsfi(&io___1130);
28335 			do_fio(&c__1, (char *)&nole, (ftnlen)sizeof(integer));
28336 			e_wsfi();
28337 			lnoten = 4;
28338 		    }
28339 /* Writing concatenation */
28340 		    i__6[0] = lnoten, a__4[0] = noteq;
28341 		    i__6[1] = 1, a__4[1] = "}";
28342 		    s_cat(noteq, a__4, i__6, &c__2, (ftnlen)8);
28343 		    ++lnoten;
28344 		}
28345 /* Writing concatenation */
28346 		i__6[0] = *lnote, a__4[0] = notexq;
28347 		i__6[1] = lnoten, a__4[1] = noteq;
28348 		s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
28349 		*lnote += lnoten;
28350 	    }
28351 	}
28352     }
28353     return 0;
28354 } /* notex_ */
28355 
ntindex_(char * line,char * s2q,integer * lenline,ftnlen line_len,ftnlen s2q_len)28356 integer ntindex_(char *line, char *s2q, integer *lenline, ftnlen line_len,
28357 	ftnlen s2q_len)
28358 {
28359     /* System generated locals */
28360     address a__1[2];
28361     integer ret_val, i__1, i__2, i__3[2];
28362     char ch__1[1], ch__2[2];
28363 
28364     /* Builtin functions */
28365     integer i_indx(char *, char *, ftnlen, ftnlen), s_cmp(char *, char *,
28366 	    ftnlen, ftnlen);
28367     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
28368 
28369     /* Local variables */
28370     static integer ic, len;
28371     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
28372     static integer ndxs2, ndxbs;
28373     static logical intex;
28374     extern integer lenstr_(char *, integer *, ftnlen);
28375 
28376 
28377 /*  Returns index(line,s2q) if NOT in TeX string, 0 otherwise */
28378 
28379     ndxs2 = i_indx(line, s2q, line_len, s2q_len);
28380     chax_(ch__1, (ftnlen)1, &c__92);
28381     ndxbs = i_indx(line, ch__1, line_len, (ftnlen)1);
28382     if (ndxbs == 0 || ndxs2 < ndxbs) {
28383 	ret_val = ndxs2;
28384     } else {
28385 
28386 /*  There are both bs and s2q, and bs is to the left of sq2. So check bs's to */
28387 /*  right of first: End is '\ ', start is ' \' */
28388 
28389 	len = lenstr_(line, lenline, line_len);
28390 	intex = TRUE_;
28391 	i__1 = len;
28392 	for (ic = ndxbs + 1; ic <= i__1; ++ic) {
28393 	    if (ic == ndxs2) {
28394 		if (intex) {
28395 		    ret_val = 0;
28396 		    i__2 = ic;
28397 		    ndxs2 = i_indx(line + i__2, s2q, len - i__2, s2q_len) +
28398 			    ic;
28399 		} else {
28400 		    ret_val = ndxs2;
28401 		    return ret_val;
28402 		}
28403 	    } else /* if(complicated condition) */ {
28404 		i__2 = ic;
28405 /* Writing concatenation */
28406 		chax_(ch__1, (ftnlen)1, &c__92);
28407 		i__3[0] = 1, a__1[0] = ch__1;
28408 		i__3[1] = 1, a__1[1] = " ";
28409 		s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)2);
28410 		if (intex && s_cmp(line + i__2, ch__2, ic + 2 - i__2, (ftnlen)
28411 			2) == 0) {
28412 		    intex = FALSE_;
28413 		} else /* if(complicated condition) */ {
28414 		    i__2 = ic;
28415 /* Writing concatenation */
28416 		    i__3[0] = 1, a__1[0] = " ";
28417 		    chax_(ch__1, (ftnlen)1, &c__92);
28418 		    i__3[1] = 1, a__1[1] = ch__1;
28419 		    s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)2);
28420 		    if (! intex && s_cmp(line + i__2, ch__2, ic + 2 - i__2, (
28421 			    ftnlen)2) == 0) {
28422 			intex = TRUE_;
28423 		    }
28424 		}
28425 	    }
28426 /* L1: */
28427 	}
28428     }
28429     return ret_val;
28430 } /* ntindex_ */
28431 
ntrbbb_(integer * n,char * char1q,char * ulqq,integer * iv,char * notexq,integer * lnote,ftnlen char1q_len,ftnlen ulqq_len,ftnlen notexq_len)28432 /* Subroutine */ int ntrbbb_(integer *n, char *char1q, char *ulqq, integer *
28433 	iv, char *notexq, integer *lnote, ftnlen char1q_len, ftnlen ulqq_len,
28434 	ftnlen notexq_len)
28435 {
28436     /* System generated locals */
28437     address a__1[3], a__2[2];
28438     integer i__1[3], i__2[2], i__3;
28439     char ch__1[1];
28440 
28441     /* Builtin functions */
28442     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
28443 
28444     /* Local variables */
28445     static integer im, len;
28446     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
28447     extern /* Subroutine */ int stop1_(void);
28448     static char tempq[4];
28449     extern /* Subroutine */ int printl_(char *, ftnlen), istring_(integer *,
28450 	    char *, integer *, ftnlen);
28451 
28452 
28453 /*  This appends to notexq e.g. '\ibbbu1' */
28454 
28455     if (*n >= 5) {
28456 	combbm_1.isbbm = TRUE_;
28457     }
28458     if (*lnote > 0) {
28459 /* Writing concatenation */
28460 	i__1[0] = *lnote, a__1[0] = notexq;
28461 	chax_(ch__1, (ftnlen)1, &c__92);
28462 	i__1[1] = 1, a__1[1] = ch__1;
28463 	i__1[2] = 1, a__1[2] = char1q;
28464 	s_cat(notexq, a__1, i__1, &c__3, (ftnlen)79);
28465     } else {
28466 /* Writing concatenation */
28467 	chax_(ch__1, (ftnlen)1, &c__92);
28468 	i__2[0] = 1, a__2[0] = ch__1;
28469 	i__2[1] = 1, a__2[1] = char1q;
28470 	s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
28471     }
28472     *lnote += 2;
28473     i__3 = *n;
28474     for (im = 1; im <= i__3; ++im) {
28475 /* Writing concatenation */
28476 	i__2[0] = *lnote, a__2[0] = notexq;
28477 	i__2[1] = 1, a__2[1] = "b";
28478 	s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
28479 	++(*lnote);
28480 /* L3: */
28481     }
28482 
28483 /*  add the number, 0 if 12 */
28484 
28485 /*  5/25/08 Allow >12 */
28486 
28487 /*      call istring(mod(iv,12),tempq,len) */
28488     if (*iv < 24) {
28489 	istring_(iv, tempq, &len, (ftnlen)4);
28490     } else if (*iv == 24) {
28491 	*(unsigned char *)tempq = '0';
28492 	len = 1;
28493     } else {
28494 	printl_("Sorry, too man open beams", (ftnlen)25);
28495 	stop1_();
28496     }
28497 /* Writing concatenation */
28498     i__1[0] = *lnote, a__1[0] = notexq;
28499     i__1[1] = 1, a__1[1] = ulqq;
28500     i__1[2] = len, a__1[2] = tempq;
28501     s_cat(notexq, a__1, i__1, &c__3, (ftnlen)79);
28502     *lnote = *lnote + 1 + len;
28503     return 0;
28504 } /* ntrbbb_ */
28505 
numclef_(char * clefq,ftnlen clefq_len)28506 integer numclef_(char *clefq, ftnlen clefq_len)
28507 {
28508     /* System generated locals */
28509     integer ret_val;
28510 
28511     /* Builtin functions */
28512     integer i_indx(char *, char *, ftnlen, ftnlen);
28513 
28514 
28515 /*  Returns the number to be used as argument of \setclef (for MusiXTeX only) */
28516 /*        if (ichar(clefq) .lt. 55) then */
28517     if (*(unsigned char *)clefq <= 55) {
28518 	ret_val = *(unsigned char *)clefq - 48;
28519 	if (ret_val == 7) {
28520 	    ret_val = 9;
28521 	}
28522     } else {
28523 	ret_val = i_indx("tsmanrbxxf", clefq, (ftnlen)10, (ftnlen)1) - 1;
28524     }
28525     return ret_val;
28526 } /* numclef_ */
28527 
outbar_(integer * i__,integer * jlast)28528 /* Subroutine */ int outbar_(integer *i__, integer *jlast)
28529 {
28530     /* System generated locals */
28531     address a__1[3];
28532     integer i__1[3], i__2;
28533     real r__1;
28534     char ch__1[9], ch__2[1], ch__3[11];
28535     cilist ci__1;
28536 
28537     /* Builtin functions */
28538     double r_lg10(real *);
28539     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
28540     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
28541 
28542     /* Local variables */
28543     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
28544     static integer nfmt;
28545 
28546     r__1 = *i__ + .5f;
28547     nfmt = r_lg10(&r__1) + 2;
28548     if (*jlast + 5 + nfmt < 80) {
28549 	ci__1.cierr = 0;
28550 	ci__1.ciunit = 6;
28551 /* Writing concatenation */
28552 	i__1[0] = 5, a__1[0] = "(a5,i";
28553 	i__2 = nfmt + 48;
28554 	chax_(ch__2, (ftnlen)1, &i__2);
28555 	i__1[1] = 1, a__1[1] = ch__2;
28556 	i__1[2] = 3, a__1[2] = ",$)";
28557 	ci__1.cifmt = (s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)9), ch__1);
28558 	s_wsfe(&ci__1);
28559 	do_fio(&c__1, "  Bar", (ftnlen)5);
28560 	do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer));
28561 	e_wsfe();
28562 	ci__1.cierr = 0;
28563 	ci__1.ciunit = 15;
28564 /* Writing concatenation */
28565 	i__1[0] = 5, a__1[0] = "(a5,i";
28566 	i__2 = nfmt + 48;
28567 	chax_(ch__2, (ftnlen)1, &i__2);
28568 	i__1[1] = 1, a__1[1] = ch__2;
28569 	i__1[2] = 3, a__1[2] = ",$)";
28570 	ci__1.cifmt = (s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)9), ch__1);
28571 	s_wsfe(&ci__1);
28572 	do_fio(&c__1, "  Bar", (ftnlen)5);
28573 	do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer));
28574 	e_wsfe();
28575 	*jlast = *jlast + 5 + nfmt;
28576     } else {
28577 	ci__1.cierr = 0;
28578 	ci__1.ciunit = 6;
28579 /* Writing concatenation */
28580 	i__1[0] = 7, a__1[0] = "(/,a5,i";
28581 	i__2 = nfmt + 48;
28582 	chax_(ch__2, (ftnlen)1, &i__2);
28583 	i__1[1] = 1, a__1[1] = ch__2;
28584 	i__1[2] = 3, a__1[2] = ",$)";
28585 	ci__1.cifmt = (s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)11), ch__3);
28586 	s_wsfe(&ci__1);
28587 	do_fio(&c__1, "  Bar", (ftnlen)5);
28588 	do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer));
28589 	e_wsfe();
28590 	ci__1.cierr = 0;
28591 	ci__1.ciunit = 15;
28592 /* Writing concatenation */
28593 	i__1[0] = 7, a__1[0] = "(/,a5,i";
28594 	i__2 = nfmt + 48;
28595 	chax_(ch__2, (ftnlen)1, &i__2);
28596 	i__1[1] = 1, a__1[1] = ch__2;
28597 	i__1[2] = 3, a__1[2] = ",$)";
28598 	ci__1.cifmt = (s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)11), ch__3);
28599 	s_wsfe(&ci__1);
28600 	do_fio(&c__1, "  Bar", (ftnlen)5);
28601 	do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer));
28602 	e_wsfe();
28603 	*jlast = nfmt + 5;
28604     }
28605     return 0;
28606 } /* outbar_ */
28607 
pmxa_(char * basenameq,integer * lbase,logical * isfirst,integer * nsyout,integer * nbarss,logical * optimize,ftnlen basenameq_len)28608 /* Subroutine */ int pmxa_(char *basenameq, integer *lbase, logical *isfirst,
28609 	integer *nsyout, integer *nbarss, logical *optimize, ftnlen
28610 	basenameq_len)
28611 {
28612     /* Initialized data */
28613 
28614     static real wtimesig = .72f;
28615     static real wclef = .8f;
28616     static real wkeysig = .28f;
28617 
28618     /* System generated locals */
28619     integer i__1, i__2, i__3, i__4, i__5, i__6;
28620     real r__1, r__2, r__3, r__4;
28621     doublereal d__1, d__2;
28622     olist o__1;
28623     cllist cl__1;
28624     alist al__1;
28625 
28626     /* Builtin functions */
28627     integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char
28628 	    *, ftnlen), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen),
28629 	    e_wsfe(void), f_open(olist *), f_clos(cllist *), i_nint(real *);
28630     double pow_dd(doublereal *, doublereal *);
28631     integer f_rew(alist *);
28632 
28633     /* Local variables */
28634     extern /* Subroutine */ int g1etnote_(logical *, integer *, logical *,
28635 	    logical *);
28636     extern integer i1fnodur_(integer *, char *, ftnlen);
28637     extern /* Subroutine */ int makeabar_(void);
28638     static real xmtrnum0, heightil;
28639     extern /* Subroutine */ int findeonk_(integer *, integer *, real *, real *
28640 	    , real *, real *, real *);
28641     static real elsstarg;
28642     static logical cstuplet;
28643     static real c__, d__;
28644     static integer j, listcresc;
28645     extern /* Subroutine */ int getpmxmod_(logical *, char *, ftnlen);
28646     static integer isysendpg;
28647     static logical fulltrans;
28648     static integer ip, nomnsystp, kv;
28649     static real xn;
28650     static integer nns, isy, listdecresc, key1, key2;
28651     static real diff;
28652     static integer iflb, ifig, ifpb, ioff;
28653     extern doublereal feon_(real *);
28654     static real elsk[3999];
28655     static integer ikey;
28656     static real elss[125];
28657     static logical loop;
28658     static real wdpt;
28659     static integer iptr;
28660     static real diff1;
28661     static integer ibar1;
28662     extern doublereal f1eon_(real *);
28663     extern /* Subroutine */ int stop1_(void);
28664     static integer ipage, naccs;
28665     static real celsk[4000];
28666     static logical newmb[3999];
28667     static integer ibars;
28668     static real dtmin, dtmax, xelsk, wmins;
28669     static integer ivnow, ibarb4;
28670     static real fsyst;
28671     static integer isyst;
28672     static real elmin0, elmin1;
28673     static integer isysb4;
28674     static real omegag, facins, glueil;
28675     extern /* Subroutine */ int outbar_(integer *, integer *);
28676     static integer jprntb, nintpg, mtrdnp;
28677     extern /* Subroutine */ int printl_(char *, ftnlen);
28678     static real poenom;
28679     static integer mtrnmp, nshort;
28680     static real wminpt, celskb4, xiltxt;
28681     static integer nsystp;
28682     static real wsyspt;
28683     extern /* Subroutine */ int g1etset_(integer *, integer *, integer *,
28684 	    integer *, integer *, integer *, real *, integer *, integer *,
28685 	    integer *, integer *, logical *);
28686     static integer lenbeat, lastbar[126];
28687     static real xilfrac;
28688     static integer iflbnow;
28689     static logical bottreb;
28690     static integer mtrdenl, imovbrk, lenmult, iscount;
28691     static real sumelsk;
28692     static integer instnow, nsystpp;
28693 
28694     /* Fortran I/O blocks */
28695     static cilist io___1143 = { 0, 6, 0, 0, 0 };
28696     static cilist io___1144 = { 0, 6, 0, 0, 0 };
28697     static cilist io___1145 = { 0, 15, 0, "(a)", 0 };
28698     static cilist io___1146 = { 0, 19, 0, "(i6)", 0 };
28699     static cilist io___1158 = { 0, 6, 0, 0, 0 };
28700     static cilist io___1162 = { 0, 6, 0, 0, 0 };
28701     static cilist io___1168 = { 0, 15, 0, "(/,a20,i4,a1,i4)", 0 };
28702     static cilist io___1169 = { 0, 6, 0, "(/,a20,i4,a1,i4)", 0 };
28703     static cilist io___1174 = { 0, 6, 0, 0, 0 };
28704     static cilist io___1176 = { 0, 6, 0, 0, 0 };
28705     static cilist io___1177 = { 0, 6, 0, 0, 0 };
28706     static cilist io___1178 = { 0, 6, 0, 0, 0 };
28707     static cilist io___1179 = { 0, 15, 0, "(a,2i5)", 0 };
28708     static cilist io___1180 = { 0, 15, 0, "(a)", 0 };
28709     static cilist io___1182 = { 0, 12, 0, "(a)", 0 };
28710     static cilist io___1183 = { 0, 12, 0, 0, 0 };
28711     static cilist io___1184 = { 0, 12, 0, "(6f10.5/f10.5,3i5)", 0 };
28712     static cilist io___1185 = { 0, 12, 0, 0, 0 };
28713     static cilist io___1204 = { 0, 12, 0, 0, 0 };
28714     static cilist io___1219 = { 0, 12, 0, "(i5)", 0 };
28715     static cilist io___1237 = { 0, 12, 0, "(1pe12.5/i5,5e12.3)", 0 };
28716     static cilist io___1238 = { 0, 13, 0, "(i5)", 0 };
28717     static cilist io___1239 = { 0, 6, 0, "(/,a)", 0 };
28718     static cilist io___1240 = { 0, 6, 0, 0, 0 };
28719     static cilist io___1241 = { 0, 15, 0, "(/,a)", 0 };
28720     static cilist io___1242 = { 0, 15, 0, "()", 0 };
28721 
28722 
28723 /* ccccccccccccccccccccccccccccccccccccccccccccccc */
28724 /* c                                            cc */
28725 /* c Subroutine, combine with pmxb.for */
28726 /* c */
28727 /* ccccccccccccccccccccccccccccccccccccccccccccccc */
28728 /* c */
28729 /* c  Need to consider X spaces in xtuplets when getting poenom, and */
28730 /* c      maybe fbar? */
28731 /* c  mx06a */
28732 /* c    ID numbers for voices when number of voices is reduced. */
28733 /* c */
28734 /* c  mx03a */
28735 /* c    account for new fracindent for new movements. */
28736 /* c */
28737 /* c  Known changes since pmxa. Version 1.1b (see pmxb for longer list) */
28738 /* c */
28739 /* c  Check ID codes for slurs. */
28740 /* c  Version 1.24 still does not have details for spacing/positioning */
28741 /* c    arpeggios if there are accidentals or shifted notes or crowded scores. */
28742 /* c  Fix problem in 1.22 with arpeggios across multi-line staves */
28743 /* c  Fix problem in 1.22 with flat key signatures */
28744 /* c  Read setup data as strings */
28745 /* c  Warning for octave designation plus +/- */
28746 /* c  Don't pause for volta warning, */
28747 /* c  Macros */
28748 /* c  Correct fsyst to account for transposition and key changes. */
28749 /* c  Check for nbars > nsyst */
28750 /* c */
28751 /* cccccccccccccccccccccccccccccccccc */
28752     /* Parameter adjustments */
28753     --nbarss;
28754 
28755     /* Function Body */
28756     commus_1.whead20 = .3f;
28757     if (! (*optimize)) {
28758 	s_wsle(&io___1143);
28759 	e_wsle();
28760 	s_wsle(&io___1144);
28761 	do_lio(&c__9, &c__1, "Starting first PMX pass", (ftnlen)23);
28762 	e_wsle();
28763 	s_wsfe(&io___1145);
28764 	do_fio(&c__1, " Starting first PMX pass", (ftnlen)24);
28765 	e_wsfe();
28766     }
28767     if (*isfirst) {
28768 	o__1.oerr = 0;
28769 	o__1.ounit = 19;
28770 	o__1.ofnmlen = 11;
28771 	o__1.ofnm = "pmxaerr.dat";
28772 	o__1.orl = 0;
28773 	o__1.osta = 0;
28774 	o__1.oacc = 0;
28775 	o__1.ofm = 0;
28776 	o__1.oblnk = 0;
28777 	f_open(&o__1);
28778 	s_wsfe(&io___1146);
28779 	do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
28780 	e_wsfe();
28781 	cl__1.cerr = 0;
28782 	cl__1.cunit = 19;
28783 	cl__1.csta = 0;
28784 	f_clos(&cl__1);
28785     }
28786     if (! (*optimize)) {
28787 	jprntb = 81;
28788     }
28789     commac_1.macuse = 0;
28790     comkeys_1.ornrpt = FALSE_;
28791     comkeys_1.stickys = FALSE_;
28792     commac_1.mrecord = FALSE_;
28793     commac_1.mplay = FALSE_;
28794     c1omget_1.lastchar = FALSE_;
28795     comnvst_2.novshrinktop = FALSE_;
28796     cstuplet = FALSE_;
28797     comslur_1.fontslur = TRUE_;
28798     comligfont_1.isligfont = FALSE_;
28799     fulltrans = FALSE_;
28800     for (c1omnotes_1.ibarcnt = 1; c1omnotes_1.ibarcnt <= 3999;
28801 	    ++c1omnotes_1.ibarcnt) {
28802 	c1omnotes_1.udsp[c1omnotes_1.ibarcnt - 1] = 0.f;
28803 	c1omnotes_1.wminnh[c1omnotes_1.ibarcnt - 1] = -1.f;
28804 /* L42: */
28805     }
28806 
28807 /*  Initialize input buffer */
28808 
28809     c1omget_1.lenbuf0 = inbuff_1.ipbuf;
28810     inbuff_1.ipbuf = 0;
28811     inbuff_1.ilbuf = 1;
28812     g1etset_(&a1ll_2.nv, &comkeys_1.noinst, &a1ll_2.mtrnuml, &mtrdenl, &
28813 	    mtrnmp, &mtrdnp, &xmtrnum0, comkeys_1.newkey, &compage_1.npages, &
28814 	    compage_1.nsyst, &commus_1.musize, &bottreb);
28815 
28816 /*  Set up list of instrument numbers (iv) */
28817 
28818     ivnow = 0;
28819     i__1 = comkeys_1.noinst;
28820     for (instnow = 1; instnow <= i__1; ++instnow) {
28821 	i__2 = c1omget_1.nsperi[instnow - 1];
28822 	for (iscount = 1; iscount <= i__2; ++iscount) {
28823 	    ++ivnow;
28824 	    cominsttrans_1.instno[ivnow - 1] = instnow;
28825 /* L14: */
28826 	}
28827 /* L13: */
28828     }
28829 
28830 /*  Save initial meter for midi */
28831 
28832     if (! (*isfirst) && compage_1.npages == 0) {
28833 	s_wsle(&io___1158);
28834 	do_lio(&c__9, &c__1, "Sorry, must have npages>0 for optimization.", (
28835 		ftnlen)43);
28836 	e_wsle();
28837 	stop1_();
28838     }
28839     *nsyout = compage_1.nsyst;
28840 
28841 /*  isig1 will be changed in getnote if there is a transposition */
28842 
28843     comkeys_1.isig1 = comkeys_1.newkey[0];
28844     if (compage_1.npages > compage_1.nsyst) {
28845 	printl_("npages > nsyst in input.  Please fix the input.", (ftnlen)47)
28846 		;
28847 	stop1_();
28848     }
28849 
28850 /*  fbar = afterruleskip/elemskip */
28851 /*  apt = width of small accidental + space in points (= 6 at 20pt) =wheadpt */
28852 
28853     c1ommvl_1.fbar = 1.f;
28854     c1omnotes_1.wheadpt = commus_1.whead20 * commus_1.musize;
28855     ifig = 0;
28856     compage_1.usefig = TRUE_;
28857     lenbeat = i1fnodur_(&mtrdenl, "x", (ftnlen)1);
28858     lenmult = 1;
28859     if (mtrdenl == 2) {
28860 	lenbeat = 16;
28861 	lenmult = 2;
28862     }
28863     a1ll_2.lenbr1 = lenmult * a1ll_2.mtrnuml * lenbeat;
28864     r__1 = lenmult * xmtrnum0 * lenbeat;
28865     a1ll_2.lenbr0 = i_nint(&r__1);
28866     a1ll_2.mtrnuml = 0;
28867     if (a1ll_2.lenbr0 != 0) {
28868 	c1omnotes_1.ibaroff = 1;
28869 	a1ll_2.lenbar = a1ll_2.lenbr0;
28870     } else {
28871 	c1omnotes_1.ibaroff = 0;
28872 	a1ll_2.lenbar = a1ll_2.lenbr1;
28873     }
28874     c1omnotes_1.ibarcnt = 0;
28875     c1omnotes_1.nptr[0] = 1;
28876     a1ll_2.iccount = 128;
28877     compage_1.nmovbrk = 0;
28878     compage_1.nflb = 0;
28879     compage_1.nfpb = 0;
28880     compage_1.ipagfpb[0] = 1;
28881     compage_1.isysfpb[0] = 1;
28882     compage_1.ibarflb[0] = 1;
28883     compage_1.isysflb[0] = 1;
28884     compage_1.nistaff[0] = a1ll_2.nv - 1;
28885 
28886 /*  Check for pmx.mod */
28887 
28888     c1omget_1.linesinpmxmod = 0;
28889 /*      line1pmxmod = ilbuf */
28890     getpmxmod_(&c_true, " ", (ftnlen)1);
28891     if (! (*isfirst) && c1omget_1.linesinpmxmod > 0) {
28892 	s_wsle(&io___1162);
28893 	do_lio(&c__9, &c__1, "Sorry, cannot optimize if there is a pmx.mod f"
28894 		"ile", (ftnlen)49);
28895 	e_wsle();
28896 	stop1_();
28897     }
28898 
28899 /*  Initialize for loop over lines */
28900 
28901     comkeys_1.nkeys = 1;
28902     comkeys_1.ibrkch[0] = 1;
28903     comkeys_1.mbrestsav = 0;
28904     comkeys_1.shifton = FALSE_;
28905     a1ll_2.firstline = TRUE_;
28906     a1ll_2.newmeter = FALSE_;
28907     c1omget_1.ihead = 0;
28908     c1omget_1.isheadr = FALSE_;
28909     c1omnotes_1.gotclef = FALSE_;
28910     comkeys_1.idsig = 0;
28911     c1omnotes_1.iddot = 0;
28912     compage_1.fintstf = -1.f;
28913     compage_1.gintstf = 1.f;
28914     listcresc = 0;
28915     listdecresc = 0;
28916 L30:
28917     loop = TRUE_;
28918     comkeys_1.iskchb = FALSE_;
28919     c1omget_1.issegno = FALSE_;
28920     a1ll_2.nbars = 0;
28921     c1omnotes_1.ibarmbr = 0;
28922 /* L3: */
28923     i__1 = a1ll_2.nv;
28924     for (a1ll_2.iv = 1; a1ll_2.iv <= i__1; ++a1ll_2.iv) {
28925 	c1ommvl_1.nvmx[a1ll_2.iv - 1] = 1;
28926 	c1ommvl_1.ivmx[a1ll_2.iv - 1] = a1ll_2.iv;
28927 	a1ll_2.itsofar[a1ll_2.iv - 1] = 0;
28928 	a1ll_2.nnl[a1ll_2.iv - 1] = 0;
28929 	for (j = 1; j <= 200; ++j) {
28930 	    a1ll_2.rest[a1ll_2.iv + j * 24 - 25] = FALSE_;
28931 	    c1ommvl_1.nacc[a1ll_2.iv + j * 24 - 25] = 0.f;
28932 /* L5: */
28933 	}
28934 /* L4: */
28935     }
28936     a1ll_2.iv = 1;
28937     c1ommvl_1.ivx = 1;
28938     c1omget_1.fbon = FALSE_;
28939     comkeys_1.barend = FALSE_;
28940     c1omget_1.isvolt = FALSE_;
28941 L2:
28942     if (loop) {
28943 
28944 /*  Within this short loop, nv voices are filled up for the duration of a block. */
28945 /*  On exit (loop=.false.) the following are set: nnl(nv),itsofar(nv) */
28946 /*  nodur(..),rest(..).  nnl will later be */
28947 /*  increased and things slid around as accidental skips are added. */
28948 
28949 	g1etnote_(&loop, &ifig, optimize, &fulltrans);
28950 	if (c1omget_1.lastchar) {
28951 	    goto L20;
28952 	}
28953 	goto L2;
28954     }
28955     if (comkeys_1.mbrestsav > 0) {
28956 	printl_(" ", (ftnlen)1);
28957 	printl_("You must enter the same multibar rest in ALL parts", (ftnlen)
28958 		50);
28959 	stop1_();
28960     }
28961     i__1 = a1ll_2.nbars;
28962     for (a1ll_2.ibar = 1; a1ll_2.ibar <= i__1; ++a1ll_2.ibar) {
28963 	++c1omnotes_1.ibarcnt;
28964 
28965 /*  The following is just a signal to start a new bar when cataloging spaces */
28966 /*    for catspace(...) */
28967 
28968 	c1omnotes_1.nptr[c1omnotes_1.ibarcnt] = c1omnotes_1.nptr[
28969 		c1omnotes_1.ibarcnt - 1];
28970 	newmb[c1omnotes_1.ibarcnt - 1] = FALSE_;
28971 	if (a1ll_2.newmeter && a1ll_2.ibar == 1) {
28972 	    newmb[c1omnotes_1.ibarcnt - 1] = TRUE_;
28973 	}
28974 
28975 /*  Above is only for spacing calcs later on.  Remember new meter can only occur */
28976 /*  at START of a new input line (ibar = 1) */
28977 
28978 	if (a1ll_2.ibar != c1omnotes_1.ibarmbr) {
28979 	    if (! (*optimize)) {
28980 		i__2 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff;
28981 		outbar_(&i__2, &jprntb);
28982 	    }
28983 	} else {
28984 	    if (! (*optimize)) {
28985 		s_wsfe(&io___1168);
28986 		do_fio(&c__1, " Multibar rest, bars", (ftnlen)20);
28987 		i__2 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff;
28988 		do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
28989 		do_fio(&c__1, "-", (ftnlen)1);
28990 		i__3 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
28991 			c1omnotes_1.mbrest - 1;
28992 		do_fio(&c__1, (char *)&i__3, (ftnlen)sizeof(integer));
28993 		e_wsfe();
28994 		s_wsfe(&io___1169);
28995 		do_fio(&c__1, " Multibar rest, bars", (ftnlen)20);
28996 		i__2 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff;
28997 		do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
28998 		do_fio(&c__1, "-", (ftnlen)1);
28999 		i__3 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
29000 			c1omnotes_1.mbrest - 1;
29001 		do_fio(&c__1, (char *)&i__3, (ftnlen)sizeof(integer));
29002 		e_wsfe();
29003 		jprntb = 0;
29004 	    }
29005 	    c1omnotes_1.ibaroff = c1omnotes_1.ibaroff - c1omnotes_1.mbrest +
29006 		    1;
29007 	}
29008 	if (a1ll_2.firstline && a1ll_2.lenbr0 != 0) {
29009 	    if (a1ll_2.ibar == 1) {
29010 		a1ll_2.lenbar = a1ll_2.lenbr0;
29011 	    } else {
29012 		a1ll_2.lenbar = a1ll_2.lenbr1;
29013 	    }
29014 	}
29015 	if (a1ll_2.ibar > 1) {
29016 
29017 /*  For bars after first, slide all stuff down to beginning of arrays */
29018 
29019 	    i__2 = a1ll_2.nv;
29020 	    for (a1ll_2.iv = 1; a1ll_2.iv <= i__2; ++a1ll_2.iv) {
29021 		i__3 = c1ommvl_1.nvmx[a1ll_2.iv - 1];
29022 		for (kv = 1; kv <= i__3; ++kv) {
29023 		    c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25];
29024 		    ioff = a1ll_2.nib[c1ommvl_1.ivx + (a1ll_2.ibar - 1) * 24
29025 			    - 25];
29026 		    i__4 = a1ll_2.nib[c1ommvl_1.ivx + a1ll_2.ibar * 24 - 25]
29027 			    - ioff;
29028 		    for (ip = 1; ip <= i__4; ++ip) {
29029 			a1ll_2.nodur[c1ommvl_1.ivx + ip * 24 - 25] =
29030 				a1ll_2.nodur[c1ommvl_1.ivx + (ip + ioff) * 24
29031 				- 25];
29032 			a1ll_2.rest[c1ommvl_1.ivx + ip * 24 - 25] =
29033 				a1ll_2.rest[c1ommvl_1.ivx + (ip + ioff) * 24
29034 				- 25];
29035 			c1ommvl_1.nacc[c1ommvl_1.ivx + ip * 24 - 25] =
29036 				c1ommvl_1.nacc[c1ommvl_1.ivx + (ip + ioff) *
29037 				24 - 25];
29038 /* L12: */
29039 		    }
29040 /* L11: */
29041 		}
29042 	    }
29043 	}
29044 	i__3 = a1ll_2.nv;
29045 	for (a1ll_2.iv = 1; a1ll_2.iv <= i__3; ++a1ll_2.iv) {
29046 	    i__2 = c1ommvl_1.nvmx[a1ll_2.iv - 1];
29047 	    for (kv = 1; kv <= i__2; ++kv) {
29048 		ioff = 0;
29049 		if (a1ll_2.ibar > 1) {
29050 		    ioff = a1ll_2.nib[c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25]
29051 			     + (a1ll_2.ibar - 1) * 24 - 25];
29052 		}
29053 /* L67: */
29054 	    }
29055 	}
29056 	makeabar_();
29057 	elsk[c1omnotes_1.ibarcnt - 1] = linecom_1.elskb + c1ommvl_1.fbar;
29058 /* L10: */
29059     }
29060     a1ll_2.newmeter = FALSE_;
29061     a1ll_2.firstline = FALSE_;
29062     goto L30;
29063 L20:
29064 
29065 /* Vertical analysis. */
29066 
29067     if (compage_1.npages == 0) {
29068 	if (compage_1.nsyst == 0) {
29069 	    s_wsle(&io___1174);
29070 	    do_lio(&c__9, &c__1, "When npages=0, must set nsyst=bars/syst, n"
29071 		    "ot 0", (ftnlen)46);
29072 	    e_wsle();
29073 	    stop1_();
29074 	}
29075 	compage_1.nsyst = (c1omnotes_1.ibarcnt - 1) / compage_1.nsyst + 1;
29076 	if (a1ll_2.nv == 1) {
29077 	    nsystpp = 12;
29078 	} else if (a1ll_2.nv == 2) {
29079 	    nsystpp = 7;
29080 	} else if (a1ll_2.nv == 3) {
29081 	    nsystpp = 5;
29082 	} else if (a1ll_2.nv == 4) {
29083 	    nsystpp = 3;
29084 	} else if (a1ll_2.nv <= 7) {
29085 	    nsystpp = 2;
29086 	} else {
29087 	    nsystpp = 1;
29088 	}
29089 	compage_1.npages = (compage_1.nsyst - 1) / nsystpp + 1;
29090     }
29091 
29092 /*  Check nsyst vs ibarcnt */
29093 
29094     if (compage_1.nsyst > c1omnotes_1.ibarcnt) {
29095 	s_wsle(&io___1176);
29096 	e_wsle();
29097 	s_wsle(&io___1177);
29098 	do_lio(&c__9, &c__1, "nsyst,ibarcnt:", (ftnlen)14);
29099 	do_lio(&c__3, &c__1, (char *)&compage_1.nsyst, (ftnlen)sizeof(integer)
29100 		);
29101 	do_lio(&c__3, &c__1, (char *)&c1omnotes_1.ibarcnt, (ftnlen)sizeof(
29102 		integer));
29103 	e_wsle();
29104 	s_wsle(&io___1178);
29105 	do_lio(&c__9, &c__1, "There are more systems than bars.", (ftnlen)33);
29106 	e_wsle();
29107 	s_wsfe(&io___1179);
29108 	do_fio(&c__1, " nsyst,ibarcnt:", (ftnlen)15);
29109 	do_fio(&c__1, (char *)&compage_1.nsyst, (ftnlen)sizeof(integer));
29110 	do_fio(&c__1, (char *)&c1omnotes_1.ibarcnt, (ftnlen)sizeof(integer));
29111 	e_wsfe();
29112 	s_wsfe(&io___1180);
29113 	do_fio(&c__1, " There are more systems than bars.", (ftnlen)34);
29114 	e_wsfe();
29115 	stop1_();
29116     }
29117 
29118 /*  Set up dummy forced line & page breaks after last real one */
29119 
29120     ++compage_1.nflb;
29121     compage_1.ibarflb[compage_1.nflb] = c1omnotes_1.ibarcnt + 1;
29122     compage_1.isysflb[compage_1.nflb] = compage_1.nsyst + 1;
29123     ++compage_1.nfpb;
29124     compage_1.ipagfpb[compage_1.nfpb] = compage_1.npages + 1;
29125     compage_1.isysfpb[compage_1.nfpb] = compage_1.nsyst + 1;
29126     heightil = compage_1.ptheight * 4.f / commus_1.musize;
29127     o__1.oerr = 0;
29128     o__1.ounit = 12;
29129     o__1.ofnm = 0;
29130     o__1.orl = 0;
29131     o__1.osta = "SCRATCH";
29132     o__1.oacc = 0;
29133     o__1.ofm = 0;
29134     o__1.oblnk = 0;
29135     f_open(&o__1);
29136     s_wsfe(&io___1182);
29137     do_fio(&c__1, basenameq, (*lbase));
29138     e_wsfe();
29139     s_wsle(&io___1183);
29140     do_lio(&c__3, &c__1, (char *)&(*lbase), (ftnlen)sizeof(integer));
29141     e_wsle();
29142 
29143 /* Pass to pmxb the initial signature, including effect of transposition. */
29144 
29145     s_wsfe(&io___1184);
29146     do_fio(&c__1, (char *)&c1ommvl_1.fbar, (ftnlen)sizeof(real));
29147     do_fio(&c__1, (char *)&c1omnotes_1.wheadpt, (ftnlen)sizeof(real));
29148     do_fio(&c__1, (char *)&cblock_1.etait, (ftnlen)sizeof(real));
29149     do_fio(&c__1, (char *)&cblock_1.etatc, (ftnlen)sizeof(real));
29150     do_fio(&c__1, (char *)&cblock_1.etacs1, (ftnlen)sizeof(real));
29151     do_fio(&c__1, (char *)&cblock_1.etatop, (ftnlen)sizeof(real));
29152     do_fio(&c__1, (char *)&cblock_1.etabot, (ftnlen)sizeof(real));
29153     do_fio(&c__1, (char *)&cominbot_1.inbothd, (ftnlen)sizeof(integer));
29154     do_fio(&c__1, (char *)&cblock_1.inhnoh, (ftnlen)sizeof(integer));
29155     do_fio(&c__1, (char *)&comkeys_1.isig1, (ftnlen)sizeof(integer));
29156     e_wsfe();
29157     s_wsle(&io___1185);
29158     do_lio(&c__3, &c__1, (char *)&compage_1.npages, (ftnlen)sizeof(integer));
29159     do_lio(&c__4, &c__1, (char *)&compage_1.widthpt, (ftnlen)sizeof(real));
29160     do_lio(&c__4, &c__1, (char *)&compage_1.ptheight, (ftnlen)sizeof(real));
29161     do_lio(&c__4, &c__1, (char *)&compage_1.hoffpt, (ftnlen)sizeof(real));
29162     do_lio(&c__4, &c__1, (char *)&compage_1.voffpt, (ftnlen)sizeof(real));
29163     do_lio(&c__3, &c__1, (char *)&compage_1.nsyst, (ftnlen)sizeof(integer));
29164     e_wsle();
29165     iflbnow = -1;
29166     isysb4 = 0;
29167     i__1 = compage_1.nfpb;
29168     for (ifpb = 1; ifpb <= i__1; ++ifpb) {
29169 
29170 /*  Each time thru this loop is like a single score with several pages */
29171 
29172 	compage_1.npages = compage_1.ipagfpb[ifpb] - compage_1.ipagfpb[ifpb -
29173 		1];
29174 	compage_1.nsyst = compage_1.isysfpb[ifpb] - compage_1.isysfpb[ifpb -
29175 		1];
29176 	nomnsystp = (compage_1.nsyst - 1) / compage_1.npages + 1;
29177 	nshort = nomnsystp * compage_1.npages - compage_1.nsyst;
29178 	i__2 = compage_1.npages;
29179 	for (ipage = 1; ipage <= i__2; ++ipage) {
29180 	    nsystp = nomnsystp;
29181 	    if (ipage <= nshort) {
29182 		--nsystp;
29183 	    }
29184 
29185 /*  Last system number on this page: */
29186 	    isysendpg = isysb4 + nsystp;
29187 	    nintpg = 0;
29188 	    i__3 = isysendpg;
29189 	    for (isy = isysb4 + 1; isy <= i__3; ++isy) {
29190 		if (compage_1.isysflb[iflbnow + 1] == isy) {
29191 		    ++iflbnow;
29192 		}
29193 		nintpg += compage_1.nistaff[iflbnow];
29194 /* L15: */
29195 	    }
29196 	    xilfrac = 0.f;
29197 	    xiltxt = 0.f;
29198 	    if (ipage == 1 && c1omget_1.ihead > 0) {
29199 
29200 /*  Needn't zero out ihead after printing titles if we only allow titles at top? */
29201 
29202 		if ((c1omget_1.ihead & 1) == 1) {
29203 		    xiltxt += cblock_1.hgtin * 4 / commus_1.musize;
29204 		    xilfrac += cblock_1.etait;
29205 		}
29206 		if ((c1omget_1.ihead & 2) == 2) {
29207 		    xiltxt += cblock_1.hgtti * 4 / commus_1.musize;
29208 		    xilfrac += cblock_1.etatc;
29209 		}
29210 		if ((c1omget_1.ihead & 4) == 4) {
29211 		    xiltxt += cblock_1.hgtco * 4 / commus_1.musize;
29212 		    xilfrac += cblock_1.etacs1;
29213 		} else {
29214 
29215 /* Use double the title-composer space if there is no composer */
29216 
29217 		    xilfrac += cblock_1.etatc;
29218 		}
29219 	    }
29220 	    d__ = xilfrac + nsystp - 1 + cblock_1.etatop + cblock_1.etabot;
29221 /*          C = nsystp*(nv-1) */
29222 	    c__ = (real) nintpg;
29223 /*          xN = heightil - xiltxt - 4*nsystp*nv - (nsystp-1)*xilbn */
29224 	    xn = heightil - xiltxt - (nintpg + nsystp << 2) - (nsystp - 1) *
29225 		    cblock_1.xilbn;
29226 	    if (bottreb) {
29227 		xn -= (nsystp - 1) * cblock_1.xilbtc;
29228 	    }
29229 	    if (c1omget_1.ihead == 0 && c1omget_1.isheadr) {
29230 		xn -= cblock_1.xilhdr;
29231 	    }
29232 	    if (ifig == 1) {
29233 		xn -= nsystp * cblock_1.xilfig;
29234 	    }
29235 	    glueil = (xn - cblock_1.b * c__) / (d__ + cblock_1.a * c__);
29236 	    omegag = (cblock_1.b * d__ + cblock_1.a * xn) / (d__ + cblock_1.a
29237 		    * c__);
29238 
29239 /*  G = \interlines between systems */
29240 /*  omega*G = \interlines between staves of the same system */
29241 /*  \interstaff = 4+omega*G */
29242 /*  C = total number of interstaff spaces in the page */
29243 /*  D = omega-indep factors for scalable height = nsy-1 (intersystem glue) */
29244 /*      + etatop + etabot + etatxt + */
29245 /*  N = scaleable height (\interlignes) = height - htext - staff heights - xil */
29246 /*  xil = extra interliges = (nsy-1)*xilbn + 10 if header and no titles */
29247 /*                          + (nsy-1)*xiltcb    for treble clef bottoms */
29248 /*                          + nsy*xilfig        for figures */
29249 /*  G = N/(D + omega * C) = glueil,   (1) */
29250 /*  But (empirically)  omega*G = a*G + b (2) */
29251 /*      with a=1.071 and b=2.714 */
29252 /*  Solving (1) and (2) gives */
29253 /*      G = (N-b*C)/(D+a*C) , omega*G = (b*D+a*N)/(D+a*C) */
29254 /*  Pass to pmxb    omega*G (=\interstaff-4) */
29255 /*                  (etatop,bot,it,tc,cx)*G as inputs to \titles */
29256 
29257 /*       glueil = (heightil-xiltxt-nsystp*(xil+4*nv)) */
29258 /*    *             /(nsystp*(1+gfact*(nv-1))-1+etatop+etabot+xilfrac) */
29259 /*       xnsttop = glueil*etatop */
29260 /*       xintstaff = 4+gfact*glueil */
29261 
29262 /*  Only the first page will get local adjustment now if needed, others in pmxb */
29263 
29264 	    if (ifpb == 1 && ipage == 1 && compage_1.fintstf > 0.f) {
29265 		facins = compage_1.fintstf;
29266 		compage_1.fintstf = -1.f;
29267 	    } else {
29268 
29269 /*  gintstf = 1.0 by default, but may be changed with AI<x> */
29270 
29271 		facins = compage_1.gintstf;
29272 	    }
29273 	    s_wsle(&io___1204);
29274 	    do_lio(&c__3, &c__1, (char *)&nsystp, (ftnlen)sizeof(integer));
29275 /* Computing MAX */
29276 	    r__2 = 0.f, r__3 = cblock_1.etatop * glueil;
29277 	    r__1 = dmax(r__2,r__3);
29278 	    do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real));
29279 	    r__4 = facins * (omegag + 4);
29280 	    do_lio(&c__4, &c__1, (char *)&r__4, (ftnlen)sizeof(real));
29281 	    e_wsle();
29282 	    c1omget_1.ihead = 0;
29283 	    c1omget_1.isheadr = FALSE_;
29284 	    isysb4 = isysendpg;
29285 /* L7: */
29286 	}
29287 /* L8: */
29288     }
29289 
29290 /*  Done with vertical, now do horizontals */
29291 
29292     celsk[1] = elsk[0];
29293     i__1 = c1omnotes_1.ibarcnt;
29294     for (a1ll_2.ibar = 2; a1ll_2.ibar <= i__1; ++a1ll_2.ibar) {
29295 	celsk[a1ll_2.ibar] = celsk[a1ll_2.ibar - 1] + elsk[a1ll_2.ibar - 1];
29296 /* L21: */
29297     }
29298     lastbar[0] = 0;
29299     ibar1 = 1;
29300     wmins = -1.f;
29301     iflb = 1;
29302     imovbrk = 0;
29303     ikey = 1;
29304 
29305 /*  Return nsyst to its *total* value */
29306 
29307     compage_1.nsyst = compage_1.isysfpb[compage_1.nfpb] - 1;
29308     i__1 = compage_1.nsyst;
29309     for (isyst = 1; isyst <= i__1; ++isyst) {
29310 	if (isyst == compage_1.isysflb[iflb]) {
29311 	    ++iflb;
29312 	}
29313 	if (compage_1.nmovbrk > 0 && imovbrk < compage_1.nmovbrk) {
29314 	    if (isyst == compage_1.isysmb[imovbrk + 1]) {
29315 		++imovbrk;
29316 	    }
29317 	}
29318 	ibarb4 = lastbar[isyst - 1];
29319 	if (isyst == 1) {
29320 	    if (*isfirst) {
29321 		elsstarg = celsk[compage_1.ibarflb[1] - 1] / (
29322 			compage_1.isysflb[1] - 1 - c1omget_1.fracindent) * (1
29323 			- c1omget_1.fracindent);
29324 	    }
29325 	    celskb4 = 0.f;
29326 	} else {
29327 	    celskb4 = celsk[ibarb4];
29328 
29329 /*  Must dimension isysmb(0:*) just so I can execute this test! */
29330 
29331 	    if (*isfirst) {
29332 		if (compage_1.nmovbrk > 0 && isyst == compage_1.isysmb[
29333 			imovbrk]) {
29334 
29335 /*  First syst after forced line break.  There may be indentation. */
29336 
29337 		    elsstarg = (celsk[compage_1.ibarflb[iflb] - 1] - celskb4)
29338 			    / (compage_1.isysflb[iflb] - isyst -
29339 			    compage_1.fracsys[imovbrk - 1]) * (1 -
29340 			    compage_1.fracsys[imovbrk - 1]);
29341 		} else {
29342 
29343 /*  There is no indentation to deal with */
29344 
29345 		    elsstarg = (celsk[compage_1.ibarflb[iflb] - 1] - celskb4)
29346 			    / (compage_1.isysflb[iflb] - isyst);
29347 		}
29348 	    }
29349 	}
29350 	if (*isfirst) {
29351 	    diff1 = (r__1 = elsstarg - elsk[ibarb4], dabs(r__1));
29352 	    i__2 = c1omnotes_1.ibarcnt;
29353 	    for (a1ll_2.ibar = ibarb4 + 2; a1ll_2.ibar <= i__2; ++a1ll_2.ibar)
29354 		     {
29355 		diff = elsstarg - (celsk[a1ll_2.ibar] - celskb4);
29356 		if (dabs(diff) >= diff1) {
29357 		    goto L24;
29358 		}
29359 		diff1 = dabs(diff);
29360 /* L23: */
29361 	    }
29362 L24:
29363 	    --a1ll_2.ibar;
29364 	    lastbar[isyst] = a1ll_2.ibar;
29365 	    nbarss[isyst] = a1ll_2.ibar - ibarb4;
29366 	} else {
29367 
29368 /*  nbarss is given as an input, must compute lastbar and ibar */
29369 
29370 	    lastbar[isyst] = nbarss[isyst] + ibarb4;
29371 	    a1ll_2.ibar = lastbar[isyst];
29372 	}
29373 
29374 /*  elss is # of elemskip in the syst. from notes & ars's, not ruleskips, ask's. */
29375 
29376 	elss[isyst - 1] = celsk[a1ll_2.ibar] - celskb4;
29377 	s_wsfe(&io___1219);
29378 	i__2 = lastbar[isyst - 1] + 1;
29379 	do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
29380 	e_wsfe();
29381 
29382 /*  Transposed sigs are isig1, newkey(2,3,...). */
29383 
29384 	if (ikey == 1) {
29385 	    key1 = comkeys_1.isig1;
29386 	} else {
29387 	    key1 = comkeys_1.newkey[ikey - 1];
29388 	}
29389 	fsyst = wclef + abs(key1) * wkeysig + 2.f / commus_1.musize;
29390 	xelsk = 0.f;
29391 L1:
29392 	if (ikey < comkeys_1.nkeys) {
29393 	    if (comkeys_1.ibrkch[ikey] <= lastbar[isyst]) {
29394 
29395 /*  Add space for all key changes */
29396 
29397 		++ikey;
29398 		key2 = comkeys_1.newkey[ikey - 1];
29399 /* Computing MAX */
29400 /* Computing MAX */
29401 		i__5 = abs(key1), i__6 = abs(key2);
29402 		i__3 = (i__2 = key2 - key1, abs(i__2)), i__4 = max(i__5,i__6);
29403 		naccs = max(i__3,i__4);
29404 		fsyst += naccs * wkeysig;
29405 
29406 /*  Account for afterruleskips (fbar) */
29407 
29408 		xelsk += c1ommvl_1.fbar / 2;
29409 		if (comkeys_1.ibrkch[ikey - 1] < lastbar[isyst] && !
29410 			comkeys_1.kchmid[ikey - 1]) {
29411 		    xelsk += -1.f;
29412 		}
29413 		key1 = key2;
29414 		goto L1;
29415 	    }
29416 	}
29417 
29418 /*  Add extra fixed space for double bar */
29419 
29420 	if (isyst == compage_1.nsyst) {
29421 	    fsyst += 4.5f / commus_1.musize;
29422 	}
29423 
29424 /*  Add extra fixed space for initial time signature */
29425 
29426 	if (isyst == 1) {
29427 	    fsyst += wtimesig;
29428 	}
29429 
29430 /*  Add extra fixed space for time signature changes & user-defined spaces */
29431 
29432 	i__2 = lastbar[isyst];
29433 	for (ibars = ibarb4 + 1; ibars <= i__2; ++ibars) {
29434 	    if (newmb[ibars - 1]) {
29435 		fsyst += wtimesig;
29436 	    }
29437 	    fsyst += c1omnotes_1.udsp[ibars - 1] / commus_1.musize;
29438 /* L26: */
29439 	}
29440 	if (isyst == 1) {
29441 	    wdpt = compage_1.widthpt * (1 - c1omget_1.fracindent);
29442 	} else {
29443 	    if (compage_1.nmovbrk > 0 && imovbrk > 0 && isyst ==
29444 		    compage_1.isysmb[imovbrk]) {
29445 		wdpt = compage_1.widthpt * (1 - compage_1.fracsys[imovbrk - 1]
29446 			);
29447 	    } else {
29448 		wdpt = compage_1.widthpt;
29449 	    }
29450 	}
29451 	wsyspt = wdpt - fsyst * commus_1.musize - nbarss[isyst] * .4f;
29452 
29453 /*  Checks for min spacing */
29454 /*  Get min allowable space */
29455 
29456 	dtmin = 1e3f;
29457 	i__2 = ibar1 + nbarss[isyst] - 1;
29458 	for (a1ll_2.ibar = ibar1; a1ll_2.ibar <= i__2; ++a1ll_2.ibar) {
29459 /* Computing MIN */
29460 	    r__1 = dtmin, r__2 = linecom_1.tnminb[a1ll_2.ibar - 1];
29461 	    dtmin = dmin(r__1,r__2);
29462 	    if (c1omnotes_1.wminnh[a1ll_2.ibar - 1] >= 0.f) {
29463 		wmins = c1omnotes_1.wminnh[a1ll_2.ibar - 1];
29464 	    }
29465 /* L45: */
29466 	}
29467 	if (wmins < 0.f) {
29468 	    wmins = .3f;
29469 	}
29470 	wminpt = (wmins + 1) * .3f * commus_1.musize;
29471 
29472 /*  Find max duration & # of notes for this system */
29473 
29474 	dtmax = 0.f;
29475 	nns = 0;
29476 	i__2 = c1omnotes_1.nptr[ibar1 + nbarss[isyst] - 1] - 1;
29477 	for (iptr = c1omnotes_1.nptr[ibar1 - 1]; iptr <= i__2; ++iptr) {
29478 /* Computing MAX */
29479 	    r__1 = dtmax, r__2 = c1omnotes_1.durb[iptr - 1];
29480 	    dtmax = dmax(r__1,r__2);
29481 	    nns += c1omnotes_1.nnpd[iptr - 1];
29482 /* L43: */
29483 	}
29484 	elmin0 = wsyspt * f1eon_(&dtmin) / (elss[isyst - 1] + xelsk);
29485 	if (elmin0 >= wminpt) {
29486 
29487 /*  Subtract out fbar stuff to keep old way of passing sumelsk to pmxb; */
29488 /*    there is no need to "flatten" */
29489 
29490 	    sumelsk = elss[isyst - 1] - c1ommvl_1.fbar * nbarss[isyst];
29491 	    comeon_1.eonk = 0.f;
29492 	    comeon_1.ewmxk = 1.f;
29493 	} else {
29494 	    elmin1 = wsyspt / ((c1ommvl_1.fbar * nbarss[isyst] + xelsk) /
29495 		    f1eon_(&dtmax) + nns);
29496 	    if (elmin1 <= wminpt) {
29497 /*            print* */
29498 /*            print*,'In system #',isyst,' cannot meet min. space rqmt' */
29499 /*            write(15,'(/a,i5,a)') */
29500 /*     *         'In system #',isyst,' cannot meet min. space rqmt' */
29501 		comeon_1.eonk = .9f;
29502 	    } else {
29503 
29504 /*  Find eonk by Newton method */
29505 
29506 /*            eonk = min(.9,(wminpt-elmin0)/(elmin1-elmin0)) */
29507 		i__2 = c1omnotes_1.nptr[ibar1 + nbarss[isyst] - 1] - 1;
29508 		r__1 = wsyspt / wminpt;
29509 		r__2 = c1ommvl_1.fbar * nbarss[isyst] + xelsk;
29510 		r__3 = (wminpt - elmin0) / (elmin1 - elmin0);
29511 		findeonk_(&c1omnotes_1.nptr[ibar1 - 1], &i__2, &r__1, &r__2, &
29512 			dtmin, &dtmax, &r__3);
29513 		comeon_1.eonk = dmin(.9f,comeon_1.eonk);
29514 	    }
29515 	    d__1 = (doublereal) f1eon_(&dtmax);
29516 	    d__2 = (doublereal) comeon_1.eonk;
29517 	    comeon_1.ewmxk = pow_dd(&d__1, &d__2);
29518 
29519 /*  Recompute poenom! */
29520 
29521 	    sumelsk = 0.f;
29522 	    i__2 = c1omnotes_1.nptr[ibar1 + nbarss[isyst] - 1] - 1;
29523 	    for (iptr = c1omnotes_1.nptr[ibar1 - 1]; iptr <= i__2; ++iptr) {
29524 		r__1 = c1omnotes_1.durb[iptr - 1] / c1omnotes_1.sqzb[iptr - 1]
29525 			;
29526 		sumelsk += c1omnotes_1.nnpd[iptr - 1] * c1omnotes_1.sqzb[iptr
29527 			- 1] * feon_(&r__1);
29528 /* L44: */
29529 	    }
29530 	}
29531 	poenom = wsyspt / (sumelsk + c1ommvl_1.fbar * nbarss[isyst] + xelsk);
29532 
29533 /* Set fracindent for output: orig if isyst=1, fracsys(imovbrk) if movbrk, else 0 */
29534 
29535 	if (isyst > 0) {
29536 	    if (compage_1.nmovbrk > 0 && imovbrk > 0 && isyst ==
29537 		    compage_1.isysmb[imovbrk]) {
29538 		c1omget_1.fracindent = compage_1.fracsys[imovbrk - 1];
29539 	    } else {
29540 		c1omget_1.fracindent = 0.f;
29541 	    }
29542 	}
29543 	s_wsfe(&io___1237);
29544 	do_fio(&c__1, (char *)&poenom, (ftnlen)sizeof(real));
29545 	do_fio(&c__1, (char *)&nbarss[isyst], (ftnlen)sizeof(integer));
29546 	do_fio(&c__1, (char *)&sumelsk, (ftnlen)sizeof(real));
29547 	do_fio(&c__1, (char *)&fsyst, (ftnlen)sizeof(real));
29548 	do_fio(&c__1, (char *)&c1omget_1.fracindent, (ftnlen)sizeof(real));
29549 	do_fio(&c__1, (char *)&comeon_1.eonk, (ftnlen)sizeof(real));
29550 	do_fio(&c__1, (char *)&comeon_1.ewmxk, (ftnlen)sizeof(real));
29551 	e_wsfe();
29552 	ibar1 += nbarss[isyst];
29553 /* L22: */
29554     }
29555     al__1.aerr = 0;
29556     al__1.aunit = 12;
29557     f_rew(&al__1);
29558     o__1.oerr = 0;
29559     o__1.ounit = 13;
29560     o__1.ofnm = 0;
29561     o__1.orl = 0;
29562     o__1.osta = "SCRATCH";
29563     o__1.oacc = 0;
29564     o__1.ofm = 0;
29565     o__1.oblnk = 0;
29566     f_open(&o__1);
29567     s_wsfe(&io___1238);
29568     do_fio(&c__1, (char *)&ifig, (ftnlen)sizeof(integer));
29569     e_wsfe();
29570     al__1.aerr = 0;
29571     al__1.aunit = 13;
29572     f_rew(&al__1);
29573     inbuff_1.ilbuf = 1;
29574     inbuff_1.ipbuf = 0;
29575     if (! (*optimize)) {
29576 	s_wsfe(&io___1239);
29577 	do_fio(&c__1, " Done with first pass", (ftnlen)21);
29578 	e_wsfe();
29579 	s_wsle(&io___1240);
29580 	e_wsle();
29581 	s_wsfe(&io___1241);
29582 	do_fio(&c__1, " Done with first pass", (ftnlen)21);
29583 	e_wsfe();
29584 	s_wsfe(&io___1242);
29585 	e_wsfe();
29586     }
29587 
29588 /*  Following syntax is needed since pmxa is called with literal argument .false. */
29589 
29590     if (*isfirst) {
29591 	*isfirst = FALSE_;
29592     }
29593     return 0;
29594 } /* pmxa_ */
29595 
pmxb_(logical * inlast,real * poevec,integer * ncalls,logical * optimize)29596 /* Subroutine */ int pmxb_(logical *inlast, real *poevec, integer *ncalls,
29597 	logical *optimize)
29598 {
29599     /* System generated locals */
29600     address a__1[12], a__2[6], a__3[4], a__4[2], a__5[3], a__6[10], a__7[9],
29601 	    a__8[5], a__9[2], a__10[8], a__11[14];
29602     integer i__1, i__2, i__3[12], i__4[6], i__5[4], i__6[2], i__7, i__8[3],
29603 	    i__9[10], i__10[9], i__11[5], i__12[2], i__13, i__14[8], i__15[14]
29604 	    ;
29605     real r__1, r__2;
29606     char ch__1[1], ch__2[46], ch__3[23], ch__4[26], ch__5[27], ch__6[20],
29607 	    ch__7[29], ch__8[8], ch__9[35], ch__10[14], ch__11[19], ch__12[
29608 	    107], ch__13[12], ch__14[15], ch__15[13], ch__16[9], ch__17[11],
29609 	    ch__18[32], ch__19[10], ch__20[4], ch__21[16], ch__22[33], ch__23[
29610 	    18], ch__24[82], ch__25[66], ch__26[60], ch__27[45], ch__28[6],
29611 	    ch__29[17], ch__30[76], ch__31[40], ch__32[69], ch__33[41],
29612 	    ch__34[44], ch__35[5], ch__36[7], ch__37[24], ch__38[22], ch__39[
29613 	    96];
29614     cilist ci__1;
29615     icilist ici__1;
29616     olist o__1;
29617     cllist cl__1;
29618     alist al__1;
29619 
29620     /* Builtin functions */
29621     integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char
29622 	    *, ftnlen), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen),
29623 	    e_wsfe(void), s_rsfe(cilist *), e_rsfe(void), s_rsle(cilist *),
29624 	    e_rsle(void);
29625     double r_mod(real *, real *);
29626     integer i_nint(real *), pow_ii(integer *, integer *), f_open(olist *);
29627     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
29628     double r_lg10(real *);
29629     integer i_indx(char *, char *, ftnlen, ftnlen);
29630     double r_dim(real *, real *);
29631     integer i_dim(integer *, integer *);
29632     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
29633     integer s_wsfi(icilist *), e_wsfi(void), lbit_shift(integer, integer),
29634 	    f_clos(cllist *), f_rew(alist *);
29635 
29636     /* Local variables */
29637     static integer nbarss;
29638     static real elsktot;
29639     static integer ndigbn, indsym;
29640     extern /* Subroutine */ int wgmeter_(integer *, integer *);
29641     static integer mtrnms;
29642     static real xnstbot;
29643     static integer iptemp, islide, ipnew, iudorn, idynd;
29644     extern /* Subroutine */ int setbits_(integer *, integer *, integer *,
29645 	    integer *);
29646     static integer itxtdyn, isdata, iarps;
29647     extern /* Subroutine */ int make1bar_(integer *, real *, real *, logical *
29648 	    , real *, integer *, integer *, integer *), make2bar_(integer *,
29649 	    real *, real *, logical *, real *, integer *, integer *, integer *
29650 	    , char *, ftnlen);
29651     static real hardb4;
29652     extern /* Subroutine */ int askfig_(char *, integer *, char *, integer *,
29653 	    logical *, logical *, ftnlen, ftnlen);
29654     static real xmtrnum0;
29655     extern integer igetbits_(integer *, integer *, integer *);
29656     extern /* Subroutine */ int newvoice_(integer *, char *, logical *,
29657 	    ftnlen);
29658     static logical lrptpend;
29659     extern /* Subroutine */ int setmeter_(integer *, integer *, integer *,
29660 	    integer *), puttitle_(integer *, real *, real *, char *, real *,
29661 	    real *, real *, integer *, logical *, char *, ftnlen, ftnlen);
29662     static integer iornqnow, i__;
29663     static char basenameq[44], pathnameq[40];
29664     extern /* Subroutine */ int midievent_(char *, integer *, integer *,
29665 	    ftnlen);
29666     static real xintstaff[40];
29667     static integer ia, ig, il, ip, it, kv, ip2, ibc, icc, ipa, ipi;
29668     static real esk;
29669     static char nmq[40];
29670     static integer iiv;
29671     static real poe, frac;
29672     static integer ifig, jfig, ndig;
29673     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
29674     static real hesk[23];
29675     static integer ioff;
29676     extern doublereal feon_(real *);
29677     static char fmtq[24];
29678     static logical loop;
29679     static real hpts[23], wdpt;
29680     static logical lrpt, rrpt;
29681     static integer lnmq, icrd, idyn;
29682     static real tglp1;
29683     extern /* Subroutine */ int stop1_(void);
29684     static logical clchb;
29685     static integer lbase, lclef;
29686     static char charq[1];
29687     static logical clchv[24], slint;
29688     static integer istop[80];
29689     static real squez[80];
29690     static logical ismbr;
29691     static real etait, etatc, etacs1;
29692     static integer nsyst, lpath, iauto;
29693     static real slfac1;
29694     static integer lnote, nclef, ipnow;
29695     extern /* Subroutine */ int linebreakties_(integer *, integer *, integer *
29696 	    , integer *, integer *, logical *, char *, ftnlen);
29697     static real fsyst;
29698     static integer isdat;
29699     extern integer ncmid_(integer *, integer *);
29700     extern /* Subroutine */ int writesetsign_(integer *, integer *, integer *,
29701 	     logical *);
29702     static integer naccs;
29703     static logical evolta;
29704     static integer numbms[24], istart[80];
29705     static logical cwrest[24], svolta;
29706     static char notexq[79];
29707     static logical onvolt;
29708     static real tstart[80];
29709     static logical putmbr;
29710     static real etatop, etabot;
29711     static integer inhnoh;
29712     extern /* Subroutine */ int getset_(integer *, integer *, integer *,
29713 	    integer *, integer *, integer *, real *, integer *, integer *,
29714 	    integer *, real *, logical *, char *, char *, char *, char *,
29715 	    integer *, integer *, ftnlen, ftnlen, ftnlen, ftnlen);
29716     static integer noinst;
29717     static logical istype0;
29718     static integer npages, ibcoff, ibmrep, nhstot, jprntb, nhssys;
29719     extern /* Subroutine */ int addmidi_(integer *, integer *, integer *,
29720 	    integer *, real *, logical *, logical *);
29721     static integer lenbeat;
29722     extern /* Subroutine */ int outbar_(integer *, integer *);
29723     static real ptsndb, ptsndv;
29724     extern /* Subroutine */ int wsclef_(integer *, integer *, char *, integer
29725 	    *, ftnlen), topfile_(char *, integer *, integer *, char *,
29726 	    integer *, integer *, real *, integer *, integer *, logical *,
29727 	    real *, logical *, ftnlen, ftnlen);
29728     static logical ispstie, vshrink;
29729     static integer isyscnt;
29730     static real xntrial;
29731     extern integer ifnodur_(integer *, char *, ftnlen);
29732     static integer isystpg;
29733     extern /* Subroutine */ int getnote_(logical *);
29734     static real ptsdflt;
29735     extern /* Subroutine */ int clefsym_(integer *, char *, integer *,
29736 	    integer *, ftnlen);
29737     static integer islnow, lvoltxt;
29738     static real xnsttop[40];
29739     static integer iplnow;
29740 
29741     /* Fortran I/O blocks */
29742     static cilist io___1243 = { 0, 6, 0, 0, 0 };
29743     static cilist io___1244 = { 0, 6, 0, 0, 0 };
29744     static cilist io___1245 = { 0, 6, 0, 0, 0 };
29745     static cilist io___1246 = { 0, 15, 0, "(a)", 0 };
29746     static cilist io___1249 = { 0, 12, 0, "(a)", 0 };
29747     static cilist io___1251 = { 0, 12, 0, 0, 0 };
29748     static cilist io___1253 = { 0, 12, 0, 0, 0 };
29749     static cilist io___1269 = { 0, 6, 0, 0, 0 };
29750     static cilist io___1270 = { 0, 12, 0, 0, 0 };
29751     static cilist io___1276 = { 0, 13, 0, 0, 0 };
29752     static cilist io___1278 = { 0, 14, 0, "(a)", 0 };
29753     static cilist io___1281 = { 0, 11, 0, "(a)", 0 };
29754     static cilist io___1282 = { 0, 11, 0, "(a)", 0 };
29755     static cilist io___1283 = { 0, 11, 0, "(a)", 0 };
29756     static cilist io___1286 = { 0, 11, 0, "(a)", 0 };
29757     static cilist io___1296 = { 0, 11, 0, "(a)", 0 };
29758     static cilist io___1298 = { 0, 6, 0, "(/,a20,i4,a1,i4)", 0 };
29759     static cilist io___1299 = { 0, 15, 0, "(/,a20,i4,a1,i4)", 0 };
29760     static cilist io___1303 = { 0, 11, 0, "(a)", 0 };
29761     static cilist io___1304 = { 0, 11, 0, "(a14,f4.1,a)", 0 };
29762     static cilist io___1313 = { 0, 11, 0, "(a)", 0 };
29763     static cilist io___1322 = { 0, 11, 0, "(a)", 0 };
29764     static cilist io___1323 = { 0, 11, 0, "(a)", 0 };
29765     static cilist io___1324 = { 0, 12, 0, 0, 0 };
29766     static cilist io___1327 = { 0, 6, 0, 0, 0 };
29767     static cilist io___1328 = { 0, 6, 0, 0, 0 };
29768     static cilist io___1331 = { 0, 11, 0, "(a)", 0 };
29769     static cilist io___1332 = { 0, 11, 0, "(a)", 0 };
29770     static cilist io___1333 = { 0, 11, 0, "(a)", 0 };
29771     static cilist io___1334 = { 0, 11, 0, "(a)", 0 };
29772     static cilist io___1335 = { 0, 11, 0, "(a)", 0 };
29773     static cilist io___1336 = { 0, 11, 0, "(a)", 0 };
29774     static cilist io___1339 = { 0, 11, 0, "(a)", 0 };
29775     static cilist io___1340 = { 0, 11, 0, "(a)", 0 };
29776     static cilist io___1342 = { 0, 11, 0, "(a)", 0 };
29777     static cilist io___1343 = { 0, 11, 0, "(a)", 0 };
29778     static cilist io___1353 = { 0, 11, 0, "(a)", 0 };
29779     static cilist io___1354 = { 0, 12, 0, 0, 0 };
29780     static cilist io___1356 = { 0, 14, 0, "(a9,i2,a10,i2,1x,a4)", 0 };
29781     static cilist io___1359 = { 0, 11, 0, fmtq, 0 };
29782     static cilist io___1361 = { 0, 6, 0, 0, 0 };
29783     static cilist io___1362 = { 0, 6, 0, 0, 0 };
29784     static cilist io___1363 = { 0, 11, 0, "(a)", 0 };
29785     static icilist io___1366 = { 0, nmq+12, 0, "(2i1)", 2, 1 };
29786     static icilist io___1367 = { 0, nmq+12, 0, "(a1,i2,a1,i1)", 5, 1 };
29787     static cilist io___1368 = { 0, 11, 0, "(a)", 0 };
29788     static cilist io___1369 = { 0, 11, 0, "(a18,i1,a2)", 0 };
29789     static cilist io___1370 = { 0, 11, 0, "(a18,i2,a2)", 0 };
29790     static cilist io___1372 = { 0, 11, 0, "(a11,i1,a2)", 0 };
29791     static cilist io___1373 = { 0, 11, 0, "(a11,i2,a2)", 0 };
29792     static cilist io___1374 = { 0, 11, 0, "(a11,i3,a2)", 0 };
29793     static cilist io___1376 = { 0, 11, 0, "(a)", 0 };
29794     static cilist io___1377 = { 0, 11, 0, "(a)", 0 };
29795     static cilist io___1378 = { 0, 11, 0, "(a)", 0 };
29796     static cilist io___1379 = { 0, 11, 0, "(a)", 0 };
29797     static cilist io___1380 = { 0, 11, 0, "(a)", 0 };
29798     static cilist io___1381 = { 0, 11, 0, "(a)", 0 };
29799     static cilist io___1383 = { 0, 11, 0, fmtq, 0 };
29800     static cilist io___1384 = { 0, 11, 0, "(a)", 0 };
29801     static cilist io___1385 = { 0, 11, 0, fmtq, 0 };
29802     static cilist io___1386 = { 0, 11, 0, "(a)", 0 };
29803     static cilist io___1387 = { 0, 11, 0, "(a)", 0 };
29804     static cilist io___1388 = { 0, 11, 0, "(a)", 0 };
29805     static cilist io___1389 = { 0, 11, 0, "(a)", 0 };
29806     static cilist io___1390 = { 0, 11, 0, "(a)", 0 };
29807     static cilist io___1391 = { 0, 11, 0, "(a)", 0 };
29808     static cilist io___1392 = { 0, 11, 0, "(a)", 0 };
29809     static cilist io___1393 = { 0, 11, 0, "(a)", 0 };
29810     static cilist io___1394 = { 0, 11, 0, "(a)", 0 };
29811     static cilist io___1395 = { 0, 11, 0, "(a)", 0 };
29812     static cilist io___1396 = { 0, 11, 0, "(a)", 0 };
29813     static cilist io___1397 = { 0, 11, 0, "(a)", 0 };
29814     static cilist io___1398 = { 0, 11, 0, "(a)", 0 };
29815     static cilist io___1399 = { 0, 11, 0, "(a)", 0 };
29816     static cilist io___1400 = { 0, 11, 0, "(a)", 0 };
29817     static cilist io___1401 = { 0, 11, 0, "(a)", 0 };
29818     static cilist io___1402 = { 0, 11, 0, "(a)", 0 };
29819     static cilist io___1403 = { 0, 11, 0, "(a16,i1,a14)", 0 };
29820     static cilist io___1404 = { 0, 11, 0, "(a)", 0 };
29821     static cilist io___1405 = { 0, 12, 1, 0, 0 };
29822     static cilist io___1408 = { 0, 11, 0, "(a)", 0 };
29823     static cilist io___1409 = { 0, 11, 0, "(a)", 0 };
29824     static cilist io___1410 = { 0, 11, 0, "(a)", 0 };
29825     static cilist io___1412 = { 0, 11, 0, "(a)", 0 };
29826     static cilist io___1413 = { 0, 11, 0, "(a)", 0 };
29827     static cilist io___1414 = { 0, 11, 0, "(a)", 0 };
29828     static cilist io___1415 = { 0, 11, 0, "(a)", 0 };
29829     static cilist io___1416 = { 0, 11, 0, "(a,2i1,a)", 0 };
29830     static cilist io___1417 = { 0, 11, 0, "(a)", 0 };
29831     static cilist io___1418 = { 0, 11, 0, "(a)", 0 };
29832     static cilist io___1434 = { 0, 11, 0, "(a)", 0 };
29833     static cilist io___1435 = { 0, 11, 0, "(a)", 0 };
29834     static cilist io___1443 = { 0, 11, 0, "(a11,f5.1,a4)", 0 };
29835     static cilist io___1444 = { 0, 11, 0, "(a)", 0 };
29836     static cilist io___1445 = { 0, 11, 0, "(a)", 0 };
29837     static cilist io___1446 = { 0, 11, 0, "(a)", 0 };
29838     static cilist io___1447 = { 0, 11, 0, "(a)", 0 };
29839     static cilist io___1448 = { 0, 11, 0, "(a)", 0 };
29840     static cilist io___1449 = { 0, 6, 0, 0, 0 };
29841     static cilist io___1450 = { 0, 6, 0, 0, 0 };
29842     static cilist io___1451 = { 0, 15, 0, 0, 0 };
29843     static cilist io___1452 = { 0, 11, 0, "(a)", 0 };
29844     static cilist io___1453 = { 0, 11, 0, "(a)", 0 };
29845     static cilist io___1454 = { 0, 11, 0, fmtq, 0 };
29846     static cilist io___1455 = { 0, 11, 0, "(a)", 0 };
29847     static cilist io___1456 = { 0, 11, 0, "(a)", 0 };
29848     static cilist io___1457 = { 0, 11, 0, "(a)", 0 };
29849     static cilist io___1458 = { 0, 14, 0, "(a9,i2,a10,i2,1x,a5)", 0 };
29850     static cilist io___1459 = { 0, 6, 0, 0, 0 };
29851     static cilist io___1460 = { 0, 6, 0, 0, 0 };
29852     static cilist io___1461 = { 0, 6, 0, 0, 0 };
29853     static cilist io___1462 = { 0, 15, 0, "(/,a)", 0 };
29854     static cilist io___1463 = { 0, 15, 0, "(a)", 0 };
29855 
29856 
29857 /* ccccccccccccccccccccccccc */
29858 /* c */
29859 /* c To Do */
29860 /* c */
29861 /* c  Resolve disagreement in final poe for 1st system, compared with *.mx2 */
29862 /* c  Shift slurs on right- or left-shifted main notes (2/7/99) */
29863 /* c  Various end-of-input-block repeat problems (ick142.pmx). */
29864 /* c  Force multiplicity for un-beamed xtups. */
29865 /* c  Clef change at end of piece */
29866 /* c  Global "A" option to maximize "X" at a given time tick. */
29867 /* c  Tighten test for end-of-bar hardspace, flgndv(ivx) due to right-shifted */
29868 /* c       note.  See trubl18.pmx */
29869 /* c  Tab character as space. */
29870 /* c  Clef interference with second line of music. */
29871 /* c  Add space for interferences between *different* lines of music? */
29872 /* c  Shift arpeggios, both automatic and manual. */
29873 /* c  Different musicsize for different instruments. */
29874 /* c  Spacing checks for accid's on left-shifted chord notes */
29875 /* c  Spacing checks for double dots */
29876 /* c  Allow forced line breaks w/o setting nsyst. */
29877 /* c  Cresc-Decresc. (Enhance MusiXTeX first?) */
29878 /* c  Dynamic Marks. */
29879 /* c  Bug with Voltas at line end (MusiXTeX problem?). */
29880 /* c  Subtle bug w/ slur hgt over line brk, see trubl15.pmx */
29881 /* c  Stem-end slurs. */
29882 /* c  Allow units in indentation. */
29883 /* c  Make inline TeX more context sensitive. */
29884 /* c  Werner's 4/2/98 problem with "o?" */
29885 /* c  Scor2prt converts e.g. "r0+0" into "r0 0", which seems to be wrong. */
29886 /* c    converts e.g. "r2db" into "r2d", which might be wrong. */
29887 /* c  Werner's generalsignature problem with Key change and new transposition. */
29888 /* c    (wibug8.pmx) */
29889 /* c  Unequal xtuplets */
29890 /* c  Print both sets of bar #'s in tex file. */
29891 /* c  Make barlines invisible \def\xbar{\empty} , fix fbar. */
29892 /* c  Auto-tie slurs  'At' */
29893 /* c  Forced line break anywhere (e.g. at a mid-bar repeat). */
29894 /* c  Clef change at very start of file. */
29895 /* c  Tighten test for M as macro terminator. */
29896 /* c  Fix title so not separate limit on author length + composer length. */
29897 /* c  Arpeggios in xtups. */
29898 /* c */
29899 /* c mx10b */
29900 /* c  Option for instrument name at top center. Last item in P command: */
29901 /* c    P[n]c         text is instrument name (use in parts) */
29902 /* c    P[n]cstuff    text is stuff (up to 1st blank) */
29903 /* c    P[n]c"stuff with spaces"   text is stuff with spaces */
29904 /* c */
29905 /* c Post version 1.43 */
29906 /* c  Reduced space rqmt for multiplicity-0 graces (no flag) */
29907 /* c  Removed last sepsym in centered whole-bar rests, fixes volta height bug. */
29908 /* c */
29909 /* c Version 1.43 */
29910 /* c  Fix spacing for end-of-line signature change. */
29911 /* c  Adjust left-shift of grace group for shifted accidentals. */
29912 /* c  Put in extra space for left-shifted accidentals. */
29913 /* c  Fix bug with dot-shift before accid-shift on chord note. */
29914 /* c  Space-check for right-shifted main notes. */
29915 /* c  Enable forcing stem direction of single notes in non-beamed xtups. */
29916 /* c  Disallow clef change after last note before end of input block (pmxa) */
29917 /* c  Print meter change before page break */
29918 /* c  increase length of strings for \titles macro */
29919 /* c version 1.42 */
29920 /* c  Loosen up input syntax for "X" commands.  Subroutine getx() */
29921 /* c  "B" and "P" in "X" commands */
29922 /* c mx09b */
29923 /* c  Allow multiple rests at start of xtup */
29924 /* c  Add 64th rest */
29925 /* c  Fix xtup numbers over rests. (subroutine levrn) */
29926 /* c  Initialize notcrd=.false. every gulp. Avoids undefined state with e.g. */
29927 /* c    c za / ( c a ... */
29928 /* c  Allow double dots to be shifted. */
29929 /* c  Fix spacing with double dotted notes; permit splitting small note. */
29930 /* c  Fix \dotted printout so it works with old compiler */
29931 /* c mx08b */
29932 /* c  Automatic spaces if needed for shifted accidentals. */
29933 /* c  Some Dynamics */
29934 /* c  Increase accid. horiz. shift resolution to .o5 (use one more bit in nacc) */
29935 /* c version 1.41 */
29936 /* c  Allow ":" as last char of path name */
29937 /* c  Dotted slurs "sb" */
29938 /* c  Continue bar numbering at movement break "L[integer]Mc" */
29939 /* c mx07b */
29940 /* c  Whole-bar rests with double lines of music.  Fixed all options ? */
29941 /* c  Shift accidentals, either [+|-][integer][+|-][number] or [<|>][number]. */
29942 /* c  Option to suppress centering full-bar rests. "o" */
29943 /* c mx06b */
29944 /* c  Shift accid on left-shifted chord note. */
29945 /* c  Rest as first note of xtup. */
29946 /* c  Wrong slopes with small widths.  Scale slfac1 by widthpt_default/widthpt */
29947 /* c  Allow Rb for single bar at movemnet break or end of piece. (islur(25)) */
29948 /* c  Change # of inst at a movement break.  noinst is total # and must be used */
29949 /* c    in 1st movement.  ninow is current.  nspern(1,...,ninow) is current */
29950 /* c    staves/inst, nsperi(1,...,noinst) is original.  rename tells whether to */
29951 /* c    reprint names in parindent at a movement break.  Default is .false. */
29952 /* c    unless ninow changes, then .true.  But can force either with r+/- as */
29953 /* c    option in 'M' */
29954 /* c mx04b */
29955 /* c  Double-dotted notes, separate+beamed, main+chord, still no extra space. */
29956 /* c  ???  Don't shift slur ends on whole notes. */
29957 /* c  (pmxa) Write line number of error in pmxaerr.dat */
29958 /* c mx02b */
29959 /* c  Admit "RD" before "/" (search for "rptfq2:" ) */
29960 /* c  In doslur, for multi-line staves, single notes, check forced stem dir'n */
29961 /* c    before setting stemup (used to set horiz offset). */
29962 /* cccccccccccccccccccccccccccccc */
29963 
29964 /*  FYI /all/ differs in appearance in function ncmid */
29965 
29966 /* cccccccccccc */
29967 /* c  islur  cc */
29968 /* cccccccccccc */
29969 /*  bit  meaning */
29970 /*  0     slur activity on this note */
29971 /*  1     t-slur here. */
29972 /*  2     force 0-slope beam starting on this note */
29973 /*  3     Double dotted note! */
29974 /*  4     grace before main note */
29975 /*  5     left repeat */
29976 /*  6     right repeat */
29977 /*  7     start Volta */
29978 /*  8     doublebar */
29979 /*  9     end Volta */
29980 /*  10    on=>endvoltabox */
29981 /*  11    on=>clefchange */
29982 /*  12-14 0=>treble, ... , 6=>bass */
29983 /*  15    on=> start new block for clef change (maybe diff. voice) */
29984 /*  16    literal TeX string */
29985 /*  17    1=up, 0=down stem for single note (override) See bit 30! */
29986 /*  18    if on, prohibit beaming */
29987 /*  19    if on, full bar rest as pause */
29988 /*  20    Beam multiplicity down-up */
29989 /*  21    Forced multiplicity for any beam including xtups */
29990 /*  22-24 Value of forced multiplicity */
29991 /*  25    single barline at movement break */
29992 /*  26    doubleBAR (see bits 5,6,8) */
29993 /*  27-28 Forced beam fine-tune height (1 to 3) */
29994 /*  29    Blank rest */
29995 /*  30    If on, get stem dir'n from bit 17 */
29996 /*  31    If on, suppress printing number with xtuplet starting here */
29997 /* cccccccccccc */
29998 /* c  ipl    cc */
29999 /* cccccccccccc */
30000 /* c  0-7   Location in list [0,200] */
30001 /*  0-7   Unused */
30002 /*  8     left offset main note one headwidth */
30003 /*  9     right offset main note one headwidth */
30004 /*  10    chord present? */
30005 /*  11-16 Forced beam height adjustment (-30 to +30) */
30006 /*  17-22 Forced beam slope adjustment (-30 to +30) */
30007 /*  23-26 Slur index for Way-after grace.  Inserted when slur is started. */
30008 /* c  27      Unused? */
30009 /*  27 5th bit for slur index for Way-after grace (100712) */
30010 /*  28    key change: only in voice 1 */
30011 /*  29    Grace after main note. (Type A) */
30012 /*  30    In forced beam.  Signals need to check beam heights */
30013 /*  31    Grace way after main note. (stretch to next note, type W) */
30014 /* cccccccccccc */
30015 /* c  iornq  cc */
30016 /* cccccccccccc */
30017 /*  0     Ornament "(".  Was user-defined horizontal slur shift on this note */
30018 /*               until 9/24/97; changed that to irest(21) */
30019 /*  1-13  stmgx+Tupf._) */
30020 /*  14    Down fermata, was F */
30021 /*  15    Trill w/o "tr", was U */
30022 /*  16-18 Editorial s,f,n */
30023 /*  19-20 >^ */
30024 /*  21    "?" for editorial accid, w/ or w/o s,f,n */
30025 /*  22    Set if ihornb governs ornament height.  Same in icrdorn. */
30026 /*  23    Set in getorn if ANY note at time of this main note has ornament. */
30027 /*             This is ONLY used in beamstrt to signal whether to do more */
30028 /*             tests for whether ihornb is needed.  (ihornb is only needed */
30029 /*             if nonchord+upbm, chord+upbm+top_note, chord+dnbm+bot_note) */
30030 /*     (7/1/00)Also set if any dynamic, as ihornb will be needed when dnbm. */
30031 /*  24    Slur on after or way-after grace.  Use as signal to START slur. */
30032 /*  25    Tweak orn ht. Same in icrdorn for chord note */
30033 /*  26    Insert user-defined space before this note (was 22) */
30034 /*  27    Arpeggio stop or start (if 2 at same time), or all-in-this-chord */
30035 /*  28    caesura or breath */
30036 /*  29    blank barline (must be iv=1) (would have used islur but no room) */
30037 /*  30    "Look-left" option for keyboard rest */
30038 /*  31    Set if any note (main or chord) has cautionary accid, for space checks */
30039 /* cccccccccccc */
30040 /* c  irest  cc */
30041 /* cccccccccccc */
30042 /*  0        rest=1, no rest = 0 */
30043 /*  1        There will be a vertical shift for number of this xtup */
30044 /*  2-6      Height shift, 1 => -15, 31 => +15  Indicate by +/- [n] after 'n' */
30045 /*  7        There is a horizontal shift for xtup number */
30046 /*  9-13     Horiz shift, 1=>-1.5, ... , 31=>+1.5 */
30047 /*  14       Flip up/down-ness of xtup number */
30048 /*  15       Single-voice, single note shift  X(...)[p]S */
30049 /*  16       Start single-voice, multinote shift with this note X(...)[p]: */
30050 /*  17       End single-voice, multinote shift after this note. Enter symbol */
30051 /*              after note. X: */
30052 /*  18       User-defined hardspace after last note of bar, *after* this note. */
30053 /*              Value still stored in udoff(ivx,nudoff(ivx)), not with other */
30054 /*              hardspaces in udsp, to avoid confusion with time checks. */
30055 /*  19       Move the dot.  Data stored in ndotmv,updot,rtdot */
30056 /*  20       Set if right-shifted main or chord note here.  Use for space checks. */
30057 /*  21       User-defined hardspace in xtup */
30058 /*  22       User-defined slur shift horizontal slur shift. */
30059 /*  23       Set on last note before staff-jumping a beam. */
30060 /*  24       Set on first note after staff-jumping a beam */
30061 /*  25       Suppress rest centering. "ro" */
30062 /*  26       Dynamic on this note */
30063 /*  27       Set if left-shifted main or chord note here.  Use for space checks. */
30064 /*  28       Set if xtup starts on this note. */
30065 /*  29       Set on lowest-voice note at same time as 1st note after jump-beam. */
30066 /*  30       Set on note after end of jump-beam segment, to force new note group */
30067 /*  31       Flag for cautionary accidental */
30068 /* cccccccccccc */
30069 /* c  nacc   cc */
30070 /* cccccccccccc */
30071 /*  0-1      0=no accid, 1=fl, 2=sh, 3=na */
30072 /*  2        double */
30073 /*  3        big */
30074 /*  4-9      vertshift-32 */
30075 /*  10-16    20*(horiz. shift + 5.35) (Recentered ver 2.32) */
30076 /*  17       Midi-only accidental */
30077 /*  18       2:1 xtup */
30078 /*  19       Together with nacc(18), increase multiplicity by 1 and dot 1st note. */
30079 /*  20       Set on last note of each seg except last seg of single-slope beam. */
30080 /*  21       Set on 1st note of each seg except 1st seg of single-slope beam. */
30081 /*  22-26    If .ne.0, printed xtup number for xtup starting on this note. */
30082 /*  27       Set for dotted xtup note.  Mult dur by 1.5, mult next by .5 & increase */
30083 /*             multiplicity by 1 */
30084 /*  28       Set on main note of chord if accidentals are ordered. */
30085 /*  29       Tag for chordal accidental shift...means add to autoshifts. */
30086 /*  30-31    Set 30|31 if main note in a chord is part of a 2nd and needs to be shifted. */
30087 /*             If upstem|downstem, main is upper|lower member of 2nd */
30088 /*             Action is to interchange pitches only when notes are placed. */
30089 /* cccccccccccc */
30090 /* c  mult   cc */
30091 /* cccccccccccc */
30092 /*  0-3      Multiplicity+8 (mult= # of flags) */
30093 /*  4        Set if slope adjustment for xtup bracket */
30094 /*  5-9      16+slope adjustment */
30095 /*  27       Stemlength override */
30096 /*  28-30    New stem length. */
30097 /* cccccccccccc */
30098 /* c  isdat1 cc */
30099 /* cccccccccccc */
30100 /*  13-17    iv */
30101 /*  3-10     ip */
30102 /*  11       start/stop switch */
30103 /*  12       kv-1 */
30104 /*  19-25    ichar(code$) */
30105 /*  26       force direction? */
30106 /*  27       forced dir'n = up if on, set in sslur; also */
30107 /*           final direction, set in doslur when beam is started, used on term. */
30108 /*  28-31    ndxslur, set in doslur when beam is started, used on term. */
30109 /* cccccccccccc */
30110 /* c  isdat2 cc */
30111 /* cccccccccccc */
30112 /*  0        Chord switch.  Not set on main note. */
30113 /*  1-2      left/right notehead shift.  Set only for chord note. */
30114 /*  3        tie positioning */
30115 /*  4        dotted slur */
30116 /*  6-11     voff1 1-63  =>  -31...+31 */
30117 /*  12-18    hoff1 1-127 => -6.3...+6.3 */
30118 /*  19-25    nolev */
30119 /*  26       \sluradjust    (p+s) */
30120 /*  27       \nosluradjust  (p-s) */
30121 /*  28       \tieadjust     (p+t) */
30122 /*  29       \notieadjust   (p-t) */
30123 /* cccccccccccc */
30124 /* c  isdat3 cc */
30125 /* cccccccccccc */
30126 /*  0        set if midslur (at least one argument) */
30127 /*  1        set if curve (2 more args) */
30128 /*  2-7      32+first arg (height correction) (1st arg may be negative) */
30129 /*  8-10     second arg (initial slope) */
30130 /*  11-13    third arg (closing slope) */
30131 /*  14-21    tie level for use in LineBreakTies */
30132 /*  22-29    ncm for use in LineBreakTies */
30133 /* cccccccccccc */
30134 /* c  isdat4 cc  Set these all at turn-on using s option */
30135 /* cccccccccccc */
30136 /*  0-5      Linebreak seg 1 voff 1-63  =>  -31...+31 */
30137 /*  6-12     Linebreak seg 1 hoff 1-127 => -6.3...+6.3 */
30138 /*  16-21    Linebreak seg 2 voff 1-63  =>  -31...+31 */
30139 /*  22-28    Linebreak seg 2 hoff 1-127 => -6.3...+6.3 */
30140 /* cccccccccccc */
30141 /*  icrdat   c */
30142 /* cccccccccccc */
30143 /*     0-7   ip within voice */
30144 /*     8-11  ivx (together with 28th bit) */
30145 /*     12-18 note level */
30146 /*     19    accidental? */
30147 /*     20-22 accidental value (1=natural, 2=flat, 3=sharp, 6=dflat, 7=dsharp) */
30148 /*     23    shift left */
30149 /*     24    shift right */
30150 /*     25    arpeggio start or stop */
30151 /*     26    flag for moved dot (here, not icrdot, since this is always reset!) */
30152 /*     27    Midi-only accidental */
30153 /*     28    (6/27/10) 5th bit for ivx, to allow up to 24 voices */
30154 /*     29    Tag for accidental shift...means add to autoshifts. */
30155 /*     31    Flag for cautionary accidental on chord note */
30156 /* cccccccccccc */
30157 /*  icrdot   c: */
30158 /* cccccccccccc */
30159 /*     0-6   10*abs(vertical dot shift in \internote) + 64 */
30160 /*     7-13  10*abs(horizontal dot shift in \internote) + 64 */
30161 /*     14-19 vert accidental shift-32 */
30162 /*     20-26 20*(horiz accidental shift+3.2) */
30163 /*     27-29 top-down level rank of chord note w/accid. Set in crdaccs. */
30164 
30165 /*  Bits in icrdorn are same as in iornq, even tho most orns won't go in crds. */
30166 
30167 /* ccccccccccccccccccccccccccccccc */
30168     /* Parameter adjustments */
30169     --poevec;
30170 
30171     /* Function Body */
30172     if (! (*optimize)) {
30173 	s_wsle(&io___1243);
30174 	e_wsle();
30175 	s_wsle(&io___1244);
30176 	do_lio(&c__9, &c__1, "Starting second PMX pass", (ftnlen)24);
30177 	e_wsle();
30178 	s_wsle(&io___1245);
30179 	e_wsle();
30180 	s_wsfe(&io___1246);
30181 	do_fio(&c__1, "Starting second PMX pass", (ftnlen)24);
30182 	e_wsfe();
30183     }
30184     ++(*ncalls);
30185     comlast_1.islast = *inlast;
30186     commac_1.macuse = 0;
30187     isyscnt = 0;
30188     all_1.stemmax = 8.2f;
30189     all_1.stemmin = 3.9f;
30190     all_1.stemlen = 6.f;
30191     chax_(ch__1, (ftnlen)1, &c__92);
30192     *(unsigned char *)all_1.sq = *(unsigned char *)&ch__1[0];
30193     comignorenats_1.ignorenats = FALSE_;
30194     combc_1.bcspec = TRUE_;
30195     comas3_1.topmods = FALSE_;
30196     ismbr = FALSE_;
30197     s_rsfe(&io___1249);
30198     do_fio(&c__1, basenameq, (ftnlen)44);
30199     e_rsfe();
30200     s_rsle(&io___1251);
30201     do_lio(&c__3, &c__1, (char *)&lbase, (ftnlen)sizeof(integer));
30202     e_rsle();
30203     s_rsle(&io___1253);
30204     do_lio(&c__4, &c__1, (char *)&comask_1.fbar, (ftnlen)sizeof(real));
30205     do_lio(&c__4, &c__1, (char *)&comask_1.wheadpt, (ftnlen)sizeof(real));
30206     do_lio(&c__4, &c__1, (char *)&etait, (ftnlen)sizeof(real));
30207     do_lio(&c__4, &c__1, (char *)&etatc, (ftnlen)sizeof(real));
30208     do_lio(&c__4, &c__1, (char *)&etacs1, (ftnlen)sizeof(real));
30209     do_lio(&c__4, &c__1, (char *)&etatop, (ftnlen)sizeof(real));
30210     do_lio(&c__4, &c__1, (char *)&etabot, (ftnlen)sizeof(real));
30211     do_lio(&c__3, &c__1, (char *)&cominbot_1.inbothd, (ftnlen)sizeof(integer))
30212 	    ;
30213     do_lio(&c__3, &c__1, (char *)&inhnoh, (ftnlen)sizeof(integer));
30214     do_lio(&c__3, &c__1, (char *)&comtop_1.isig, (ftnlen)sizeof(integer));
30215     e_rsle();
30216     inbuff_1.ilbuf = 1;
30217     inbuff_1.ipbuf = 0;
30218     getset_(&all_1.nv, &noinst, &all_1.mtrnuml, &all_1.mtrdenl, &all_1.mtrnmp,
30219 	     &all_1.mtrdnp, &xmtrnum0, &npages, &nsyst, &all_1.musicsize, &
30220 	    comtop_1.fracindent, &istype0, comtop_1.inameq, comclefq_1.clefq,
30221 	    all_1.sepsymq, pathnameq, &lpath, &comtop_1.isig0, (ftnlen)79, (
30222 	    ftnlen)1, (ftnlen)1, (ftnlen)40);
30223     if (commidi_1.ismidi) {
30224 
30225 /*  Initial key signature and meter for pickup bar */
30226 /*  130313 Unless explicit miditranspose for all parts (to be dealt with later), */
30227 /*    want concert sig (isig0) here. K+n+m will have changed sig to isig */
30228 /*        call midievent('k',isig,0) */
30229 /* 130316 */
30230 /*        call midievent('k',isig0,0) */
30231 /*        call midievent('k',midisig,0) */
30232 
30233 /*  Above is probably cosmetic */
30234 /*        call midievent('k',midisig,0) */
30235 	if (xmtrnum0 > comtol_1.tol) {
30236 
30237 /*  We have a pickup.  Some tricky stuff to get a meter: */
30238 
30239 	    xntrial = xmtrnum0;
30240 	    for (ip2 = 0; ip2 <= 5; ++ip2) {
30241 		if ((r__1 = r_mod(&xntrial, &c_b807), dabs(r__1)) <
30242 			comtol_1.tol) {
30243 		    goto L6;
30244 		}
30245 		xntrial *= 2;
30246 /* L5: */
30247 	    }
30248 	    s_wsle(&io___1269);
30249 	    do_lio(&c__9, &c__1, "Problem finding meter for pickup bar", (
30250 		    ftnlen)36);
30251 	    e_wsle();
30252 	    xntrial = 1.f;
30253 	    ip2 = 0;
30254 L6:
30255 	    i__1 = i_nint(&xntrial);
30256 	    i__2 = pow_ii(&c__2, &ip2) * all_1.mtrdenl;
30257 	    midievent_("m", &i__1, &i__2, (ftnlen)1);
30258 	} else {
30259 
30260 /*  No pickup, enter the starting meter */
30261 
30262 	    midievent_("m", &all_1.mtrnuml, &all_1.mtrdenl, (ftnlen)1);
30263 	}
30264     }
30265 
30266 /*  Set musicsize from value passed in common, due to possible reset by S[n]m16 */
30267 
30268     all_1.musicsize = commus_1.musize;
30269     s_rsle(&io___1270);
30270     do_lio(&c__3, &c__1, (char *)&npages, (ftnlen)sizeof(integer));
30271     do_lio(&c__4, &c__1, (char *)&comtop_1.widthpt, (ftnlen)sizeof(real));
30272     do_lio(&c__4, &c__1, (char *)&comtop_1.height, (ftnlen)sizeof(real));
30273     do_lio(&c__4, &c__1, (char *)&comtop_1.hoffpt, (ftnlen)sizeof(real));
30274     do_lio(&c__4, &c__1, (char *)&comtop_1.voffpt, (ftnlen)sizeof(real));
30275     do_lio(&c__3, &c__1, (char *)&nsyst, (ftnlen)sizeof(integer));
30276     i__1 = npages;
30277     for (ipa = 1; ipa <= i__1; ++ipa) {
30278 	do_lio(&c__3, &c__1, (char *)&comnotes_1.nsystp[ipa - 1], (ftnlen)
30279 		sizeof(integer));
30280 	do_lio(&c__4, &c__1, (char *)&xnsttop[ipa - 1], (ftnlen)sizeof(real));
30281 	do_lio(&c__4, &c__1, (char *)&xintstaff[ipa - 1], (ftnlen)sizeof(real)
30282 		);
30283     }
30284     do_lio(&c__3, &c__1, (char *)&iauto, (ftnlen)sizeof(integer));
30285     e_rsle();
30286 
30287 /*  If default width ever changes, must adjust this stmt. */
30288 
30289     slfac1 = 2.98156f / comtop_1.widthpt;
30290     all_1.figbass = FALSE_;
30291     s_rsle(&io___1276);
30292     do_lio(&c__3, &c__1, (char *)&ifig, (ftnlen)sizeof(integer));
30293     e_rsle();
30294     if (ifig == 1) {
30295 	all_1.figbass = TRUE_;
30296 	o__1.oerr = 0;
30297 	o__1.ounit = 14;
30298 	o__1.ofnm = 0;
30299 	o__1.orl = 0;
30300 	o__1.osta = "SCRATCH";
30301 	o__1.oacc = 0;
30302 	o__1.ofm = 0;
30303 	o__1.oblnk = 0;
30304 	f_open(&o__1);
30305 	s_wsfe(&io___1278);
30306 /* Writing concatenation */
30307 	i__3[0] = 1, a__1[0] = all_1.sq;
30308 	i__3[1] = 3, a__1[1] = "def";
30309 	i__3[2] = 1, a__1[2] = all_1.sq;
30310 	i__3[3] = 8, a__1[3] = "fixdrop{";
30311 	i__3[4] = 1, a__1[4] = all_1.sq;
30312 	i__3[5] = 7, a__1[5] = "advance";
30313 	i__3[6] = 1, a__1[6] = all_1.sq;
30314 	i__3[7] = 10, a__1[7] = "sysno by 1";
30315 	i__3[8] = 1, a__1[8] = all_1.sq;
30316 	i__3[9] = 6, a__1[9] = "ifcase";
30317 	i__3[10] = 1, a__1[10] = all_1.sq;
30318 	i__3[11] = 6, a__1[11] = "sysno%";
30319 	s_cat(ch__2, a__1, i__3, &c__12, (ftnlen)46);
30320 	do_fio(&c__1, ch__2, (ftnlen)46);
30321 	e_wsfe();
30322     }
30323     comget_1.lastchar = FALSE_;
30324     ibcoff = 0;
30325     if (xmtrnum0 > 0.f) {
30326 	ibcoff = -1;
30327     }
30328     o__1.oerr = 0;
30329     o__1.ounit = 11;
30330     o__1.ofnm = 0;
30331     o__1.orl = 0;
30332     o__1.osta = "SCRATCH";
30333     o__1.oacc = 0;
30334     o__1.ofm = 0;
30335     o__1.oblnk = 0;
30336     f_open(&o__1);
30337 
30338 /*  vshrink for the first page is calculated in topfile, */
30339 /*  and if true set interstaff=10.  vshrink affects Titles. */
30340 /*  Must also save vshrink for page ending. */
30341 
30342     topfile_(basenameq, &lbase, &all_1.nv, comclefq_1.clefq, &noinst, &
30343 	    all_1.musicsize, xintstaff, &all_1.mtrnmp, &all_1.mtrdnp, &
30344 	    vshrink, &comask_1.fbar, &comslur_1.fontslur, (ftnlen)44, (ftnlen)
30345 	    1);
30346 
30347 /*  ninow is working value of # of instruments.  noinst is max #, and # at start. */
30348 
30349     comnotes_1.ninow = noinst;
30350 
30351 /*  Save original printed meter in case movement breaks */
30352 
30353     comget_1.movnmp = all_1.mtrnmp;
30354     comget_1.movdnp = all_1.mtrdnp;
30355 
30356     if (comlast_1.islast && all_1.figbass && all_1.musicsize == 16) {
30357 	s_wsfe(&io___1281);
30358 /* Writing concatenation */
30359 	i__4[0] = 1, a__2[0] = all_1.sq;
30360 	i__4[1] = 3, a__2[1] = "def";
30361 	i__4[2] = 1, a__2[2] = all_1.sq;
30362 	i__4[3] = 8, a__2[3] = "figfont{";
30363 	i__4[4] = 1, a__2[4] = all_1.sq;
30364 	i__4[5] = 9, a__2[5] = "eightrm}%";
30365 	s_cat(ch__3, a__2, i__4, &c__6, (ftnlen)23);
30366 	do_fio(&c__1, ch__3, (ftnlen)23);
30367 	e_wsfe();
30368     }
30369 
30370     if (comlast_1.islast && comligfont_1.isligfont) {
30371 	if (all_1.musicsize == 16) {
30372 	    s_wsfe(&io___1282);
30373 /* Writing concatenation */
30374 	    i__5[0] = 1, a__3[0] = all_1.sq;
30375 	    i__5[1] = 4, a__3[1] = "font";
30376 	    i__5[2] = 1, a__3[2] = all_1.sq;
30377 	    i__5[3] = 20, a__3[3] = "ligfont=cmrj at 8pt%";
30378 	    s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)26);
30379 	    do_fio(&c__1, ch__4, (ftnlen)26);
30380 	    e_wsfe();
30381 	} else {
30382 	    s_wsfe(&io___1283);
30383 /* Writing concatenation */
30384 	    i__5[0] = 1, a__3[0] = all_1.sq;
30385 	    i__5[1] = 4, a__3[1] = "font";
30386 	    i__5[2] = 1, a__3[2] = all_1.sq;
30387 	    i__5[3] = 21, a__3[3] = "ligfont=cmrj at 10pt%";
30388 	    s_cat(ch__5, a__3, i__5, &c__4, (ftnlen)27);
30389 	    do_fio(&c__1, ch__5, (ftnlen)27);
30390 	    e_wsfe();
30391 	}
30392     }
30393     lenbeat = ifnodur_(&all_1.mtrdenl, "x", (ftnlen)1);
30394     if (all_1.mtrdenl == 2) {
30395 	lenbeat = 16;
30396     }
30397     all_1.lenb1 = all_1.mtrnuml * lenbeat;
30398     if (all_1.mtrdenl == 2) {
30399 	all_1.lenb1 <<= 1;
30400     }
30401     setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &combeam_1.ibmtyp, &ibmrep);
30402     r__1 = xmtrnum0 * lenbeat;
30403     all_1.lenb0 = i_nint(&r__1);
30404     if (all_1.mtrdenl == 2) {
30405 	all_1.lenb0 <<= 1;
30406     }
30407     if (all_1.lenb0 != 0) {
30408 	if (comlast_1.islast) {
30409 	    s_wsfe(&io___1286);
30410 /* Writing concatenation */
30411 	    i__5[0] = 1, a__3[0] = all_1.sq;
30412 	    i__5[1] = 7, a__3[1] = "advance";
30413 	    i__5[2] = 1, a__3[2] = all_1.sq;
30414 	    i__5[3] = 11, a__3[3] = "barno by -1";
30415 	    s_cat(ch__6, a__3, i__5, &c__4, (ftnlen)20);
30416 	    do_fio(&c__1, ch__6, (ftnlen)20);
30417 	    e_wsfe();
30418 	}
30419 	all_1.lenbar = all_1.lenb0;
30420     } else {
30421 	all_1.lenbar = all_1.lenb1;
30422     }
30423 
30424 /*  Initialize full-program variables */
30425 
30426     comask_1.fixednew = 0.f;
30427     comask_1.scaldold = 0.f;
30428     comget_1.fintstf = -1.f;
30429     comget_1.gintstf = 1.f;
30430     comas2_1.nasksys = 0;
30431     combibarcnt_1.ibarcnt = 0;
30432     all_1.iline = 0;
30433     comget_1.movbrk = 0;
30434     isystpg = 0;
30435     comnotes_1.ipage = 1;
30436     all_1.iccount = 128;
30437     comas3_1.iask = 0;
30438     nhstot = 0;
30439     comnsp_2.nb = 1;
30440     if (! (*optimize)) {
30441 	jprntb = 81;
30442     }
30443     comtop_1.idsig = 0;
30444 
30445 /*  Next 5 are raise-barno parameters.  irzbnd is integer part of default level. */
30446 
30447     comsln_1.irzbnd = 3;
30448     if (comtop_1.isig == 3 && *(unsigned char *)&comclefq_1.clefq[all_1.nv -
30449 	    1] == 't') {
30450 	comsln_1.irzbnd = 4;
30451     }
30452     comsln_1.is1n1 = 0;
30453     comsln_1.isnx = 0;
30454     comslur_1.slurcurve = 0.f;
30455 
30456 /* 111109 Made global rather than per gulp */
30457 
30458     comdyn_1.ndyn = 0;
30459     compoi_1.ispoi = FALSE_;
30460     slint = FALSE_;
30461     lrptpend = FALSE_;
30462     comget_1.rptnd1 = FALSE_;
30463     *(unsigned char *)comget_1.rptfq2 = 'E';
30464     comget_1.rptprev = FALSE_;
30465     onvolt = FALSE_;
30466     comnsp_2.flgndb = FALSE_;
30467     comget_1.fbon = FALSE_;
30468     comnotes_1.shifton = FALSE_;
30469     comget_1.ornrpt = FALSE_;
30470     comnotes_1.setis = FALSE_;
30471     comarp_1.lowdot = FALSE_;
30472     comnvi_1.rename = FALSE_;
30473     comnotes_1.nobar1 = FALSE_;
30474     comget_1.equalize = FALSE_;
30475     comlast_1.usevshrink = TRUE_;
30476     comslur_1.wrotepsslurdefaults = FALSE_;
30477     comnotes_1.optlinebreakties = FALSE_;
30478     comnotes_1.headerspecial = FALSE_;
30479 
30480 /*  vshrink is initialized in topfile */
30481 
30482     comget_1.stickys = FALSE_;
30483 
30484 /*  ixrest = 1 or 2 if xtup has started with a rest */
30485 
30486     for (commvl_1.ivx = 1; commvl_1.ivx <= 24; ++commvl_1.ivx) {
30487 	strtmid_1.ixrest[commvl_1.ivx - 1] = 0;
30488 	comfig_1.fullsize[commvl_1.ivx - 1] = 1.f;
30489 
30490 /*  Set legacy note level to middle c as default */
30491 
30492 	comnotes_1.ndlev[commvl_1.ivx - 1] = 29;
30493 	comnotes_1.ndlev[commvl_1.ivx + 23] = 29;
30494 /* L1: */
30495     }
30496     comnotes_1.npreslur = 0;
30497     nhssys = 0;
30498     comslur_1.listslur = 0;
30499     for (i__ = 1; i__ <= 202; ++i__) {
30500 	all_1.isdat1[i__ - 1] = 0;
30501 	all_1.isdat2[i__ - 1] = 0;
30502 /* L31: */
30503     }
30504     all_1.nsdat = 0;
30505 
30506 /*  Initialize flag for figures in any other voice than 1 */
30507 
30508     comfig_1.ivxfig2 = 0;
30509 
30510 /*  Initialize for loop over gulps */
30511 
30512     all_1.firstgulp = TRUE_;
30513 
30514 /*  Start a gulp */
30515 
30516 L30:
30517     loop = TRUE_;
30518     comnotes_1.notcrd = TRUE_;
30519     combjmp_1.isbjmp = FALSE_;
30520     combjmp_1.isbj2 = FALSE_;
30521     comfb_1.autofbon = FALSE_;
30522     comfb_1.tautofb = 0.f;
30523     all_1.nbars = 0;
30524     comfig_1.nfigs[0] = 0;
30525     comfig_1.nfigs[1] = 0;
30526     comgrace_1.ngrace = 0;
30527     comtrill_1.ntrill = 0;
30528     comtrill_1.ncrd = 0;
30529     comtrill_1.nudorn = 0;
30530     comgrace_1.nlit = 0;
30531     comgrace_1.nvolt = 0;
30532     comgrace_1.ibarmbr = 0;
30533     comudsp_1.nudsp = 0;
30534 /*      ndyn = 0   ! 111109 */
30535     comdyn_1.ntxtdyn = 0;
30536     comcb_1.nbc = 0;
30537     comarpshift_1.numarpshift = 0;
30538     for (i__ = 1; i__ <= 37; ++i__) {
30539 	comgrace_1.graspace[i__ - 1] = 0.f;
30540 /* L3: */
30541     }
30542 
30543 /*  Now initialize up to nv.  Do it in getnote as r'qd for 2nd voices per syst. */
30544 /*  and also if nv increases in an 'M' directive. */
30545 
30546     i__1 = all_1.nv;
30547     for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
30548 	newvoice_(&all_1.iv, comclefq_1.clefq + (all_1.iv - 1), &c_false, (
30549 		ftnlen)1);
30550 /* L4: */
30551     }
30552 
30553 /*  Check if endsymbol was set earlier */
30554 
30555     if (comget_1.rptnd1) {
30556 	comget_1.rptnd1 = FALSE_;
30557 	*(unsigned char *)comget_1.rptfq2 = *(unsigned char *)comget_1.rptfq1;
30558     } else {
30559 
30560 /*  Only use if movbrk>0, to signal default ('RD') */
30561 
30562 	*(unsigned char *)comget_1.rptfq2 = 'E';
30563     }
30564     all_1.iv = 1;
30565     commvl_1.ivx = 1;
30566 L2:
30567     if (loop) {
30568 
30569 /*  Within this loop, nv voices are filled up for the duration of the block. */
30570 /*  On exit (loop=.false.) the following are set: nnl(nv),itsofar(nv) */
30571 /*  nolev(nv,nnl(nv)),nodur(..),accq(..),irest(..). */
30572 /*  nbars is for this input block. */
30573 /*  Only at the beginning of an input block will there be a possible mtr change, */
30574 /*  signalled by a nonzero mtrnuml. (which will be re-zeroed right after change) */
30575 
30576 	getnote_(&loop);
30577 	if (comget_1.lastchar) {
30578 	    goto L40;
30579 	}
30580 	goto L2;
30581     }
30582 
30583 /*  Finished an input block (gulp). */
30584 
30585     if (commidi_1.ismidi) {
30586 
30587 /*  Put rests into midi array for 2nd lines that were not used in this gulp. */
30588 
30589 	i__1 = all_1.nv;
30590 	for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
30591 	    if (commidi_1.twoline[all_1.iv - 1] && commvl_1.nvmx[all_1.iv - 1]
30592 		     == 1) {
30593 		if (all_1.firstgulp && all_1.lenb0 != 0) {
30594 		    r__1 = (all_1.nbars - 1.f) * all_1.lenbar + all_1.lenb0;
30595 		    addmidi_(&commidi_1.midchan[all_1.iv + 23], &c__0, &c__0,
30596 			    &c__0, &r__1, &c_true, &c_false);
30597 		} else {
30598 		    r__1 = all_1.nbars * 1.f * all_1.lenbar;
30599 		    addmidi_(&commidi_1.midchan[all_1.iv + 23], &c__0, &c__0,
30600 			    &c__0, &r__1, &c_true, &c_false);
30601 		}
30602 	    }
30603 /* L60: */
30604 	}
30605     }
30606     comgrace_1.nvolt = 0;
30607     for (all_1.iv = 1; all_1.iv <= 24; ++all_1.iv) {
30608 	comudsp_1.nudoff[all_1.iv - 1] = 0;
30609 	comcc_1.ndotmv[all_1.iv - 1] = 0;
30610 /* L28: */
30611     }
30612 
30613 /*  Put stuff at top of p.1.  Must wait until now to have read title info. */
30614 
30615     if (combibarcnt_1.ibarcnt == 0) {
30616 	puttitle_(&inhnoh, &xnsttop[comnotes_1.ipage - 1], &etatop, all_1.sq,
30617 		&etait, &etatc, &etacs1, &all_1.nv, &vshrink, all_1.sepsymq, (
30618 		ftnlen)1, (ftnlen)1);
30619 	if (comnotes_1.headerspecial) {
30620 	    s_wsfe(&io___1296);
30621 /* Writing concatenation */
30622 	    chax_(ch__1, (ftnlen)1, &c__92);
30623 	    i__6[0] = 1, a__4[0] = ch__1;
30624 	    i__6[1] = 28, a__4[1] = "special{header=psslurs.pro}%";
30625 	    s_cat(ch__7, a__4, i__6, &c__2, (ftnlen)29);
30626 	    do_fio(&c__1, ch__7, (ftnlen)29);
30627 	    e_wsfe();
30628 	}
30629 
30630 /*  Write special header for first page */
30631 
30632     }
30633     i__1 = all_1.nbars;
30634     for (all_1.ibar = 1; all_1.ibar <= i__1; ++all_1.ibar) {
30635 	++combibarcnt_1.ibarcnt;
30636 	comask_1.bar1syst = combibarcnt_1.ibarcnt == iauto;
30637 /* Computing MAX */
30638 	r__1 = combibarcnt_1.ibarcnt + .001f + ibcoff;
30639 	i__2 = 0, i__7 = (integer) r_lg10(&r__1);
30640 	ndig = max(i__2,i__7);
30641 	if (comlast_1.islast) {
30642 	    ci__1.cierr = 0;
30643 	    ci__1.ciunit = 11;
30644 /* Writing concatenation */
30645 	    i__8[0] = 6, a__5[0] = "(a11,i";
30646 	    i__2 = ndig + 50;
30647 	    chax_(ch__1, (ftnlen)1, &i__2);
30648 	    i__8[1] = 1, a__5[1] = ch__1;
30649 	    i__8[2] = 1, a__5[2] = ")";
30650 	    ci__1.cifmt = (s_cat(ch__8, a__5, i__8, &c__3, (ftnlen)8), ch__8);
30651 	    s_wsfe(&ci__1);
30652 	    do_fio(&c__1, "% Bar count", (ftnlen)11);
30653 	    i__7 = combibarcnt_1.ibarcnt + ibcoff;
30654 	    do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer));
30655 	    e_wsfe();
30656 	}
30657 	if (all_1.ibar != comgrace_1.ibarmbr) {
30658 	    if (! (*optimize)) {
30659 		i__2 = combibarcnt_1.ibarcnt + ibcoff;
30660 		outbar_(&i__2, &jprntb);
30661 	    }
30662 	} else {
30663 	    if (! (*optimize)) {
30664 		s_wsfe(&io___1298);
30665 		do_fio(&c__1, " Multibar rest, bars", (ftnlen)20);
30666 		i__2 = combibarcnt_1.ibarcnt + ibcoff;
30667 		do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
30668 		do_fio(&c__1, "-", (ftnlen)1);
30669 		i__7 = combibarcnt_1.ibarcnt + ibcoff + comgrace_1.mbrest - 1;
30670 		do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer));
30671 		e_wsfe();
30672 		s_wsfe(&io___1299);
30673 		do_fio(&c__1, " Multibar rest, bars", (ftnlen)20);
30674 		i__2 = combibarcnt_1.ibarcnt + ibcoff;
30675 		do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
30676 		do_fio(&c__1, "-", (ftnlen)1);
30677 		i__7 = combibarcnt_1.ibarcnt + ibcoff + comgrace_1.mbrest - 1;
30678 		do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer));
30679 		e_wsfe();
30680 		jprntb = 0;
30681 	    }
30682 	    ibcoff = ibcoff + comgrace_1.mbrest - 1;
30683 	    if (all_1.ibar == 1 && all_1.firstgulp && ! bit_test(all_1.islur[
30684 		    0],5)) {
30685 		comgrace_1.xb4mbr = comstart_1.facmtr * all_1.musicsize;
30686 	    }
30687 
30688 /*  The above may be he only case where the space-before option is used in \mbrest */
30689 
30690 	}
30691 
30692 /*  Move the read to after end-of-bar hardspace checks, so we get right poenom */
30693 /*  at end of a line. */
30694 /*       if (bar1syst) read(12,*) poenom */
30695 
30696 /*  Check for clef at start of bar.  No slide yet.  Also flags at end of prev. */
30697 /*  bar.  This block is run at the start of every bar.  May fail for flag at */
30698 /*  end of last bar.  To account for necc. hardspaces, compute and store */
30699 /*    nhssys = # of hard spaces for this system */
30700 /*    hesk(nhssys) = elemskips avialable */
30701 /*    hpts(nhssys) = hard points needed, including notehead */
30702 /*  Here, merely insert placeholder into output.  Later, when poe is computed, */
30703 /*  compute additional pts and store them in hpttot(1...nhstot).  Finally in */
30704 /*  subroutine askfig, write true pts where placeholders are. */
30705 
30706 	ioff = 0;
30707 	if (all_1.ibar > 1) {
30708 	    ioff = all_1.nib[(all_1.ibar - 1) * 24 - 24];
30709 	}
30710 	clchb = bit_test(all_1.islur[(ioff + 1) * 24 - 24],15);
30711 	putmbr = FALSE_;
30712 	if (ismbr) {
30713 	    if (clchb) {
30714 
30715 /*  Clef change and multi-bar rest coming up.  Kluge to get space at end of rest. */
30716 
30717 		s_wsfe(&io___1303);
30718 /* Writing concatenation */
30719 		i__9[0] = 1, a__6[0] = all_1.sq;
30720 		i__9[1] = 3, a__6[1] = "let";
30721 		i__9[2] = 1, a__6[2] = all_1.sq;
30722 		i__9[3] = 4, a__6[3] = "mbrt";
30723 		i__9[4] = 1, a__6[4] = all_1.sq;
30724 		i__9[5] = 6, a__6[5] = "mbrest";
30725 		i__9[6] = 1, a__6[6] = all_1.sq;
30726 		i__9[7] = 3, a__6[7] = "def";
30727 		i__9[8] = 1, a__6[8] = all_1.sq;
30728 		i__9[9] = 14, a__6[9] = "mbrest#1#2#3{%";
30729 		s_cat(ch__9, a__6, i__9, &c__10, (ftnlen)35);
30730 		do_fio(&c__1, ch__9, (ftnlen)35);
30731 		e_wsfe();
30732 		s_wsfe(&io___1304);
30733 /* Writing concatenation */
30734 		i__6[0] = 1, a__4[0] = all_1.sq;
30735 		i__6[1] = 13, a__4[1] = "mbrt{#1}{#2}{";
30736 		s_cat(ch__10, a__4, i__6, &c__2, (ftnlen)14);
30737 		do_fio(&c__1, ch__10, (ftnlen)14);
30738 		r__1 = all_1.musicsize * .55f;
30739 		do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
30740 /* Writing concatenation */
30741 		i__10[0] = 1, a__7[0] = "}";
30742 		i__10[1] = 1, a__7[1] = all_1.sq;
30743 		i__10[2] = 6, a__7[2] = "global";
30744 		i__10[3] = 1, a__7[3] = all_1.sq;
30745 		i__10[4] = 3, a__7[4] = "let";
30746 		i__10[5] = 1, a__7[5] = all_1.sq;
30747 		i__10[6] = 6, a__7[6] = "mbrest";
30748 		i__10[7] = 1, a__7[7] = all_1.sq;
30749 		i__10[8] = 6, a__7[8] = "mbrt}%";
30750 		s_cat(ch__4, a__7, i__10, &c__9, (ftnlen)26);
30751 		do_fio(&c__1, ch__4, (ftnlen)26);
30752 		e_wsfe();
30753 	    }
30754 	    ismbr = FALSE_;
30755 	    putmbr = TRUE_;
30756 	}
30757 	if (all_1.ibar == comgrace_1.ibarmbr) {
30758 	    ismbr = TRUE_;
30759 	}
30760 
30761 /*  Set flag here so at start of next bar, if there's a clef change, can add space */
30762 /*    after the mbr with the above kluge */
30763 
30764 	if (! (clchb || comnsp_2.flgndb)) {
30765 	    goto L23;
30766 	}
30767 
30768 /*  Must check available space */
30769 
30770 	ptsndb = 0.f;
30771 
30772 /*  Zero out block signal */
30773 
30774 	if (clchb) {
30775 	    all_1.islur[(ioff + 1) * 24 - 24] = bit_clear(all_1.islur[(ioff +
30776 		    1) * 24 - 24],15);
30777 	}
30778 
30779 /*  In this loop, we determine how much hardspace is needed (if any) */
30780 /*  9/7/97  Note that for last bar in input block, if number of lines of */
30781 /*    music decreases in new block, highest numbered ones won't be checked */
30782 /*    since the loop below covers the new nvmx(iv), not necessarily the old */
30783 /*    one. */
30784 /*  4/18/98 Apparently nmxsav was a solution to the above problem */
30785 
30786 	i__2 = all_1.nv;
30787 	for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) {
30788 	    i__7 = comnsp_2.nvmxsav[all_1.iv - 1];
30789 	    for (kv = 1; kv <= i__7; ++kv) {
30790 		commvl_1.ivx = comnsp_2.ivmxsav[all_1.iv + kv * 24 - 25];
30791 		ptsndv = comnsp_2.flgndv[commvl_1.ivx - 1] * comask_1.wheadpt;
30792 		ioff = 0;
30793 		if (all_1.ibar > 1) {
30794 		    ioff = all_1.nib[commvl_1.ivx + (all_1.ibar - 1) * 24 -
30795 			    25];
30796 		    ip = ioff;
30797 		    if (all_1.ibar > 2) {
30798 			ip = ioff - all_1.nib[commvl_1.ivx + (all_1.ibar - 2)
30799 				* 24 - 25];
30800 		    }
30801 /*            prevtn(ivx) = tnote(iand(ipl(ivx,ip),255)) */
30802 		    comnsp_2.prevtn[commvl_1.ivx - 1] = all_1.tnote[
30803 			    comipl2_1.ipl2[commvl_1.ivx + ip * 24 - 25] - 1];
30804 
30805 /* If ibar=1 (1st bar in input block), prevtn(ivx) was set at end of makeabar. */
30806 
30807 		}
30808 
30809 /*  Only allow clef changes when ivx <= nv */
30810 
30811 		if (commvl_1.ivx <= all_1.nv) {
30812 		    clchv[all_1.iv - 1] = clchb && bit_test(all_1.islur[
30813 			    all_1.iv + (ioff + 1) * 24 - 25],11);
30814 		    if (clchv[all_1.iv - 1]) {
30815 
30816 /*  Clef change in this voice.  Turn off signal.  Get space avail. */
30817 
30818 			all_1.islur[all_1.iv + (ioff + 1) * 24 - 25] =
30819 				bit_clear(all_1.islur[all_1.iv + (ioff + 1) *
30820 				24 - 25],11);
30821 			if ((r__1 = comnsp_2.prevtn[all_1.iv - 1] -
30822 				comnsp_2.space[comnsp_2.nb - 1], dabs(r__1)) <
30823 				 comtol_1.tol) {
30824 			    ptsndv += combmh_1.clefend * comask_1.wheadpt;
30825 			}
30826 		    }
30827 		}
30828 /* Computing MAX */
30829 		r__1 = ptsndb, r__2 = ptsndv + comask_1.wheadpt *
30830 			spfacs_1.xspfac;
30831 		ptsndb = dmax(r__1,r__2);
30832 /* L16: */
30833 	    }
30834 	}
30835 
30836 /* ????  where is nb set???  nb probably in left over from makeabar */
30837 
30838 	r__1 = comnsp_2.space[comnsp_2.nb - 1] * squez[comnsp_2.nb - 1];
30839 	esk = feon_(&r__1);
30840 	ptsdflt = esk * comask_1.poenom - comask_1.wheadpt;
30841 /*        if ((ptsndb.gt.ptsdflt.or.ptsgnd.gt.0.) .and. movbrk.eq.0) then */
30842 	if ((ptsndb > ptsdflt || comnsp_2.ptsgnd > 0.f) && comget_1.movbrk ==
30843 		0 && ! putmbr) {
30844 
30845 /*  Must ADD hardspace!  So put in a placeholder, and store params for later. */
30846 
30847 	    if (comlast_1.islast) {
30848 		s_wsfe(&io___1313);
30849 /* Writing concatenation */
30850 		i__6[0] = 1, a__4[0] = all_1.sq;
30851 		i__6[1] = 18, a__4[1] = "xardspace{    pt}%";
30852 		s_cat(ch__11, a__4, i__6, &c__2, (ftnlen)19);
30853 		do_fio(&c__1, ch__11, (ftnlen)19);
30854 		e_wsfe();
30855 	    }
30856 	    ++nhssys;
30857 	    if (ptsndb - ptsdflt > comnsp_2.ptsgnd - comask_1.poenom *
30858 		    comnsp_2.eskgnd) {
30859 		hesk[nhssys - 1] = esk;
30860 		hpts[nhssys - 1] = ptsndb + comask_1.wheadpt;
30861 	    } else {
30862 		hesk[nhssys - 1] = comnsp_2.eskgnd;
30863 		hpts[nhssys - 1] = comnsp_2.ptsgnd + comask_1.wheadpt;
30864 	    }
30865 	    comask_1.fixednew += hpts[nhssys - 1];
30866 	    comask_1.scaldold += hesk[nhssys - 1];
30867 	}
30868 	if (clchb) {
30869 	    i__7 = all_1.nv;
30870 	    for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) {
30871 		if (clchv[all_1.iv - 1]) {
30872 /* Writing concatenation */
30873 		    i__6[0] = 1, a__4[0] = all_1.sq;
30874 		    i__6[1] = 6, a__4[1] = "znotes";
30875 		    s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
30876 		    lnote = 7;
30877 		    i__2 = all_1.iv;
30878 		    for (iiv = 2; iiv <= i__2; ++iiv) {
30879 /* Writing concatenation */
30880 			i__6[0] = lnote, a__4[0] = notexq;
30881 			i__6[1] = 1, a__4[1] = all_1.sepsymq + (iiv - 2);
30882 			s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
30883 			++lnote;
30884 /* L24: */
30885 		    }
30886 
30887 /*  Recompute ioff since it will vary from voice to voice */
30888 
30889 		    if (all_1.ibar == 1) {
30890 			ioff = 0;
30891 		    } else {
30892 			ioff = all_1.nib[all_1.iv + (all_1.ibar - 1) * 24 -
30893 				25];
30894 		    }
30895 
30896 /*  Must call clefsym to get nclef, even if there is a movement break */
30897 
30898 		    clefsym_(&all_1.islur[all_1.iv + (ioff + 1) * 24 - 25],
30899 			    fmtq, &lclef, &nclef, (ftnlen)24);
30900 		    if (comget_1.movbrk == 0 && comlast_1.islast) {
30901 			s_wsfe(&io___1322);
30902 /* Writing concatenation */
30903 			i__5[0] = lnote, a__3[0] = notexq;
30904 			i__5[1] = lclef, a__3[1] = fmtq;
30905 			i__5[2] = 1, a__3[2] = all_1.sq;
30906 			i__5[3] = 3, a__3[3] = "en%";
30907 			s_cat(ch__12, a__3, i__5, &c__4, (ftnlen)107);
30908 			do_fio(&c__1, ch__12, lnote + lclef + 4);
30909 			e_wsfe();
30910 		    }
30911 		    wsclef_(&all_1.iv, &comnotes_1.ninow, comclefq_1.clefq, &
30912 			    nclef, (ftnlen)1);
30913 		}
30914 /* L17: */
30915 	    }
30916 	    if (comlast_1.islast) {
30917 		s_wsfe(&io___1323);
30918 /* Writing concatenation */
30919 		i__6[0] = 1, a__4[0] = all_1.sq;
30920 		i__6[1] = 11, a__4[1] = "pmxnewclefs";
30921 		s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)12);
30922 		do_fio(&c__1, ch__13, (ftnlen)12);
30923 		e_wsfe();
30924 	    }
30925 	}
30926 L23:
30927 
30928 /*  End of loop for end-of-bar hardspaces and non-movbrk clef symbol. */
30929 
30930 	if (comask_1.bar1syst) {
30931 	    s_rsle(&io___1324);
30932 	    do_lio(&c__4, &c__1, (char *)&comask_1.poenom, (ftnlen)sizeof(
30933 		    real));
30934 	    e_rsle();
30935 	}
30936 
30937 /*  Repeat symbols.  Haven't slid down yet, so use islur(1,nib(1,ibar-1)+1) */
30938 
30939 	if (all_1.ibar == 1) {
30940 	    islnow = all_1.islur[0];
30941 	    iornqnow = all_1.iornq[24];
30942 	} else {
30943 	    islnow = all_1.islur[(all_1.nib[(all_1.ibar - 1) * 24 - 24] + 1) *
30944 		     24 - 24];
30945 	    iornqnow = all_1.iornq[(all_1.nib[(all_1.ibar - 1) * 24 - 24] + 1)
30946 		     * 24];
30947 	}
30948 
30949 /*  Check for R-symbols set at end of prior input block */
30950 
30951 	if (comget_1.movbrk == 0 && *(unsigned char *)comget_1.rptfq2 != 'E')
30952 		{
30953 	    if (*(unsigned char *)comget_1.rptfq2 == 'D') {
30954 		islnow = bit_set(islnow,26);
30955 	    } else if (*(unsigned char *)comget_1.rptfq2 == 'r') {
30956 		islnow = bit_set(islnow,6);
30957 	    } else if (*(unsigned char *)comget_1.rptfq2 == 'd') {
30958 		islnow = bit_set(islnow,8);
30959 	    } else if (*(unsigned char *)comget_1.rptfq2 == 'b') {
30960 		islnow = bit_set(islnow,25);
30961 	    } else {
30962 		s_wsle(&io___1327);
30963 		e_wsle();
30964 		s_wsle(&io___1328);
30965 		do_lio(&c__9, &c__1, "Illegal symbol with \"R\" at end of in"
30966 			"put block:", (ftnlen)46);
30967 		do_lio(&c__9, &c__1, comget_1.rptfq2, (ftnlen)1);
30968 		e_wsle();
30969 		stop1_();
30970 	    }
30971 	    *(unsigned char *)comget_1.rptfq2 = 'E';
30972 	}
30973 	if ((islnow & 352) != 0) {
30974 
30975 /*  Bit 5(lrpt), 6(rrpt), or 8(doublebar) has been set */
30976 
30977 	    lrpt = bit_test(islnow,5);
30978 	    rrpt = bit_test(islnow,6);
30979 	    lrptpend = lrpt && comask_1.bar1syst;
30980 	    if (lrpt && ! lrptpend) {
30981 		if (rrpt) {
30982 		    if (comlast_1.islast) {
30983 			s_wsfe(&io___1331);
30984 /* Writing concatenation */
30985 			i__6[0] = 1, a__4[0] = all_1.sq;
30986 			i__6[1] = 18, a__4[1] = "setleftrightrepeat";
30987 			s_cat(ch__11, a__4, i__6, &c__2, (ftnlen)19);
30988 			do_fio(&c__1, ch__11, (ftnlen)19);
30989 			e_wsfe();
30990 		    }
30991 		    comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt *
30992 			     spfacs_1.lrrptfac - .4f;
30993 		} else {
30994 		    if (comlast_1.islast) {
30995 			s_wsfe(&io___1332);
30996 /* Writing concatenation */
30997 			i__6[0] = 1, a__4[0] = all_1.sq;
30998 			i__6[1] = 13, a__4[1] = "setleftrepeat";
30999 			s_cat(ch__10, a__4, i__6, &c__2, (ftnlen)14);
31000 			do_fio(&c__1, ch__10, (ftnlen)14);
31001 			e_wsfe();
31002 		    }
31003 		    comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt *
31004 			     spfacs_1.rptfac - .4f;
31005 		}
31006 	    } else if (rrpt) {
31007 		if (comlast_1.islast) {
31008 		    s_wsfe(&io___1333);
31009 /* Writing concatenation */
31010 		    i__6[0] = 1, a__4[0] = all_1.sq;
31011 		    i__6[1] = 14, a__4[1] = "setrightrepeat";
31012 		    s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)15);
31013 		    do_fio(&c__1, ch__14, (ftnlen)15);
31014 		    e_wsfe();
31015 		}
31016 		comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt *
31017 			spfacs_1.rptfac - .4f;
31018 	    } else if (bit_test(islnow,8)) {
31019 		if (comlast_1.islast) {
31020 		    s_wsfe(&io___1334);
31021 /* Writing concatenation */
31022 		    i__6[0] = 1, a__4[0] = all_1.sq;
31023 		    i__6[1] = 12, a__4[1] = "setdoublebar";
31024 		    s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)13);
31025 		    do_fio(&c__1, ch__15, (ftnlen)13);
31026 		    e_wsfe();
31027 		}
31028 		comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt *
31029 			spfacs_1.dbarfac - .4f;
31030 	    }
31031 	} else if (bit_test(islnow,26)) {
31032 
31033 /*  doubleBAR */
31034 
31035 	    if (comlast_1.islast) {
31036 		s_wsfe(&io___1335);
31037 /* Writing concatenation */
31038 		i__6[0] = 1, a__4[0] = all_1.sq;
31039 		i__6[1] = 12, a__4[1] = "setdoubleBAR";
31040 		s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)13);
31041 		do_fio(&c__1, ch__15, (ftnlen)13);
31042 		e_wsfe();
31043 	    }
31044 	    comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt *
31045 		    spfacs_1.ddbarfac - .4f;
31046 	} else if (bit_test(iornqnow,29)) {
31047 
31048 /*  no bar line */
31049 
31050 /* --        if (islast) write(11,'(a)')sq//'setzalaligne' */
31051 /* ++ */
31052 	    if (comlast_1.islast) {
31053 		if (comget_1.movbrk == 0) {
31054 		    s_wsfe(&io___1336);
31055 /* Writing concatenation */
31056 		    i__6[0] = 1, a__4[0] = all_1.sq;
31057 		    i__6[1] = 12, a__4[1] = "setzalaligne";
31058 		    s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)13);
31059 		    do_fio(&c__1, ch__15, (ftnlen)13);
31060 		    e_wsfe();
31061 		} else {
31062 
31063 /*  Encountered "Rz" at start of input block at start of new movement,  Must */
31064 /*    use newmovement macro with arg 4 rather than setzalaligne, since former */
31065 /*    already redefines stoppiece. */
31066 
31067 		    *(unsigned char *)comget_1.rptfq2 = 'z';
31068 		}
31069 	    }
31070 /* ++ */
31071 	    comask_1.fixednew += -.4f;
31072 	}
31073 
31074 /*  1st and 2nd endings */
31075 
31076 	svolta = bit_test(islnow,7);
31077 	evolta = bit_test(islnow,9);
31078 	if (evolta) {
31079 	    if (bit_test(islnow,10)) {
31080 		if (comlast_1.islast) {
31081 		    s_wsfe(&io___1339);
31082 /* Writing concatenation */
31083 		    i__6[0] = 1, a__4[0] = all_1.sq;
31084 		    i__6[1] = 11, a__4[1] = "endvoltabox";
31085 		    s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)12);
31086 		    do_fio(&c__1, ch__13, (ftnlen)12);
31087 		    e_wsfe();
31088 		}
31089 	    } else {
31090 		if (comlast_1.islast) {
31091 		    s_wsfe(&io___1340);
31092 /* Writing concatenation */
31093 		    i__6[0] = 1, a__4[0] = all_1.sq;
31094 		    i__6[1] = 8, a__4[1] = "endvolta";
31095 		    s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)9);
31096 		    do_fio(&c__1, ch__16, (ftnlen)9);
31097 		    e_wsfe();
31098 		}
31099 	    }
31100 	    onvolt = FALSE_;
31101 	}
31102 	if (svolta) {
31103 	    ++comgrace_1.nvolt;
31104 	    lvoltxt = i_indx(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20,
31105 		     " ", (ftnlen)20, (ftnlen)1) - 1;
31106 	    if (lvoltxt == 1) {
31107 		if (comlast_1.islast) {
31108 		    s_wsfe(&io___1342);
31109 /* Writing concatenation */
31110 		    i__5[0] = 1, a__3[0] = all_1.sq;
31111 		    i__5[1] = 8, a__3[1] = "Setvolta";
31112 		    i__5[2] = 1, a__3[2] = comgrace_1.voltxtq + (
31113 			    comgrace_1.nvolt - 1) * 20;
31114 		    i__5[3] = 1, a__3[3] = "%";
31115 		    s_cat(ch__17, a__3, i__5, &c__4, (ftnlen)11);
31116 		    do_fio(&c__1, ch__17, (ftnlen)11);
31117 		    e_wsfe();
31118 		}
31119 	    } else {
31120 		if (comlast_1.islast) {
31121 		    s_wsfe(&io___1343);
31122 /* Writing concatenation */
31123 		    i__11[0] = 1, a__8[0] = all_1.sq;
31124 		    i__11[1] = 8, a__8[1] = "Setvolta";
31125 		    i__11[2] = 1, a__8[2] = "{";
31126 		    i__11[3] = lvoltxt, a__8[3] = comgrace_1.voltxtq + (
31127 			    comgrace_1.nvolt - 1) * 20;
31128 		    i__11[4] = 2, a__8[4] = "}%";
31129 		    s_cat(ch__18, a__8, i__11, &c__5, (ftnlen)32);
31130 		    do_fio(&c__1, ch__18, lvoltxt + 12);
31131 		    e_wsfe();
31132 		}
31133 	    }
31134 	    onvolt = TRUE_;
31135 	}
31136 	if (all_1.ibar > 1) {
31137 	    ipnow = all_1.nib[(all_1.ibar - 1) * 24 - 24] + 1;
31138 	} else {
31139 	    ipnow = 1;
31140 	}
31141 	iplnow = all_1.ipl[ipnow * 24 - 24];
31142 	if (comask_1.bar1syst) {
31143 
31144 /*  If listslur>0, then there is at least one slur or tie carried over the break */
31145 
31146 	    ispstie = FALSE_;
31147 	    if (comnotes_1.optlinebreakties && ! comslur_1.fontslur &&
31148 		    comslur_1.listslur != 0 && comlast_1.islast) {
31149 		linebreakties_(all_1.isdat1, all_1.isdat2, all_1.isdat3,
31150 			all_1.isdat4, &all_1.nsdat, &ispstie, all_1.sepsymq, (
31151 			ftnlen)1);
31152 	    }
31153 	    ++all_1.iline;
31154 
31155 /*  End an old system, Start a new system */
31156 
31157 	    if (all_1.iline != 1) {
31158 
31159 /*  Not first line. */
31160 /*  Get corrected poe = points/elemskip for *previous* system */
31161 
31162 		wdpt = comtop_1.widthpt * (1 - comtop_1.fracindent);
31163 		poe = (wdpt - fsyst * all_1.musicsize - nbarss * .4f -
31164 			comask_1.fixednew) / (elsktot + comask_1.fbar *
31165 			nbarss - comask_1.scaldold);
31166 		++isyscnt;
31167 		poevec[isyscnt] = poe;
31168 
31169 /*  Transfer data for system into global arrays to hold until very end */
31170 
31171 		i__7 = comas2_1.nasksys;
31172 		for (ia = 1; ia <= i__7; ++ia) {
31173 		    ++comas3_1.iask;
31174 		    comas3_1.ask[comas3_1.iask - 1] = comas2_1.wasksys[ia - 1]
31175 			     / poe - (r__1 = comas2_1.elasksys[ia - 1], dabs(
31176 			    r__1));
31177 
31178 /*  Only admit negative ask if it was user-defined space, signalled by elask<=0. */
31179 
31180 		    if (comas2_1.elasksys[ia - 1] > 0.f) {
31181 			comas3_1.ask[comas3_1.iask - 1] = r_dim(&comas3_1.ask[
31182 				comas3_1.iask - 1], &c_b762);
31183 		    }
31184 /* L9: */
31185 		}
31186 		i__7 = nhssys;
31187 		for (ia = 1; ia <= i__7; ++ia) {
31188 		    ++nhstot;
31189 /* Computing MAX */
31190 		    r__1 = hpts[ia - 1] - hesk[ia - 1] * poe;
31191 		    comhsp_1.hpttot[nhstot - 1] = dmax(r__1,0.f);
31192 /* L25: */
31193 		}
31194 
31195 /*  Reset counters for new system */
31196 
31197 		comask_1.scaldold = 0.f;
31198 		comask_1.fixednew = 0.f;
31199 		comas2_1.nasksys = 0;
31200 		nhssys = 0;
31201 	    }
31202 
31203 /*  End of if block for first bar of non-first system. Still 1st bar, any system */
31204 
31205 	    if (comlast_1.islast && all_1.figbass) {
31206 		s_wsfe(&io___1353);
31207 /* Writing concatenation */
31208 		i__6[0] = 1, a__4[0] = all_1.sq;
31209 		i__6[1] = 8, a__4[1] = "fixdrop%";
31210 		s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)9);
31211 		do_fio(&c__1, ch__16, (ftnlen)9);
31212 		e_wsfe();
31213 	    }
31214 	    ++isystpg;
31215 
31216 /*  Try moving the next stmt way down, to fix a bug and get \eject printed at */
31217 /*  end of single-system page. */
31218 /*          if (isystpg .eq. nsystp(ipage)) isystpg = 0 */
31219 	    s_rsle(&io___1354);
31220 	    do_lio(&c__3, &c__1, (char *)&nbarss, (ftnlen)sizeof(integer));
31221 	    do_lio(&c__4, &c__1, (char *)&elsktot, (ftnlen)sizeof(real));
31222 	    do_lio(&c__4, &c__1, (char *)&fsyst, (ftnlen)sizeof(real));
31223 	    do_lio(&c__4, &c__1, (char *)&frac, (ftnlen)sizeof(real));
31224 	    do_lio(&c__4, &c__1, (char *)&comeon_1.eonk, (ftnlen)sizeof(real))
31225 		    ;
31226 	    do_lio(&c__4, &c__1, (char *)&comeon_1.ewmxk, (ftnlen)sizeof(real)
31227 		    );
31228 	    e_rsle();
31229 	    if (all_1.iline > 1) {
31230 		comtop_1.fracindent = frac;
31231 	    }
31232 	    if (all_1.figbass) {
31233 		all_1.ifigdr[(all_1.iline << 1) - 2] = 4;
31234 		all_1.ifigdr[(all_1.iline << 1) - 1] = 4;
31235 	    }
31236 	    all_1.slfac = slfac1 * all_1.musicsize * elsktot;
31237 	    if (all_1.iline != 1) {
31238 
31239 /*  For the line just _finished_, put figdrop in separate file. */
31240 
31241 		if (all_1.figbass) {
31242 		    s_wsfe(&io___1356);
31243 /* Writing concatenation */
31244 		    i__6[0] = 1, a__4[0] = all_1.sq;
31245 		    i__6[1] = 8, a__4[1] = "figdrop=";
31246 		    s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)9);
31247 		    do_fio(&c__1, ch__16, (ftnlen)9);
31248 		    do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline - 1 << 1)
31249 			     - 2], (ftnlen)sizeof(integer));
31250 /* Writing concatenation */
31251 		    i__8[0] = 1, a__5[0] = " ";
31252 		    i__8[1] = 1, a__5[1] = all_1.sq;
31253 		    i__8[2] = 8, a__5[2] = "figdtwo=";
31254 		    s_cat(ch__19, a__5, i__8, &c__3, (ftnlen)10);
31255 		    do_fio(&c__1, ch__19, (ftnlen)10);
31256 		    do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline - 1 << 1)
31257 			     - 1], (ftnlen)sizeof(integer));
31258 /* Writing concatenation */
31259 		    i__12[0] = 1, a__9[0] = all_1.sq;
31260 		    i__12[1] = 3, a__9[1] = "or%";
31261 		    s_cat(ch__20, a__9, i__12, &c__2, (ftnlen)4);
31262 		    do_fio(&c__1, ch__20, (ftnlen)4);
31263 		    e_wsfe();
31264 		}
31265 
31266 /*  Check slurs in top staff for interference w/ barno. Only check when */
31267 /*  # if digits in barno >= |isig|  But to keep on/off phasing, must ALWAYS */
31268 /*  keep track of ons and offs when |isig|<=3. */
31269 
31270 		r__1 = combibarcnt_1.ibarcnt + ibcoff + .01f;
31271 		ndigbn = (integer) r_lg10(&r__1) + 1;
31272 		comsln_1.isnx = 0;
31273 		if (ndigbn >= abs(comtop_1.isig) && comsln_1.is1n1 > 0) {
31274 
31275 /*  There's a slur in top voice over the line break, hgt=is1n1, idcode=is2n1 */
31276 /*  Look for termination in remainder of this input block.  If not found, */
31277 /*  just use is1n1.  Remember, haven't slid down yet. */
31278 
31279 		    ioff = 0;
31280 		    if (all_1.ibar > 1) {
31281 			ioff = all_1.nib[commvl_1.ivmx[all_1.nv +
31282 				commvl_1.nvmx[all_1.nv - 1] * 24 - 25] + (
31283 				all_1.ibar - 1) * 24 - 25];
31284 		    }
31285 		    i__7 = all_1.nsdat;
31286 		    for (isdat = 1; isdat <= i__7; ++isdat) {
31287 			if (igetbits_(&all_1.isdat1[isdat - 1], &c__5, &c__13)
31288 				 == commvl_1.ivmx[all_1.nv + commvl_1.nvmx[
31289 				all_1.nv - 1] * 24 - 25] && ! bit_test(
31290 				all_1.isdat1[isdat - 1],11) && igetbits_(&
31291 				all_1.isdat1[isdat - 1], &c__7, &c__19) ==
31292 				comsln_1.is2n1) {
31293 
31294 /*  Found slur ending.  Just check note height, can't do fine adjustments. */
31295 
31296 /*                 is1n1 = max(is1n1,igetbits(isdat2(nsdat),7,19)) */
31297 /* Computing MAX */
31298 			    i__2 = comsln_1.is1n1, i__13 = igetbits_(&
31299 				    all_1.isdat2[isdat - 1], &c__7, &c__19);
31300 			    comsln_1.is1n1 = max(i__2,i__13);
31301 			    goto L51;
31302 			}
31303 /* L50: */
31304 		    }
31305 
31306 /*  If exiting loop normally, did not find end of slur.  c'est la vie. */
31307 
31308 L51:
31309 		    i__7 = ncmid_(&all_1.nv, &c__1) + 1 + comsln_1.irzbnd;
31310 		    comsln_1.isnx = i_dim(&comsln_1.is1n1, &i__7);
31311 		    if (comsln_1.isnx > 0) {
31312 
31313 /*  AHA! Slur likely to interfere with barno. */
31314 
31315 /*  Modified 090525 to use \bnrs */
31316 
31317 			slint = TRUE_;
31318 			s_copy(fmtq, "(a16,i1,a14)", (ftnlen)24, (ftnlen)12);
31319 			if (comsln_1.irzbnd + comsln_1.isnx > 9) {
31320 			    s_copy(fmtq, "(a16,i2,a14)", (ftnlen)24, (ftnlen)
31321 				    12);
31322 			}
31323 			if (comlast_1.islast) {
31324 			    s_wsfe(&io___1359);
31325 /* Writing concatenation */
31326 			    i__5[0] = 1, a__3[0] = all_1.sq;
31327 			    i__5[1] = 3, a__3[1] = "def";
31328 			    i__5[2] = 1, a__3[2] = all_1.sq;
31329 			    i__5[3] = 11, a__3[3] = "raisebarno{";
31330 			    s_cat(ch__21, a__3, i__5, &c__4, (ftnlen)16);
31331 			    do_fio(&c__1, ch__21, (ftnlen)16);
31332 			    i__7 = comsln_1.irzbnd + comsln_1.isnx;
31333 			    do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(
31334 				    integer));
31335 /* Writing concatenation */
31336 			    i__8[0] = 2, a__5[0] = ".5";
31337 			    i__8[1] = 1, a__5[1] = all_1.sq;
31338 			    i__8[2] = 11, a__5[2] = "internote}%";
31339 			    s_cat(ch__10, a__5, i__8, &c__3, (ftnlen)14);
31340 			    do_fio(&c__1, ch__10, (ftnlen)14);
31341 			    e_wsfe();
31342 			}
31343 /*                if (islast) then */
31344 /*                  if (isnx .le. 9) then */
31345 /*                    write(11,'(a5,i1,a2)')sq//'bnrs',isnx,'0%' */
31346 /*                  else */
31347 /*                    write(11,'(a6,i2,a3)')sq//'bnrs{',isnx,'}0%' */
31348 /*                  end if */
31349 /*                end if */
31350 
31351 		    }
31352 		}
31353 		if (comget_1.movbrk > 0) {
31354 
31355 /*              movbrk = 0 */
31356 /*  Move the reset down, so can use movbrk>0 to stop extra meter prints. */
31357 
31358 /*  New movement.  Redefine stoppiece, contpiece.  These will be called either */
31359 /*     explicitly or as part of alaligne. */
31360 /*  indsym = 0,1,2 for doubleBAR , doublebar, rightrepeat. */
31361 /*     This is passed to \newmovement. */
31362 
31363 		    if (*(unsigned char *)comget_1.rptfq2 == 'E') {
31364 			*(unsigned char *)comget_1.rptfq2 = 'D';
31365 		    }
31366 		    indsym = i_indx("Ddrbz", comget_1.rptfq2, (ftnlen)5, (
31367 			    ftnlen)1) - 1;
31368 		    *(unsigned char *)comget_1.rptfq2 = 'E';
31369 
31370 /*  Also check for Rd or Rr set the normal way */
31371 
31372 		    if (bit_test(islnow,8)) {
31373 			indsym = 1;
31374 		    } else if (bit_test(islnow,6)) {
31375 			indsym = 2;
31376 		    }
31377 		    if (indsym < 0) {
31378 			s_wsle(&io___1361);
31379 			e_wsle();
31380 			s_wsle(&io___1362);
31381 			do_lio(&c__9, &c__1, "Illegal end symbol before \"/\""
31382 				, (ftnlen)29);
31383 			e_wsle();
31384 			stop1_();
31385 		    }
31386 
31387 /*  Check for continuation (no bar number reset) */
31388 
31389 		    if (comlast_1.islast && comnotes_1.nobar1) {
31390 			s_wsfe(&io___1363);
31391 /* Writing concatenation */
31392 			i__14[0] = 1, a__10[0] = all_1.sq;
31393 			i__14[1] = 7, a__10[1] = "advance";
31394 			i__14[2] = 1, a__10[2] = all_1.sq;
31395 			i__14[3] = 6, a__10[3] = "barno1";
31396 			i__14[4] = 1, a__10[4] = all_1.sq;
31397 			i__14[5] = 10, a__10[5] = "startbarno";
31398 			i__14[6] = 1, a__10[6] = all_1.sq;
31399 			i__14[7] = 6, a__10[7] = "barno%";
31400 			s_cat(ch__22, a__10, i__14, &c__8, (ftnlen)33);
31401 			do_fio(&c__1, ch__22, (ftnlen)33);
31402 			e_wsfe();
31403 		    }
31404 
31405 /* Per Rainer's suggestion, changing \nbinstruments via 3rd arg of \newmovement */
31406 
31407 /*              if (movgap .lt. 10) then */
31408 /*                if (islast) write(11,'(a12,2i1,a1)') */
31409 /*     *                sq//'newmovement',movgap,indsym,'%' */
31410 /*              else */
31411 /*                if (islast) write(11,'(a13,i2,a1,i1,a1)') */
31412 /*     *                sq//'newmovement{',movgap,'}',indsym,'%' */
31413 /*              end if */
31414 		    if (comlast_1.islast) {
31415 /* Writing concatenation */
31416 			i__6[0] = 1, a__4[0] = all_1.sq;
31417 			i__6[1] = 11, a__4[1] = "newmovement";
31418 			s_cat(nmq, a__4, i__6, &c__2, (ftnlen)40);
31419 			lnmq = 12;
31420 			if (comget_1.movgap < 10) {
31421 			    lnmq = 14;
31422 			    s_wsfi(&io___1366);
31423 			    do_fio(&c__1, (char *)&comget_1.movgap, (ftnlen)
31424 				    sizeof(integer));
31425 			    do_fio(&c__1, (char *)&indsym, (ftnlen)sizeof(
31426 				    integer));
31427 			    e_wsfi();
31428 			} else {
31429 			    lnmq = 17;
31430 			    s_wsfi(&io___1367);
31431 			    do_fio(&c__1, "{", (ftnlen)1);
31432 			    do_fio(&c__1, (char *)&comget_1.movgap, (ftnlen)
31433 				    sizeof(integer));
31434 			    do_fio(&c__1, "}", (ftnlen)1);
31435 			    do_fio(&c__1, (char *)&indsym, (ftnlen)sizeof(
31436 				    integer));
31437 			    e_wsfi();
31438 			}
31439 			if (comnotes_1.ninow < 10) {
31440 			    ++lnmq;
31441 			    ici__1.icierr = 0;
31442 			    ici__1.icirnum = 1;
31443 			    ici__1.icirlen = 1;
31444 			    ici__1.iciunit = nmq + (lnmq - 1);
31445 			    ici__1.icifmt = "(i1)";
31446 			    s_wsfi(&ici__1);
31447 			    do_fio(&c__1, (char *)&comnotes_1.ninow, (ftnlen)
31448 				    sizeof(integer));
31449 			    e_wsfi();
31450 			} else {
31451 			    lnmq += 4;
31452 			    i__7 = lnmq - 4;
31453 			    ici__1.icierr = 0;
31454 			    ici__1.icirnum = 1;
31455 			    ici__1.icirlen = lnmq - i__7;
31456 			    ici__1.iciunit = nmq + i__7;
31457 			    ici__1.icifmt = "(a1,i2,a1)";
31458 			    s_wsfi(&ici__1);
31459 			    do_fio(&c__1, "{", (ftnlen)1);
31460 			    do_fio(&c__1, (char *)&comnotes_1.ninow, (ftnlen)
31461 				    sizeof(integer));
31462 			    do_fio(&c__1, "}", (ftnlen)1);
31463 			    e_wsfi();
31464 			}
31465 			++lnmq;
31466 			ici__1.icierr = 0;
31467 			ici__1.icirnum = 1;
31468 			ici__1.icirlen = 1;
31469 			ici__1.iciunit = nmq + (lnmq - 1);
31470 			ici__1.icifmt = "(a1)";
31471 			s_wsfi(&ici__1);
31472 			do_fio(&c__1, "%", (ftnlen)1);
31473 			e_wsfi();
31474 			s_wsfe(&io___1368);
31475 			do_fio(&c__1, nmq, lnmq);
31476 			e_wsfe();
31477 		    }
31478 
31479 /*  Change generalmeter if necessary */
31480 
31481 		    if (comlast_1.islast) {
31482 			wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
31483 		    }
31484 
31485 /*  (Moved all name-writing to getnote, right when 'M' is detected) */
31486 
31487 		    if (bit_test(iplnow,28)) {
31488 
31489 /*  Key signature at movement break */
31490 
31491 			iplnow = bit_clear(iplnow,28);
31492 			if (comtop_1.isig > 0) {
31493 			    if (comlast_1.islast) {
31494 				s_wsfe(&io___1369);
31495 /* Writing concatenation */
31496 				i__6[0] = 1, a__4[0] = all_1.sq;
31497 				i__6[1] = 17, a__4[1] = "generalsignature{";
31498 				s_cat(ch__23, a__4, i__6, &c__2, (ftnlen)18);
31499 				do_fio(&c__1, ch__23, (ftnlen)18);
31500 				do_fio(&c__1, (char *)&comtop_1.isig, (ftnlen)
31501 					sizeof(integer));
31502 				do_fio(&c__1, "}%", (ftnlen)2);
31503 				e_wsfe();
31504 			    }
31505 			} else {
31506 			    if (comlast_1.islast) {
31507 				s_wsfe(&io___1370);
31508 /* Writing concatenation */
31509 				i__6[0] = 1, a__4[0] = all_1.sq;
31510 				i__6[1] = 17, a__4[1] = "generalsignature{";
31511 				s_cat(ch__23, a__4, i__6, &c__2, (ftnlen)18);
31512 				do_fio(&c__1, ch__23, (ftnlen)18);
31513 				do_fio(&c__1, (char *)&comtop_1.isig, (ftnlen)
31514 					sizeof(integer));
31515 				do_fio(&c__1, "}%", (ftnlen)2);
31516 				e_wsfe();
31517 			    }
31518 			}
31519 			if (comlast_1.islast && cominsttrans_1.laterinsttrans)
31520 				 {
31521 			    writesetsign_(&cominsttrans_1.ninsttrans,
31522 				    cominsttrans_1.iinsttrans,
31523 				    cominsttrans_1.itranskey, &
31524 				    cominsttrans_1.laterinsttrans);
31525 			}
31526 		    }
31527 		    if (comget_1.parmov >= -.1f) {
31528 
31529 /*  Resent paragraph indentation */
31530 
31531 			ipi = comget_1.parmov * comtop_1.widthpt + .1f;
31532 			if (ipi < 10) {
31533 			    if (comlast_1.islast) {
31534 				s_wsfe(&io___1372);
31535 /* Writing concatenation */
31536 				i__6[0] = 1, a__4[0] = all_1.sq;
31537 				i__6[1] = 10, a__4[1] = "parindent ";
31538 				s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)11);
31539 				do_fio(&c__1, ch__17, (ftnlen)11);
31540 				do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(
31541 					integer));
31542 				do_fio(&c__1, "pt", (ftnlen)2);
31543 				e_wsfe();
31544 			    }
31545 			} else if (ipi < 100) {
31546 			    if (comlast_1.islast) {
31547 				s_wsfe(&io___1373);
31548 /* Writing concatenation */
31549 				i__6[0] = 1, a__4[0] = all_1.sq;
31550 				i__6[1] = 10, a__4[1] = "parindent ";
31551 				s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)11);
31552 				do_fio(&c__1, ch__17, (ftnlen)11);
31553 				do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(
31554 					integer));
31555 				do_fio(&c__1, "pt", (ftnlen)2);
31556 				e_wsfe();
31557 			    }
31558 			} else {
31559 			    if (comlast_1.islast) {
31560 				s_wsfe(&io___1374);
31561 /* Writing concatenation */
31562 				i__6[0] = 1, a__4[0] = all_1.sq;
31563 				i__6[1] = 10, a__4[1] = "parindent ";
31564 				s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)11);
31565 				do_fio(&c__1, ch__17, (ftnlen)11);
31566 				do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(
31567 					integer));
31568 				do_fio(&c__1, "pt", (ftnlen)2);
31569 				e_wsfe();
31570 			    }
31571 			}
31572 		    }
31573 		}
31574 		if (isystpg == 1) {
31575 
31576 /*  First line on a page (not 1st page, still first bar).  Tidy up old page */
31577 /*  then eject. */
31578 
31579 /*  Removed this 5/13/01 as it was causing double endvoltas.  This probably */
31580 /*  is only needed at the end in case there is no endvolta specified. */
31581 /*              if (onvolt) then */
31582 /* c                if (islast) write(11,'(a)')sq//'endvoltabox%' */
31583 /* c                onvolt = .false. */
31584 /*              end if */
31585 
31586 
31587 /*  Check for meter change at start of a new PAGE */
31588 
31589 		    if (all_1.mtrnuml > 0) {
31590 
31591 /*  Meter change at start of a new page.  Ugly repeated coding here. */
31592 
31593 			mtrnms = all_1.mtrnuml;
31594 			setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &
31595 				combeam_1.ibmtyp, &ibmrep);
31596 			all_1.mtrnuml = mtrnms;
31597 			if (comget_1.movbrk == 0 && comlast_1.islast) {
31598 			    wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
31599 			}
31600 		    }
31601 
31602 /*  Key signature change? */
31603 
31604 		    if (bit_test(iplnow,28) && comget_1.movbrk == 0) {
31605 /* Writing concatenation */
31606 			i__14[0] = 1, a__10[0] = all_1.sq;
31607 			i__14[1] = 4, a__10[1] = "xbar";
31608 			i__14[2] = 1, a__10[2] = all_1.sq;
31609 			i__14[3] = 10, a__10[3] = "addspace{-";
31610 			i__14[4] = 1, a__10[4] = all_1.sq;
31611 			i__14[5] = 14, a__10[5] = "afterruleskip}";
31612 			i__14[6] = 1, a__10[6] = all_1.sq;
31613 			i__14[7] = 17, a__10[7] = "generalsignature{";
31614 			s_cat(notexq, a__10, i__14, &c__8, (ftnlen)79);
31615 			lnote = 49;
31616 			if (comtop_1.isig < 0) {
31617 /* Writing concatenation */
31618 			    i__6[0] = 49, a__4[0] = notexq;
31619 			    i__6[1] = 1, a__4[1] = "-";
31620 			    s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
31621 			    lnote = 50;
31622 			}
31623 			if (comlast_1.islast) {
31624 			    s_wsfe(&io___1376);
31625 /* Writing concatenation */
31626 			    i__8[0] = lnote, a__5[0] = notexq;
31627 			    i__7 = abs(comtop_1.isig) + 48;
31628 			    chax_(ch__1, (ftnlen)1, &i__7);
31629 			    i__8[1] = 1, a__5[1] = ch__1;
31630 			    i__8[2] = 2, a__5[2] = "}%";
31631 			    s_cat(ch__24, a__5, i__8, &c__3, (ftnlen)82);
31632 			    do_fio(&c__1, ch__24, lnote + 3);
31633 			    e_wsfe();
31634 			}
31635 			if (comlast_1.islast && cominsttrans_1.laterinsttrans)
31636 				 {
31637 			    writesetsign_(&cominsttrans_1.ninsttrans,
31638 				    cominsttrans_1.iinsttrans,
31639 				    cominsttrans_1.itranskey, &
31640 				    cominsttrans_1.laterinsttrans);
31641 			}
31642 			if (comlast_1.islast && comignorenats_1.ignorenats) {
31643 			    s_wsfe(&io___1377);
31644 /* Writing concatenation */
31645 			    i__6[0] = 1, a__4[0] = all_1.sq;
31646 			    i__6[1] = 11, a__4[1] = "ignorenats%";
31647 			    s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)12);
31648 			    do_fio(&c__1, ch__13, (ftnlen)12);
31649 			    e_wsfe();
31650 			}
31651 			if (comlast_1.islast) {
31652 			    s_wsfe(&io___1378);
31653 /* Writing concatenation */
31654 			    i__9[0] = 1, a__6[0] = all_1.sq;
31655 			    i__9[1] = 14, a__6[1] = "zchangecontext";
31656 			    i__9[2] = 1, a__6[2] = all_1.sq;
31657 			    i__9[3] = 10, a__6[3] = "addspace{-";
31658 			    i__9[4] = 1, a__6[4] = all_1.sq;
31659 			    i__9[5] = 14, a__6[5] = "afterruleskip}";
31660 			    i__9[6] = 1, a__6[6] = all_1.sq;
31661 			    i__9[7] = 10, a__6[7] = "zstoppiece";
31662 			    i__9[8] = 1, a__6[8] = all_1.sq;
31663 			    i__9[9] = 13, a__6[9] = "PMXbarnotrue%";
31664 			    s_cat(ch__25, a__6, i__9, &c__10, (ftnlen)66);
31665 			    do_fio(&c__1, ch__25, (ftnlen)66);
31666 			    e_wsfe();
31667 			}
31668 		    } else if (all_1.mtrnuml > 0 && comget_1.movbrk == 0) {
31669 
31670 /*  Meter change but no signature change */
31671 
31672 			if (comlast_1.islast) {
31673 			    s_wsfe(&io___1379);
31674 /* Writing concatenation */
31675 			    i__3[0] = 1, a__1[0] = all_1.sq;
31676 			    i__3[1] = 14, a__1[1] = "xchangecontext";
31677 			    i__3[2] = 1, a__1[2] = all_1.sq;
31678 			    i__3[3] = 10, a__1[3] = "addspace{-";
31679 			    i__3[4] = 1, a__1[4] = all_1.sq;
31680 			    i__3[5] = 14, a__1[5] = "afterruleskip}";
31681 			    i__3[6] = 1, a__1[6] = all_1.sq;
31682 			    i__3[7] = 3, a__1[7] = "let";
31683 			    i__3[8] = 1, a__1[8] = all_1.sq;
31684 			    i__3[9] = 4, a__1[9] = "bnat";
31685 			    i__3[10] = 1, a__1[10] = all_1.sq;
31686 			    i__3[11] = 9, a__1[11] = "barnoadd%";
31687 			    s_cat(ch__26, a__1, i__3, &c__12, (ftnlen)60);
31688 			    do_fio(&c__1, ch__26, (ftnlen)60);
31689 			    e_wsfe();
31690 			}
31691 			if (comlast_1.islast) {
31692 			    s_wsfe(&io___1380);
31693 /* Writing concatenation */
31694 			    i__3[0] = 1, a__1[0] = all_1.sq;
31695 			    i__3[1] = 3, a__1[1] = "def";
31696 			    i__3[2] = 1, a__1[2] = all_1.sq;
31697 			    i__3[3] = 9, a__1[3] = "barnoadd{";
31698 			    i__3[4] = 1, a__1[4] = all_1.sq;
31699 			    i__3[5] = 3, a__1[5] = "let";
31700 			    i__3[6] = 1, a__1[6] = all_1.sq;
31701 			    i__3[7] = 8, a__1[7] = "barnoadd";
31702 			    i__3[8] = 1, a__1[8] = all_1.sq;
31703 			    i__3[9] = 5, a__1[9] = "bnat}";
31704 			    i__3[10] = 1, a__1[10] = all_1.sq;
31705 			    i__3[11] = 11, a__1[11] = "zstoppiece%";
31706 			    s_cat(ch__27, a__1, i__3, &c__12, (ftnlen)45);
31707 			    do_fio(&c__1, ch__27, (ftnlen)45);
31708 			    e_wsfe();
31709 			}
31710 		    } else {
31711 			if (comlast_1.islast) {
31712 			    s_wsfe(&io___1381);
31713 /* Writing concatenation */
31714 			    i__6[0] = 1, a__4[0] = all_1.sq;
31715 			    i__6[1] = 10, a__4[1] = "stoppiece%";
31716 			    s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)11);
31717 			    do_fio(&c__1, ch__17, (ftnlen)11);
31718 			    e_wsfe();
31719 			}
31720 		    }
31721 
31722 /*  This is the key spot when vshrink is used.  Value of vshrink here comes from */
31723 /*  just after the prior pagebreak, i.e., it is not affected by "Av" */
31724 /*  that may have been entered at this pagebreak, since that only affects usevshrink. */
31725 /*  So choose page *ending* (with or without \vfill) depending on old vshrink.  Then */
31726 /*  check value of usevshrink to reset vshrink if necessary for the new page, where */
31727 /*  we have to set \interstaff and later call puttitle. */
31728 /*  Top of first page needs special treatment.  For this we use */
31729 /*  novshrinktop, which was set in g1etnote on the first pass, since on */
31730 /*  second pass, vshrink at top of page one is dealt with in topfile, which is called */
31731 /*  *before* any reading in any "Av" at the top of the first input block. */
31732 
31733 		    if (! vshrink) {
31734 			xnstbot = xnsttop[comnotes_1.ipage - 1] * etabot /
31735 				etatop;
31736 			if (xnstbot < 9.95f) {
31737 			    s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10)
31738 				    ;
31739 			} else {
31740 			    s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10)
31741 				    ;
31742 			}
31743 			if (comlast_1.islast) {
31744 			    s_wsfe(&io___1383);
31745 /* Writing concatenation */
31746 			    i__6[0] = 1, a__4[0] = all_1.sq;
31747 			    i__6[1] = 5, a__4[1] = "vskip";
31748 			    s_cat(ch__28, a__4, i__6, &c__2, (ftnlen)6);
31749 			    do_fio(&c__1, ch__28, (ftnlen)6);
31750 			    do_fio(&c__1, (char *)&xnstbot, (ftnlen)sizeof(
31751 				    real));
31752 /* Writing concatenation */
31753 			    i__5[0] = 1, a__3[0] = all_1.sq;
31754 			    i__5[1] = 10, a__3[1] = "Interligne";
31755 			    i__5[2] = 1, a__3[2] = all_1.sq;
31756 			    i__5[3] = 6, a__3[3] = "eject%";
31757 			    s_cat(ch__23, a__3, i__5, &c__4, (ftnlen)18);
31758 			    do_fio(&c__1, ch__23, (ftnlen)18);
31759 			    e_wsfe();
31760 			}
31761 		    } else {
31762 			if (comlast_1.islast) {
31763 			    s_wsfe(&io___1384);
31764 /* Writing concatenation */
31765 			    i__5[0] = 1, a__3[0] = all_1.sq;
31766 			    i__5[1] = 5, a__3[1] = "vfill";
31767 			    i__5[2] = 1, a__3[2] = all_1.sq;
31768 			    i__5[3] = 6, a__3[3] = "eject%";
31769 			    s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)13);
31770 			    do_fio(&c__1, ch__15, (ftnlen)13);
31771 			    e_wsfe();
31772 			}
31773 		    }
31774 		    ++comnotes_1.ipage;
31775 
31776 /*  Now that page is ejected, compute new vshrink */
31777 
31778 		    vshrink = xintstaff[comnotes_1.ipage - 1] > 20.f &&
31779 			    comlast_1.usevshrink;
31780 		    if (vshrink) {
31781 			comarp_1.xinsnow = 10.f;
31782 		    } else {
31783 			comarp_1.xinsnow = xintstaff[comnotes_1.ipage - 1];
31784 		    }
31785 		    if (comget_1.fintstf > 0.f && comnotes_1.ipage > 1) {
31786 			comarp_1.xinsnow = comarp_1.xinsnow *
31787 				comget_1.fintstf / comget_1.gintstf;
31788 			comget_1.fintstf = -1.f;
31789 		    }
31790 		    if (comarp_1.xinsnow < 9.95f) {
31791 			s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10);
31792 		    } else if (comarp_1.xinsnow < 99.95f) {
31793 			s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10);
31794 		    } else {
31795 			s_copy(fmtq, "(a,f5.1,a)", (ftnlen)24, (ftnlen)10);
31796 		    }
31797 
31798 /*  Vertical spacing parameters, then restart */
31799 
31800 		    if (comlast_1.islast) {
31801 			s_wsfe(&io___1385);
31802 /* Writing concatenation */
31803 			i__6[0] = 1, a__4[0] = all_1.sq;
31804 			i__6[1] = 11, a__4[1] = "interstaff{";
31805 			s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)12);
31806 			do_fio(&c__1, ch__13, (ftnlen)12);
31807 			do_fio(&c__1, (char *)&comarp_1.xinsnow, (ftnlen)
31808 				sizeof(real));
31809 /* Writing concatenation */
31810 			i__8[0] = 1, a__5[0] = "}";
31811 			i__8[1] = 1, a__5[1] = all_1.sq;
31812 			i__8[2] = 9, a__5[2] = "contpiece";
31813 			s_cat(ch__17, a__5, i__8, &c__3, (ftnlen)11);
31814 			do_fio(&c__1, ch__17, (ftnlen)11);
31815 			e_wsfe();
31816 		    }
31817 
31818 /*  Check for meter change at start of a new PAGE */
31819 
31820 		    if (all_1.mtrnuml > 0) {
31821 
31822 /*  Meter change at start of a new page */
31823 
31824 			setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &
31825 				combeam_1.ibmtyp, &ibmrep);
31826 			if (comget_1.movbrk == 0) {
31827 			    if (comlast_1.islast) {
31828 				wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
31829 			    }
31830 			    if (all_1.mtrdnp > 0) {
31831 				if (comlast_1.islast) {
31832 				    s_wsfe(&io___1386);
31833 /* Writing concatenation */
31834 				    i__6[0] = 1, a__4[0] = all_1.sq;
31835 				    i__6[1] = 10, a__4[1] = "newtimes2%";
31836 				    s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)
31837 					    11);
31838 				    do_fio(&c__1, ch__17, (ftnlen)11);
31839 				    e_wsfe();
31840 				}
31841 				if (all_1.ibar == comgrace_1.ibarmbr) {
31842 				    comgrace_1.xb4mbr = comstart_1.facmtr *
31843 					    all_1.musicsize;
31844 				}
31845 			    }
31846 			}
31847 		    }
31848 
31849 /*  If no real titles here, which there probably will never be, make vertical */
31850 /*  space at page top with \titles{...}.  headlog=.false.<=>no real titles */
31851 
31852 		    puttitle_(&inhnoh, &xnsttop[comnotes_1.ipage - 1], &
31853 			    etatop, all_1.sq, &etait, &etatc, &etacs1, &
31854 			    all_1.nv, &vshrink, all_1.sepsymq, (ftnlen)1, (
31855 			    ftnlen)1);
31856 		    if (comnotes_1.headerspecial) {
31857 			s_wsfe(&io___1387);
31858 /* Writing concatenation */
31859 			chax_(ch__1, (ftnlen)1, &c__92);
31860 			i__6[0] = 1, a__4[0] = ch__1;
31861 			i__6[1] = 28, a__4[1] = "special{header=psslurs.pro}%"
31862 				;
31863 			s_cat(ch__7, a__4, i__6, &c__2, (ftnlen)29);
31864 			do_fio(&c__1, ch__7, (ftnlen)29);
31865 			e_wsfe();
31866 		    }
31867 
31868 /*  Write special header for first page */
31869 
31870 		} else {
31871 
31872 /*  First bar of system, not a new page, force line break */
31873 
31874 		    if (bit_test(iplnow,28)) {
31875 
31876 /*  Signature change */
31877 
31878 /* Writing concatenation */
31879 			i__14[0] = 1, a__10[0] = all_1.sq;
31880 			i__14[1] = 4, a__10[1] = "xbar";
31881 			i__14[2] = 1, a__10[2] = all_1.sq;
31882 			i__14[3] = 10, a__10[3] = "addspace{-";
31883 			i__14[4] = 1, a__10[4] = all_1.sq;
31884 			i__14[5] = 14, a__10[5] = "afterruleskip}";
31885 			i__14[6] = 1, a__10[6] = all_1.sq;
31886 			i__14[7] = 17, a__10[7] = "generalsignature{";
31887 			s_cat(notexq, a__10, i__14, &c__8, (ftnlen)79);
31888 			lnote = 49;
31889 			if (comtop_1.isig < 0) {
31890 /* Writing concatenation */
31891 			    i__6[0] = 49, a__4[0] = notexq;
31892 			    i__6[1] = 1, a__4[1] = "-";
31893 			    s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
31894 			    lnote = 50;
31895 			}
31896 			if (comlast_1.islast) {
31897 			    s_wsfe(&io___1388);
31898 /* Writing concatenation */
31899 			    i__8[0] = lnote, a__5[0] = notexq;
31900 			    i__7 = abs(comtop_1.isig) + 48;
31901 			    chax_(ch__1, (ftnlen)1, &i__7);
31902 			    i__8[1] = 1, a__5[1] = ch__1;
31903 			    i__8[2] = 2, a__5[2] = "}%";
31904 			    s_cat(ch__24, a__5, i__8, &c__3, (ftnlen)82);
31905 			    do_fio(&c__1, ch__24, lnote + 3);
31906 			    e_wsfe();
31907 			}
31908 			if (comlast_1.islast && cominsttrans_1.laterinsttrans)
31909 				 {
31910 			    writesetsign_(&cominsttrans_1.ninsttrans,
31911 				    cominsttrans_1.iinsttrans,
31912 				    cominsttrans_1.itranskey, &
31913 				    cominsttrans_1.laterinsttrans);
31914 			}
31915 			if (comlast_1.islast) {
31916 			    s_wsfe(&io___1389);
31917 /* Writing concatenation */
31918 			    i__5[0] = 1, a__3[0] = all_1.sq;
31919 			    i__5[1] = 7, a__3[1] = "advance";
31920 			    i__5[2] = 1, a__3[2] = all_1.sq;
31921 			    i__5[3] = 8, a__3[3] = "barno-1%";
31922 			    s_cat(ch__29, a__3, i__5, &c__4, (ftnlen)17);
31923 			    do_fio(&c__1, ch__29, (ftnlen)17);
31924 			    e_wsfe();
31925 			}
31926 			if (all_1.mtrnuml != 0) {
31927 
31928 /*  Meter+sig change, new line, may need mods if movement break here. */
31929 
31930 			    setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &
31931 				    combeam_1.ibmtyp, &ibmrep);
31932 			    if (comlast_1.islast) {
31933 				wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
31934 				if (comignorenats_1.ignorenats) {
31935 				    s_wsfe(&io___1390);
31936 /* Writing concatenation */
31937 				    i__6[0] = 1, a__4[0] = all_1.sq;
31938 				    i__6[1] = 11, a__4[1] = "ignorenats%";
31939 				    s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)
31940 					    12);
31941 				    do_fio(&c__1, ch__13, (ftnlen)12);
31942 				    e_wsfe();
31943 				}
31944 				s_wsfe(&io___1391);
31945 /* Writing concatenation */
31946 				i__3[0] = 1, a__1[0] = all_1.sq;
31947 				i__3[1] = 14, a__1[1] = "xchangecontext";
31948 				i__3[2] = 1, a__1[2] = all_1.sq;
31949 				i__3[3] = 10, a__1[3] = "addspace{-";
31950 				i__3[4] = 1, a__1[4] = all_1.sq;
31951 				i__3[5] = 14, a__1[5] = "afterruleskip}";
31952 				i__3[6] = 1, a__1[6] = all_1.sq;
31953 				i__3[7] = 10, a__1[7] = "zstoppiece";
31954 				i__3[8] = 1, a__1[8] = all_1.sq;
31955 				i__3[9] = 12, a__1[9] = "PMXbarnotrue";
31956 				i__3[10] = 1, a__1[10] = all_1.sq;
31957 				i__3[11] = 10, a__1[11] = "contpiece%";
31958 				s_cat(ch__30, a__1, i__3, &c__12, (ftnlen)76);
31959 				do_fio(&c__1, ch__30, (ftnlen)76);
31960 				e_wsfe();
31961 /*     *                'addspace{-'//sq//'afterruleskip}'//sq//'def' */
31962 /*     *                //sq//'writezbarno{}'//sq//'zalaligne%' */
31963 				s_wsfe(&io___1392);
31964 /* Writing concatenation */
31965 				i__5[0] = 1, a__3[0] = all_1.sq;
31966 				i__5[1] = 10, a__3[1] = "addspace{-";
31967 				i__5[2] = 1, a__3[2] = all_1.sq;
31968 				i__5[3] = 15, a__3[3] = "afterruleskip}%";
31969 				s_cat(ch__5, a__3, i__5, &c__4, (ftnlen)27);
31970 				do_fio(&c__1, ch__5, (ftnlen)27);
31971 				e_wsfe();
31972 				wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
31973 				if (comignorenats_1.ignorenats) {
31974 				    s_wsfe(&io___1393);
31975 /* Writing concatenation */
31976 				    i__6[0] = 1, a__4[0] = all_1.sq;
31977 				    i__6[1] = 11, a__4[1] = "ignorenats%";
31978 				    s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)
31979 					    12);
31980 				    do_fio(&c__1, ch__13, (ftnlen)12);
31981 				    e_wsfe();
31982 				}
31983 				s_wsfe(&io___1394);
31984 /* Writing concatenation */
31985 				i__6[0] = 1, a__4[0] = all_1.sq;
31986 				i__6[1] = 14, a__4[1] = "zchangecontext";
31987 				s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)15);
31988 				do_fio(&c__1, ch__14, (ftnlen)15);
31989 				e_wsfe();
31990 			    }
31991 			} else {
31992 			    if (comlast_1.islast &&
31993 				    comignorenats_1.ignorenats) {
31994 				s_wsfe(&io___1395);
31995 /* Writing concatenation */
31996 				i__6[0] = 1, a__4[0] = all_1.sq;
31997 				i__6[1] = 11, a__4[1] = "ignorenats%";
31998 				s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)12);
31999 				do_fio(&c__1, ch__13, (ftnlen)12);
32000 				e_wsfe();
32001 			    }
32002 			    if (comlast_1.islast) {
32003 				s_wsfe(&io___1396);
32004 /* Writing concatenation */
32005 				i__3[0] = 1, a__1[0] = all_1.sq;
32006 				i__3[1] = 14, a__1[1] = "xchangecontext";
32007 				i__3[2] = 1, a__1[2] = all_1.sq;
32008 				i__3[3] = 10, a__1[3] = "addspace{-";
32009 				i__3[4] = 1, a__1[4] = all_1.sq;
32010 				i__3[5] = 14, a__1[5] = "afterruleskip}";
32011 				i__3[6] = 1, a__1[6] = all_1.sq;
32012 				i__3[7] = 10, a__1[7] = "zstoppiece";
32013 				i__3[8] = 1, a__1[8] = all_1.sq;
32014 				i__3[9] = 12, a__1[9] = "PMXbarnotrue";
32015 				i__3[10] = 1, a__1[10] = all_1.sq;
32016 				i__3[11] = 10, a__1[11] = "contpiece%";
32017 				s_cat(ch__30, a__1, i__3, &c__12, (ftnlen)76);
32018 				do_fio(&c__1, ch__30, (ftnlen)76);
32019 				e_wsfe();
32020 			    }
32021 /*     *               'addspace{-'//sq//'afterruleskip}'//sq//'def'// */
32022 /*     *               sq//'writezbarno{}'//sq//'zalaligne%' */
32023 			}
32024 		    } else if (all_1.mtrnuml == 0) {
32025 
32026 /*  No meter change */
32027 
32028 			if (comlast_1.islast) {
32029 			    s_wsfe(&io___1397);
32030 /* Writing concatenation */
32031 			    i__6[0] = 1, a__4[0] = all_1.sq;
32032 			    i__6[1] = 8, a__4[1] = "alaligne";
32033 			    s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)9);
32034 			    do_fio(&c__1, ch__16, (ftnlen)9);
32035 			    e_wsfe();
32036 			}
32037 		    } else {
32038 
32039 /*  New meter, no new sig, end of line, not new page. */
32040 
32041 /* \generalmeter{\meterfrac{3}{4}}% */
32042 /* \xchangecontext\addspace{-\afterruleskip}% */
32043 /* \zalaligne\generalmeter{\meterfrac{3}{4}}\addspace{-\afterruleskip}% */
32044 /* \zchangecontext */
32045 
32046 			setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &
32047 				combeam_1.ibmtyp, &ibmrep);
32048 			if (comget_1.movbrk == 0) {
32049 			    if (comlast_1.islast) {
32050 				wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
32051 			    }
32052 			    if (all_1.mtrdnp > 0) {
32053 				if (comlast_1.islast) {
32054 				    s_wsfe(&io___1398);
32055 /* Writing concatenation */
32056 				    i__3[0] = 1, a__1[0] = all_1.sq;
32057 				    i__3[1] = 3, a__1[1] = "let";
32058 				    i__3[2] = 1, a__1[2] = all_1.sq;
32059 				    i__3[3] = 4, a__1[3] = "bnat";
32060 				    i__3[4] = 1, a__1[4] = all_1.sq;
32061 				    i__3[5] = 8, a__1[5] = "barnoadd";
32062 				    i__3[6] = 1, a__1[6] = all_1.sq;
32063 				    i__3[7] = 3, a__1[7] = "def";
32064 				    i__3[8] = 1, a__1[8] = all_1.sq;
32065 				    i__3[9] = 9, a__1[9] = "barnoadd{";
32066 				    i__3[10] = 1, a__1[10] = all_1.sq;
32067 				    i__3[11] = 7, a__1[11] = "empty}%";
32068 				    s_cat(ch__31, a__1, i__3, &c__12, (ftnlen)
32069 					    40);
32070 				    do_fio(&c__1, ch__31, (ftnlen)40);
32071 				    e_wsfe();
32072 				    s_wsfe(&io___1399);
32073 /* Writing concatenation */
32074 				    i__15[0] = 1, a__11[0] = all_1.sq;
32075 				    i__15[1] = 14, a__11[1] = "xchangecontext"
32076 					    ;
32077 				    i__15[2] = 1, a__11[2] = all_1.sq;
32078 				    i__15[3] = 10, a__11[3] = "addspace{-";
32079 				    i__15[4] = 1, a__11[4] = all_1.sq;
32080 				    i__15[5] = 14, a__11[5] = "afterruleskip}"
32081 					    ;
32082 				    i__15[6] = 1, a__11[6] = all_1.sq;
32083 				    i__15[7] = 9, a__11[7] = "zalaligne";
32084 				    i__15[8] = 1, a__11[8] = all_1.sq;
32085 				    i__15[9] = 3, a__11[9] = "let";
32086 				    i__15[10] = 1, a__11[10] = all_1.sq;
32087 				    i__15[11] = 8, a__11[11] = "barnoadd";
32088 				    i__15[12] = 1, a__11[12] = all_1.sq;
32089 				    i__15[13] = 4, a__11[13] = "bnat";
32090 				    s_cat(ch__32, a__11, i__15, &c__14, (
32091 					    ftnlen)69);
32092 				    do_fio(&c__1, ch__32, (ftnlen)69);
32093 				    e_wsfe();
32094 				    wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
32095 				    s_wsfe(&io___1400);
32096 /* Writing concatenation */
32097 				    i__4[0] = 1, a__2[0] = all_1.sq;
32098 				    i__4[1] = 10, a__2[1] = "addspace{-";
32099 				    i__4[2] = 1, a__2[2] = all_1.sq;
32100 				    i__4[3] = 14, a__2[3] = "afterruleskip}";
32101 				    i__4[4] = 1, a__2[4] = all_1.sq;
32102 				    i__4[5] = 14, a__2[5] = "zchangecontext";
32103 				    s_cat(ch__33, a__2, i__4, &c__6, (ftnlen)
32104 					    41);
32105 				    do_fio(&c__1, ch__33, (ftnlen)41);
32106 				    e_wsfe();
32107 				}
32108 				if (all_1.ibar == comgrace_1.ibarmbr) {
32109 				    comgrace_1.xb4mbr = comstart_1.facmtr *
32110 					    all_1.musicsize;
32111 				}
32112 			    } else {
32113 				if (comlast_1.islast) {
32114 				    s_wsfe(&io___1401);
32115 /* Writing concatenation */
32116 				    i__6[0] = 1, a__4[0] = all_1.sq;
32117 				    i__6[1] = 8, a__4[1] = "alaligne";
32118 				    s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)
32119 					    9);
32120 				    do_fio(&c__1, ch__16, (ftnlen)9);
32121 				    e_wsfe();
32122 				}
32123 			    }
32124 			} else {
32125 			    if (comlast_1.islast) {
32126 				s_wsfe(&io___1402);
32127 /* Writing concatenation */
32128 				i__6[0] = 1, a__4[0] = all_1.sq;
32129 				i__6[1] = 8, a__4[1] = "alaligne";
32130 				s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)9);
32131 				do_fio(&c__1, ch__16, (ftnlen)9);
32132 				e_wsfe();
32133 			    }
32134 			}
32135 		    }
32136 		}
32137 
32138 /*  Modified 090525 to use \bnrs */
32139 
32140 		if (slint) {
32141 		    slint = FALSE_;
32142 		    if (comlast_1.islast) {
32143 			s_wsfe(&io___1403);
32144 /* Writing concatenation */
32145 			i__5[0] = 1, a__3[0] = all_1.sq;
32146 			i__5[1] = 3, a__3[1] = "def";
32147 			i__5[2] = 1, a__3[2] = all_1.sq;
32148 			i__5[3] = 11, a__3[3] = "raisebarno{";
32149 			s_cat(ch__21, a__3, i__5, &c__4, (ftnlen)16);
32150 			do_fio(&c__1, ch__21, (ftnlen)16);
32151 			do_fio(&c__1, (char *)&comsln_1.irzbnd, (ftnlen)
32152 				sizeof(integer));
32153 /* Writing concatenation */
32154 			i__8[0] = 2, a__5[0] = ".5";
32155 			i__8[1] = 1, a__5[1] = all_1.sq;
32156 			i__8[2] = 11, a__5[2] = "internote}%";
32157 			s_cat(ch__10, a__5, i__8, &c__3, (ftnlen)14);
32158 			do_fio(&c__1, ch__10, (ftnlen)14);
32159 			e_wsfe();
32160 		    }
32161 		}
32162 		comget_1.movbrk = 0;
32163 	    }
32164 
32165 /*  Clean up if we squelched bar number reset at movement break */
32166 
32167 	    if (comnotes_1.nobar1) {
32168 		if (comlast_1.islast) {
32169 		    s_wsfe(&io___1404);
32170 /* Writing concatenation */
32171 		    i__6[0] = 1, a__4[0] = all_1.sq;
32172 		    i__6[1] = 11, a__4[1] = "startbarno1";
32173 		    s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)12);
32174 		    do_fio(&c__1, ch__13, (ftnlen)12);
32175 		    e_wsfe();
32176 		}
32177 		comnotes_1.nobar1 = FALSE_;
32178 	    }
32179 	    i__7 = s_rsle(&io___1405);
32180 	    if (i__7 != 0) {
32181 		goto L14;
32182 	    }
32183 	    i__7 = do_lio(&c__3, &c__1, (char *)&iauto, (ftnlen)sizeof(
32184 		    integer));
32185 	    if (i__7 != 0) {
32186 		goto L14;
32187 	    }
32188 	    i__7 = e_rsle();
32189 	    if (i__7 != 0) {
32190 		goto L14;
32191 	    }
32192 L14:
32193 
32194 /*  We come thru here for the 1st bar of every system, so initialize is1n1 */
32195 
32196 	    comsln_1.is1n1 = 0;
32197 
32198 /*  Brought down from above */
32199 
32200 	    if (isystpg == comnotes_1.nsystp[comnotes_1.ipage - 1]) {
32201 		isystpg = 0;
32202 	    }
32203 
32204 /*  Check for linebreak ties */
32205 
32206 	    if (ispstie) {
32207 		linebreakties_(all_1.isdat1, all_1.isdat2, all_1.isdat3,
32208 			all_1.isdat4, &all_1.nsdat, &ispstie, all_1.sepsymq, (
32209 			ftnlen)1);
32210 	    }
32211 	} else {
32212 
32213 /*  Not first bar of system */
32214 
32215 	    if (bit_test(iplnow,28)) {
32216 
32217 /*  Signature change */
32218 
32219 		if (all_1.mtrnuml != 0) {
32220 
32221 /*  Meter+signature change mid line, assume no movement break */
32222 
32223 		    setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &
32224 			    combeam_1.ibmtyp, &ibmrep);
32225 		    if (comlast_1.islast) {
32226 			wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
32227 		    }
32228 /* Writing concatenation */
32229 		    i__6[0] = 1, a__4[0] = all_1.sq;
32230 		    i__6[1] = 17, a__4[1] = "generalsignature{";
32231 		    s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
32232 		    lnote = 18;
32233 		    if (comtop_1.isig < 0) {
32234 /* Writing concatenation */
32235 			i__6[0] = 18, a__4[0] = notexq;
32236 			i__6[1] = 1, a__4[1] = "-";
32237 			s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
32238 			lnote = 19;
32239 		    }
32240 		    if (comlast_1.islast) {
32241 			iptemp = abs(comtop_1.isig) + 48;
32242 			chax_(ch__1, (ftnlen)1, &iptemp);
32243 			*(unsigned char *)charq = *(unsigned char *)&ch__1[0];
32244 /* Writing concatenation */
32245 			i__8[0] = lnote, a__5[0] = notexq;
32246 			i__8[1] = 1, a__5[1] = charq;
32247 			i__8[2] = 2, a__5[2] = "}%";
32248 			s_cat(notexq, a__5, i__8, &c__3, (ftnlen)79);
32249 			lnote += 3;
32250 			s_wsfe(&io___1408);
32251 			do_fio(&c__1, notexq, lnote);
32252 			e_wsfe();
32253 			if (comlast_1.islast && cominsttrans_1.laterinsttrans)
32254 				 {
32255 			    writesetsign_(&cominsttrans_1.ninsttrans,
32256 				    cominsttrans_1.iinsttrans,
32257 				    cominsttrans_1.itranskey, &
32258 				    cominsttrans_1.laterinsttrans);
32259 			}
32260 			if (comignorenats_1.ignorenats) {
32261 			    s_wsfe(&io___1409);
32262 /* Writing concatenation */
32263 			    i__6[0] = 1, a__4[0] = all_1.sq;
32264 			    i__6[1] = 11, a__4[1] = "ignorenats%";
32265 			    s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)12);
32266 			    do_fio(&c__1, ch__13, (ftnlen)12);
32267 			    e_wsfe();
32268 			}
32269 			s_wsfe(&io___1410);
32270 /* Writing concatenation */
32271 			i__6[0] = 1, a__4[0] = all_1.sq;
32272 			i__6[1] = 15, a__4[1] = "xchangecontext%";
32273 			s_cat(ch__21, a__4, i__6, &c__2, (ftnlen)16);
32274 			do_fio(&c__1, ch__21, (ftnlen)16);
32275 			e_wsfe();
32276 		    }
32277 		    if (all_1.ibar == comgrace_1.ibarmbr) {
32278 
32279 /*  Compute space for multibar rest */
32280 
32281 			if (comtop_1.lastisig * comtop_1.isig >= 0) {
32282 /* Computing MAX */
32283 			    i__7 = abs(comtop_1.lastisig), i__2 = abs(
32284 				    comtop_1.isig);
32285 			    naccs = max(i__7,i__2);
32286 			} else {
32287 			    naccs = (i__7 = comtop_1.lastisig - comtop_1.isig,
32288 				     abs(i__7));
32289 			}
32290 			comgrace_1.xb4mbr = (comstart_1.facmtr + naccs * .24f)
32291 				 * all_1.musicsize;
32292 		    }
32293 		} else {
32294 
32295 /*  Signature change only */
32296 
32297 /* Writing concatenation */
32298 		    i__14[0] = 1, a__10[0] = all_1.sq;
32299 		    i__14[1] = 4, a__10[1] = "xbar";
32300 		    i__14[2] = 1, a__10[2] = all_1.sq;
32301 		    i__14[3] = 10, a__10[3] = "addspace{-";
32302 		    i__14[4] = 1, a__10[4] = all_1.sq;
32303 		    i__14[5] = 14, a__10[5] = "afterruleskip}";
32304 		    i__14[6] = 1, a__10[6] = all_1.sq;
32305 		    i__14[7] = 17, a__10[7] = "generalsignature{";
32306 		    s_cat(notexq, a__10, i__14, &c__8, (ftnlen)79);
32307 		    lnote = 49;
32308 		    if (comtop_1.isig < 0) {
32309 /* Writing concatenation */
32310 			i__6[0] = 49, a__4[0] = notexq;
32311 			i__6[1] = 1, a__4[1] = "-";
32312 			s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
32313 			lnote = 50;
32314 		    }
32315 		    if (comlast_1.islast) {
32316 			s_wsfe(&io___1412);
32317 /* Writing concatenation */
32318 			i__8[0] = lnote, a__5[0] = notexq;
32319 			i__7 = abs(comtop_1.isig) + 48;
32320 			chax_(ch__1, (ftnlen)1, &i__7);
32321 			i__8[1] = 1, a__5[1] = ch__1;
32322 			i__8[2] = 2, a__5[2] = "}%";
32323 			s_cat(ch__24, a__5, i__8, &c__3, (ftnlen)82);
32324 			do_fio(&c__1, ch__24, lnote + 3);
32325 			e_wsfe();
32326 		    }
32327 		    if (comlast_1.islast && cominsttrans_1.laterinsttrans) {
32328 			writesetsign_(&cominsttrans_1.ninsttrans,
32329 				cominsttrans_1.iinsttrans,
32330 				cominsttrans_1.itranskey, &
32331 				cominsttrans_1.laterinsttrans);
32332 		    }
32333 		    if (comlast_1.islast && comignorenats_1.ignorenats) {
32334 			s_wsfe(&io___1413);
32335 /* Writing concatenation */
32336 			i__6[0] = 1, a__4[0] = all_1.sq;
32337 			i__6[1] = 11, a__4[1] = "ignorenats%";
32338 			s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)12);
32339 			do_fio(&c__1, ch__13, (ftnlen)12);
32340 			e_wsfe();
32341 		    }
32342 		    if (comlast_1.islast) {
32343 			s_wsfe(&io___1414);
32344 /* Writing concatenation */
32345 			i__4[0] = 1, a__2[0] = all_1.sq;
32346 			i__4[1] = 14, a__2[1] = "zchangecontext";
32347 			i__4[2] = 1, a__2[2] = all_1.sq;
32348 			i__4[3] = 12, a__2[3] = "addspace{-.5";
32349 			i__4[4] = 1, a__2[4] = all_1.sq;
32350 			i__4[5] = 15, a__2[5] = "afterruleskip}%";
32351 			s_cat(ch__34, a__2, i__4, &c__6, (ftnlen)44);
32352 			do_fio(&c__1, ch__34, (ftnlen)44);
32353 			e_wsfe();
32354 		    }
32355 		    if (all_1.ibar == comgrace_1.ibarmbr) {
32356 
32357 /*  Compute space for multibar rest */
32358 
32359 			if (comtop_1.lastisig * comtop_1.isig >= 0) {
32360 /* Computing MAX */
32361 			    i__7 = abs(comtop_1.lastisig), i__2 = abs(
32362 				    comtop_1.isig);
32363 			    naccs = max(i__7,i__2);
32364 			} else {
32365 			    naccs = (i__7 = comtop_1.lastisig - comtop_1.isig,
32366 				     abs(i__7));
32367 			}
32368 			comgrace_1.xb4mbr = naccs * .24f * all_1.musicsize;
32369 		    }
32370 		}
32371 	    } else if (all_1.mtrnuml == 0) {
32372 
32373 /*  No meter change */
32374 
32375 		if (comlast_1.islast) {
32376 		    s_wsfe(&io___1415);
32377 /* Writing concatenation */
32378 		    i__6[0] = 1, a__4[0] = all_1.sq;
32379 		    i__6[1] = 4, a__4[1] = "xbar";
32380 		    s_cat(ch__35, a__4, i__6, &c__2, (ftnlen)5);
32381 		    do_fio(&c__1, ch__35, (ftnlen)5);
32382 		    e_wsfe();
32383 		}
32384 	    } else {
32385 
32386 /*  Change meter midline */
32387 
32388 		setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &combeam_1.ibmtyp, &
32389 			ibmrep);
32390 		if (comget_1.movbrk == 0) {
32391 		    if (comlast_1.islast) {
32392 			wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
32393 		    }
32394 		    if (all_1.mtrdnp > 0) {
32395 			if (comlast_1.islast) {
32396 			    s_wsfe(&io___1416);
32397 /* Writing concatenation */
32398 			    i__6[0] = 1, a__4[0] = all_1.sq;
32399 			    i__6[1] = 10, a__4[1] = "newtimes0%";
32400 			    s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)11);
32401 			    do_fio(&c__1, ch__17, (ftnlen)11);
32402 			    e_wsfe();
32403 			}
32404 			if (all_1.ibar == comgrace_1.ibarmbr) {
32405 			    comgrace_1.xb4mbr = comstart_1.facmtr *
32406 				    all_1.musicsize;
32407 			}
32408 		    } else {
32409 			if (comlast_1.islast) {
32410 			    s_wsfe(&io___1417);
32411 /* Writing concatenation */
32412 			    i__6[0] = 1, a__4[0] = all_1.sq;
32413 			    i__6[1] = 4, a__4[1] = "xbar";
32414 			    s_cat(ch__35, a__4, i__6, &c__2, (ftnlen)5);
32415 			    do_fio(&c__1, ch__35, (ftnlen)5);
32416 			    e_wsfe();
32417 			}
32418 		    }
32419 		}
32420 	    }
32421 	}
32422 
32423 /*  Now that xbar's are written, can put in left-repeats at line beginnings */
32424 
32425 	if (lrptpend) {
32426 	    if (comlast_1.islast) {
32427 		s_wsfe(&io___1418);
32428 /* Writing concatenation */
32429 		i__4[0] = 1, a__2[0] = all_1.sq;
32430 		i__4[1] = 7, a__2[1] = "advance";
32431 		i__4[2] = 1, a__2[2] = all_1.sq;
32432 		i__4[3] = 7, a__2[3] = "barno-1";
32433 		i__4[4] = 1, a__2[4] = all_1.sq;
32434 		i__4[5] = 10, a__2[5] = "leftrepeat";
32435 		s_cat(ch__5, a__2, i__4, &c__6, (ftnlen)27);
32436 		do_fio(&c__1, ch__5, (ftnlen)27);
32437 		e_wsfe();
32438 	    }
32439 	    lrptpend = FALSE_;
32440 	}
32441 	if (all_1.ibar > 1) {
32442 
32443 /*  For bars after first, slide all stuff down to beginning of arrays */
32444 
32445 	    i__7 = all_1.nv;
32446 	    for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) {
32447 		i__2 = commvl_1.nvmx[all_1.iv - 1];
32448 		for (kv = 1; kv <= i__2; ++kv) {
32449 		    commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
32450 		    ioff = all_1.nib[commvl_1.ivx + (all_1.ibar - 1) * 24 -
32451 			    25];
32452 		    i__13 = all_1.nib[commvl_1.ivx + all_1.ibar * 24 - 25] -
32453 			    ioff;
32454 		    for (ip = 1; ip <= i__13; ++ip) {
32455 			all_1.nolev[commvl_1.ivx + ip * 24 - 25] =
32456 				all_1.nolev[commvl_1.ivx + (ip + ioff) * 24 -
32457 				25];
32458 			all_1.nodur[commvl_1.ivx + ip * 24 - 25] =
32459 				all_1.nodur[commvl_1.ivx + (ip + ioff) * 24 -
32460 				25];
32461 			all_1.nacc[commvl_1.ivx + ip * 24 - 25] = all_1.nacc[
32462 				commvl_1.ivx + (ip + ioff) * 24 - 25];
32463 			all_1.irest[commvl_1.ivx + ip * 24 - 25] =
32464 				all_1.irest[commvl_1.ivx + (ip + ioff) * 24 -
32465 				25];
32466 			all_1.islur[commvl_1.ivx + ip * 24 - 25] =
32467 				all_1.islur[commvl_1.ivx + (ip + ioff) * 24 -
32468 				25];
32469 			all_1.ipl[commvl_1.ivx + ip * 24 - 25] = all_1.ipl[
32470 				commvl_1.ivx + (ip + ioff) * 24 - 25];
32471 			all_1.iornq[commvl_1.ivx + ip * 24 - 1] = all_1.iornq[
32472 				commvl_1.ivx + (ip + ioff) * 24 - 1];
32473 			all_1.mult[commvl_1.ivx + ip * 24 - 25] = all_1.mult[
32474 				commvl_1.ivx + (ip + ioff) * 24 - 25];
32475 /*              if (ivx.le.2 .and. figbass) */
32476 /*     *                isfig(ivx,ip) = isfig(ivx,ip+ioff) */
32477 			if (all_1.figbass && commvl_1.ivx == 1 ||
32478 				commvl_1.ivx == comfig_1.ivxfig2) {
32479 			    if (commvl_1.ivx == 1) {
32480 				all_1.isfig[(ip << 1) - 2] = all_1.isfig[(ip
32481 					+ ioff << 1) - 2];
32482 			    } else {
32483 				all_1.isfig[(ip << 1) - 1] = all_1.isfig[(ip
32484 					+ ioff << 1) - 1];
32485 			    }
32486 			}
32487 /* L12: */
32488 		    }
32489 		    if (commvl_1.ivx <= all_1.nv && comcc_1.ncc[all_1.iv - 1]
32490 			    > 1) {
32491 			islide = 0;
32492 			i__13 = comcc_1.ncc[all_1.iv - 1];
32493 			for (icc = 1; icc <= i__13; ++icc) {
32494 			    if (comcc_1.tcc[all_1.iv + icc * 24 - 25] <= (
32495 				    real) all_1.lenbar) {
32496 
32497 /*  This time will drop <=0 when slid. */
32498 
32499 				islide = icc - 1;
32500 				comcc_1.ncmidcc[all_1.iv - 1] =
32501 					comcc_1.ncmidcc[all_1.iv + icc * 24 -
32502 					25];
32503 			    } else {
32504 				comcc_1.tcc[all_1.iv + (icc - islide) * 24 -
32505 					25] = comcc_1.tcc[all_1.iv + icc * 24
32506 					- 25] - all_1.lenbar;
32507 				comcc_1.ncmidcc[all_1.iv + (icc - islide) *
32508 					24 - 25] = comcc_1.ncmidcc[all_1.iv +
32509 					icc * 24 - 25];
32510 			    }
32511 /* L13: */
32512 			}
32513 			comcc_1.ncc[all_1.iv - 1] -= islide;
32514 			comcc_1.tcc[all_1.iv - 1] = 0.f;
32515 		    }
32516 /* L11: */
32517 		}
32518 	    }
32519 	    i__2 = comgrace_1.ngrace;
32520 	    for (ig = 1; ig <= i__2; ++ig) {
32521 		comgrace_1.ipg[ig - 1] -= all_1.nib[comgrace_1.ivg[ig - 1] + (
32522 			all_1.ibar - 1) * 24 - 25];
32523 		if (all_1.ibar > 2) {
32524 		    comgrace_1.ipg[ig - 1] += all_1.nib[comgrace_1.ivg[ig - 1]
32525 			     + (all_1.ibar - 2) * 24 - 25];
32526 		}
32527 /* L15: */
32528 	    }
32529 	    i__2 = comgrace_1.nlit;
32530 	    for (il = 1; il <= i__2; ++il) {
32531 		comgrace_1.iplit[il - 1] -= all_1.nib[comgrace_1.ivlit[il - 1]
32532 			 + (all_1.ibar - 1) * 24 - 25];
32533 		if (all_1.ibar > 2) {
32534 		    comgrace_1.iplit[il - 1] += all_1.nib[comgrace_1.ivlit[il
32535 			    - 1] + (all_1.ibar - 2) * 24 - 25];
32536 		}
32537 /* L21: */
32538 	    }
32539 	    i__2 = comtrill_1.ntrill;
32540 	    for (it = 1; it <= i__2; ++it) {
32541 		comtrill_1.iptrill[it - 1] -= all_1.nib[comtrill_1.ivtrill[it
32542 			- 1] + (all_1.ibar - 1) * 24 - 25];
32543 		if (all_1.ibar > 2) {
32544 		    comtrill_1.iptrill[it - 1] += all_1.nib[
32545 			    comtrill_1.ivtrill[it - 1] + (all_1.ibar - 2) *
32546 			    24 - 25];
32547 		}
32548 /* L22: */
32549 	    }
32550 	    i__2 = comtrill_1.ncrd;
32551 	    for (icrd = 1; icrd <= i__2; ++icrd) {
32552 /*            ivx = iand(15,ishft(icrdat(icrd),-8)) */
32553 		commvl_1.ivx = (15 & lbit_shift(comtrill_1.icrdat[icrd - 1], (
32554 			ftnlen)-8)) + (igetbits_(&comtrill_1.icrdat[icrd - 1],
32555 			 &c__1, &c__28) << 4);
32556 		ipnew = (255 & comtrill_1.icrdat[icrd - 1]) - all_1.nib[
32557 			commvl_1.ivx + (all_1.ibar - 1) * 24 - 25];
32558 		if (all_1.ibar > 2) {
32559 		    ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 -
32560 			    25];
32561 		}
32562 		comtrill_1.icrdat[icrd - 1] = -256 & comtrill_1.icrdat[icrd -
32563 			1];
32564 		comtrill_1.icrdat[icrd - 1] = max(0,ipnew) |
32565 			comtrill_1.icrdat[icrd - 1];
32566 /* L27: */
32567 	    }
32568 	    i__2 = comtrill_1.nudorn;
32569 	    for (iudorn = 1; iudorn <= i__2; ++iudorn) {
32570 /*            ivx = iand(15,ishft(kudorn(iudorn),-8)) */
32571 		commvl_1.ivx = comivxudorn_1.ivxudorn[iudorn - 1];
32572 		ipnew = (255 & comtrill_1.kudorn[iudorn - 1]) - all_1.nib[
32573 			commvl_1.ivx + (all_1.ibar - 1) * 24 - 25];
32574 		if (all_1.ibar > 2) {
32575 		    ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 -
32576 			    25];
32577 		}
32578 		comtrill_1.kudorn[iudorn - 1] = -256 & comtrill_1.kudorn[
32579 			iudorn - 1];
32580 		comtrill_1.kudorn[iudorn - 1] = max(0,ipnew) |
32581 			comtrill_1.kudorn[iudorn - 1];
32582 /* L29: */
32583 	    }
32584 	    i__2 = comdyn_1.ndyn;
32585 	    for (idyn = 1; idyn <= i__2; ++idyn) {
32586 		idynd = comdyn_1.idyndat[idyn - 1];
32587 /*            ivx = iand(15,idynd) */
32588 		commvl_1.ivx = (15 & idynd) + (igetbits_(&comdyn_1.idynda2[
32589 			idyn - 1], &c__1, &c__10) << 4);
32590 		ipnew = igetbits_(&idynd, &c__8, &c__4) - all_1.nib[
32591 			commvl_1.ivx + (all_1.ibar - 1) * 24 - 25];
32592 
32593 /* The following construction avoids array bound errors in some compilers */
32594 
32595 		if (all_1.ibar > 2) {
32596 		    ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 -
32597 			    25];
32598 		}
32599 		ipnew = i_dim(&ipnew, &c__0);
32600 		setbits_(&idynd, &c__8, &c__4, &ipnew);
32601 		comdyn_1.idyndat[idyn - 1] = idynd;
32602 /* L42: */
32603 	    }
32604 	    i__2 = comdyn_1.ntxtdyn;
32605 	    for (itxtdyn = 1; itxtdyn <= i__2; ++itxtdyn) {
32606 		idynd = comdyn_1.ivxiptxt[itxtdyn - 1];
32607 /*            ivx = iand(15,idynd) */
32608 		commvl_1.ivx = 31 & idynd;
32609 /*            ipnew = igetbits(idynd,8,4)-nib(ivx,ibar-1) */
32610 		ipnew = igetbits_(&idynd, &c__8, &c__5) - all_1.nib[
32611 			commvl_1.ivx + (all_1.ibar - 1) * 24 - 25];
32612 		if (all_1.ibar > 2) {
32613 		    ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 -
32614 			    25];
32615 		}
32616 		ipnew = i_dim(&ipnew, &c__0);
32617 /*            call setbits(idynd,8,4,ipnew) */
32618 		setbits_(&idynd, &c__8, &c__5, &ipnew);
32619 		comdyn_1.ivxiptxt[itxtdyn - 1] = idynd;
32620 /* L43: */
32621 	    }
32622 	    i__2 = all_1.nsdat;
32623 	    for (isdat = 1; isdat <= i__2; ++isdat) {
32624 		isdata = all_1.isdat1[isdat - 1];
32625 		commvl_1.ivx = commvl_1.ivmx[igetbits_(&isdata, &c__5, &c__13)
32626 			 + (igetbits_(&isdata, &c__1, &c__12) + 1) * 24 - 25];
32627 		ipnew = igetbits_(&isdata, &c__8, &c__3) - all_1.nib[
32628 			commvl_1.ivx + (all_1.ibar - 1) * 24 - 25];
32629 		if (all_1.ibar > 2) {
32630 		    ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 -
32631 			    25];
32632 		}
32633 		ipnew = i_dim(&ipnew, &c__0);
32634 		setbits_(&isdata, &c__8, &c__3, &ipnew);
32635 		all_1.isdat1[isdat - 1] = isdata;
32636 /* L41: */
32637 	    }
32638 	    i__2 = comcb_1.nbc;
32639 	    for (ibc = 1; ibc <= i__2; ++ibc) {
32640 /*            ivx = iand(15,ibcdata(ibc)) */
32641 		commvl_1.ivx = (15 & comcb_1.ibcdata[ibc - 1]) + (igetbits_(&
32642 			comcb_1.ibcdata[ibc - 1], &c__1, &c__28) << 4);
32643 		ipnew = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__4) -
32644 			all_1.nib[commvl_1.ivx + (all_1.ibar - 1) * 24 - 25];
32645 		if (all_1.ibar > 2) {
32646 		    ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 -
32647 			    25];
32648 		}
32649 		ipnew = i_dim(&ipnew, &c__0);
32650 		setbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__4, &ipnew);
32651 /* L44: */
32652 	    }
32653 	    i__2 = comarpshift_1.numarpshift;
32654 	    for (iarps = 1; iarps <= i__2; ++iarps) {
32655 		comarpshift_1.iparpshift[iarps - 1] -= all_1.nib[
32656 			comarpshift_1.ivarpshift[iarps - 1] + (all_1.ibar - 1)
32657 			 * 24 - 25];
32658 		if (all_1.ibar > 2) {
32659 		    comarpshift_1.iparpshift[iarps - 1] += all_1.nib[
32660 			    comarpshift_1.ivarpshift[iarps - 1] + (all_1.ibar
32661 			    - 2) * 24 - 25];
32662 		}
32663 /* L45: */
32664 	    }
32665 
32666 /*  Bookkeeping for figures.  This will set nfigs = 0 if there are no figs left. */
32667 /*  If there are figs left, it will reset all times relative to start of */
32668 /*  current bar. */
32669 
32670 	    for (commvl_1.ivx = 1; commvl_1.ivx <= 2; ++commvl_1.ivx) {
32671 		if (all_1.figbass) {
32672 		    islide = 0;
32673 		    i__2 = comfig_1.nfigs[commvl_1.ivx - 1];
32674 		    for (jfig = 1; jfig <= i__2; ++jfig) {
32675 			if (comfig_1.itfig[commvl_1.ivx + (jfig << 1) - 3] <
32676 				all_1.lenbar) {
32677 
32678 /*  This figure was already used */
32679 
32680 			    islide = jfig;
32681 			} else {
32682 			    comfig_1.itfig[commvl_1.ivx + (jfig - islide << 1)
32683 				     - 3] = comfig_1.itfig[commvl_1.ivx + (
32684 				    jfig << 1) - 3] - all_1.lenbar;
32685 			    s_copy(comfig_1.figq + (commvl_1.ivx + (jfig -
32686 				    islide << 1) - 3) * 10, comfig_1.figq + (
32687 				    commvl_1.ivx + (jfig << 1) - 3) * 10, (
32688 				    ftnlen)10, (ftnlen)10);
32689 			    comgrace_1.itoff[commvl_1.ivx + (jfig - islide <<
32690 				    1) - 3] = comgrace_1.itoff[commvl_1.ivx +
32691 				    (jfig << 1) - 3];
32692 			    comfig_1.ivupfig[commvl_1.ivx + (jfig - islide <<
32693 				    1) - 3] = comfig_1.ivupfig[commvl_1.ivx +
32694 				    (jfig << 1) - 3];
32695 			}
32696 /* L20: */
32697 		    }
32698 		    comfig_1.nfigs[commvl_1.ivx - 1] -= islide;
32699 		}
32700 		if (comfig_1.nfigs[1] == 0) {
32701 		    goto L47;
32702 		}
32703 /* L46: */
32704 	    }
32705 L47:
32706 	    ;
32707 	}
32708 
32709 /*  End of sliding down for bars after first in gulp. */
32710 
32711 /*  The following may not be needed by makeabar, but just in case... */
32712 
32713 	if (all_1.firstgulp && all_1.lenb0 != 0) {
32714 	    if (all_1.ibar == 1) {
32715 		all_1.lenbar = all_1.lenb0;
32716 	    } else {
32717 		all_1.lenbar = all_1.lenb1;
32718 	    }
32719 	}
32720 
32721 /*  Equal line spacing stuff */
32722 
32723 	if (comget_1.equalize && comask_1.bar1syst) {
32724 	    if (isystpg == 1) {
32725 		s_wsfe(&io___1434);
32726 /* Writing concatenation */
32727 		i__6[0] = 1, a__4[0] = all_1.sq;
32728 		i__6[1] = 8, a__4[1] = "starteq%";
32729 		s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)9);
32730 		do_fio(&c__1, ch__16, (ftnlen)9);
32731 		e_wsfe();
32732 	    } else if (isystpg == comnotes_1.nsystp[comnotes_1.ipage - 1] - 1)
32733 		     {
32734 		s_wsfe(&io___1435);
32735 /* Writing concatenation */
32736 		i__6[0] = 1, a__4[0] = all_1.sq;
32737 		i__6[1] = 6, a__4[1] = "endeq%";
32738 		s_cat(ch__36, a__4, i__6, &c__2, (ftnlen)7);
32739 		do_fio(&c__1, ch__36, (ftnlen)7);
32740 		e_wsfe();
32741 	    }
32742 	}
32743 	make1bar_(&ibmrep, &tglp1, tstart, cwrest, squez, istop, numbms,
32744 		istart);
32745 	make2bar_(&comnotes_1.ninow, &tglp1, tstart, cwrest, squez, istop,
32746 		numbms, istart, comclefq_1.clefq, (ftnlen)1);
32747 
32748 /*  Hardspace before barline? */
32749 
32750 	hardb4 = 0.f;
32751 	i__2 = all_1.nv;
32752 	for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) {
32753 	    i__7 = commvl_1.nvmx[all_1.iv - 1];
32754 	    for (kv = 1; kv <= i__7; ++kv) {
32755 		commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
32756 		if (bit_test(all_1.irest[commvl_1.ivx + all_1.nn[commvl_1.ivx
32757 			- 1] * 24 - 25],18)) {
32758 		    ++comudsp_1.nudoff[commvl_1.ivx - 1];
32759 /* Computing MAX */
32760 		    r__1 = hardb4, r__2 = comudsp_1.udoff[commvl_1.ivx +
32761 			    comudsp_1.nudoff[commvl_1.ivx - 1] * 24 - 25];
32762 		    hardb4 = dmax(r__1,r__2);
32763 		}
32764 /* L35: */
32765 	    }
32766 	}
32767 	if (hardb4 > 0.f) {
32768 	    if (comlast_1.islast) {
32769 		s_wsfe(&io___1443);
32770 /* Writing concatenation */
32771 		i__6[0] = 1, a__4[0] = all_1.sq;
32772 		i__6[1] = 10, a__4[1] = "hardspace{";
32773 		s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)11);
32774 		do_fio(&c__1, ch__17, (ftnlen)11);
32775 		do_fio(&c__1, (char *)&hardb4, (ftnlen)sizeof(real));
32776 		do_fio(&c__1, "pt}%", (ftnlen)4);
32777 		e_wsfe();
32778 	    }
32779 
32780 /* This was causing an incorrect poe in an example, which did not affect main */
32781 /*   spacing, but did cause an extra accidental space to be too small */
32782 
32783 	    comask_1.fixednew -= hardb4;
32784 	}
32785 /* L10: */
32786     }
32787     all_1.firstgulp = FALSE_;
32788     all_1.lenb0 = 0;
32789     goto L30;
32790 L40:
32791     cl__1.cerr = 0;
32792     cl__1.cunit = 12;
32793     cl__1.csta = 0;
32794     f_clos(&cl__1);
32795     cl__1.cerr = 0;
32796     cl__1.cunit = 13;
32797     cl__1.csta = 0;
32798     f_clos(&cl__1);
32799     inbuff_1.ilbuf = 1;
32800     inbuff_1.ipbuf = 0;
32801     wdpt = comtop_1.widthpt;
32802     if (all_1.iline == 1) {
32803 	wdpt = comtop_1.widthpt * (1 - comtop_1.fracindent);
32804     }
32805     poe = (wdpt - fsyst * all_1.musicsize - nbarss * .4f - comask_1.fixednew)
32806 	    / (elsktot + comask_1.fbar * nbarss - comask_1.scaldold);
32807     poevec[nsyst] = poe;
32808     if (! comlast_1.islast) {
32809 	cl__1.cerr = 0;
32810 	cl__1.cunit = 11;
32811 	cl__1.csta = 0;
32812 	f_clos(&cl__1);
32813 	cl__1.cerr = 0;
32814 	cl__1.cunit = 16;
32815 	cl__1.csta = 0;
32816 	f_clos(&cl__1);
32817 	if (all_1.figbass) {
32818 	    cl__1.cerr = 0;
32819 	    cl__1.cunit = 14;
32820 	    cl__1.csta = 0;
32821 	    f_clos(&cl__1);
32822 	}
32823 	return 0;
32824     }
32825     i__1 = comas2_1.nasksys;
32826     for (ia = 1; ia <= i__1; ++ia) {
32827 	++comas3_1.iask;
32828 	comas3_1.ask[comas3_1.iask - 1] = comas2_1.wasksys[ia - 1] / poe - (
32829 		r__1 = comas2_1.elasksys[ia - 1], dabs(r__1));
32830 	if (comas2_1.elasksys[ia - 1] > 0.f) {
32831 	    comas3_1.ask[comas3_1.iask - 1] = r_dim(&comas3_1.ask[
32832 		    comas3_1.iask - 1], &c_b762);
32833 	}
32834 /* L19: */
32835     }
32836     i__1 = nhssys;
32837     for (ia = 1; ia <= i__1; ++ia) {
32838 	++nhstot;
32839 /* Computing MAX */
32840 	r__1 = hpts[ia - 1] - hesk[ia - 1] * poe;
32841 	comhsp_1.hpttot[nhstot - 1] = dmax(r__1,0.f);
32842 /* L26: */
32843     }
32844     if (comlast_1.islast && onvolt) {
32845 	s_wsfe(&io___1444);
32846 /* Writing concatenation */
32847 	i__6[0] = 1, a__4[0] = all_1.sq;
32848 	i__6[1] = 11, a__4[1] = "endvoltabox";
32849 	s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)12);
32850 	do_fio(&c__1, ch__13, (ftnlen)12);
32851 	e_wsfe();
32852     }
32853     if (*(unsigned char *)comget_1.rptfq2 != 'E') {
32854 
32855 /* Terminal repeat.  Right or double? */
32856 
32857 	if (*(unsigned char *)comget_1.rptfq2 == 'r') {
32858 	    if (comlast_1.islast) {
32859 		s_wsfe(&io___1445);
32860 /* Writing concatenation */
32861 		i__5[0] = 1, a__3[0] = all_1.sq;
32862 		i__5[1] = 14, a__3[1] = "setrightrepeat";
32863 		i__5[2] = 1, a__3[2] = all_1.sq;
32864 		i__5[3] = 8, a__3[3] = "endpiece";
32865 		s_cat(ch__37, a__3, i__5, &c__4, (ftnlen)24);
32866 		do_fio(&c__1, ch__37, (ftnlen)24);
32867 		e_wsfe();
32868 	    }
32869 	} else if (*(unsigned char *)comget_1.rptfq2 == 'd') {
32870 	    if (comlast_1.islast) {
32871 		s_wsfe(&io___1446);
32872 /* Writing concatenation */
32873 		i__5[0] = 1, a__3[0] = all_1.sq;
32874 		i__5[1] = 12, a__3[1] = "setdoublebar";
32875 		i__5[2] = 1, a__3[2] = all_1.sq;
32876 		i__5[3] = 8, a__3[3] = "endpiece";
32877 		s_cat(ch__38, a__3, i__5, &c__4, (ftnlen)22);
32878 		do_fio(&c__1, ch__38, (ftnlen)22);
32879 		e_wsfe();
32880 	    }
32881 	} else if (*(unsigned char *)comget_1.rptfq2 == 'b') {
32882 	    if (comlast_1.islast) {
32883 		s_wsfe(&io___1447);
32884 /* Writing concatenation */
32885 		i__6[0] = 1, a__4[0] = all_1.sq;
32886 		i__6[1] = 8, a__4[1] = "endpiece";
32887 		s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)9);
32888 		do_fio(&c__1, ch__16, (ftnlen)9);
32889 		e_wsfe();
32890 	    }
32891 	} else if (*(unsigned char *)comget_1.rptfq2 == 'z') {
32892 	    if (comlast_1.islast) {
32893 		s_wsfe(&io___1448);
32894 /* Writing concatenation */
32895 		i__5[0] = 1, a__3[0] = all_1.sq;
32896 		i__5[1] = 12, a__3[1] = "setzalaligne";
32897 		i__5[2] = 1, a__3[2] = all_1.sq;
32898 		i__5[3] = 8, a__3[3] = "Endpiece";
32899 		s_cat(ch__38, a__3, i__5, &c__4, (ftnlen)22);
32900 		do_fio(&c__1, ch__38, (ftnlen)22);
32901 		e_wsfe();
32902 	    }
32903 	} else {
32904 /*        else if (rptfq2 .ne. 'D') then */
32905 	    s_wsle(&io___1449);
32906 	    e_wsle();
32907 	    s_wsle(&io___1450);
32908 	    do_lio(&c__9, &c__1, "R? , ? not \"d\",\"r\",or\"b\",\"z\"; rptf"
32909 		    "q2:", (ftnlen)37);
32910 	    do_lio(&c__9, &c__1, comget_1.rptfq2, (ftnlen)1);
32911 	    e_wsle();
32912 	    s_wsle(&io___1451);
32913 	    do_lio(&c__9, &c__1, "R? , ? not \"d\",\"r\",or\"b\",\"z\"; rptf"
32914 		    "q2:", (ftnlen)37);
32915 	    do_lio(&c__9, &c__1, comget_1.rptfq2, (ftnlen)1);
32916 	    e_wsle();
32917 	    if (comlast_1.islast) {
32918 		s_wsfe(&io___1452);
32919 /* Writing concatenation */
32920 		i__6[0] = 1, a__4[0] = all_1.sq;
32921 		i__6[1] = 8, a__4[1] = "Endpiece";
32922 		s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)9);
32923 		do_fio(&c__1, ch__16, (ftnlen)9);
32924 		e_wsfe();
32925 	    }
32926 	}
32927     } else {
32928 	if (comlast_1.islast) {
32929 	    s_wsfe(&io___1453);
32930 /* Writing concatenation */
32931 	    i__6[0] = 1, a__4[0] = all_1.sq;
32932 	    i__6[1] = 8, a__4[1] = "Endpiece";
32933 	    s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)9);
32934 	    do_fio(&c__1, ch__16, (ftnlen)9);
32935 	    e_wsfe();
32936 	}
32937     }
32938     if (! vshrink) {
32939 	xnstbot = xnsttop[comnotes_1.ipage - 1] * etabot / etatop;
32940 	if (xnstbot < 9.95f) {
32941 	    s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10);
32942 	} else {
32943 	    s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10);
32944 	}
32945 	if (comlast_1.islast) {
32946 	    s_wsfe(&io___1454);
32947 /* Writing concatenation */
32948 	    i__6[0] = 1, a__4[0] = all_1.sq;
32949 	    i__6[1] = 5, a__4[1] = "vskip";
32950 	    s_cat(ch__28, a__4, i__6, &c__2, (ftnlen)6);
32951 	    do_fio(&c__1, ch__28, (ftnlen)6);
32952 	    do_fio(&c__1, (char *)&xnstbot, (ftnlen)sizeof(real));
32953 /* Writing concatenation */
32954 	    i__4[0] = 1, a__2[0] = all_1.sq;
32955 	    i__4[1] = 10, a__2[1] = "Interligne";
32956 	    i__4[2] = 1, a__2[2] = all_1.sq;
32957 	    i__4[3] = 5, a__2[3] = "eject";
32958 	    i__4[4] = 1, a__2[4] = all_1.sq;
32959 	    i__4[5] = 9, a__2[5] = "endmuflex";
32960 	    s_cat(ch__5, a__2, i__4, &c__6, (ftnlen)27);
32961 	    do_fio(&c__1, ch__5, (ftnlen)27);
32962 	    e_wsfe();
32963 	}
32964 	if (comlast_1.islast) {
32965 	    s_wsfe(&io___1455);
32966 /* Writing concatenation */
32967 	    i__6[0] = 1, a__4[0] = all_1.sq;
32968 	    i__6[1] = 3, a__4[1] = "bye";
32969 	    s_cat(ch__20, a__4, i__6, &c__2, (ftnlen)4);
32970 	    do_fio(&c__1, ch__20, (ftnlen)4);
32971 	    e_wsfe();
32972 	}
32973     } else {
32974 	if (comlast_1.islast) {
32975 	    s_wsfe(&io___1456);
32976 /* Writing concatenation */
32977 	    i__4[0] = 1, a__2[0] = all_1.sq;
32978 	    i__4[1] = 5, a__2[1] = "vfill";
32979 	    i__4[2] = 1, a__2[2] = all_1.sq;
32980 	    i__4[3] = 5, a__2[3] = "eject";
32981 	    i__4[4] = 1, a__2[4] = all_1.sq;
32982 	    i__4[5] = 9, a__2[5] = "endmuflex";
32983 	    s_cat(ch__38, a__2, i__4, &c__6, (ftnlen)22);
32984 	    do_fio(&c__1, ch__38, (ftnlen)22);
32985 	    e_wsfe();
32986 	}
32987 	if (comlast_1.islast) {
32988 	    s_wsfe(&io___1457);
32989 /* Writing concatenation */
32990 	    i__6[0] = 1, a__4[0] = all_1.sq;
32991 	    i__6[1] = 3, a__4[1] = "bye";
32992 	    s_cat(ch__20, a__4, i__6, &c__2, (ftnlen)4);
32993 	    do_fio(&c__1, ch__20, (ftnlen)4);
32994 	    e_wsfe();
32995 	}
32996     }
32997     al__1.aerr = 0;
32998     al__1.aunit = 11;
32999     f_rew(&al__1);
33000     if (all_1.figbass) {
33001 	s_wsfe(&io___1458);
33002 /* Writing concatenation */
33003 	i__6[0] = 1, a__4[0] = all_1.sq;
33004 	i__6[1] = 8, a__4[1] = "figdrop=";
33005 	s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)9);
33006 	do_fio(&c__1, ch__16, (ftnlen)9);
33007 	do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline << 1) - 2], (ftnlen)
33008 		sizeof(integer));
33009 /* Writing concatenation */
33010 	i__8[0] = 1, a__5[0] = " ";
33011 	i__8[1] = 1, a__5[1] = all_1.sq;
33012 	i__8[2] = 8, a__5[2] = "figdtwo=";
33013 	s_cat(ch__19, a__5, i__8, &c__3, (ftnlen)10);
33014 	do_fio(&c__1, ch__19, (ftnlen)10);
33015 	do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline << 1) - 1], (ftnlen)
33016 		sizeof(integer));
33017 /* Writing concatenation */
33018 	i__12[0] = 1, a__9[0] = all_1.sq;
33019 	i__12[1] = 4, a__9[1] = "fi}%";
33020 	s_cat(ch__35, a__9, i__12, &c__2, (ftnlen)5);
33021 	do_fio(&c__1, ch__35, (ftnlen)5);
33022 	e_wsfe();
33023 	al__1.aerr = 0;
33024 	al__1.aunit = 14;
33025 	f_rew(&al__1);
33026     }
33027     askfig_(pathnameq, &lpath, basenameq, &lbase, &all_1.figbass, &istype0, (
33028 	    ftnlen)40, (ftnlen)44);
33029     if (! (*optimize)) {
33030 	s_wsle(&io___1459);
33031 	e_wsle();
33032 	s_wsle(&io___1460);
33033 /* Writing concatenation */
33034 	i__5[0] = 8, a__3[0] = "Writing ";
33035 	i__5[1] = lpath, a__3[1] = pathnameq;
33036 	i__5[2] = lbase, a__3[2] = basenameq;
33037 	i__5[3] = 4, a__3[3] = ".tex";
33038 	s_cat(ch__39, a__3, i__5, &c__4, (ftnlen)96);
33039 	do_lio(&c__9, &c__1, ch__39, lpath + 8 + lbase + 4);
33040 	e_wsle();
33041 	s_wsle(&io___1461);
33042 	do_lio(&c__9, &c__1, "Done with second PMX pass.", (ftnlen)26);
33043 	e_wsle();
33044 	s_wsfe(&io___1462);
33045 /* Writing concatenation */
33046 	i__5[0] = 8, a__3[0] = "Writing ";
33047 	i__5[1] = lpath, a__3[1] = pathnameq;
33048 	i__5[2] = lbase, a__3[2] = basenameq;
33049 	i__5[3] = 4, a__3[3] = ".tex";
33050 	s_cat(ch__39, a__3, i__5, &c__4, (ftnlen)96);
33051 	do_fio(&c__1, ch__39, lpath + 8 + lbase + 4);
33052 	e_wsfe();
33053 	s_wsfe(&io___1463);
33054 	do_fio(&c__1, " Done with second PMX pass.  Now run TeX", (ftnlen)40);
33055 	e_wsfe();
33056     }
33057     return 0;
33058 } /* pmxb_ */
33059 
poestats_(integer * nsyst,real * poe,real * poebar,real * devnorm)33060 /* Subroutine */ int poestats_(integer *nsyst, real *poe, real *poebar, real *
33061 	devnorm)
33062 {
33063     /* System generated locals */
33064     integer i__1;
33065     real r__1;
33066 
33067     /* Builtin functions */
33068     double sqrt(doublereal);
33069 
33070     /* Local variables */
33071     static real sumx;
33072     static integer isyst;
33073     static real sumxx;
33074 
33075 
33076 /*  Compute avg. & norm. std. dev. of poe. */
33077 
33078     /* Parameter adjustments */
33079     --poe;
33080 
33081     /* Function Body */
33082     sumx = 0.f;
33083     sumxx = 0.f;
33084     i__1 = *nsyst;
33085     for (isyst = 1; isyst <= i__1; ++isyst) {
33086 	sumx += poe[isyst];
33087 /* Computing 2nd power */
33088 	r__1 = poe[isyst];
33089 	sumxx += r__1 * r__1;
33090 /* L1: */
33091     }
33092 /* L2: */
33093 /* Computing 2nd power */
33094     r__1 = sumx;
33095     *devnorm = sqrt(*nsyst * sumxx / (r__1 * r__1) - 1);
33096     *poebar = sumx / *nsyst;
33097     return 0;
33098 } /* poestats_ */
33099 
precrd_(integer * ivx,integer * ip,integer * nolevm,integer * nacc,integer * ipl,integer * irest,char * udq,logical * twooftwo,integer * icashft,ftnlen udq_len)33100 /* Subroutine */ int precrd_(integer *ivx, integer *ip, integer *nolevm,
33101 	integer *nacc, integer *ipl, integer *irest, char *udq, logical *
33102 	twooftwo, integer *icashft, ftnlen udq_len)
33103 {
33104     /* System generated locals */
33105     integer i__1, i__2, i__3;
33106 
33107     /* Builtin functions */
33108     integer lbit_shift(integer, integer), s_wsle(cilist *), e_wsle(void),
33109 	    do_lio(integer *, integer *, char *, ftnlen);
33110 
33111     /* Local variables */
33112     extern integer igetbits_(integer *, integer *, integer *);
33113     static integer i__, levminacc, levmaxacc, ip1, ile, ivx1, iold, ilev;
33114     static logical is2nd;
33115     extern /* Subroutine */ int stop1_(void);
33116     static integer kicrd[10], nolev, iaccid, naccid, iorder, icrdot0;
33117     extern /* Subroutine */ int crdaccs_(integer *, integer *, integer *,
33118 	    integer *, integer *, integer *, integer *, integer *, integer *,
33119 	    logical *, integer *);
33120     static integer levtabl[88];
33121     extern /* Subroutine */ int setbits_(integer *, integer *, integer *,
33122 	    integer *);
33123 
33124     /* Fortran I/O blocks */
33125     static cilist io___1471 = { 0, 6, 0, 0, 0 };
33126     static cilist io___1472 = { 0, 6, 0, 0, 0 };
33127     static cilist io___1483 = { 0, 6, 0, 0, 0 };
33128     static cilist io___1484 = { 0, 6, 0, 0, 0 };
33129 
33130 
33131 
33132 /*  Analyzes chords, data to be used with slurs on chords and plain chords. */
33133 /*  Check for 2nds, shift notes if neccesary. */
33134 /*       ipl(10) chord present */
33135 /*       irest(20) set if any note is right shifted */
33136 /*       irest(27) set if any note is left shifted */
33137 /*       ipl(8|9) left|right shift main note */
33138 /*       icrdat(23|24)   ditto     chord note */
33139 /*       udq is updown-ness, needed to analyze 2nds. */
33140 /*       levtabl(i)=0 if no note at this level, -1 if main note, icrd if chord note. */
33141 /*       icrdot(icrd)(27-29) sequence order of chord note if accid, top down */
33142 
33143     for (i__ = 1; i__ <= 88; ++i__) {
33144 	levtabl[i__ - 1] = 0;
33145 /* L11: */
33146     }
33147     i__1 = comtrill_1.ncrd;
33148     for (comtrill_1.icrd1 = 1; comtrill_1.icrd1 <= i__1; ++comtrill_1.icrd1) {
33149 	ivx1 = (15 & lbit_shift(comtrill_1.icrdat[comtrill_1.icrd1 - 1], (
33150 		ftnlen)-8)) + (igetbits_(&comtrill_1.icrdat[comtrill_1.icrd1
33151 		- 1], &c__1, &c__28) << 4);
33152 	ip1 = 255 & comtrill_1.icrdat[comtrill_1.icrd1 - 1];
33153 	if (ip1 == *ip && ivx1 == *ivx) {
33154 	    goto L2;
33155 	}
33156 /* L1: */
33157     }
33158     s_wsle(&io___1471);
33159     e_wsle();
33160     s_wsle(&io___1472);
33161     do_lio(&c__9, &c__1, "Cannot find first chord note in precrd. Send sourc"
33162 	    "e to Dr. Don!", (ftnlen)63);
33163     e_wsle();
33164     stop1_();
33165 L2:
33166     comtrill_1.maxlev = *nolevm;
33167     comtrill_1.minlev = *nolevm;
33168     levtabl[*nolevm - 1] = -1;
33169     is2nd = FALSE_;
33170     naccid = 0;
33171     levmaxacc = -100;
33172     levminacc = 1000;
33173 
33174 /*  Check 1st 3 bits of nacc for accid on main note of chord. */
33175 
33176     if ((7 & *nacc) > 0) {
33177 	naccid = 1;
33178 
33179 /*  Start list of notes with accid's.  There will be naccid of them. kicrd=0 if main, */
33180 /*    otherwise icrd value for note with accidental. */
33181 
33182 	kicrd[0] = 0;
33183 	levmaxacc = *nolevm;
33184 	levminacc = *nolevm;
33185 
33186 /*  Start the level-ranking */
33187 
33188 	icrdot0 = 1;
33189     }
33190     i__1 = comtrill_1.ncrd;
33191     for (comtrill_1.icrd2 = comtrill_1.icrd1; comtrill_1.icrd2 <= i__1;
33192 	    ++comtrill_1.icrd2) {
33193 	nolev = igetbits_(&comtrill_1.icrdat[comtrill_1.icrd2 - 1], &c__7, &
33194 		c__12);
33195 	levtabl[nolev - 1] = comtrill_1.icrd2;
33196 	comtrill_1.maxlev = max(comtrill_1.maxlev,nolev);
33197 	comtrill_1.minlev = min(comtrill_1.minlev,nolev);
33198 
33199 /*  Check for accidental */
33200 
33201 	if (bit_test(comtrill_1.icrdat[comtrill_1.icrd2 - 1],19)) {
33202 	    ++naccid;
33203 	    levmaxacc = max(levmaxacc,nolev);
33204 	    levminacc = min(levminacc,nolev);
33205 
33206 /*  Add this icrd to list of values for notes with accid's. */
33207 
33208 	    kicrd[naccid - 1] = comtrill_1.icrd2;
33209 	    if (! bit_test(*nacc,28)) {
33210 
33211 /*  Order not forced, so get the level-ranking, top down */
33212 
33213 		iorder = 1;
33214 		i__2 = naccid - 1;
33215 		for (iaccid = 1; iaccid <= i__2; ++iaccid) {
33216 		    if (kicrd[iaccid - 1] == 0) {
33217 			if (*nolevm > nolev) {
33218 			    ++iorder;
33219 			} else {
33220 			    ++icrdot0;
33221 			}
33222 		    } else {
33223 			if (igetbits_(&comtrill_1.icrdat[kicrd[iaccid - 1] -
33224 				1], &c__7, &c__12) > nolev) {
33225 			    ++iorder;
33226 			} else {
33227 			    iold = igetbits_(&comtrill_1.icrdot[kicrd[iaccid
33228 				    - 1] - 1], &c__3, &c__27);
33229 			    i__3 = iold + 1;
33230 			    setbits_(&comtrill_1.icrdot[kicrd[iaccid - 1] - 1]
33231 				    , &c__3, &c__27, &i__3);
33232 			}
33233 		    }
33234 /* L12: */
33235 		}
33236 		setbits_(&comtrill_1.icrdot[comtrill_1.icrd2 - 1], &c__3, &
33237 			c__27, &iorder);
33238 	    }
33239 	}
33240 
33241 /*  Exit loop if last note in this chord */
33242 
33243 	if (comtrill_1.icrd2 == comtrill_1.ncrd) {
33244 	    goto L4;
33245 	}
33246 	if (igetbits_(&comtrill_1.icrdat[comtrill_1.icrd2], &c__8, &c__0) != *
33247 		ip || igetbits_(&comtrill_1.icrdat[comtrill_1.icrd2], &c__4, &
33248 		c__8) + (igetbits_(&comtrill_1.icrdat[comtrill_1.icrd2], &
33249 		c__1, &c__28) << 4) != *ivx) {
33250 	    goto L4;
33251 	}
33252 /*     *      igetbits(icrdat(icrd2+1),4,8) .ne. ivx) go to 4 */
33253 /* L3: */
33254     }
33255     s_wsle(&io___1483);
33256     e_wsle();
33257     s_wsle(&io___1484);
33258     do_lio(&c__9, &c__1, "Failed to find last chord note. Send source to Dr."
33259 	    " Don!", (ftnlen)55);
33260     e_wsle();
33261     stop1_();
33262 L4:
33263 
33264 /*  Now icrd1, icrd2 define range of icrd for this chord. */
33265 
33266 /*  Bypass autos-shifting if any manual shifts are present */
33267 
33268     if (bit_test(*irest,20) || bit_test(*irest,27)) {
33269 	goto L10;
33270     }
33271 
33272 /*  Check for 2nds */
33273 
33274     for (ilev = 1; ilev <= 87; ++ilev) {
33275 	if (levtabl[ilev - 1] != 0 && levtabl[ilev] != 0) {
33276 
33277 /*  There is at least one 2nd.. */
33278 
33279 	    if (*(unsigned char *)udq == 'u') {
33280 
33281 /*  Upstem. Start with 2nd just found and go up, rt-shifting upper */
33282 /*     member of each pair */
33283 
33284 		ile = ilev;
33285 
33286 /*  Set main-note flag for ANY right-shift */
33287 
33288 		*irest = bit_set(*irest,20);
33289 L7:
33290 		if (levtabl[ile] < 0) {
33291 
33292 /*  Upstem, & upper member is main so must be rt-shifted. This would move */
33293 /*    stem too, so we rt-shift the OTHER note, and set flag that signals */
33294 /*    to interchange pitches just when these two notes are placed. */
33295 
33296 		    *nacc = bit_set(*nacc,30);
33297 		    comtrill_1.icrdat[levtabl[ile - 1] - 1] = bit_set(
33298 			    comtrill_1.icrdat[levtabl[ile - 1] - 1],24);
33299 		} else {
33300 
33301 /*  Upper member is chord note, must be rt-shifted */
33302 
33303 		    comtrill_1.icrdat[levtabl[ile] - 1] = bit_set(
33304 			    comtrill_1.icrdat[levtabl[ile] - 1],24);
33305 		}
33306 		++ile;
33307 L8:
33308 		++ile;
33309 		if (ile < 87) {
33310 		    if (levtabl[ile - 1] != 0 && levtabl[ile] != 0) {
33311 			goto L7;
33312 		    } else {
33313 			goto L8;
33314 		    }
33315 		}
33316 		goto L10;
33317 	    } else {
33318 
33319 /*  Downstem. Start at top and work down, left-shifting lower member of each pair. */
33320 /*     We know that lowest pair is at (ilev,ilev+1). */
33321 
33322 		ile = 88;
33323 
33324 /*  Set main-note flag for ANY right-shift */
33325 
33326 		*irest = bit_set(*irest,27);
33327 L9:
33328 		if (levtabl[ile - 1] != 0 && levtabl[ile - 2] != 0) {
33329 		    if (levtabl[ile - 2] < 0) {
33330 /*                ipl = ibset(ipl,8) */
33331 
33332 /*  Dnstem, & lower member is main so must be left-shifted. This would move */
33333 /*    stem too, so we left-shift the OTHER note, and set flag that signals */
33334 /*    to interchange pitches just when these two notes are placed. */
33335 
33336 			*nacc = bit_set(*nacc,31);
33337 			comtrill_1.icrdat[levtabl[ile - 1] - 1] = bit_set(
33338 				comtrill_1.icrdat[levtabl[ile - 1] - 1],23);
33339 		    } else {
33340 
33341 /*  Lower member is chord note, must be shifted */
33342 
33343 			comtrill_1.icrdat[levtabl[ile - 2] - 1] = bit_set(
33344 				comtrill_1.icrdat[levtabl[ile - 2] - 1],23);
33345 		    }
33346 		    --ile;
33347 		}
33348 		--ile;
33349 		if (ile >= ilev + 1) {
33350 		    goto L9;
33351 		}
33352 		goto L10;
33353 	    }
33354 	}
33355 /* L5: */
33356     }
33357 L10:
33358 
33359 /*  Done with 2nds, now do accid's.  Call even if just one, in case left shifts. */
33360 
33361 /*      if (naccid .gt. 1) call crdaccs(nacc,ipl,irest,naccid, */
33362     if (naccid >= 1) {
33363 	crdaccs_(nacc, ipl, irest, &naccid, kicrd, nolevm, &levmaxacc, &
33364 		levminacc, &icrdot0, twooftwo, icashft);
33365     }
33366     return 0;
33367 } /* precrd_ */
33368 
printl_(char * string,ftnlen string_len)33369 /* Subroutine */ int printl_(char *string, ftnlen string_len)
33370 {
33371     /* Builtin functions */
33372     integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
33373 	    e_wsle(void), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen),
33374 	     e_wsfe(void);
33375 
33376     /* Fortran I/O blocks */
33377     static cilist io___1487 = { 0, 6, 0, 0, 0 };
33378     static cilist io___1488 = { 0, 15, 0, "(a)", 0 };
33379 
33380 
33381 
33382 /*  Send string to console and to log file */
33383 
33384     s_wsle(&io___1487);
33385     do_lio(&c__9, &c__1, string, string_len);
33386     e_wsle();
33387     s_wsfe(&io___1488);
33388     do_fio(&c__1, string, string_len);
33389     e_wsfe();
33390     return 0;
33391 } /* printl_ */
33392 
putarp_(real * tnow,integer * iv,integer * ip,integer * nolev,integer * ncm,char * soutq,integer * lsout,ftnlen soutq_len)33393 /* Subroutine */ int putarp_(real *tnow, integer *iv, integer *ip, integer *
33394 	nolev, integer *ncm, char *soutq, integer *lsout, ftnlen soutq_len)
33395 {
33396     /* Initialized data */
33397 
33398     static char symq[8*2] = "raisearp" "arpeggio";
33399 
33400     /* System generated locals */
33401     address a__1[2], a__2[3], a__3[4];
33402     integer i__1, i__2[2], i__3[3], i__4[4];
33403     real r__1;
33404     char ch__1[1], ch__2[1];
33405     icilist ici__1;
33406 
33407     /* Builtin functions */
33408     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
33409     integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
33410 	    , i_nint(real *);
33411 
33412     /* Local variables */
33413     static logical isarpshift;
33414     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
33415     static integer iarp, isym, iarps, lnote;
33416     extern /* Subroutine */ int addstr_(char *, integer *, char *, integer *,
33417 	    ftnlen, ftnlen);
33418     static integer levbot, ilvert, invert;
33419     static char notexq[79];
33420 
33421     /* Fortran I/O blocks */
33422     static icilist io___1494 = { 0, notexq+9, 0, "(f3.1,a2)", 5, 1 };
33423 
33424 
33425 
33426 /*  Find which iarp, if any */
33427 
33428     i__1 = comarp_1.narp;
33429     for (iarp = 1; iarp <= i__1; ++iarp) {
33430 	if ((r__1 = *tnow - comarp_1.tar[iarp - 1], dabs(r__1)) <
33431 		comtol_1.tol) {
33432 	    goto L2;
33433 	}
33434 /* L1: */
33435     }
33436 
33437 /*  If here, this is the *first* call for this arp. */
33438 
33439     ++comarp_1.narp;
33440     comarp_1.tar[comarp_1.narp - 1] = *tnow + comtol_1.tol * .5f;
33441     comarp_1.ivar1[comarp_1.narp - 1] = *iv;
33442     comarp_1.ipar1[comarp_1.narp - 1] = *ip;
33443     comarp_1.levar1[comarp_1.narp - 1] = *nolev;
33444     comarp_1.ncmar1[comarp_1.narp - 1] = *ncm;
33445     return 0;
33446 L2:
33447 
33448 /*  If here, this is *second* call at this time, iarp points to values from 1st. */
33449 
33450 /*  Check for shift. Set IsArpShift and iarps */
33451 
33452     i__1 = comarpshift_1.numarpshift;
33453     for (iarps = 1; iarps <= i__1; ++iarps) {
33454 	if (comarpshift_1.ivarpshift[iarps - 1] == comarp_1.ivar1[iarp - 1] &&
33455 		 comarpshift_1.iparpshift[iarps - 1] == comarp_1.ipar1[iarp -
33456 		1]) {
33457 	    isarpshift = TRUE_;
33458 /* Writing concatenation */
33459 	    chax_(ch__1, (ftnlen)1, &c__92);
33460 	    i__2[0] = 1, a__1[0] = ch__1;
33461 	    i__2[1] = 8, a__1[1] = "loffset{";
33462 	    s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
33463 	    s_wsfi(&io___1494);
33464 	    do_fio(&c__1, (char *)&comarpshift_1.arpshift[iarps - 1], (ftnlen)
33465 		    sizeof(real));
33466 	    do_fio(&c__1, "}{", (ftnlen)2);
33467 	    e_wsfi();
33468 	    lnote = 14;
33469 	    goto L4;
33470 	}
33471 /* L3: */
33472     }
33473     isarpshift = FALSE_;
33474     lnote = 0;
33475 L4:
33476     if (*iv == comarp_1.ivar1[iarp - 1]) {
33477 
33478 /*  Arp is in a single staff. */
33479 
33480 /* Computing MIN */
33481 	i__1 = comarp_1.levar1[iarp - 1];
33482 	levbot = min(i__1,*nolev) - *ncm + 3;
33483 	invert = (i__1 = comarp_1.levar1[iarp - 1] - *nolev, abs(i__1)) + 1;
33484     } else {
33485 
33486 /*  Arp covers >1 staff.  Lower staff has to be the first, upper is current and */
33487 /*  is where the symbol will be written. */
33488 
33489 	r__1 = comarp_1.xinsnow * 2;
33490 	levbot = -i_nint(&r__1) + 3 + comarp_1.levar1[iarp - 1] -
33491 		comarp_1.ncmar1[iarp - 1];
33492 	invert = -levbot + 4 + *nolev - *ncm;
33493 /*      print*,'xinsnow,levar1,ncmar1,levbot,nolev,ncm:' */
33494 /*      write(*,'(f5.1,5i5)')xinsnow,levar1(iarp),ncmar1(iarp), */
33495 /*     *levbot,nolev,ncm */
33496     }
33497 
33498 /*  isym will be (1,2) if invert is (even,odd).  If even, raise .5\internote */
33499 
33500     isym = invert % 2 + 1;
33501     ilvert = (invert + 1) / 2;
33502     if (levbot >= 0 && levbot <= 9) {
33503 
33504 /*  Single digit */
33505 
33506 	if (! isarpshift) {
33507 /* Writing concatenation */
33508 	    chax_(ch__1, (ftnlen)1, &c__92);
33509 	    i__3[0] = 1, a__2[0] = ch__1;
33510 	    i__3[1] = 8, a__2[1] = symq + (isym - 1 << 3);
33511 	    i__1 = levbot + 48;
33512 	    chax_(ch__2, (ftnlen)1, &i__1);
33513 	    i__3[2] = 1, a__2[2] = ch__2;
33514 	    s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
33515 	} else {
33516 /* Writing concatenation */
33517 	    i__4[0] = lnote, a__3[0] = notexq;
33518 	    chax_(ch__1, (ftnlen)1, &c__92);
33519 	    i__4[1] = 1, a__3[1] = ch__1;
33520 	    i__4[2] = 8, a__3[2] = symq + (isym - 1 << 3);
33521 	    i__1 = levbot + 48;
33522 	    chax_(ch__2, (ftnlen)1, &i__1);
33523 	    i__4[3] = 1, a__3[3] = ch__2;
33524 	    s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
33525 	}
33526 	lnote += 10;
33527     } else {
33528 	if (! isarpshift) {
33529 /* Writing concatenation */
33530 	    chax_(ch__1, (ftnlen)1, &c__92);
33531 	    i__3[0] = 1, a__2[0] = ch__1;
33532 	    i__3[1] = 8, a__2[1] = symq + (isym - 1 << 3);
33533 	    i__3[2] = 1, a__2[2] = "{";
33534 	    s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
33535 	} else {
33536 /* Writing concatenation */
33537 	    i__4[0] = lnote, a__3[0] = notexq;
33538 	    chax_(ch__1, (ftnlen)1, &c__92);
33539 	    i__4[1] = 1, a__3[1] = ch__1;
33540 	    i__4[2] = 8, a__3[2] = symq + (isym - 1 << 3);
33541 	    i__4[3] = 1, a__3[3] = "{";
33542 	    s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
33543 	}
33544 	lnote += 10;
33545 	if (levbot >= -9) {
33546 
33547 /*  Need two spaces for number */
33548 
33549 	    i__1 = lnote;
33550 	    ici__1.icierr = 0;
33551 	    ici__1.icirnum = 1;
33552 	    ici__1.icirlen = lnote + 3 - i__1;
33553 	    ici__1.iciunit = notexq + i__1;
33554 	    ici__1.icifmt = "(i2,a1)";
33555 	    s_wsfi(&ici__1);
33556 	    do_fio(&c__1, (char *)&levbot, (ftnlen)sizeof(integer));
33557 	    do_fio(&c__1, "}", (ftnlen)1);
33558 	    e_wsfi();
33559 	    lnote += 3;
33560 	} else {
33561 	    i__1 = lnote;
33562 	    ici__1.icierr = 0;
33563 	    ici__1.icirnum = 1;
33564 	    ici__1.icirlen = lnote + 4 - i__1;
33565 	    ici__1.iciunit = notexq + i__1;
33566 	    ici__1.icifmt = "(i3,a1)";
33567 	    s_wsfi(&ici__1);
33568 	    do_fio(&c__1, (char *)&levbot, (ftnlen)sizeof(integer));
33569 	    do_fio(&c__1, "}", (ftnlen)1);
33570 	    e_wsfi();
33571 	    lnote += 4;
33572 	}
33573     }
33574 /*      if (ilvert .le. 9) then */
33575 /*        call addstr(notexq(1:lnote)//chax(48+ilvert),lnote+1, */
33576 /*     *              soutq,lsout) */
33577 /*      else */
33578 /*        write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')'{',ilvert,'}' */
33579 /*        call addstr(notexq(1:lnote+4),lnote+4,soutq,lsout) */
33580 /*      end if */
33581     if (ilvert > 9) {
33582 	i__1 = lnote;
33583 	ici__1.icierr = 0;
33584 	ici__1.icirnum = 1;
33585 	ici__1.icirlen = lnote + 4 - i__1;
33586 	ici__1.iciunit = notexq + i__1;
33587 	ici__1.icifmt = "(a1,i2,a1)";
33588 	s_wsfi(&ici__1);
33589 	do_fio(&c__1, "{", (ftnlen)1);
33590 	do_fio(&c__1, (char *)&ilvert, (ftnlen)sizeof(integer));
33591 	do_fio(&c__1, "}", (ftnlen)1);
33592 	e_wsfi();
33593 	lnote += 4;
33594     } else {
33595 /* Writing concatenation */
33596 	i__2[0] = lnote, a__1[0] = notexq;
33597 	i__1 = ilvert + 48;
33598 	chax_(ch__1, (ftnlen)1, &i__1);
33599 	i__2[1] = 1, a__1[1] = ch__1;
33600 	s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
33601 	++lnote;
33602     }
33603     if (isarpshift) {
33604 /* Writing concatenation */
33605 	i__2[0] = lnote, a__1[0] = notexq;
33606 	i__2[1] = 1, a__1[1] = "}";
33607 	s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
33608 	++lnote;
33609     }
33610     addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80);
33611 
33612 /*  cancel out the stored time, to permit two arps at same time! */
33613 
33614     comarp_1.tar[iarp - 1] = -1.f;
33615     return 0;
33616 } /* putarp_ */
33617 
putast_(real * elask,integer * indxask,char * outq,ftnlen outq_len)33618 /* Subroutine */ int putast_(real *elask, integer *indxask, char *outq,
33619 	ftnlen outq_len)
33620 {
33621     /* System generated locals */
33622     address a__1[3];
33623     integer i__1, i__2[3];
33624     icilist ici__1;
33625 
33626     /* Builtin functions */
33627     integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
33628 	    ;
33629     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
33630 	     char **, integer *, integer *, ftnlen);
33631 
33632     /* Local variables */
33633     static integer lp;
33634     static char tag[129], fmtq[9];
33635 
33636     /* Fortran I/O blocks */
33637     static icilist io___1502 = { 0, fmtq, 0, "(a5,i1,a3)", 9, 1 };
33638 
33639 
33640     if (*elask >= 0.f) {
33641 	if (*elask < .995f) {
33642 	    lp = 3;
33643 	} else if (*elask < 9.995f) {
33644 	    lp = 4;
33645 	} else {
33646 	    lp = 5;
33647 	}
33648 	s_wsfi(&io___1502);
33649 	do_fio(&c__1, "(a2,f", (ftnlen)5);
33650 	do_fio(&c__1, (char *)&lp, (ftnlen)sizeof(integer));
33651 	do_fio(&c__1, ".2)", (ftnlen)3);
33652 	e_wsfi();
33653     } else {
33654 	lp = 5;
33655 	s_copy(fmtq, "(a2,f5.1)", (ftnlen)9, (ftnlen)9);
33656     }
33657 
33658 /*  Overwrite as follows:  ...xyz*ask     *lmnop... -> */
33659 /*                         ...xyz*ast{.nn}*lmnop... */
33660 /*                         ...xyz*ast{n.nn}*lmnop... */
33661 /*                         ...xyz*ast{nn.nn}*lmnop... */
33662 /*  or for negative,       ...xyz*ast{-nn.n}*lmnop... */
33663     i__1 = *indxask + 8;
33664     s_copy(tag, outq + i__1, (ftnlen)129, 129 - i__1);
33665     i__1 = *indxask + 2;
33666     ici__1.icierr = 0;
33667     ici__1.icirnum = 1;
33668     ici__1.icirlen = 129 - i__1;
33669     ici__1.iciunit = outq + i__1;
33670     ici__1.icifmt = fmtq;
33671     s_wsfi(&ici__1);
33672     do_fio(&c__1, "t{", (ftnlen)2);
33673     do_fio(&c__1, (char *)&(*elask), (ftnlen)sizeof(real));
33674     e_wsfi();
33675 /* Writing concatenation */
33676     i__2[0] = *indxask + 4 + lp, a__1[0] = outq;
33677     i__2[1] = 1, a__1[1] = "}";
33678     i__2[2] = 129, a__1[2] = tag;
33679     s_cat(outq, a__1, i__2, &c__3, (ftnlen)129);
33680     return 0;
33681 } /* putast_ */
33682 
putcb_(integer * ivx,integer * ip,char * notexq,integer * lnote,ftnlen notexq_len)33683 /* Subroutine */ int putcb_(integer *ivx, integer *ip, char *notexq, integer *
33684 	lnote, ftnlen notexq_len)
33685 {
33686     /* System generated locals */
33687     address a__1[2];
33688     integer i__1, i__2[2];
33689     char ch__1[1];
33690     icilist ici__1;
33691 
33692     /* Builtin functions */
33693     /* Subroutine */ int s_stop(char *, ftnlen), s_copy(char *, char *,
33694 	    ftnlen, ftnlen), s_cat(char *, char **, integer *, integer *,
33695 	    ftnlen);
33696     integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
33697 	    ;
33698 
33699     /* Local variables */
33700     extern integer igetbits_(integer *, integer *, integer *);
33701     static integer ibc, ipbc, ivxbc;
33702     static real hshft;
33703     static integer ihshft, ivshft;
33704     extern /* Subroutine */ int printl_(char *, ftnlen);
33705 
33706 /*      ivxip = ivx+16*ip */
33707     i__1 = comcb_1.nbc;
33708     for (ibc = 1; ibc <= i__1; ++ibc) {
33709 /*        if (ivxip .eq. iand(1023,ibcdata(ibc))) go to 2 */
33710 /*        if (ivx.eq.iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28) */
33711 /*     *    .and. ip.eq.iand(1008,ibcdata(ibc))) go to 2 */
33712 	ivxbc = (15 & comcb_1.ibcdata[ibc - 1]) + (igetbits_(&comcb_1.ibcdata[
33713 		ibc - 1], &c__1, &c__28) << 4);
33714 	ipbc = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__4);
33715 	if (*ivx == ivxbc && *ip == ipbc) {
33716 	    goto L2;
33717 	}
33718 /* L1: */
33719     }
33720     printl_("Error in putbc, Call Dr. Don", (ftnlen)28);
33721     s_stop("", (ftnlen)0);
33722 L2:
33723     if (bit_test(comcb_1.ibcdata[ibc - 1],27)) {
33724 	*lnote = 8;
33725 	s_copy(notexq, "\\pbreath", (ftnlen)79, (ftnlen)8);
33726     } else {
33727 	*lnote = 9;
33728 	s_copy(notexq, "\\pcaesura", (ftnlen)79, (ftnlen)9);
33729     }
33730     ivshft = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__6, &c__13);
33731 /* ??      ivshft = igetbits(ibcdata(ibc),6,13)-32 */
33732     if (ivshft > 0) {
33733 	ivshft += -32;
33734     }
33735     if (ivshft < 0 || ivshft > 9) {
33736 /* Writing concatenation */
33737 	i__2[0] = *lnote, a__1[0] = notexq;
33738 	i__2[1] = 1, a__1[1] = "{";
33739 	s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
33740 	++(*lnote);
33741 	if (ivshft < -9) {
33742 	    i__1 = *lnote;
33743 	    ici__1.icierr = 0;
33744 	    ici__1.icirnum = 1;
33745 	    ici__1.icirlen = *lnote + 3 - i__1;
33746 	    ici__1.iciunit = notexq + i__1;
33747 	    ici__1.icifmt = "(i3)";
33748 	    s_wsfi(&ici__1);
33749 	    do_fio(&c__1, (char *)&ivshft, (ftnlen)sizeof(integer));
33750 	    e_wsfi();
33751 	    *lnote += 3;
33752 	} else {
33753 	    i__1 = *lnote;
33754 	    ici__1.icierr = 0;
33755 	    ici__1.icirnum = 1;
33756 	    ici__1.icirlen = *lnote + 2 - i__1;
33757 	    ici__1.iciunit = notexq + i__1;
33758 	    ici__1.icifmt = "(i2)";
33759 	    s_wsfi(&ici__1);
33760 	    do_fio(&c__1, (char *)&ivshft, (ftnlen)sizeof(integer));
33761 	    e_wsfi();
33762 	    *lnote += 2;
33763 	}
33764 /* Writing concatenation */
33765 	i__2[0] = *lnote, a__1[0] = notexq;
33766 	i__2[1] = 1, a__1[1] = "}";
33767 	s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
33768 	++(*lnote);
33769     } else {
33770 /* Writing concatenation */
33771 	i__2[0] = *lnote, a__1[0] = notexq;
33772 	*(unsigned char *)&ch__1[0] = ivshft + 48;
33773 	i__2[1] = 1, a__1[1] = ch__1;
33774 	s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
33775 	++(*lnote);
33776     }
33777     ihshft = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__19);
33778     if (ihshft == 0) {
33779 /* Writing concatenation */
33780 	i__2[0] = *lnote, a__1[0] = notexq;
33781 	i__2[1] = 1, a__1[1] = "0";
33782 	s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
33783 	++(*lnote);
33784     } else {
33785 	hshft = (ihshft - 128) * .1f;
33786 
33787 /*  -12.8<hshft<12.8 */
33788 
33789 /* Writing concatenation */
33790 	i__2[0] = *lnote, a__1[0] = notexq;
33791 	i__2[1] = 1, a__1[1] = "{";
33792 	s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
33793 	++(*lnote);
33794 	if (hshft < -9.95f) {
33795 	    i__1 = *lnote;
33796 	    ici__1.icierr = 0;
33797 	    ici__1.icirnum = 1;
33798 	    ici__1.icirlen = *lnote + 5 - i__1;
33799 	    ici__1.iciunit = notexq + i__1;
33800 	    ici__1.icifmt = "(f5.1)";
33801 	    s_wsfi(&ici__1);
33802 	    do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real));
33803 	    e_wsfi();
33804 	    *lnote += 5;
33805 	} else if (hshft < -.05f || hshft > 9.95f) {
33806 	    i__1 = *lnote;
33807 	    ici__1.icierr = 0;
33808 	    ici__1.icirnum = 1;
33809 	    ici__1.icirlen = *lnote + 4 - i__1;
33810 	    ici__1.iciunit = notexq + i__1;
33811 	    ici__1.icifmt = "(f4.1)";
33812 	    s_wsfi(&ici__1);
33813 	    do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real));
33814 	    e_wsfi();
33815 	    *lnote += 4;
33816 	} else {
33817 	    i__1 = *lnote;
33818 	    ici__1.icierr = 0;
33819 	    ici__1.icirnum = 1;
33820 	    ici__1.icirlen = *lnote + 3 - i__1;
33821 	    ici__1.iciunit = notexq + i__1;
33822 	    ici__1.icifmt = "(f3.1)";
33823 	    s_wsfi(&ici__1);
33824 	    do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real));
33825 	    e_wsfi();
33826 	    *lnote += 3;
33827 	}
33828 /* Writing concatenation */
33829 	i__2[0] = *lnote, a__1[0] = notexq;
33830 	i__2[1] = 1, a__1[1] = "}";
33831 	s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
33832 	++(*lnote);
33833     }
33834     return 0;
33835 } /* putcb_ */
33836 
putfig_(integer * ivx,integer * ifig,real * offnsk,logical * figcheck,char * soutq,integer * lsout,ftnlen soutq_len)33837 /* Subroutine */ int putfig_(integer *ivx, integer *ifig, real *offnsk,
33838 	logical *figcheck, char *soutq, integer *lsout, ftnlen soutq_len)
33839 {
33840     /* System generated locals */
33841     address a__1[2], a__2[3], a__3[6], a__4[4];
33842     integer i__1[2], i__2[3], i__3, i__4[6], i__5[4];
33843     real r__1;
33844     char ch__1[1], ch__2[22], ch__3[21], ch__4[20], ch__5[19], ch__6[18],
33845 	    ch__7[13], ch__8[11], ch__9[8], ch__10[2];
33846 
33847     /* Builtin functions */
33848     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
33849 	     char **, integer *, integer *, ftnlen);
33850     integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
33851 	    , i_indx(char *, char *, ftnlen, ftnlen);
33852 
33853     /* Local variables */
33854     static integer ic;
33855     static char sq[1];
33856     static integer nof;
33857     static char ch1q[1], ch2q[1];
33858     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
33859     static integer nofa;
33860     static char figq[10];
33861     static integer lnof;
33862     static char nofq[5];
33863     static integer lnum, lnofa;
33864     static char nofaq[5];
33865     static integer icnum, lnote;
33866     extern /* Subroutine */ int addstr_(char *, integer *, char *, integer *,
33867 	    ftnlen, ftnlen);
33868     static char figutq[4], conttq[4], notexq[80];
33869     extern /* Subroutine */ int istring_(integer *, char *, integer *, ftnlen)
33870 	    ;
33871 
33872     /* Fortran I/O blocks */
33873     static icilist io___1514 = { 0, notexq+5, 0, "(f6.2)", 6, 1 };
33874     static icilist io___1516 = { 0, notexq+5, 0, "(f5.2)", 5, 1 };
33875     static icilist io___1517 = { 0, notexq+5, 0, "(f4.2)", 4, 1 };
33876     static icilist io___1518 = { 0, notexq+5, 0, "(f3.2)", 3, 1 };
33877     static icilist io___1531 = { 0, notexq+5, 0, "(f6.2)", 6, 1 };
33878     static icilist io___1532 = { 0, notexq+5, 0, "(f5.2)", 5, 1 };
33879     static icilist io___1533 = { 0, notexq+5, 0, "(f4.2)", 4, 1 };
33880     static icilist io___1534 = { 0, notexq+5, 0, "(f3.2)", 3, 1 };
33881 
33882 
33883     if (*ivx == 1) {
33884 	s_copy(figutq, "Figu", (ftnlen)4, (ftnlen)4);
33885 	s_copy(conttq, "Cont", (ftnlen)4, (ftnlen)4);
33886     } else {
33887 	s_copy(figutq, "Figt", (ftnlen)4, (ftnlen)4);
33888 	s_copy(conttq, "Cott", (ftnlen)4, (ftnlen)4);
33889     }
33890     chax_(ch__1, (ftnlen)1, &c__92);
33891     *(unsigned char *)sq = *(unsigned char *)&ch__1[0];
33892     if (dabs(*offnsk) > 1e-4f) {
33893 
33894 /*  Write offset for floating figure, to two decimal places */
33895 
33896 /* Writing concatenation */
33897 	i__1[0] = 1, a__1[0] = sq;
33898 	i__1[1] = 4, a__1[1] = "off{";
33899 	s_cat(notexq, a__1, i__1, &c__2, (ftnlen)80);
33900 	if (-(*offnsk) < -9.995f) {
33901 	    s_wsfi(&io___1514);
33902 	    r__1 = -(*offnsk);
33903 	    do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
33904 	    e_wsfi();
33905 	    lnote = 11;
33906 	} else if (-(*offnsk) < -.995f || -(*offnsk) > 9.995f) {
33907 	    s_wsfi(&io___1516);
33908 	    r__1 = -(*offnsk);
33909 	    do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
33910 	    e_wsfi();
33911 	    lnote = 10;
33912 	} else if (-(*offnsk) < -1e-4f || -(*offnsk) > .995f) {
33913 	    s_wsfi(&io___1517);
33914 	    r__1 = -(*offnsk);
33915 	    do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
33916 	    e_wsfi();
33917 	    lnote = 9;
33918 	} else {
33919 	    s_wsfi(&io___1518);
33920 	    r__1 = -(*offnsk);
33921 	    do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
33922 	    e_wsfi();
33923 	    lnote = 8;
33924 	}
33925 /* Writing concatenation */
33926 	i__2[0] = lnote, a__2[0] = notexq;
33927 	i__2[1] = 1, a__2[1] = sq;
33928 	i__2[2] = 9, a__2[2] = "noteskip}";
33929 	s_cat(notexq, a__2, i__2, &c__3, (ftnlen)80);
33930 	i__3 = lnote + 10;
33931 	addstr_(notexq, &i__3, soutq, lsout, (ftnlen)80, (ftnlen)80);
33932     }
33933     s_copy(figq, comfig_2.figqq + (*ivx + (*ifig << 1) - 3) * 10, (ftnlen)10,
33934 	    (ftnlen)10);
33935     ic = 1;
33936 /*      nof = 0 */
33937 /*      nofa = -1 */
33938     nof = -comfig_2.ivupfig[*ivx + (*ifig << 1) - 3];
33939     nofa = -comfig_2.ivupfig[*ivx + (*ifig << 1) - 3] - 1;
33940 
33941 /*  Beginning of manual loop */
33942 
33943 L1:
33944     *(unsigned char *)ch1q = *(unsigned char *)&figq[ic - 1];
33945 
33946 /*  Exit when first blank is encountered */
33947 
33948     if (*(unsigned char *)ch1q == ' ') {
33949 	goto L2;
33950     }
33951 
33952 /*  Starting a level.  Set up vertical offset. */
33953 
33954 /*        lnof = 1 */
33955 /*        nofq = chax(nof+48) */
33956 /*        if (nof .gt. 9) then */
33957 /*          lnof = 2 */
33958 /*          nofq = '1'//chax(nof-10+48) */
33959 /*        end if */
33960 /*        if (nofa .eq.-1) then */
33961 /*          lnofa = 2 */
33962 /*          nofaq = '-1' */
33963 /*        else if (nofa .lt. 10) then */
33964 /*          lnofa = 1 */
33965 /*          nofaq = chax(nofa+48) */
33966 /*        else */
33967 /*          lnofa = 2 */
33968 /*          nofaq = '1'//chax(nofa+38) */
33969 /*        end if */
33970     istring_(&nof, nofq, &lnof, (ftnlen)5);
33971     istring_(&nofa, nofaq, &lnofa, (ftnlen)5);
33972     if (*(unsigned char *)ch1q == '0') {
33973 
33974 /*  Continuation figure.  Next number is length (in noteskips). The number will */
33975 /*    end at the first blank or char that is not digit or decimal point. If */
33976 /*    colon, it is a separator and must be skipped */
33977 
33978 	icnum = ic + 1;
33979 L3:
33980 	++ic;
33981 	if (i_indx("0123456789.", figq + (ic - 1), (ftnlen)11, (ftnlen)1) > 0)
33982 		 {
33983 	    goto L3;
33984 	}
33985 	lnum = ic - icnum;
33986 /* Writing concatenation */
33987 	i__4[0] = 1, a__3[0] = sq;
33988 	i__4[1] = 4, a__3[1] = conttq;
33989 	i__4[2] = lnof, a__3[2] = nofq;
33990 	i__4[3] = 1, a__3[3] = "{";
33991 	i__4[4] = ic - 1 - (icnum - 1), a__3[4] = figq + (icnum - 1);
33992 	i__4[5] = 1, a__3[5] = "}";
33993 	s_cat(ch__2, a__3, i__4, &c__6, (ftnlen)22);
33994 	i__3 = ic + 7 - icnum + lnof;
33995 	addstr_(ch__2, &i__3, soutq, lsout, lnof + 6 + (ic - 1 - (icnum - 1))
33996 		+ 1, (ftnlen)80);
33997 	if (*(unsigned char *)&figq[ic - 1] != ':') {
33998 	    --ic;
33999 	}
34000     } else if (*(unsigned char *)ch1q == '#' || *(unsigned char *)ch1q == '-'
34001 	    || *(unsigned char *)ch1q == 'n') {
34002 	++ic;
34003 	*(unsigned char *)ch2q = *(unsigned char *)&figq[ic - 1];
34004 	if (*(unsigned char *)ch2q == ' ') {
34005 
34006 /*  Figure is a stand-alone accidental, so must be centered */
34007 
34008 	    if (*(unsigned char *)ch1q == '#') {
34009 /* Writing concatenation */
34010 		i__4[0] = 1, a__3[0] = sq;
34011 		i__4[1] = 4, a__3[1] = figutq;
34012 		i__4[2] = lnofa, a__3[2] = nofaq;
34013 		i__4[3] = 1, a__3[3] = "{";
34014 		i__4[4] = 1, a__3[4] = sq;
34015 		i__4[5] = 9, a__3[5] = "sharpfig}";
34016 		s_cat(ch__3, a__3, i__4, &c__6, (ftnlen)21);
34017 		i__3 = lnofa + 16;
34018 		addstr_(ch__3, &i__3, soutq, lsout, lnofa + 16, (ftnlen)80);
34019 	    } else if (*(unsigned char *)ch1q == '-') {
34020 /* Writing concatenation */
34021 		i__4[0] = 1, a__3[0] = sq;
34022 		i__4[1] = 4, a__3[1] = figutq;
34023 		i__4[2] = lnofa, a__3[2] = nofaq;
34024 		i__4[3] = 1, a__3[3] = "{";
34025 		i__4[4] = 1, a__3[4] = sq;
34026 		i__4[5] = 8, a__3[5] = "flatfig}";
34027 		s_cat(ch__4, a__3, i__4, &c__6, (ftnlen)20);
34028 		i__3 = lnofa + 15;
34029 		addstr_(ch__4, &i__3, soutq, lsout, lnofa + 15, (ftnlen)80);
34030 	    } else if (*(unsigned char *)ch1q == 'n') {
34031 /* Writing concatenation */
34032 		i__4[0] = 1, a__3[0] = sq;
34033 		i__4[1] = 4, a__3[1] = figutq;
34034 		i__4[2] = lnofa, a__3[2] = nofaq;
34035 		i__4[3] = 1, a__3[3] = "{";
34036 		i__4[4] = 1, a__3[4] = sq;
34037 		i__4[5] = 7, a__3[5] = "natfig}";
34038 		s_cat(ch__5, a__3, i__4, &c__6, (ftnlen)19);
34039 		i__3 = lnofa + 14;
34040 		addstr_(ch__5, &i__3, soutq, lsout, lnofa + 14, (ftnlen)80);
34041 	    }
34042 	    goto L2;
34043 	} else {
34044 
34045 /*  Figure is an accidental followed by a number */
34046 /*  First put the accidental (offset to the left) */
34047 
34048 	    if (*(unsigned char *)ch1q == '#') {
34049 /* Writing concatenation */
34050 		i__4[0] = 1, a__3[0] = sq;
34051 		i__4[1] = 4, a__3[1] = figutq;
34052 		i__4[2] = lnofa, a__3[2] = nofaq;
34053 		i__4[3] = 1, a__3[3] = "{";
34054 		i__4[4] = 1, a__3[4] = sq;
34055 		i__4[5] = 6, a__3[5] = "fsmsh}";
34056 		s_cat(ch__6, a__3, i__4, &c__6, (ftnlen)18);
34057 		i__3 = lnofa + 13;
34058 		addstr_(ch__6, &i__3, soutq, lsout, lnofa + 13, (ftnlen)80);
34059 	    } else if (*(unsigned char *)ch1q == '-') {
34060 /* Writing concatenation */
34061 		i__4[0] = 1, a__3[0] = sq;
34062 		i__4[1] = 4, a__3[1] = figutq;
34063 		i__4[2] = lnofa, a__3[2] = nofaq;
34064 		i__4[3] = 1, a__3[3] = "{";
34065 		i__4[4] = 1, a__3[4] = sq;
34066 		i__4[5] = 6, a__3[5] = "fsmfl}";
34067 		s_cat(ch__6, a__3, i__4, &c__6, (ftnlen)18);
34068 		i__3 = lnofa + 13;
34069 		addstr_(ch__6, &i__3, soutq, lsout, lnofa + 13, (ftnlen)80);
34070 	    } else if (*(unsigned char *)ch1q == 'n') {
34071 /* Writing concatenation */
34072 		i__4[0] = 1, a__3[0] = sq;
34073 		i__4[1] = 4, a__3[1] = figutq;
34074 		i__4[2] = lnofa, a__3[2] = nofaq;
34075 		i__4[3] = 1, a__3[3] = "{";
34076 		i__4[4] = 1, a__3[4] = sq;
34077 		i__4[5] = 6, a__3[5] = "fsmna}";
34078 		s_cat(ch__6, a__3, i__4, &c__6, (ftnlen)18);
34079 		i__3 = lnofa + 13;
34080 		addstr_(ch__6, &i__3, soutq, lsout, lnofa + 13, (ftnlen)80);
34081 	    }
34082 
34083 /*  Now put the number */
34084 
34085 /* Writing concatenation */
34086 	    i__4[0] = 1, a__3[0] = sq;
34087 	    i__4[1] = 4, a__3[1] = figutq;
34088 	    i__4[2] = lnof, a__3[2] = nofq;
34089 	    i__4[3] = 1, a__3[3] = "{";
34090 	    i__4[4] = 1, a__3[4] = ch2q;
34091 	    i__4[5] = 1, a__3[5] = "}";
34092 	    s_cat(ch__7, a__3, i__4, &c__6, (ftnlen)13);
34093 	    i__3 = lnof + 8;
34094 	    addstr_(ch__7, &i__3, soutq, lsout, lnof + 8, (ftnlen)80);
34095 	}
34096     } else if (*(unsigned char *)ch1q == '_') {
34097 
34098 /*  Placeholder only (for lowering a figure).  Don't do anything! */
34099 
34100     } else {
34101 
34102 /*  Figure is a single number, maybe with s after */
34103 
34104 /* Writing concatenation */
34105 	i__5[0] = 1, a__4[0] = sq;
34106 	i__5[1] = 4, a__4[1] = figutq;
34107 	i__5[2] = lnof, a__4[2] = nofq;
34108 	i__5[3] = 1, a__4[3] = "{";
34109 	s_cat(ch__8, a__4, i__5, &c__4, (ftnlen)11);
34110 	i__3 = lnof + 6;
34111 	addstr_(ch__8, &i__3, soutq, lsout, lnof + 6, (ftnlen)80);
34112 	i__3 = ic;
34113 	s_copy(ch2q, figq + i__3, (ftnlen)1, ic + 1 - i__3);
34114 	if (*(unsigned char *)ch2q == 's') {
34115 
34116 /*  Use a special character. Insert font call */
34117 
34118 	    ++ic;
34119 /* Writing concatenation */
34120 	    i__1[0] = 1, a__1[0] = sq;
34121 	    i__1[1] = 7, a__1[1] = "ligfont";
34122 	    s_cat(ch__9, a__1, i__1, &c__2, (ftnlen)8);
34123 	    addstr_(ch__9, &c__8, soutq, lsout, (ftnlen)8, (ftnlen)80);
34124 	}
34125 /* Writing concatenation */
34126 	i__1[0] = 1, a__1[0] = ch1q;
34127 	i__1[1] = 1, a__1[1] = "}";
34128 	s_cat(ch__10, a__1, i__1, &c__2, (ftnlen)2);
34129 	addstr_(ch__10, &c__2, soutq, lsout, (ftnlen)2, (ftnlen)80);
34130 /*          call addstr(sq//Figutq//nofq(1:lnof)//'{'//ch1q//'}', */
34131 /*     *           8+lnof,soutq,lsout) */
34132     }
34133     if (ic >= 10) {
34134 	goto L2;
34135     }
34136     ++ic;
34137     nof += 4;
34138     nofa += 4;
34139     goto L1;
34140 L2:
34141     if (dabs(*offnsk) > 1e-4f) {
34142 /* Writing concatenation */
34143 	i__1[0] = 1, a__1[0] = sq;
34144 	i__1[1] = 4, a__1[1] = "off{";
34145 	s_cat(notexq, a__1, i__1, &c__2, (ftnlen)80);
34146 	if (*offnsk < -9.995f) {
34147 	    s_wsfi(&io___1531);
34148 	    do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real));
34149 	    e_wsfi();
34150 	    lnote = 11;
34151 	} else if (*offnsk < -.995f || *offnsk > 9.995f) {
34152 	    s_wsfi(&io___1532);
34153 	    do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real));
34154 	    e_wsfi();
34155 	    lnote = 10;
34156 	} else if (*offnsk < -1e-4f || *offnsk > .995f) {
34157 	    s_wsfi(&io___1533);
34158 	    do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real));
34159 	    e_wsfi();
34160 	    lnote = 9;
34161 	} else {
34162 	    s_wsfi(&io___1534);
34163 	    do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real));
34164 	    e_wsfi();
34165 	    lnote = 8;
34166 	}
34167 /* Writing concatenation */
34168 	i__2[0] = lnote, a__2[0] = notexq;
34169 	i__2[1] = 1, a__2[1] = sq;
34170 	i__2[2] = 9, a__2[2] = "noteskip}";
34171 	s_cat(notexq, a__2, i__2, &c__3, (ftnlen)80);
34172 	i__3 = lnote + 10;
34173 	addstr_(notexq, &i__3, soutq, lsout, (ftnlen)80, (ftnlen)80);
34174     }
34175     if (*ifig < comfig_2.nfigs[*ivx - 1]) {
34176 	++(*ifig);
34177     } else {
34178 	comfig_2.nfigs[*ivx - 1] = 0;
34179 	*figcheck = FALSE_;
34180     }
34181     return 0;
34182 } /* putfig_ */
34183 
putorn_(integer * iornq,integer * nolev,integer * nolevm,integer * nodur,integer * nornb,char * ulq,integer * ibmcnt,integer * ivx,integer * ncm,integer * islur,integer * nvmx,integer * nv,integer * ihornb,real * stemlin,char * outq,integer * lout,integer * ip,integer * islhgt,logical * beamon,logical * iscrd,ftnlen ulq_len,ftnlen outq_len)34184 /* Subroutine */ int putorn_(integer *iornq, integer *nolev, integer *nolevm,
34185 	integer *nodur, integer *nornb, char *ulq, integer *ibmcnt, integer *
34186 	ivx, integer *ncm, integer *islur, integer *nvmx, integer *nv,
34187 	integer *ihornb, real *stemlin, char *outq, integer *lout, integer *
34188 	ip, integer *islhgt, logical *beamon, logical *iscrd, ftnlen ulq_len,
34189 	ftnlen outq_len)
34190 {
34191     /* System generated locals */
34192     address a__1[2], a__2[3], a__3[6];
34193     integer i__1, i__2, i__3[2], i__4[3], i__5[6];
34194     real r__1, r__2;
34195     char ch__1[1], ch__2[6];
34196     icilist ici__1;
34197 
34198     /* Builtin functions */
34199     integer pow_ii(integer *, integer *), i_nint(real *);
34200     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
34201     integer lbit_shift(integer, integer), i_dim(integer *, integer *), s_wsfi(
34202 	    icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void);
34203     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
34204 
34205     /* Local variables */
34206     extern /* Subroutine */ int addblank_(char *, integer *, ftnlen);
34207     static logical usehornb;
34208     static char sq[1];
34209     extern integer log2_(integer *);
34210     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
34211     static integer ioff, ibit;
34212     extern /* Character */ VOID udqq_(char *, ftnlen, integer *, integer *,
34213 	    integer *, integer *, integer *, integer *);
34214     extern integer lfmt1_(real *);
34215     static integer ibitt, ihorn, lform, lnote;
34216     static char noteq[8];
34217     static integer iornt;
34218     static char ulpzq[1];
34219     extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer
34220 	    *, ftnlen);
34221     static integer lnoten, iudorn;
34222     static char notexq[79];
34223     static integer iclracc, ioffinc;
34224     static real stemlen;
34225     extern /* Subroutine */ int dotrill_(integer *, integer *, integer *,
34226 	    char *, integer *, char *, integer *, ftnlen, ftnlen);
34227 
34228 
34229 /*  All args are individual array element *values* except nornb,ihornb,ulq. */
34230 /*  notcrd = .true. if ornament is on main note. */
34231 /*    nolevm is level of main note (for chords) */
34232 
34233     /* Parameter adjustments */
34234     ihornb -= 25;
34235     ulq -= 25;
34236     --nornb;
34237 
34238     /* Function Body */
34239     chax_(ch__1, (ftnlen)1, &c__92);
34240     *(unsigned char *)sq = *(unsigned char *)&ch__1[0];
34241     *lout = 0;
34242     usehornb = FALSE_;
34243     if (*nodur < 64) {
34244 	stemlen = *stemlin;
34245     } else {
34246 	stemlen = 0.f;
34247     }
34248 
34249 /*  Get up-downness. ulpzq is opposite from stem direction for both beams and */
34250 /*    non beams.  Can use in name of ornament [ . or _ ] */
34251 
34252     if (*beamon) {
34253 	if (*(unsigned char *)&ulq[*ivx + *ibmcnt * 24] == 'u') {
34254 	    *(unsigned char *)ulpzq = 'l';
34255 	} else {
34256 	    *(unsigned char *)ulpzq = 'u';
34257 	}
34258     } else {
34259 	udqq_(ch__1, (ftnlen)1, nolevm, ncm, islur, nvmx, ivx, nv);
34260 	if (*(unsigned char *)&ch__1[0] == 'l') {
34261 	    *(unsigned char *)ulpzq = 'u';
34262 	} else {
34263 	    *(unsigned char *)ulpzq = 'l';
34264 	}
34265     }
34266 
34267 /*  To enable >1 ornament on a note, next line is top of manual loop. */
34268 
34269 L2:
34270 
34271 /*  Bit # of last ornament (last of bits 0-21) */
34272 /* c  Bit # of last ornament (last of bits 0-24) */
34273     i__1 = *iornq & 4194303;
34274     ibit = log2_(&i__1);
34275 /*      ibit = log2(iand(iornq,33554431)) */
34276     iornt = pow_ii(&c__2, &ibit);
34277 
34278 /*  Begin routine to set height.  Bits 0-13: (stmgx+Tupf._) */
34279 /*  14: Down fermata, was F  15: Trill w/o "tr", was U, 16-18: edit. s,f,n */
34280 /*  19-20: >^, 21: ? (with or w/o 16-18) */
34281 
34282 /*  Do not use beam height for . or _ */
34283 
34284     if (bit_test(*iornq,22) && (iornt & 6144) == 0) {
34285 
34286 /*  Height is set by special beam stuff. */
34287 /*  Do not leave ihorn set, do separately for every ornament */
34288 
34289 	ihorn = ihornb[*ivx + nornb[*ivx] * 24];
34290 	if (*(unsigned char *)ulpzq == 'u') {
34291 	    ihorn += -2;
34292 	}
34293 
34294 /*  Following flag tells whether to increment nornb when exiting the subroutine. */
34295 
34296 	usehornb = TRUE_;
34297     } else if (ibit == 14) {
34298 
34299 /*  Down fermata.  Don't worry about upper chord notes. */
34300 
34301 	if (*(unsigned char *)ulpzq == 'l') {
34302 /* Computing MIN */
34303 	    i__1 = *nolev, i__2 = *ncm - 3;
34304 	    ihorn = min(i__1,i__2);
34305 	} else {
34306 /* Computing MIN */
34307 	    r__1 = *nolev - stemlen, r__2 = *ncm - 3.f;
34308 	    ihorn = dmin(r__1,r__2);
34309 	}
34310     } else if (bit_test(iornt,13) || bit_test(iornt,0)) {
34311 
34312 /*  ( or ) */
34313 
34314 	ihorn = *nolev;
34315     } else if ((iornt & 6144) > 0) {
34316 
34317 /* c  Staccato . or tenuto _ , but not special beam stuff.  Need up-down info */
34318 /*  NOTE: removed .&_ from special beam treatment. */
34319 /*  Staccato . or tenuto _  Need up-down info */
34320 
34321 	if (! (*iscrd) || comtrill_1.maxlev != *nolev && *(unsigned char *)
34322 		ulpzq == 'l' || comtrill_1.minlev != *nolev && *(unsigned
34323 		char *)ulpzq == 'u') {
34324 	    ihorn = *nolev;
34325 	} else if (comtrill_1.maxlev == *nolev) {
34326 	    *(unsigned char *)ulpzq = 'u';
34327 /* Computing MAX */
34328 	    r__1 = *nolev + stemlen, r__2 = *ncm + 3.f;
34329 	    ihorn = dmax(r__1,r__2);
34330 	} else {
34331 	    *(unsigned char *)ulpzq = 'l';
34332 /* Computing MIN */
34333 	    r__1 = *nolev - stemlen, r__2 = *ncm - 3.f;
34334 	    ihorn = dmin(r__1,r__2);
34335 	}
34336     } else if (*iscrd && *nolev == comtrill_1.minlev) {
34337 	if (*(unsigned char *)ulpzq == 'l') {
34338 /* Computing MIN */
34339 	    i__1 = *nolev - 3, i__2 = *ncm - 6;
34340 	    ihorn = min(i__1,i__2);
34341 	} else {
34342 /* Computing MIN */
34343 	    i__1 = *nolev - i_nint(&stemlen) - 3, i__2 = *ncm - 6;
34344 	    ihorn = min(i__1,i__2);
34345 	}
34346     } else if (ibit == 10 && *nolev > 90) {
34347 
34348 /*  Special treatment for fermata on a shifted rest */
34349 
34350 	ihorn = *ncm + 5;
34351     } else if (*(unsigned char *)ulpzq == 'l') {
34352 
34353 /*  (iscrd and nolev=maxlev) or (.not.iscrd) */
34354 
34355 /* Computing MAX */
34356 	r__1 = *nolev + stemlen + 2, r__2 = *ncm + 5.f;
34357 	ihorn = dmax(r__1,r__2);
34358     } else {
34359 /* Computing MAX */
34360 	i__1 = *nolev + 2, i__2 = *ncm + 5;
34361 	ihorn = max(i__1,i__2);
34362     }
34363     ioff = 0;
34364     iclracc = 0;
34365 
34366 /*  Begin routine to set name.  Bits 0-13: (stmgx+Tupf._) */
34367 /*  14: Down fermata, was F  15: Trill w/o "tr", was U, 16-18: edit. s,f,n */
34368 
34369     if (bit_test(iornt,2)) {
34370 /* Writing concatenation */
34371 	i__3[0] = 1, a__1[0] = sq;
34372 	i__3[1] = 5, a__1[1] = "shake";
34373 	s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34374 	lnote = 6;
34375     } else if (bit_test(iornt,3)) {
34376 /* Writing concatenation */
34377 	i__3[0] = 1, a__1[0] = sq;
34378 	i__3[1] = 7, a__1[1] = "mordent";
34379 	s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34380 	lnote = 8;
34381     } else if (bit_test(iornt,1)) {
34382 /* Writing concatenation */
34383 	i__3[0] = 1, a__1[0] = sq;
34384 	i__3[1] = 3, a__1[1] = "mtr";
34385 	s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34386 	lnote = 4;
34387     } else if (bit_test(iornt,5)) {
34388 /* Writing concatenation */
34389 	i__3[0] = 1, a__1[0] = sq;
34390 	i__3[1] = 3, a__1[1] = "xtr";
34391 	s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34392 	lnote = 4;
34393     } else if (bit_test(iornt,6)) {
34394 /* Writing concatenation */
34395 	i__3[0] = 1, a__1[0] = sq;
34396 	i__3[1] = 3, a__1[1] = "ptr";
34397 	s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34398 	lnote = 4;
34399     } else if (bit_test(iornt,13)) {
34400 /* Writing concatenation */
34401 	i__3[0] = 1, a__1[0] = sq;
34402 	i__3[1] = 3, a__1[1] = "rpn";
34403 	s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34404 	lnote = 4;
34405     } else if (bit_test(iornt,0)) {
34406 /* Writing concatenation */
34407 	i__3[0] = 1, a__1[0] = sq;
34408 	i__3[1] = 3, a__1[1] = "lpn";
34409 	s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34410 	lnote = 4;
34411     } else if (bit_test(iornt,12)) {
34412 /* Writing concatenation */
34413 	i__4[0] = 1, a__2[0] = sq;
34414 	i__4[1] = 1, a__2[1] = ulpzq;
34415 	i__4[2] = 2, a__2[2] = "st";
34416 	s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79);
34417 	lnote = 4;
34418     } else if (bit_test(iornt,11)) {
34419 /* Writing concatenation */
34420 	i__4[0] = 1, a__2[0] = sq;
34421 	i__4[1] = 1, a__2[1] = ulpzq;
34422 	i__4[2] = 2, a__2[2] = "pz";
34423 	s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79);
34424 	lnote = 4;
34425     } else if (bit_test(iornt,8)) {
34426 /* Writing concatenation */
34427 	i__3[0] = 1, a__1[0] = sq;
34428 	i__3[1] = 3, a__1[1] = "upz";
34429 	s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34430 	lnote = 4;
34431 	ioff = -2;
34432     } else if (bit_test(iornt,9)) {
34433 /* Writing concatenation */
34434 	i__3[0] = 1, a__1[0] = sq;
34435 	i__3[1] = 4, a__1[1] = "uppz";
34436 	s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34437 	lnote = 5;
34438 	ioff = -2;
34439     } else if (bit_test(iornt,10)) {
34440 	if (*nodur < 48) {
34441 /* Writing concatenation */
34442 	    i__3[0] = 1, a__1[0] = sq;
34443 	    i__3[1] = 9, a__1[1] = "fermataup";
34444 	    s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34445 	} else {
34446 /* Writing concatenation */
34447 	    i__3[0] = 1, a__1[0] = sq;
34448 	    i__3[1] = 9, a__1[1] = "Fermataup";
34449 	    s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34450 	}
34451 	lnote = 10;
34452 	ioff = -2;
34453     } else if (bit_test(iornt,14)) {
34454 	if (*nodur < 48) {
34455 /* Writing concatenation */
34456 	    i__3[0] = 1, a__1[0] = sq;
34457 	    i__3[1] = 11, a__1[1] = "fermatadown";
34458 	    s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34459 	} else {
34460 /* Writing concatenation */
34461 	    i__3[0] = 1, a__1[0] = sq;
34462 	    i__3[1] = 11, a__1[1] = "Fermatadown";
34463 	    s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34464 	}
34465 	lnote = 12;
34466     } else if (bit_test(iornt,21)) {
34467 
34468 /*  "?" in editorial ornament.  Clear bit 16-18 after use, since ibit=21 */
34469 
34470 	if (bit_test(*iornq,16)) {
34471 /* Writing concatenation */
34472 	    i__3[0] = 1, a__1[0] = sq;
34473 	    i__3[1] = 6, a__1[1] = "qsharp";
34474 	    s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34475 	    lnote = 7;
34476 	    ioff = 2;
34477 	    *iornq = bit_clear(*iornq,16);
34478 	    iclracc = 16;
34479 	} else if (bit_test(*iornq,17)) {
34480 /* Writing concatenation */
34481 	    i__3[0] = 1, a__1[0] = sq;
34482 	    i__3[1] = 5, a__1[1] = "qflat";
34483 	    s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34484 	    lnote = 6;
34485 	    ioff = 1;
34486 	    *iornq = bit_clear(*iornq,17);
34487 	    iclracc = 17;
34488 	} else if (bit_test(*iornq,18)) {
34489 /* Writing concatenation */
34490 	    i__3[0] = 1, a__1[0] = sq;
34491 	    i__3[1] = 4, a__1[1] = "qnat";
34492 	    s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34493 	    lnote = 5;
34494 	    ioff = 2;
34495 	    *iornq = bit_clear(*iornq,18);
34496 	    iclracc = 18;
34497 	} else {
34498 /* Writing concatenation */
34499 	    i__3[0] = 1, a__1[0] = sq;
34500 	    i__3[1] = 5, a__1[1] = "qedit";
34501 	    s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34502 	    lnote = 6;
34503 	    ioff = 0;
34504 	}
34505     } else if (bit_test(iornt,16)) {
34506 /* Writing concatenation */
34507 	i__3[0] = 1, a__1[0] = sq;
34508 	i__3[1] = 6, a__1[1] = "esharp";
34509 	s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34510 	lnote = 7;
34511 	ioff = 2;
34512     } else if (bit_test(iornt,17)) {
34513 /* Writing concatenation */
34514 	i__3[0] = 1, a__1[0] = sq;
34515 	i__3[1] = 5, a__1[1] = "eflat";
34516 	s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34517 	lnote = 6;
34518 	ioff = 1;
34519     } else if (bit_test(iornt,18)) {
34520 /* Writing concatenation */
34521 	i__3[0] = 1, a__1[0] = sq;
34522 	i__3[1] = 4, a__1[1] = "enat";
34523 	s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34524 	lnote = 5;
34525 	ioff = 2;
34526     } else if (bit_test(iornt,19)) {
34527 /* Writing concatenation */
34528 	i__3[0] = 1, a__1[0] = sq;
34529 	i__3[1] = 3, a__1[1] = "usf";
34530 	s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34531 	lnote = 4;
34532 	ioff = -2;
34533     } else if (bit_test(iornt,20)) {
34534 /* Writing concatenation */
34535 	i__3[0] = 1, a__1[0] = sq;
34536 	i__3[1] = 4, a__1[1] = "usfz";
34537 	s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34538 	lnote = 5;
34539 	ioff = -2;
34540     }
34541     iudorn = 0;
34542 
34543 /*  User-defined level shift of ornament from default? */
34544 
34545     if (bit_test(*iornq,25)) {
34546 
34547 /*  Find which (if any) element of kudorn has the shift. */
34548 
34549 	i__1 = comtrill_1.nudorn;
34550 	for (iudorn = 1; iudorn <= i__1; ++iudorn) {
34551 	    if (ibit < 21) {
34552 		ibitt = ibit;
34553 
34554 /*  Could have oes, but not oe? or oes? */
34555 
34556 	    } else if (iclracc > 0) {
34557 
34558 /*  Earlier cleared edit. accid, meaning it was oes? */
34559 
34560 		ibitt = iclracc + 6;
34561 	    } else {
34562 		ibitt = 21;
34563 	    }
34564 	    ibitt = *ip + (*ivx % 16 << 8) + (*nolev << 12) + (ibitt << 19);
34565 /*          if (ibitt .eq. iand(33554431,kudorn(iudorn))) go to 4 */
34566 	    if (ibitt == (33554431 & comtrill_1.kudorn[iudorn - 1]) && *ivx ==
34567 		     comivxudorn_1.ivxudorn[iudorn - 1]) {
34568 		goto L4;
34569 	    }
34570 /* L3: */
34571 	}
34572 
34573 /*  Nothing shifted on this note; exit this if block */
34574 
34575 	iudorn = 0;
34576 	goto L5;
34577 L4:
34578 	ioffinc = (63 & lbit_shift(comtrill_1.kudorn[iudorn - 1], (ftnlen)-25)
34579 		) - 32;
34580 	if (ibit == 19 && ioffinc < -7) {
34581 
34582 /*  Convert usf to lsf.  The reason has to do with positioning being impossile */
34583 /*  for some mysterious reason when you drop \usf below the staff */
34584 
34585 /* Writing concatenation */
34586 	    i__3[0] = 1, a__1[0] = sq;
34587 	    i__3[1] = 3, a__1[1] = "lsf";
34588 	    s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34589 	    ioffinc += 6;
34590 	}
34591 	ioff += ioffinc;
34592     }
34593 L5:
34594 
34595 /*  Shift level to avoid slur.  Conditions are */
34596 /*   1.  There is a slur */
34597 /*   2.  No user-defined orn height shift (btest(iornq,25)) */
34598 /*   3.  upslur (islhgt>0) */
34599 /*   4.  ornament is not segno(4), ._)(11-13), down ferm(14) or "(" (0) Bin=30737 */
34600 /*   5.  islhgt+3 >=  height already computed. */
34601 
34602     if (! bit_test(*iornq,25) && *islhgt > 0 && (iornt & 30737) == 0) {
34603 	i__1 = *islhgt + 3;
34604 	ioff += i_dim(&i__1, &ihorn);
34605     }
34606     i__1 = ihorn + ioff;
34607     notefq_(noteq, &lnoten, &i__1, ncm, (ftnlen)8);
34608     if (lnoten == 1) {
34609 	addblank_(noteq, &lnoten, (ftnlen)8);
34610     }
34611     if ((iornt & 32896) > 0) {
34612 
34613 /*  T-trill or trill w/o "tr" */
34614 
34615 	dotrill_(ivx, ip, &iornt, noteq, &lnoten, notexq, &lnote, (ftnlen)8, (
34616 		ftnlen)79);
34617     } else {
34618 /* Writing concatenation */
34619 	i__3[0] = lnote, a__1[0] = notexq;
34620 	i__3[1] = lnoten, a__1[1] = noteq;
34621 	s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
34622 	lnote += lnoten;
34623     }
34624     if (iudorn > 0) {
34625 	if (bit_test(comtrill_1.kudorn[iudorn - 1],31)) {
34626 
34627 /*  Horizontal shift */
34628 
34629 	    lform = lfmt1_(&comtrill_1.ornhshft[iudorn - 1]);
34630 	    ici__1.icierr = 0;
34631 	    ici__1.icirnum = 1;
34632 	    ici__1.icirlen = lform;
34633 	    ici__1.iciunit = noteq;
34634 /* Writing concatenation */
34635 	    i__4[0] = 2, a__2[0] = "(f";
34636 	    i__1 = lform + 48;
34637 	    chax_(ch__1, (ftnlen)1, &i__1);
34638 	    i__4[1] = 1, a__2[1] = ch__1;
34639 	    i__4[2] = 3, a__2[2] = ".1)";
34640 	    ici__1.icifmt = (s_cat(ch__2, a__2, i__4, &c__3, (ftnlen)6),
34641 		    ch__2);
34642 	    s_wsfi(&ici__1);
34643 	    do_fio(&c__1, (char *)&comtrill_1.ornhshft[iudorn - 1], (ftnlen)
34644 		    sizeof(real));
34645 	    e_wsfi();
34646 /* Writing concatenation */
34647 	    i__5[0] = 1, a__3[0] = sq;
34648 	    i__5[1] = 8, a__3[1] = "roffset{";
34649 	    i__5[2] = lform, a__3[2] = noteq;
34650 	    i__5[3] = 2, a__3[3] = "}{";
34651 	    i__5[4] = lnote, a__3[4] = notexq;
34652 	    i__5[5] = 1, a__3[5] = "}";
34653 	    s_cat(notexq, a__3, i__5, &c__6, (ftnlen)79);
34654 	    lnote = lnote + lform + 12;
34655 	    comtrill_1.ornhshft[iudorn - 1] = 0.f;
34656 	    comtrill_1.kudorn[iudorn - 1] = bit_clear(comtrill_1.kudorn[
34657 		    iudorn - 1],31);
34658 	}
34659     }
34660 
34661 /*  Zero out the bit for ornament just dealt with. */
34662 
34663     *iornq = bit_clear(*iornq,ibit);
34664     if (*lout == 0) {
34665 	s_copy(outq, notexq, (ftnlen)79, lnote);
34666     } else {
34667 /* Writing concatenation */
34668 	i__3[0] = *lout, a__1[0] = outq;
34669 	i__3[1] = lnote, a__1[1] = notexq;
34670 	s_cat(outq, a__1, i__3, &c__2, (ftnlen)79);
34671     }
34672     *lout += lnote;
34673 
34674 /*  Check bits 0-21, go back if any are still set */
34675 
34676     if ((*iornq & 4194303) > 0) {
34677 	goto L2;
34678     }
34679     if (usehornb) {
34680 	++nornb[*ivx];
34681     }
34682     return 0;
34683 } /* putorn_ */
34684 
putshft_(integer * ivx,logical * onoff,char * soutq,integer * lsout,ftnlen soutq_len)34685 /* Subroutine */ int putshft_(integer *ivx, logical *onoff, char *soutq,
34686 	integer *lsout, ftnlen soutq_len)
34687 {
34688     /* System generated locals */
34689     address a__1[3], a__2[4];
34690     integer i__1[3], i__2, i__3[4];
34691     real r__1;
34692     char ch__1[1], ch__2[6], ch__3[88];
34693     icilist ici__1;
34694 
34695     /* Builtin functions */
34696     double r_sign(real *, real *);
34697     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
34698     integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
34699 	    ;
34700 
34701     /* Local variables */
34702     static char sq[1];
34703     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
34704     static integer ifmt;
34705     static real xoff;
34706     extern /* Subroutine */ int addstr_(char *, integer *, char *, integer *,
34707 	    ftnlen, ftnlen);
34708     static char notexq[80];
34709 
34710     chax_(ch__1, (ftnlen)1, &c__92);
34711     *(unsigned char *)sq = *(unsigned char *)&ch__1[0];
34712 
34713 /*  Start user-defined offsets X(...): or X(...)S */
34714 
34715     if (*onoff) {
34716 	++comudsp_1.nudoff[*ivx - 1];
34717     }
34718 
34719 /*  Xoff is in pts.  Round off to nearest .1.  Will use at end of shift. */
34720 
34721     xoff = comudsp_1.udoff[*ivx + comudsp_1.nudoff[*ivx - 1] * 24 - 25];
34722     r__1 = (integer) (dabs(xoff) * 10.f + .5f) / 10.f;
34723     xoff = r_sign(&r__1, &xoff);
34724     if (! (*onoff)) {
34725 	xoff = -xoff;
34726     }
34727     if (xoff < -9.95f) {
34728 	ifmt = 5;
34729     } else if (xoff < -.95f || xoff > 9.95f) {
34730 	ifmt = 4;
34731     } else {
34732 	ifmt = 3;
34733     }
34734     ici__1.icierr = 0;
34735     ici__1.icirnum = 1;
34736     ici__1.icirlen = 80;
34737     ici__1.iciunit = notexq;
34738 /* Writing concatenation */
34739     i__1[0] = 2, a__1[0] = "(f";
34740     i__2 = ifmt + 48;
34741     chax_(ch__1, (ftnlen)1, &i__2);
34742     i__1[1] = 1, a__1[1] = ch__1;
34743     i__1[2] = 3, a__1[2] = ".1)";
34744     ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2);
34745     s_wsfi(&ici__1);
34746     do_fio(&c__1, (char *)&xoff, (ftnlen)sizeof(real));
34747     e_wsfi();
34748 /* Writing concatenation */
34749     i__3[0] = 1, a__2[0] = sq;
34750     i__3[1] = 4, a__2[1] = "off{";
34751     i__3[2] = ifmt, a__2[2] = notexq;
34752     i__3[3] = 3, a__2[3] = "pt}";
34753     s_cat(ch__3, a__2, i__3, &c__4, (ftnlen)88);
34754     i__2 = ifmt + 8;
34755     addstr_(ch__3, &i__2, soutq, lsout, ifmt + 8, (ftnlen)80);
34756     return 0;
34757 } /* putshft_ */
34758 
puttitle_(integer * inhnoh,real * xnsttop,real * etatop,char * sq,real * etait,real * etatc,real * etacs1,integer * nv,logical * vshrink,char * sepsymq,ftnlen sq_len,ftnlen sepsymq_len)34759 /* Subroutine */ int puttitle_(integer *inhnoh, real *xnsttop, real *etatop,
34760 	char *sq, real *etait, real *etatc, real *etacs1, integer *nv,
34761 	logical *vshrink, char *sepsymq, ftnlen sq_len, ftnlen sepsymq_len)
34762 {
34763     /* System generated locals */
34764     address a__1[2], a__2[3], a__3[3], a__4[4];
34765     integer i__1[2], i__2, i__3[3], i__4, i__5[3], i__6[4];
34766     real r__1;
34767     char ch__1[8], ch__2[1], ch__3[10], ch__4[148], ch__5[129], ch__6[133];
34768     icilist ici__1;
34769 
34770     /* Builtin functions */
34771     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
34772     double r_lg10(real *);
34773     integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
34774 	    , s_wsfe(cilist *), e_wsfe(void);
34775     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
34776 
34777     /* Local variables */
34778     extern /* Subroutine */ int writflot_(real *, char *, integer *, ftnlen);
34779     static integer iv, lcq, ndig;
34780     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
34781     static real xcsil, xtcil, vskil, xitil, glueil;
34782     extern integer lenstr_(char *, integer *, ftnlen);
34783     extern /* Subroutine */ int printl_(char *, ftnlen);
34784     static char notexq[127];
34785     static integer lenline;
34786 
34787     /* Fortran I/O blocks */
34788     static cilist io___1562 = { 0, 11, 0, "(a)", 0 };
34789     static cilist io___1565 = { 0, 11, 0, "(a)", 0 };
34790     static cilist io___1568 = { 0, 11, 0, "(a)", 0 };
34791 
34792 
34793 
34794 /*  Called once per page, at top of page!  If vshrink, only called for p.1. */
34795 /*  Actual titles only allowed on p.1. (set by headlog). */
34796 /*  3/18/01:  The above comment is probably bogus...can use Tt on later pages. */
34797 
34798     /* Parameter adjustments */
34799     --sepsymq;
34800 
34801     /* Function Body */
34802 /* Writing concatenation */
34803     i__1[0] = 1, a__1[0] = sq;
34804     i__1[1] = 6, a__1[1] = "znotes";
34805     s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
34806     lenline = 7;
34807     i__2 = *nv - 1;
34808     for (iv = 1; iv <= i__2; ++iv) {
34809 /* Writing concatenation */
34810 	i__1[0] = lenline, a__1[0] = notexq;
34811 	i__1[1] = 1, a__1[1] = sepsymq + iv;
34812 	s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
34813 	++lenline;
34814 /* L22: */
34815     }
34816 /* Writing concatenation */
34817     i__3[0] = lenline, a__2[0] = notexq;
34818     i__3[1] = 1, a__2[1] = sq;
34819     i__3[2] = 10, a__2[2] = "zcharnote{";
34820     s_cat(notexq, a__2, i__3, &c__3, (ftnlen)127);
34821     lenline += 11;
34822     if (! comtitl_1.headlog) {
34823 	comtitl_1.inhead = *inhnoh;
34824     }
34825     if (*vshrink && comlast_1.usevshrink) {
34826 	comtitl_1.inhead = 16;
34827     }
34828     r__1 = comtitl_1.inhead + .01f;
34829     ndig = (integer) r_lg10(&r__1) + 1;
34830     i__2 = lenline;
34831     ici__1.icierr = 0;
34832     ici__1.icirnum = 1;
34833     ici__1.icirlen = lenline + ndig + 10 - i__2;
34834     ici__1.iciunit = notexq + i__2;
34835 /* Writing concatenation */
34836     i__3[0] = 2, a__2[0] = "(i";
34837     i__4 = ndig + 48;
34838     chax_(ch__2, (ftnlen)1, &i__4);
34839     i__3[1] = 1, a__2[1] = ch__2;
34840     i__3[2] = 5, a__2[2] = ",a10)";
34841     ici__1.icifmt = (s_cat(ch__1, a__2, i__3, &c__3, (ftnlen)8), ch__1);
34842     s_wsfi(&ici__1);
34843     do_fio(&c__1, (char *)&comtitl_1.inhead, (ftnlen)sizeof(integer));
34844 /* Writing concatenation */
34845     i__5[0] = 2, a__3[0] = "}{";
34846     i__5[1] = 1, a__3[1] = sq;
34847     i__5[2] = 7, a__3[2] = "titles{";
34848     s_cat(ch__3, a__3, i__5, &c__3, (ftnlen)10);
34849     do_fio(&c__1, ch__3, (ftnlen)10);
34850     e_wsfi();
34851     lenline = lenline + ndig + 10;
34852 
34853 /*  Vertical skip at top of page (\Il) = etatop*glueil.  Needed whether */
34854 /*    headers are present or not. */
34855 
34856     glueil = *xnsttop / *etatop;
34857     vskil = *etatop * glueil;
34858     if (*vshrink && comlast_1.usevshrink) {
34859 	vskil = 2.f;
34860     }
34861     writflot_(&vskil, notexq, &lenline, (ftnlen)127);
34862     if (! comtitl_1.headlog) {
34863 	if (comlast_1.islast) {
34864 	    s_wsfe(&io___1562);
34865 /* Writing concatenation */
34866 	    i__6[0] = lenline, a__4[0] = notexq;
34867 	    i__6[1] = 17, a__4[1] = "}{}{0}{}{0}{}{0}}";
34868 	    i__6[2] = 1, a__4[2] = sq;
34869 	    i__6[3] = 3, a__4[3] = "en%";
34870 	    s_cat(ch__4, a__4, i__6, &c__4, (ftnlen)148);
34871 	    do_fio(&c__1, ch__4, lenline + 21);
34872 	    e_wsfe();
34873 	}
34874     } else {
34875 /* Writing concatenation */
34876 	i__1[0] = lenline, a__1[0] = notexq;
34877 	i__1[1] = 2, a__1[1] = "}{";
34878 	s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
34879 	lenline += 2;
34880 	lcq = lenstr_(comtitl_1.instrq, &c__120, (ftnlen)120);
34881 	if (lcq > 0) {
34882 	    xitil = *etait * glueil;
34883 	    if (*vshrink && comlast_1.usevshrink) {
34884 		xitil = 2.f;
34885 	    }
34886 /* Writing concatenation */
34887 	    i__3[0] = lenline, a__2[0] = notexq;
34888 	    i__3[1] = lcq, a__2[1] = comtitl_1.instrq;
34889 	    i__3[2] = 2, a__2[2] = "}{";
34890 	    s_cat(notexq, a__2, i__3, &c__3, (ftnlen)127);
34891 
34892 /* Null out instrument once used */
34893 
34894 	    s_copy(comtitl_1.instrq, " ", (ftnlen)120, (ftnlen)1);
34895 	    lenline = lenline + lcq + 2;
34896 	    writflot_(&xitil, notexq, &lenline, (ftnlen)127);
34897 	} else {
34898 /* Writing concatenation */
34899 	    i__1[0] = lenline, a__1[0] = notexq;
34900 	    i__1[1] = 3, a__1[1] = "}{0";
34901 	    s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
34902 	    lenline += 3;
34903 	}
34904 	if (comlast_1.islast) {
34905 	    s_wsfe(&io___1565);
34906 /* Writing concatenation */
34907 	    i__1[0] = lenline, a__1[0] = notexq;
34908 	    i__1[1] = 2, a__1[1] = "}%";
34909 	    s_cat(ch__5, a__1, i__1, &c__2, (ftnlen)129);
34910 	    do_fio(&c__1, ch__5, lenline + 2);
34911 	    e_wsfe();
34912 	}
34913 	s_copy(notexq, "{", (ftnlen)127, (ftnlen)1);
34914 	lenline = 1;
34915 	lcq = lenstr_(comtitl_1.titleq, &c__120, (ftnlen)120);
34916 	if (lcq > 0) {
34917 /* Writing concatenation */
34918 	    i__1[0] = lenline, a__1[0] = notexq;
34919 	    i__1[1] = lcq, a__1[1] = comtitl_1.titleq;
34920 	    s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
34921 	    lenline += lcq;
34922 	} else {
34923 	    printl_(" ", (ftnlen)1);
34924 	    printl_("WARNING", (ftnlen)7);
34925 	    printl_("  In a title block, you have specified instrument and/or"
34926 		    , (ftnlen)56);
34927 	    printl_("  composer but no title for the piece.", (ftnlen)38);
34928 	}
34929 /* Writing concatenation */
34930 	i__1[0] = lenline, a__1[0] = notexq;
34931 	i__1[1] = 2, a__1[1] = "}{";
34932 	s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
34933 	lenline += 2;
34934 	xtcil = *etatc * glueil;
34935 	lcq = lenstr_(comtitl_1.compoq, &c__120, (ftnlen)120);
34936 	if (lcq == 0) {
34937 	    xtcil *= 2;
34938 	}
34939 	if (*vshrink && comlast_1.usevshrink) {
34940 	    xtcil = 2.f;
34941 	}
34942 	writflot_(&xtcil, notexq, &lenline, (ftnlen)127);
34943 /* Writing concatenation */
34944 	i__1[0] = lenline, a__1[0] = notexq;
34945 	i__1[1] = 2, a__1[1] = "}{";
34946 	s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
34947 	lenline += 2;
34948 	if (lcq > 0) {
34949 /* Writing concatenation */
34950 	    i__3[0] = lenline, a__2[0] = notexq;
34951 	    i__3[1] = lcq, a__2[1] = comtitl_1.compoq;
34952 	    i__3[2] = 2, a__2[2] = "}{";
34953 	    s_cat(notexq, a__2, i__3, &c__3, (ftnlen)127);
34954 	    lenline = lenline + 2 + lcq;
34955 
34956 /*  Null out compoq so it does not get written later */
34957 
34958 	    s_copy(comtitl_1.compoq, " ", (ftnlen)120, (ftnlen)1);
34959 	    xcsil = *etacs1 * glueil;
34960 	    if (*vshrink && comlast_1.usevshrink) {
34961 		xcsil = 2.f;
34962 	    }
34963 	    writflot_(&xcsil, notexq, &lenline, (ftnlen)127);
34964 	} else {
34965 /* Writing concatenation */
34966 	    i__1[0] = lenline, a__1[0] = notexq;
34967 	    i__1[1] = 3, a__1[1] = "}{0";
34968 	    s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
34969 	    lenline += 3;
34970 	}
34971 	if (comlast_1.islast) {
34972 	    s_wsfe(&io___1568);
34973 /* Writing concatenation */
34974 	    i__6[0] = lenline, a__4[0] = notexq;
34975 	    i__6[1] = 2, a__4[1] = "}}";
34976 	    i__6[2] = 1, a__4[2] = sq;
34977 	    i__6[3] = 3, a__4[3] = "en%";
34978 	    s_cat(ch__6, a__4, i__6, &c__4, (ftnlen)133);
34979 	    do_fio(&c__1, ch__6, lenline + 6);
34980 	    e_wsfe();
34981 	}
34982 	comtitl_1.headlog = FALSE_;
34983     }
34984     return 0;
34985 } /* puttitle_ */
34986 
putxtn_(integer * ntupv,integer * iflop,integer * multb,integer * iud,real * wheadpt,real * poenom,integer * nolev1,integer * islope,real * slfac,real * xnlmid,integer * islur,integer * lnote,char * notexq,integer * ncmid,integer * nlnum,real * eloff,integer * iup,integer * irest,logical * usexnumt,ftnlen notexq_len)34987 /* Subroutine */ int putxtn_(integer *ntupv, integer *iflop, integer *multb,
34988 	integer *iud, real *wheadpt, real *poenom, integer *nolev1, integer *
34989 	islope, real *slfac, real *xnlmid, integer *islur, integer *lnote,
34990 	char *notexq, integer *ncmid, integer *nlnum, real *eloff, integer *
34991 	iup, integer *irest, logical *usexnumt, ftnlen notexq_len)
34992 {
34993     /* System generated locals */
34994     address a__1[2], a__2[3];
34995     integer i__1[2], i__2[3], i__3;
34996     real r__1;
34997     char ch__1[1];
34998     icilist ici__1;
34999 
35000     /* Builtin functions */
35001     integer i_nint(real *), lbit_shift(integer, integer);
35002     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
35003     integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
35004 	    ;
35005 
35006     /* Local variables */
35007     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
35008     static char noteq[8];
35009     extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer
35010 	    *, ftnlen);
35011     static integer lnoten, istrtn;
35012 
35013 
35014 /*  Places digit for xtuplet. */
35015 
35016     if (*iflop != 0 && *multb > 0) {
35017 
35018 /* Number goes on beam side, move R/L by .5 wheadpt for upper/lower */
35019 
35020 	*eloff -= *iud * .5f * *wheadpt / *poenom;
35021 
35022 /*  Number goes on beam side, must use beam parameters to set pos'n */
35023 
35024 	*nlnum = *nolev1 + *islope / *slfac * *eloff + *iup * (*multb + 8);
35025 	if (*multb >= 2) {
35026 	    *nlnum += *iup;
35027 	}
35028     } else {
35029 	r__1 = *xnlmid - 1 + *iud * 3 + *iflop * 11;
35030 	*nlnum = i_nint(&r__1);
35031     }
35032     if (! bit_test(*islur,31)) {
35033 
35034 /*  Only print number when wanted.  First check vert, horiz offset */
35035 
35036 	if (bit_test(*irest,1)) {
35037 	    *nlnum = *nlnum + (31 & lbit_shift(*irest, (ftnlen)-2)) - 16;
35038 	}
35039 	if (bit_test(*irest,7)) {
35040 	    *eloff += ((31 & lbit_shift(*irest, (ftnlen)-9)) * .1f - 1.6f) * *
35041 		    wheadpt / *poenom;
35042 	}
35043 	if (! (*usexnumt)) {
35044 /* Writing concatenation */
35045 	    chax_(ch__1, (ftnlen)1, &c__92);
35046 	    i__1[0] = 1, a__1[0] = ch__1;
35047 	    i__1[1] = 5, a__1[1] = "xnum{";
35048 	    s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
35049 	    *lnote = 10;
35050 	    istrtn = 7;
35051 	} else {
35052 /* Writing concatenation */
35053 	    chax_(ch__1, (ftnlen)1, &c__92);
35054 	    i__1[0] = 1, a__1[0] = ch__1;
35055 	    i__1[1] = 6, a__1[1] = "xnumt{";
35056 	    s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
35057 	    *lnote = 11;
35058 	    istrtn = 8;
35059 	}
35060 	if (*eloff < .995f) {
35061 	    ici__1.icierr = 0;
35062 	    ici__1.icirnum = 1;
35063 	    ici__1.icirlen = 4;
35064 	    ici__1.iciunit = notexq + (istrtn - 1);
35065 	    ici__1.icifmt = "(i1,f3.2)";
35066 	    s_wsfi(&ici__1);
35067 	    do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
35068 	    do_fio(&c__1, (char *)&(*eloff), (ftnlen)sizeof(real));
35069 	    e_wsfi();
35070 	} else if (*eloff < 9.995f) {
35071 	    ici__1.icierr = 0;
35072 	    ici__1.icirnum = 1;
35073 	    ici__1.icirlen = 4;
35074 	    ici__1.iciunit = notexq + (istrtn - 1);
35075 	    ici__1.icifmt = "(f4.2)";
35076 	    s_wsfi(&ici__1);
35077 	    do_fio(&c__1, (char *)&(*eloff), (ftnlen)sizeof(real));
35078 	    e_wsfi();
35079 	} else {
35080 	    ici__1.icierr = 0;
35081 	    ici__1.icirnum = 1;
35082 	    ici__1.icirlen = 5;
35083 	    ici__1.iciunit = notexq + (istrtn - 1);
35084 	    ici__1.icifmt = "(f5.2)";
35085 	    s_wsfi(&ici__1);
35086 	    do_fio(&c__1, (char *)&(*eloff), (ftnlen)sizeof(real));
35087 	    e_wsfi();
35088 	    ++(*lnote);
35089 	}
35090 	notefq_(noteq, &lnoten, nlnum, ncmid, (ftnlen)8);
35091 /* Writing concatenation */
35092 	i__2[0] = *lnote, a__2[0] = notexq;
35093 	i__2[1] = 1, a__2[1] = "}";
35094 	i__2[2] = lnoten, a__2[2] = noteq;
35095 	s_cat(notexq, a__2, i__2, &c__3, (ftnlen)79);
35096 	*lnote = *lnote + 1 + lnoten;
35097 	if (*ntupv < 10) {
35098 	    i__3 = *lnote;
35099 	    ici__1.icierr = 0;
35100 	    ici__1.icirnum = 1;
35101 	    ici__1.icirlen = *lnote + 1 - i__3;
35102 	    ici__1.iciunit = notexq + i__3;
35103 	    ici__1.icifmt = "(i1)";
35104 	    s_wsfi(&ici__1);
35105 	    do_fio(&c__1, (char *)&(*ntupv), (ftnlen)sizeof(integer));
35106 	    e_wsfi();
35107 	    ++(*lnote);
35108 	} else {
35109 /* Writing concatenation */
35110 	    i__1[0] = *lnote, a__1[0] = notexq;
35111 	    i__1[1] = 1, a__1[1] = "{";
35112 	    s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
35113 	    i__3 = *lnote + 1;
35114 	    ici__1.icierr = 0;
35115 	    ici__1.icirnum = 1;
35116 	    ici__1.icirlen = *lnote + 3 - i__3;
35117 	    ici__1.iciunit = notexq + i__3;
35118 	    ici__1.icifmt = "(i2)";
35119 	    s_wsfi(&ici__1);
35120 	    do_fio(&c__1, (char *)&(*ntupv), (ftnlen)sizeof(integer));
35121 	    e_wsfi();
35122 /* Writing concatenation */
35123 	    i__1[0] = *lnote + 3, a__1[0] = notexq;
35124 	    i__1[1] = 1, a__1[1] = "}";
35125 	    s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
35126 	    *lnote += 4;
35127 	}
35128     }
35129     return 0;
35130 } /* putxtn_ */
35131 
read10_(char * string,logical * lastchar,ftnlen string_len)35132 /* Subroutine */ int read10_(char *string, logical *lastchar, ftnlen
35133 	string_len)
35134 {
35135     /* Builtin functions */
35136     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
35137 
35138     /* Local variables */
35139     static integer ip1, ip2;
35140     extern /* Subroutine */ int getbuf_(char *, ftnlen);
35141 
35142     if (! commac_1.mplay) {
35143 	if (inbuff_1.ilbuf > inbuff_1.nlbuf) {
35144 	    goto L999;
35145 	}
35146 	getbuf_(string, string_len);
35147 	return 0;
35148 L999:
35149 	*lastchar = TRUE_;
35150 	return 0;
35151     } else {
35152 
35153 /*  Play a macro.  Set pointer to first character needed in buffer */
35154 
35155 	if (c1ommac_1.ilmac == c1ommac_1.il1mac[commac_1.macnum - 1]) {
35156 
35157 /*  Getting first line of macro */
35158 
35159 	    ip1 = c1ommac_1.ip1mac[commac_1.macnum - 1];
35160 	    c1ommac_1.iplmac = ip1 - c1ommac_1.ic1mac[commac_1.macnum - 1];
35161 	} else if (c1ommac_1.ilmac <= c1ommac_1.il2mac[commac_1.macnum - 1]) {
35162 
35163 /*  Beyond first line of macro.  Advance line-start pointer. */
35164 
35165 	    c1ommac_1.iplmac += inbuff_1.lbuf[c1ommac_1.ilmac - 2];
35166 	    ip1 = c1ommac_1.iplmac + 1;
35167 	} else {
35168 
35169 /*  Beyond last line of macro.  Terminate it! */
35170 
35171 	    commac_1.mplay = FALSE_;
35172 	    commac_1.endmac = TRUE_;
35173 	    return 0;
35174 	}
35175 	if (c1ommac_1.ilmac == c1ommac_1.il2mac[commac_1.macnum - 1]) {
35176 
35177 /*  Getting last line of macro. */
35178 
35179 	    ip2 = c1ommac_1.ip2mac[commac_1.macnum - 1];
35180 	} else {
35181 
35182 /*  Getting line before last line of macro. */
35183 
35184 	    ip2 = c1ommac_1.iplmac + inbuff_1.lbuf[c1ommac_1.ilmac - 1];
35185 	}
35186 	if (ip2 >= ip1) {
35187 	    s_copy(string, inbuff_1.bufq + (ip1 - 1), string_len, ip2 - (ip1
35188 		    - 1));
35189 	} else {
35190 
35191 /*  Kluge for when macro start is on a line by itself */
35192 
35193 	    s_copy(string, " ", string_len, (ftnlen)1);
35194 	}
35195 	++c1ommac_1.ilmac;
35196 	return 0;
35197     }
35198     return 0;
35199 } /* read10_ */
35200 
readin_(char * lineq,integer * iccount,integer * nline,ftnlen lineq_len)35201 doublereal readin_(char *lineq, integer *iccount, integer *nline, ftnlen
35202 	lineq_len)
35203 {
35204     /* System generated locals */
35205     address a__1[3];
35206     integer i__1[3];
35207     real ret_val;
35208     char ch__1[27], ch__2[6], ch__3[1];
35209     icilist ici__1;
35210 
35211     /* Builtin functions */
35212     integer i_indx(char *, char *, ftnlen, ftnlen), s_wsle(cilist *);
35213     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
35214     integer do_lio(integer *, integer *, char *, ftnlen), e_wsle(void),
35215 	    s_rsfi(icilist *), do_fio(integer *, char *, ftnlen), e_rsfi(void)
35216 	    ;
35217 
35218     /* Local variables */
35219     static integer i1, i2, icf;
35220     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
35221     static char durq[1];
35222     extern /* Subroutine */ int stop1_(void), getbuf_(char *, ftnlen),
35223 	    getchar_(char *, integer *, char *, ftnlen, ftnlen);
35224 
35225     /* Fortran I/O blocks */
35226     static cilist io___1577 = { 0, 6, 0, 0, 0 };
35227 
35228 
35229 
35230 /*  Reads a piece of setup data from file lineq, gets a new lineq from */
35231 /*  file 10 (jobname.pmx) and increments nline if needed,  passes over */
35232 /*  comment lines */
35233 
35234 L4:
35235     if (*iccount == 128) {
35236 L1:
35237 	getbuf_(lineq, (ftnlen)128);
35238 	++(*nline);
35239 	if (*(unsigned char *)lineq == '%') {
35240 	    goto L1;
35241 	}
35242 	*iccount = 0;
35243     }
35244     ++(*iccount);
35245 
35246 /*  Find next non-blank or end of line */
35247 
35248     for (*iccount = *iccount; *iccount <= 127; ++(*iccount)) {
35249 	if (*(unsigned char *)&lineq[*iccount - 1] != ' ') {
35250 	    goto L3;
35251 	}
35252 /* L2: */
35253     }
35254 
35255 /*  If here, need to get a new line */
35256 
35257     *iccount = 128;
35258     goto L4;
35259 L3:
35260 
35261 /*  iccount now points to start of number to read */
35262 
35263     i1 = *iccount;
35264 L5:
35265     getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
35266 
35267 /*  Remember that getchar increments iccount, then reads a character. */
35268 
35269     if (i_indx("0123456789.-", durq, (ftnlen)12, (ftnlen)1) > 0) {
35270 	goto L5;
35271     }
35272     i2 = *iccount - 1;
35273     if (i2 < i1) {
35274 	s_wsle(&io___1577);
35275 /* Writing concatenation */
35276 	i__1[0] = 7, a__1[0] = "Found \"";
35277 	i__1[1] = 1, a__1[1] = durq;
35278 	i__1[2] = 19, a__1[2] = "\" instead of number";
35279 	s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27);
35280 	do_lio(&c__9, &c__1, ch__1, (ftnlen)27);
35281 	e_wsle();
35282 	stop1_();
35283     }
35284     icf = i2 - i1 + 49;
35285     ici__1.icierr = 0;
35286     ici__1.iciend = 0;
35287     ici__1.icirnum = 1;
35288     ici__1.icirlen = i2 - (i1 - 1);
35289     ici__1.iciunit = lineq + (i1 - 1);
35290 /* Writing concatenation */
35291     i__1[0] = 2, a__1[0] = "(f";
35292     chax_(ch__3, (ftnlen)1, &icf);
35293     i__1[1] = 1, a__1[1] = ch__3;
35294     i__1[2] = 3, a__1[2] = ".0)";
35295     ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2);
35296     s_rsfi(&ici__1);
35297     do_fio(&c__1, (char *)&ret_val, (ftnlen)sizeof(real));
35298     e_rsfi();
35299     return ret_val;
35300 } /* readin_ */
35301 
readmeter_(char * lineq,integer * iccount,integer * mtrnum,integer * mtrden,ftnlen lineq_len)35302 /* Subroutine */ int readmeter_(char *lineq, integer *iccount, integer *
35303 	mtrnum, integer *mtrden, ftnlen lineq_len)
35304 {
35305     /* System generated locals */
35306     address a__1[3];
35307     integer i__1, i__2[3];
35308     char ch__1[4], ch__2[1];
35309     icilist ici__1;
35310 
35311     /* Builtin functions */
35312     integer i_indx(char *, char *, ftnlen, ftnlen);
35313     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
35314     integer s_rsfi(icilist *), do_fio(integer *, char *, ftnlen), e_rsfi(void)
35315 	    ;
35316 
35317     /* Local variables */
35318     static integer ns;
35319     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
35320     static char durq[1];
35321     extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen,
35322 	    ftnlen);
35323 
35324     i__1 = *iccount;
35325     if (i_indx(lineq + i__1, "/", *iccount + 3 - i__1, (ftnlen)1) == 0) {
35326 
35327 /*  No slashes, so use old method */
35328 
35329 	getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
35330 	if (*(unsigned char *)durq == '-') {
35331 
35332 /*  Negative numerator is used only to printed; signals vertical slash */
35333 
35334 	    getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
35335 	    *mtrnum = -(*(unsigned char *)durq - 48);
35336 	} else if (*(unsigned char *)durq == 'o') {
35337 
35338 /*  Numerator is EXACTLY 1 */
35339 
35340 	    *mtrnum = 1;
35341 	} else {
35342 	    *mtrnum = *(unsigned char *)durq - 48;
35343 	    if (*mtrnum == 1) {
35344 
35345 /*  Numerator is >9 */
35346 
35347 		getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
35348 		*mtrnum = *(unsigned char *)durq - 38;
35349 	    }
35350 	}
35351 	getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
35352 	if (*(unsigned char *)durq == 'o') {
35353 	    *mtrden = 1;
35354 	} else {
35355 	    *mtrden = *(unsigned char *)durq - 48;
35356 	    if (*mtrden == 1) {
35357 		getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
35358 		*mtrden = *(unsigned char *)durq - 38;
35359 	    }
35360 	}
35361     } else {
35362 
35363 /*  Expect the form m[n1]/[n2]/[n3]/[n4] . Advance iccount by one from '/' or 'm' */
35364 
35365 	++(*iccount);
35366 	ns = i_indx(lineq + (*iccount - 1), "/", 128 - (*iccount - 1), (
35367 		ftnlen)1);
35368 	ici__1.icierr = 0;
35369 	ici__1.iciend = 0;
35370 	ici__1.icirnum = 1;
35371 	ici__1.icirlen = *iccount + ns - 2 - (*iccount - 1);
35372 	ici__1.iciunit = lineq + (*iccount - 1);
35373 /* Writing concatenation */
35374 	i__2[0] = 2, a__1[0] = "(i";
35375 	i__1 = ns + 47;
35376 	chax_(ch__2, (ftnlen)1, &i__1);
35377 	i__2[1] = 1, a__1[1] = ch__2;
35378 	i__2[2] = 1, a__1[2] = ")";
35379 	ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1);
35380 	s_rsfi(&ici__1);
35381 	do_fio(&c__1, (char *)&(*mtrnum), (ftnlen)sizeof(integer));
35382 	e_rsfi();
35383 
35384 /*  Reset iccount to start of second integer */
35385 
35386 	*iccount += ns;
35387 
35388 /*  There must be either a slash or a blank at pos'n 2 or 3 */
35389 
35390 	ns = i_indx(lineq + (*iccount - 1), "/", (ftnlen)3, (ftnlen)1);
35391 	if (ns == 0) {
35392 	    ns = i_indx(lineq + (*iccount - 1), " ", (ftnlen)3, (ftnlen)1);
35393 	}
35394 	ici__1.icierr = 0;
35395 	ici__1.iciend = 0;
35396 	ici__1.icirnum = 1;
35397 	ici__1.icirlen = *iccount + ns - 2 - (*iccount - 1);
35398 	ici__1.iciunit = lineq + (*iccount - 1);
35399 /* Writing concatenation */
35400 	i__2[0] = 2, a__1[0] = "(i";
35401 	i__1 = ns + 47;
35402 	chax_(ch__2, (ftnlen)1, &i__1);
35403 	i__2[1] = 1, a__1[1] = ch__2;
35404 	i__2[2] = 1, a__1[2] = ")";
35405 	ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1);
35406 	s_rsfi(&ici__1);
35407 	do_fio(&c__1, (char *)&(*mtrden), (ftnlen)sizeof(integer));
35408 	e_rsfi();
35409 
35410 /*  Set iccount to last character used */
35411 
35412 	*iccount = *iccount + ns - 1;
35413     }
35414     return 0;
35415 } /* readmeter_ */
35416 
readnum_(char * lineq,integer * iccount,char * durq,real * fnum,ftnlen lineq_len,ftnlen durq_len)35417 /* Subroutine */ int readnum_(char *lineq, integer *iccount, char *durq, real
35418 	*fnum, ftnlen lineq_len, ftnlen durq_len)
35419 {
35420     /* System generated locals */
35421     address a__1[3];
35422     integer i__1[3];
35423     char ch__1[27], ch__2[6], ch__3[1];
35424     icilist ici__1;
35425 
35426     /* Builtin functions */
35427     integer i_indx(char *, char *, ftnlen, ftnlen), s_wsle(cilist *);
35428     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
35429     integer do_lio(integer *, integer *, char *, ftnlen), e_wsle(void),
35430 	    s_rsfi(icilist *), do_fio(integer *, char *, ftnlen), e_rsfi(void)
35431 	    ;
35432 
35433     /* Local variables */
35434     static integer i1, i2, icf;
35435     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
35436     extern /* Subroutine */ int stop1_(void), getchar_(char *, integer *,
35437 	    char *, ftnlen, ftnlen);
35438 
35439     /* Fortran I/O blocks */
35440     static cilist io___1583 = { 0, 6, 0, 0, 0 };
35441 
35442 
35443 
35444 /*  This reads a number starting at position iccount.  Remember that on exit, */
35445 /*  getchar leaves iccount at the last character retrieved.  So must only */
35446 /*  call this routine *after* detecting a number or decimal. */
35447 /*  On exit, durq is next character after end of number. */
35448 
35449     i1 = *iccount;
35450 L1:
35451     getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
35452     if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) > 0) {
35453 	goto L1;
35454     }
35455     i2 = *iccount - 1;
35456     if (i2 < i1) {
35457 	s_wsle(&io___1583);
35458 /* Writing concatenation */
35459 	i__1[0] = 7, a__1[0] = "Found \"";
35460 	i__1[1] = 1, a__1[1] = durq;
35461 	i__1[2] = 19, a__1[2] = "\" instead of number";
35462 	s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27);
35463 	do_lio(&c__9, &c__1, ch__1, (ftnlen)27);
35464 	e_wsle();
35465 	stop1_();
35466     } else if (*(unsigned char *)&lineq[i1 - 1] == '.' && *(unsigned char *)&
35467 	    lineq[i2 - 1] == '.') {
35468 	--i2;
35469 	--(*iccount);
35470     }
35471     icf = i2 - i1 + 49;
35472     ici__1.icierr = 0;
35473     ici__1.iciend = 0;
35474     ici__1.icirnum = 1;
35475     ici__1.icirlen = i2 - (i1 - 1);
35476     ici__1.iciunit = lineq + (i1 - 1);
35477 /* Writing concatenation */
35478     i__1[0] = 2, a__1[0] = "(f";
35479     chax_(ch__3, (ftnlen)1, &icf);
35480     i__1[1] = 1, a__1[1] = ch__3;
35481     i__1[2] = 3, a__1[2] = ".0)";
35482     ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2);
35483     s_rsfi(&ici__1);
35484     do_fio(&c__1, (char *)&(*fnum), (ftnlen)sizeof(real));
35485     e_rsfi();
35486     return 0;
35487 } /* readnum_ */
35488 
setbits_(integer * isdata,integer * iwidbit,integer * ishift,integer * ivalue)35489 /* Subroutine */ int setbits_(integer *isdata, integer *iwidbit, integer *
35490 	ishift, integer *ivalue)
35491 {
35492     /* Builtin functions */
35493     integer pow_ii(integer *, integer *), s_wsle(cilist *), e_wsle(void),
35494 	    do_lio(integer *, integer *, char *, ftnlen), s_wsfe(cilist *),
35495 	    do_fio(integer *, char *, ftnlen), e_wsfe(void), lbit_shift(
35496 	    integer, integer);
35497 
35498     /* Local variables */
35499     static integer ibase;
35500 
35501     /* Fortran I/O blocks */
35502     static cilist io___1586 = { 0, 6, 0, 0, 0 };
35503     static cilist io___1587 = { 0, 6, 0, 0, 0 };
35504     static cilist io___1588 = { 0, 15, 0, "(/,a)", 0 };
35505 
35506 
35507 
35508 /*  Sets iwidbits of isdata, shifted by ishift, to ivalue */
35509 
35510     ibase = pow_ii(&c__2, iwidbit) - 1;
35511     if (*ivalue > ibase) {
35512 	s_wsle(&io___1586);
35513 	e_wsle();
35514 	s_wsle(&io___1587);
35515 	do_lio(&c__9, &c__1, "WARNING in setbits: ivalue > ibase", (ftnlen)34)
35516 		;
35517 	e_wsle();
35518 	s_wsfe(&io___1588);
35519 	do_fio(&c__1, "WARNING in setbits: ivalue > ibase", (ftnlen)34);
35520 	e_wsfe();
35521     }
35522     *isdata = ~ lbit_shift(ibase, *ishift) & *isdata;
35523     *isdata |= lbit_shift(*ivalue, *ishift);
35524     return 0;
35525 } /* setbits_ */
35526 
setbm2_(real * xelsk,integer * nnb,real * sumx,real * sumy,integer * ipb,integer * islope,integer * nolev1)35527 /* Subroutine */ int setbm2_(real *xelsk, integer *nnb, real *sumx, real *
35528 	sumy, integer *ipb, integer *islope, integer *nolev1)
35529 {
35530     /* System generated locals */
35531     integer i__1;
35532     real r__1, r__2;
35533 
35534     /* Builtin functions */
35535     integer i_nint(real *), i_sign(integer *, integer *);
35536 
35537     /* Local variables */
35538     static real em;
35539     static integer ibc, inb, iul;
35540     static real beta, smin, delta, ybeam, ynote, sumxx, sumxy, deficit;
35541 
35542 
35543 /* The MEAN SQUARE slope algorithm */
35544 
35545     /* Parameter adjustments */
35546     --ipb;
35547     --xelsk;
35548 
35549     /* Function Body */
35550     ibc = all_1.ibmcnt[commvl_1.ivx - 1];
35551     sumxx = 0.f;
35552     sumxy = 0.f;
35553     i__1 = *nnb;
35554     for (inb = 1; inb <= i__1; ++inb) {
35555 /* Computing 2nd power */
35556 	r__1 = xelsk[inb];
35557 	sumxx += r__1 * r__1;
35558 	sumxy += xelsk[inb] * all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25];
35559 /* L2: */
35560     }
35561     delta = *nnb * sumxx - *sumx * *sumx;
35562     em = (*nnb * sumxy - *sumx * *sumy) / delta;
35563     r__1 = em * .5f * all_1.slfac;
35564     *islope = i_nint(&r__1);
35565     if (abs(*islope) > 9) {
35566 	*islope = i_sign(&c__9, islope);
35567     }
35568     beta = (*sumy - *islope / all_1.slfac * *sumx) / *nnb;
35569     *nolev1 = i_nint(&beta);
35570 
35571 /*   Check if any stems are too short */
35572 
35573     smin = 100.f;
35574     iul = -1;
35575     if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u') {
35576 	iul = 1;
35577     }
35578     i__1 = *nnb;
35579     for (inb = 1; inb <= i__1; ++inb) {
35580 	ybeam = *nolev1 + iul * all_1.stemlen + *islope * xelsk[inb] /
35581 		all_1.slfac;
35582 	ynote = (real) all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25];
35583 /* Computing MIN */
35584 	r__1 = smin, r__2 = iul * (ybeam - ynote);
35585 	smin = dmin(r__1,r__2);
35586 /* L4: */
35587     }
35588     if (smin < all_1.stemmin) {
35589 	deficit = all_1.stemmin - smin;
35590 	r__1 = *nolev1 + iul * deficit;
35591 	*nolev1 = i_nint(&r__1);
35592     }
35593     return 0;
35594 } /* setbm2_ */
35595 
setmac_(char * lineq,integer * iccount,integer * ibarcnt,integer * ibaroff,integer * nbars,char * charq,char * durq,integer * ivx,integer * nline,ftnlen lineq_len,ftnlen charq_len,ftnlen durq_len)35596 /* Subroutine */ int setmac_(char *lineq, integer *iccount, integer *ibarcnt,
35597 	integer *ibaroff, integer *nbars, char *charq, char *durq, integer *
35598 	ivx, integer *nline, ftnlen lineq_len, ftnlen charq_len, ftnlen
35599 	durq_len)
35600 {
35601     /* System generated locals */
35602     integer i__1, i__2;
35603 
35604     /* Builtin functions */
35605     integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char
35606 	    *, ftnlen), i_indx(char *, char *, ftnlen, ftnlen), i_nint(real *)
35607 	    ;
35608     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
35609 
35610     /* Local variables */
35611     static real fnum;
35612     static integer ndxm;
35613     extern /* Subroutine */ int stop1_(void), m1rec1_(char *, integer *,
35614 	    integer *, integer *, integer *, integer *, ftnlen), getbuf_(char
35615 	    *, ftnlen), errmsg_(char *, integer *, integer *, char *, ftnlen,
35616 	    ftnlen), readnum_(char *, integer *, char *, real *, ftnlen,
35617 	    ftnlen), g1etchar_(char *, integer *, char *, ftnlen, ftnlen);
35618 
35619     /* Fortran I/O blocks */
35620     static cilist io___1601 = { 0, 6, 0, 0, 0 };
35621     static cilist io___1602 = { 0, 6, 0, 0, 0 };
35622     static cilist io___1603 = { 0, 6, 0, 0, 0 };
35623 
35624 
35625 
35626 /*  Macro action */
35627 
35628     g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
35629     if (*(unsigned char *)charq == 'S' && *ivx != 1) {
35630 	s_wsle(&io___1601);
35631 	e_wsle();
35632 	s_wsle(&io___1602);
35633 	e_wsle();
35634 	s_wsle(&io___1603);
35635 	do_lio(&c__9, &c__1, "*********WARNING*********", (ftnlen)25);
35636 	e_wsle();
35637 	i__1 = *ibarcnt - *ibaroff + *nbars + 1;
35638 	errmsg_(lineq, iccount, &i__1, "\"MS...\" only put in parts by scor2"
35639 		"prt if in voice #1!", (ftnlen)128, (ftnlen)53);
35640     }
35641     if (i_indx("RSP ", charq, (ftnlen)4, (ftnlen)1) == 0) {
35642 	i__1 = *ibarcnt - *ibaroff + *nbars + 1;
35643 	errmsg_(lineq, iccount, &i__1, "Illegal character after \"M\" (macro"
35644 		")!", (ftnlen)128, (ftnlen)36);
35645 	stop1_();
35646     } else if (*(unsigned char *)charq != ' ') {
35647 
35648 /*  Record or playback a macro.  Get the number of the macro. */
35649 
35650 	g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
35651 	if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
35652 	    i__1 = *ibarcnt - *ibaroff + *nbars + 1;
35653 	    errmsg_(lineq, iccount, &i__1, "Must input number after \"MR\""
35654 		    ",\"MP\", or \"MS\"!", (ftnlen)128, (ftnlen)43);
35655 	    stop1_();
35656 	}
35657 	readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
35658 	commac_1.macnum = i_nint(&fnum);
35659 	if (*(unsigned char *)durq != ' ') {
35660 	    i__1 = *ibarcnt - *ibaroff + *nbars + 1;
35661 	    errmsg_(lineq, iccount, &i__1, "Macro number must be followed by"
35662 		    " a blank!", (ftnlen)128, (ftnlen)41);
35663 	    stop1_();
35664 	}
35665 	if (i_indx("RS", charq, (ftnlen)2, (ftnlen)1) > 0) {
35666 
35667 /*  Record or save a macro */
35668 
35669 	    if (commac_1.macnum < 1 || commac_1.macnum > 20) {
35670 		i__1 = *iccount - 1;
35671 		i__2 = *ibarcnt - *ibaroff + *nbars + 1;
35672 		errmsg_(lineq, &i__1, &i__2, "Macro number not in range 1-20!"
35673 			, (ftnlen)128, (ftnlen)31);
35674 		stop1_();
35675 /*          else if (btest(macuse,macnum)) then */
35676 /*            print* */
35677 /*            print*,'WARNING: Redefining macro # ',macnum */
35678 	    }
35679 	    commac_1.macuse = bit_set(commac_1.macuse,commac_1.macnum);
35680 	    if (*(unsigned char *)charq == 'R') {
35681 		m1rec1_(lineq, iccount, ibarcnt, ibaroff, nbars, &ndxm, (
35682 			ftnlen)128);
35683 	    } else if (*(unsigned char *)charq == 'S') {
35684 
35685 /*  Save (Record but don't activate) */
35686 
35687 L1:
35688 		m1rec1_(lineq, iccount, ibarcnt, ibaroff, nbars, &ndxm, (
35689 			ftnlen)128);
35690 		if (commac_1.mrecord) {
35691 		    getbuf_(lineq, (ftnlen)128);
35692 		    ++(*nline);
35693 		    *iccount = 0;
35694 		    goto L1;
35695 		}
35696 		*iccount = *iccount + ndxm + 1;
35697 	    }
35698 	} else {
35699 
35700 /*  Playback the macro */
35701 
35702 	    if (! bit_test(commac_1.macuse,commac_1.macnum)) {
35703 		i__1 = *iccount - 1;
35704 		i__2 = *ibarcnt - *ibaroff + *nbars + 1;
35705 		errmsg_(lineq, &i__1, &i__2, "Cannot play a macro that has n"
35706 			"ot been recorded!", (ftnlen)128, (ftnlen)47);
35707 		stop1_();
35708 	    }
35709 	    commac_1.icchold = *iccount;
35710 	    s_copy(commac_1.lnholdq, lineq, (ftnlen)128, (ftnlen)128);
35711 	    *iccount = 128;
35712 	    commac_1.mplay = TRUE_;
35713 	    c1ommac_1.ilmac = c1ommac_1.il1mac[commac_1.macnum - 1];
35714 	}
35715     }
35716     return 0;
35717 } /* setmac_ */
35718 
setmeter_(integer * mtrnuml,integer * mtrdenl,integer * ibmtyp,integer * ibmrep)35719 /* Subroutine */ int setmeter_(integer *mtrnuml, integer *mtrdenl, integer *
35720 	ibmtyp, integer *ibmrep)
35721 {
35722 
35723 /*  Sets last 2 args depending on 1st 2, (logical) num, denom. */
35724 /*  ibmtyp = 1, 2, or 3 defines set of masks for beam groupings. */
35725 /*  1: all duple meters */
35726 /*  2: triple w/ denom=4, subdivide in groups of 2 8ths */
35727 /*  3: triple w/ denom=8, subdivide in groups of 3 8ths */
35728 /*  Note that lenbar is set at top or when 'm' symbol is read in getnote */
35729 
35730     if (*mtrdenl == 4) {
35731 	if (*mtrnuml % 3 == 0) {
35732 	    *ibmtyp = 2;
35733 	    *ibmrep = *mtrnuml / 3;
35734 	} else {
35735 	    *ibmtyp = 1;
35736 	    *ibmrep = *mtrnuml / 2;
35737 	}
35738     } else if (*mtrdenl == 2) {
35739 	*ibmtyp = 1;
35740 	if (*mtrnuml == 3) {
35741 	    *ibmrep = 3;
35742 	} else {
35743 	    *ibmrep = (*mtrnuml << 1) / *mtrdenl;
35744 	}
35745     } else {
35746 
35747 /*  Assumes mtrdenl=8 and 3/8, 6/8, 9/8, or 12/8 */
35748 
35749 	*ibmtyp = 3;
35750 	*ibmrep = *mtrnuml / 3;
35751     }
35752 
35753 /*  Reset so we don't keep writing new meters */
35754 
35755     *mtrnuml = 0;
35756 
35757 /*  Prevent ibmrep=0.  Needed for odd bars, e.g. 1/8, where beams don't matter */
35758 
35759     *ibmrep = max(*ibmrep,1);
35760     return 0;
35761 } /* setmeter_ */
35762 
setupb_(real * xelsk,integer * nnb,real * sumx,real * sumy,integer * ipb,real * smed,integer * ixrest)35763 /* Subroutine */ int setupb_(real *xelsk, integer *nnb, real *sumx, real *
35764 	sumy, integer *ipb, real *smed, integer *ixrest)
35765 {
35766     /* System generated locals */
35767     integer i__1, i__2;
35768     real r__1, r__2;
35769 
35770     /* Builtin functions */
35771     double r_sign(real *, real *);
35772     integer i_nint(real *), i_sign(integer *, integer *);
35773     double sqrt(doublereal);
35774 
35775     /* Local variables */
35776     static integer i__, j;
35777     static real t;
35778     static integer n1, ip;
35779     static real yb1;
35780     static integer ibc, inb, jnb;
35781     static real off;
35782     static integer nsc, iul;
35783     static real syb, sum, ssq, off1, off2;
35784     static logical l1ng, l2ng;
35785     static real beta, smin, eskz0;
35786     static integer ipxt1;
35787     extern integer ncmid_(integer *, integer *);
35788     static real ybeam, xboff;
35789     static integer ndoub;
35790     static real slope[800];
35791     static integer issbs;
35792     static real ynote;
35793     extern /* Subroutine */ int setbm2_(real *, integer *, real *, real *,
35794 	    integer *, integer *, integer *);
35795     static integer nscmid;
35796     static real dnolev;
35797     static integer iplast, nolevo;
35798     static real xnolev2, deficit;
35799     static integer ipxtmid;
35800 
35801 
35802 /* The outer combo algorithm */
35803 
35804     /* Parameter adjustments */
35805     --ipb;
35806     --xelsk;
35807 
35808     /* Function Body */
35809     ibc = all_1.ibmcnt[commvl_1.ivx - 1];
35810     comxtup_2.nxtinbm[commvl_1.ivx - 1] = 0;
35811     n1 = comipl2_1.ipl2[commvl_1.ivx + all_1.ibm1[commvl_1.ivx + ibc * 24 -
35812 	    25] * 24 - 25];
35813 
35814 /*  Initialize counters used in this subroutine, and then later during actual */
35815 /*    beam drawing, to count later segments of single-slope beam groups */
35816 
35817     comxtup_2.nssb[commvl_1.ivx - 1] = 0;
35818     comxtup_2.issb[commvl_1.ivx - 1] = 0;
35819 
35820 /*  Set flag for xtup beam starting with rest (no others can start with rest) */
35821 
35822     if (bit_test(all_1.irest[commvl_1.ivx + all_1.ipo[n1 - 1] * 24 - 25],0)) {
35823 	*ixrest = 1;
35824     }
35825 
35826 /* Figure how many elemskips to each note. Use the list, counting only non-rests. */
35827 
35828     eskz0 = all_1.eskz[commvl_1.ivx + all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]
35829 	     * 24 - 25];
35830     *nnb = 0;
35831     *sumx = 0.f;
35832     *sumy = 0.f;
35833     ipxt1 = 0;
35834     iplast = all_1.ibm2[commvl_1.ivx + ibc * 24 - 25];
35835     i__1 = iplast;
35836     for (ip = all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]; ip <= i__1; ++ip) {
35837 	if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
35838 	    ++(*nnb);
35839 	    ipb[*nnb] = ip;
35840 	    xelsk[*nnb] = all_1.eskz[commvl_1.ivx + ip * 24 - 25] - eskz0;
35841 	    *sumx += xelsk[*nnb];
35842 	    *sumy += all_1.nolev[commvl_1.ivx + ipb[*nnb] * 24 - 25];
35843 	    if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],21)) {
35844 
35845 /*  This is the starting note of later segment of single-slope beam group */
35846 /*  Temporarily store ip here. */
35847 
35848 		++comxtup_2.nssb[commvl_1.ivx - 1];
35849 		comxtup_2.lev1ssb[commvl_1.ivx + comxtup_2.nssb[commvl_1.ivx
35850 			- 1] * 24 - 25] = *nnb;
35851 	    }
35852 	}
35853 
35854 /*  New xtup stuff here.  Final object is to get distance from start of xtup */
35855 /*    to number. xtinbm counts xtups in this beam only.  mtupv is the printed */
35856 /*    number.  ntupv is number of notes in xtup, and is only used to get */
35857 /*    eloff, the distance from start of xtup to the number. */
35858 
35859 	if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],18)) {
35860 	    ++ndoub;
35861 	}
35862 	if (ipxt1 == 0 && all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 0) {
35863 
35864 /*  Xtup is starting here */
35865 
35866 	    ++comxtup_2.nxtinbm[commvl_1.ivx - 1];
35867 	    ipxt1 = ip;
35868 	    if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],18)) {
35869 		ndoub = 1;
35870 	    } else {
35871 		ndoub = 0;
35872 	    }
35873 	} else if (ipxt1 > 0 && all_1.nodur[commvl_1.ivx + ip * 24 - 25] > 0)
35874 		{
35875 
35876 /*  Xtup ends here.  Set total number of notes in xtup. */
35877 
35878 	    comxtup_2.ntupv[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx - 1]
35879 		     * 24 - 25] = ip + 1 - ipxt1;
35880 
35881 /*  Set printed number for embedded xtup. */
35882 
35883 	    comxtup_2.mtupv[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx - 1]
35884 		     * 24 - 25] = comxtup_2.ntupv[commvl_1.ivx +
35885 		    comxtup_2.nxtinbm[commvl_1.ivx - 1] * 24 - 25] + ndoub;
35886 
35887 /*  Middle note of xtup if ntupv odd, note to left of gap if even. */
35888 
35889 	    ipxtmid = (ip + ipxt1) / 2;
35890 	    comxtup_2.eloff[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx - 1]
35891 		     * 24 - 25] = comeskz2_1.eskz2[commvl_1.ivx + ipxtmid *
35892 		    24 - 25] - comeskz2_1.eskz2[commvl_1.ivx + ipxt1 * 24 -
35893 		    25];
35894 	    if (comxtup_2.ntupv[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx
35895 		    - 1] * 24 - 25] % 2 == 0) {
35896 		comxtup_2.eloff[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx
35897 			- 1] * 24 - 25] += (comeskz2_1.eskz2[commvl_1.ivx + (
35898 			ipxtmid + 1) * 24 - 25] - comeskz2_1.eskz2[
35899 			commvl_1.ivx + ipxtmid * 24 - 25]) * .5f;
35900 	    }
35901 	    ipxt1 = 0;
35902 	}
35903 /* L2: */
35904     }
35905 
35906 /*  Reset nxtinbm for use as counter as #'s are posted by putxtn(..) */
35907 
35908     comxtup_2.nxtinbm[commvl_1.ivx - 1] = 0;
35909     *smed = 0.f;
35910     if (! bit_test(all_1.islur[commvl_1.ivx + ipb[1] * 24 - 25],2)) {
35911 
35912 /* No forced 0 slope */
35913 
35914 	if (*nnb == 1) {
35915 	    goto L6;
35916 	}
35917 	nsc = 0;
35918 	i__1 = *nnb - 1;
35919 	for (inb = 1; inb <= i__1; ++inb) {
35920 	    i__2 = *nnb;
35921 	    for (jnb = inb + 1; jnb <= i__2; ++jnb) {
35922 		++nsc;
35923 		slope[nsc - 1] = (all_1.nolev[commvl_1.ivx + ipb[jnb] * 24 -
35924 			25] - all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25])
35925 			/ (xelsk[jnb] - xelsk[inb]);
35926 		if ((r__1 = slope[nsc - 1], dabs(r__1)) < 1e-4f) {
35927 		    ++nsc;
35928 		    slope[nsc - 1] = slope[nsc - 2];
35929 		    ++nsc;
35930 		    slope[nsc - 1] = slope[nsc - 2];
35931 		}
35932 /* L5: */
35933 	    }
35934 	}
35935 	if (nsc == 1) {
35936 	    *smed = slope[0];
35937 	    goto L6;
35938 	}
35939 	nscmid = nsc / 2 + 1;
35940 	i__2 = nscmid;
35941 	for (i__ = 1; i__ <= i__2; ++i__) {
35942 	    i__1 = nsc;
35943 	    for (j = i__ + 1; j <= i__1; ++j) {
35944 		if (slope[j - 1] < slope[i__ - 1]) {
35945 		    t = slope[j - 1];
35946 		    slope[j - 1] = slope[i__ - 1];
35947 		    slope[i__ - 1] = t;
35948 		}
35949 /* L7: */
35950 	    }
35951 	}
35952 	*smed = slope[nscmid - 1];
35953 	if (nsc == nsc / 2 << 1) {
35954 
35955 /*  Even number of slopes in the list, so median is ambiguous */
35956 
35957 	    if ((r__2 = slope[nscmid - 2], dabs(r__2)) < (r__1 = slope[nscmid
35958 		    - 1], dabs(r__1)) - comtol_1.tol) {
35959 
35960 /*  Lower-numbered one is truly less in absolute value, so use it */
35961 
35962 		*smed = slope[nscmid - 2];
35963 	    } else if ((r__1 = slope[nscmid - 2] + slope[nscmid - 1], dabs(
35964 		    r__1)) < comtol_1.tol) {
35965 
35966 /*  Two slopes are effectively equal.  Take the one with sign of the average */
35967 
35968 		sum = 0.f;
35969 		i__1 = nsc;
35970 		for (i__ = 1; i__ <= i__1; ++i__) {
35971 		    sum += slope[i__ - 1];
35972 /* L1: */
35973 		}
35974 		*smed = r_sign(smed, &sum);
35975 	    }
35976 	}
35977 L6:
35978 	r__1 = *smed * .5f * all_1.slfac;
35979 	comxtup_2.islope[commvl_1.ivx - 1] = i_nint(&r__1);
35980 	if ((i__1 = comxtup_2.islope[commvl_1.ivx - 1], abs(i__1)) > 9) {
35981 	    comxtup_2.islope[commvl_1.ivx - 1] = i_sign(&c__9, &
35982 		    comxtup_2.islope[commvl_1.ivx - 1]);
35983 	}
35984     } else {
35985 
35986 /*  Forced horizontal beam */
35987 
35988 	comxtup_2.islope[commvl_1.ivx - 1] = 0;
35989     }
35990     beta = (*sumy - comxtup_2.islope[commvl_1.ivx - 1] / all_1.slfac * *sumx)
35991 	    / *nnb;
35992 
35993 /*  If ixrest>0, this is a virtual nolev1 at location of rest.  Will first use */
35994 /*  as is for placing xtup number and/or bracket, then reset it for start of */
35995 /*  actual beam */
35996 
35997     comxtup_2.nolev1[commvl_1.ivx - 1] = i_nint(&beta);
35998 
35999 /*  Check if any stems are too short */
36000 
36001     smin = 100.f;
36002     iul = -1;
36003     if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u') {
36004 	iul = 1;
36005     }
36006     ssq = 0.f;
36007     syb = 0.f;
36008 /*      yb1 = nolev1(ivx)+iul*(stemlen+bmhgt*(mult(ivx,ipb(1))-1)) */
36009     yb1 = comxtup_2.nolev1[commvl_1.ivx - 1] + iul * (all_1.stemlen +
36010 	    combmh_1.bmhgt * ((15 & all_1.mult[commvl_1.ivx + ipb[1] * 24 -
36011 	    25]) - 9));
36012     i__1 = *nnb;
36013     for (inb = 1; inb <= i__1; ++inb) {
36014 	ybeam = yb1 + comxtup_2.islope[commvl_1.ivx - 1] * xelsk[inb] /
36015 		all_1.slfac - iul * combmh_1.bmhgt * ((15 & all_1.mult[
36016 		commvl_1.ivx + ipb[inb] * 24 - 25]) - 9);
36017 /*     *              -iul*bmhgt*(mult(ivx,ipb(inb))-1) */
36018 	syb += ybeam;
36019 	ynote = (real) all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25];
36020 	off = ybeam - ynote;
36021 	if (inb == 1) {
36022 	    off1 = off;
36023 	} else if (inb == *nnb) {
36024 	    off2 = off;
36025 	}
36026 	ssq += off * off;
36027 /* Computing MIN */
36028 	r__1 = smin, r__2 = iul * off;
36029 	smin = dmin(r__1,r__2);
36030 /* L4: */
36031     }
36032     dnolev = 0.f;
36033     if (smin < all_1.stemmin) {
36034 	deficit = all_1.stemmin - smin;
36035 	nolevo = comxtup_2.nolev1[commvl_1.ivx - 1];
36036 	r__1 = comxtup_2.nolev1[commvl_1.ivx - 1] + iul * deficit;
36037 	comxtup_2.nolev1[commvl_1.ivx - 1] = i_nint(&r__1);
36038 	dnolev = (real) (comxtup_2.nolev1[commvl_1.ivx - 1] - nolevo);
36039 	off1 += dnolev;
36040 	off2 += dnolev;
36041     }
36042 /* Computing 2nd power */
36043     r__1 = dnolev;
36044     ssq = ssq + dnolev * 2 * (syb - *sumy) + r__1 * r__1;
36045     if (! comxtup_2.vxtup[commvl_1.ivx - 1] && sqrt(ssq / *nnb) >
36046 	    all_1.stemmax && (dabs(off1) < all_1.stemmax || dabs(off2) <
36047 	    all_1.stemmax) && ! bit_test(all_1.islur[commvl_1.ivx + ipb[1] *
36048 	    24 - 25],2)) {
36049 
36050 /*  The first check is to save trouble of putting xtup's in setbm2. */
36051 /*  The penultimate check is that first and last stems aren't both excessive. */
36052 /*  The last check is that a 0 slope has not been forced */
36053 
36054 	setbm2_(&xelsk[1], nnb, sumx, sumy, &ipb[1], &comxtup_2.islope[
36055 		commvl_1.ivx - 1], &comxtup_2.nolev1[commvl_1.ivx - 1]);
36056     }
36057 
36058 /*  Check if beam starts or ends too high or low. */
36059 
36060 /*      xboff = bmhgt*(mult(ivx,ipb(1))-1) */
36061     xboff = combmh_1.bmhgt * ((15 & all_1.mult[commvl_1.ivx + ipb[1] * 24 -
36062 	    25]) - 9);
36063     l1ng = iul * (comxtup_2.nolev1[commvl_1.ivx - 1] - ncmid_(&all_1.iv, &ipb[
36064 	    1])) + xboff + 7 < 0.f;
36065     xnolev2 = comxtup_2.nolev1[commvl_1.ivx - 1] + comxtup_2.islope[
36066 	    commvl_1.ivx - 1] / all_1.slfac * xelsk[*nnb];
36067     l2ng = iul * (xnolev2 - ncmid_(&all_1.iv, &ipb[*nnb])) + xboff + 7 < 0.f;
36068     if (l1ng || l2ng) {
36069 
36070 /*  Need to correct start or stop, also slope */
36071 
36072 	if (l1ng) {
36073 	    r__1 = ncmid_(&all_1.iv, &ipb[1]) - (xboff + 7.f) * iul;
36074 	    comxtup_2.nolev1[commvl_1.ivx - 1] = i_nint(&r__1);
36075 	}
36076 	if (l2ng) {
36077 	    r__1 = ncmid_(&all_1.iv, &ipb[*nnb]) - (xboff + 7.f) * iul;
36078 	    xnolev2 = (real) i_nint(&r__1);
36079 	}
36080 
36081 /*  Since one or the other end has changed, need to change slope */
36082 
36083 	if (! bit_test(all_1.islur[commvl_1.ivx + ipb[1] * 24 - 25],2)) {
36084 	    r__1 = all_1.slfac * (xnolev2 - comxtup_2.nolev1[commvl_1.ivx - 1]
36085 		    ) / xelsk[*nnb];
36086 	    comxtup_2.islope[commvl_1.ivx - 1] = i_nint(&r__1);
36087 	}
36088     }
36089     if (comxtup_2.nssb[commvl_1.ivx - 1] > 0) {
36090 
36091 /*  This is a single-slope beam group.  Store start heights for later segs. */
36092 
36093 	i__1 = comxtup_2.nssb[commvl_1.ivx - 1];
36094 	for (issbs = 1; issbs <= i__1; ++issbs) {
36095 	    comxtup_2.lev1ssb[commvl_1.ivx + issbs * 24 - 25] =
36096 		    comxtup_2.nolev1[commvl_1.ivx - 1] + comxtup_2.islope[
36097 		    commvl_1.ivx - 1] / all_1.slfac * xelsk[comxtup_2.lev1ssb[
36098 		    commvl_1.ivx + issbs * 24 - 25]];
36099 /* L3: */
36100 	}
36101     }
36102     return 0;
36103 } /* setupb_ */
36104 
sortpoe_(integer * nsyst,real * poe,integer * ipoe)36105 /* Subroutine */ int sortpoe_(integer *nsyst, real *poe, integer *ipoe)
36106 {
36107     /* System generated locals */
36108     integer i__1, i__2;
36109 
36110     /* Local variables */
36111     static integer io1, io2, iord, itemp;
36112 
36113 
36114 /*  Initialize ipoe: */
36115 
36116     /* Parameter adjustments */
36117     --ipoe;
36118     --poe;
36119 
36120     /* Function Body */
36121     i__1 = *nsyst;
36122     for (iord = 1; iord <= i__1; ++iord) {
36123 	ipoe[iord] = iord;
36124 /* L3: */
36125     }
36126 
36127 /*  Construct ipoe vector with pairwise interchanges.  When done, ipoe(1) will */
36128 /*  be index of smallest poe, and ipoe(nsyst) will be index of biggest poe. */
36129 
36130     i__1 = *nsyst - 1;
36131     for (io1 = 1; io1 <= i__1; ++io1) {
36132 	i__2 = *nsyst;
36133 	for (io2 = io1 + 1; io2 <= i__2; ++io2) {
36134 	    if (poe[ipoe[io1]] > poe[ipoe[io2]]) {
36135 
36136 /* Interchange the indices */
36137 
36138 		itemp = ipoe[io1];
36139 		ipoe[io1] = ipoe[io2];
36140 		ipoe[io2] = itemp;
36141 	    }
36142 /* L5: */
36143 	}
36144 /* L4: */
36145     }
36146     return 0;
36147 } /* sortpoe_ */
36148 
spsslur_(char * lineq,integer * iccount,integer * iv,integer * kv,integer * ip,integer * isdat1,integer * isdat2,integer * isdat3,integer * isdat4,integer * nsdat,logical * notcrd,integer * nolev,char * starter,ftnlen lineq_len,ftnlen starter_len)36149 /* Subroutine */ int spsslur_(char *lineq, integer *iccount, integer *iv,
36150 	integer *kv, integer *ip, integer *isdat1, integer *isdat2, integer *
36151 	isdat3, integer *isdat4, integer *nsdat, logical *notcrd, integer *
36152 	nolev, char *starter, ftnlen lineq_len, ftnlen starter_len)
36153 {
36154     /* System generated locals */
36155     integer i__1, i__2;
36156     real r__1;
36157 
36158     /* Builtin functions */
36159     integer i_indx(char *, char *, ftnlen, ftnlen), s_cmp(char *, char *,
36160 	    ftnlen, ftnlen), i_nint(real *);
36161 
36162     /* Local variables */
36163     extern integer igetbits_(integer *, integer *, integer *);
36164     static integer ilb12;
36165     static real fnum;
36166     static char dumq[1], durq[1];
36167     static integer ihoff, isdat, ivoff, icurv1, idcode, nolevc, numint;
36168     extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen,
36169 	    ftnlen), readnum_(char *, integer *, char *, real *, ftnlen,
36170 	    ftnlen), setbits_(integer *, integer *, integer *, integer *);
36171 
36172 
36173 /*  Reads in slur data.  Record all h/v-shifts for non-chords, user-specified */
36174 /*  ones for chords. */
36175 /*  5/26/02  This subr is called ONLY for postscript slurs. */
36176 
36177 /*  See subroutine doslur for bit values in isdat1,2,3 */
36178 
36179 
36180 /*  Counter for signed integers.  1st is height, 2nd is horiz, 3rd is curve */
36181 
36182     /* Parameter adjustments */
36183     --isdat4;
36184     --isdat3;
36185     --isdat2;
36186     --isdat1;
36187 
36188     /* Function Body */
36189     numint = 0;
36190     ivoff = 0;
36191     ihoff = 0;
36192     ++(*nsdat);
36193     if (*(unsigned char *)starter == '{' || *(unsigned char *)starter == '}')
36194 	    {
36195 	isdat2[*nsdat] = bit_set(isdat2[*nsdat],3);
36196     }
36197     setbits_(&isdat1[*nsdat], &c__5, &c__13, iv);
36198     i__1 = *kv - 1;
36199     setbits_(&isdat1[*nsdat], &c__1, &c__12, &i__1);
36200     setbits_(&isdat1[*nsdat], &c__8, &c__3, ip);
36201     isdat3[*nsdat] = 0;
36202     isdat4[*nsdat] = 0;
36203     ilb12 = 0;
36204 
36205 /*  Get ID code */
36206 
36207 /* flag for tweaks of 1st or 2nd (0|1) seg of linebreak s */
36208     getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
36209     if (i_indx("uldtb+-hfnHps ", durq, (ftnlen)14, (ftnlen)1) > 0) {
36210 
36211 /*  Null id. Note for ps slurs, 'H' cannot be an ID */
36212 
36213 	--(*iccount);
36214 	if (*(unsigned char *)&lineq[*iccount - 1] == 't') {
36215 	    idcode = 1;
36216 	} else {
36217 	    idcode = 32;
36218 	}
36219     } else {
36220 
36221 /*  Set explicit idcode */
36222 
36223 	idcode = *(unsigned char *)durq;
36224 	i__1 = *iccount - 2;
36225 	if (s_cmp(lineq + i__1, "t", *iccount - 1 - i__1, (ftnlen)1) == 0) {
36226 
36227 /*  Make t[ID] look like s[ID]t */
36228 
36229 	    isdat2[*nsdat] = bit_set(isdat2[*nsdat],3);
36230 	}
36231     }
36232     setbits_(&isdat1[*nsdat], &c__7, &c__19, &idcode);
36233 
36234 /*  Set start/stop: look thru list from end for same idcode,iv,kv */
36235 
36236     for (isdat = *nsdat - 1; isdat >= 1; --isdat) {
36237 	if (idcode == igetbits_(&isdat1[isdat], &c__7, &c__19) && *iv ==
36238 		igetbits_(&isdat1[isdat], &c__5, &c__13) && *kv - 1 ==
36239 		igetbits_(&isdat1[isdat], &c__1, &c__12)) {
36240 
36241 /*  Matched idcode & ivx.  On/off?.  If on, new is turnoff, leave bit 11 at 0. */
36242 
36243 	    if (bit_test(isdat1[isdat],11)) {
36244 		goto L3;
36245 	    }
36246 
36247 /*  Found slur is a turnoff, so new one is a turnon.  Jump down to set bit */
36248 
36249 	    goto L4;
36250 	}
36251 /* L2: */
36252     }
36253 
36254 /*  If here, this is turnon. */
36255 
36256 L4:
36257     isdat1[*nsdat] = bit_set(isdat1[*nsdat],11);
36258 L3:
36259 
36260 /*  Now done with initial turnon- or turnoff-specifics. */
36261 
36262     if (i_nint(&comslur_1.slurcurve) != 0 && bit_test(isdat1[*nsdat],11)) {
36263 
36264 /*  There's a default curvature tweak */
36265 
36266 	icurv1 = i_nint(&comslur_1.slurcurve) + 3;
36267 	if (icurv1 == 2) {
36268 	    icurv1 = 1;
36269 	}
36270 	isdat3[*nsdat] = bit_set(isdat3[*nsdat],0);
36271 	i__1 = icurv1 + 32;
36272 	setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1);
36273     }
36274 
36275 /*  Loop for rest of input */
36276 
36277 L1:
36278     getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
36279     if (i_indx("uld", durq, (ftnlen)3, (ftnlen)1) > 0) {
36280 
36281 /*  Force direction */
36282 
36283 	isdat1[*nsdat] = bit_set(isdat1[*nsdat],26);
36284 	if (*(unsigned char *)durq == 'u') {
36285 	    isdat1[*nsdat] = bit_set(isdat1[*nsdat],27);
36286 	}
36287 	goto L1;
36288     } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
36289 	++numint;
36290 	if (numint == 1) {
36291 
36292 /*  Vertical offset */
36293 
36294 	    ++(*iccount);
36295 	    readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
36296 	    --(*iccount);
36297 	    ivoff = i_nint(&fnum);
36298 	    if (*(unsigned char *)durq == '-') {
36299 		ivoff = -ivoff;
36300 	    }
36301 	} else if (numint == 2) {
36302 
36303 /*  Horizontal offset */
36304 
36305 	    ++(*iccount);
36306 	    readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
36307 	    --(*iccount);
36308 
36309 /*  fnum is abs(hshift), must be 0 to 6.3 */
36310 
36311 	    ihoff = fnum * 10 + .5f;
36312 	    if (*(unsigned char *)durq == '-') {
36313 		ihoff = -ihoff;
36314 	    }
36315 
36316 /*  Later will set bits to 1...127 to represent -6.3,...+6.3 */
36317 
36318 	} else {
36319 
36320 /*  Must be the 3rd signed integer, so it's a curve specification */
36321 
36322 	    isdat3[*nsdat] = bit_set(isdat3[*nsdat],0);
36323 	    ++(*iccount);
36324 	    readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
36325 	    icurv1 = i_nint(&fnum);
36326 	    if (*(unsigned char *)durq == '-') {
36327 		icurv1 = -icurv1;
36328 	    }
36329 	    i__1 = icurv1 + 32;
36330 	    setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1);
36331 	    if (*(unsigned char *)dumq != ':') {
36332 
36333 /*  Back up the pointer and loop for more input */
36334 
36335 		--(*iccount);
36336 	    } else {
36337 
36338 /*  Expect two single digits as parameters for curve */
36339 
36340 		isdat3[*nsdat] = bit_set(isdat3[*nsdat],1);
36341 		i__1 = *iccount;
36342 		i__2 = *(unsigned char *)&lineq[i__1] - 48;
36343 		setbits_(&isdat3[*nsdat], &c__3, &c__8, &i__2);
36344 		i__1 = *iccount + 1;
36345 		i__2 = *(unsigned char *)&lineq[i__1] - 48;
36346 		setbits_(&isdat3[*nsdat], &c__3, &c__11, &i__2);
36347 		*iccount += 2;
36348 	    }
36349 	}
36350 	goto L1;
36351     } else if (*(unsigned char *)durq == 't') {
36352 	isdat2[*nsdat] = bit_set(isdat2[*nsdat],3);
36353 	goto L1;
36354     } else if (*(unsigned char *)durq == 'b') {
36355 	isdat2[*nsdat] = bit_set(isdat2[*nsdat],4);
36356 	goto L1;
36357     } else if (*(unsigned char *)durq == 's') {
36358 
36359 /*  Endpoint tweaks for linebreak slurs. */
36360 
36361 	getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
36362 
36363 /*  Next is vertical offset */
36364 
36365 /* Must be +|- */
36366 	++(*iccount);
36367 	readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
36368 	if (*(unsigned char *)durq == '-') {
36369 	    fnum = -fnum;
36370 	}
36371 	i__1 = ilb12 << 4;
36372 	i__2 = i_nint(&fnum) + 32;
36373 	setbits_(&isdat4[*nsdat], &c__6, &i__1, &i__2);
36374 	if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
36375 
36376 /*  Also a horizontal offset */
36377 
36378 	    ++(*iccount);
36379 	    readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
36380 	    if (*(unsigned char *)dumq == '-') {
36381 		fnum = -fnum;
36382 	    }
36383 	    i__1 = (ilb12 << 4) + 6;
36384 	    r__1 = fnum * 10;
36385 	    i__2 = i_nint(&r__1) + 64;
36386 	    setbits_(&isdat4[*nsdat], &c__7, &i__1, &i__2);
36387 	}
36388 	--(*iccount);
36389 	ilb12 = 1;
36390 	goto L1;
36391     } else if (i_indx("fnhH", durq, (ftnlen)4, (ftnlen)1) > 0) {
36392 
36393 /*  Special ps slur curvatures. */
36394 /*  Translate to old \midslur args (1,4,5,6) */
36395 
36396 	icurv1 = i_indx("fnxhH", durq, (ftnlen)5, (ftnlen)1);
36397 	if (icurv1 == 5) {
36398 
36399 /*  check for 2nd H */
36400 
36401 	    i__1 = *iccount;
36402 	    if (s_cmp(lineq + i__1, "H", *iccount + 1 - i__1, (ftnlen)1) == 0)
36403 		     {
36404 		++(*iccount);
36405 		icurv1 = 6;
36406 	    }
36407 	}
36408 	isdat3[*nsdat] = bit_set(isdat3[*nsdat],0);
36409 	i__1 = icurv1 + 32;
36410 	setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1);
36411 	goto L1;
36412     } else if (*(unsigned char *)durq == 'p') {
36413 /* Local adjustment */
36414 	getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
36415 /*  +|- */
36416 	getchar_(lineq, iccount, dumq, (ftnlen)128, (ftnlen)1);
36417 /*  26       \sluradjust    (p+s) */
36418 /*  27       \nosluradjust  (p-s) */
36419 /*  28       \tieadjust     (p+t) */
36420 /*  29       \notieadjust   (p-t) */
36421 /*  s|t */
36422 	if (*(unsigned char *)durq == '+') {
36423 	    if (*(unsigned char *)dumq == 's') {
36424 		isdat2[*nsdat] = bit_set(isdat2[*nsdat],26);
36425 	    } else {
36426 		isdat2[*nsdat] = bit_set(isdat2[*nsdat],28);
36427 	    }
36428 	} else {
36429 	    if (*(unsigned char *)dumq == 's') {
36430 		isdat2[*nsdat] = bit_set(isdat2[*nsdat],27);
36431 	    } else {
36432 		isdat2[*nsdat] = bit_set(isdat2[*nsdat],29);
36433 	    }
36434 	}
36435 	goto L1;
36436     }
36437 
36438 /*  Record shifts */
36439 
36440     i__1 = ivoff + 32;
36441     setbits_(&isdat2[*nsdat], &c__6, &c__6, &i__1);
36442     i__1 = ihoff + 64;
36443     setbits_(&isdat2[*nsdat], &c__7, &c__12, &i__1);
36444 
36445 /*  Record chord flag, note level, notehead shift */
36446 
36447     if (*notcrd) {
36448 	setbits_(&isdat2[*nsdat], &c__7, &c__19, nolev);
36449     } else {
36450 	nolevc = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__7, &
36451 		c__12);
36452 	setbits_(&isdat2[*nsdat], &c__7, &c__19, &nolevc);
36453 	isdat2[*nsdat] = bit_set(isdat2[*nsdat],0);
36454 	i__1 = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__2, &
36455 		c__23);
36456 	setbits_(&isdat2[*nsdat], &c__2, &c__1, &i__1);
36457     }
36458     return 0;
36459 } /* spsslur_ */
36460 
sslur_(char * lineq,integer * iccount,integer * iv,integer * kv,integer * ip,integer * isdat1,integer * isdat2,integer * isdat3,integer * nsdat,logical * notcrd,integer * nolev,char * starter,ftnlen lineq_len,ftnlen starter_len)36461 /* Subroutine */ int sslur_(char *lineq, integer *iccount, integer *iv,
36462 	integer *kv, integer *ip, integer *isdat1, integer *isdat2, integer *
36463 	isdat3, integer *nsdat, logical *notcrd, integer *nolev, char *
36464 	starter, ftnlen lineq_len, ftnlen starter_len)
36465 {
36466     /* System generated locals */
36467     integer i__1, i__2;
36468 
36469     /* Builtin functions */
36470     integer i_indx(char *, char *, ftnlen, ftnlen), i_nint(real *), s_cmp(
36471 	    char *, char *, ftnlen, ftnlen);
36472 
36473     /* Local variables */
36474     extern integer igetbits_(integer *, integer *, integer *);
36475     static real fnum;
36476     static char dumq[1], durq[1];
36477     static integer ihoff, isdat, ivoff, icurv1, idcode, nolevc, numint;
36478     extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen,
36479 	    ftnlen), readnum_(char *, integer *, char *, real *, ftnlen,
36480 	    ftnlen), setbits_(integer *, integer *, integer *, integer *);
36481 
36482 
36483 /*  Reads in slur data.  Record all h/v-shifts for non-chords, user-specified */
36484 /*  ones for chords. */
36485 /*  5/26/02 now only for non-postscript slurs, use spsslur() for postscript */
36486 
36487 /*  See subroutine doslur for bit values in isdat1,2,3 */
36488 
36489 
36490 /*  Counter for signed integers.  1st is height, 2nd is horiz, 3rd is curve */
36491 
36492     /* Parameter adjustments */
36493     --isdat3;
36494     --isdat2;
36495     --isdat1;
36496 
36497     /* Function Body */
36498     numint = 0;
36499     ivoff = 0;
36500     ihoff = 0;
36501     ++(*nsdat);
36502     if (*(unsigned char *)starter == '{' || *(unsigned char *)starter == '}')
36503 	    {
36504 	isdat2[*nsdat] = bit_set(isdat2[*nsdat],3);
36505     }
36506     setbits_(&isdat1[*nsdat], &c__5, &c__13, iv);
36507     i__1 = *kv - 1;
36508     setbits_(&isdat1[*nsdat], &c__1, &c__12, &i__1);
36509     setbits_(&isdat1[*nsdat], &c__8, &c__3, ip);
36510     isdat3[*nsdat] = 0;
36511 
36512 /*  Get id letter */
36513 
36514     if (*(unsigned char *)&lineq[*iccount - 1] == 't') {
36515 
36516 /*  Old-style t-slur. Use special idcode = 1 */
36517 
36518 	idcode = 1;
36519     } else {
36520 	getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
36521 	if (i_indx("uldtb+-hf ", durq, (ftnlen)10, (ftnlen)1) > 0) {
36522 
36523 /*  Null id */
36524 
36525 	    idcode = 32;
36526 	    --(*iccount);
36527 	} else if (*(unsigned char *)durq == 'H') {
36528 
36529 /*  Postscript slur, cannot use 'H' as code, must check for 2nd 'H' */
36530 
36531 	    idcode = 32;
36532 	    --(*iccount);
36533 
36534 /*  There may be another "H", but no need to deal with it yet */
36535 
36536 	} else {
36537 
36538 /*  Set explicit idcode */
36539 
36540 	    idcode = *(unsigned char *)durq;
36541 	}
36542     }
36543     setbits_(&isdat1[*nsdat], &c__7, &c__19, &idcode);
36544 
36545 /*  Set start/stop: look thru list from end for same idcode,iv,kv */
36546 
36547     for (isdat = *nsdat - 1; isdat >= 1; --isdat) {
36548 	if (idcode == igetbits_(&isdat1[isdat], &c__7, &c__19) && *iv ==
36549 		igetbits_(&isdat1[isdat], &c__5, &c__13) && *kv - 1 ==
36550 		igetbits_(&isdat1[isdat], &c__1, &c__12)) {
36551 
36552 /*  Matched idcode & ivx.  On/off?.  If on, new is turnoff, leave bit 11 at 0. */
36553 
36554 	    if (bit_test(isdat1[isdat],11)) {
36555 		goto L3;
36556 	    }
36557 
36558 /*  Found slur is a turnoff, so new one is a turnon.  Jump down to set bit */
36559 
36560 	    goto L4;
36561 	}
36562 /* L2: */
36563     }
36564 
36565 /*  If here, this is turnon. */
36566 
36567 L4:
36568     isdat1[*nsdat] = bit_set(isdat1[*nsdat],11);
36569 L3:
36570 
36571 /*  Now done with initial turnon- or turnoff-specifics.  Loop for rest of input */
36572 
36573 L1:
36574     getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
36575     if (i_indx("uld", durq, (ftnlen)3, (ftnlen)1) > 0) {
36576 
36577 /*  Force direction */
36578 
36579 	isdat1[*nsdat] = bit_set(isdat1[*nsdat],26);
36580 	if (*(unsigned char *)durq == 'u') {
36581 	    isdat1[*nsdat] = bit_set(isdat1[*nsdat],27);
36582 	}
36583 	goto L1;
36584     } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
36585 	++numint;
36586 	if (numint == 1) {
36587 
36588 /*  Vertical offset */
36589 
36590 	    ++(*iccount);
36591 	    readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
36592 	    --(*iccount);
36593 	    ivoff = i_nint(&fnum);
36594 	    if (*(unsigned char *)durq == '-') {
36595 		ivoff = -ivoff;
36596 	    }
36597 	} else if (numint == 2) {
36598 
36599 /*  Horizontal offset */
36600 
36601 	    ++(*iccount);
36602 	    readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
36603 	    --(*iccount);
36604 
36605 /*  fnum is abs(hshift), must be 0 to 6.3 */
36606 
36607 	    ihoff = fnum * 10 + .5f;
36608 	    if (*(unsigned char *)durq == '-') {
36609 		ihoff = -ihoff;
36610 	    }
36611 
36612 /*  Later will set bits to 1...127 to represent -6.3,...+6.3 */
36613 
36614 	} else {
36615 
36616 /*  Must be the 3rd signed integer, so it's a curve specification */
36617 
36618 	    isdat3[*nsdat] = bit_set(isdat3[*nsdat],0);
36619 	    ++(*iccount);
36620 	    readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
36621 	    icurv1 = i_nint(&fnum);
36622 	    if (*(unsigned char *)durq == '-') {
36623 		icurv1 = -icurv1;
36624 	    }
36625 	    i__1 = icurv1 + 32;
36626 	    setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1);
36627 	    if (*(unsigned char *)dumq != ':') {
36628 
36629 /*  Back up the pointer and loop for more input */
36630 
36631 		--(*iccount);
36632 	    } else {
36633 
36634 /*  Expect two single digits as parameters for curve */
36635 
36636 		isdat3[*nsdat] = bit_set(isdat3[*nsdat],1);
36637 		i__1 = *iccount;
36638 		i__2 = *(unsigned char *)&lineq[i__1] - 48;
36639 		setbits_(&isdat3[*nsdat], &c__3, &c__8, &i__2);
36640 		i__1 = *iccount + 1;
36641 		i__2 = *(unsigned char *)&lineq[i__1] - 48;
36642 		setbits_(&isdat3[*nsdat], &c__3, &c__11, &i__2);
36643 		*iccount += 2;
36644 	    }
36645 	}
36646 	goto L1;
36647     } else if (*(unsigned char *)durq == 't') {
36648 	isdat2[*nsdat] = bit_set(isdat2[*nsdat],3);
36649 	goto L1;
36650     } else if (*(unsigned char *)durq == 'b') {
36651 	isdat2[*nsdat] = bit_set(isdat2[*nsdat],4);
36652 	goto L1;
36653     } else if (i_indx("fhH", durq, (ftnlen)3, (ftnlen)1) > 0) {
36654 
36655 /*  Special ps slur curvatures.  Translate to old \midslur args (1,4,5,6) */
36656 
36657 	icurv1 = i_indx("fhH", durq, (ftnlen)3, (ftnlen)1) + 2;
36658 	if (icurv1 == 3) {
36659 	    icurv1 = 1;
36660 	} else if (icurv1 == 5) {
36661 
36662 /*  check for 2nd H */
36663 
36664 	    i__1 = *iccount;
36665 	    if (s_cmp(lineq + i__1, "H", *iccount + 1 - i__1, (ftnlen)1) == 0)
36666 		     {
36667 		++(*iccount);
36668 		icurv1 = 6;
36669 	    }
36670 	}
36671 	isdat3[*nsdat] = bit_set(isdat3[*nsdat],0);
36672 
36673 /*  Must change sign if downslur, but cannot do it now since we don't know */
36674 /*    slur direction for sure. */
36675 
36676 	i__1 = icurv1 + 32;
36677 	setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1);
36678 	goto L1;
36679     }
36680 
36681 /*  Record shifts */
36682 
36683     i__1 = ivoff + 32;
36684     setbits_(&isdat2[*nsdat], &c__6, &c__6, &i__1);
36685     i__1 = ihoff + 64;
36686     setbits_(&isdat2[*nsdat], &c__7, &c__12, &i__1);
36687 
36688 /*  Record chord flag, note level, notehead shift */
36689 
36690     if (*notcrd) {
36691 	setbits_(&isdat2[*nsdat], &c__7, &c__19, nolev);
36692     } else {
36693 	nolevc = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__7, &
36694 		c__12);
36695 	setbits_(&isdat2[*nsdat], &c__7, &c__19, &nolevc);
36696 	isdat2[*nsdat] = bit_set(isdat2[*nsdat],0);
36697 	i__1 = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__2, &
36698 		c__23);
36699 	setbits_(&isdat2[*nsdat], &c__2, &c__1, &i__1);
36700     }
36701     return 0;
36702 } /* sslur_ */
36703 
stop1_(void)36704 /* Subroutine */ int stop1_(void)
36705 {
36706     extern /* Subroutine */ int exit_(integer *);
36707 
36708     exit_(&c__1);
36709     return 0;
36710 } /* stop1_ */
36711 
topfile_(char * basenameq,integer * lbase,integer * nv,char * clefq,integer * noinst,integer * musicsize,real * xinstf1,integer * mtrnmp,integer * mtrdnp,logical * vshrink,real * fbar,logical * fontslur,ftnlen basenameq_len,ftnlen clefq_len)36712 /* Subroutine */ int topfile_(char *basenameq, integer *lbase, integer *nv,
36713 	char *clefq, integer *noinst, integer *musicsize, real *xinstf1,
36714 	integer *mtrnmp, integer *mtrdnp, logical *vshrink, real *fbar,
36715 	logical *fontslur, ftnlen basenameq_len, ftnlen clefq_len)
36716 {
36717     /* System generated locals */
36718     address a__1[3], a__2[2], a__3[4], a__4[6], a__5[2], a__6[10], a__7[20],
36719 	    a__8[12], a__9[8];
36720     integer i__1[3], i__2[2], i__3[4], i__4[6], i__5, i__6[2], i__7, i__8,
36721 	    i__9[10], i__10[20], i__11[12], i__12[8];
36722     real r__1;
36723     char ch__1[1], ch__2[50], ch__3[15], ch__4[10], ch__5[39], ch__6[14],
36724 	    ch__7[17], ch__8[16], ch__9[32], ch__10[8], ch__11[12], ch__12[9],
36725 	     ch__13[13], ch__14[11], ch__15[21], ch__16[7], ch__17[6], ch__18[
36726 	    30], ch__19[19], ch__20[1], ch__21[2], ch__22[33], ch__23[25],
36727 	    ch__24[81], ch__25[82], ch__26[18], ch__27[57], ch__28[44],
36728 	    ch__29[62], ch__30[54], ch__31[86], ch__32[41], ch__33[47];
36729     cilist ci__1;
36730 
36731     /* Builtin functions */
36732     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
36733     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
36734     integer s_wsfi(icilist *), e_wsfi(void), i_nint(real *);
36735     double r_lg10(real *);
36736     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
36737 
36738     /* Local variables */
36739     static integer k, iv;
36740     static char sq[1];
36741     static integer ipi;
36742     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
36743     static char fmtq[24];
36744     extern /* Subroutine */ int writesetsign_(integer *, integer *, integer *,
36745 	     logical *);
36746     static char fbarq[5];
36747     static integer lname, lfmtq, iinst;
36748     extern integer numclef_(char *, ftnlen);
36749     extern /* Subroutine */ int wgmeter_(integer *, integer *);
36750     static integer nstaves;
36751 
36752     /* Fortran I/O blocks */
36753     static cilist io___1668 = { 0, 11, 0, "(a)", 0 };
36754     static cilist io___1669 = { 0, 11, 0, "(a)", 0 };
36755     static cilist io___1670 = { 0, 11, 0, "(a)", 0 };
36756     static cilist io___1671 = { 0, 11, 0, "(a)", 0 };
36757     static cilist io___1672 = { 0, 11, 0, "(a)", 0 };
36758     static cilist io___1673 = { 0, 11, 0, "(a)", 0 };
36759     static cilist io___1674 = { 0, 11, 0, "(a)", 0 };
36760     static cilist io___1675 = { 0, 11, 0, "(a)", 0 };
36761     static cilist io___1676 = { 0, 11, 0, "(a)", 0 };
36762     static cilist io___1677 = { 0, 11, 0, "(a)", 0 };
36763     static cilist io___1678 = { 0, 11, 0, "(a)", 0 };
36764     static cilist io___1679 = { 0, 11, 0, "(a)", 0 };
36765     static cilist io___1680 = { 0, 11, 0, "(a)", 0 };
36766     static cilist io___1681 = { 0, 11, 0, "(a)", 0 };
36767     static cilist io___1682 = { 0, 11, 0, "(a)", 0 };
36768     static cilist io___1684 = { 0, 11, 0, "(a8,i1,a)", 0 };
36769     static cilist io___1685 = { 0, 11, 0, "(a9,i2,a)", 0 };
36770     static cilist io___1686 = { 0, 11, 0, "(a8,i1,a)", 0 };
36771     static cilist io___1687 = { 0, 11, 0, "(a9,i2,a)", 0 };
36772     static icilist io___1689 = { 0, fbarq, 0, "(f5.3)", 5, 1 };
36773     static cilist io___1690 = { 0, 11, 0, "(a)", 0 };
36774     static cilist io___1691 = { 0, 11, 0, "(a)", 0 };
36775     static cilist io___1692 = { 0, 11, 0, "(a7,i3,a2)", 0 };
36776     static cilist io___1693 = { 0, 11, 0, "(a8,i3,a2)", 0 };
36777     static cilist io___1694 = { 0, 11, 0, "(a8,i2,a2)", 0 };
36778     static cilist io___1695 = { 0, 11, 0, "(a8,i1,a2)", 0 };
36779     static cilist io___1696 = { 0, 11, 0, "(a8,i2,a2)", 0 };
36780     static cilist io___1697 = { 0, 11, 0, "(a8,i3,a2)", 0 };
36781     static cilist io___1698 = { 0, 11, 0, "(a8,i2,a2)", 0 };
36782     static cilist io___1699 = { 0, 11, 0, "(a8,i1,a2)", 0 };
36783     static cilist io___1700 = { 0, 11, 0, "(a8,i2,a2)", 0 };
36784     static cilist io___1701 = { 0, 11, 0, "(a)", 0 };
36785     static cilist io___1702 = { 0, 11, 0, "(a19,i1,a1)", 0 };
36786     static cilist io___1703 = { 0, 11, 0, "(a19,i2,a1)", 0 };
36787     static cilist io___1706 = { 0, 11, 0, "(a)", 0 };
36788     static cilist io___1707 = { 0, 11, 0, "(a11,i2,a)", 0 };
36789     static cilist io___1711 = { 0, 11, 0, "(a)", 0 };
36790     static cilist io___1712 = { 0, 11, 0, "(a9,i2,a)", 0 };
36791     static cilist io___1714 = { 0, 11, 0, "(a8,i1,a)", 0 };
36792     static cilist io___1715 = { 0, 11, 0, "(a9,i2,a)", 0 };
36793     static cilist io___1716 = { 0, 11, 0, "(a18,i2,a2)", 0 };
36794     static cilist io___1718 = { 0, 11, 0, "(a11,i1,a2)", 0 };
36795     static cilist io___1719 = { 0, 11, 0, "(a11,i2,a2)", 0 };
36796     static cilist io___1720 = { 0, 11, 0, "(a11,i3,a2)", 0 };
36797     static cilist io___1721 = { 0, 11, 0, "(a)", 0 };
36798     static cilist io___1722 = { 0, 11, 0, fmtq, 0 };
36799     static cilist io___1723 = { 0, 11, 0, "(a)", 0 };
36800     static cilist io___1724 = { 0, 11, 0, "(a)", 0 };
36801     static cilist io___1725 = { 0, 11, 0, "(a)", 0 };
36802     static cilist io___1726 = { 0, 11, 0, "(a)", 0 };
36803     static cilist io___1727 = { 0, 11, 0, "(a)", 0 };
36804     static cilist io___1728 = { 0, 11, 0, "(a)", 0 };
36805 
36806 
36807     /* Parameter adjustments */
36808     --clefq;
36809 
36810     /* Function Body */
36811     chax_(ch__1, (ftnlen)1, &c__92);
36812     *(unsigned char *)sq = *(unsigned char *)&ch__1[0];
36813     *vshrink = *xinstf1 > 20.f && ! comnvst_1.novshrinktop;
36814     if (*vshrink) {
36815 	comarp_1.xinsnow = 10.f;
36816     } else {
36817 	comarp_1.xinsnow = *xinstf1;
36818     }
36819     if (! comlast_1.islast) {
36820 	return 0;
36821     }
36822     s_wsfe(&io___1668);
36823     do_fio(&c__1, "%%%%%%%%%%%%%%%%%", (ftnlen)17);
36824     e_wsfe();
36825     s_wsfe(&io___1669);
36826     do_fio(&c__1, "%", (ftnlen)1);
36827     e_wsfe();
36828     s_wsfe(&io___1670);
36829 /* Writing concatenation */
36830     i__1[0] = 2, a__1[0] = "% ";
36831     i__1[1] = *lbase, a__1[1] = basenameq;
36832     i__1[2] = 4, a__1[2] = ".tex";
36833     s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)50);
36834     do_fio(&c__1, ch__2, *lbase + 6);
36835     e_wsfe();
36836     s_wsfe(&io___1671);
36837     do_fio(&c__1, "%", (ftnlen)1);
36838     e_wsfe();
36839     s_wsfe(&io___1672);
36840     do_fio(&c__1, "%%%%%%%%%%%%%%%%", (ftnlen)16);
36841     e_wsfe();
36842     s_wsfe(&io___1673);
36843 /* Writing concatenation */
36844     i__2[0] = 1, a__2[0] = sq;
36845     i__2[1] = 14, a__2[1] = "input musixtex";
36846     s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)15);
36847     do_fio(&c__1, ch__3, (ftnlen)15);
36848     e_wsfe();
36849     s_wsfe(&io___1674);
36850 /* Writing concatenation */
36851     i__2[0] = 1, a__2[0] = sq;
36852     i__2[1] = 9, a__2[1] = "input pmx";
36853     s_cat(ch__4, a__2, i__2, &c__2, (ftnlen)10);
36854     do_fio(&c__1, ch__4, (ftnlen)10);
36855     e_wsfe();
36856 /*      write(11,'(a)')sq//'input musixmad' */
36857 /*      write(11,'(a)')sq//'input musixxad' */
36858     s_wsfe(&io___1675);
36859 /* Writing concatenation */
36860     i__3[0] = 1, a__3[0] = sq;
36861     i__3[1] = 15, a__3[1] = "setmaxslurs{24}";
36862     i__3[2] = 1, a__3[2] = sq;
36863     i__3[3] = 22, a__3[3] = "setmaxinstruments{24}%";
36864     s_cat(ch__5, a__3, i__3, &c__4, (ftnlen)39);
36865     do_fio(&c__1, ch__5, (ftnlen)39);
36866     e_wsfe();
36867     if (! (*fontslur)) {
36868 	s_wsfe(&io___1676);
36869 /* Writing concatenation */
36870 	i__2[0] = 1, a__2[0] = sq;
36871 	i__2[1] = 13, a__2[1] = "input musixps";
36872 	s_cat(ch__6, a__2, i__2, &c__2, (ftnlen)14);
36873 	do_fio(&c__1, ch__6, (ftnlen)14);
36874 	e_wsfe();
36875     }
36876 
36877 /* Need to input musixmad to permit more slurs. */
36878 
36879     if (*musicsize == 20) {
36880 	s_wsfe(&io___1677);
36881 /* Writing concatenation */
36882 	i__2[0] = 1, a__2[0] = sq;
36883 	i__2[1] = 16, a__2[1] = "normalmusicsize%";
36884 	s_cat(ch__7, a__2, i__2, &c__2, (ftnlen)17);
36885 	do_fio(&c__1, ch__7, (ftnlen)17);
36886 	e_wsfe();
36887     } else if (*musicsize == 16) {
36888 	s_wsfe(&io___1678);
36889 /* Writing concatenation */
36890 	i__2[0] = 1, a__2[0] = sq;
36891 	i__2[1] = 15, a__2[1] = "smallmusicsize%";
36892 	s_cat(ch__8, a__2, i__2, &c__2, (ftnlen)16);
36893 	do_fio(&c__1, ch__8, (ftnlen)16);
36894 	e_wsfe();
36895     } else if (*musicsize == 24) {
36896 	s_wsfe(&io___1679);
36897 /* Writing concatenation */
36898 	i__2[0] = 1, a__2[0] = sq;
36899 	i__2[1] = 15, a__2[1] = "largemusicsize%";
36900 	s_cat(ch__8, a__2, i__2, &c__2, (ftnlen)16);
36901 	do_fio(&c__1, ch__8, (ftnlen)16);
36902 	e_wsfe();
36903 	s_wsfe(&io___1680);
36904 /* Writing concatenation */
36905 	i__4[0] = 1, a__4[0] = sq;
36906 	i__4[1] = 3, a__4[1] = "def";
36907 	i__4[2] = 1, a__4[2] = sq;
36908 	i__4[3] = 10, a__4[3] = "meterfont{";
36909 	i__4[4] = 1, a__4[4] = sq;
36910 	i__4[5] = 16, a__4[5] = "meterlargefont}%";
36911 	s_cat(ch__9, a__4, i__4, &c__6, (ftnlen)32);
36912 	do_fio(&c__1, ch__9, (ftnlen)32);
36913 	e_wsfe();
36914     } else if (*musicsize == 29) {
36915 	s_wsfe(&io___1681);
36916 /* Writing concatenation */
36917 	i__2[0] = 1, a__2[0] = sq;
36918 	i__2[1] = 15, a__2[1] = "Largemusicsize%";
36919 	s_cat(ch__8, a__2, i__2, &c__2, (ftnlen)16);
36920 	do_fio(&c__1, ch__8, (ftnlen)16);
36921 	e_wsfe();
36922 	s_wsfe(&io___1682);
36923 /* Writing concatenation */
36924 	i__4[0] = 1, a__4[0] = sq;
36925 	i__4[1] = 3, a__4[1] = "def";
36926 	i__4[2] = 1, a__4[2] = sq;
36927 	i__4[3] = 10, a__4[3] = "meterfont{";
36928 	i__4[4] = 1, a__4[4] = sq;
36929 	i__4[5] = 16, a__4[5] = "meterLargefont}%";
36930 	s_cat(ch__9, a__4, i__4, &c__6, (ftnlen)32);
36931 	do_fio(&c__1, ch__9, (ftnlen)32);
36932 	e_wsfe();
36933     }
36934 
36935 /*  Set sizes. Have sizes per staff in isize(.) and noinst per staff in */
36936 /*    nsperi(.) */
36937 
36938 /* 130324 */
36939 /*      iiv = 1 */
36940     i__5 = *noinst;
36941     for (iinst = 1; iinst <= i__5; ++iinst) {
36942 /*        if (isize(iiv) .eq. 1) then */
36943 	if (comsize_1.isize[iinst - 1] == 1) {
36944 	    if (iinst <= 9) {
36945 		s_wsfe(&io___1684);
36946 /* Writing concatenation */
36947 		i__2[0] = 1, a__2[0] = sq;
36948 		i__2[1] = 7, a__2[1] = "setsize";
36949 		s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
36950 		do_fio(&c__1, ch__10, (ftnlen)8);
36951 		do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
36952 /* Writing concatenation */
36953 		i__6[0] = 1, a__5[0] = sq;
36954 		i__6[1] = 11, a__5[1] = "smallvalue%";
36955 		s_cat(ch__11, a__5, i__6, &c__2, (ftnlen)12);
36956 		do_fio(&c__1, ch__11, (ftnlen)12);
36957 		e_wsfe();
36958 	    } else {
36959 		s_wsfe(&io___1685);
36960 /* Writing concatenation */
36961 		i__2[0] = 1, a__2[0] = sq;
36962 		i__2[1] = 8, a__2[1] = "setsize{";
36963 		s_cat(ch__12, a__2, i__2, &c__2, (ftnlen)9);
36964 		do_fio(&c__1, ch__12, (ftnlen)9);
36965 		do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
36966 /* Writing concatenation */
36967 		i__1[0] = 1, a__1[0] = "}";
36968 		i__1[1] = 1, a__1[1] = sq;
36969 		i__1[2] = 11, a__1[2] = "smallvalue%";
36970 		s_cat(ch__13, a__1, i__1, &c__3, (ftnlen)13);
36971 		do_fio(&c__1, ch__13, (ftnlen)13);
36972 		e_wsfe();
36973 	    }
36974 /*        else if (isize(iiv) .eq. 2) then */
36975 	} else if (comsize_1.isize[iinst - 1] == 2) {
36976 	    if (iinst <= 9) {
36977 		s_wsfe(&io___1686);
36978 /* Writing concatenation */
36979 		i__2[0] = 1, a__2[0] = sq;
36980 		i__2[1] = 7, a__2[1] = "setsize";
36981 		s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
36982 		do_fio(&c__1, ch__10, (ftnlen)8);
36983 		do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
36984 /* Writing concatenation */
36985 		i__6[0] = 1, a__5[0] = sq;
36986 		i__6[1] = 10, a__5[1] = "tinyvalue%";
36987 		s_cat(ch__14, a__5, i__6, &c__2, (ftnlen)11);
36988 		do_fio(&c__1, ch__14, (ftnlen)11);
36989 		e_wsfe();
36990 	    } else {
36991 		s_wsfe(&io___1687);
36992 /* Writing concatenation */
36993 		i__2[0] = 1, a__2[0] = sq;
36994 		i__2[1] = 8, a__2[1] = "setsize{";
36995 		s_cat(ch__12, a__2, i__2, &c__2, (ftnlen)9);
36996 		do_fio(&c__1, ch__12, (ftnlen)9);
36997 		do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
36998 /* Writing concatenation */
36999 		i__1[0] = 1, a__1[0] = "}";
37000 		i__1[1] = 1, a__1[1] = sq;
37001 		i__1[2] = 10, a__1[2] = "tinyvalue%";
37002 		s_cat(ch__11, a__1, i__1, &c__3, (ftnlen)12);
37003 		do_fio(&c__1, ch__11, (ftnlen)12);
37004 		e_wsfe();
37005 	    }
37006 	}
37007 /*        iiv = iiv+nsperi(iinst) */
37008 /* L5: */
37009     }
37010     s_wsfi(&io___1689);
37011     do_fio(&c__1, (char *)&(*fbar), (ftnlen)sizeof(real));
37012     e_wsfi();
37013     s_wsfe(&io___1690);
37014 /* Writing concatenation */
37015     i__2[0] = 1, a__2[0] = sq;
37016     i__2[1] = 13, a__2[1] = "nopagenumbers";
37017     s_cat(ch__6, a__2, i__2, &c__2, (ftnlen)14);
37018     do_fio(&c__1, ch__6, (ftnlen)14);
37019     e_wsfe();
37020     s_wsfe(&io___1691);
37021 /* Writing concatenation */
37022     i__3[0] = 1, a__3[0] = sq;
37023     i__3[1] = 14, a__3[1] = "tracingstats=2";
37024     i__3[2] = 1, a__3[2] = sq;
37025     i__3[3] = 5, a__3[3] = "relax";
37026     s_cat(ch__15, a__3, i__3, &c__4, (ftnlen)21);
37027     do_fio(&c__1, ch__15, (ftnlen)21);
37028     e_wsfe();
37029     s_wsfe(&io___1692);
37030 /* Writing concatenation */
37031     i__2[0] = 1, a__2[0] = sq;
37032     i__2[1] = 6, a__2[1] = "hsize=";
37033     s_cat(ch__16, a__2, i__2, &c__2, (ftnlen)7);
37034     do_fio(&c__1, ch__16, (ftnlen)7);
37035     i__5 = i_nint(&comtop_1.widthpt);
37036     do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer));
37037     do_fio(&c__1, "pt", (ftnlen)2);
37038     e_wsfe();
37039     ci__1.cierr = 0;
37040     ci__1.ciunit = 11;
37041 /* Writing concatenation */
37042     i__1[0] = 5, a__1[0] = "(a6,i";
37043     r__1 = comtop_1.height + .1f;
37044     i__5 = (integer) r_lg10(&r__1) + 49;
37045     chax_(ch__1, (ftnlen)1, &i__5);
37046     i__1[1] = 1, a__1[1] = ch__1;
37047     i__1[2] = 4, a__1[2] = ",a2)";
37048     ci__1.cifmt = (s_cat(ch__4, a__1, i__1, &c__3, (ftnlen)10), ch__4);
37049     s_wsfe(&ci__1);
37050 /* Writing concatenation */
37051     i__2[0] = 1, a__2[0] = sq;
37052     i__2[1] = 5, a__2[1] = "vsize";
37053     s_cat(ch__17, a__2, i__2, &c__2, (ftnlen)6);
37054     do_fio(&c__1, ch__17, (ftnlen)6);
37055     i__7 = (integer) (comtop_1.height + .1f);
37056     do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer));
37057     do_fio(&c__1, "pt", (ftnlen)2);
37058     e_wsfe();
37059     if (dabs(comtop_1.hoffpt) > .1f) {
37060 	if (comtop_1.hoffpt <= -10.f) {
37061 	    s_wsfe(&io___1693);
37062 /* Writing concatenation */
37063 	    i__2[0] = 1, a__2[0] = sq;
37064 	    i__2[1] = 7, a__2[1] = "hoffset";
37065 	    s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
37066 	    do_fio(&c__1, ch__10, (ftnlen)8);
37067 	    i__5 = i_nint(&comtop_1.hoffpt);
37068 	    do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer));
37069 	    do_fio(&c__1, "pt", (ftnlen)2);
37070 	    e_wsfe();
37071 	} else if (comtop_1.hoffpt < 0.f) {
37072 	    s_wsfe(&io___1694);
37073 /* Writing concatenation */
37074 	    i__2[0] = 1, a__2[0] = sq;
37075 	    i__2[1] = 7, a__2[1] = "hoffset";
37076 	    s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
37077 	    do_fio(&c__1, ch__10, (ftnlen)8);
37078 	    i__5 = i_nint(&comtop_1.hoffpt);
37079 	    do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer));
37080 	    do_fio(&c__1, "pt", (ftnlen)2);
37081 	    e_wsfe();
37082 	} else if (comtop_1.hoffpt < 10.f) {
37083 	    s_wsfe(&io___1695);
37084 /* Writing concatenation */
37085 	    i__2[0] = 1, a__2[0] = sq;
37086 	    i__2[1] = 7, a__2[1] = "hoffset";
37087 	    s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
37088 	    do_fio(&c__1, ch__10, (ftnlen)8);
37089 	    i__5 = i_nint(&comtop_1.hoffpt);
37090 	    do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer));
37091 	    do_fio(&c__1, "pt", (ftnlen)2);
37092 	    e_wsfe();
37093 	} else {
37094 	    s_wsfe(&io___1696);
37095 /* Writing concatenation */
37096 	    i__2[0] = 1, a__2[0] = sq;
37097 	    i__2[1] = 7, a__2[1] = "hoffset";
37098 	    s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
37099 	    do_fio(&c__1, ch__10, (ftnlen)8);
37100 	    i__5 = i_nint(&comtop_1.hoffpt);
37101 	    do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer));
37102 	    do_fio(&c__1, "pt", (ftnlen)2);
37103 	    e_wsfe();
37104 	}
37105     }
37106     if (dabs(comtop_1.voffpt) > .1f) {
37107 	if (comtop_1.voffpt <= -10.f) {
37108 	    s_wsfe(&io___1697);
37109 /* Writing concatenation */
37110 	    i__2[0] = 1, a__2[0] = sq;
37111 	    i__2[1] = 7, a__2[1] = "voffset";
37112 	    s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
37113 	    do_fio(&c__1, ch__10, (ftnlen)8);
37114 	    i__5 = i_nint(&comtop_1.voffpt);
37115 	    do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer));
37116 	    do_fio(&c__1, "pt", (ftnlen)2);
37117 	    e_wsfe();
37118 	} else if (comtop_1.voffpt < 0.f) {
37119 	    s_wsfe(&io___1698);
37120 /* Writing concatenation */
37121 	    i__2[0] = 1, a__2[0] = sq;
37122 	    i__2[1] = 7, a__2[1] = "voffset";
37123 	    s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
37124 	    do_fio(&c__1, ch__10, (ftnlen)8);
37125 	    i__5 = i_nint(&comtop_1.voffpt);
37126 	    do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer));
37127 	    do_fio(&c__1, "pt", (ftnlen)2);
37128 	    e_wsfe();
37129 	} else if (comtop_1.voffpt < 10.f) {
37130 	    s_wsfe(&io___1699);
37131 /* Writing concatenation */
37132 	    i__2[0] = 1, a__2[0] = sq;
37133 	    i__2[1] = 7, a__2[1] = "voffset";
37134 	    s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
37135 	    do_fio(&c__1, ch__10, (ftnlen)8);
37136 	    i__5 = i_nint(&comtop_1.voffpt);
37137 	    do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer));
37138 	    do_fio(&c__1, "pt", (ftnlen)2);
37139 	    e_wsfe();
37140 	} else {
37141 	    s_wsfe(&io___1700);
37142 /* Writing concatenation */
37143 	    i__2[0] = 1, a__2[0] = sq;
37144 	    i__2[1] = 7, a__2[1] = "voffset";
37145 	    s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
37146 	    do_fio(&c__1, ch__10, (ftnlen)8);
37147 	    i__5 = i_nint(&comtop_1.voffpt);
37148 	    do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer));
37149 	    do_fio(&c__1, "pt", (ftnlen)2);
37150 	    e_wsfe();
37151 	}
37152     }
37153 
37154 /*  The default  raisebarno=3.5 internote, set in pmx.tex.  Increase to 4.5 if */
37155 /*  3 sharps and treble clef, to avoid vertical clash with top space g# */
37156 
37157     if (comtop_1.isig == 3 && *(unsigned char *)&clefq[*nv] == 't') {
37158 	s_wsfe(&io___1701);
37159 /* Writing concatenation */
37160 	i__4[0] = 1, a__4[0] = sq;
37161 	i__4[1] = 3, a__4[1] = "def";
37162 	i__4[2] = 1, a__4[2] = sq;
37163 	i__4[3] = 14, a__4[3] = "raisebarno{4.5";
37164 	i__4[4] = 1, a__4[4] = sq;
37165 	i__4[5] = 10, a__4[5] = "internote}";
37166 	s_cat(ch__18, a__4, i__4, &c__6, (ftnlen)30);
37167 	do_fio(&c__1, ch__18, (ftnlen)30);
37168 	e_wsfe();
37169     }
37170     if (*noinst < 10) {
37171 	s_wsfe(&io___1702);
37172 /* Writing concatenation */
37173 	i__3[0] = 1, a__3[0] = sq;
37174 	i__3[1] = 3, a__3[1] = "def";
37175 	i__3[2] = 1, a__3[2] = sq;
37176 	i__3[3] = 14, a__3[3] = "nbinstruments{";
37177 	s_cat(ch__19, a__3, i__3, &c__4, (ftnlen)19);
37178 	do_fio(&c__1, ch__19, (ftnlen)19);
37179 	do_fio(&c__1, (char *)&(*noinst), (ftnlen)sizeof(integer));
37180 	do_fio(&c__1, "}", (ftnlen)1);
37181 	e_wsfe();
37182     } else {
37183 	s_wsfe(&io___1703);
37184 /* Writing concatenation */
37185 	i__3[0] = 1, a__3[0] = sq;
37186 	i__3[1] = 3, a__3[1] = "def";
37187 	i__3[2] = 1, a__3[2] = sq;
37188 	i__3[3] = 14, a__3[3] = "nbinstruments{";
37189 	s_cat(ch__19, a__3, i__3, &c__4, (ftnlen)19);
37190 	do_fio(&c__1, ch__19, (ftnlen)19);
37191 	do_fio(&c__1, (char *)&(*noinst), (ftnlen)sizeof(integer));
37192 	do_fio(&c__1, "}", (ftnlen)1);
37193 	e_wsfe();
37194     }
37195     iv = 0;
37196     i__5 = *noinst;
37197     for (iinst = 1; iinst <= i__5; ++iinst) {
37198 	nstaves = comnvi_1.nsperi[iinst - 1];
37199 	if (iinst < 10) {
37200 	    s_wsfe(&io___1706);
37201 /* Writing concatenation */
37202 	    i__3[0] = 1, a__3[0] = sq;
37203 	    i__3[1] = 9, a__3[1] = "setstaffs";
37204 	    i__7 = iinst + 48;
37205 	    chax_(ch__1, (ftnlen)1, &i__7);
37206 	    i__3[2] = 1, a__3[2] = ch__1;
37207 	    i__8 = nstaves + 48;
37208 	    chax_(ch__20, (ftnlen)1, &i__8);
37209 	    i__3[3] = 1, a__3[3] = ch__20;
37210 	    s_cat(ch__11, a__3, i__3, &c__4, (ftnlen)12);
37211 	    do_fio(&c__1, ch__11, (ftnlen)12);
37212 	    e_wsfe();
37213 	} else {
37214 	    s_wsfe(&io___1707);
37215 /* Writing concatenation */
37216 	    i__2[0] = 1, a__2[0] = sq;
37217 	    i__2[1] = 10, a__2[1] = "setstaffs{";
37218 	    s_cat(ch__14, a__2, i__2, &c__2, (ftnlen)11);
37219 	    do_fio(&c__1, ch__14, (ftnlen)11);
37220 	    do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
37221 /* Writing concatenation */
37222 	    i__6[0] = 1, a__5[0] = "}";
37223 	    i__7 = nstaves + 48;
37224 	    chax_(ch__1, (ftnlen)1, &i__7);
37225 	    i__6[1] = 1, a__5[1] = ch__1;
37226 	    s_cat(ch__21, a__5, i__6, &c__2, (ftnlen)2);
37227 	    do_fio(&c__1, ch__21, (ftnlen)2);
37228 	    e_wsfe();
37229 	}
37230 	++iv;
37231 	if (nstaves == 1) {
37232 	    i__7 = numclef_(clefq + iv, (ftnlen)1) + 48;
37233 	    chax_(ch__1, (ftnlen)1, &i__7);
37234 	    s_copy(fmtq, ch__1, (ftnlen)24, (ftnlen)1);
37235 	    lfmtq = 1;
37236 	} else {
37237 /* Writing concatenation */
37238 	    i__2[0] = 1, a__2[0] = "{";
37239 	    i__7 = numclef_(clefq + iv, (ftnlen)1) + 48;
37240 	    chax_(ch__1, (ftnlen)1, &i__7);
37241 	    i__2[1] = 1, a__2[1] = ch__1;
37242 	    s_cat(fmtq, a__2, i__2, &c__2, (ftnlen)24);
37243 	    lfmtq = 2;
37244 	    i__7 = nstaves;
37245 	    for (k = 2; k <= i__7; ++k) {
37246 		++iv;
37247 /* Writing concatenation */
37248 		i__2[0] = lfmtq, a__2[0] = fmtq;
37249 		i__8 = numclef_(clefq + iv, (ftnlen)1) + 48;
37250 		chax_(ch__1, (ftnlen)1, &i__8);
37251 		i__2[1] = 1, a__2[1] = ch__1;
37252 		s_cat(fmtq, a__2, i__2, &c__2, (ftnlen)24);
37253 		++lfmtq;
37254 /* L2: */
37255 	    }
37256 /* Writing concatenation */
37257 	    i__2[0] = lfmtq, a__2[0] = fmtq;
37258 	    i__2[1] = 1, a__2[1] = "}";
37259 	    s_cat(fmtq, a__2, i__2, &c__2, (ftnlen)24);
37260 	    ++lfmtq;
37261 	}
37262 	if (iinst < 10) {
37263 	    s_wsfe(&io___1711);
37264 /* Writing concatenation */
37265 	    i__3[0] = 1, a__3[0] = sq;
37266 	    i__3[1] = 7, a__3[1] = "setclef";
37267 	    i__7 = iinst + 48;
37268 	    chax_(ch__1, (ftnlen)1, &i__7);
37269 	    i__3[2] = 1, a__3[2] = ch__1;
37270 	    i__3[3] = lfmtq, a__3[3] = fmtq;
37271 	    s_cat(ch__22, a__3, i__3, &c__4, (ftnlen)33);
37272 	    do_fio(&c__1, ch__22, lfmtq + 9);
37273 	    e_wsfe();
37274 	} else {
37275 	    s_wsfe(&io___1712);
37276 /* Writing concatenation */
37277 	    i__2[0] = 1, a__2[0] = sq;
37278 	    i__2[1] = 8, a__2[1] = "setclef{";
37279 	    s_cat(ch__12, a__2, i__2, &c__2, (ftnlen)9);
37280 	    do_fio(&c__1, ch__12, (ftnlen)9);
37281 	    do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
37282 /* Writing concatenation */
37283 	    i__6[0] = 1, a__5[0] = "}";
37284 	    i__6[1] = lfmtq, a__5[1] = fmtq;
37285 	    s_cat(ch__23, a__5, i__6, &c__2, (ftnlen)25);
37286 	    do_fio(&c__1, ch__23, lfmtq + 1);
37287 	    e_wsfe();
37288 	}
37289 	for (lname = 79; lname >= 2; --lname) {
37290 	    if (*(unsigned char *)&comtop_1.inameq[(iinst - 1) * 79 + (lname
37291 		    - 1)] != ' ') {
37292 		goto L4;
37293 	    }
37294 /* L3: */
37295 	}
37296 L4:
37297 	comtop_1.lnam[iinst - 1] = lname;
37298 	if (iinst < 10) {
37299 	    s_wsfe(&io___1714);
37300 /* Writing concatenation */
37301 	    i__2[0] = 1, a__2[0] = sq;
37302 	    i__2[1] = 7, a__2[1] = "setname";
37303 	    s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
37304 	    do_fio(&c__1, ch__10, (ftnlen)8);
37305 	    do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
37306 /* Writing concatenation */
37307 	    i__1[0] = 1, a__1[0] = "{";
37308 	    i__1[1] = lname, a__1[1] = comtop_1.inameq + (iinst - 1) * 79;
37309 	    i__1[2] = 1, a__1[2] = "}";
37310 	    s_cat(ch__24, a__1, i__1, &c__3, (ftnlen)81);
37311 	    do_fio(&c__1, ch__24, lname + 2);
37312 	    e_wsfe();
37313 	} else {
37314 	    s_wsfe(&io___1715);
37315 /* Writing concatenation */
37316 	    i__2[0] = 1, a__2[0] = sq;
37317 	    i__2[1] = 8, a__2[1] = "setname{";
37318 	    s_cat(ch__12, a__2, i__2, &c__2, (ftnlen)9);
37319 	    do_fio(&c__1, ch__12, (ftnlen)9);
37320 	    do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
37321 /* Writing concatenation */
37322 	    i__1[0] = 2, a__1[0] = "}{";
37323 	    i__1[1] = lname, a__1[1] = comtop_1.inameq + (iinst - 1) * 79;
37324 	    i__1[2] = 1, a__1[2] = "}";
37325 	    s_cat(ch__25, a__1, i__1, &c__3, (ftnlen)82);
37326 	    do_fio(&c__1, ch__25, lname + 3);
37327 	    e_wsfe();
37328 	}
37329 /* L1: */
37330     }
37331     s_wsfe(&io___1716);
37332 /* Writing concatenation */
37333     i__2[0] = 1, a__2[0] = sq;
37334     i__2[1] = 17, a__2[1] = "generalsignature{";
37335     s_cat(ch__26, a__2, i__2, &c__2, (ftnlen)18);
37336     do_fio(&c__1, ch__26, (ftnlen)18);
37337     do_fio(&c__1, (char *)&comtop_1.isig, (ftnlen)sizeof(integer));
37338     do_fio(&c__1, "}%", (ftnlen)2);
37339     e_wsfe();
37340     if (cominsttrans_1.earlytranson) {
37341 	writesetsign_(&cominsttrans_1.ninsttrans, cominsttrans_1.iinsttrans,
37342 		cominsttrans_1.itranskey, &cominsttrans_1.earlytranson);
37343     }
37344     wgmeter_(mtrnmp, mtrdnp);
37345     r__1 = comtop_1.fracindent * comtop_1.widthpt;
37346     ipi = i_nint(&r__1);
37347     if (ipi < 10) {
37348 	s_wsfe(&io___1718);
37349 /* Writing concatenation */
37350 	i__2[0] = 1, a__2[0] = sq;
37351 	i__2[1] = 10, a__2[1] = "parindent ";
37352 	s_cat(ch__14, a__2, i__2, &c__2, (ftnlen)11);
37353 	do_fio(&c__1, ch__14, (ftnlen)11);
37354 	do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(integer));
37355 	do_fio(&c__1, "pt", (ftnlen)2);
37356 	e_wsfe();
37357     } else if (ipi < 100) {
37358 	s_wsfe(&io___1719);
37359 /* Writing concatenation */
37360 	i__2[0] = 1, a__2[0] = sq;
37361 	i__2[1] = 10, a__2[1] = "parindent ";
37362 	s_cat(ch__14, a__2, i__2, &c__2, (ftnlen)11);
37363 	do_fio(&c__1, ch__14, (ftnlen)11);
37364 	do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(integer));
37365 	do_fio(&c__1, "pt", (ftnlen)2);
37366 	e_wsfe();
37367     } else {
37368 	s_wsfe(&io___1720);
37369 /* Writing concatenation */
37370 	i__2[0] = 1, a__2[0] = sq;
37371 	i__2[1] = 10, a__2[1] = "parindent ";
37372 	s_cat(ch__14, a__2, i__2, &c__2, (ftnlen)11);
37373 	do_fio(&c__1, ch__14, (ftnlen)11);
37374 	do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(integer));
37375 	do_fio(&c__1, "pt", (ftnlen)2);
37376 	e_wsfe();
37377     }
37378     s_wsfe(&io___1721);
37379 /* Writing concatenation */
37380     i__9[0] = 1, a__6[0] = sq;
37381     i__9[1] = 11, a__6[1] = "elemskip1pt";
37382     i__9[2] = 1, a__6[2] = sq;
37383     i__9[3] = 13, a__6[3] = "afterruleskip";
37384     i__9[4] = 5, a__6[4] = fbarq;
37385     i__9[5] = 2, a__6[5] = "pt";
37386     i__9[6] = 1, a__6[6] = sq;
37387     i__9[7] = 17, a__6[7] = "beforeruleskip0pt";
37388     i__9[8] = 1, a__6[8] = sq;
37389     i__9[9] = 5, a__6[9] = "relax";
37390     s_cat(ch__27, a__6, i__9, &c__10, (ftnlen)57);
37391     do_fio(&c__1, ch__27, (ftnlen)57);
37392     e_wsfe();
37393     if (! (*vshrink)) {
37394 	if (*xinstf1 < 9.95f) {
37395 	    s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10);
37396 	} else {
37397 	    s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10);
37398 	}
37399 	s_wsfe(&io___1722);
37400 /* Writing concatenation */
37401 	i__4[0] = 1, a__4[0] = sq;
37402 	i__4[1] = 15, a__4[1] = "stafftopmarg0pt";
37403 	i__4[2] = 1, a__4[2] = sq;
37404 	i__4[3] = 15, a__4[3] = "staffbotmarg0pt";
37405 	i__4[4] = 1, a__4[4] = sq;
37406 	i__4[5] = 11, a__4[5] = "interstaff{";
37407 	s_cat(ch__28, a__4, i__4, &c__6, (ftnlen)44);
37408 	do_fio(&c__1, ch__28, (ftnlen)44);
37409 	do_fio(&c__1, (char *)&(*xinstf1), (ftnlen)sizeof(real));
37410 /* Writing concatenation */
37411 	i__1[0] = 1, a__1[0] = "}";
37412 	i__1[1] = 1, a__1[1] = sq;
37413 	i__1[2] = 5, a__1[2] = "relax";
37414 	s_cat(ch__16, a__1, i__1, &c__3, (ftnlen)7);
37415 	do_fio(&c__1, ch__16, (ftnlen)7);
37416 	e_wsfe();
37417     } else {
37418 	s_wsfe(&io___1723);
37419 /* Writing concatenation */
37420 	i__9[0] = 1, a__6[0] = sq;
37421 	i__9[1] = 15, a__6[1] = "stafftopmarg0pt";
37422 	i__9[2] = 1, a__6[2] = sq;
37423 	i__9[3] = 13, a__6[3] = "staffbotmarg5";
37424 	i__9[4] = 1, a__6[4] = sq;
37425 	i__9[5] = 10, a__6[5] = "Interligne";
37426 	i__9[6] = 1, a__6[6] = sq;
37427 	i__9[7] = 14, a__6[7] = "interstaff{10}";
37428 	i__9[8] = 1, a__6[8] = sq;
37429 	i__9[9] = 5, a__6[9] = "relax";
37430 	s_cat(ch__29, a__6, i__9, &c__10, (ftnlen)62);
37431 	do_fio(&c__1, ch__29, (ftnlen)62);
37432 	e_wsfe();
37433     }
37434     if (*nv == 1) {
37435 	s_wsfe(&io___1724);
37436 /* Writing concatenation */
37437 	i__2[0] = 1, a__2[0] = sq;
37438 	i__2[1] = 11, a__2[1] = "nostartrule";
37439 	s_cat(ch__11, a__2, i__2, &c__2, (ftnlen)12);
37440 	do_fio(&c__1, ch__11, (ftnlen)12);
37441 	e_wsfe();
37442     }
37443     s_wsfe(&io___1725);
37444 /* Writing concatenation */
37445     i__3[0] = 1, a__3[0] = sq;
37446     i__3[1] = 8, a__3[1] = "readmod{";
37447     i__3[2] = *lbase, a__3[2] = basenameq;
37448     i__3[3] = 1, a__3[3] = "}";
37449     s_cat(ch__30, a__3, i__3, &c__4, (ftnlen)54);
37450     do_fio(&c__1, ch__30, *lbase + 10);
37451     e_wsfe();
37452     if (comnvst_1.cstuplet) {
37453 	s_wsfe(&io___1726);
37454 /* Writing concatenation */
37455 	i__10[0] = 1, a__7[0] = sq;
37456 	i__10[1] = 12, a__7[1] = "input tuplet";
37457 	i__10[2] = 1, a__7[2] = sq;
37458 	i__10[3] = 3, a__7[3] = "def";
37459 	i__10[4] = 1, a__7[4] = sq;
37460 	i__10[5] = 12, a__7[5] = "xnumt#1#2#3{";
37461 	i__10[6] = 1, a__7[6] = sq;
37462 	i__10[7] = 16, a__7[7] = "zcharnote{#2}{~}";
37463 	i__10[8] = 1, a__7[8] = sq;
37464 	i__10[9] = 3, a__7[9] = "def";
37465 	i__10[10] = 1, a__7[10] = sq;
37466 	i__10[11] = 10, a__7[11] = "tuplettxt{";
37467 	i__10[12] = 1, a__7[12] = sq;
37468 	i__10[13] = 9, a__7[13] = "smalltype";
37469 	i__10[14] = 1, a__7[14] = sq;
37470 	i__10[15] = 6, a__7[15] = "it{#3}";
37471 	i__10[16] = 1, a__7[16] = sq;
37472 	i__10[17] = 1, a__7[17] = "/";
37473 	i__10[18] = 1, a__7[18] = sq;
37474 	i__10[19] = 4, a__7[19] = "/}}%";
37475 	s_cat(ch__31, a__7, i__10, &c__20, (ftnlen)86);
37476 	do_fio(&c__1, ch__31, (ftnlen)86);
37477 	e_wsfe();
37478 	s_wsfe(&io___1727);
37479 /* Writing concatenation */
37480 	i__11[0] = 1, a__8[0] = sq;
37481 	i__11[1] = 3, a__8[1] = "let";
37482 	i__11[2] = 1, a__8[2] = sq;
37483 	i__11[3] = 5, a__8[3] = "ovbkt";
37484 	i__11[4] = 1, a__8[4] = sq;
37485 	i__11[5] = 8, a__8[5] = "uptuplet";
37486 	i__11[6] = 1, a__8[6] = sq;
37487 	i__11[7] = 3, a__8[7] = "let";
37488 	i__11[8] = 1, a__8[8] = sq;
37489 	i__11[9] = 5, a__8[9] = "unbkt";
37490 	i__11[10] = 1, a__8[10] = sq;
37491 	i__11[11] = 11, a__8[11] = "downtuplet%";
37492 	s_cat(ch__32, a__8, i__11, &c__12, (ftnlen)41);
37493 	do_fio(&c__1, ch__32, (ftnlen)41);
37494 	e_wsfe();
37495     }
37496     s_wsfe(&io___1728);
37497 /* Writing concatenation */
37498     i__12[0] = 1, a__9[0] = sq;
37499     i__12[1] = 11, a__9[1] = "startmuflex";
37500     i__12[2] = 1, a__9[2] = sq;
37501     i__12[3] = 10, a__9[3] = "startpiece";
37502     i__12[4] = 1, a__9[4] = sq;
37503     i__12[5] = 8, a__9[5] = "addspace";
37504     i__12[6] = 1, a__9[6] = sq;
37505     i__12[7] = 14, a__9[7] = "afterruleskip%";
37506     s_cat(ch__33, a__9, i__12, &c__8, (ftnlen)47);
37507     do_fio(&c__1, ch__33, (ftnlen)47);
37508     e_wsfe();
37509     return 0;
37510 } /* topfile_ */
37511 
udfq_(char * ret_val,ftnlen ret_val_len,integer * nolev,integer * ncm)37512 /* Character */ VOID udfq_(char *ret_val, ftnlen ret_val_len, integer *nolev,
37513 	integer *ncm)
37514 {
37515     static integer ntest;
37516 
37517 
37518 /*  Slur directions */
37519 
37520     ntest = *nolev - *ncm;
37521     if (ntest < 0 || ntest == 0 && combc_1.bcspec && *ncm == 23) {
37522 	*(unsigned char *)ret_val = 'd';
37523     } else {
37524 	*(unsigned char *)ret_val = 'u';
37525     }
37526     return ;
37527 } /* udfq_ */
37528 
udqq_(char * ret_val,ftnlen ret_val_len,integer * nole,integer * ncm,integer * isl,integer * nvmx,integer * ivx,integer * nv)37529 /* Character */ VOID udqq_(char *ret_val, ftnlen ret_val_len, integer *nole,
37530 	integer *ncm, integer *isl, integer *nvmx, integer *ivx, integer *nv)
37531 {
37532     /* System generated locals */
37533     real r__1;
37534     char ch__2[1];
37535 
37536     /* Local variables */
37537     extern /* Character */ VOID ulfq_(char *, ftnlen, real *, integer *);
37538     static char udqqq[1];
37539 
37540 
37541 /*  Stem direction for single notes */
37542 
37543     if (bit_test(*isl,30)) {
37544 
37545 /*  Absolute override */
37546 
37547 	if (bit_test(*isl,17)) {
37548 	    *(unsigned char *)udqqq = 'u';
37549 	} else {
37550 	    *(unsigned char *)udqqq = 'l';
37551 	}
37552     } else if (*nvmx == 1) {
37553 
37554 /*  Single voice per staff, default */
37555 
37556 	r__1 = *nole * 1.f;
37557 	ulfq_(ch__2, (ftnlen)1, &r__1, ncm);
37558 	*(unsigned char *)udqqq = *(unsigned char *)&ch__2[0];
37559     } else {
37560 
37561 /*  Multi-voice per staff, 1st is lower, 2nd upper */
37562 
37563 	if (*ivx <= *nv) {
37564 	    *(unsigned char *)udqqq = 'l';
37565 	} else {
37566 	    *(unsigned char *)udqqq = 'u';
37567 	}
37568     }
37569     *(unsigned char *)ret_val = *(unsigned char *)udqqq;
37570     return ;
37571 } /* udqq_ */
37572 
ulfq_(char * ret_val,ftnlen ret_val_len,real * xnolev,integer * ncm)37573 /* Character */ VOID ulfq_(char *ret_val, ftnlen ret_val_len, real *xnolev,
37574 	integer *ncm)
37575 {
37576     static real test;
37577 
37578 
37579 /*  Stem directions */
37580 
37581     test = *xnolev - *ncm;
37582     if (test < -.001f || test < .001f && combc_1.bcspec && *ncm == 23) {
37583 	*(unsigned char *)ret_val = 'u';
37584     } else {
37585 	*(unsigned char *)ret_val = 'l';
37586     }
37587     return ;
37588 } /* ulfq_ */
37589 
upcaseq_(char * ret_val,ftnlen ret_val_len,char * chq,ftnlen chq_len)37590 /* Character */ VOID upcaseq_(char *ret_val, ftnlen ret_val_len, char *chq,
37591 	ftnlen chq_len)
37592 {
37593     /* System generated locals */
37594     address a__1[2];
37595     integer i__1, i__2[2];
37596     char ch__2[1], ch__3[53];
37597 
37598     /* Builtin functions */
37599     integer s_wsle(cilist *);
37600     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
37601     integer do_lio(integer *, integer *, char *, ftnlen), e_wsle(void);
37602     /* Subroutine */ int s_stop(char *, ftnlen);
37603 
37604     /* Local variables */
37605     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
37606 
37607     /* Fortran I/O blocks */
37608     static cilist io___1732 = { 0, 6, 0, 0, 0 };
37609 
37610 
37611     if (*(unsigned char *)chq >= 61 && *(unsigned char *)chq < 122) {
37612 	i__1 = *(unsigned char *)chq - 32;
37613 	chax_(ch__2, (ftnlen)1, &i__1);
37614 	*(unsigned char *)ret_val = *(unsigned char *)&ch__2[0];
37615     } else {
37616 	*(unsigned char *)ret_val = *(unsigned char *)chq;
37617 	s_wsle(&io___1732);
37618 /* Writing concatenation */
37619 	i__2[0] = 52, a__1[0] = "Warning, upcaseq was called with improper a"
37620 		"rgument: ";
37621 	i__2[1] = 1, a__1[1] = chq;
37622 	s_cat(ch__3, a__1, i__2, &c__2, (ftnlen)53);
37623 	do_lio(&c__9, &c__1, ch__3, (ftnlen)53);
37624 	e_wsle();
37625 	s_stop("", (ftnlen)0);
37626     }
37627     return ;
37628 } /* upcaseq_ */
37629 
wgmeter_(integer * mtrnmp,integer * mtrdnp)37630 /* Subroutine */ int wgmeter_(integer *mtrnmp, integer *mtrdnp)
37631 {
37632     /* System generated locals */
37633     address a__1[4];
37634     integer i__1[4], i__2;
37635     char ch__1[1], ch__2[25], ch__3[26], ch__4[21], ch__5[24];
37636 
37637     /* Builtin functions */
37638     integer s_wsfe(cilist *);
37639     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
37640     integer do_fio(integer *, char *, ftnlen), e_wsfe(void);
37641 
37642     /* Local variables */
37643     static char sq[1];
37644     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
37645 
37646     /* Fortran I/O blocks */
37647     static cilist io___1734 = { 0, 11, 0, "(a25,i1,a2,i1,a3)", 0 };
37648     static cilist io___1735 = { 0, 11, 0, "(a25,i1,a2,i2,a3)", 0 };
37649     static cilist io___1736 = { 0, 11, 0, "(a25,i2,a2,i1,a3)", 0 };
37650     static cilist io___1737 = { 0, 11, 0, "(a25,i2,a2,i2,a3)", 0 };
37651     static cilist io___1738 = { 0, 11, 0, "(a26,i1,a2,i1,a3)", 0 };
37652     static cilist io___1739 = { 0, 11, 0, "(a21,i1,a2)", 0 };
37653     static cilist io___1740 = { 0, 11, 0, "(a)", 0 };
37654     static cilist io___1741 = { 0, 11, 0, "(a)", 0 };
37655     static cilist io___1742 = { 0, 11, 0, "(a)", 0 };
37656 
37657 
37658 
37659 /*  Writes meter stuff to file 11, so only called if islast=.true. */
37660 
37661     if (*mtrdnp == 0) {
37662 	return 0;
37663     }
37664     chax_(ch__1, (ftnlen)1, &c__92);
37665     *(unsigned char *)sq = *(unsigned char *)&ch__1[0];
37666     if (*mtrnmp > 0 && *mtrnmp <= 9) {
37667 	if (*mtrdnp < 10) {
37668 	    s_wsfe(&io___1734);
37669 /* Writing concatenation */
37670 	    i__1[0] = 1, a__1[0] = sq;
37671 	    i__1[1] = 13, a__1[1] = "generalmeter{";
37672 	    i__1[2] = 1, a__1[2] = sq;
37673 	    i__1[3] = 10, a__1[3] = "meterfrac{";
37674 	    s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25);
37675 	    do_fio(&c__1, ch__2, (ftnlen)25);
37676 	    do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer));
37677 	    do_fio(&c__1, "}{", (ftnlen)2);
37678 	    do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer));
37679 	    do_fio(&c__1, "}}%", (ftnlen)3);
37680 	    e_wsfe();
37681 	} else {
37682 	    s_wsfe(&io___1735);
37683 /* Writing concatenation */
37684 	    i__1[0] = 1, a__1[0] = sq;
37685 	    i__1[1] = 13, a__1[1] = "generalmeter{";
37686 	    i__1[2] = 1, a__1[2] = sq;
37687 	    i__1[3] = 10, a__1[3] = "meterfrac{";
37688 	    s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25);
37689 	    do_fio(&c__1, ch__2, (ftnlen)25);
37690 	    do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer));
37691 	    do_fio(&c__1, "}{", (ftnlen)2);
37692 	    do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer));
37693 	    do_fio(&c__1, "}}%", (ftnlen)3);
37694 	    e_wsfe();
37695 	}
37696     } else if (*mtrnmp >= 10) {
37697 	if (*mtrdnp < 10) {
37698 	    s_wsfe(&io___1736);
37699 /* Writing concatenation */
37700 	    i__1[0] = 1, a__1[0] = sq;
37701 	    i__1[1] = 13, a__1[1] = "generalmeter{";
37702 	    i__1[2] = 1, a__1[2] = sq;
37703 	    i__1[3] = 10, a__1[3] = "meterfrac{";
37704 	    s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25);
37705 	    do_fio(&c__1, ch__2, (ftnlen)25);
37706 	    do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer));
37707 	    do_fio(&c__1, "}{", (ftnlen)2);
37708 	    do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer));
37709 	    do_fio(&c__1, "}}%", (ftnlen)3);
37710 	    e_wsfe();
37711 	} else {
37712 	    s_wsfe(&io___1737);
37713 /* Writing concatenation */
37714 	    i__1[0] = 1, a__1[0] = sq;
37715 	    i__1[1] = 13, a__1[1] = "generalmeter{";
37716 	    i__1[2] = 1, a__1[2] = sq;
37717 	    i__1[3] = 10, a__1[3] = "meterfrac{";
37718 	    s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25);
37719 	    do_fio(&c__1, ch__2, (ftnlen)25);
37720 	    do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer));
37721 	    do_fio(&c__1, "}{", (ftnlen)2);
37722 	    do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer));
37723 	    do_fio(&c__1, "}}%", (ftnlen)3);
37724 	    e_wsfe();
37725 	}
37726     } else if (*mtrnmp < 0) {
37727 	s_wsfe(&io___1738);
37728 /* Writing concatenation */
37729 	i__1[0] = 1, a__1[0] = sq;
37730 	i__1[1] = 13, a__1[1] = "generalmeter{";
37731 	i__1[2] = 1, a__1[2] = sq;
37732 	i__1[3] = 11, a__1[3] = "meterfracS{";
37733 	s_cat(ch__3, a__1, i__1, &c__4, (ftnlen)26);
37734 	do_fio(&c__1, ch__3, (ftnlen)26);
37735 	i__2 = -(*mtrnmp);
37736 	do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
37737 	do_fio(&c__1, "}{", (ftnlen)2);
37738 	do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer));
37739 	do_fio(&c__1, "}}%", (ftnlen)3);
37740 	e_wsfe();
37741     } else if (*mtrdnp <= 4) {
37742 	s_wsfe(&io___1739);
37743 /* Writing concatenation */
37744 	i__1[0] = 1, a__1[0] = sq;
37745 	i__1[1] = 13, a__1[1] = "generalmeter{";
37746 	i__1[2] = 1, a__1[2] = sq;
37747 	i__1[3] = 6, a__1[3] = "meterN";
37748 	s_cat(ch__4, a__1, i__1, &c__4, (ftnlen)21);
37749 	do_fio(&c__1, ch__4, (ftnlen)21);
37750 	do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer));
37751 	do_fio(&c__1, "}%", (ftnlen)2);
37752 	e_wsfe();
37753     } else if (*mtrdnp == 5) {
37754 	s_wsfe(&io___1740);
37755 /* Writing concatenation */
37756 	i__1[0] = 1, a__1[0] = sq;
37757 	i__1[1] = 12, a__1[1] = "generalmeter";
37758 	i__1[2] = 1, a__1[2] = sq;
37759 	i__1[3] = 10, a__1[3] = "allabreve%";
37760 	s_cat(ch__5, a__1, i__1, &c__4, (ftnlen)24);
37761 	do_fio(&c__1, ch__5, (ftnlen)24);
37762 	e_wsfe();
37763     } else if (*mtrdnp == 6) {
37764 	s_wsfe(&io___1741);
37765 /* Writing concatenation */
37766 	i__1[0] = 1, a__1[0] = sq;
37767 	i__1[1] = 12, a__1[1] = "generalmeter";
37768 	i__1[2] = 1, a__1[2] = sq;
37769 	i__1[3] = 7, a__1[3] = "meterC%";
37770 	s_cat(ch__4, a__1, i__1, &c__4, (ftnlen)21);
37771 	do_fio(&c__1, ch__4, (ftnlen)21);
37772 	e_wsfe();
37773     } else if (*mtrdnp == 7) {
37774 	s_wsfe(&io___1742);
37775 /* Writing concatenation */
37776 	i__1[0] = 1, a__1[0] = sq;
37777 	i__1[1] = 12, a__1[1] = "generalmeter";
37778 	i__1[2] = 1, a__1[2] = sq;
37779 	i__1[3] = 10, a__1[3] = "meterIIIS%";
37780 	s_cat(ch__5, a__1, i__1, &c__4, (ftnlen)24);
37781 	do_fio(&c__1, ch__5, (ftnlen)24);
37782 	e_wsfe();
37783     }
37784     return 0;
37785 } /* wgmeter_ */
37786 
writemidi_(char * jobname,integer * ljob,ftnlen jobname_len)37787 /* Subroutine */ int writemidi_(char *jobname, integer *ljob, ftnlen
37788 	jobname_len)
37789 {
37790     /* Initialized data */
37791 
37792     static shortint icmm[16] = { 0,1,2,3,4,5,6,7,8,10,11,12,13,14,15,16 };
37793 
37794     /* System generated locals */
37795     address a__1[4], a__2[7], a__3[3], a__4[2], a__5[12];
37796     integer i__1[4], i__2, i__3[7], i__4[3], i__5[2], i__6, i__7[12], i__8,
37797 	    i__9, i__10, i__11, i__12;
37798     char ch__1[14], ch__2[1], ch__3[12], ch__4[1], ch__5[1], ch__6[46], ch__7[
37799 	    27], ch__8[29], ch__9[15], ch__10[1], ch__11[4], ch__12[81],
37800 	    ch__13[25];
37801     cllist cl__1;
37802 
37803     /* Builtin functions */
37804     integer s_wsfe(cilist *);
37805     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
37806     integer do_fio(integer *, char *, ftnlen), e_wsfe(void), lbit_shift(
37807 	    integer, integer), s_wsfi(icilist *), e_wsfi(void), f_clos(cllist
37808 	    *);
37809 
37810     /* Local variables */
37811     static integer i__, kv, ib0, ib1, icm;
37812     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
37813     static integer isec, mend, ndata, ibyte;
37814     static char byteq[1*4], instq[10], tempoq[10];
37815     extern /* Subroutine */ int printl_(char *, ftnlen);
37816 
37817     /* Fortran I/O blocks */
37818     static cilist io___1744 = { 0, 51, 0, "(a,$)", 0 };
37819     static cilist io___1745 = { 0, 52, 0, "(a6,10Z4)", 0 };
37820     static cilist io___1750 = { 0, 51, 0, "(a,$)", 0 };
37821     static cilist io___1751 = { 0, 52, 0, "(a6,8z4)", 0 };
37822     static cilist io___1752 = { 0, 51, 0, "(a,$)", 0 };
37823     static cilist io___1753 = { 0, 52, 0, "(a)", 0 };
37824     static cilist io___1754 = { 0, 51, 0, "(a,$)", 0 };
37825     static cilist io___1755 = { 0, 52, 0, "(a)", 0 };
37826     static cilist io___1758 = { 0, 51, 0, "(a,$)", 0 };
37827     static cilist io___1759 = { 0, 52, 0, "(z4)", 0 };
37828     static cilist io___1760 = { 0, 51, 0, "(a,$)", 0 };
37829     static cilist io___1761 = { 0, 52, 0, "(4z4)", 0 };
37830     static cilist io___1766 = { 0, 51, 0, "(a,$)", 0 };
37831     static cilist io___1767 = { 0, 52, 0, "(a4,z2,a7,11z4)", 0 };
37832     static cilist io___1768 = { 0, 51, 0, "(a,$)", 0 };
37833     static cilist io___1769 = { 0, 52, 0, "(4z4)", 0 };
37834     static cilist io___1770 = { 0, 51, 0, "(a,$)", 0 };
37835     static cilist io___1771 = { 0, 52, 0, "(a)", 0 };
37836     static icilist io___1773 = { 0, tempoq, 0, "(i2)", 10, 1 };
37837     static icilist io___1775 = { 0, instq, 0, "(i3)", 10, 1 };
37838     static cilist io___1776 = { 0, 51, 0, "(a,$)", 0 };
37839     static cilist io___1777 = { 0, 52, 0, "(z4)", 0 };
37840     static cilist io___1778 = { 0, 51, 0, "(a,$)", 0 };
37841     static cilist io___1779 = { 0, 52, 0, "(4z4)", 0 };
37842     static cilist io___1780 = { 0, 6, 0, "(1x,a12,(10i6))", 0 };
37843     static cilist io___1781 = { 0, 15, 0, "(1x,a12,(10i6))", 0 };
37844 
37845 
37846 
37847 /*  Used to be icmm(0:nm); did midi fail when nv>16? */
37848 
37849 
37850 /*  These are not consecutive because channel 9 is reserved for percussion. */
37851 
37852 
37853 /*  Write Header */
37854 
37855     s_wsfe(&io___1744);
37856 /* Writing concatenation */
37857     i__1[0] = 11, a__1[0] = "MThd\000\000\000\006\000\001\000";
37858     *(unsigned char *)&ch__2[0] = commidi_1.numchan + 1;
37859     i__1[1] = 1, a__1[1] = ch__2;
37860     i__1[2] = 1, a__1[2] = "\000";
37861     i__1[3] = 1, a__1[3] = "\360";
37862     s_cat(ch__1, a__1, i__1, &c__4, (ftnlen)14);
37863     do_fio(&c__1, ch__1, (ftnlen)14);
37864     e_wsfe();
37865     if (commidi_1.debugmidi) {
37866 	s_wsfe(&io___1745);
37867 	do_fio(&c__1, "\"MThd\"", (ftnlen)6);
37868 	do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
37869 	do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
37870 	do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
37871 	do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
37872 	do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
37873 	do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
37874 	do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
37875 	i__2 = commidi_1.numchan + 1;
37876 	do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
37877 	do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
37878 	do_fio(&c__1, (char *)&c__240, (ftnlen)sizeof(integer));
37879 	e_wsfe();
37880     }
37881 
37882 /*  Write the "conductor" track, for keys, meter, and tempos */
37883 /*  Get the number of bytes in the conductor event stream */
37884 
37885     ndata = commidi_1.imidi[commidi_1.numchan] + 1 - commmac_1.msecstrt[
37886 	    commidi_1.numchan + commmac_1.nmidsec * 25 - 25];
37887     i__2 = commmac_1.nmidsec - 1;
37888     for (isec = 1; isec <= i__2; ++isec) {
37889 	ndata = ndata + 1 + commmac_1.msecend[commidi_1.numchan + isec * 25 -
37890 		25] - commmac_1.msecstrt[commidi_1.numchan + isec * 25 - 25];
37891 /* L15: */
37892     }
37893 /*      ib1 = (4+ljob+26+ndata+4)/256 */
37894 /*      ib0 = 4+ljob+26+ndata+4-256*ib1 */
37895     ib1 = (*ljob + 31 + ndata + 4) / 256;
37896     ib0 = *ljob + 31 + ndata + 4 - (ib1 << 8);
37897     s_wsfe(&io___1750);
37898 /* Writing concatenation */
37899     i__3[0] = 6, a__2[0] = "MTrk\000\000";
37900     *(unsigned char *)&ch__2[0] = ib1;
37901     i__3[1] = 1, a__2[1] = ch__2;
37902     *(unsigned char *)&ch__4[0] = ib0;
37903     i__3[2] = 1, a__2[2] = ch__4;
37904     i__3[3] = 1, a__2[3] = "\000";
37905     i__3[4] = 1, a__2[4] = "\377";
37906     i__3[5] = 1, a__2[5] = "\001";
37907     *(unsigned char *)&ch__5[0] = *ljob + 27;
37908     i__3[6] = 1, a__2[6] = ch__5;
37909     s_cat(ch__3, a__2, i__3, &c__7, (ftnlen)12);
37910     do_fio(&c__1, ch__3, (ftnlen)12);
37911     e_wsfe();
37912 
37913 /*  Text header */
37914 
37915 /*     *  //char(0)//char(255)//char(1)//char(ljob+26) */
37916     if (commidi_1.debugmidi) {
37917 	s_wsfe(&io___1751);
37918 	do_fio(&c__1, "\"MTrk\"", (ftnlen)6);
37919 	do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
37920 	do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
37921 	do_fio(&c__1, (char *)&ib1, (ftnlen)sizeof(integer));
37922 	do_fio(&c__1, (char *)&ib0, (ftnlen)sizeof(integer));
37923 	do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
37924 	do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer));
37925 	do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
37926 	i__2 = *ljob + 27;
37927 	do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
37928 	e_wsfe();
37929     }
37930     s_wsfe(&io___1752);
37931     do_fio(&c__1, jobname, (*ljob));
37932     e_wsfe();
37933     if (commidi_1.debugmidi) {
37934 	s_wsfe(&io___1753);
37935 /* Writing concatenation */
37936 	i__4[0] = 1, a__3[0] = "\"";
37937 	i__4[1] = *ljob, a__3[1] = jobname;
37938 	i__4[2] = 1, a__3[2] = "\"";
37939 	s_cat(ch__6, a__3, i__4, &c__3, (ftnlen)46);
37940 	do_fio(&c__1, ch__6, *ljob + 2);
37941 	e_wsfe();
37942     }
37943 
37944 /*  (separate writes are needed to defeat compiler BUG!!!) */
37945 
37946 /*      write(51,'(a,$)')'.mid, produced by PMX 2.30' */
37947     s_wsfe(&io___1754);
37948 /* Writing concatenation */
37949     i__5[0] = 22, a__4[0] = ".mid, produced by PMX ";
37950     i__5[1] = 5, a__4[1] = comver_1.versionc;
37951     s_cat(ch__7, a__4, i__5, &c__2, (ftnlen)27);
37952     do_fio(&c__1, ch__7, (ftnlen)27);
37953     e_wsfe();
37954     if (commidi_1.debugmidi) {
37955 	s_wsfe(&io___1755);
37956 /* Writing concatenation */
37957 	i__4[0] = 23, a__3[0] = "\".mid, produced by PMX ";
37958 	i__4[1] = 5, a__3[1] = comver_1.versionc;
37959 	i__4[2] = 1, a__3[2] = "\"";
37960 	s_cat(ch__8, a__3, i__4, &c__3, (ftnlen)29);
37961 	do_fio(&c__1, ch__8, (ftnlen)29);
37962 	e_wsfe();
37963     }
37964 
37965 /*  Conductor event data: Loop over sections. */
37966 
37967     i__2 = commmac_1.nmidsec;
37968     for (isec = 1; isec <= i__2; ++isec) {
37969 	if (isec < commmac_1.nmidsec) {
37970 	    mend = commmac_1.msecend[commidi_1.numchan + isec * 25 - 25];
37971 	} else {
37972 	    mend = commidi_1.imidi[commidi_1.numchan];
37973 	}
37974 	i__6 = mend;
37975 	for (i__ = commmac_1.msecstrt[commidi_1.numchan + isec * 25 - 25];
37976 		i__ <= i__6; ++i__) {
37977 	    s_wsfe(&io___1758);
37978 	    *(unsigned char *)&ch__2[0] = (char) commidi_1.mmidi[
37979 		    commidi_1.numchan + i__ * 25 - 25];
37980 	    do_fio(&c__1, ch__2, (ftnlen)1);
37981 	    e_wsfe();
37982 	    if (commidi_1.debugmidi) {
37983 		s_wsfe(&io___1759);
37984 		do_fio(&c__1, (char *)&commidi_1.mmidi[commidi_1.numchan +
37985 			i__ * 25 - 25], (ftnlen)sizeof(shortint));
37986 		e_wsfe();
37987 	    }
37988 /* L17: */
37989 	}
37990 /* L16: */
37991     }
37992 
37993 /*  And close out the time sig / tempo track. */
37994 
37995     s_wsfe(&io___1760);
37996     do_fio(&c__1, "\000\377/\000", (ftnlen)4);
37997     e_wsfe();
37998     if (commidi_1.debugmidi) {
37999 	s_wsfe(&io___1761);
38000 	do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
38001 	do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer));
38002 	do_fio(&c__1, (char *)&c__47, (ftnlen)sizeof(integer));
38003 	do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
38004 	e_wsfe();
38005     }
38006 
38007 /*  Loop over track for each voice:  The following sets up iv. */
38008 
38009     all_1.iv = all_1.nv;
38010     if (commidi_1.twoline[all_1.nv - 1]) {
38011 	kv = 2;
38012     } else {
38013 	kv = 1;
38014     }
38015 
38016 /* Moved to pmxab to allow midivel, bal, tran as functions of instrument */
38017 /*   rather than staff (iv) */
38018 /* c */
38019 /* c  Count up staves(iv,nv) vs instruments.  Store instr# for iv in iinsiv(iv) */
38020 /* c */
38021 /*      nstaves = 0 */
38022 /*      ivt = 0 */
38023 /*      do 12 iinst = 1 , nm */
38024 /*        nstaves = nstaves+nsperi(iinst) */
38025 /*        do 13 ivtt = 1 , nsperi(iinst) */
38026 /*          ivt = ivt+1 */
38027 /*          iinsiv(ivt) = iinst */
38028 /* 13      continue */
38029 /*        if (nstaves .eq. nv) go to 14 */
38030 /* 12    continue */
38031 /*      print*,'Screwup!' */
38032 /*      call stop1() */
38033 /* 14    continue */
38034 
38035     i__2 = commidi_1.numchan - 1;
38036     for (icm = 0; icm <= i__2; ++icm) {
38037 
38038 /*  Get the number of bytes in the data stream */
38039 
38040 	ndata = commidi_1.imidi[icm] + 1 - commmac_1.msecstrt[icm +
38041 		commmac_1.nmidsec * 25 - 25];
38042 	i__6 = commmac_1.nmidsec - 1;
38043 	for (isec = 1; isec <= i__6; ++isec) {
38044 	    ndata = ndata + 1 + commmac_1.msecend[icm + isec * 25 - 25] -
38045 		    commmac_1.msecstrt[icm + isec * 25 - 25];
38046 /* L11: */
38047 	}
38048 
38049 /* c  Add 3 (for instrum) plus 4 (for closing) to byte count, */
38050 /*  Add 3 for instrum, 4 for bal,  plus 4 (for closing) to byte count, */
38051 
38052 /*        ndata = ndata+7 */
38053 	ndata += 11;
38054 
38055 /*  Add 4+lnam(iinsiv(iv)) if lnam>0 , */
38056 
38057 	if (comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1] > 0) {
38058 	    ndata = ndata + 4 + comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1]
38059 		    - 1];
38060 	}
38061 
38062 /*  Separate total byte counts into 4 bytes */
38063 
38064 	for (ibyte = 1; ibyte <= 4; ++ibyte) {
38065 	    if (ndata > 0) {
38066 		*(unsigned char *)&byteq[ibyte - 1] = (char) (ndata % 256);
38067 		ndata = lbit_shift(ndata, (ftnlen)-8);
38068 	    } else {
38069 		*(unsigned char *)&byteq[ibyte - 1] = '\0';
38070 	    }
38071 /* L2: */
38072 	}
38073 
38074 /*  Now write front stuff for this track */
38075 
38076 	s_wsfe(&io___1766);
38077 /* Writing concatenation */
38078 	i__7[0] = 4, a__5[0] = "MTrk";
38079 	i__7[1] = 1, a__5[1] = byteq + 3;
38080 	i__7[2] = 1, a__5[2] = byteq + 2;
38081 	i__7[3] = 1, a__5[3] = byteq + 1;
38082 	i__7[4] = 1, a__5[4] = byteq;
38083 	i__7[5] = 1, a__5[5] = "\000";
38084 	*(unsigned char *)&ch__2[0] = icmm[icm] + 192;
38085 	i__7[6] = 1, a__5[6] = ch__2;
38086 	*(unsigned char *)&ch__4[0] = commidi_1.midinst[commvel_1.iinsiv[
38087 		all_1.iv - 1] - 1];
38088 	i__7[7] = 1, a__5[7] = ch__4;
38089 	i__7[8] = 1, a__5[8] = "\000";
38090 	*(unsigned char *)&ch__5[0] = icmm[icm] + 176;
38091 	i__7[9] = 1, a__5[9] = ch__5;
38092 	i__7[10] = 1, a__5[10] = "\n";
38093 	*(unsigned char *)&ch__10[0] = commvel_1.midbc[icm];
38094 	i__7[11] = 1, a__5[11] = ch__10;
38095 	s_cat(ch__9, a__5, i__7, &c__12, (ftnlen)15);
38096 	do_fio(&c__1, ch__9, (ftnlen)15);
38097 	e_wsfe();
38098 /*     *    //char(0)//char(12*16+icmm(icm))//char(midinst(iv)) */
38099 	if (commidi_1.debugmidi) {
38100 	    s_wsfe(&io___1767);
38101 	    do_fio(&c__1, "icm=", (ftnlen)4);
38102 	    do_fio(&c__1, (char *)&icm, (ftnlen)sizeof(integer));
38103 	    do_fio(&c__1, " \"MTrk\"", (ftnlen)7);
38104 	    i__6 = *(unsigned char *)&byteq[3];
38105 	    do_fio(&c__1, (char *)&i__6, (ftnlen)sizeof(integer));
38106 	    i__8 = *(unsigned char *)&byteq[2];
38107 	    do_fio(&c__1, (char *)&i__8, (ftnlen)sizeof(integer));
38108 	    i__9 = *(unsigned char *)&byteq[1];
38109 	    do_fio(&c__1, (char *)&i__9, (ftnlen)sizeof(integer));
38110 	    i__10 = *(unsigned char *)&byteq[0];
38111 	    do_fio(&c__1, (char *)&i__10, (ftnlen)sizeof(integer));
38112 	    do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
38113 	    i__11 = icmm[icm] + 192;
38114 	    do_fio(&c__1, (char *)&i__11, (ftnlen)sizeof(integer));
38115 	    do_fio(&c__1, (char *)&commidi_1.midinst[commvel_1.iinsiv[
38116 		    all_1.iv - 1] - 1], (ftnlen)sizeof(integer));
38117 	    do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
38118 	    i__12 = icmm[icm] + 176;
38119 	    do_fio(&c__1, (char *)&i__12, (ftnlen)sizeof(integer));
38120 	    do_fio(&c__1, (char *)&c__10, (ftnlen)sizeof(integer));
38121 	    do_fio(&c__1, (char *)&commvel_1.midbc[icm], (ftnlen)sizeof(
38122 		    integer));
38123 	    e_wsfe();
38124 	}
38125 /*     *    ichar(byteq(1)),0,12*16+icmm(icm),midinst(iv), */
38126 	if (comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1] > 0) {
38127 
38128 /*  Add instrument name as sequence name */
38129 
38130 	    s_wsfe(&io___1768);
38131 /* Writing concatenation */
38132 	    i__5[0] = 3, a__4[0] = "\000\377\003";
38133 	    *(unsigned char *)&ch__2[0] = comtop_1.lnam[commvel_1.iinsiv[
38134 		    all_1.iv - 1] - 1];
38135 	    i__5[1] = 1, a__4[1] = ch__2;
38136 	    s_cat(ch__11, a__4, i__5, &c__2, (ftnlen)4);
38137 	    do_fio(&c__1, ch__11, (ftnlen)4);
38138 	    e_wsfe();
38139 	    if (commidi_1.debugmidi) {
38140 		s_wsfe(&io___1769);
38141 		do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
38142 		do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer));
38143 		do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
38144 		do_fio(&c__1, (char *)&comtop_1.lnam[commvel_1.iinsiv[
38145 			all_1.iv - 1] - 1], (ftnlen)sizeof(integer));
38146 		e_wsfe();
38147 	    }
38148 	    s_wsfe(&io___1770);
38149 	    do_fio(&c__1, comtop_1.inameq + (commvel_1.iinsiv[all_1.iv - 1] -
38150 		    1) * 79, comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1]
38151 		    );
38152 	    e_wsfe();
38153 	    if (commidi_1.debugmidi) {
38154 		s_wsfe(&io___1771);
38155 /* Writing concatenation */
38156 		i__4[0] = 1, a__3[0] = "\"";
38157 		i__4[1] = comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1],
38158 			a__3[1] = comtop_1.inameq + (commvel_1.iinsiv[
38159 			all_1.iv - 1] - 1) * 79;
38160 		i__4[2] = 1, a__3[2] = "\"";
38161 		s_cat(ch__12, a__3, i__4, &c__3, (ftnlen)81);
38162 		do_fio(&c__1, ch__12, comtop_1.lnam[commvel_1.iinsiv[all_1.iv
38163 			- 1] - 1] + 2);
38164 		e_wsfe();
38165 	    }
38166 	}
38167 	s_wsfi(&io___1773);
38168 	do_fio(&c__1, (char *)&icm, (ftnlen)sizeof(integer));
38169 	e_wsfi();
38170 	s_wsfi(&io___1775);
38171 	do_fio(&c__1, (char *)&commidi_1.midinst[commvel_1.iinsiv[all_1.iv -
38172 		1] - 1], (ftnlen)sizeof(integer));
38173 	e_wsfi();
38174 /* Writing concatenation */
38175 	i__1[0] = 16, a__1[0] = "MIDI instrument ";
38176 	i__1[1] = 2, a__1[1] = tempoq;
38177 	i__1[2] = 4, a__1[2] = " is ";
38178 	i__1[3] = 3, a__1[3] = instq;
38179 	s_cat(ch__13, a__1, i__1, &c__4, (ftnlen)25);
38180 	printl_(ch__13, (ftnlen)25);
38181 
38182 /*  Notes: Loop over sections. */
38183 
38184 	i__6 = commmac_1.nmidsec;
38185 	for (isec = 1; isec <= i__6; ++isec) {
38186 	    if (isec < commmac_1.nmidsec) {
38187 		mend = commmac_1.msecend[icm + isec * 25 - 25];
38188 	    } else {
38189 		mend = commidi_1.imidi[icm];
38190 	    }
38191 	    i__8 = mend;
38192 	    for (i__ = commmac_1.msecstrt[icm + isec * 25 - 25]; i__ <= i__8;
38193 		    ++i__) {
38194 		s_wsfe(&io___1776);
38195 		*(unsigned char *)&ch__2[0] = (char) commidi_1.mmidi[icm +
38196 			i__ * 25 - 25];
38197 		do_fio(&c__1, ch__2, (ftnlen)1);
38198 		e_wsfe();
38199 		if (commidi_1.debugmidi) {
38200 		    s_wsfe(&io___1777);
38201 		    do_fio(&c__1, (char *)&commidi_1.mmidi[icm + i__ * 25 -
38202 			    25], (ftnlen)sizeof(shortint));
38203 		    e_wsfe();
38204 		}
38205 /* L10: */
38206 	    }
38207 /* L9: */
38208 	}
38209 
38210 /*  Closing 4 bytes */
38211 
38212 	s_wsfe(&io___1778);
38213 /* Writing concatenation */
38214 	chax_(ch__2, (ftnlen)1, &c__0);
38215 	i__1[0] = 1, a__1[0] = ch__2;
38216 	i__1[1] = 1, a__1[1] = "\377";
38217 	i__1[2] = 1, a__1[2] = "/";
38218 	i__1[3] = 1, a__1[3] = "\000";
38219 	s_cat(ch__11, a__1, i__1, &c__4, (ftnlen)4);
38220 	do_fio(&c__1, ch__11, (ftnlen)4);
38221 	e_wsfe();
38222 	if (commidi_1.debugmidi) {
38223 	    s_wsfe(&io___1779);
38224 	    do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
38225 	    do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer));
38226 	    do_fio(&c__1, (char *)&c__47, (ftnlen)sizeof(integer));
38227 	    do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
38228 	    e_wsfe();
38229 	}
38230 	if (kv == 2) {
38231 	    kv = 1;
38232 	} else if (all_1.iv == 1) {
38233 	    goto L5;
38234 	} else {
38235 	    --all_1.iv;
38236 	    if (commidi_1.twoline[all_1.iv - 1]) {
38237 		kv = 2;
38238 	    }
38239 	}
38240 L5:
38241 	;
38242     }
38243     s_wsfe(&io___1780);
38244     do_fio(&c__1, "Bytes used:", (ftnlen)11);
38245     i__2 = commidi_1.numchan;
38246     for (icm = 0; icm <= i__2; ++icm) {
38247 	do_fio(&c__1, (char *)&commidi_1.imidi[icm], (ftnlen)sizeof(integer));
38248     }
38249     e_wsfe();
38250     s_wsfe(&io___1781);
38251     do_fio(&c__1, "Bytes used:", (ftnlen)11);
38252     i__2 = commidi_1.numchan;
38253     for (icm = 0; icm <= i__2; ++icm) {
38254 	do_fio(&c__1, (char *)&commidi_1.imidi[icm], (ftnlen)sizeof(integer));
38255     }
38256     e_wsfe();
38257     cl__1.cerr = 0;
38258     cl__1.cunit = 51;
38259     cl__1.csta = 0;
38260     f_clos(&cl__1);
38261     if (commidi_1.debugmidi) {
38262 	cl__1.cerr = 0;
38263 	cl__1.cunit = 52;
38264 	cl__1.csta = 0;
38265 	f_clos(&cl__1);
38266     }
38267     return 0;
38268 } /* writemidi_ */
38269 
writesetsign_(integer * ninsttrans,integer * iinsttrans,integer * itranskey,logical * flag__)38270 /* Subroutine */ int writesetsign_(integer *ninsttrans, integer *iinsttrans,
38271 	integer *itranskey, logical *flag__)
38272 {
38273     /* System generated locals */
38274     address a__1[2];
38275     integer i__1, i__2[2], i__3;
38276     char ch__1[1], ch__2[80];
38277     icilist ici__1;
38278 
38279     /* Builtin functions */
38280     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
38281     integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
38282 	    , s_wsfe(cilist *), e_wsfe(void);
38283 
38284     /* Local variables */
38285     static integer i__;
38286     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
38287     static integer lnote;
38288     static char notexq[79];
38289 
38290     /* Fortran I/O blocks */
38291     static cilist io___1785 = { 0, 11, 0, "(a)", 0 };
38292 
38293 
38294 
38295 /*  Assumes notexq is blank */
38296 
38297     /* Parameter adjustments */
38298     --itranskey;
38299     --iinsttrans;
38300 
38301     /* Function Body */
38302     i__1 = *ninsttrans;
38303     for (i__ = 1; i__ <= i__1; ++i__) {
38304 /* Writing concatenation */
38305 	chax_(ch__1, (ftnlen)1, &c__92);
38306 	i__2[0] = 1, a__1[0] = ch__1;
38307 	i__2[1] = 7, a__1[1] = "setsign";
38308 	s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
38309 	lnote = 8;
38310 	if (iinsttrans[i__] < 10) {
38311 /* Writing concatenation */
38312 	    i__2[0] = lnote, a__1[0] = notexq;
38313 	    i__3 = iinsttrans[i__] + 48;
38314 	    chax_(ch__1, (ftnlen)1, &i__3);
38315 	    i__2[1] = 1, a__1[1] = ch__1;
38316 	    s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
38317 	    ++lnote;
38318 	} else {
38319 	    i__3 = lnote;
38320 	    ici__1.icierr = 0;
38321 	    ici__1.icirnum = 1;
38322 	    ici__1.icirlen = lnote + 4 - i__3;
38323 	    ici__1.iciunit = notexq + i__3;
38324 	    ici__1.icifmt = "(a1,i2,a1)";
38325 	    s_wsfi(&ici__1);
38326 	    do_fio(&c__1, "{", (ftnlen)1);
38327 	    do_fio(&c__1, (char *)&iinsttrans[i__], (ftnlen)sizeof(integer));
38328 	    do_fio(&c__1, "}", (ftnlen)1);
38329 	    e_wsfi();
38330 	    lnote += 4;
38331 	}
38332 	if (itranskey[i__] < 0) {
38333 	    i__3 = lnote;
38334 	    ici__1.icierr = 0;
38335 	    ici__1.icirnum = 1;
38336 	    ici__1.icirlen = lnote + 4 - i__3;
38337 	    ici__1.iciunit = notexq + i__3;
38338 	    ici__1.icifmt = "(a1,i2,a1)";
38339 	    s_wsfi(&ici__1);
38340 	    do_fio(&c__1, "{", (ftnlen)1);
38341 	    do_fio(&c__1, (char *)&itranskey[i__], (ftnlen)sizeof(integer));
38342 	    do_fio(&c__1, "}", (ftnlen)1);
38343 	    e_wsfi();
38344 	    lnote += 4;
38345 	} else {
38346 /* Writing concatenation */
38347 	    i__2[0] = lnote, a__1[0] = notexq;
38348 	    i__3 = itranskey[i__] + 48;
38349 	    chax_(ch__1, (ftnlen)1, &i__3);
38350 	    i__2[1] = 1, a__1[1] = ch__1;
38351 	    s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
38352 	    ++lnote;
38353 	}
38354 	s_wsfe(&io___1785);
38355 /* Writing concatenation */
38356 	i__2[0] = lnote, a__1[0] = notexq;
38357 	i__2[1] = 1, a__1[1] = "%";
38358 	s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)80);
38359 	do_fio(&c__1, ch__2, lnote + 1);
38360 	e_wsfe();
38361 /* L1: */
38362     }
38363     *flag__ = FALSE_;
38364     return 0;
38365 } /* writesetsign_ */
38366 
writflot_(real * x,char * notexq,integer * lenline,ftnlen notexq_len)38367 /* Subroutine */ int writflot_(real *x, char *notexq, integer *lenline,
38368 	ftnlen notexq_len)
38369 {
38370     /* System generated locals */
38371     integer i__1;
38372     icilist ici__1;
38373 
38374     /* Builtin functions */
38375     integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
38376 	    ;
38377 
38378     if (*x < .95f) {
38379 	i__1 = *lenline;
38380 	ici__1.icierr = 0;
38381 	ici__1.icirnum = 1;
38382 	ici__1.icirlen = *lenline + 2 - i__1;
38383 	ici__1.iciunit = notexq + i__1;
38384 	ici__1.icifmt = "(f2.1)";
38385 	s_wsfi(&ici__1);
38386 	do_fio(&c__1, (char *)&(*x), (ftnlen)sizeof(real));
38387 	e_wsfi();
38388 	*lenline += 2;
38389     } else if (*x < 9.95f) {
38390 	i__1 = *lenline;
38391 	ici__1.icierr = 0;
38392 	ici__1.icirnum = 1;
38393 	ici__1.icirlen = *lenline + 3 - i__1;
38394 	ici__1.iciunit = notexq + i__1;
38395 	ici__1.icifmt = "(f3.1)";
38396 	s_wsfi(&ici__1);
38397 	do_fio(&c__1, (char *)&(*x), (ftnlen)sizeof(real));
38398 	e_wsfi();
38399 	*lenline += 3;
38400     } else {
38401 	i__1 = *lenline;
38402 	ici__1.icierr = 0;
38403 	ici__1.icirnum = 1;
38404 	ici__1.icirlen = *lenline + 4 - i__1;
38405 	ici__1.iciunit = notexq + i__1;
38406 	ici__1.icifmt = "(f4.1)";
38407 	s_wsfi(&ici__1);
38408 	do_fio(&c__1, (char *)&(*x), (ftnlen)sizeof(real));
38409 	e_wsfi();
38410 	*lenline += 4;
38411     }
38412     return 0;
38413 } /* writflot_ */
38414 
wsclef_(integer * iv,integer * ninow,char * clefq,integer * nclef,ftnlen clefq_len)38415 /* Subroutine */ int wsclef_(integer *iv, integer *ninow, char *clefq,
38416 	integer *nclef, ftnlen clefq_len)
38417 {
38418     /* System generated locals */
38419     address a__1[3], a__2[2];
38420     integer i__1, i__2[3], i__3[2], i__4;
38421     char ch__1[1], ch__2[1], ch__3[9], ch__4[22];
38422 
38423     /* Builtin functions */
38424     integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char
38425 	    *, ftnlen);
38426     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
38427     integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
38428 	    , s_wsfe(cilist *), e_wsfe(void);
38429 
38430     /* Local variables */
38431     static integer iv1, iv2, iiv;
38432     extern /* Character */ VOID chax_(char *, ftnlen, integer *);
38433     static integer ltem;
38434     static char temq[20];
38435     extern /* Subroutine */ int stop1_(void);
38436     static integer iinst;
38437     extern integer numclef_(char *, ftnlen);
38438 
38439     /* Fortran I/O blocks */
38440     static cilist io___1788 = { 0, 6, 0, 0, 0 };
38441     static cilist io___1789 = { 0, 6, 0, 0, 0 };
38442     static icilist io___1793 = { 0, temq, 0, "(a9,i2,a1)", 20, 1 };
38443     static cilist io___1794 = { 0, 11, 0, "(a)", 0 };
38444     static cilist io___1796 = { 0, 11, 0, "(a)", 0 };
38445 
38446 
38447 
38448 /*  Writes \setclef for instrument containing voice iv */
38449 
38450     /* Parameter adjustments */
38451     --clefq;
38452 
38453     /* Function Body */
38454     if (*nclef < 7) {
38455 	i__1 = *nclef + 48;
38456 	chax_(ch__1, (ftnlen)1, &i__1);
38457 	*(unsigned char *)&clefq[*iv] = *(unsigned char *)&ch__1[0];
38458     } else {
38459 	*(unsigned char *)&clefq[*iv] = '9';
38460     }
38461     if (! comlast_1.islast) {
38462 	return 0;
38463     }
38464     iv1 = 1;
38465     i__1 = *ninow;
38466     for (iinst = 1; iinst <= i__1; ++iinst) {
38467 	if (*iv < iv1 + comnvi_1.nspern[iinst - 1]) {
38468 	    goto L2;
38469 	}
38470 	iv1 += comnvi_1.nspern[iinst - 1];
38471 /* L1: */
38472     }
38473     s_wsle(&io___1788);
38474     e_wsle();
38475     s_wsle(&io___1789);
38476     do_lio(&c__9, &c__1, "Should not be here in wsclef!", (ftnlen)29);
38477     e_wsle();
38478     stop1_();
38479 L2:
38480     iv2 = iv1 + comnvi_1.nspern[iinst - 1] - 1;
38481     if (iinst < 10) {
38482 /* Writing concatenation */
38483 	chax_(ch__1, (ftnlen)1, &c__92);
38484 	i__2[0] = 1, a__1[0] = ch__1;
38485 	i__2[1] = 7, a__1[1] = "setclef";
38486 	i__1 = iinst + 48;
38487 	chax_(ch__2, (ftnlen)1, &i__1);
38488 	i__2[2] = 1, a__1[2] = ch__2;
38489 	s_cat(temq, a__1, i__2, &c__3, (ftnlen)20);
38490 	ltem = 9;
38491     } else {
38492 	s_wsfi(&io___1793);
38493 /* Writing concatenation */
38494 	chax_(ch__1, (ftnlen)1, &c__92);
38495 	i__3[0] = 1, a__2[0] = ch__1;
38496 	i__3[1] = 8, a__2[1] = "setclef{";
38497 	s_cat(ch__3, a__2, i__3, &c__2, (ftnlen)9);
38498 	do_fio(&c__1, ch__3, (ftnlen)9);
38499 	do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
38500 	do_fio(&c__1, "}", (ftnlen)1);
38501 	e_wsfi();
38502 	ltem = 12;
38503     }
38504     if (iv1 == iv2) {
38505 	s_wsfe(&io___1794);
38506 /* Writing concatenation */
38507 	i__2[0] = ltem, a__1[0] = temq;
38508 	i__2[1] = 1, a__1[1] = clefq + *iv;
38509 	i__2[2] = 1, a__1[2] = "%";
38510 	s_cat(ch__4, a__1, i__2, &c__3, (ftnlen)22);
38511 	do_fio(&c__1, ch__4, ltem + 2);
38512 	e_wsfe();
38513     } else {
38514 /* Writing concatenation */
38515 	i__3[0] = ltem, a__2[0] = temq;
38516 	i__3[1] = 1, a__2[1] = "{";
38517 	s_cat(temq, a__2, i__3, &c__2, (ftnlen)20);
38518 	++ltem;
38519 	i__1 = iv2;
38520 	for (iiv = iv1; iiv <= i__1; ++iiv) {
38521 /* Writing concatenation */
38522 	    i__3[0] = ltem, a__2[0] = temq;
38523 	    i__4 = numclef_(clefq + iiv, (ftnlen)1) + 48;
38524 	    chax_(ch__1, (ftnlen)1, &i__4);
38525 	    i__3[1] = 1, a__2[1] = ch__1;
38526 	    s_cat(temq, a__2, i__3, &c__2, (ftnlen)20);
38527 	    ++ltem;
38528 /* L3: */
38529 	}
38530 	s_wsfe(&io___1796);
38531 /* Writing concatenation */
38532 	i__3[0] = ltem, a__2[0] = temq;
38533 	i__3[1] = 2, a__2[1] = "}%";
38534 	s_cat(ch__4, a__2, i__3, &c__2, (ftnlen)22);
38535 	do_fio(&c__1, ch__4, ltem + 2);
38536 	e_wsfe();
38537     }
38538     return 0;
38539 } /* wsclef_ */
38540 
pmxab_()38541 /* Main program alias */ int pmxab_ () { MAIN__ (); return 0; }
38542