w32tex
About: TeX Live provides a comprehensive TeX system including all the major TeX-related programs, macro packages, and fonts that are free software. Windows sources.
  Fossies Dox: w32tex-src.tar.xz  ("unofficial" and yet experimental doxygen-generated source code documentation)  

pmxab.c
Go to the documentation of this file.
1 #line 1 ""
2 /* -- translated by f2c (version 20160102).
3  You must link the resulting object file with libf2c:
4  on Microsoft Windows system, link with libf2c.lib;
5  on Linux or Unix systems, link with .../path/to/libf2c.a -lm
6  or, if you install libf2c.a in a standard place, with -lf2c -lm
7  -- in that order, at the end of the command line, as in
8  cc *.o -lf2c -lm
9  Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
10 
11  http://www.netlib.org/f2c/libf2c.zip
12 */
13 
14 #include "f2c.h"
15 
16 #line 1 ""
17 /* Common Block Declarations */
18 
19 struct {
20  char versionc[5];
22 
23 #define comver_1 comver_
24 
25 struct {
28 
29 #define comevent_1 comevent_
30 
31 struct {
32  integer levson[25], levsoff[25], imidso[25], naccbl[25], laccbl[250]
33  /* was [25][10] */, jaccbl[250] /* was [25][10] */, nusebl;
36 
37 #define comslm_1 comslm_
38 
39 struct {
41  real trest[25];
42  integer mcpitch[20], mgap, iacclo[150] /* was [25][6] */, iacchi[150]
43  /* was [25][6] */, midinst[24], nmidcrd, midchan[48] /*
44  was [24][2] */, numchan, naccim[25], laccim[250] /* was [25][
45  10] */, jaccim[250] /* was [25][10] */;
47  shortint mmidi[614400] /* was [25][24576] */;
50 
51 #define commidi_1 commidi_
52 
53 union {
54  struct {
55  integer midivel[24], midvelc[25], midibal[24], midbc[25], miditran[24]
56  , midtc[25], noinst;
58  } _1;
59  struct {
60  integer midivel[24], midvelc[25], midibal[24], midbc[25], miditran[24]
61  , midtc[25], noinstdum;
62  shortint iinsiv[24];
63  } _2;
65 
66 #define commvel_1 (commvel_._1)
67 #define commvel_2 (commvel_._2)
68 
69 struct {
71  shortint lbuf[9600];
72  char bufq[131072];
74 
75 #define inbuff_1 inbuff_
76 
77 struct {
81 
82 #define commus_1 commus_
83 
84 union {
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, idum, itsofar[24], nib[360] /* was [24][
90  15] */, nn[24];
91  logical rest[4800] /* was [24][200] */;
94  } _1;
95  struct {
96  integer iv, ivxo[600], ipo[600];
97  real to[600], tno[600];
98  integer nnl[24], nv, ibar, mtrnuml, nodur[4800] /* was [24][200] */,
99  lenbar, iccount, nbars, itsofar[24], nib[360] /* was [24][
100  15] */, nn[24];
101  logical rest[4800] /* was [24][200] */;
104  } _2;
106 
107 #define a1ll_1 (a1ll_._1)
108 #define a1ll_2 (a1ll_._2)
109 
110 struct {
111  integer n69[25], n34[25];
113 
114 #define comdiag_1 comdiag_
115 
116 struct {
117  integer mmacstrt[500] /* was [25][20] */, mmacend[500] /*
118  was [25][20] */, immac, mmactime[20], nmidsec, msecstrt[1500]
119  /* was [25][60] */, msecend[1500] /* was [25][60] */;
122 
123 #define commmac_1 commmac_
124 
125 struct {
128 
129 #define truelinecount_1 truelinecount_
130 
131 struct {
140 
141 #define c1omget_1 c1omget_
142 
143 struct {
145  real task[40], wask[40], elask[40];
147 
148 #define comas1_1 comas1_
149 
150 struct {
151  real udsp[50], tudsp[50];
153  real udoff[480] /* was [24][20] */;
156 
157 #define comudsp_1 comudsp_
158 
159 struct comtol_1_ {
161 };
162 
163 #define comtol_1 (*(struct comtol_1_ *) &comtol_)
164 
165 struct {
166  shortint ipslon[25], lusebl[10], jusebl[10];
168 
169 #define comips_1 comips_
170 
171 struct {
174 
175 #define comlast_1 comlast_
176 
177 union {
178  struct {
179  real space[80];
182  integer ivmxsav[48] /* was [24][2] */, nvmxsav[24];
183  } _1;
184  struct {
185  real space[80];
186  integer nb;
187  real prevtn[24], flgndv[24];
188  logical flgndb;
189  real eskgnd, ptsgnd;
190  integer ivmxsav[48] /* was [24][2] */, nvmxsav[24];
191  } _2;
193 
194 #define comnsp_1 (comnsp_._1)
195 #define comnsp_2 (comnsp_._2)
196 
197 union {
198  struct {
199  integer mult[4800] /* was [24][200] */, iv, nnl[24], nv, ibar,
200  ivxo[600], ipo[600];
201  real to[600], tno[600], tnote[600], eskz[4800] /* was [24][200] */;
202  integer ipl[4800] /* was [24][200] */, ibm1[216] /* was [24][9]
203  */, ibm2[216] /* was [24][9] */, nolev[4800] /* was [24][
204  200] */, ibmcnt[24], nodur[4800] /* was [24][200] */,
205  jn, lenbar, iccount, nbars, itsofar[24], nacc[4800] /*
206  was [24][200] */, nib[360] /* was [24][15] */, nn[24],
211  integer mtrnuml, mtrdenl, mtrnmp, mtrdnp, islur[4800] /* was [24][
212  200] */, ifigdr[250] /* was [2][125] */, iline;
214  integer irest[4800] /* was [24][200] */, iornq[4824] /*
215  was [24][201] */, isdat1[202], isdat2[202], nsdat, isdat3[202]
216  , isdat4[202];
217  logical beamon[24], isfig[400] /* was [2][200] */;
218  char sepsymq[24], sq[1], ulq[216] /* was [24][9] */;
219  } _1;
220  struct {
221  integer mult[4800] /* was [24][200] */, jv, nnl[24], nv, ibar,
222  ivxo[600], ipo[600];
223  real to[600], tno[600], tnote[600], eskz[4800] /* was [24][200] */;
224  integer ipl[4800] /* was [24][200] */, ibm1[216] /* was [24][9]
225  */, ibm2[216] /* was [24][9] */, nolev[4800] /* was [24][
226  200] */, ibmcnt[24], nodur[4800] /* was [24][200] */,
227  jn, lenbar, iccount, nbars, itsofar[24], nacc[4800] /*
228  was [24][200] */, nib[360] /* was [24][15] */, nn[24],
229  lenb0, lenb1;
230  real slfac;
233  integer mtrnuml, mtrdenl, mtrnmp, mtrdnp, islur[4800] /* was [24][
234  200] */, ifigdr[250] /* was [2][125] */, iline;
236  integer irest[4800] /* was [24][200] */, iornq[4824] /*
237  was [24][201] */, isdat1[202], isdat2[202], nsdat, isdat3[202]
238  , isdat4[202];
239  logical beamon[24], isfig[400] /* was [2][200] */;
240  char sepsymq[24], sq[1], ulq[216] /* was [24][9] */;
241  } _2;
243 
244 #define all_1 (all_._1)
245 #define all_2 (all_._2)
246 
247 struct {
248  real eskz2[4800] /* was [24][200] */;
250 
251 #define comeskz2_1 comeskz2_
252 
253 struct {
256 
257 #define comntot_1 comntot_
258 
259 struct {
260  real hpttot[176];
262 
263 #define comhsp_1 comhsp_
264 
265 struct {
268 
269 #define compoi_1 compoi_
270 
271 struct {
274 
275 #define combbm_1 combbm_
276 
277 struct {
278  real ask[2500];
282 
283 #define comas3_1 comas3_
284 
285 struct {
290 
291 #define combjmp_1 combjmp_
292 
293 struct {
296 
297 #define comoct_1 comoct_
298 
299 union {
300  struct {
303  integer ntupv[216] /* was [24][9] */, nolev1[24], mtupv[216]
304  /* was [24][9] */, nxtinbm[24], islope[24];
305  real xelsk[24], eloff[216] /* was [24][9] */;
306  integer nssb[24], issb[24], lev1ssb[480] /* was [24][20] */;
307  } _1;
308  struct {
309  integer ixtup;
310  logical vxtup[24];
311  integer ntupv[216] /* was [24][9] */, nolev1[24], mtupv[216]
312  /* was [24][9] */, nxtinbm[24], islope[24];
313  real xels11[24], eloff[216] /* was [24][9] */;
314  integer nssb[24], issb[24], lev1ssb[480] /* was [24][20] */;
315  } _2;
317 
318 #define comxtup_1 (comxtup_._1)
319 #define comxtup_2 (comxtup_._2)
320 
321 struct {
324 
325 #define comdraw_1 comdraw_
326 
327 struct {
328  integer nvmx[24], ivmx[48] /* was [24][2] */, ivx;
330 
331 #define commvl_1 commvl_
332 
333 struct {
338 
339 #define strtmid_1 strtmid_
340 
341 struct {
345 
346 #define comask_1 comask_
347 
348 struct {
352  char inameq[1896];
354 
355 #define comtop_1 comtop_
356 
357 struct {
360  integer ncrd, icrdat[193], icrdot[193], icrdorn[193], nudorn, kudorn[63];
364 
365 #define comtrill_1 comtrill_
366 
367 struct {
373 
374 #define comipb_1 comipb_
375 
376 union {
377  struct {
379  } _1;
380  struct {
383  } _2;
385 
386 #define comnvst_1 (comnvst_._1)
387 #define comnvst_2 (comnvst_._2)
388 
389 union {
390  struct {
391  integer itfig[148] /* was [2][74] */;
392  char figq[1480] /* was [2][74] */;
393  integer ivupfig[148] /* was [2][74] */, nfigs[2];
395  integer ivxfig2, ivvfig[148] /* was [2][74] */;
396  } _1;
397  struct {
398  integer itfig[148] /* was [2][74] */;
399  char figqq[1480] /* was [2][74] */;
400  integer ivupfig[148] /* was [2][74] */, nfigs[2];
401  real fullsize[24];
402  integer ivxfig2, ivvfig[148] /* was [2][74] */;
403  } _2;
405 
406 #define comfig_1 (comfig_._1)
407 #define comfig_2 (comfig_._2)
408 
409 struct {
412 
413 #define xjbeambrests_1 xjbeambrests_
414 
415 struct comtrans_1_ {
416  char cheadq[60];
417 };
418 
419 #define comtrans_1 (*(struct comtrans_1_ *) &comtrans_)
420 
421 struct compage_1_ {
424  isysfpb[19];
428 };
429 
430 #define compage_1 (*(struct compage_1_ *) &compage_)
431 
432 struct cblock_1_ {
436 };
437 
438 #define cblock_1 (*(struct cblock_1_ *) &cblock_)
439 
440 struct cominbot_1_ {
442 };
443 
444 #define cominbot_1 (*(struct cominbot_1_ *) &cominbot_)
445 
446 struct comstart_1_ {
448 };
449 
450 #define comstart_1 (*(struct comstart_1_ *) &comstart_)
451 
452 struct comtitl_1_ {
453  char instrq[120], titleq[120], compoq[120];
456 };
457 
458 #define comtitl_1 (*(struct comtitl_1_ *) &comtitl_)
459 
460 struct spfacs_1_ {
465 };
466 
467 #define spfacs_1 (*(struct spfacs_1_ *) &spfacs_)
468 
469 struct combmh_1_ {
471 };
472 
473 #define combmh_1 (*(struct combmh_1_ *) &combmh_)
474 
475 struct comdyn_1_ {
476  integer ndyn, idyndat[99], levdsav[24], ivowg[12];
477  real hoh1[12], hoh2[12], hoh2h1[2];
479  char txtdynq[5248];
481 };
482 
483 #define comdyn_1 (*(struct comdyn_1_ *) &comdyn_)
484 
488 };
489 
490 #define comkbdrests_1 (*(struct comkbdrests_1_ *) &comkbdrests_)
491 
496 };
497 
498 #define cominsttrans_1 (*(struct cominsttrans_1_ *) &cominsttrans_)
499 
500 struct comsize_1_ {
502 };
503 
504 #define comsize_1 (*(struct comsize_1_ *) &comsize_)
505 
506 struct {
508  real wminnh[3999];
509  integer nnpd[9600];
510  real durb[9600];
512  real udsp[3999], wheadpt, sqzb[9600];
514 
515 #define c1omnotes_1 c1omnotes_
516 
517 struct {
519  real tar[8];
520  integer ivar1[8], ipar1[8], levar1[8], ncmar1[8];
524 
525 #define comarp_1 comarp_
526 
527 struct {
530 
531 #define commidisig_1 commidisig_
532 
533 struct {
535  real tcc[240] /* was [24][10] */;
536  integer ncmidcc[240] /* was [24][10] */, maxdotmv[24], ndotmv[24];
537  real updot[480] /* was [24][20] */, rtdot[480] /* was [24][20] */;
539 
540 #define comcc_1 comcc_
541 
542 struct {
544  logical upslur[48] /* was [24][2] */;
549 
550 #define comslur_1 comslur_
551 
552 union {
553  struct {
555  } _1;
556  struct {
558  } _2;
560 
561 #define comhair_1 (comhair_._1)
562 #define comhair_2 (comhair_._2)
563 
564 struct {
565  integer ivg[37], ipg[37], nolevg[74], itoff[148] /* was [2][74] */;
571  integer lenlit[83], multg[37];
572  logical upg[37], slurg[37], slashg[37];
574  char voltxtq[120], litq[10624];
576 
577 #define comgrace_1 comgrace_
578 
579 struct {
582 
583 #define comsln_1 comsln_
584 
585 struct {
588 
589 #define comeon_1 comeon_
590 
591 struct {
592  integer ipl2[4800] /* was [24][200] */;
594 
595 #define comipl2_1 comipl2_
596 
597 struct {
600 
601 #define combeam_1 combeam_
602 
603 struct {
607  char lnholdq[128];
610 
611 #define commac_1 commac_
612 
613 struct {
614  integer nvmx[24], ivmx[48] /* was [24][2] */, ivx;
615  real fbar;
616  integer nacc[4800] /* was [24][200] */;
618 
619 #define c1ommvl_1 c1ommvl_
620 
621 union {
622  struct {
627  integer noinst;
629  } _1;
630  struct {
631  integer nkeys, ibrkch[18], newkey[18];
632  logical iskchb;
635  integer noinst;
637  } _2;
639 
640 #define comkeys_1 (comkeys_._1)
641 #define comkeys_2 (comkeys_._2)
642 
643 struct {
646 
647 #define comligfont_1 comligfont_
648 
649 struct {
652 
653 #define comis4bignv_1 comis4bignv_
654 
655 struct {
659  real poefa[125];
661 
662 #define comshort_1 comshort_
663 
664 struct {
665  logical lastchar, rptnd1, sluron[48] /* was [24][2] */, fbon,
666  ornrpt, stickys;
670  char rptfq1[1], rptfq2[1];
672 
673 #define comget_1 comget_
674 
675 struct {
679 
680 #define comignorenats_1 comignorenats_
681 
682 struct {
683  integer nnodur, lastlev, ndlev[48] /* was [24][2] */;
692 
693 #define comnotes_1 comnotes_
694 
695 struct {
698  char headrq[80], lowerq[80];
701 
702 #define comhead_1 comhead_
703 
704 struct {
706  real t1fb[960] /* was [24][40] */, t2fb[960] /* was [24][40] */;
707  char ulfbq[960] /* was [24][40] */;
713 
714 #define comfb_1 comfb_
715 
716 struct {
719 
720 #define combc_1 combc_
721 
722 struct {
727 
728 #define comnvi_1 comnvi_
729 
730 struct {
731  integer ip1mac[20], il1mac[20], ip2mac[20], il2mac[20], ic1mac[20], ilmac,
734 
735 #define c1ommac_1 c1ommac_
736 
737 struct {
738  char clefq[24];
740 
741 #define comclefq_1 comclefq_
742 
743 struct {
747 
748 #define comarpshift_1 comarpshift_
749 
750 struct {
753 
754 #define combibarcnt_1 combibarcnt_
755 
756 struct {
759 
760 #define comlyr_1 comlyr_
761 
762 struct {
766 
767 #define combottop_1 combottop_
768 
769 struct {
772 
773 #define comivxudorn_1 comivxudorn_
774 
775 struct {
778 
779 #define comcb_1 comcb_
780 
781 struct {
783  real wasksys[800], elasksys[800];
785 
786 #define comas2_1 comas2_
787 
788 struct {
791 
792 #define comcwrf_1 comcwrf_
793 
794 struct {
797 
798 #define comclefrests_1 comclefrests_
799 
800 struct {
803 
804 #define comc8flag_1 comc8flag_
805 
806 struct {
807  real elskb, tnminb[3999];
809 
810 #define linecom_1 linecom_
811 
812 /* Initialized data */
813 
814 struct {
815  char e_1[60];
816  } comtrans_ = { " "
817  " " };
818 
819 struct {
820  real e_1[4];
822  real e_3[30];
824  } compage_ = { 524.f, 740.f, 0.f, 0.f, {0}, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f,
825  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,
826  0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f };
827 
828 struct {
829  real e_1[14];
831  } cblock_ = { .5f, .25f, .4f, .4f, .2f, 12.f, 21.f, 12.f, 4.f, 1.6f, 5.f,
832  5.7f, 1.071f, 2.714f, 16 };
833 
834 struct {
835  integer e_1;
836  } cominbot_ = { 16 };
837 
838 struct {
839  real e_1;
840  } comstart_ = { .55f };
841 
842 struct {
843  char e_1[360];
844  logical e_2;
846  } comtitl_ = { " "
847  " "
848  " "
849  " "
850  " "
851  " ", FALSE_ };
852 
853 struct {
854  real e_1[14];
855  integer e_2;
856  real e_3[5];
857  } spfacs_ = { 1.3333f, .4f, .7f, .3f, .2f, 2.f, 1.f, .7f, .7f, .9f, .5f,
858  9.f, 1.7f, 1.32f, 2, .47f, .83f, .17f, .5f, 1.f };
859 
860 struct {
861  real e_1[2];
862  } combmh_ = { 1.1f, 2.3f };
863 
864 struct {
866  integer e_2[12];
867  real e_3[26];
868  integer fill_4[1479];
869  } comdyn_ = { {0}, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 2.2f, 1.7f, 1.2f,
870  .7f, 1.3f, 1.3f, .4f, .8f, 1.2f, .8f, 1.2f, 1.6f, -2.7f, -2.2f,
871  -1.7f, -1.2f, -2.3f, -2.1f, -1.f, -1.7f, -2.1f, -1.6f, -1.9f,
872  -2.3f, -.3f, .3f };
873 
874 struct {
875  integer e_1[16];
876  logical e_2;
877  } comkbdrests_ = { 0, 0, 0, 2, 1, 4, 5, 4, 9, 7, 5, 5, 7, 5, 6, 6, FALSE_
878  };
879 
880 struct {
881  integer e_1[24];
882  integer fill_2[24];
883  integer e_3[24];
884  integer fill_4[25];
886  } cominsttrans_ = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
887  0, 0, 0, 0, 0, 0, {0}, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
888  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {0}, FALSE_, FALSE_ };
889 
890 struct {
891  integer e_1[24];
892  } comsize_ = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
893  0, 0, 0, 0 };
894 
895 struct {
896  real e_1;
897  } comtol_ = { .001f };
898 
899 
900 /* Table of constant values */
901 
902 static integer c__9 = 9;
903 static integer c__1 = 1;
904 static integer c__44 = 44;
905 static integer c__2 = 2;
906 static integer c__4 = 4;
907 static integer c__128 = 128;
908 static integer c__3 = 3;
911 static integer c__92 = 92;
912 static integer c__11 = 11;
913 static integer c__12 = 12;
914 static integer c__17 = 17;
915 static integer c__14 = 14;
916 static integer c__129 = 129;
917 static integer c__5 = 5;
918 static integer c__13 = 13;
919 static integer c__6 = 6;
920 static integer c__7 = 7;
921 static integer c__22 = 22;
922 static integer c__0 = 0;
923 static integer c__27 = 27;
924 static integer c__10 = 10;
925 static integer c__20 = 20;
926 static integer c__26 = 26;
927 static real c_b1007 = -2.f;
928 static real c_b1008 = 0.f;
929 static real c_b1053 = 1.f;
930 static integer c__8 = 8;
931 static integer c__16 = 16;
932 static integer c__23 = 23;
933 static integer c__39 = 39;
934 static integer c__96 = 96;
935 static integer c__21 = 21;
936 static integer c__19 = 19;
937 static integer c__24 = 24;
938 static integer c__28 = 28;
939 static integer c__18 = 18;
940 static real c_b1901 = 2.f;
941 static integer c__30 = 30;
942 static integer c__60 = 60;
943 static integer c__80 = 80;
944 static integer c__256 = 256;
945 static integer c__34 = 34;
946 static integer c__120 = 120;
947 static integer c__240 = 240;
948 static integer c__255 = 255;
949 static integer c__47 = 47;
950 
951 /* Main program */ int MAIN__(void)
952 {
953  /* Initialized data */
954 
955  static char date[9] = "17 Mar 20";
956  static char version[5] = "2.94 ";
957  static integer maxit = 200;
958  static integer ncalls = 0;
959  static logical isfirst = TRUE_;
960 
961  /* System generated locals */
962  address a__1[2], a__2[4], a__3[3];
963  integer i__1, i__2, i__3[2], i__4[4], i__5[3], i__6;
964  real r__1;
965  char ch__1[48], ch__2[64], ch__3[37], ch__4[55], ch__5[56];
966  olist o__1;
967  cllist cl__1;
968  inlist ioin__1;
969 
970  /* Builtin functions */
971  /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
972  integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
973  e_wsle(void), s_rsfe(cilist *), do_fio(integer *, char *, ftnlen),
974  e_rsfe(void), s_cmp(char *, char *, ftnlen, ftnlen), i_indx(char
975  *, char *, ftnlen, ftnlen);
976  /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
978  /* Subroutine */ int s_stop(char *, ftnlen);
979  integer s_wsfe(cilist *), e_wsfe(void);
980 
981  /* Local variables */
982  static real devnorm0;
983  static logical optimize;
984  extern /* Subroutine */ int poestats_(integer *, real *, real *, real *),
985  writemidi_(char *, integer *, ftnlen);
986  static integer ncomments, ip1, ilb, icm;
987  static real poe[125];
988  static integer ivt, ivx;
989  static real poe0[125];
990  static integer ljob, ipoe[125];
991  extern /* Subroutine */ int pmxa_(char *, integer *, logical *, integer *,
992  integer *, logical *, ftnlen), pmxb_(logical *, real *, integer *
993  , logical *);
994  static integer ivtt, isys, ljob4;
995  extern /* Subroutine */ int stop1_(void);
996  extern integer iargc_(void);
997  static integer nbari[125], nbars[125], iinst, isysd, numit, isyst, isysu,
998  nsyst, nbars0[125];
999  static real poebar;
1000  extern /* Subroutine */ int getarg_(integer *, char *, ftnlen);
1001  static integer idnord, iplast;
1002  static logical fexist;
1003  static real devpmx;
1004  static integer iupord;
1005  extern integer lenstr_(char *, integer *, ftnlen);
1006  extern /* Subroutine */ int printl_(char *, ftnlen);
1007  static integer ndxpmx;
1008  static real poebar0;
1009  static char jobname[44], infileq[47], lnholdq[128];
1010  static real devnorm;
1011  static integer numargs, nstaves;
1012  extern /* Subroutine */ int sortpoe_(integer *, real *, integer *);
1013 
1014  /* Fortran I/O blocks */
1015  static cilist io___10 = { 0, 6, 0, 0, 0 };
1016  static cilist io___11 = { 0, 6, 0, 0, 0 };
1017  static cilist io___12 = { 0, 5, 0, "(a)", 0 };
1018  static cilist io___15 = { 0, 6, 0, 0, 0 };
1019  static cilist io___16 = { 0, 6, 0, 0, 0 };
1020  static cilist io___17 = { 0, 6, 0, 0, 0 };
1021  static cilist io___21 = { 0, 6, 0, 0, 0 };
1022  static cilist io___24 = { 0, 18, 1, "(a)", 0 };
1023  static cilist io___26 = { 0, 6, 0, 0, 0 };
1024  static cilist io___34 = { 0, 6, 0, 0, 0 };
1025  static cilist io___35 = { 0, 15, 0, 0, 0 };
1026  static cilist io___39 = { 0, 6, 0, 0, 0 };
1027  static cilist io___40 = { 0, 15, 0, 0, 0 };
1028  static cilist io___42 = { 0, 15, 0, 0, 0 };
1029  static cilist io___51 = { 0, 6, 0, 0, 0 };
1030  static cilist io___52 = { 0, 15, 0, 0, 0 };
1031  static cilist io___60 = { 0, 6, 0, 0, 0 };
1032  static cilist io___61 = { 0, 15, 0, 0, 0 };
1033  static cilist io___62 = { 0, 6, 0, "(5x,20i3)", 0 };
1034  static cilist io___63 = { 0, 15, 0, "(5x,20i3)", 0 };
1035  static cilist io___64 = { 0, 6, 0, 0, 0 };
1036  static cilist io___65 = { 0, 15, 0, 0, 0 };
1037  static cilist io___66 = { 0, 6, 0, 0, 0 };
1038  static cilist io___67 = { 0, 15, 0, 0, 0 };
1039  static cilist io___68 = { 0, 6, 0, 0, 0 };
1040  static cilist io___69 = { 0, 15, 0, 0, 0 };
1041  static cilist io___70 = { 0, 6, 0, "(5x,20i3)", 0 };
1042  static cilist io___71 = { 0, 15, 0, "(5x,20i3)", 0 };
1043  static cilist io___72 = { 0, 6, 0, "(5x,20i3)", 0 };
1044  static cilist io___73 = { 0, 15, 0, "(5x,20i3)", 0 };
1045 
1046 
1047 
1048 /* This program, PMX, developed by Don Simons */
1049 /* (dsimons@roadrunner.com), is a preprocessor for MusiXTeX. In concert with */
1050 /* MusiXTeX and TeX, its purpose is to allow the user to create high-quality */
1051 /* typeset musical scores by including a sequence of PMX commands in an ASCII */
1052 /* input file. */
1053 
1054 /* This program is free software: you can redistribute it and/or modify */
1055 /* it under the terms of the GNU General Public License as published by */
1056 /* the Free Software Foundation, either version 3 of the License, or */
1057 /* (at your option) any later version. */
1058 
1059 /* This program is distributed in the hope that it will be useful, */
1060 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
1061 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
1062 /* GNU General Public License for more details. */
1063 
1064 /* You should have received a copy of the GNU General Public License */
1065 /* along with this program. If not, see <http://www.gnu.org/licenses/>. */
1066 
1067 
1068 
1069 /* To compile with gfortran: */
1070 /* 1. Merge all files using copy *.for epmx[nnnn].for */
1071 /* 2. Search and replace all character*65536 with character*131072 */
1072 /* 3. Comment/uncomment getarg lines */
1073 /* 4. gfortran -O pmx[nnnn].for -o pmxab.exe */
1074 
1075 /* To do */
1076 /* Correct Rainer's email address in manual */
1077 /* Linesplit (\\‍) in h */
1078 /* Tt at start of a movement. */
1079 /* Toggle midi on or off; allow midi only. */
1080 /* Page number printed on 1st page even if 1 system. */
1081 /* Still need inserted space for chordal accidentals */
1082 /* Voicewise transposition. */
1083 /* better segno */
1084 /* coda */
1085 /* duevolte */
1086 /* Fix xtup bracket direction in 2-line staves?? (maybe leave as is) */
1087 /* Sticky ornaments with shifts. */
1088 /* Deal with Werner's vertical spacing thing associated with title. */
1089 /* Multiple ties in midi */
1090 /* Werner's missing c in MIDI due to start/stop ties on same note. */
1091 /* Beams with single 64ths */
1092 /* 128ths and/or dotted 64ths */
1093 /* Close out MIDI with integral # of beats? */
1094 /* Increase ast dimensions or redo logic. */
1095 /* Does slur direction get set for user-defined single-note stem dir'ns? */
1096 /* Transpose by sections. */
1097 /* Optimization loop over sections only */
1098 /* Command-line option to read nbarss in. Write out nbarss when optimizing. */
1099 /* (or just read from .plg?) */
1100 /* Beams over bar lines. */
1101 /* 2-digit figures */
1102 /* A real coule (slanted line between notes in a chord) */
1103 /* Dotted slurs for grace notes. */
1104 /* Undotted chord notes with dotted main note. */
1105 /* Forced line break without line number */
1106 /* Fix dot moving when 2nds in chord get flipped */
1107 /* To do: increase length on notexq in dodyn */
1108 /* 2.94 */
1109 /* Allow moving dots on main and chord note in 2-note termolos */
1110 /* Add definitions of \hbp and \hbpp to pmx.tex */
1111 /* 2.91 */
1112 /* Tweak: insert \stdstemfalse before every user-shortened or lengthened stem. */
1113 /* This cancels defaul extensions to middle line and also (with 'L') allows */
1114 /* stems that are longer than 4.66 but still don't reach middle line. */
1115 /* Allow alteration of number height in multibar rest, option n. */
1116 /* Fix bug introduced in 2.89 so that the "o" in "mo800" is now OK. */
1117 /* 2.90 */
1118 /* Many tweaks to allow gaps at end or middle of a system using */
1119 /* L[n]S[x] and LC[y]. New pmx.tex. */
1120 /* 2.88 */
1121 /* Comment out print*,"Changed pathname to..." since it was going */
1122 /* iteration when optimizing linebreaks with the undocumented option Ao. */
1123 /* Add nv back in as argument for getmidi, so loop transferring data */
1124 /* from midivel to midvelc can be executed. This corrects bug and */
1125 /* allows per-instrument change in midi velocities at the start */
1126 /* of any block */
1127 /* Add subroutine inst2chan to transfer midi data as noted above. Works with */
1128 /* Iv but buggy when used with IT and Ib */
1129 /* 2.87 */
1130 /* Allow changes to and from octave treble clef. Instrument with it */
1131 /* must only have one staff. */
1132 /* Some fixes for beam multiplicity changes at staff jumps. Must still */
1133 /* use inline for mult. increase at downward staff jump. See sjb.pmx. */
1134 /* 2.84 */
1135 /* Bug fix: dots in chordal seconds */
1136 /* Bug fix: Initialize ihornb for non-beamed, down xtup */
1137 /* Bug fix: When using "AT" with 2-note x3c rD. */
1138 /* 2.83 */
1139 /* Fix problems when changing to or from octave treble clef. */
1140 /* Fix beaming (or not) and number location for xtups with */
1141 /* multiple rests. Still some problems with number height but */
1142 /* can be band-aided with number height tweak option. */
1143 /* Tweak error messages for options on "R" command. */
1144 /* Allow forced beam height and slope tweaks with 2-note tremolos */
1145 /* Allow chordal note with 2-note tremolos, adding dots as needed. */
1146 /* Fix call to ncmid in beamstrt when setting start height for beam of */
1147 /* 2-note trem, by changing arg from ivx to iv */
1148 /* 2.82 */
1149 /* bugfix: beams with rests, not confused with xtups. */
1150 /* x option after slur index to allow slurs to go from one voice to another. */
1151 /* x option also for ties */
1152 /* 2.81 */
1153 /* Allow string of rests to end xtup */
1154 /* in chordal half-note 2-note tremolo, make chord notes open. */
1155 /* 2.80 */
1156 /* Add 2-note tremolos */
1157 /* 2.78 */
1158 /* Expand bufq to 131072 bytes */
1159 /* Expand maxblks tp 9600 */
1160 /* Allow up to 75 pages */
1161 /* Index postscript hairpins from 1 up instead of by voice #. */
1162 /* Add option 'o' to forced beam for open notehead (\hb); set ipl(3) */
1163 /* Add option T[n], n=1,2,3 for single stem tremolo */
1164 /* 2.77 */
1165 /* Enable AV+/-x+/-y to add vskip bigh before or after \eject */
1166 /* 2.76 */
1167 /* 2.75 */
1168 /* Bugfix: unbeamed xtups with dots: in beamn1 and beamid allow dotted 16th, and */
1169 /* 2 or 3 flags on shortened note. */
1170 /* 2.74 */
1171 /* Bugfix: allow "0" as argument of @ command on lyrics string. */
1172 /* Check for and allow "\ in centered page headings with P command. */
1173 /* Check for and allow "\ in text dynamics with D command. */
1174 /* For lyrics string starting in xtuplet, insert check for inputting musixlyr. */
1175 /* For staff-crossing beamed xtuplet chords, if 2nd segment of a joined beam */
1176 /* starts with a blank rest, put '\sk' into the TeX. */
1177 /* To enable high-to-both beamed etup staff-crossing chord, for blank */
1178 /* rest at start of forced beam, shift \sk's from before to after \ib..; */
1179 /* so \ib is at start and note in upper voice has a beam to connect to. */
1180 /* Expand range of vertical xtup number shift, now stored in mult(16-22) */
1181 /* Check for and allow \" within lyrics strings, for umlauts. */
1182 /* 2.73 (160121) */
1183 /* Dirk's "..." command, to convert "text" into \pmxlyr{text}\ and insert as */
1184 /* inline TeX. Replace all '~' inside "..." and not preceded with '\', by */
1185 /* '\lk '. Right after 2nd ", replace @[a,b][+,-]n with \at{[a,b][+,-]n}\ */
1186 /* Include definitions of \ly and \at in pmx.tex (2 Feb 16). After first ", */
1187 /* add (as type 2 string) '\\input musixlyr \' */
1188 /* After inputting pathname, change any '\' to '/', for Linux compatibility. */
1189 /* 2.72 (160110) */
1190 /* Really finalize \mbrest...go back to 3 args to deal with clef changes. */
1191 /* Fine tune centered whole bar rests to deal with clef changes */
1192 /* Fix bug in wsclef when >1 staff per instrument, since \setclef */
1193 /* needs to know instrument and specify clefs on all staves for that */
1194 /* instrument. Ones that were not changed by user will not be printed, */
1195 /* and will be kept the same as before. */
1196 /* Fix bug with arpegii from one voice to another in same staff. */
1197 /* 2.71 (151226) */
1198 /* Finalize mbrest mods */
1199 /* 2.705 */
1200 /* Fix error message */
1201 /* 2.704 (140614) */
1202 /* Octave treble clef */
1203 /* Make horizontal ornament shift (ornhshft) floating */
1204 /* 2.703 (140323) */
1205 /* Option v[-]n at end of any figure will alter figdrop for rest of system */
1206 /* 2.702 */
1207 /* Stem slurs. Only for ps, assume no other pos'n adjustments. Option "v" */
1208 /* 2.701 */
1209 /* oC = coda (\code{10}) */
1210 /* Move iornq(29) (blank barline) to ipl(0) (changes in pmxb, getnote) */
1211 /* oG = new seqno */
1212 /* To do: fix grace note spacing problem (partially done) */
1213 /* 2.622 */
1214 /* Redefine midtc(..) and miditran(..); clean up all transpositions/key changes */
1215 /* Kn[+/-...] \ignorenats at signature changes */
1216 /* Fix tie checks in doslur() and dopsslur() to subtract iTransAmt from nolevs */
1217 /* before checking and setting pitch levels levson() and levsoff() */
1218 /* Define midisig separately from isig. Put in common commidisig. */
1219 /* Use for explicit midi signature and for accid corrections to midi piches */
1220 /* in addmidi. */
1221 /* 2.621 */
1222 /* Make keyboard rest option work in xtuplets. Created subroutine */
1223 /* chkkbdrests, modified make2bar to include calls to chkkbdrests as rqd. */
1224 /* 2.620 */
1225 /* Allow user-defined rest height tweaks at start of beam. */
1226 /* 2.619 */
1227 /* At movement break, change \nbinstruments in \newmovement macro; add */
1228 /* 3rd arg to \newmovement in pmx.tex; modify pmxb.for and getnote.for */
1229 /* to remove call to newnoi and change call to \newmovement */
1230 /* 2.618 */
1231 /* Add option Ac[l,4] to set vert and horiz size and offsets to properly */
1232 /* center page for letter or a4 paper. */
1233 /* 2.617 */
1234 /* In g1etnote, change if-check for note to use index(...) instead */
1235 /* of ichar(charq) since it was messing up gfortran optimizer */
1236 /* After pmxa, search for and remove penultimate line <blank><blank>/ */
1237 /* because it was screwing up linux-compiled versions */
1238 /* Bugfix: Increase dimension of kicrd from 7 to 10 in crdaccs(...) */
1239 /* 2.616 (111110) */
1240 /* Allow hairpins to span multiple notes groups (gulps). */
1241 /* 2.615+ (110810) */
1242 /* Fix midi when some instruments are transposed, by subtracting */
1243 /* iTransAmt(instno(iv)) from pitch values sent to via addmidi in */
1244 /* make2bar.for (for main notes) and docrd (for chord notes) */
1245 /* 2.615 (110725) */
1246 /* Fig bug with size-setting (in topfile) when instrument has >1 staves */
1247 /* 2.615 (110724) */
1248 /* Make AS[0|-|s|t]... really set sizes */
1249 /* 2.614 */
1250 /* Mod notex.for to fix Terry's bug with raised dotted rests (caused */
1251 /* by double-hboxing). */
1252 /* 2.613 */
1253 /* Bugfix: In pmxa, change "do while" limit to keep from overwriting instno. */
1254 /* 2.612 */
1255 /* Enhance AS to allow s or t for smallsize or tinysize */
1256 /* 2.611 */
1257 /* Error trap for "D" before any notes in a block. */
1258 /* 2.610 */
1259 /* Instrument-wise key changes and transposition (incomplete) */
1260 /* 2.603 */
1261 /* 101211 In getpmxmod.for, decreased nline by 2 to fix locating errors */
1262 /* following reading in an include file. */
1263 /* 101121 Added some error messages in g1etset.for setup data */
1264 /* 2.602 */
1265 /* Correct slur indexing in linebreakslurs. */
1266 /* Account for comment lines in line count for error messages */
1267 /* 2.601 */
1268 /* Bug fix: allow 24 slurs with graces */
1269 /* 2.60 Changes made make it really big */
1270 /* increase mv (size of midi) ? Note: MIDI can't have >16 voices w/o */
1271 /* major reprogramming, and 16 may also be a problem (icmm) */
1272 /* nm=24 (voices) done */
1273 /* 24 slurs done */
1274 /* 24 simultaneous beams (Replace index 24 by 0, so get 0-23) */
1275 /* bufq*131072 (gfortran only) */
1276 /* getarg syntax (gfortran only) */
1277 /* 2.523+ */
1278 /* Fix voice numbering for normal dynamics and text dynamics */
1279 /* 2.523 */
1280 /* Version of bigpmx first posted to Hiroaki's web site. */
1281 /* 2.522 */
1282 /* 5/26/10 Replace ipl bits 0-7 with ipl2, add new common for it. */
1283 /* With 2.521+ as starting version, incorporate bigpmx mods to allow 24 voices. */
1284 /* 5/13/10 Fix log2 function */
1285 /* 5/15/10 Fix bitwise storage for dynamics, fix segnoo string length. */
1286 /* 2.521+ */
1287 /* 091025 Enable dotting 2nd part of linebreak slur or tie. */
1288 /* To adjust barno height due to linebreak slur, use \bnrs instead of */
1289 /* explicitly redefining \raisebarno (pmxb) */
1290 /* 2.521 */
1291 /* Bugfix */
1292 /* 2.520 */
1293 /* 090519 Enable ligfonts (special figured bass characters) */
1294 /* 2.519 */
1295 /* Fix another bug which kept \sk from being output so misaligned some notes. */
1296 /* 2.518 */
1297 /* Fix bugs: referencing fig data, char declaration for member of */
1298 /* common/comfig/ */
1299 /* 2.517 */
1300 /* Allow figures in voice 1 + any one other. */
1301 /* 2.516 */
1302 /* Allow figures in voice #2 */
1303 /* 2.515+ to do: Change manual and activate rule against clef change in voice #2. */
1304 /* 2.515 */
1305 /* 071222 Changes in getnote to allow auto forced beams to start anywhere. */
1306 /* 071206 In make2bar, shift fermataup7 to left over centered pause. */
1307 /* 070901 In doslur, check for nolev <=2 in case slur ends on rest in 2-line */
1308 /* staff (it was screwing up vertical justification). */
1309 /* n34 for tweaks to midi durations of quarter note septuplets. */
1310 /* To do: In ref250.tex, the tables where 's,t,)' is explained, the line */
1311 /* [+,- i] ... Vertical adjustment of the start of second segment */
1312 /* should it be replaced by */
1313 /* [s +,- i] ... Vertical adjustment of the start of second segment */
1314 /* 2.514 */
1315 /* Changes in make2bar to get horizontal spacing right when normal grace */
1316 /* follows after grace */
1317 /* Changes in dograce to get octaves right for any material entered inside */
1318 /* \gaft, which shields transpose register changes from the outside world. */
1319 /* 2.513 */
1320 /* In make1bar, near end, for forced beams starting with a rest, copy hgt and */
1321 /* slope tweaks to ALL notes after first, not just the second one, so if */
1322 /* there's more than one rest at start the tweaks are still observed. */
1323 /* In beamid and beamend, add stand-alone triply-flagged notes for xtups. */
1324 /* 2.512 */
1325 /* Near end of pmxb, fix error trap to allow redundant 'RD' */
1326 /* Enable multiplicity down-up '][' within xtup. */
1327 /* 2.511 */
1328 /* Introduce eskz2 for xtup #'s and bracket lengths, to remove bug caused by */
1329 /* adjusteskz as in bar 7 of barsant. */
1330 /* 2.510a */
1331 /* Test: remove restriction on tempo changes in MIDI macros */
1332 /* Send to CM for beta testing. */
1333 /* 2.509+ */
1334 /* To do: Correct manual on AS. "-" is for smaller staves. */
1335 /* 2.510 */
1336 /* Forgot to declare litq, voltxtq as character in subroutine getgrace */
1337 /* 2.509 */
1338 /* Corrected small bug in arpeggio shifting (ivx <= iv in call putarp) */
1339 /* 2.508 */
1340 /* Allow graces in xtups. New subroutine getgrace. */
1341 /* 2.507 */
1342 /* To do: Raise/lower figures. */
1343 /* To do: Add 24, 29 to list of musicsizes in manual */
1344 /* New sub adjusteskz to account for ask's when computing lengths of */
1345 /* brackets for unbeamed xtups, slopes and horizontal posn's of number */
1346 /* Bug fix: in beamn1, beamid, and beamend, allow unbeamed xtups w/ 2 flags */
1347 /* Add look-left option for keyboard rests, "L" in rest command, set iornq(30) */
1348 /* 2.506 */
1349 /* Fix bug with AK, when simultaneous rests have same duration, use defaults. */
1350 /* 2.505 */
1351 /* Keyboard rests AK */
1352 /* 2.504 */
1353 /* Space after normal grace: option X[n] */
1354 /* Fixed og when nv .ne. noinst, by using sepsymq instead of '&' */
1355 /* (To do) length of xtup bracket when there is added non-collision space. */
1356 /* Trap musicsize if .ne. 16,20,24,29. */
1357 /* 2.503 */
1358 /* Enable arpeggio left shift with ?-x */
1359 /* To do: In manual, arpeggio over 2 staves. */
1360 /* Allow musicsize of 24 and 29. Had to define meter font size explicitly, */
1361 /* also change font size for text dynamics, but not much else so far. */
1362 /* Bugfix in beamstrt, introduced in 2415, ip was changed before putxtn */
1363 /* was called, causing error in printing replacement number. */
1364 /* 2.502 */
1365 /* Incorporate Dirk Laurie's patch to use { , } , for ties. */
1366 /* Figure height adjustment: append +[n] */
1367 /* Change ec font stuff in pmx.tex per Olivier Vogel's comment (CM email?) */
1368 /* 2.501 */
1369 /* Readjust horizontal offset back to .8 in LineBreakTies */
1370 /* Fix zero-subscript (iudorn) in putorn */
1371 /* 2.50 */
1372 /* Increase number of text-dynamics (dimension of txtdynq) per block */
1373 /* from 12 to 41. */
1374 /* Slur option n to override altered default curvature. */
1375 /* Allow default ps slur curvature tweaks with Ap+/-c */
1376 /* 2.416 */
1377 /* Increase length of textdynq from 24 to 128 */
1378 /* (Todo) Add comment in manual about blank lines at end. */
1379 /* Configuration file: Define subroutine getpmxmod, check path in environment */
1380 /* variable pmxmoddir, check existence, read lines into bufq after setup. */
1381 /* Increase dimension on idynn in dodyn from 4 to 10 for max number */
1382 /* of marks in a bar */
1383 /* Increase allowable # of lines from 2000 to 4000. */
1384 /* (To do) Replace definition of \liftpausc per Olivier. */
1385 /* (To do) Fix extraneous error message if RD is placed at very end. */
1386 /* 2.415 */
1387 /* Fix "AT" option: replace putxtn,topfile,beamstrt,beamid to use \xnumt */
1388 /* instead of redefining \xnum. Change font used to \smallfont (as for */
1389 /* normal xtups, */
1390 /* Allow slur to start on rest. */
1391 /* 2.414 */
1392 /* Correct bug in crdacc when adding accidental to boundary causes number of */
1393 /* segments to decrease */
1394 /* Special rule for 3-accidental chords: If no 2nds, place them in order */
1395 /* top, bottom, middle. */
1396 /* 2.413 */
1397 /* Correct bugs in chordal accidentals, related to left-shifted noteheads */
1398 /* (a) Special problems with downstem when main note needs shifting */
1399 /* (b) Assign 0 rank to boundary segs due to left-shifted noteheads */
1400 /* 2.412 */
1401 /* Change default horiz shift of start of seg 2 of linebreak slurs: */
1402 /* -.7 for slurs, -1.2 for ties, */
1403 /* Use height of start of seg 1 slur itself for end of 1 and start of 2. */
1404 /* 2.411 */
1405 /* "Apl" activates special treatment of linebreak slur/tie's; breaks all in 2. */
1406 /* "s" option in start of slur/tie as precursor to vert/horiz tweaks for end */
1407 /* of seg 1. of linebreak slur/tie, 2nd "s" for start of seg2. */
1408 /* With "Apl", curvature adjustments on starting slur command apply to seg 1, */
1409 /* those on ending command to seg 2. */
1410 /* 2.410 */
1411 /* "AT" to allow Col. S.'s tuplet option. Simply input tuplet.tex and redefine */
1412 /* \xnum, \unbkt, \ovbkt. */
1413 /* "s" option in main xtup input after "x": slope tweak for bracket. mult(4) is */
1414 /* flag, mult(5-9) is tweak value+16 */
1415 /* 2.409 */
1416 /* Bugfix in docrd for MIDI: Use original pitch in case main/chord were */
1417 /* switched due to 2nds. */
1418 /* Remove "o" from error message for "A" command. */
1419 /* New syntax: optional instrument number separator ":" in movement */
1420 /* break command to precede a 2-digit instrument. */
1421 /* Conditional output formats for \setname at movement break to allow */
1422 /* instrument numbers >9. */
1423 /* Bugfix in coding to raise barno due to slur over line break (pmxb) */
1424 /* Move date/version data statement in pmxab to a better place. */
1425 /* 2.408 */
1426 /* Allow pnotes{x} when x>9.995 (mod is only to format stmt in make2bar). */
1427 /* Bug fix in \liftPAusep in notex.for and in pmx.tex */
1428 /* Character variables for version and date */
1429 /* For up-stem single graces slurred to down-stem, shift slur start left by */
1430 /* 0.8 so slur doesn't get too short. */
1431 /* Initialize and slide mult, same as other full-program variables in /all/. */
1432 /* 2.407 */
1433 /* Allow AN[n]"[partname]" to be parsed by scor2prt as filename for part n, */
1434 /* 2.406 */
1435 /* Alter PMX: put \dnstrut into \znotes in \starteq (for system spacing */
1436 /* equalization). */
1437 /* Put dimensions of double sharps and flats in crdacc (for chords). */
1438 /* Bugfix: Use sepsymq in LineBreakTies(..) instead of '&' */
1439 /* Use only first 4 bits of mult for multiplicity+8, so rest can be used */
1440 /* for other stuff. */
1441 /* Move stemlength stuff in nacc(27-30) to mult(27-30) to remove conflict. */
1442 /* 2.405: Not published but saved for safety. */
1443 /* Option Aph to write \special{header=psslurs.pro} top of each page, so */
1444 /* dviselec will work OK. */
1445 /* 2.404 */
1446 /* Allow slur to end on rest, but not start on a rest. Efaults height */
1447 /* of ending is default height of start (before any automatic or user- */
1448 /* defined djustments). User may adjust height as normal from default. */
1449 /* 2.403 */
1450 /* Bugfix: turn off repeated beaming patterns.at end of non-last voice. */
1451 /* 2.402 */
1452 /* Automatic repeated forced beams. Start with "[:" End with next explicit */
1453 /* forced beam or end of input block. */
1454 /* Increase # of forced beams per line of music per input block from 20 to 40 */
1455 /* 2.401 */
1456 /* Optional K-Postscript Linebreak Ties, Apl. New subroutine LineBreakTies. */
1457 /* Makes 1st part normal shape, and starts 2nd part a little further left. */
1458 /* Enable arpeggios in xtuplets. Had to make time itar(narp) a real. */
1459 /* 2.40 */
1460 /* Set up WrotePsslurDefaults (logical) so only write defaults on 1st Ap. */
1461 /* Fix non-ps-slur input to \midslur (third signed integer). Do not reverse */
1462 /* sign for down-slurs. */
1463 /* 2.359 */
1464 /* Add error exit subroutine stop1 to make exit status g77-compatible.. */
1465 /* Absolute octave on xtup chord note was 2 octave too high, fixed in getnote */
1466 /* Fermata on vertically shifted rest: special trap in putorn() to set height. */
1467 /* Correct multiple grace note spacing for small staves (in dograce, */
1468 /* define wheadpt1 depending on staff size) */
1469 /* 2.358 */
1470 /* Allow curvature corrections at start of postscript slur, in dopsslur() */
1471 /* Local slur options p[+|-][s|t] for [nos|s]luradjust,[not|t]ieadjust */
1472 /* Options for [Nos|S]luradjust,[Not|T]ieadjust,[noh|h]alfties: Ap[+|-][s|t|h] */
1473 /* Make t[ID] act like s[ID]t, most mods in spsslur(). */
1474 /* Add spsslur() to read in data for ps slurs, call from getnote. */
1475 /* In beamstrt, save args for SetupB in common comipb to save them for */
1476 /* 2nd call when xtup starts with rest */
1477 /* Add spacing for ornament ")" as if it were accidental, in make2bar(). */
1478 /* Horiz shift start and end of ps ties, dep. on stem dir'n, in dopsslur() */
1479 /* Horiz. shift start of ps grace slur, 2 places in dograce(). */
1480 /* Horiz shift end of grace slur in endslur() */
1481 /* Make st slurs into postscript ties. Separate subroutine dopsslur(), */
1482 /* Non-beamed xtup: "a" in 1st note or rest, before "x" (sets drawbm=.false.) */
1483 /* Allow two D"x" on same note. Introduced jtxtdyn1 in dodyn. */
1484 /* 2.357a */
1485 /* Fix missing "end" in backfill.com, too-long lines in g1etnote, getnote */
1486 /* 2.357 */
1487 /* Increase dimension for # of lit TeX strings from 52 to 83. */
1488 /* Allow blank rest in middle of xtuplet. Only mods in g*etnote(). */
1489 /* 2.356 */
1490 /* Increased some dimensions from 30 to 40 to allow up to 40 pages. */
1491 /* In unbeamed xtups, "n" did not suppress bracket. Fixed in beamstrt(). */
1492 /* Fix parsing of "f,h,H,HH" in sslur. */
1493 /* Fix bug with cdot, note-level for slur termination (in getnote) */
1494 /* 2.355 */
1495 /* Midi transposition: IT[+|-][n1][+|-][n2]...[+|-][n(noinst)], */
1496 /* n=# of half-steps. Restrict to mult. of 12 now, to avoid key-sig issues */
1497 /* Make midi recognize ps ties in doslur. */
1498 /* Correct ttieforsl so that it eats 2nd argument properly, using \zcharnote */
1499 /* to get octave right. */
1500 /* 2.354 */
1501 /* With postscript slurs, make t-slurs real ties by inserting replacement */
1502 /* macros \tieforisu, etc, defined in pmx.tex */
1503 /* Check for open cresc or decresc at end of input block, using list[de]cresc */
1504 /* Hairpin syntax conditional on postscript slurs. Backup to fill in start */
1505 /* level, using new backfill(...). Separate height tweaks for */
1506 /* start and finish. */
1507 /* 2.353 */
1508 /* K-0+n to transpose by half step (rather than just change key) */
1509 /* Allow "rm[n]" when nv>1. Require it in all parts. Just write a stack of */
1510 /* \mbrest's */
1511 /* Enable "Rz"; define \setzalaligne in pmx.tex. Special treatment at end */
1512 /* of input block before movement break, and at start of block after */
1513 /* movement break, using \newmovement rather than \setzalaligne, since */
1514 /* former already redefines \stoppiece. In second case, set rptfg2='z'. */
1515 /* Make clefq(nm) common between pmxb and getnote; change references in */
1516 /* getnote at 'M' to array elements, setting all new clefs as you go. */
1517 /* 2.352 */
1518 /* Remove \parskip redefinition from pmx.tex; write it into TeX file when */
1519 /* "Ae" is invoked. */
1520 /* Ap to activate postscript slurs. Add macro \psforts to pmx.tex to redefine */
1521 /* \tslur in case \midslur was used. Allow slur inputs 'f','h','H','HH', */
1522 /* translate them thru mapping to (1,4,5,6) as \midslur params, then let */
1523 /* \psforts translate them back to ps slur macors. */
1524 /* 2.351 */
1525 /* Number slurs from 0 up instead of 11 down, anticipating postscript slurs. */
1526 /* Write "\eightrm" instead of "\cmr8" for \figfont with small baseline size. */
1527 /* Increase length of basenameq to 44 characters everywhere. */
1528 /* Increase dimension of mcpitch (midi-chord-pitch) to 20. */
1529 /* Set default systems per page to 1 if nv>7 */
1530 /* In pmxb, move place where isystpg is reset to 0, so that \eject gets */
1531 /* written when there is just one system per page. */
1532 /* 2.35 */
1533 /* Cautionary accidentals with 'c' anywhere in note symbol. */
1534 /* NEW pmx.tex with \resetsize to set size to normal or small depending on */
1535 /* current \internote. Used with new coding in dograce() to get right */
1536 /* new size in case user has \setsize'ed some lines to \smallvalue. For */
1537 /* \smallvalue-sized staves, redefine \tinynotesize to give 11-pt font. */
1538 /* Affects pmx.tex. */
1539 /* Continuation figure with fractional length. May now mix with other figures. */
1540 /* If another figure follow Cont-fig, separate with colon. */
1541 /* 2.342 */
1542 /* Bugfix in getnote to recognize relative octave shift in grace at start of */
1543 /* input block. */
1544 /* In make2bar, initialize islhgt=0 earlier than before (possible solution */
1545 /* to Suse g77 compile problem that I could not reproduce).. */
1546 /* Bugfix in beamstrt & beamn1 for r2x6 c4D d d d */
1547 /* 2.341 */
1548 /* Syntax check: Forced page break page number must be > than previous. */
1549 /* Bugfix: Define ivx when "sliding down" breath/caesure data in pmxb. */
1550 /* 2.34 */
1551 /* New pmx.tex with redefined liftpausc */
1552 /* Bug fix with dotted, non-beamed xtups. */
1553 /* 2.332 */
1554 /* Fix bugs in horizonal shifts, spacing, for accid's, graces, noteheads. */
1555 /* Allow arbitrary pos. input to W in g1etnote and getnote. */
1556 /* 2.331 */
1557 /* Bug-fix in dodyn(..): typo on length of arg of txtdyn */
1558 /* 2.33 */
1559 /* Caesura (oc), breath (ob). Set iornq(28), store rest of data in ibcdata() */
1560 /* 2.321 */
1561 /* Rescale accidental shifts. Still use 7 bits but now map (0,127) */
1562 /* onto (-1.,5.35) */
1563 /* Fix ihornb bug in dodyn, seen with dynamics on lower-voice non-beamed xtups */
1564 /* 2.32 (Noticed after posting) */
1565 /* Prohibit "/" as figure. */
1566 /* 2.32 (Posted) */
1567 /* Tidied up accidentals in chords, do spacing. */
1568 /* Still to do: */
1569 /* check for "(" on chord notes in spacing algo */
1570 /* small accids */
1571 /* double accids */
1572 /* autoshift slurs */
1573 /* 2.310 */
1574 /* Extra call to precrd ahead of spacing chk, and single-note crd/acc */
1575 /* shifts seem OK, but not multiple. crd/acc shifts not recorded 1st time. */
1576 /* 2.309 */
1577 /* Alternate algo for accid shifts in chords. */
1578 /* 2.308 */
1579 /* Auto horiz. notehead shifting added to precrd. */
1580 /* 2.307 */
1581 /* Auto shifting of multiple accidentals in chords. */
1582 /* "Ao" in main chord note to keep accidentals in order. Set nacc(28). */
1583 /* If there are any manual main or chord note shifts, then */
1584 /* If any manual shift is preceded by "A" then */
1585 /* 1. Auto-shifting proceeds */
1586 /* 2. "A"-shifts add to autoshifts */
1587 /* 3. non-"A" shifts are ignored! */
1588 /* Else (>0 man shifts, none has "A") */
1589 /* No auto-ordering, No autoshifts, */
1590 /* End if */
1591 /* End if */
1592 /* 2.306 */
1593 /* Initialize legacy note level to middle C in case user forgets to set */
1594 /* octave. */
1595 /* Shift xtup note? */
1596 /* Shift in elemskips rather than noteheads? */
1597 /* 2.305 */
1598 /* Stop pmxb from multiple endvolta's at start of new page. */
1599 /* 2.304 */
1600 /* "Sx" in a note means shorten stemlength by x \internotes. "Sx:" turn on */
1601 /* for multiple notes in the voice, "S:" last shortened note. */
1602 /* 2.303 */
1603 /* vshrink stuff all OK? Description is in pmxb. */
1604 /* 2.302 */
1605 /* Toggle vshrink with "Av". vshrink normally kicks in when \interstaff */
1606 /* hits 20. This still needs work. */
1607 /* Add " /" to last line if last char is not % or /. */
1608 /* 2.301 */
1609 /* Check in beamn1 for single note before multiplicity down-up. */
1610 /* allow '.PMX' as well as '.pmx' */
1611 /* 2.299 */
1612 /* Correct typo in pmxb involving PMXbarnotrue. */
1613 /* Replacement printed number for xtup: Unsigned integer after 'n' after 'x' */
1614 /* Minor upgrade parsing xtuplet options 'x...' */
1615 /* Correct dimension of nxtinbm in make2bar. */
1616 /* 2.298 */
1617 /* Account for doubled xtup notes in subroutine getx (user-defined spaces), */
1618 /* by adding ndoub as an argument.. */
1619 /* 2.297 */
1620 /* Created and solved compiler problem. Put drawbm(NM) in its own common. */
1621 /* Add new def'ns [\a|PA]usc, \lift[pa|PA]usc to pmx.tex, use them in make2bar */
1622 /* when \centerbar is used. */
1623 /* Modify \mbrest & \CenterBar in pmx.tex to use \volta@endcor etc. Have PMX */
1624 /* use right 2nd and 3rd args for \mbrest when key, meter, or clef changes. */
1625 /* 2.296 */
1626 /* Correct printed numbers for forced beams with multiple xtups. For each beam */
1627 /* make list in setupb by voice of eloff (h-offset) and mtupv (printed #) */
1628 /* Increase lengths of jobname and infileq by 20 characters */
1629 /* Enable whole notes and breves as 1st or last note of xtup in beamn1 and */
1630 /* beamend, and wholes in beamid. */
1631 /* 2.295 */
1632 /* Midi balance Ib[n1]:[n2]:...[nn] */
1633 /* Single-slope beam groups [...]-[...] */
1634 /* Trap "i" unless after accidental (main notes, xtups, chord notes) */
1635 /* 2.294 */
1636 /* Unequal xtups with "D" to double a note in an xtup. */
1637 /* As above, "F" will (a) increase multiplicity by 1 for marked note and next */
1638 /* one and (b) add a dot to the first one. */
1639 /* Fix bug with e.g. c84 [ .d e.f ] by checking whether forced beam is on */
1640 /* when "." is encountered, then correcting beam start time.(end of getnote) */
1641 /* MIDI velocity (volume) set: Iv[n1]:[n2]:[n3]... */
1642 /* 2.293 */
1643 /* Check for single notes spanning bar lines. */
1644 /* Correct various bugs with staff-jumping beams. (1) for 2nd segment, vxtup */
1645 /* must be set in make2bar since beamstrt is not called, fixing problem with */
1646 /* dot at end. (2) add ivjb2 to flag which voice has 2nd segment and fix */
1647 /* problem when >2 staves. */
1648 /* Add nodur to args of dodyn, so can check if stemless and avoid height tweak */
1649 /* Correct bug in getdyn setting flag in idynda2(0) for manual horiz. tweak */
1650 /* 2.292a */
1651 /* Undo syntax check for Type 2 or 3 TeX string starting in column 1. */
1652 /* Meanwhile, Werner's problem with a mid-line Type 3 string has gone away?! */
1653 /* 2.292 */
1654 /* Allow comments in xtuplets */
1655 /* Enable multiple octave jumps in grace notes. */
1656 /* Allow dynamics in xtuplets. */
1657 /* Fix bug in getdyn searching for end of text string (correct length of lineq */
1658 /* to 128) */
1659 /* Fix bug in dodyn, must ignore horiz. interaction tweak for */
1660 /* user-text (idno = 0) */
1661 /* Syntax check for Type 2 or 3 TeX string starting in column 1 */
1662 /* (NOTE: later undone!) */
1663 /* Syntax check for page number > npages at forced line break. */
1664 /* 2.291 */
1665 /* Fix error in AS command (accid spacing for small systems), making only */
1666 /* one spec per staff, nv total. */
1667 /* Stop using MIDI channel 10 */
1668 /* 2.29 */
1669 /* Fix error in console output format for # of bytes used in MIDI file. */
1670 /* Fix bug in dograce so no space is added between grace and main note when */
1671 /* there is a MIDI-only accidental. */
1672 /* Fix bug so oes?+4 works. It was too ugly to explain. */
1673 /* ...Different ways of storing accidental specs on input and output. */
1674 /* No longer zap \writezbarno in special situations. */
1675 /* Fix bug in dyntxt level on rest */
1676 /* Line spacing equalization. Add macros \starteq, \endeq, \spread, etc. */
1677 /* Activate with Ae. (Maybe later could input alternate values for */
1678 /* \upamt, \dnamt, \parskip). Put \starteq on 1st note in voice 1 */
1679 /* in the page, and \endeq on 1st note of next-to-last line in page. */
1680 /* 2.28 */
1681 /* Flip direction of forced beam "[f..." */
1682 /* Fix beam numbering for staff jumping beams. Uses irest(23,24,29,30) */
1683 /* Fix bug in sliding ip's for txtdyn's */
1684 /* In dyn's allow vert. offsets +/-64, horiz +/-25.6 (store in idnyda2(1-99) */
1685 /* 2.27 */
1686 /* Comment out lines in dodyn checking number of dynamic marks found. Voice */
1687 /* order may not be monotonic if two lines on a staff. */
1688 /* Literal dynamic: D"[text]" */
1689 /* 2.26 */
1690 /* Allow hairpin start-stop on same note by disabling auto-tweaks in dodyn, */
1691 /* increasing dimension of idynn to 4 to allow 4 symbols on same note. */
1692 /* Increase voltxtq length from 10 to 20. */
1693 /* AS[-/0][-/0]... to inform PMX that "-" voices are small, and rough */
1694 /* accounting for ast's is done by defining effective headwidth */
1695 /* whead1 in makebar2 to be 0.8*whead. */
1696 /* 2.25 */
1697 /* Fix logic bug with sepsym's when # of instruments changes. */
1698 /* Slight increases in default offsets for hairpin starts after "p" */
1699 /* 2.24 */
1700 /* Hairpins D< or D> as toggle. */
1701 /* Many automatic position tweaks for letter-group dynamics and hairpins. */
1702 /* 2.23 */
1703 /* Continued rhythmic shortcuts: space followed by "." or "," */
1704 /* 2.22 */
1705 /* In call to doslur, change tno(...) to tnote(...). This was only */
1706 /* used when checking to slurs per stem directions, and should have been */
1707 /* the note duration all along. */
1708 /* MIDI-only accidental, bit 17 in nacc, or 27 in icrdat. */
1709 /* Use "i" anywhere in note symbol. */
1710 /* 2.21 */
1711 /* Increase from 20 to 30 dimensions for movement breaks and midi sections. */
1712 /* Fix out-of-order declarations per mutex comments */
1713 /* Add "Bad error" and "Kluging" messages to log file. */
1714 /* 2.197 */
1715 /* add /comips/ to save tie-check midi variables */
1716 /* For spacing of clef changes at start of input block, changed integer time */
1717 /* lastnodur to prevtn, so it works with xtups. Possible incompatibility! */
1718 /* 2.196 */
1719 /* Fix Ickbug with time check in ncmid() */
1720 /* Interchange \fermataup7 and \pausec to get proper alignment */
1721 /* Enable French violin clef "f", number 7 in PMX, but 9 in MusiXTeX. */
1722 /* Add defn's of \hsp, \hspp to pmx.tex */
1723 /* Fix pre-slurs on xtup chord notes. */
1724 /* Fixed raised PAuse, define \liftPAuse */
1725 /* Replace \zbreve\sk with \breve. */
1726 /* Made "1" work as mtrdenl by doubling it and mtrnuml. BUT WAIT...what */
1727 /* about "o" and 1 as shorthand for 16???? Search for "Kluge" */
1728 /* Added "vo" (voice) as MIDI instrument 55 */
1729 /* Allow 3-digit page numbers (search for "toppageno") */
1730 /* Fix bug caused by prior fix (cancelling accid after bar line was ignored). */
1731 /* Fix double accids in chords */
1732 /* 2.194 */
1733 /* Fix bug with accid/tie/barline/chord in addmidi by restructuring accid if */
1734 /* block. */
1735 /* Add meter to MIDI file with every pause */
1736 /* Purify FORTRAN? */
1737 /* 2.193 */
1738 /* Increased # of in-line TeX strings from 36 to 52. */
1739 /* Fix entry of # of bytes in header of tempo/meter/key track to allow >255. */
1740 /* 2.191 */
1741 /* Event track: Tempos, meters, keys all together. Data in comevent */
1742 /* 2.15 */
1743 /* Pretty good midi capability. Still no attention to slurs on chord notes. */
1744 /* 2.11 */
1745 /* 11 Dec 99 c rm1 */
1746 /* 11 Dec 99 "oes?", "oe?" */
1747 /* 11 Dec 99 Cancel slur horizontal tweaks with non-stemmed notes */
1748 /* 11 Dec 99 Error message for shifted, repeated ornaments. */
1749 /* 2.10 (Version 2.1) */
1750 /* Fix bug with lowdot and xtuplets */
1751 /* 2.09 */
1752 /* Fix bug with multiple ornament heights over beams, when one is . or _ */
1753 /* Error message from pmxa if rest on last note of xtup. */
1754 /* Enable 12 slurs. */
1755 /* Reinstate multiple rests at start of xtup. */
1756 /* 2.07 */
1757 /* Combine consecutive type-1 TeX strings. */
1758 /* \midslur and \curve as 3rd signed digit in slur termination, + 2 opt.int's. */
1759 /* Fixed breve chord notes in docrd */
1760 /* Check irest(28) as well as vxtup when setting nodur for chord notes, since */
1761 /* vxtup isn't set until 1st *main* note in xtup */
1762 /* Vectorize nolev1, slope, ixrest. Klug fix for xtups with variable spacing. */
1763 /* 2.06+ */
1764 /* Make deterministic the beam slope calculation when there are an even # of */
1765 /* slopes in list and middle two are equal magnitude but opposite sign. */
1766 /* pmxa Trap for "o:" before 1st note in block */
1767 /* Partial bug fix for 64th notes in xtuplets. */
1768 /* Make ixrest a vector, since with new time scheme may not finish xtup in */
1769 /* same notes block. */
1770 /* Increase max # of pages from 20 to 30 (dimensions of nsystp,..., in pmxb) */
1771 /* 2.06 */
1772 /* Account for changes in nv when computing \interstaff. Add a counter */
1773 /* nistaff(iflb) = # of interstaff spaces per system = nv-1. Set whenever */
1774 /* setting isysflb(iflb). Note nv can only change at a forced line break. */
1775 /* Note also, iflb starts at 0! */
1776 /* 2.05 */
1777 /* Automatic start of new notes group with part 2 of staff-jump beam */
1778 /* In make1bar, set irest bit 29 of lowest-voice note at same time, */
1779 /* use as flag when making notes groups. */
1780 /* For now, remove dummy blank line at end...it zaps terminal repeats. */
1781 /* 2.02 */
1782 /* Fixed slur-counting bug for multiple, slurred, aftergraces. */
1783 /* 2.01 */
1784 /* Increase to ask(1400) */
1785 /* Increase max forced page breaks to 18 */
1786 /* Define pausc for centered pause */
1787 /* 2.0a */
1788 /* Insert dummy blank line at very end to handle input files w/o terminal CR-LF */
1789 /* pmx03r */
1790 /* Option m[n] in S symbol to change musicsize (for parts) */
1791 /* Double dotted rests now work. */
1792 /* Write file name to log file */
1793 /* Check existence of input file */
1794 /* Allow 24-char jobname, may end with ".pmx" */
1795 /* Comment out time stuff */
1796 /* Replace 3-argument getarg with 2-argument + iargc */
1797 /* Fix bug with negative noinst due to nint<=int replacement */
1798 /* move lovation of iv in isdat1 to allow iv>7. */
1799 /* Set nm=12 */
1800 /* pmx03q */
1801 /* replace int(x+.001) with nint(x) */
1802 /* Write TeX file name to screen and to pml. */
1803 /* Replace char(...) with chax(...) to sovle msdev bug. */
1804 /* Bug fix: macro terminations when M is on a line by itself. */
1805 /* Bug fix: don't accumulate space for XS in pmxa. */
1806 /* Streamline Macros: use pointers to bufq instead of scratch files */
1807 /* pmx03p */
1808 /* Store input file in single character array bufq. */
1809 /* lbuf(i)*2 is length of line i */
1810 /* ipbuf is position just before next line to be read. */
1811 /* pmx03 */
1812 /* Optimize read/writes */
1813 /* pmx02 */
1814 /* Fix line count (for errors) when there are saved macros */
1815 /* pmx01 */
1816 /* In optimize mode, open/close macros (Watch out for residual zz files!) */
1817 /* Command line input */
1818 /* Option Ao to optimize, otherwise normal processing */
1819 
1820 /* cccccc */
1821 
1822 /* Added 130302 only to get nsperi from g1etnote, for use in midi setup */
1823 
1824 
1825 /* immac(i) is the index of i-th macro, i=1,nmac. Also make a list containing */
1826 /* nmidsec section starts and stops based on PLAYING macros (not recording). */
1827 
1828 /* cccccccccccccccccccccccc */
1829 
1830 
1831 /* cccccccccccccccccccccccc */
1832 /* itstart = mytime() */
1833 #line 838 ""
1834  s_copy(comver_1.versionc, version, (ftnlen)5, (ftnlen)5);
1835 
1836 /* Initialize midi parameters */
1837 
1838 #line 842 ""
1839  commmac_1.gottempo = FALSE_;
1840 #line 843 ""
1841  commidi_1.ismidi = FALSE_;
1842 #line 844 ""
1843  commidi_1.debugmidi = FALSE_;
1844 #line 845 ""
1845  commidi_1.relacc = FALSE_;
1846 #line 846 ""
1847  commmac_1.mmacrec = FALSE_;
1848 #line 847 ""
1849  commmac_1.nmidsec = 1;
1850 #line 848 ""
1851  commidi_1.mgap = 10;
1852 #line 849 ""
1853  comevent_1.miditime = 0;
1854 #line 850 ""
1855  comevent_1.lasttime = 0;
1856 #line 851 ""
1857  commidi_1.nmidcrd = 0;
1858 #line 852 ""
1859  comslm_1.nusebl = 0;
1860 #line 853 ""
1861  commidi_1.notmain = FALSE_;
1862 #line 854 ""
1863  for (ivx = 1; ivx <= 24; ++ivx) {
1864 #line 855 ""
1865  commidi_1.twoline[ivx - 1] = FALSE_;
1866 #line 856 ""
1867  commidi_1.midinst[ivx - 1] = 6;
1868 #line 857 ""
1869  commvel_1.midivel[ivx - 1] = 127;
1870 #line 858 ""
1871  commvel_1.midibal[ivx - 1] = 64;
1872 #line 859 ""
1873  commvel_1.miditran[ivx - 1] = 0;
1874 #line 860 ""
1875 /* L3: */
1876 #line 860 ""
1877  }
1878 #line 861 ""
1879  for (icm = 0; icm <= 24; ++icm) {
1880 #line 862 ""
1881  commidi_1.imidi[icm] = 0;
1882 #line 863 ""
1883  commidi_1.restpend[icm] = FALSE_;
1884 #line 864 ""
1885  commidi_1.trest[icm] = 0.f;
1886 #line 865 ""
1887  comslm_1.levson[icm] = 0;
1888 #line 866 ""
1889  comslm_1.levsoff[icm] = 0;
1890 #line 867 ""
1891  comslm_1.slmon[icm] = FALSE_;
1892 #line 868 ""
1893  comslm_1.naccbl[icm] = 0;
1894 #line 869 ""
1895  comdiag_1.n69[icm] = 0;
1896 #line 870 ""
1897  comdiag_1.n34[icm] = 0;
1898 #line 871 ""
1899  commmac_1.msecstrt[icm] = 1;
1900 #line 872 ""
1901 /* L12: */
1902 #line 872 ""
1903  }
1904 
1905 /* End of midi parameter initialization */
1906 
1907 #line 876 ""
1908  commus_1.musize = 0;
1909 #line 877 ""
1910  optimize = FALSE_;
1911 #line 878 ""
1912  numargs = iargc_();
1913 #line 879 ""
1914  if (numargs == 0) {
1915 #line 880 ""
1916  s_wsle(&io___10);
1917 #line 880 ""
1918  do_lio(&c__9, &c__1, "You could have entered a jobname on the comman"\
1919  "d line,", (ftnlen)53);
1920 #line 880 ""
1921  e_wsle();
1922 #line 881 ""
1923  s_wsle(&io___11);
1924 #line 881 ""
1925  do_lio(&c__9, &c__1, " but you may enter one now:", (ftnlen)32);
1926 #line 881 ""
1927  e_wsle();
1928 #line 882 ""
1929  s_rsfe(&io___12);
1930 #line 882 ""
1931  do_fio(&c__1, jobname, (ftnlen)44);
1932 #line 882 ""
1933  e_rsfe();
1934 #line 883 ""
1935  numargs = 1;
1936 #line 884 ""
1937  } else {
1938 /* call getarg(1,jobname,idum) ! May need to replace this w/ next line */
1939 #line 886 ""
1940  getarg_(&c__1, jobname, (ftnlen)44);
1941 #line 887 ""
1942  }
1943 #line 888 ""
1944 L10:
1945 #line 888 ""
1946  ljob = lenstr_(jobname, &c__44, (ftnlen)44);
1947 #line 889 ""
1948  if (ljob > 44) {
1949 #line 890 ""
1950  s_wsle(&io___15);
1951 #line 890 ""
1952  do_lio(&c__9, &c__1, "Jobname is too long. Try again.", (ftnlen)31);
1953 #line 890 ""
1954  e_wsle();
1955 #line 891 ""
1956  stop1_();
1957 #line 892 ""
1958  } else if (ljob == 0) {
1959 #line 893 ""
1960  s_wsle(&io___16);
1961 #line 893 ""
1962  do_lio(&c__9, &c__1, "No was jobname entered. Try again.", (ftnlen)34)
1963  ;
1964 #line 893 ""
1965  e_wsle();
1966 #line 894 ""
1967  stop1_();
1968 #line 895 ""
1969  } else if (numargs == 2) {
1970 #line 896 ""
1971  if (ljob == 2 && s_cmp(jobname, "-o", (ftnlen)2, (ftnlen)2) == 0) {
1972 #line 897 ""
1973  optimize = TRUE_;
1974 /* call getarg(2,jobname,idum) ! May need to replace this w/ next line */
1975 #line 899 ""
1976  getarg_(&c__2, jobname, (ftnlen)44);
1977 #line 900 ""
1978  numargs = 1;
1979 #line 901 ""
1980  goto L10;
1981 #line 902 ""
1982  } else {
1983 #line 903 ""
1984  s_wsle(&io___17);
1985 #line 903 ""
1986  do_lio(&c__9, &c__1, "Illegal option on command line", (ftnlen)30)
1987  ;
1988 #line 903 ""
1989  e_wsle();
1990 #line 904 ""
1991  stop1_();
1992 #line 905 ""
1993  }
1994 #line 906 ""
1995  }
1996 
1997 /* Strip ".pmx" if necessary */
1998 
1999 /* Computing MAX */
2000 #line 910 ""
2001  i__1 = i_indx(jobname, ".pmx", (ftnlen)44, (ftnlen)4), i__2 = i_indx(
2002  jobname, ".PMX", (ftnlen)44, (ftnlen)4);
2003 #line 910 ""
2004  ndxpmx = max(i__1,i__2);
2005 #line 911 ""
2006  if (ndxpmx > 0) {
2007 #line 912 ""
2008  s_copy(jobname, jobname, (ftnlen)44, ndxpmx - 1);
2009 #line 913 ""
2010  ljob += -4;
2011 #line 914 ""
2012  }
2013 
2014 /* Check for existence of input file */
2015 
2016 /* Writing concatenation */
2017 #line 918 ""
2018  i__3[0] = ljob, a__1[0] = jobname;
2019 #line 918 ""
2020  i__3[1] = 4, a__1[1] = ".pmx";
2021 #line 918 ""
2022  s_cat(infileq, a__1, i__3, &c__2, (ftnlen)47);
2023 #line 919 ""
2024  ioin__1.inerr = 0;
2025 #line 919 ""
2026  ioin__1.infilen = 47;
2027 #line 919 ""
2028  ioin__1.infile = infileq;
2029 #line 919 ""
2030  ioin__1.inex = &fexist;
2031 #line 919 ""
2032  ioin__1.inopen = 0;
2033 #line 919 ""
2034  ioin__1.innum = 0;
2035 #line 919 ""
2036  ioin__1.innamed = 0;
2037 #line 919 ""
2038  ioin__1.inname = 0;
2039 #line 919 ""
2040  ioin__1.inacc = 0;
2041 #line 919 ""
2042  ioin__1.inseq = 0;
2043 #line 919 ""
2044  ioin__1.indir = 0;
2045 #line 919 ""
2046  ioin__1.infmt = 0;
2047 #line 919 ""
2048  ioin__1.inform = 0;
2049 #line 919 ""
2050  ioin__1.inunf = 0;
2051 #line 919 ""
2052  ioin__1.inrecl = 0;
2053 #line 919 ""
2054  ioin__1.innrec = 0;
2055 #line 919 ""
2056  ioin__1.inblank = 0;
2057 #line 919 ""
2058  f_inqu(&ioin__1);
2059 #line 920 ""
2060  if (! fexist) {
2061 #line 921 ""
2062  ioin__1.inerr = 0;
2063 #line 921 ""
2064  ioin__1.infilen = ljob + 4;
2065 /* Writing concatenation */
2066 #line 921 ""
2067  i__3[0] = ljob, a__1[0] = jobname;
2068 #line 921 ""
2069  i__3[1] = 4, a__1[1] = ".PMX";
2070 #line 921 ""
2071  s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48);
2072 #line 921 ""
2073  ioin__1.infile = ch__1;
2074 #line 921 ""
2075  ioin__1.inex = &fexist;
2076 #line 921 ""
2077  ioin__1.inopen = 0;
2078 #line 921 ""
2079  ioin__1.innum = 0;
2080 #line 921 ""
2081  ioin__1.innamed = 0;
2082 #line 921 ""
2083  ioin__1.inname = 0;
2084 #line 921 ""
2085  ioin__1.inacc = 0;
2086 #line 921 ""
2087  ioin__1.inseq = 0;
2088 #line 921 ""
2089  ioin__1.indir = 0;
2090 #line 921 ""
2091  ioin__1.infmt = 0;
2092 #line 921 ""
2093  ioin__1.inform = 0;
2094 #line 921 ""
2095  ioin__1.inunf = 0;
2096 #line 921 ""
2097  ioin__1.inrecl = 0;
2098 #line 921 ""
2099  ioin__1.innrec = 0;
2100 #line 921 ""
2101  ioin__1.inblank = 0;
2102 #line 921 ""
2103  f_inqu(&ioin__1);
2104 #line 922 ""
2105  if (! fexist) {
2106 #line 923 ""
2107  s_wsle(&io___21);
2108 /* Writing concatenation */
2109 #line 923 ""
2110  i__3[0] = 17, a__1[0] = "Cannot find file ";
2111 #line 923 ""
2112  i__3[1] = 47, a__1[1] = infileq;
2113 #line 923 ""
2114  s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)64);
2115 #line 923 ""
2116  do_lio(&c__9, &c__1, ch__2, (ftnlen)64);
2117 #line 923 ""
2118  e_wsle();
2119 #line 924 ""
2120  stop1_();
2121 #line 925 ""
2122  } else {
2123 /* Writing concatenation */
2124 #line 926 ""
2125  i__3[0] = ljob, a__1[0] = jobname;
2126 #line 926 ""
2127  i__3[1] = 4, a__1[1] = ".PMX";
2128 #line 926 ""
2129  s_cat(infileq, a__1, i__3, &c__2, (ftnlen)47);
2130 #line 927 ""
2131  }
2132 #line 928 ""
2133  }
2134 
2135 /* Open a log file */
2136 
2137 #line 932 ""
2138  o__1.oerr = 0;
2139 #line 932 ""
2140  o__1.ounit = 15;
2141 #line 932 ""
2142  o__1.ofnmlen = ljob + 4;
2143 /* Writing concatenation */
2144 #line 932 ""
2145  i__3[0] = ljob, a__1[0] = jobname;
2146 #line 932 ""
2147  i__3[1] = 4, a__1[1] = ".pml";
2148 #line 932 ""
2149  s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48);
2150 #line 932 ""
2151  o__1.ofnm = ch__1;
2152 #line 932 ""
2153  o__1.orl = 0;
2154 #line 932 ""
2155  o__1.osta = 0;
2156 #line 932 ""
2157  o__1.oacc = 0;
2158 #line 932 ""
2159  o__1.ofm = 0;
2160 #line 932 ""
2161  o__1.oblnk = 0;
2162 #line 932 ""
2163  f_open(&o__1);
2164 /* Writing concatenation */
2165 #line 933 ""
2166  i__4[0] = 21, a__2[0] = "This is PMX, Version ";
2167 #line 933 ""
2168  i__4[1] = 5, a__2[1] = version;
2169 #line 933 ""
2170  i__4[2] = 2, a__2[2] = ", ";
2171 #line 933 ""
2172  i__4[3] = 9, a__2[3] = date;
2173 #line 933 ""
2174  s_cat(ch__3, a__2, i__4, &c__4, (ftnlen)37);
2175 #line 933 ""
2176  printl_(ch__3, (ftnlen)37);
2177 #line 934 ""
2178  ljob4 = ljob;
2179 /* Writing concatenation */
2180 #line 935 ""
2181  i__3[0] = 8, a__1[0] = "Opening ";
2182 #line 935 ""
2183  i__3[1] = 47, a__1[1] = infileq;
2184 #line 935 ""
2185  s_cat(ch__4, a__1, i__3, &c__2, (ftnlen)55);
2186 #line 935 ""
2187  printl_(ch__4, (ftnlen)55);
2188 #line 936 ""
2189  o__1.oerr = 0;
2190 #line 936 ""
2191  o__1.ounit = 18;
2192 #line 936 ""
2193  o__1.ofnmlen = 47;
2194 #line 936 ""
2195  o__1.ofnm = infileq;
2196 #line 936 ""
2197  o__1.orl = 0;
2198 #line 936 ""
2199  o__1.osta = 0;
2200 #line 936 ""
2201  o__1.oacc = 0;
2202 #line 936 ""
2203  o__1.ofm = 0;
2204 #line 936 ""
2205  o__1.oblnk = 0;
2206 #line 936 ""
2207  f_open(&o__1);
2208 
2209 /* Copy input file into common buffer */
2210 
2211 #line 940 ""
2212  inbuff_1.ipbuf = 0;
2213 #line 941 ""
2214  truelinecount_1.linewcom[0] = 1;
2215 #line 942 ""
2216  for (inbuff_1.ilbuf = 1; inbuff_1.ilbuf <= 9600; ++inbuff_1.ilbuf) {
2217 #line 943 ""
2218  ncomments = 0;
2219 #line 944 ""
2220 L14:
2221 #line 944 ""
2222  i__1 = s_rsfe(&io___24);
2223 #line 944 ""
2224  if (i__1 != 0) {
2225 #line 944 ""
2226  goto L9;
2227 #line 944 ""
2228  }
2229 #line 944 ""
2230  i__1 = do_fio(&c__1, lnholdq, (ftnlen)128);
2231 #line 944 ""
2232  if (i__1 != 0) {
2233 #line 944 ""
2234  goto L9;
2235 #line 944 ""
2236  }
2237 #line 944 ""
2238  i__1 = e_rsfe();
2239 #line 944 ""
2240  if (i__1 != 0) {
2241 #line 944 ""
2242  goto L9;
2243 #line 944 ""
2244  }
2245 #line 945 ""
2246  inbuff_1.lbuf[inbuff_1.ilbuf - 1] = (shortint) lenstr_(lnholdq, &
2247  c__128, (ftnlen)128);
2248 #line 946 ""
2249  if (inbuff_1.lbuf[inbuff_1.ilbuf - 1] == 0) {
2250 
2251 /* Blank line. Make it a single blank with length 1 */
2252 
2253 #line 950 ""
2254  inbuff_1.lbuf[inbuff_1.ilbuf - 1] = 1;
2255 #line 951 ""
2256  s_copy(lnholdq, " ", (ftnlen)128, (ftnlen)1);
2257 #line 952 ""
2258  }
2259 
2260 /* Now line has at least one non blank character. Check for comment */
2261 /* As of Version 260, do not copy comments into bufq */
2262 /* But need to count %'s for error messaging */
2263 /* if (lnholdq(1:1).eq.'%') go to 14 */
2264 #line 958 ""
2265  if (*(unsigned char *)lnholdq == '%') {
2266 #line 959 ""
2267  ++ncomments;
2268 #line 960 ""
2269  goto L14;
2270 #line 961 ""
2271  }
2272 
2273 /* When here, have counted all preceding comments and have a real line */
2274 
2275 #line 965 ""
2276  if (inbuff_1.ilbuf > 1) {
2277 #line 966 ""
2278  truelinecount_1.linewcom[inbuff_1.ilbuf - 1] =
2279  truelinecount_1.linewcom[inbuff_1.ilbuf - 2] + 1 +
2280  ncomments;
2281 #line 967 ""
2282  } else {
2283 #line 968 ""
2284  truelinecount_1.linewcom[0] = ncomments + 1;
2285 #line 969 ""
2286  }
2287 #line 970 ""
2288  if (inbuff_1.ipbuf + inbuff_1.lbuf[inbuff_1.ilbuf - 1] > 131072) {
2289 #line 971 ""
2290  s_wsle(&io___26);
2291 #line 971 ""
2292  do_lio(&c__9, &c__1, "Too many characters in file, stopping", (
2293  ftnlen)37);
2294 #line 971 ""
2295  e_wsle();
2296 #line 972 ""
2297  stop1_();
2298 #line 973 ""
2299  }
2300 #line 974 ""
2301  i__1 = inbuff_1.ipbuf;
2302 #line 974 ""
2303  s_copy(inbuff_1.bufq + i__1, lnholdq, inbuff_1.ipbuf + inbuff_1.lbuf[
2304  inbuff_1.ilbuf - 1] - i__1, (ftnlen)128);
2305 #line 975 ""
2306  inbuff_1.ipbuf += inbuff_1.lbuf[inbuff_1.ilbuf - 1];
2307 #line 976 ""
2308 /* L8: */
2309 #line 976 ""
2310  }
2311 #line 977 ""
2312  printl_("Too many lines in input file", (ftnlen)28);
2313 #line 978 ""
2314  stop1_();
2315 #line 979 ""
2316 L9:
2317 
2318 /* Insert dummy line to handle input files w/o CR-LF at end. */
2319 
2320 #line 983 ""
2321  inbuff_1.nlbuf = inbuff_1.ilbuf - 1;
2322 /* nlbuf = ilbuf */
2323 /* bufq(ipbuf+1:ipbuf+3) = ' / ' */
2324 /* lbuf(nlbuf) = 3 */
2325 #line 987 ""
2326  cl__1.cerr = 0;
2327 #line 987 ""
2328  cl__1.cunit = 18;
2329 #line 987 ""
2330  cl__1.csta = 0;
2331 #line 987 ""
2332  f_clos(&cl__1);
2333 #line 988 ""
2334  i__1 = maxit;
2335 #line 988 ""
2336  for (numit = 1; numit <= i__1; ++numit) {
2337 #line 989 ""
2338  if (optimize) {
2339 #line 989 ""
2340  printl_("Starting an iteration", (ftnlen)21);
2341 #line 989 ""
2342  }
2343 
2344 /* When isfirst=.true., pmxa() generates linebreaks normally, output in nbars0. */
2345 /* Otherwise, nbars0 is the input */
2346 /* When islast=.false., pmxb only returns poe's, otherwise does whole job */
2347 
2348 #line 995 ""
2349  pmxa_(jobname, &ljob4, &isfirst, &nsyst, nbars0, &optimize, (ftnlen)
2350  44);
2351 #line 996 ""
2352  if (! optimize) {
2353 #line 997 ""
2354  if (commidi_1.ismidi) {
2355 
2356 /* This was moved here from writemidi 130302 to allow midivel,bal,tran, to be */
2357 /* set up here as functions of instrument rather than iv (staff). */
2358 /* Count up staves(iv,nv) vs instruments. Store instr# for iv in iinsiv(iv) */
2359 
2360 #line 1003 ""
2361  nstaves = 0;
2362 #line 1004 ""
2363  ivt = 0;
2364 #line 1005 ""
2365  for (iinst = 1; iinst <= 24; ++iinst) {
2366 #line 1006 ""
2367  nstaves += c1omget_1.nsperi[iinst - 1];
2368 #line 1007 ""
2369  i__2 = c1omget_1.nsperi[iinst - 1];
2370 #line 1007 ""
2371  for (ivtt = 1; ivtt <= i__2; ++ivtt) {
2372 #line 1008 ""
2373  ++ivt;
2374 #line 1009 ""
2375  commvel_1.iinsiv[ivt - 1] = (shortint) iinst;
2376 #line 1010 ""
2377 /* L17: */
2378 #line 1010 ""
2379  }
2380 #line 1011 ""
2381  if (nstaves == a1ll_1.nv) {
2382 #line 1011 ""
2383  goto L18;
2384 #line 1011 ""
2385  }
2386 #line 1012 ""
2387 /* L16: */
2388 #line 1012 ""
2389  }
2390 #line 1013 ""
2391  s_wsle(&io___34);
2392 #line 1013 ""
2393  do_lio(&c__9, &c__1, "Screwup!", (ftnlen)8);
2394 #line 1013 ""
2395  e_wsle();
2396 #line 1014 ""
2397  stop1_();
2398 #line 1015 ""
2399 L18:
2400 
2401 /* Set up channel numbers for midi. */
2402 
2403 #line 1019 ""
2404  commidi_1.numchan = 0;
2405 #line 1020 ""
2406  for (a1ll_1.iv = a1ll_1.nv; a1ll_1.iv >= 1; --a1ll_1.iv) {
2407 #line 1021 ""
2408  if (commidi_1.twoline[a1ll_1.iv - 1]) {
2409 #line 1022 ""
2410  commidi_1.midchan[a1ll_1.iv + 23] = commidi_1.numchan;
2411 #line 1023 ""
2412  ++commidi_1.numchan;
2413 #line 1024 ""
2414  }
2415 #line 1025 ""
2416  commidi_1.midchan[a1ll_1.iv - 1] = commidi_1.numchan;
2417 #line 1026 ""
2418  ++commidi_1.numchan;
2419 #line 1027 ""
2420 /* L11: */
2421 #line 1027 ""
2422  }
2423 
2424 /* numchan will now be the number of channels, but max channel # is numchan-1 */
2425 
2426 /* Set up velocities, balances, and midi-transpositions */
2427 
2428 #line 1033 ""
2429  for (a1ll_1.iv = a1ll_1.nv; a1ll_1.iv >= 1; --a1ll_1.iv) {
2430 #line 1034 ""
2431  if (commidi_1.twoline[a1ll_1.iv - 1]) {
2432 /* 130302 Make these functions of instrument rather than staff (iv) */
2433 /* midvelc(midchan(iv,2)) = midivel(iv) */
2434 /* midbc(midchan(iv,2)) = midibal(iv) */
2435 /* midtc(midchan(iv,2)) = miditran(iv) */
2436 #line 1039 ""
2437  commvel_1.midvelc[commidi_1.midchan[a1ll_1.iv + 23]] =
2438  commvel_1.midivel[commvel_1.iinsiv[a1ll_1.iv
2439  - 1] - 1];
2440 #line 1040 ""
2441  commvel_1.midbc[commidi_1.midchan[a1ll_1.iv + 23]] =
2442  commvel_1.midibal[commvel_1.iinsiv[a1ll_1.iv
2443  - 1] - 1];
2444 #line 1041 ""
2445  commvel_1.midtc[commidi_1.midchan[a1ll_1.iv + 23]] =
2446  commvel_1.miditran[commvel_1.iinsiv[a1ll_1.iv
2447  - 1] - 1];
2448 #line 1042 ""
2449  }
2450 /* midvelc(midchan(iv,1)) = midivel(iv) */
2451 /* midbc(midchan(iv,1)) = midibal(iv) */
2452 /* midtc(midchan(iv,1)) = miditran(iv) */
2453 #line 1046 ""
2454  commvel_1.midvelc[commidi_1.midchan[a1ll_1.iv - 1]] =
2455  commvel_1.midivel[commvel_1.iinsiv[a1ll_1.iv - 1]
2456  - 1];
2457 #line 1047 ""
2458  commvel_1.midbc[commidi_1.midchan[a1ll_1.iv - 1]] =
2459  commvel_1.midibal[commvel_1.iinsiv[a1ll_1.iv - 1]
2460  - 1];
2461 #line 1048 ""
2462  commvel_1.midtc[commidi_1.midchan[a1ll_1.iv - 1]] =
2463  commvel_1.miditran[commvel_1.iinsiv[a1ll_1.iv - 1]
2464  - 1];
2465 #line 1049 ""
2466 /* L13: */
2467 #line 1049 ""
2468  }
2469 #line 1050 ""
2470  }
2471 
2472 /* TEMPORARY!!! */
2473 
2474 #line 1054 ""
2475  s_wsle(&io___35);
2476 #line 1054 ""
2477  do_lio(&c__9, &c__1, "nlbuf: ", (ftnlen)7);
2478 #line 1054 ""
2479  do_lio(&c__3, &c__1, (char *)&inbuff_1.nlbuf, (ftnlen)sizeof(
2480  integer));
2481 #line 1054 ""
2482  e_wsle();
2483 #line 1055 ""
2484  ip1 = 1;
2485 #line 1056 ""
2486  i__2 = inbuff_1.nlbuf;
2487 #line 1056 ""
2488  for (ilb = 1; ilb <= i__2; ++ilb) {
2489 /* write(15,'(2i5,a40,3i5)')ilb,lbuf(ilb), */
2490 /* * bufq(ip1:ip1+lbuf(ilb)-1), */
2491 /* * (ichar(bufq(ip1+lbuf(ilb)-k:ip1+lbuf(ilb)-k)), */
2492 /* * k=min(3,lbuf(ilb)),1,-1) */
2493 #line 1061 ""
2494  ip1 += inbuff_1.lbuf[ilb - 1];
2495 #line 1062 ""
2496 /* L10000: */
2497 #line 1062 ""
2498  }
2499 #line 1063 ""
2500  iplast = ip1 - 1;
2501 
2502 /* Check to see if (1) last line is "<blank><blank>/" and (2) next to last */
2503 /* line is "/" */
2504 
2505 #line 1068 ""
2506  i__2 = iplast + 1 - inbuff_1.lbuf[inbuff_1.nlbuf - 1] - 1;
2507 #line 1068 ""
2508  if (s_cmp(inbuff_1.bufq + i__2, " /", iplast - i__2, (ftnlen)3)
2509  == 0) {
2510 #line 1069 ""
2511  i__2 = iplast - inbuff_1.lbuf[inbuff_1.nlbuf - 1] - 1;
2512 #line 1069 ""
2513  if (s_cmp(inbuff_1.bufq + i__2, "/", iplast - inbuff_1.lbuf[
2514  inbuff_1.nlbuf - 1] - i__2, (ftnlen)1) == 0) {
2515 #line 1070 ""
2516  s_wsle(&io___39);
2517 #line 1070 ""
2518  do_lio(&c__9, &c__1, "Removing last line of \"<blank><bl"\
2519  "ank>/\"", (ftnlen)39);
2520 #line 1070 ""
2521  e_wsle();
2522 #line 1071 ""
2523  s_wsle(&io___40);
2524 #line 1071 ""
2525  do_lio(&c__9, &c__1, "Removing last line of \"<blank><bl"\
2526  "ank>/\"", (ftnlen)39);
2527 #line 1071 ""
2528  e_wsle();
2529 #line 1072 ""
2530  --inbuff_1.nlbuf;
2531 #line 1073 ""
2532  }
2533 #line 1074 ""
2534  }
2535 
2536 #line 1076 ""
2537  pmxb_(&c_true, poe0, &ncalls, &optimize);
2538 #line 1077 ""
2539  if (commidi_1.ismidi) {
2540 
2541 /* Write midi file */
2542 
2543 #line 1081 ""
2544  o__1.oerr = 0;
2545 #line 1081 ""
2546  o__1.ounit = 51;
2547 #line 1081 ""
2548  o__1.ofnmlen = ljob + 4;
2549 /* Writing concatenation */
2550 #line 1081 ""
2551  i__3[0] = ljob, a__1[0] = jobname;
2552 #line 1081 ""
2553  i__3[1] = 4, a__1[1] = ".mid";
2554 #line 1081 ""
2555  s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48);
2556 #line 1081 ""
2557  o__1.ofnm = ch__1;
2558 #line 1081 ""
2559  o__1.orl = 0;
2560 #line 1081 ""
2561  o__1.osta = 0;
2562 #line 1081 ""
2563  o__1.oacc = 0;
2564 #line 1081 ""
2565  o__1.ofm = 0;
2566 #line 1081 ""
2567  o__1.oblnk = 0;
2568 #line 1081 ""
2569  f_open(&o__1);
2570 #line 1082 ""
2571  if (commidi_1.debugmidi) {
2572 #line 1082 ""
2573  o__1.oerr = 0;
2574 #line 1082 ""
2575  o__1.ounit = 52;
2576 #line 1082 ""
2577  o__1.ofnmlen = ljob + 4;
2578 /* Writing concatenation */
2579 #line 1082 ""
2580  i__3[0] = ljob, a__1[0] = jobname;
2581 #line 1082 ""
2582  i__3[1] = 4, a__1[1] = ".dbm";
2583 #line 1082 ""
2584  s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48);
2585 #line 1082 ""
2586  o__1.ofnm = ch__1;
2587 #line 1082 ""
2588  o__1.orl = 0;
2589 #line 1082 ""
2590  o__1.osta = 0;
2591 #line 1082 ""
2592  o__1.oacc = 0;
2593 #line 1082 ""
2594  o__1.ofm = 0;
2595 #line 1082 ""
2596  o__1.oblnk = 0;
2597 #line 1082 ""
2598  f_open(&o__1);
2599 #line 1082 ""
2600  }
2601 #line 1083 ""
2602  printl_(" ", (ftnlen)1);
2603 /* Writing concatenation */
2604 #line 1084 ""
2605  i__5[0] = 8, a__3[0] = "Writing ";
2606 #line 1084 ""
2607  i__5[1] = ljob, a__3[1] = jobname;
2608 #line 1084 ""
2609  i__5[2] = 4, a__3[2] = ".mid";
2610 #line 1084 ""
2611  s_cat(ch__5, a__3, i__5, &c__3, (ftnlen)56);
2612 #line 1084 ""
2613  printl_(ch__5, ljob + 12);
2614 #line 1085 ""
2615  writemidi_(jobname, &ljob, (ftnlen)44);
2616 #line 1086 ""
2617  }
2618 #line 1087 ""
2619  cl__1.cerr = 0;
2620 #line 1087 ""
2621  cl__1.cunit = 15;
2622 #line 1087 ""
2623  cl__1.csta = 0;
2624 #line 1087 ""
2625  f_clos(&cl__1);
2626 #line 1088 ""
2627  s_stop("", (ftnlen)0);
2628 #line 1089 ""
2629  }
2630 #line 1090 ""
2631  s_wsle(&io___42);
2632 #line 1090 ""
2633  do_lio(&c__9, &c__1, "nlbuf: ", (ftnlen)7);
2634 #line 1090 ""
2635  do_lio(&c__3, &c__1, (char *)&inbuff_1.nlbuf, (ftnlen)sizeof(integer))
2636  ;
2637 #line 1090 ""
2638  e_wsle();
2639 #line 1091 ""
2640  ip1 = 1;
2641 #line 1092 ""
2642  pmxb_(&c_false, poe0, &ncalls, &optimize);
2643 #line 1093 ""
2644  poestats_(&nsyst, poe0, &poebar0, &devnorm0);
2645 
2646 /* Save initial deviation and line breaks for later comparison */
2647 
2648 #line 1097 ""
2649  if (numit == 1) {
2650 #line 1098 ""
2651  devpmx = devnorm0;
2652 #line 1099 ""
2653  i__2 = nsyst;
2654 #line 1099 ""
2655  for (isys = 1; isys <= i__2; ++isys) {
2656 #line 1100 ""
2657  nbari[isys - 1] = nbars0[isys - 1];
2658 #line 1101 ""
2659 /* L20: */
2660 #line 1101 ""
2661  }
2662 #line 1102 ""
2663  }
2664 #line 1103 ""
2665  sortpoe_(&nsyst, poe0, ipoe);
2666 #line 1104 ""
2667  for (iupord = nsyst; iupord >= 1; --iupord) {
2668 #line 1105 ""
2669  isysu = ipoe[iupord - 1];
2670 #line 1106 ""
2671  s_wsle(&io___51);
2672 #line 1106 ""
2673  do_lio(&c__9, &c__1, "isysu=", (ftnlen)6);
2674 #line 1106 ""
2675  do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(integer));
2676 #line 1106 ""
2677  e_wsle();
2678 #line 1107 ""
2679  s_wsle(&io___52);
2680 #line 1107 ""
2681  do_lio(&c__9, &c__1, "isysu=", (ftnlen)6);
2682 #line 1107 ""
2683  do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(integer));
2684 #line 1107 ""
2685  e_wsle();
2686 
2687 /* Skip if system isysu has poe0 < avg or isysd has poe0 > avg */
2688 
2689 #line 1111 ""
2690  if (poe0[isysu - 1] < poebar0) {
2691 #line 1111 ""
2692  goto L1;
2693 #line 1111 ""
2694  }
2695 #line 1112 ""
2696  i__2 = nsyst;
2697 #line 1112 ""
2698  for (idnord = 1; idnord <= i__2; ++idnord) {
2699 #line 1113 ""
2700  isysd = ipoe[idnord - 1];
2701 #line 1114 ""
2702  if (isysu == isysd || nbars0[isysd - 1] == 1 || poe0[isysd -
2703  1] > poebar0) {
2704 #line 1114 ""
2705  goto L5;
2706 #line 1114 ""
2707  }
2708 #line 1116 ""
2709  i__6 = nsyst;
2710 #line 1116 ""
2711  for (isyst = 1; isyst <= i__6; ++isyst) {
2712 #line 1117 ""
2713  nbars[isyst - 1] = nbars0[isyst - 1];
2714 #line 1118 ""
2715  if (isyst == isysu) {
2716 #line 1119 ""
2717  ++nbars[isyst - 1];
2718 #line 1120 ""
2719  } else if (isyst == isysd) {
2720 #line 1121 ""
2721  --nbars[isyst - 1];
2722 #line 1122 ""
2723  }
2724 #line 1123 ""
2725 /* L2: */
2726 #line 1123 ""
2727  }
2728 #line 1124 ""
2729  pmxa_(jobname, &ljob4, &isfirst, &nsyst, nbars, &optimize, (
2730  ftnlen)44);
2731 #line 1125 ""
2732  pmxb_(&c_false, poe, &ncalls, &optimize);
2733 #line 1126 ""
2734  poestats_(&nsyst, poe, &poebar, &devnorm);
2735 #line 1127 ""
2736  if (devnorm < devnorm0) {
2737 #line 1128 ""
2738  devnorm0 = devnorm;
2739 #line 1129 ""
2740  poebar0 = poebar;
2741 #line 1130 ""
2742  i__6 = nsyst;
2743 #line 1130 ""
2744  for (isys = 1; isys <= i__6; ++isys) {
2745 #line 1131 ""
2746  nbars0[isys - 1] = nbars[isys - 1];
2747 #line 1132 ""
2748  poe0[isys - 1] = poe[isys - 1];
2749 #line 1133 ""
2750 /* L4: */
2751 #line 1133 ""
2752  }
2753 #line 1134 ""
2754  s_wsle(&io___60);
2755 #line 1134 ""
2756  do_lio(&c__9, &c__1, "Improved with iup,idown,devnorm:", (
2757  ftnlen)32);
2758 #line 1134 ""
2759  do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(
2760  integer));
2761 #line 1134 ""
2762  do_lio(&c__3, &c__1, (char *)&isysd, (ftnlen)sizeof(
2763  integer));
2764 #line 1134 ""
2765  do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(
2766  real));
2767 #line 1134 ""
2768  e_wsle();
2769 #line 1136 ""
2770  s_wsle(&io___61);
2771 #line 1136 ""
2772  do_lio(&c__9, &c__1, "Improved with iup,idown,devnorm:", (
2773  ftnlen)32);
2774 #line 1136 ""
2775  do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(
2776  integer));
2777 #line 1136 ""
2778  do_lio(&c__3, &c__1, (char *)&isysd, (ftnlen)sizeof(
2779  integer));
2780 #line 1136 ""
2781  do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(
2782  real));
2783 #line 1136 ""
2784  e_wsle();
2785 #line 1138 ""
2786  s_wsfe(&io___62);
2787 #line 1138 ""
2788  i__6 = nsyst;
2789 #line 1138 ""
2790  for (isys = 1; isys <= i__6; ++isys) {
2791 #line 1138 ""
2792  do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)
2793  sizeof(integer));
2794 #line 1138 ""
2795  }
2796 #line 1138 ""
2797  e_wsfe();
2798 #line 1139 ""
2799  s_wsfe(&io___63);
2800 #line 1139 ""
2801  i__6 = nsyst;
2802 #line 1139 ""
2803  for (isys = 1; isys <= i__6; ++isys) {
2804 #line 1139 ""
2805  do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)
2806  sizeof(integer));
2807 #line 1139 ""
2808  }
2809 #line 1139 ""
2810  e_wsfe();
2811 #line 1140 ""
2812  sortpoe_(&nsyst, poe0, ipoe);
2813 #line 1141 ""
2814  goto L6;
2815 #line 1142 ""
2816  }
2817 #line 1143 ""
2818 L5:
2819 #line 1143 ""
2820  ;
2821 #line 1143 ""
2822  }
2823 #line 1144 ""
2824 L1:
2825 #line 1144 ""
2826  ;
2827 #line 1144 ""
2828  }
2829 
2830 /* If we get here, must have gone thru all switches and found nothing better, */
2831 /* so done! */
2832 
2833 #line 1149 ""
2834  goto L7;
2835 #line 1150 ""
2836 L6:
2837 #line 1150 ""
2838  ;
2839 #line 1150 ""
2840  }
2841 #line 1151 ""
2842 L7:
2843 #line 1152 ""
2844  s_wsle(&io___64);
2845 #line 1152 ""
2846  do_lio(&c__9, &c__1, "Optimum located, numit:", (ftnlen)23);
2847 #line 1152 ""
2848  do_lio(&c__3, &c__1, (char *)&numit, (ftnlen)sizeof(integer));
2849 #line 1152 ""
2850  do_lio(&c__9, &c__1, ", ncalls:", (ftnlen)10);
2851 #line 1152 ""
2852  do_lio(&c__3, &c__1, (char *)&ncalls, (ftnlen)sizeof(integer));
2853 #line 1152 ""
2854  e_wsle();
2855 #line 1153 ""
2856  s_wsle(&io___65);
2857 #line 1153 ""
2858  do_lio(&c__9, &c__1, "Optimum located, numit:", (ftnlen)23);
2859 #line 1153 ""
2860  do_lio(&c__3, &c__1, (char *)&numit, (ftnlen)sizeof(integer));
2861 #line 1153 ""
2862  do_lio(&c__9, &c__1, ", ncalls:", (ftnlen)10);
2863 #line 1153 ""
2864  do_lio(&c__3, &c__1, (char *)&ncalls, (ftnlen)sizeof(integer));
2865 #line 1153 ""
2866  e_wsle();
2867 #line 1154 ""
2868  s_wsle(&io___66);
2869 #line 1154 ""
2870  do_lio(&c__9, &c__1, "Final error:", (ftnlen)12);
2871 #line 1154 ""
2872  do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(real));
2873 #line 1154 ""
2874  do_lio(&c__9, &c__1, ", initial error:", (ftnlen)16);
2875 #line 1154 ""
2876  do_lio(&c__4, &c__1, (char *)&devpmx, (ftnlen)sizeof(real));
2877 #line 1154 ""
2878  e_wsle();
2879 #line 1155 ""
2880  s_wsle(&io___67);
2881 #line 1155 ""
2882  do_lio(&c__9, &c__1, "Final error:", (ftnlen)12);
2883 #line 1155 ""
2884  do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(real));
2885 #line 1155 ""
2886  do_lio(&c__9, &c__1, ", initial error:", (ftnlen)16);
2887 #line 1155 ""
2888  do_lio(&c__4, &c__1, (char *)&devpmx, (ftnlen)sizeof(real));
2889 #line 1155 ""
2890  e_wsle();
2891 #line 1156 ""
2892  s_wsle(&io___68);
2893 #line 1156 ""
2894  do_lio(&c__9, &c__1, "Percentage improvement:", (ftnlen)23);
2895 #line 1156 ""
2896  r__1 = (1 - devnorm0 / devpmx) * 100.f;
2897 #line 1156 ""
2898  do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real));
2899 #line 1156 ""
2900  e_wsle();
2901 #line 1157 ""
2902  s_wsle(&io___69);
2903 #line 1157 ""
2904  do_lio(&c__9, &c__1, "Percentage improvement:", (ftnlen)23);
2905 #line 1157 ""
2906  r__1 = (1 - devnorm0 / devpmx) * 100.f;
2907 #line 1157 ""
2908  do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real));
2909 #line 1157 ""
2910  e_wsle();
2911 #line 1158 ""
2912  printl_("Initial bars/system:", (ftnlen)20);
2913 #line 1159 ""
2914  s_wsfe(&io___70);
2915 #line 1159 ""
2916  i__1 = nsyst;
2917 #line 1159 ""
2918  for (isys = 1; isys <= i__1; ++isys) {
2919 #line 1159 ""
2920  do_fio(&c__1, (char *)&nbari[isys - 1], (ftnlen)sizeof(integer));
2921 #line 1159 ""
2922  }
2923 #line 1159 ""
2924  e_wsfe();
2925 #line 1160 ""
2926  s_wsfe(&io___71);
2927 #line 1160 ""
2928  i__1 = nsyst;
2929 #line 1160 ""
2930  for (isys = 1; isys <= i__1; ++isys) {
2931 #line 1160 ""
2932  do_fio(&c__1, (char *)&nbari[isys - 1], (ftnlen)sizeof(integer));
2933 #line 1160 ""
2934  }
2935 #line 1160 ""
2936  e_wsfe();
2937 #line 1161 ""
2938  printl_("Final bars/system:", (ftnlen)18);
2939 #line 1162 ""
2940  s_wsfe(&io___72);
2941 #line 1162 ""
2942  i__1 = nsyst;
2943 #line 1162 ""
2944  for (isys = 1; isys <= i__1; ++isys) {
2945 #line 1162 ""
2946  do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)sizeof(integer));
2947 #line 1162 ""
2948  }
2949 #line 1162 ""
2950  e_wsfe();
2951 #line 1163 ""
2952  s_wsfe(&io___73);
2953 #line 1163 ""
2954  i__1 = nsyst;
2955 #line 1163 ""
2956  for (isys = 1; isys <= i__1; ++isys) {
2957 #line 1163 ""
2958  do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)sizeof(integer));
2959 #line 1163 ""
2960  }
2961 #line 1163 ""
2962  e_wsfe();
2963 #line 1164 ""
2964  pmxa_(jobname, &ljob4, &c_false, &nsyst, nbars0, &optimize, (ftnlen)44);
2965 #line 1165 ""
2966  pmxb_(&c_true, poe0, &ncalls, &optimize);
2967 #line 1166 ""
2968  cl__1.cerr = 0;
2969 #line 1166 ""
2970  cl__1.cunit = 15;
2971 #line 1166 ""
2972  cl__1.csta = 0;
2973 #line 1166 ""
2974  f_clos(&cl__1);
2975 #line 1167 ""
2976  return 0;
2977 } /* MAIN__ */
2978 
2979 /* Subroutine */ int accsym_(integer *nacc, char *acsymq, integer *lacc,
2980  ftnlen acsymq_len)
2981 {
2982  /* Builtin functions */
2983  /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
2984  integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
2985  e_wsle(void);
2986 
2987  /* Local variables */
2988  static integer iacc;
2989 
2990  /* Fortran I/O blocks */
2991  static cilist io___75 = { 0, 6, 0, 0, 0 };
2992 
2993 
2994 #line 1170 ""
2995  iacc = *nacc & 7;
2996 #line 1171 ""
2997  if (iacc == 1) {
2998 #line 1172 ""
2999  s_copy(acsymq, "fl", (ftnlen)3, (ftnlen)2);
3000 #line 1173 ""
3001  *lacc = 2;
3002 #line 1174 ""
3003  } else if (iacc == 2) {
3004 #line 1175 ""
3005  s_copy(acsymq, "sh", (ftnlen)3, (ftnlen)2);
3006 #line 1176 ""
3007  *lacc = 2;
3008 #line 1177 ""
3009  } else if (iacc == 3) {
3010 #line 1178 ""
3011  s_copy(acsymq, "na", (ftnlen)3, (ftnlen)2);
3012 #line 1179 ""
3013  *lacc = 2;
3014 #line 1180 ""
3015  } else if (iacc == 5) {
3016 #line 1181 ""
3017  s_copy(acsymq, "dfl", (ftnlen)3, (ftnlen)3);
3018 #line 1182 ""
3019  *lacc = 3;
3020 #line 1183 ""
3021  } else if (iacc == 6) {
3022 #line 1184 ""
3023  s_copy(acsymq, "dsh", (ftnlen)3, (ftnlen)3);
3024 #line 1185 ""
3025  *lacc = 3;
3026 #line 1186 ""
3027  } else {
3028 #line 1187 ""
3029  s_wsle(&io___75);
3030 #line 1187 ""
3031  do_lio(&c__9, &c__1, "bad accidental: ", (ftnlen)16);
3032 #line 1187 ""
3033  do_lio(&c__3, &c__1, (char *)&iacc, (ftnlen)sizeof(integer));
3034 #line 1187 ""
3035  e_wsle();
3036 #line 1188 ""
3037  }
3038 #line 1189 ""
3039  return 0;
3040 } /* accsym_ */
3041 
3042 /* Subroutine */ int addask_(real *taskn, real *waskn, real *elaskn, real *
3043  fixednew, real *scaldold, real *tglp1, real *scfac, logical *isudsp)
3044 {
3045  /* System generated locals */
3046  integer i__1;
3047  real r__1;
3048 
3049  /* Builtin functions */
3050  integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
3051  e_wsle(void);
3052 
3053  /* Local variables */
3054  static real oldelask;
3055  extern /* Subroutine */ int stop1_(void);
3056  static integer iudsp;
3057  static real scoarg, oldwask;
3058 
3059  /* Fortran I/O blocks */
3060  static cilist io___78 = { 0, 6, 0, 0, 0 };
3061 
3062 
3063 #line 1198 ""
3064  scoarg = *scaldold * *scfac;
3065 #line 1199 ""
3066  if (*isudsp) {
3067 
3068 /* Find which udsp we're dealing with */
3069 
3070 #line 1203 ""
3071  i__1 = comudsp_1.nudsp;
3072 #line 1203 ""
3073  for (iudsp = 1; iudsp <= i__1; ++iudsp) {
3074 #line 1204 ""
3075  if ((r__1 = *taskn + *tglp1 - comudsp_1.tudsp[iudsp - 1], dabs(
3076  r__1)) < comtol_1.tol) {
3077 #line 1204 ""
3078  goto L2;
3079 #line 1204 ""
3080  }
3081 #line 1205 ""
3082 /* L1: */
3083 #line 1205 ""
3084  }
3085 #line 1206 ""
3086  s_wsle(&io___78);
3087 #line 1206 ""
3088  do_lio(&c__9, &c__1, "You should note BEEE here in addask!", (ftnlen)
3089  36);
3090 #line 1206 ""
3091  e_wsle();
3092 #line 1207 ""
3093  stop1_();
3094 #line 1208 ""
3095 L2:
3096 
3097 /* Fixednew and scaldold must not be changed, since udsp's are already included */
3098 /* in fsyst from pmxa, and udsp don't involve scaled space.. */
3099 
3100 #line 1213 ""
3101  if (comas1_1.naskb > 0 && (r__1 = *taskn - comas1_1.task[max(1,
3102  comas1_1.naskb) - 1], dabs(r__1)) < comtol_1.tol) {
3103 
3104 /* Must add user-defined space to what's there already. */
3105 
3106 #line 1217 ""
3107  comas1_1.wask[comas1_1.naskb - 1] += comudsp_1.udsp[iudsp - 1];
3108 #line 1218 ""
3109  } else {
3110 
3111 /* This place has no other space. */
3112 
3113 #line 1222 ""
3114  ++comas1_1.naskb;
3115 #line 1223 ""
3116  comas1_1.task[comas1_1.naskb - 1] = *taskn;
3117 #line 1224 ""
3118  comas1_1.wask[comas1_1.naskb - 1] = comudsp_1.udsp[iudsp - 1];
3119 #line 1225 ""
3120  comas1_1.elask[comas1_1.naskb - 1] = 0.f;
3121 #line 1226 ""
3122  }
3123 #line 1227 ""
3124  } else {
3125 /* 130330 start */
3126 #line 1229 ""
3127  oldwask = 0.f;
3128 #line 1230 ""
3129  oldelask = 0.f;
3130 /* 130330 end */
3131 
3132 /* This is a normal space, no effect if smaller than existing space */
3133 
3134 #line 1235 ""
3135  if (comas1_1.naskb > 0 && (r__1 = *taskn - comas1_1.task[max(1,
3136  comas1_1.naskb) - 1], dabs(r__1)) < comtol_1.tol) {
3137 
3138 /* We already put in some space at this time */
3139 /* Check if new one needs more space than old one at same time */
3140 
3141 #line 1240 ""
3142  if (*waskn > comas1_1.wask[comas1_1.naskb - 1]) {
3143 
3144 /* 130330 We were double counting the larger space when it came 2nd */
3145 /* Need to fix but don't see how yet. Assume times came in order and */
3146 /* that last naskb defined spaces that need updating */
3147 
3148 #line 1246 ""
3149  oldwask = comas1_1.wask[comas1_1.naskb - 1];
3150 #line 1247 ""
3151  oldelask = comas1_1.elask[comas1_1.naskb - 1];
3152 /* End of 130330 insertions */
3153 #line 1249 ""
3154  --comas1_1.naskb;
3155 #line 1250 ""
3156  } else {
3157 #line 1251 ""
3158  return 0;
3159 #line 1252 ""
3160  }
3161 #line 1253 ""
3162  }
3163 #line 1254 ""
3164  ++comas1_1.naskb;
3165 #line 1255 ""
3166  comas1_1.task[comas1_1.naskb - 1] = *taskn;
3167 #line 1256 ""
3168  comas1_1.wask[comas1_1.naskb - 1] = *waskn;
3169 #line 1257 ""
3170  comas1_1.elask[comas1_1.naskb - 1] = *elaskn;
3171 /* 130330 start */
3172 /* fixednew = fixednew+waskn */
3173 /* scaldold = scaldold+elaskn */
3174 #line 1261 ""
3175  *fixednew = *fixednew + *waskn - oldwask;
3176 #line 1262 ""
3177  *scaldold = scoarg + *elaskn - oldelask;
3178 /* 130330 end */
3179 #line 1264 ""
3180  }
3181 #line 1265 ""
3182  return 0;
3183 } /* addask_ */
3184 
3185 /* Subroutine */ int addblank_(char *noteq, integer *lnoten, ftnlen noteq_len)
3186 {
3187  /* System generated locals */
3188  address a__1[2];
3189  integer i__1[2];
3190 
3191  /* Builtin functions */
3192  /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
3193 
3194  /* Local variables */
3195  static char tchar[1];
3196 
3197 #line 1270 ""
3198  *(unsigned char *)tchar = *(unsigned char *)noteq;
3199 /* Writing concatenation */
3200 #line 1271 ""
3201  i__1[0] = 1, a__1[0] = " ";
3202 #line 1271 ""
3203  i__1[1] = 1, a__1[1] = tchar;
3204 #line 1271 ""
3205  s_cat(noteq, a__1, i__1, &c__2, (ftnlen)8);
3206 #line 1272 ""
3207  *lnoten = 2;
3208 #line 1273 ""
3209  return 0;
3210 } /* addblank_ */
3211 
3212 /* Subroutine */ int addfb_(integer *nfb, integer *iv, real *tnew, real *t1fb,
3213  real *t2fb, char *ulfbq, integer *ifbadd, ftnlen ulfbq_len)
3214 {
3215  static integer ifb;
3216 
3217 #line 1281 ""
3218  /* Parameter adjustments */
3219 #line 1281 ""
3220  ulfbq -= 25;
3221 #line 1281 ""
3222  t2fb -= 25;
3223 #line 1281 ""
3224  t1fb -= 25;
3225 #line 1281 ""
3226  --nfb;
3227 #line 1281 ""
3228 
3229 #line 1281 ""
3230  /* Function Body */
3231 #line 1281 ""
3232  *ifbadd = 1;
3233 #line 1282 ""
3234  ++nfb[*iv];
3235 #line 1283 ""
3236  for (ifb = nfb[*iv] - 1; ifb >= 1; --ifb) {
3237 #line 1284 ""
3238  if (*tnew < t1fb[*iv + ifb * 24] - comtol_1.tol) {
3239 #line 1285 ""
3240  t1fb[*iv + (ifb + 1) * 24] = t1fb[*iv + ifb * 24];
3241 #line 1286 ""
3242  t2fb[*iv + (ifb + 1) * 24] = t2fb[*iv + ifb * 24];
3243 #line 1287 ""
3244  *(unsigned char *)&ulfbq[*iv + (ifb + 1) * 24] = *(unsigned char *
3245  )&ulfbq[*iv + ifb * 24];
3246 #line 1288 ""
3247  } else {
3248 #line 1289 ""
3249  *ifbadd = ifb + 1;
3250 #line 1290 ""
3251  goto L2;
3252 #line 1291 ""
3253  }
3254 #line 1292 ""
3255 /* L1: */
3256 #line 1292 ""
3257  }
3258 #line 1293 ""
3259 L2:
3260 #line 1294 ""
3261  t1fb[*iv + *ifbadd * 24] = *tnew;
3262 #line 1295 ""
3263  *(unsigned char *)&ulfbq[*iv + *ifbadd * 24] = 'x';
3264 #line 1296 ""
3265  return 0;
3266 } /* addfb_ */
3267 
3268 /* Subroutine */ int addmidi_(integer *icm, integer *nolev, integer *iacc,
3269  integer *midisig, real *time, logical *rest, logical *endrest)
3270 {
3271  /* Initialized data */
3272 
3273  static shortint icmm[16] = { 0,1,2,3,4,5,6,7,8,10,11,12,13,14,15,16 };
3274 
3275  /* System generated locals */
3276  integer i__1, i__2, i__3;
3277  real r__1;
3278 
3279  /* Builtin functions */
3281  char *, ftnlen), e_wsle(void), i_indx(char *, char *, ftnlen,
3282  ftnlen);
3283 
3284  /* Local variables */
3285  static logical it1found;
3286  static integer nsav4tie;
3287  extern /* Subroutine */ int chkimidi_(integer *);
3288  static char notenumq[1];
3289  static integer i__, j, it1;
3290  extern integer igetvarlen_(shortint *, integer *, integer *, integer *);
3291  static integer it2;
3292  extern integer isetvarlen_(integer *, integer *);
3293  static integer ion;
3294  static shortint itk[25];
3295  static integer jacc, kacc, macc, ioff, isav, idur, jsav, idur1;
3296  extern /* Subroutine */ int stop1_(void);
3297  static integer imidt, ipsav, ipsav0, nby2on;
3298  extern integer iashft_(integer *);
3299  static integer nbytes;
3300  extern /* Subroutine */ int printl_(char *, ftnlen);
3301  static integer nby2off;
3302  static logical eximacc;
3303  static integer itiesav[500] /* was [5][100] */, idurvar;
3304 
3305  /* Fortran I/O blocks */
3306  static cilist io___88 = { 0, 6, 0, 0, 0 };
3307  static cilist io___100 = { 0, 6, 0, 0, 0 };
3308 
3309 
3310 /* subroutine addmidi(icm,nolev,iacc,isig,time,rest,endrest) */
3311 /* common /commidisig/ midisig(nm) */
3312 
3313 /* Following variables are local but must be saved. I hope they are. */
3314 /* (3/18/00) With g77 they are not, so add a common block here. */
3315 
3316 /* integer*2 ipslon(0:nm),lusebl(10),jusebl(10),icmm(0:12) */
3317 /* data icmm /0,1,2,3,4,5,6,7,8,10,11,12,13/ */
3318 
3319 /* Cancel out barline accidentals if there's a rest. */
3320 
3321 #line 1336 ""
3322  if (*rest) {
3323 #line 1336 ""
3324  comslm_1.naccbl[(300 + (0 + (*icm - 0 << 2)) - 300) / 4] = 0;
3325 #line 1336 ""
3326  }
3327 
3328 /* Special path to insert dummy rest at end of a section */
3329 
3330 #line 1340 ""
3331  if (*endrest) {
3332 #line 1340 ""
3333  goto L20;
3334 #line 1340 ""
3335  }
3336 
3337 #line 1342 ""
3338  i__1 = commidi_1.nmidcrd;
3339 #line 1342 ""
3340  for (ion = 0; ion <= i__1; ++ion) {
3341 
3342 /* check if this is only to get pitch of a chord note */
3343 
3344 #line 1346 ""
3345  if (commidi_1.notmain) {
3346 #line 1346 ""
3347  goto L6;
3348 #line 1346 ""
3349  }
3350 
3351 /* check for rest */
3352 
3353 #line 1350 ""
3354  if (*rest) {
3355 
3356 /* Will not put in a note, but must update timing */
3357 
3358 #line 1354 ""
3359  if (! commidi_1.restpend[*icm]) {
3360 
3361 /* First rest in sequence, save the time */
3362 
3363 #line 1358 ""
3364  commidi_1.restpend[*icm] = TRUE_;
3365 #line 1359 ""
3366  commidi_1.trest[*icm] = *time;
3367 #line 1360 ""
3368  } else {
3369 #line 1361 ""
3370  commidi_1.trest[*icm] += *time;
3371 #line 1362 ""
3372  }
3373 
3374 /* Note: code checkers don't like the above due to calling addmidi(trest(icm)) */
3375 /* but this only happens if rest at end of section (endrest=.true.) (called */
3376 /* from getmidi(), in which case these above lines are bypassed. */
3377 
3378 #line 1368 ""
3379  chkimidi_(icm);
3380 #line 1369 ""
3381  return 0;
3382 #line 1370 ""
3383  }
3384 
3385 /* time tics */
3386 
3387 #line 1374 ""
3388  if (commidi_1.imidi[*icm] > 0 && ion == 0) {
3389 #line 1375 ""
3390  idur = commidi_1.mgap;
3391 #line 1376 ""
3392  } else {
3393 #line 1377 ""
3394  idur = 0;
3395 #line 1378 ""
3396  }
3397 #line 1379 ""
3398  if (commidi_1.restpend[*icm]) {
3399 #line 1380 ""
3400  commidi_1.restpend[*icm] = FALSE_;
3401 #line 1381 ""
3402  r__1 = commidi_1.trest[*icm] * 15;
3403 #line 1381 ""
3404  idur += i_nint(&r__1);
3405 #line 1382 ""
3406  }
3407 
3408 /* time to start of note */
3409 
3410 #line 1386 ""
3411  idurvar = isetvarlen_(&idur, &nby2on);
3412 #line 1387 ""
3413  if (nby2on > 4) {
3414 #line 1388 ""
3415  s_wsle(&io___88);
3416 #line 1388 ""
3417  do_lio(&c__9, &c__1, "You got >4 bytes, something is bogus.", (
3418  ftnlen)37);
3419 #line 1388 ""
3420  e_wsle();
3421 #line 1389 ""
3422  stop1_();
3423 #line 1390 ""
3424  }
3425 #line 1391 ""
3426  ++commidi_1.imidi[*icm];
3427 #line 1392 ""
3428  i__2 = nby2on;
3429 #line 1392 ""
3430  for (i__ = 1; i__ <= i__2; ++i__) {
3431 
3432 /* imidi points to cell before highest (leftmost) byte. Start with lowest byte */
3433 /* at far right, fill in backwards */
3434 
3435 #line 1397 ""
3436  commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nby2on - i__) *
3437  25 - 25] = (shortint) (idurvar % 256);
3438 #line 1398 ""
3439  if (nby2on > 1) {
3440 #line 1398 ""
3441  idurvar /= 256;
3442 #line 1398 ""
3443  }
3444 #line 1399 ""
3445 /* L2: */
3446 #line 1399 ""
3447  }
3448 #line 1400 ""
3449  commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nby2on - 1;
3450 
3451 /* Note-on signal */
3452 
3453 #line 1404 ""
3454  ++commidi_1.imidi[*icm];
3455 #line 1405 ""
3456  commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint) (
3457  icmm[*icm] + 144);
3458 
3459 /* Entry point for chord note pitch determination */
3460 
3461 #line 1409 ""
3462 L6:
3463 
3464 /* Get midi pitch. On chord iteration, only do this first time (main note), */
3465 /* since pitch was already computed for nonmain chord notes. */
3466 
3467 #line 1414 ""
3468  if (ion == 0) {
3469 #line 1415 ""
3470  ipsav = *nolev * 12.f / 7 + 11;
3471 #line 1416 ""
3472  ipsav0 = ipsav;
3473 #line 1417 ""
3474  if (*midisig != 0) {
3475 
3476 /* Adjust for signature */
3477 
3478 #line 1421 ""
3479  *(unsigned char *)notenumq = (char) (*nolev % 7 + 48);
3480 #line 1422 ""
3481  if (*midisig >= i_indx("4152630", notenumq, (ftnlen)7, (
3482  ftnlen)1)) {
3483 #line 1423 ""
3484  ++ipsav;
3485 #line 1424 ""
3486  } else if (-(*midisig) >= i_indx("0362514", notenumq, (ftnlen)
3487  7, (ftnlen)1)) {
3488 #line 1425 ""
3489  --ipsav;
3490 #line 1426 ""
3491  }
3492 #line 1427 ""
3493  }
3494 
3495 /* Deal with accidentals. */
3496 
3497 /* iacc 0 1 2 3 4 5 6 7 */
3498 /* effect X fl sh na X dfl dsh X */
3499 /* iashft X -1 1 0 X -2 2 X */
3500 
3501 #line 1435 ""
3502  jacc = 0;
3503 #line 1436 ""
3504  eximacc = FALSE_;
3505 #line 1437 ""
3506  if (*iacc > 0) {
3507 
3508 /* Adjust key-sig-adjusted pitch for explicit accidental (and exit) */
3509 
3510 #line 1441 ""
3511  jacc = iashft_(iacc);
3512 #line 1442 ""
3513  eximacc = TRUE_;
3514 #line 1443 ""
3515  if (! commidi_1.relacc) {
3516 #line 1443 ""
3517  jacc = jacc + ipsav0 - ipsav;
3518 #line 1443 ""
3519  }
3520 
3521 /* (Above) Shift applies to diatonic pitch but will be added to adjusted one */
3522 
3523 #line 1447 ""
3524  } else if (commidi_1.naccim[*icm] > 0) {
3525 
3526 /* Possible implicit accidental from earlier in the bar */
3527 /* Check for prior accid in this bar at this note level */
3528 
3529 #line 1452 ""
3530  i__2 = commidi_1.naccim[*icm];
3531 #line 1452 ""
3532  for (kacc = 1; kacc <= i__2; ++kacc) {
3533 #line 1453 ""
3534  if (commidi_1.laccim[*icm + kacc * 25 - 25] == *nolev) {
3535 #line 1454 ""
3536  jacc = commidi_1.jaccim[*icm + kacc * 25 - 25];
3537 #line 1455 ""
3538  eximacc = TRUE_;
3539 #line 1456 ""
3540  if (! commidi_1.relacc) {
3541 #line 1456 ""
3542  jacc = jacc + ipsav0 - ipsav;
3543 #line 1456 ""
3544  }
3545 #line 1457 ""
3546  goto L4;
3547 #line 1458 ""
3548  }
3549 #line 1459 ""
3550 /* L3: */
3551 #line 1459 ""
3552  }
3553 #line 1460 ""
3554 L4:
3555 #line 1461 ""
3556  ;
3557 #line 1461 ""
3558  }
3559 
3560 /* Must split off the following if block from those above because chord */
3561 /* notes can cause naccim>0, forcing us to miss other chord note's */
3562 /* accross-bar-line accidental */
3563 
3564 #line 1467 ""
3565  if (comslm_1.naccbl[*icm] > 0 && ! eximacc) {
3566 
3567 /* Possible carryover accid from prior bar (or prior same-pitch note). */
3568 
3569 #line 1471 ""
3570  i__2 = comslm_1.naccbl[*icm];
3571 #line 1471 ""
3572  for (kacc = 1; kacc <= i__2; ++kacc) {
3573 #line 1472 ""
3574  if (comslm_1.laccbl[*icm + kacc * 25 - 25] == *nolev) {
3575 #line 1473 ""
3576  jacc = comslm_1.jaccbl[*icm + kacc * 25 - 25];
3577 
3578 /* Since we are *using* the bar-line accid, must flag it to be saved for next. */
3579 
3580 #line 1477 ""
3581  ++comslm_1.nusebl;
3582 #line 1478 ""
3583  comips_1.jusebl[comslm_1.nusebl - 1] = (shortint)
3584  jacc;
3585 #line 1479 ""
3586  comips_1.lusebl[comslm_1.nusebl - 1] = (shortint) (*
3587  nolev);
3588 #line 1480 ""
3589  if (! commidi_1.relacc) {
3590 #line 1480 ""
3591  jacc = jacc + ipsav0 - ipsav;
3592 #line 1480 ""
3593  }
3594 #line 1481 ""
3595  goto L22;
3596 #line 1482 ""
3597  }
3598 #line 1483 ""
3599 /* L21: */
3600 #line 1483 ""
3601  }
3602 #line 1484 ""
3603 L22:
3604 #line 1485 ""
3605  ;
3606 #line 1485 ""
3607  }
3608 #line 1486 ""
3609  ipsav += jacc;
3610 #line 1487 ""
3611  }
3612 #line 1488 ""
3613  if (commidi_1.notmain) {
3614 #line 1489 ""
3615  commidi_1.mcpitch[commidi_1.nmidcrd - 1] = ipsav;
3616 
3617 /* Save pitch for tie checks */
3618 
3619 #line 1493 ""
3620  if (comslm_1.levson[*icm] == *nolev && ! comslm_1.slmon[*icm]) {
3621 #line 1493 ""
3622  comips_1.ipslon[*icm] = (shortint) ipsav;
3623 #line 1493 ""
3624  }
3625 #line 1495 ""
3626  } else {
3627 #line 1496 ""
3628  ++commidi_1.imidi[*icm];
3629 #line 1497 ""
3630  if (ion == 0) {
3631 #line 1498 ""
3632  commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (
3633  shortint) ipsav;
3634 #line 1499 ""
3635  if (comslm_1.levson[*icm] == *nolev && ! comslm_1.slmon[*icm])
3636  {
3637 #line 1499 ""
3638  comips_1.ipslon[*icm] = (shortint) ipsav;
3639 #line 1499 ""
3640  }
3641 #line 1501 ""
3642  } else {
3643 #line 1502 ""
3644  commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (
3645  shortint) commidi_1.mcpitch[ion - 1];
3646 #line 1503 ""
3647  }
3648 #line 1504 ""
3649  }
3650 #line 1505 ""
3651  if (ion == 0) {
3652 
3653 /* Only record accids for non-chords, main chord note during chord iteration */
3654 /* and chordnotes on first call but not during iteration */
3655 
3656 #line 1510 ""
3657  if (*iacc > 0) {
3658 
3659 /* Set marker for accidental for possible continuations later this bar */
3660 /* but first check and clear earlier ones on same note. */
3661 
3662 #line 1515 ""
3663  i__2 = commidi_1.naccim[*icm];
3664 #line 1515 ""
3665  for (kacc = 1; kacc <= i__2; ++kacc) {
3666 #line 1516 ""
3667  if (commidi_1.laccim[*icm + kacc * 25 - 25] == *nolev) {
3668 #line 1517 ""
3669  i__3 = commidi_1.naccim[*icm] - 1;
3670 #line 1517 ""
3671  for (macc = kacc; macc <= i__3; ++macc) {
3672 #line 1518 ""
3673  commidi_1.laccim[*icm + macc * 25 - 25] =
3674  commidi_1.laccim[*icm + (macc + 1) * 25 -
3675  25];
3676 #line 1519 ""
3677  commidi_1.jaccim[*icm + macc * 25 - 25] =
3678  commidi_1.jaccim[*icm + (macc + 1) * 25 -
3679  25];
3680 #line 1520 ""
3681 /* L24: */
3682 #line 1520 ""
3683  }
3684 #line 1521 ""
3685  goto L25;
3686 #line 1522 ""
3687  }
3688 #line 1523 ""
3689 /* L23: */
3690 #line 1523 ""
3691  }
3692 #line 1524 ""
3693  goto L26;
3694 #line 1525 ""
3695 L25:
3696 #line 1526 ""
3697  --commidi_1.naccim[*icm];
3698 #line 1527 ""
3699 L26:
3700 
3701 /* Flag new accidental */
3702 
3703 #line 1531 ""
3704  ++commidi_1.naccim[*icm];
3705 #line 1532 ""
3706  commidi_1.laccim[*icm + commidi_1.naccim[*icm] * 25 - 25] = *
3707  nolev;
3708 #line 1533 ""
3709  commidi_1.jaccim[*icm + commidi_1.naccim[*icm] * 25 - 25] =
3710  iashft_(iacc);
3711 #line 1534 ""
3712  }
3713 
3714 /* Bail if this is a chord note on the first call (from docrd) */
3715 
3716 #line 1538 ""
3717  if (commidi_1.notmain) {
3718 #line 1539 ""
3719  chkimidi_(icm);
3720 #line 1540 ""
3721  return 0;
3722 #line 1541 ""
3723  }
3724 #line 1542 ""
3725  }
3726 
3727 /* Vel */
3728 
3729 #line 1546 ""
3730  ++commidi_1.imidi[*icm];
3731 #line 1547 ""
3732  commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint)
3733  commvel_1.midvelc[*icm];
3734 #line 1548 ""
3735  chkimidi_(icm);
3736 #line 1549 ""
3737 /* L7: */
3738 #line 1549 ""
3739  }
3740 
3741 /* For tie checks */
3742 
3743 #line 1553 ""
3744  if (comslm_1.levson[*icm] > 0 && ! comslm_1.slmon[*icm]) {
3745 #line 1553 ""
3746  comslm_1.imidso[*icm] = commidi_1.imidi[*icm];
3747 #line 1553 ""
3748  }
3749 
3750 /* Entry point for special rests at section ends (endrest=T) */
3751 
3752 #line 1557 ""
3753 L20:
3754 
3755 /* Now insert all the ends */
3756 
3757 #line 1561 ""
3758  i__1 = commidi_1.nmidcrd;
3759 #line 1561 ""
3760  for (ioff = 0; ioff <= i__1; ++ioff) {
3761 #line 1562 ""
3762  if (ioff == 0) {
3763 
3764 /* time to end */
3765 
3766 #line 1566 ""
3767  r__1 = *time * 15;
3768 #line 1566 ""
3769  idur1 = i_nint(&r__1);
3770 #line 1567 ""
3771  r__1 = commidi_1.trest[*icm] * 15;
3772 #line 1567 ""
3773  if (! (*endrest) || comevent_1.miditime == i_nint(&r__1)) {
3774 #line 1568 ""
3775  idur = idur1 - commidi_1.mgap;
3776 #line 1569 ""
3777  } else {
3778 #line 1570 ""
3779  idur = idur1;
3780 #line 1571 ""
3781  }
3782 
3783 /* Deal with roundoff problems with 7-tuplets on half or quarters */
3784 
3785 #line 1575 ""
3786  if (idur1 == 69) {
3787 #line 1576 ""
3788  ++comdiag_1.n69[*icm];
3789 /* if (mod(n69(icm)+6,7) .gt. 3) idur = 58 */
3790 #line 1578 ""
3791  if ((comdiag_1.n69[*icm] + 6) % 7 > 3) {
3792 #line 1578 ""
3793  idur = idur1 - commidi_1.mgap - 1;
3794 #line 1578 ""
3795  }
3796 #line 1579 ""
3797  } else if (idur1 == 34) {
3798 #line 1580 ""
3799  ++comdiag_1.n34[*icm];
3800 #line 1581 ""
3801  if ((comdiag_1.n34[*icm] + 6) % 7 > 4) {
3802 #line 1581 ""
3803  idur = idur1 - commidi_1.mgap + 1;
3804 #line 1581 ""
3805  }
3806 #line 1582 ""
3807  }
3808 #line 1583 ""
3809  idurvar = isetvarlen_(&idur, &nby2off);
3810 #line 1584 ""
3811  if (nby2off > 4) {
3812 #line 1585 ""
3813  s_wsle(&io___100);
3814 #line 1585 ""
3815  do_lio(&c__9, &c__1, "You got >4 bytes, something is bogus.",
3816  (ftnlen)37);
3817 #line 1585 ""
3818  e_wsle();
3819 #line 1586 ""
3820  stop1_();
3821 #line 1587 ""
3822  }
3823 #line 1588 ""
3824  ++commidi_1.imidi[*icm];
3825 #line 1589 ""
3826  chkimidi_(icm);
3827 #line 1590 ""
3828  i__2 = nby2off;
3829 #line 1590 ""
3830  for (i__ = 1; i__ <= i__2; ++i__) {
3831 #line 1591 ""
3832  commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nby2off - i__)
3833  * 25 - 25] = (shortint) (idurvar % 256);
3834 #line 1592 ""
3835  if (nby2off > 1) {
3836 #line 1592 ""
3837  idurvar /= 256;
3838 #line 1592 ""
3839  }
3840 #line 1593 ""
3841 /* L1: */
3842 #line 1593 ""
3843  }
3844 #line 1594 ""
3845  commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nby2off - 1;
3846 #line 1595 ""
3847  } else {
3848 
3849 /* Inserting end of chord note, delta time is 0 */
3850 
3851 #line 1599 ""
3852  ++commidi_1.imidi[*icm];
3853 #line 1600 ""
3854  commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = 0;
3855 #line 1601 ""
3856  }
3857 
3858 /* Note off */
3859 
3860 #line 1605 ""
3861  ++commidi_1.imidi[*icm];
3862 #line 1606 ""
3863  commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint) (
3864  icmm[*icm] + 128);
3865 
3866 /* Pitch */
3867 
3868 #line 1610 ""
3869  ++commidi_1.imidi[*icm];
3870 #line 1611 ""
3871  if (ioff == 0) {
3872 #line 1612 ""
3873  commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (
3874  shortint) ipsav;
3875 #line 1613 ""
3876  } else {
3877 #line 1614 ""
3878  commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (
3879  shortint) commidi_1.mcpitch[ioff - 1];
3880 #line 1615 ""
3881  }
3882 
3883 /* Vel */
3884 
3885 #line 1619 ""
3886  ++commidi_1.imidi[*icm];
3887 #line 1620 ""
3888  commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = 0;
3889 #line 1621 ""
3890  chkimidi_(icm);
3891 #line 1622 ""
3892  if (*endrest) {
3893 #line 1623 ""
3894  return 0;
3895 #line 1624 ""
3896  }
3897 #line 1625 ""
3898 /* L8: */
3899 #line 1625 ""
3900  }
3901 #line 1626 ""
3902  comslm_1.naccbl[*icm] = comslm_1.nusebl;
3903 #line 1627 ""
3904  if (comslm_1.nusebl > 0) {
3905 
3906 /* Fix tables of "bar-line" accids that are saved due to consecutive notes. */
3907 
3908 #line 1631 ""
3909  i__1 = comslm_1.nusebl;
3910 #line 1631 ""
3911  for (kacc = 1; kacc <= i__1; ++kacc) {
3912 #line 1632 ""
3913  comslm_1.laccbl[*icm + kacc * 25 - 25] = comips_1.lusebl[kacc - 1]
3914  ;
3915 #line 1633 ""
3916  comslm_1.jaccbl[*icm + kacc * 25 - 25] = comips_1.jusebl[kacc - 1]
3917  ;
3918 #line 1634 ""
3919 /* L30: */
3920 #line 1634 ""
3921  }
3922 #line 1635 ""
3923  comslm_1.nusebl = 0;
3924 #line 1636 ""
3925  }
3926 
3927 /* Begin tie checks */
3928 
3929 #line 1640 ""
3930  if (comslm_1.slmon[*icm]) {
3931 
3932 /* Prior note had a slur start */
3933 
3934 #line 1644 ""
3935  if (comslm_1.levson[*icm] == comslm_1.levsoff[*icm] && *iacc == 0) {
3936 
3937 /* We have a tie! (Assumed there would be no accidental on tie-ending note) */
3938 /* Make a list of times of all events back to the one starting at imidso+1, */
3939 /* which is at or before where the tie started. Ident tie start and stop by */
3940 /* comparing pitches. Save the 4 pieces of data in itiesav(1...4,nsav4tie) */
3941 /* Store actual time in itiesav(5,nsav4tie), using itiesav(1,1) as initial */
3942 /* time. */
3943 #line 1652 ""
3944  nsav4tie = 0;
3945 #line 1653 ""
3946  imidt = comslm_1.imidso[*icm];
3947 #line 1654 ""
3948 L10:
3949 #line 1654 ""
3950  ++nsav4tie;
3951 #line 1655 ""
3952  itiesav[nsav4tie * 5 - 5] = igetvarlen_(commidi_1.mmidi, icm, &
3953  imidt, &nbytes);
3954 #line 1656 ""
3955  imidt += nbytes;
3956 #line 1657 ""
3957  for (j = 1; j <= 3; ++j) {
3958 #line 1658 ""
3959  itiesav[j + 1 + nsav4tie * 5 - 6] = commidi_1.mmidi[*icm + (
3960  imidt + j) * 25 - 25];
3961 #line 1659 ""
3962 /* L11: */
3963 #line 1659 ""
3964  }
3965 #line 1660 ""
3966  imidt += 3;
3967 #line 1661 ""
3968  if (nsav4tie == 1) {
3969 #line 1662 ""
3970  itiesav[4] = itiesav[0];
3971 #line 1663 ""
3972  } else {
3973 #line 1664 ""
3974  itiesav[nsav4tie * 5 - 1] = itiesav[nsav4tie * 5 - 5] +
3975  itiesav[(nsav4tie - 1) * 5 - 1];
3976 #line 1666 ""
3977  }
3978 #line 1667 ""
3979  if (imidt != commidi_1.imidi[*icm]) {
3980 #line 1667 ""
3981  goto L10;
3982 #line 1667 ""
3983  }
3984 
3985 /* Find which two pitches agree with saved slur pitch. */
3986 
3987 #line 1671 ""
3988  it1found = FALSE_;
3989 #line 1672 ""
3990  i__1 = nsav4tie;
3991 #line 1672 ""
3992  for (it2 = 1; it2 <= i__1; ++it2) {
3993 #line 1673 ""
3994  if (itiesav[it2 * 5 - 3] == comips_1.ipslon[*icm]) {
3995 #line 1674 ""
3996  if (it1found) {
3997 #line 1674 ""
3998  goto L13;
3999 #line 1674 ""
4000  }
4001 #line 1675 ""
4002  it1 = it2;
4003 #line 1676 ""
4004  it1found = TRUE_;
4005 #line 1677 ""
4006  }
4007 #line 1678 ""
4008 /* L12: */
4009 #line 1678 ""
4010  }
4011 #line 1679 ""
4012  printl_("Program error, tied notes, send source to Dr. Don", (
4013  ftnlen)49);
4014 #line 1681 ""
4015  it1 = nsav4tie + 1;
4016 #line 1682 ""
4017  it2 = nsav4tie + 1;
4018 #line 1683 ""
4019 L13:
4020 
4021 /* List the positions we want to keep */
4022 
4023 #line 1687 ""
4024  jsav = 0;
4025 #line 1688 ""
4026  i__1 = nsav4tie;
4027 #line 1688 ""
4028  for (isav = 1; isav <= i__1; ++isav) {
4029 #line 1689 ""
4030  if (isav == it1 || isav == it2) {
4031 #line 1689 ""
4032  goto L14;
4033 #line 1689 ""
4034  }
4035 #line 1690 ""
4036  ++jsav;
4037 #line 1691 ""
4038  itk[jsav - 1] = (shortint) isav;
4039 #line 1692 ""
4040 L14:
4041 #line 1692 ""
4042  ;
4043 #line 1692 ""
4044  }
4045 #line 1693 ""
4046  nsav4tie += -2;
4047 
4048 /* Now dump events it1 & it2, recompute times, restack mmidi. */
4049 
4050 #line 1697 ""
4051  commidi_1.imidi[*icm] = comslm_1.imidso[*icm];
4052 #line 1698 ""
4053  i__1 = nsav4tie;
4054 #line 1698 ""
4055  for (isav = 1; isav <= i__1; ++isav) {
4056 #line 1699 ""
4057  if (isav == 1) {
4058 #line 1700 ""
4059  idurvar = isetvarlen_(&itiesav[itk[isav - 1] * 5 - 1], &
4060  nbytes);
4061 #line 1701 ""
4062  } else {
4063 #line 1702 ""
4064  i__2 = itiesav[itk[isav - 1] * 5 - 1] - itiesav[itk[isav
4065  - 2] * 5 - 1];
4066 #line 1702 ""
4067  idurvar = isetvarlen_(&i__2, &nbytes);
4068 #line 1704 ""
4069  }
4070 #line 1705 ""
4071  ++commidi_1.imidi[*icm];
4072 #line 1706 ""
4073  i__2 = nbytes;
4074 #line 1706 ""
4075  for (i__ = 1; i__ <= i__2; ++i__) {
4076 #line 1707 ""
4077  commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nbytes -
4078  i__) * 25 - 25] = (shortint) (idurvar % 256);
4079 #line 1708 ""
4080  if (nbytes > 1) {
4081 #line 1708 ""
4082  idurvar /= 256;
4083 #line 1708 ""
4084  }
4085 #line 1709 ""
4086 /* L16: */
4087 #line 1709 ""
4088  }
4089 #line 1710 ""
4090  commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nbytes - 1;
4091 #line 1711 ""
4092  for (i__ = 2; i__ <= 4; ++i__) {
4093 #line 1712 ""
4094  ++commidi_1.imidi[*icm];
4095 #line 1713 ""
4096  commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] =
4097  (shortint) itiesav[i__ + itk[isav - 1] * 5 - 6];
4098 #line 1714 ""
4099 /* L17: */
4100 #line 1714 ""
4101  }
4102 #line 1715 ""
4103 /* L15: */
4104 #line 1715 ""
4105  }
4106 #line 1716 ""
4107  }
4108 #line 1717 ""
4109  comslm_1.slmon[*icm] = FALSE_;
4110 #line 1718 ""
4111  comslm_1.levsoff[*icm] = 0;
4112 #line 1719 ""
4113  if (! comslm_1.dbltie) {
4114 #line 1719 ""
4115  comslm_1.levson[*icm] = 0;
4116 #line 1719 ""
4117  }
4118 #line 1720 ""
4119  }
4120 #line 1721 ""
4121  if (comslm_1.levson[*icm] > 0) {
4122 #line 1721 ""
4123  comslm_1.slmon[*icm] = TRUE_;
4124 #line 1721 ""
4125  }
4126 #line 1722 ""
4127  if (commidi_1.nmidcrd > 0) {
4128 #line 1722 ""
4129  commidi_1.nmidcrd = 0;
4130 #line 1722 ""
4131  }
4132 #line 1723 ""
4133  chkimidi_(icm);
4134 #line 1724 ""
4135  return 0;
4136 } /* addmidi_ */
4137 
4138 /* Subroutine */ int addstr_(char *notexq, integer *lnote, char *soutq,
4139  integer *lsout, ftnlen notexq_len, ftnlen soutq_len)
4140 {
4141  /* System generated locals */
4142  address a__1[2];
4143  integer i__1[2];
4144  char ch__1[81];
4145 
4146  /* Builtin functions */
4147  integer s_wsfe(cilist *);
4148  /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
4149  integer do_fio(integer *, char *, ftnlen), e_wsfe(void);
4150  /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
4151 
4152  /* Fortran I/O blocks */
4153  static cilist io___112 = { 0, 11, 0, "(a)", 0 };
4154 
4155 
4156 #line 1731 ""
4157  if (*lsout + *lnote > 72) {
4158 #line 1732 ""
4159  if (comlast_1.islast) {
4160 #line 1732 ""
4161  s_wsfe(&io___112);
4162 /* Writing concatenation */
4163 #line 1732 ""
4164  i__1[0] = *lsout, a__1[0] = soutq;
4165 #line 1732 ""
4166  i__1[1] = 1, a__1[1] = "%";
4167 #line 1732 ""
4168  s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)81);
4169 #line 1732 ""
4170  do_fio(&c__1, ch__1, *lsout + 1);
4171 #line 1732 ""
4172  e_wsfe();
4173 #line 1732 ""
4174  }
4175 #line 1733 ""
4176  *lsout = 0;
4177 #line 1734 ""
4178  }
4179 #line 1735 ""
4180  if (*lsout > 0) {
4181 /* Writing concatenation */
4182 #line 1736 ""
4183  i__1[0] = *lsout, a__1[0] = soutq;
4184 #line 1736 ""
4185  i__1[1] = *lnote, a__1[1] = notexq;
4186 #line 1736 ""
4187  s_cat(soutq, a__1, i__1, &c__2, (ftnlen)80);
4188 #line 1737 ""
4189  } else {
4190 #line 1738 ""
4191  s_copy(soutq, notexq, (ftnlen)80, (*lnote));
4192 #line 1739 ""
4193  }
4194 #line 1740 ""
4195  *lsout += *lnote;
4196 #line 1741 ""
4197  return 0;
4198 } /* addstr_ */
4199 
4200 /* Subroutine */ int adjusteskz_(integer *ib, integer *istart, real *poenom)
4201 {
4202  /* System generated locals */
4203  integer i__1, i__2;
4204  real r__1;
4205 
4206  /* Local variables */
4207  static integer in, iaskb, inmin;
4208  static real eskadd;
4209 
4210 
4211 /* For block ib, this adds accidental spaces to eskz, for use in getting */
4212 /* length of xtup bracket and slopes of brackets and beams. */
4213 
4214 #line 1767 ""
4215  /* Parameter adjustments */
4216 #line 1767 ""
4217  --istart;
4218 #line 1767 ""
4219 
4220 #line 1767 ""
4221  /* Function Body */
4222 #line 1767 ""
4223  inmin = istart[*ib] + 1;
4224 #line 1768 ""
4225  i__1 = comas1_1.naskb;
4226 #line 1768 ""
4227  for (iaskb = 1; iaskb <= i__1; ++iaskb) {
4228 #line 1769 ""
4229  if (comas1_1.task[iaskb - 1] < all_1.to[istart[*ib] - 1] -
4230  comtol_1.tol) {
4231 #line 1769 ""
4232  goto L10;
4233 #line 1769 ""
4234  }
4235 #line 1770 ""
4236  eskadd = comas1_1.wask[iaskb - 1] / *poenom - comas1_1.elask[iaskb -
4237  1];
4238 #line 1771 ""
4239  i__2 = comntot_1.ntot;
4240 #line 1771 ""
4241  for (in = inmin; in <= i__2; ++in) {
4242 #line 1772 ""
4243  if (all_1.to[in - 1] > comas1_1.task[iaskb - 1] - comtol_1.tol) {
4244 #line 1773 ""
4245  comeskz2_1.eskz2[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24
4246  - 25] += eskadd;
4247 #line 1774 ""
4248  if ((r__1 = all_1.to[in - 1] - comas1_1.task[iaskb - 1], dabs(
4249  r__1)) < comtol_1.tol) {
4250 #line 1774 ""
4251  --inmin;
4252 #line 1774 ""
4253  }
4254 #line 1775 ""
4255  } else {
4256 #line 1776 ""
4257  ++inmin;
4258 #line 1777 ""
4259  }
4260 #line 1778 ""
4261 /* L11: */
4262 #line 1778 ""
4263  }
4264 #line 1779 ""
4265 L10:
4266 #line 1779 ""
4267  ;
4268 #line 1779 ""
4269  }
4270 #line 1780 ""
4271  return 0;
4272 } /* adjusteskz_ */
4273 
4274 /* Subroutine */ int askfig_(char *pathnameq, integer *lpath, char *basenameq,
4275  integer *lbase, logical *figbass, logical *istype0, ftnlen
4276  pathnameq_len, ftnlen basenameq_len)
4277 {
4278  /* System generated locals */
4279  address a__1[3], a__2[2];
4280  integer i__1[3], i__2[2], i__3;
4281  char ch__1[1], ch__2[88], ch__3[15], ch__4[5], ch__5[4];
4282  olist o__1;
4283  cllist cl__1;
4284  alist al__1;
4285 
4286  /* Builtin functions */
4287  /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
4289  ), do_fio(integer *, char *, ftnlen), e_wsfe(void), s_rsfe(cilist
4290  *), e_rsfe(void), s_cmp(char *, char *, ftnlen, ftnlen), s_wsfi(
4291  icilist *), e_wsfi(void), i_indx(char *, char *, ftnlen, ftnlen);
4292 
4293  /* Local variables */
4294  static integer il;
4295  static char sq[1];
4296  static integer ihs;
4297  extern /* Character */ VOID chax_(char *, ftnlen, integer *);
4298  static logical done;
4299  extern integer llen_(char *, integer *, ftnlen);
4300  static char outq[129];
4301  extern /* Subroutine */ int moveln_(integer *, integer *, logical *);
4302  static integer lenout;
4303  extern /* Subroutine */ int putast_(real *, integer *, char *, ftnlen);
4304  static integer indxask;
4305 
4306  /* Fortran I/O blocks */
4307  static cilist io___120 = { 0, 12, 0, "(a)", 0 };
4308  static cilist io___121 = { 0, 12, 0, "(a)", 0 };
4309  static cilist io___123 = { 0, 11, 1, "(a129)", 0 };
4310  static icilist io___125 = { 0, outq+11, 0, "(f4.1)", 4, 1 };
4311  static cilist io___128 = { 0, 12, 0, "(a)", 0 };
4312  static cilist io___129 = { 0, 16, 1, "(a129)", 0 };
4313  static cilist io___130 = { 0, 12, 0, "(a)", 0 };
4314 
4315 
4316 #line 1792 ""
4317  chax_(ch__1, (ftnlen)1, &c__92);
4318 #line 1792 ""
4319  *(unsigned char *)sq = *(unsigned char *)&ch__1[0];
4320 #line 1793 ""
4321  o__1.oerr = 0;
4322 #line 1793 ""
4323  o__1.ounit = 12;
4324 #line 1793 ""
4325  o__1.ofnmlen = *lpath + *lbase + 4;
4326 /* Writing concatenation */
4327 #line 1793 ""
4328  i__1[0] = *lpath, a__1[0] = pathnameq;
4329 #line 1793 ""
4330  i__1[1] = *lbase, a__1[1] = basenameq;
4331 #line 1793 ""
4332  i__1[2] = 4, a__1[2] = ".tex";
4333 #line 1793 ""
4334  s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)88);
4335 #line 1793 ""
4336  o__1.ofnm = ch__2;
4337 #line 1793 ""
4338  o__1.orl = 0;
4339 #line 1793 ""
4340  o__1.osta = 0;
4341 #line 1793 ""
4342  o__1.oacc = 0;
4343 #line 1793 ""
4344  o__1.ofm = 0;
4345 #line 1793 ""
4346  o__1.oblnk = 0;
4347 #line 1793 ""
4348  f_open(&o__1);
4349 
4350 /* Transfer first 5 lines of main internal TeX file */
4351 
4352 #line 1797 ""
4353  for (il = 1; il <= 5; ++il) {
4354 #line 1798 ""
4355  moveln_(&c__11, &c__12, &done);
4356 #line 1799 ""
4357 /* L11: */
4358 #line 1799 ""
4359  }
4360 #line 1800 ""
4361  if (*istype0) {
4362 
4363 /* Transfer literal TeX stuff from special scratch file */
4364 
4365 #line 1804 ""
4366  al__1.aerr = 0;
4367 #line 1804 ""
4368  al__1.aunit = 17;
4369 #line 1804 ""
4370  f_rew(&al__1);
4371 #line 1805 ""
4372 L10:
4373 #line 1805 ""
4374  moveln_(&c__17, &c__12, &done);
4375 #line 1806 ""
4376  if (! done) {
4377 #line 1806 ""
4378  goto L10;
4379 #line 1806 ""
4380  }
4381 #line 1807 ""
4382  cl__1.cerr = 0;
4383 #line 1807 ""
4384  cl__1.cunit = 17;
4385 #line 1807 ""
4386  cl__1.csta = 0;
4387 #line 1807 ""
4388  f_clos(&cl__1);
4389 #line 1808 ""
4390  }
4391 
4392 /* Transfer next 2 lines from main scratch file */
4393 
4394 #line 1812 ""
4395  for (il = 1; il <= 2; ++il) {
4396 #line 1813 ""
4397  moveln_(&c__11, &c__12, &done);
4398 #line 1814 ""
4399 /* L3: */
4400 #line 1814 ""
4401  }
4402 #line 1815 ""
4403  if (compoi_1.ispoi) {
4404 #line 1815 ""
4405  s_wsfe(&io___120);
4406 /* Writing concatenation */
4407 #line 1815 ""
4408  i__2[0] = 1, a__2[0] = sq;
4409 #line 1815 ""
4410  i__2[1] = 14, a__2[1] = "input musixpoi";
4411 #line 1815 ""
4412  s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)15);
4413 #line 1815 ""
4414  do_fio(&c__1, ch__3, (ftnlen)15);
4415 #line 1815 ""
4416  e_wsfe();
4417 #line 1815 ""
4418  }
4419 #line 1816 ""
4420  if (combbm_1.isbbm) {
4421 #line 1816 ""
4422  s_wsfe(&io___121);
4423 /* Writing concatenation */
4424 #line 1816 ""
4425  i__2[0] = 1, a__2[0] = sq;
4426 #line 1816 ""
4427  i__2[1] = 14, a__2[1] = "input musixbbm";
4428 #line 1816 ""
4429  s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)15);
4430 #line 1816 ""
4431  do_fio(&c__1, ch__3, (ftnlen)15);
4432 #line 1816 ""
4433  e_wsfe();
4434 #line 1816 ""
4435  }
4436 #line 1817 ""
4437  if (*figbass) {
4438 
4439 /* Transfer .fig data from scratch (unit 14) into external .tex (unit 12) */
4440 
4441 #line 1821 ""
4442 L4:
4443 #line 1821 ""
4444  moveln_(&c__14, &c__12, &done);
4445 #line 1822 ""
4446  if (! done) {
4447 #line 1822 ""
4448  goto L4;
4449 #line 1822 ""
4450  }
4451 #line 1823 ""
4452  cl__1.cerr = 0;
4453 #line 1823 ""
4454  cl__1.cunit = 14;
4455 #line 1823 ""
4456  cl__1.csta = 0;
4457 #line 1823 ""
4458  f_clos(&cl__1);
4459 #line 1824 ""
4460  }
4461 #line 1825 ""
4462  comas3_1.iask = 0;
4463 #line 1826 ""
4464  ihs = 0;
4465 #line 1827 ""
4466 L1:
4467 #line 1827 ""
4468  i__3 = s_rsfe(&io___123);
4469 #line 1827 ""
4470  if (i__3 != 0) {
4471 #line 1827 ""
4472  goto L999;
4473 #line 1827 ""
4474  }
4475 #line 1827 ""
4476  i__3 = do_fio(&c__1, outq, (ftnlen)129);
4477 #line 1827 ""
4478  if (i__3 != 0) {
4479 #line 1827 ""
4480  goto L999;
4481 #line 1827 ""
4482  }
4483 #line 1827 ""
4484  i__3 = e_rsfe();
4485 #line 1827 ""
4486  if (i__3 != 0) {
4487 #line 1827 ""
4488  goto L999;
4489 #line 1827 ""
4490  }
4491 
4492 /* Hardspaces. */
4493 
4494 /* Writing concatenation */
4495 #line 1831 ""
4496  i__2[0] = 1, a__2[0] = sq;
4497 #line 1831 ""
4498  i__2[1] = 4, a__2[1] = "xard";
4499 #line 1831 ""
4500  s_cat(ch__4, a__2, i__2, &c__2, (ftnlen)5);
4501 #line 1831 ""
4502  if (s_cmp(outq, ch__4, (ftnlen)5, (ftnlen)5) == 0) {
4503 #line 1832 ""
4504  ++ihs;
4505 #line 1833 ""
4506  *(unsigned char *)&outq[1] = 'h';
4507 #line 1834 ""
4508  s_wsfi(&io___125);
4509 #line 1834 ""
4510  do_fio(&c__1, (char *)&comhsp_1.hpttot[ihs - 1], (ftnlen)sizeof(real))
4511  ;
4512 #line 1834 ""
4513  e_wsfi();
4514 #line 1835 ""
4515  lenout = 19;
4516 #line 1836 ""
4517  goto L9;
4518 #line 1837 ""
4519  }
4520 
4521 /* This part hard-wires ask's into new .tex file as ast's */
4522 
4523 #line 1841 ""
4524 L2:
4525 /* Writing concatenation */
4526 #line 1841 ""
4527  i__2[0] = 1, a__2[0] = sq;
4528 #line 1841 ""
4529  i__2[1] = 3, a__2[1] = "ask";
4530 #line 1841 ""
4531  s_cat(ch__5, a__2, i__2, &c__2, (ftnlen)4);
4532 #line 1841 ""
4533  indxask = i_indx(outq, ch__5, (ftnlen)129, (ftnlen)4);
4534 #line 1842 ""
4535  if (indxask != 0) {
4536 #line 1843 ""
4537  ++comas3_1.iask;
4538 #line 1844 ""
4539  putast_(&comas3_1.ask[comas3_1.iask - 1], &indxask, outq, (ftnlen)129)
4540  ;
4541 #line 1845 ""
4542  goto L2;
4543 #line 1846 ""
4544  }
4545 #line 1847 ""
4546  lenout = llen_(outq, &c__129, (ftnlen)129);
4547 #line 1848 ""
4548 L9:
4549 #line 1849 ""
4550  s_wsfe(&io___128);
4551 #line 1849 ""
4552  do_fio(&c__1, outq, lenout);
4553 #line 1849 ""
4554  e_wsfe();
4555 
4556 /* If this is the line with "readmod", check for topmods. */
4557 
4558 #line 1853 ""
4559  if (comas3_1.topmods && s_cmp(outq + 1, "readmod", (ftnlen)7, (ftnlen)7)
4560  == 0) {
4561 #line 1854 ""
4562  comas3_1.topmods = FALSE_;
4563 #line 1855 ""
4564  al__1.aerr = 0;
4565 #line 1855 ""
4566  al__1.aunit = 16;
4567 #line 1855 ""
4568  f_rew(&al__1);
4569 #line 1856 ""
4570  for (il = 1; il <= 1000; ++il) {
4571 #line 1857 ""
4572  i__3 = s_rsfe(&io___129);
4573 #line 1857 ""
4574  if (i__3 != 0) {
4575 #line 1857 ""
4576  goto L8;
4577 #line 1857 ""
4578  }
4579 #line 1857 ""
4580  i__3 = do_fio(&c__1, outq, (ftnlen)129);
4581 #line 1857 ""
4582  if (i__3 != 0) {
4583 #line 1857 ""
4584  goto L8;
4585 #line 1857 ""
4586  }
4587 #line 1857 ""
4588  i__3 = e_rsfe();
4589 #line 1857 ""
4590  if (i__3 != 0) {
4591 #line 1857 ""
4592  goto L8;
4593 #line 1857 ""
4594  }
4595 #line 1858 ""
4596  lenout = llen_(outq, &c__129, (ftnlen)129);
4597 
4598 /* We inserted the '%' in subroutine littex, to guarantee including blank. */
4599 
4600 #line 1862 ""
4601  s_wsfe(&io___130);
4602 #line 1862 ""
4603  do_fio(&c__1, outq, lenout);
4604 #line 1862 ""
4605  e_wsfe();
4606 #line 1863 ""
4607 /* L7: */
4608 #line 1863 ""
4609  }
4610 #line 1864 ""
4611 L8:
4612 #line 1865 ""
4613  cl__1.cerr = 0;
4614 #line 1865 ""
4615  cl__1.cunit = 16;
4616 #line 1865 ""
4617  cl__1.csta = 0;
4618 #line 1865 ""
4619  f_clos(&cl__1);
4620 #line 1866 ""
4621  }
4622 #line 1867 ""
4623  goto L1;
4624 #line 1868 ""
4625 L999:
4626 #line 1868 ""
4627  cl__1.cerr = 0;
4628 #line 1868 ""
4629  cl__1.cunit = 11;
4630 #line 1868 ""
4631  cl__1.csta = 0;
4632 #line 1868 ""
4633  f_clos(&cl__1);
4634 #line 1869 ""
4635  cl__1.cerr = 0;
4636 #line 1869 ""
4637  cl__1.cunit = 12;
4638 #line 1869 ""
4639  cl__1.csta = 0;
4640 #line 1869 ""
4641  f_clos(&cl__1);
4642 #line 1870 ""
4643  return 0;
4644 } /* askfig_ */
4645 
4646 /* Subroutine */ int backfill_(integer *iunit, char *oldq, integer *lenold,
4647  char *newq, integer *lennew, ftnlen oldq_len, ftnlen newq_len)
4648 {
4649  /* System generated locals */
4650  address a__1[3];
4651  integer i__1, i__2[3];
4652  alist al__1;
4653 
4654  /* Builtin functions */
4655  integer f_back(alist *), s_rsfe(cilist *), do_fio(integer *, char *,
4656  ftnlen), e_rsfe(void), i_indx(char *, char *, ftnlen, ftnlen);
4657  /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
4658  char **, integer *, integer *, ftnlen);
4659  integer s_wsfe(cilist *), e_wsfe(void);
4660 
4661  /* Local variables */
4662  static integer linesback, ndx, line;
4663  static char nowq[128], lineq[128*200];
4664 
4665  /* Fortran I/O blocks */
4666  static cilist io___132 = { 0, 0, 0, "(a)", 0 };
4667  static cilist io___137 = { 0, 0, 0, "(a128)", 0 };
4668 
4669 
4670 
4671 /* In iunit, looks backward for oldq, overwrites newq */
4672 /* Safest if both are same length! */
4673 
4674 #line 1879 ""
4675  linesback = 0;
4676 #line 1880 ""
4677 L1:
4678 #line 1881 ""
4679  al__1.aerr = 0;
4680 #line 1881 ""
4681  al__1.aunit = *iunit;
4682 #line 1881 ""
4683  f_back(&al__1);
4684 #line 1882 ""
4685  io___132.ciunit = *iunit;
4686 #line 1882 ""
4687  s_rsfe(&io___132);
4688 #line 1882 ""
4689  do_fio(&c__1, nowq, (ftnlen)128);
4690 #line 1882 ""
4691  e_rsfe();
4692 #line 1883 ""
4693  ndx = i_indx(nowq, oldq, (ftnlen)128, (*lenold));
4694 
4695 /* Save the line just read */
4696 
4697 #line 1887 ""
4698  ++linesback;
4699 #line 1888 ""
4700  s_copy(lineq + (linesback - 1 << 7), nowq, (ftnlen)128, (ftnlen)128);
4701 #line 1889 ""
4702  if (ndx == 0) {
4703 #line 1890 ""
4704  al__1.aerr = 0;
4705 #line 1890 ""
4706  al__1.aunit = *iunit;
4707 #line 1890 ""
4708  f_back(&al__1);
4709 #line 1891 ""
4710  goto L1;
4711 #line 1892 ""
4712  }
4713 
4714 /* If here, it's replacement time. */
4715 
4716 #line 1896 ""
4717  i__1 = ndx + *lenold - 1;
4718 /* Writing concatenation */
4719 #line 1896 ""
4720  i__2[0] = ndx - 1, a__1[0] = nowq;
4721 #line 1896 ""
4722  i__2[1] = *lennew, a__1[1] = newq;
4723 #line 1896 ""
4724  i__2[2] = 128 - i__1, a__1[2] = nowq + i__1;
4725 #line 1896 ""
4726  s_cat(lineq + (linesback - 1 << 7), a__1, i__2, &c__3, (ftnlen)128);
4727 #line 1898 ""
4728  al__1.aerr = 0;
4729 #line 1898 ""
4730  al__1.aunit = *iunit;
4731 #line 1898 ""
4732  f_back(&al__1);
4733 #line 1899 ""
4734  for (line = linesback; line >= 1; --line) {
4735 #line 1900 ""
4736  io___137.ciunit = *iunit;
4737 #line 1900 ""
4738  s_wsfe(&io___137);
4739 #line 1900 ""
4740  do_fio(&c__1, lineq + (line - 1 << 7), (ftnlen)128);
4741 #line 1900 ""
4742  e_wsfe();
4743 #line 1901 ""
4744 /* L2: */
4745 #line 1901 ""
4746  }
4747 #line 1902 ""
4748  return 0;
4749 } /* backfill_ */
4750 
4751 /* Subroutine */ int beamend_(char *notexq, integer *lnote, ftnlen notexq_len)
4752 {
4753  /* System generated locals */
4754  address a__1[13], a__2[2], a__3[6], a__4[4], a__5[5], a__6[3], a__7[7];
4755  integer i__1, i__2[13], i__3[2], i__4[6], i__5[4], i__6[5], i__7[3], i__8[
4756  7], i__9;
4757  real r__1;
4758  char ch__1[1];
4759 
4760  /* Builtin functions */
4762  char *, ftnlen), e_wsfi(void);
4763  /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen),
4764  s_copy(char *, char *, ftnlen, ftnlen);
4765  integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char
4766  *, ftnlen);
4767 
4768  /* Local variables */
4769  extern /* Subroutine */ int addblank_(char *, integer *, ftnlen);
4770  extern integer igetbits_(integer *, integer *, integer *);
4771  static integer ip, mp, len, imp;
4772  extern integer log2_(integer *);
4773  extern /* Character */ VOID chax_(char *, ftnlen, integer *);
4774  static integer nole;
4775  static real slen;
4776  static char ulqq[1];
4777  extern /* Subroutine */ int stop1_(void);
4778  extern integer ncmid_(integer *, integer *);
4779  static integer ndsav;
4780  static char tempq[4], noteq[8];
4781  extern /* Subroutine */ int notex_(char *, integer *, ftnlen);
4782  static real addoff;
4783  extern /* Subroutine */ int ntrbbb_(integer *, char *, char *, integer *,
4784  char *, integer *, ftnlen, ftnlen, ftnlen), notefq_(char *,
4785  integer *, integer *, integer *, ftnlen);
4786  static logical isdotm;
4787  static integer lnoten, multip, nindent;
4788  extern /* Subroutine */ int istring_(integer *, char *, integer *, ftnlen)
4789  ;
4790 
4791  /* Fortran I/O blocks */
4792  static icilist io___144 = { 0, tempq, 0, "(f4.1)", 4, 1 };
4793  static icilist io___145 = { 0, tempq, 0, "(f4.2)", 4, 1 };
4794  static icilist io___148 = { 0, noteq, 0, "(i2)", 2, 1 };
4795  static icilist io___150 = { 0, tempq, 0, "(f4.1)", 4, 1 };
4796  static icilist io___151 = { 0, tempq, 0, "(f4.2)", 4, 1 };
4797  static icilist io___153 = { 0, tempq, 0, "(f4.1)", 4, 1 };
4798  static icilist io___154 = { 0, tempq, 0, "(f4.1)", 4, 1 };
4799  static cilist io___155 = { 0, 6, 0, 0, 0 };
4800  static cilist io___156 = { 0, 6, 0, 0, 0 };
4801  static icilist io___160 = { 0, noteq, 0, "(i2)", 2, 1 };
4802 
4803 
4804 #line 1930 ""
4805  ip = all_1.ipo[all_1.jn - 1];
4806 #line 1931 ""
4807  multip = (all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8;
4808 #line 1932 ""
4809  *lnote = 0;
4810 #line 1933 ""
4811  if (strtmid_1.ixrest[commvl_1.ivx - 1] == 4) {
4812 
4813 /* This is the LAST note in the xtup (i.e., all rests before). Make single. */
4814 
4815 #line 1937 ""
4816  i__1 = 4 - multip;
4817 #line 1937 ""
4818  all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &i__1);
4819 #line 1938 ""
4820  notex_(notexq, lnote, (ftnlen)79);
4821 #line 1939 ""
4822  strtmid_1.ixrest[commvl_1.ivx - 1] = 0;
4823 #line 1940 ""
4824  return 0;
4825 #line 1941 ""
4826  }
4827 #line 1942 ""
4828  nole = all_1.nolev[commvl_1.ivx + ip * 24 - 25];
4829 
4830 /* Check for special situations with 2nds (see precrd) */
4831 
4832 #line 1946 ""
4833  if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],30)) {
4834 #line 1947 ""
4835  --nole;
4836 #line 1948 ""
4837  } else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],31)) {
4838 #line 1949 ""
4839  ++nole;
4840 #line 1950 ""
4841  }
4842 
4843 /* Terminate indented beams for 2-note tremolo if needed */
4844 
4845 #line 1954 ""
4846  if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],2) &&
4847  igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25], &c__2,
4848  &c__5) > 0) {
4849 #line 1956 ""
4850  nindent = igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25], &
4851  c__2, &c__5);
4852 #line 1957 ""
4853  if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[
4854  commvl_1.ivx - 1] * 24 - 25] == 'u') {
4855 #line 1958 ""
4856  addoff = -1 - nindent * .5f;
4857 #line 1959 ""
4858  } else {
4859 #line 1960 ""
4860  addoff = nindent * .5f + 1;
4861 #line 1961 ""
4862  }
4863 /* addoff = addoff+(.595-.065*abs(islope(ivx)))*islope(ivx) */
4864 #line 1963 ""
4865  addoff += comxtup_1.islope[commvl_1.ivx - 1] * .0822f;
4866 #line 1964 ""
4867  if (addoff < -.05f) {
4868 #line 1965 ""
4869  s_wsfi(&io___144);
4870 #line 1965 ""
4871  do_fio(&c__1, (char *)&addoff, (ftnlen)sizeof(real));
4872 #line 1965 ""
4873  e_wsfi();
4874 #line 1966 ""
4875  } else {
4876 #line 1967 ""
4877  s_wsfi(&io___145);
4878 #line 1967 ""
4879  do_fio(&c__1, (char *)&addoff, (ftnlen)sizeof(real));
4880 #line 1967 ""
4881  e_wsfi();
4882 #line 1968 ""
4883  }
4884 /* Writing concatenation */
4885 #line 1969 ""
4886  i__2[0] = 1, a__1[0] = all_1.sq;
4887 #line 1969 ""
4888  i__2[1] = 5, a__1[1] = "raise";
4889 #line 1969 ""
4890  i__2[2] = 4, a__1[2] = tempq;
4891 #line 1969 ""
4892  i__2[3] = 1, a__1[3] = all_1.sq;
4893 #line 1969 ""
4894  i__2[4] = 9, a__1[4] = "internote";
4895 #line 1969 ""
4896  i__2[5] = 1, a__1[5] = all_1.sq;
4897 #line 1969 ""
4898  i__2[6] = 5, a__1[6] = "hbox{";
4899 #line 1969 ""
4900  i__2[7] = 1, a__1[7] = all_1.sq;
4901 #line 1969 ""
4902  i__2[8] = 12, a__1[8] = "loffset{.7}{";
4903 #line 1969 ""
4904  i__2[9] = 1, a__1[9] = all_1.sq;
4905 #line 1969 ""
4906  i__2[10] = 2, a__1[10] = "tb";
4907 #line 1969 ""
4908  i__2[11] = 1, a__1[11] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[
4909  commvl_1.ivx - 1] * 24 - 25);
4910 #line 1969 ""
4911  i__2[12] = 3, a__1[12] = "0}}";
4912 #line 1969 ""
4913  s_cat(notexq, a__1, i__2, &c__13, (ftnlen)79);
4914 #line 1972 ""
4915  *lnote = 46;
4916 #line 1973 ""
4917  }
4918 #line 1974 ""
4919  if (! comdraw_1.drawbm[commvl_1.ivx - 1]) {
4920 
4921 /* Xtuplet with no beam, just put in the right kind of note */
4922 
4923 #line 1978 ""
4924  if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
4925 
4926 /* Rest at end of unbeamed xtup */
4927 
4928 #line 1982 ""
4929  *lnote = 3;
4930 #line 1983 ""
4931  if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29)) {
4932 /* Writing concatenation */
4933 #line 1984 ""
4934  i__3[0] = 1, a__2[0] = all_1.sq;
4935 #line 1984 ""
4936  i__3[1] = 2, a__2[1] = "sk";
4937 #line 1984 ""
4938  s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4939 
4940 /* 180106 There was a problem with nolev(ivx,ip) not being set to 0 for */
4941 /* a blank rest ending xtup, but hopefully returning from here will handle it. */
4942 
4943 #line 1989 ""
4944  return 0;
4945 #line 1990 ""
4946  } else if (multip == 0) {
4947 /* Writing concatenation */
4948 #line 1991 ""
4949  i__3[0] = 1, a__2[0] = all_1.sq;
4950 #line 1991 ""
4951  i__3[1] = 2, a__2[1] = "qp";
4952 #line 1991 ""
4953  s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4954 #line 1992 ""
4955  } else if (multip == -1) {
4956 /* Writing concatenation */
4957 #line 1993 ""
4958  i__3[0] = 1, a__2[0] = all_1.sq;
4959 #line 1993 ""
4960  i__3[1] = 2, a__2[1] = "hp";
4961 #line 1993 ""
4962  s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4963 #line 1994 ""
4964  } else if (multip == 1) {
4965 /* Writing concatenation */
4966 #line 1995 ""
4967  i__3[0] = 1, a__2[0] = all_1.sq;
4968 #line 1995 ""
4969  i__3[1] = 2, a__2[1] = "ds";
4970 #line 1995 ""
4971  s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4972 #line 1996 ""
4973  } else if (multip == 2) {
4974 /* Writing concatenation */
4975 #line 1997 ""
4976  i__3[0] = 1, a__2[0] = all_1.sq;
4977 #line 1997 ""
4978  i__3[1] = 2, a__2[1] = "qs";
4979 #line 1997 ""
4980  s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4981 #line 1998 ""
4982  } else {
4983 /* Writing concatenation */
4984 #line 1999 ""
4985  i__3[0] = 1, a__2[0] = all_1.sq;
4986 #line 1999 ""
4987  i__3[1] = 2, a__2[1] = "hs";
4988 #line 1999 ""
4989  s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
4990 #line 2000 ""
4991  }
4992 
4993 /* 180106 Deal with possible level tweak */
4994 
4995 #line 2004 ""
4996  nole = (all_1.nolev[commvl_1.ivx + ip * 24 - 25] + 50) % 100 - 50;
4997 #line 2005 ""
4998  if (nole != 0) {
4999 #line 2006 ""
5000  if (abs(nole) < 10) {
5001 #line 2007 ""
5002  i__1 = abs(nole) + 48;
5003 #line 2007 ""
5004  chax_(ch__1, (ftnlen)1, &i__1);
5005 #line 2007 ""
5006  s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1);
5007 #line 2008 ""
5008  lnoten = 1;
5009 #line 2009 ""
5010  } else {
5011 #line 2010 ""
5012  s_wsfi(&io___148);
5013 #line 2010 ""
5014  i__1 = abs(nole);
5015 #line 2010 ""
5016  do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
5017 #line 2010 ""
5018  e_wsfi();
5019 #line 2011 ""
5020  lnoten = 2;
5021 #line 2012 ""
5022  }
5023 #line 2013 ""
5024  if (nole > 0) {
5025 /* Writing concatenation */
5026 #line 2014 ""
5027  i__4[0] = 1, a__3[0] = all_1.sq;
5028 #line 2014 ""
5029  i__4[1] = 5, a__3[1] = "raise";
5030 #line 2014 ""
5031  i__4[2] = lnoten, a__3[2] = noteq;
5032 #line 2014 ""
5033  i__4[3] = 1, a__3[3] = all_1.sq;
5034 #line 2014 ""
5035  i__4[4] = 9, a__3[4] = "internote";
5036 #line 2014 ""
5037  i__4[5] = *lnote, a__3[5] = notexq;
5038 #line 2014 ""
5039  s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79);
5040 #line 2016 ""
5041  } else {
5042 /* Writing concatenation */
5043 #line 2017 ""
5044  i__4[0] = 1, a__3[0] = all_1.sq;
5045 #line 2017 ""
5046  i__4[1] = 5, a__3[1] = "lower";
5047 #line 2017 ""
5048  i__4[2] = lnoten, a__3[2] = noteq;
5049 #line 2017 ""
5050  i__4[3] = 1, a__3[3] = all_1.sq;
5051 #line 2017 ""
5052  i__4[4] = 9, a__3[4] = "internote";
5053 #line 2017 ""
5054  i__4[5] = *lnote, a__3[5] = notexq;
5055 #line 2017 ""
5056  s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79);
5057 #line 2019 ""
5058  }
5059 #line 2020 ""
5060  *lnote = lnoten + 16 + *lnote;
5061 #line 2021 ""
5062  }
5063 #line 2022 ""
5064  return 0;
5065 #line 2023 ""
5066  }
5067 #line 2024 ""
5068  if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],30)) {
5069 
5070 /* Forced stem direction */
5071 
5072 #line 2028 ""
5073  ndsav = all_1.nodur[commvl_1.ivx + ip * 24 - 25];
5074 #line 2029 ""
5075  i__1 = 4 - multip;
5076 #line 2029 ""
5077  all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &i__1);
5078 #line 2030 ""
5079  if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) {
5080 #line 2030 ""
5081  all_1.nodur[commvl_1.ivx + ip * 24 - 25] /= 2;
5082 #line 2030 ""
5083  }
5084 #line 2032 ""
5085  notex_(notexq, lnote, (ftnlen)79);
5086 #line 2033 ""
5087  all_1.nodur[commvl_1.ivx + ip * 24 - 25] = ndsav;
5088 #line 2034 ""
5089  } else {
5090 #line 2035 ""
5091  i__1 = ncmid_(&all_1.iv, &ip);
5092 #line 2035 ""
5093  notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
5094 #line 2036 ""
5095  if (lnoten == 1) {
5096 #line 2036 ""
5097  addblank_(noteq, &lnoten, (ftnlen)8);
5098 #line 2036 ""
5099  }
5100 
5101 /* To reduce confusion due to this early update of lnote, do it */
5102 /* below, separately in each case/ */
5103 /* lnote = lnoten+3 */
5104 #line 2041 ""
5105  if (! bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27))
5106  {
5107 
5108 /* Prior note is not regular-dotted */
5109 
5110 #line 2045 ""
5111  if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],2)
5112  && igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) *
5113  24 - 25], &c__2, &c__5) > 0) {
5114 
5115 /* Unbeamed tremolo with indented beams. Put termination in right here */
5116 
5117 #line 2050 ""
5118  nindent = igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) *
5119  24 - 25], &c__2, &c__5);
5120 #line 2051 ""
5121  if (*(unsigned char *)&all_1.ulq[commvl_1.ivx +
5122  all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] == 'u')
5123  {
5124 #line 2052 ""
5125  addoff = -1 - nindent * .5f;
5126 #line 2053 ""
5127  } else {
5128 #line 2054 ""
5129  addoff = nindent * .5f + 1;
5130 #line 2055 ""
5131  }
5132 
5133 /* Is there an islope here, for unbeamed? */
5134 
5135 #line 2059 ""
5136  if (addoff < -.05f) {
5137 #line 2060 ""
5138  s_wsfi(&io___150);
5139 #line 2060 ""
5140  do_fio(&c__1, (char *)&addoff, (ftnlen)sizeof(real));
5141 #line 2060 ""
5142  e_wsfi();
5143 #line 2061 ""
5144  } else {
5145 #line 2062 ""
5146  s_wsfi(&io___151);
5147 #line 2062 ""
5148  do_fio(&c__1, (char *)&addoff, (ftnlen)sizeof(real));
5149 #line 2062 ""
5150  e_wsfi();
5151 #line 2063 ""
5152  }
5153 /* Writing concatenation */
5154 #line 2064 ""
5155  i__2[0] = 1, a__1[0] = all_1.sq;
5156 #line 2064 ""
5157  i__2[1] = 5, a__1[1] = "raise";
5158 #line 2064 ""
5159  i__2[2] = 4, a__1[2] = tempq;
5160 #line 2064 ""
5161  i__2[3] = 1, a__1[3] = all_1.sq;
5162 #line 2064 ""
5163  i__2[4] = 9, a__1[4] = "internote";
5164 #line 2064 ""
5165  i__2[5] = 1, a__1[5] = all_1.sq;
5166 #line 2064 ""
5167  i__2[6] = 5, a__1[6] = "hbox{";
5168 #line 2064 ""
5169  i__2[7] = 1, a__1[7] = all_1.sq;
5170 #line 2064 ""
5171  i__2[8] = 12, a__1[8] = "loffset{.7}{";
5172 #line 2064 ""
5173  i__2[9] = 1, a__1[9] = all_1.sq;
5174 #line 2064 ""
5175  i__2[10] = 2, a__1[10] = "tb";
5176 #line 2064 ""
5177  i__2[11] = 1, a__1[11] = all_1.ulq + (commvl_1.ivx +
5178  all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
5179 #line 2064 ""
5180  i__2[12] = 3, a__1[12] = "0}}";
5181 #line 2064 ""
5182  s_cat(notexq, a__1, i__2, &c__13, (ftnlen)79);
5183 #line 2068 ""
5184  *lnote = 46;
5185 #line 2069 ""
5186  }
5187 #line 2070 ""
5188  if (multip == 0) {
5189 #line 2071 ""
5190  if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 -
5191  25],2) && all_1.nodur[commvl_1.ivx + ip * 24 - 25]
5192  > 24) {
5193 
5194 /* 2nd note of unbeamed half-note trem; make open */
5195 /* But it's not clear if unbeamed half-note tremolo is Kosher, */
5196 /* so don't worry about stem lengths here now. */
5197 
5198 #line 2078 ""
5199  if (*lnote == 0) {
5200 /* Writing concatenation */
5201 #line 2079 ""
5202  i__5[0] = 1, a__4[0] = all_1.sq;
5203 #line 2079 ""
5204  i__5[1] = 1, a__4[1] = "h";
5205 #line 2079 ""
5206  i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx
5207  + all_1.ibmcnt[commvl_1.ivx - 1] * 24 -
5208  25);
5209 #line 2079 ""
5210  i__5[3] = 8, a__4[3] = noteq;
5211 #line 2079 ""
5212  s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
5213 #line 2080 ""
5214  } else {
5215 /* Writing concatenation */
5216 #line 2081 ""
5217  i__6[0] = 46, a__5[0] = notexq;
5218 #line 2081 ""
5219  i__6[1] = 1, a__5[1] = all_1.sq;
5220 #line 2081 ""
5221  i__6[2] = 1, a__5[2] = "h";
5222 #line 2081 ""
5223  i__6[3] = 1, a__5[3] = all_1.ulq + (commvl_1.ivx
5224  + all_1.ibmcnt[commvl_1.ivx - 1] * 24 -
5225  25);
5226 #line 2081 ""
5227  i__6[4] = 8, a__5[4] = noteq;
5228 #line 2081 ""
5229  s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79);
5230 #line 2083 ""
5231  *lnote = 46;
5232 #line 2084 ""
5233  }
5234 #line 2085 ""
5235  } else {
5236 #line 2086 ""
5237  if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24
5238  - 25],2) && all_1.nodur[commvl_1.ivx + ip *
5239  24 - 25] == 24 || all_1.nodur[commvl_1.ivx +
5240  ip * 24 - 25] == 12) {
5241 
5242 /* Need a dot. */
5243 
5244 #line 2091 ""
5245  *lnote = 46;
5246 #line 2092 ""
5247  if (lnoten == 1) {
5248 /* Writing concatenation */
5249 #line 2093 ""
5250  i__3[0] = 1, a__2[0] = " ";
5251 #line 2093 ""
5252  i__3[1] = 1, a__2[1] = noteq;
5253 #line 2093 ""
5254  s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8);
5255 #line 2094 ""
5256  lnoten = 2;
5257 #line 2095 ""
5258  }
5259 
5260 /* Insert stemlength stuff here for unbeamed dotted tremolo. */
5261 /* May later combine with below to avoid repeat. But need to */
5262 /* return to normal stem length after note is set. */
5263 
5264 #line 2101 ""
5265  nindent = igetbits_(&all_1.irest[commvl_1.ivx + (
5266  ip - 1) * 24 - 25], &c__2, &c__5);
5267 #line 2102 ""
5268  if (*(unsigned char *)&all_1.ulq[commvl_1.ivx +
5269  all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25]
5270  == 'u') {
5271 #line 2103 ""
5272  slen = (nindent + 4.5f + comxtup_1.nolev1[
5273  commvl_1.ivx - 1] - nole + (
5274  all_1.eskz[commvl_1.ivx + ip * 24 -
5275  25] - all_1.eskz[commvl_1.ivx + (ip -
5276  1) * 24 - 25] - .7f) * 1.3f *
5277  comxtup_1.islope[commvl_1.ivx - 1] /
5278  all_1.slfac) * .6667f;
5279 #line 2106 ""
5280  } else {
5281 #line 2107 ""
5282  slen = (nindent + 4.5f - comxtup_1.nolev1[
5283  commvl_1.ivx - 1] + nole - (
5284  all_1.eskz[commvl_1.ivx + ip * 24 -
5285  25] - all_1.eskz[commvl_1.ivx + (ip -
5286  1) * 24 - 25] - .7f) * 1.3f *
5287  comxtup_1.islope[commvl_1.ivx - 1] /
5288  all_1.slfac) * .6667f;
5289 #line 2110 ""
5290  }
5291 #line 2111 ""
5292  s_wsfi(&io___153);
5293 #line 2111 ""
5294  do_fio(&c__1, (char *)&slen, (ftnlen)sizeof(real))
5295  ;
5296 #line 2111 ""
5297  e_wsfi();
5298 /* Writing concatenation */
5299 #line 2112 ""
5300  i__6[0] = 1, a__5[0] = all_1.sq;
5301 #line 2112 ""
5302  i__6[1] = 4, a__5[1] = "slx{";
5303 #line 2112 ""
5304  i__6[2] = 4, a__5[2] = tempq;
5305 #line 2112 ""
5306  i__6[3] = 1, a__5[3] = "}";
5307 #line 2112 ""
5308  i__6[4] = *lnote, a__5[4] = notexq;
5309 #line 2112 ""
5310  s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79);
5311 #line 2113 ""
5312  *lnote += 10;
5313 #line 2114 ""
5314  }
5315 
5316 /* Next steps are a historical kluge to distinguish dotted unbeamed 2-note trem */
5317 /* (needs \qup) from normal xtup on dotted note (eg e44dx2 f, wants no dot) */
5318 
5319 #line 2119 ""
5320  if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24
5321  - 25],2)) {
5322 #line 2120 ""
5323  if (*lnote == 0) {
5324 /* notexq = sq//'q'//ulq(ivx,ibmcnt(ivx)) */
5325 /* Writing concatenation */
5326 #line 2122 ""
5327  i__6[0] = 1, a__5[0] = all_1.sq;
5328 #line 2122 ""
5329  i__6[1] = 1, a__5[1] = "q";
5330 #line 2122 ""
5331  i__6[2] = 1, a__5[2] = all_1.ulq + (
5332  commvl_1.ivx + all_1.ibmcnt[
5333  commvl_1.ivx - 1] * 24 - 25);
5334 #line 2122 ""
5335  i__6[3] = 1, a__5[3] = "p";
5336 #line 2122 ""
5337  i__6[4] = lnoten, a__5[4] = noteq;
5338 #line 2122 ""
5339  s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79);
5340 #line 2124 ""
5341  } else {
5342 /* Writing concatenation */
5343 #line 2125 ""
5344  i__4[0] = *lnote, a__3[0] = notexq;
5345 #line 2125 ""
5346  i__4[1] = 1, a__3[1] = all_1.sq;
5347 #line 2125 ""
5348  i__4[2] = 1, a__3[2] = "q";
5349 #line 2125 ""
5350  i__4[3] = 1, a__3[3] = all_1.ulq + (
5351  commvl_1.ivx + all_1.ibmcnt[
5352  commvl_1.ivx - 1] * 24 - 25);
5353 #line 2125 ""
5354  i__4[4] = 1, a__3[4] = "p";
5355 #line 2125 ""
5356  i__4[5] = lnoten, a__3[5] = noteq;
5357 #line 2125 ""
5358  s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79);
5359 /* * //ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) */
5360 #line 2128 ""
5361  }
5362 /* lnote = lnote+3+lnoten */
5363 #line 2130 ""
5364  *lnote = *lnote + 4 + lnoten;
5365 #line 2131 ""
5366  } else {
5367 #line 2132 ""
5368  if (*lnote == 0) {
5369 /* Writing concatenation */
5370 #line 2133 ""
5371  i__5[0] = 1, a__4[0] = all_1.sq;
5372 #line 2133 ""
5373  i__5[1] = 1, a__4[1] = "q";
5374 #line 2133 ""
5375  i__5[2] = 1, a__4[2] = all_1.ulq + (
5376  commvl_1.ivx + all_1.ibmcnt[
5377  commvl_1.ivx - 1] * 24 - 25);
5378 #line 2133 ""
5379  i__5[3] = lnoten, a__4[3] = noteq;
5380 #line 2133 ""
5381  s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
5382 #line 2135 ""
5383  } else {
5384 /* Writing concatenation */
5385 #line 2136 ""
5386  i__6[0] = *lnote, a__5[0] = notexq;
5387 #line 2136 ""
5388  i__6[1] = 1, a__5[1] = all_1.sq;
5389 #line 2136 ""
5390  i__6[2] = 1, a__5[2] = "q";
5391 #line 2136 ""
5392  i__6[3] = 1, a__5[3] = all_1.ulq + (
5393  commvl_1.ivx + all_1.ibmcnt[
5394  commvl_1.ivx - 1] * 24 - 25);
5395 #line 2136 ""
5396  i__6[4] = lnoten, a__5[4] = noteq;
5397 #line 2136 ""
5398  s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79);
5399 #line 2138 ""
5400  }
5401 #line 2139 ""
5402  *lnote = *lnote + 3 + lnoten;
5403 #line 2140 ""
5404  }
5405 #line 2141 ""
5406  if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24
5407  - 25],2) && all_1.nodur[commvl_1.ivx + ip *
5408  24 - 25] == 24 || all_1.nodur[commvl_1.ivx +
5409  ip * 24 - 25] == 12) {
5410 /* Writing concatenation */
5411 #line 2143 ""
5412  i__7[0] = *lnote, a__6[0] = notexq;
5413 #line 2143 ""
5414  i__7[1] = 1, a__6[1] = all_1.sq;
5415 #line 2143 ""
5416  i__7[2] = 3, a__6[2] = "slz";
5417 #line 2143 ""
5418  s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79);
5419 #line 2144 ""
5420  *lnote += 4;
5421 #line 2145 ""
5422  }
5423 #line 2146 ""
5424  }
5425 #line 2147 ""
5426  } else if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24
5427  - 25],2)) {
5428 
5429 /* 2nd note of unbeamed quarter or 8th trem; make quarter note */
5430 /* Get stemlength change */
5431 
5432 #line 2152 ""
5433  *lnote = 46;
5434 #line 2153 ""
5435  nindent = igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) *
5436  24 - 25], &c__2, &c__5);
5437 #line 2154 ""
5438  if (*(unsigned char *)&all_1.ulq[commvl_1.ivx +
5439  all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] == 'u')
5440  {
5441 #line 2155 ""
5442  slen = (nindent + 4.5f + comxtup_1.nolev1[
5443  commvl_1.ivx - 1] - nole + (all_1.eskz[
5444  commvl_1.ivx + ip * 24 - 25] - all_1.eskz[
5445  commvl_1.ivx + (ip - 1) * 24 - 25] - .7f) *
5446  1.3f * comxtup_1.islope[commvl_1.ivx - 1] /
5447  all_1.slfac) * .6667f;
5448 #line 2158 ""
5449  } else {
5450 #line 2159 ""
5451  slen = (nindent + 4.5f - comxtup_1.nolev1[
5452  commvl_1.ivx - 1] + nole - (all_1.eskz[
5453  commvl_1.ivx + ip * 24 - 25] - all_1.eskz[
5454  commvl_1.ivx + (ip - 1) * 24 - 25] - .7f) *
5455  1.3f * comxtup_1.islope[commvl_1.ivx - 1] /
5456  all_1.slfac) * .6667f;
5457 #line 2162 ""
5458  }
5459 #line 2163 ""
5460  s_wsfi(&io___154);
5461 #line 2163 ""
5462  do_fio(&c__1, (char *)&slen, (ftnlen)sizeof(real));
5463 #line 2163 ""
5464  e_wsfi();
5465 /* Writing concatenation */
5466 #line 2164 ""
5467  i__6[0] = 46, a__5[0] = notexq;
5468 #line 2164 ""
5469  i__6[1] = 1, a__5[1] = all_1.sq;
5470 #line 2164 ""
5471  i__6[2] = 4, a__5[2] = "slx{";
5472