texlive[42656] Build/source/utils/pmx: pmx 2.7.6

commits+kakuto at tug.org commits+kakuto at tug.org
Fri Dec 9 08:18:00 CET 2016


Revision: 42656
          http://tug.org/svn/texlive?view=revision&revision=42656
Author:   kakuto
Date:     2016-12-09 08:17:59 +0100 (Fri, 09 Dec 2016)
Log Message:
-----------
pmx 2.7.6

Modified Paths:
--------------
    trunk/Build/source/utils/pmx/ChangeLog
    trunk/Build/source/utils/pmx/configure
    trunk/Build/source/utils/pmx/pmx-PATCHES/ChangeLog
    trunk/Build/source/utils/pmx/pmx-PATCHES/TL-Changes
    trunk/Build/source/utils/pmx/pmx-src/Makefile.am
    trunk/Build/source/utils/pmx/pmx-src/pmxab.c
    trunk/Build/source/utils/pmx/pmx-src/tests/barsant.mid
    trunk/Build/source/utils/pmx/pmx-src/tests/barsant.pml
    trunk/Build/source/utils/pmx/pmx-src/version.ac
    trunk/Build/source/utils/pmx/version.ac

Added Paths:
-----------
    trunk/Build/source/utils/pmx/pmx-src/PATCH-pmx276.for
    trunk/Build/source/utils/pmx/pmx-src/pmx276.for
    trunk/Build/source/utils/pmx/pmx-src/pmx276.for.orig

Removed Paths:
-------------
    trunk/Build/source/utils/pmx/pmx-src/PATCH-pmx274.for
    trunk/Build/source/utils/pmx/pmx-src/pmx274.for
    trunk/Build/source/utils/pmx/pmx-src/pmx274.for.orig

Modified: trunk/Build/source/utils/pmx/ChangeLog
===================================================================
--- trunk/Build/source/utils/pmx/ChangeLog	2016-12-09 01:02:43 UTC (rev 42655)
+++ trunk/Build/source/utils/pmx/ChangeLog	2016-12-09 07:17:59 UTC (rev 42656)
@@ -1,3 +1,7 @@
+2016-12-09  Akira Kakuto  <kakuto at fuk.kindai.ac.jp>
+
+	* Import pmx 2.7.6.
+
 2016-02-10  Akira Kakuto  <kakuto at fuk.kindai.ac.jp>
 
 	* Import pmx 2.7.3.

Modified: trunk/Build/source/utils/pmx/configure
===================================================================
--- trunk/Build/source/utils/pmx/configure	2016-12-09 01:02:43 UTC (rev 42655)
+++ trunk/Build/source/utils/pmx/configure	2016-12-09 07:17:59 UTC (rev 42656)
@@ -1,6 +1,6 @@
 #! /bin/sh
 # Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.69 for pmx (TeX Live) 2.7.3.
+# Generated by GNU Autoconf 2.69 for pmx (TeX Live) 2.7.6.
 #
 # Report bugs to <tex-k at tug.org>.
 #
@@ -580,8 +580,8 @@
 # Identity of this package.
 PACKAGE_NAME='pmx (TeX Live)'
 PACKAGE_TARNAME='pmx--tex-live-'
-PACKAGE_VERSION='2.7.3'
-PACKAGE_STRING='pmx (TeX Live) 2.7.3'
+PACKAGE_VERSION='2.7.6'
+PACKAGE_STRING='pmx (TeX Live) 2.7.6'
 PACKAGE_BUGREPORT='tex-k at tug.org'
 PACKAGE_URL=''
 
@@ -1278,7 +1278,7 @@
   # Omit some internal or obsolete options to make the list less imposing.
   # This message is too long to be a string in the A/UX 3.1 sh.
   cat <<_ACEOF
-\`configure' configures pmx (TeX Live) 2.7.3 to adapt to many kinds of systems.
+\`configure' configures pmx (TeX Live) 2.7.6 to adapt to many kinds of systems.
 
 Usage: $0 [OPTION]... [VAR=VALUE]...
 
@@ -1344,7 +1344,7 @@
 
 if test -n "$ac_init_help"; then
   case $ac_init_help in
-     short | recursive ) echo "Configuration of pmx (TeX Live) 2.7.3:";;
+     short | recursive ) echo "Configuration of pmx (TeX Live) 2.7.6:";;
    esac
   cat <<\_ACEOF
 
@@ -1441,7 +1441,7 @@
 test -n "$ac_init_help" && exit $ac_status
 if $ac_init_version; then
   cat <<\_ACEOF
-pmx (TeX Live) configure 2.7.3
+pmx (TeX Live) configure 2.7.6
 generated by GNU Autoconf 2.69
 
 Copyright (C) 2012 Free Software Foundation, Inc.
@@ -1835,7 +1835,7 @@
 This file contains any messages produced by compilers while
 running configure, to aid debugging if configure makes a mistake.
 
-It was created by pmx (TeX Live) $as_me 2.7.3, which was
+It was created by pmx (TeX Live) $as_me 2.7.6, which was
 generated by GNU Autoconf 2.69.  Invocation command line was
 
   $ $0 $@
@@ -3758,7 +3758,7 @@
 
 # Define the identity of the package.
  PACKAGE='pmx--tex-live-'
- VERSION='2.7.3'
+ VERSION='2.7.6'
 
 
 cat >>confdefs.h <<_ACEOF
@@ -5963,7 +5963,7 @@
 # report actual input values of CONFIG_FILES etc. instead of their
 # values after options handling.
 ac_log="
-This file was extended by pmx (TeX Live) $as_me 2.7.3, which was
+This file was extended by pmx (TeX Live) $as_me 2.7.6, which was
 generated by GNU Autoconf 2.69.  Invocation command line was
 
   CONFIG_FILES    = $CONFIG_FILES
@@ -6020,7 +6020,7 @@
 cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
 ac_cs_version="\\
-pmx (TeX Live) config.status 2.7.3
+pmx (TeX Live) config.status 2.7.6
 configured by $0, generated by GNU Autoconf 2.69,
   with options \\"\$ac_cs_config\\"
 

Modified: trunk/Build/source/utils/pmx/pmx-PATCHES/ChangeLog
===================================================================
--- trunk/Build/source/utils/pmx/pmx-PATCHES/ChangeLog	2016-12-09 01:02:43 UTC (rev 42655)
+++ trunk/Build/source/utils/pmx/pmx-PATCHES/ChangeLog	2016-12-09 07:17:59 UTC (rev 42656)
@@ -1,3 +1,7 @@
+2016-12-09  Akira Kakuto  <kakuto at fuk.kindai.ac.jp>
+
+	* import pmx-2.7.6.
+
 2016-02-10  Akira Kakuto  <kakuto at fuk.kindai.ac.jp>
 
 	* import pmx-2.7.3.

Modified: trunk/Build/source/utils/pmx/pmx-PATCHES/TL-Changes
===================================================================
--- trunk/Build/source/utils/pmx/pmx-PATCHES/TL-Changes	2016-12-09 01:02:43 UTC (rev 42655)
+++ trunk/Build/source/utils/pmx/pmx-PATCHES/TL-Changes	2016-12-09 07:17:59 UTC (rev 42656)
@@ -1,4 +1,4 @@
-Changes applied to the pmx-2.7.4 tree as obtained from:
+Changes applied to the pmx-2.7.6 tree as obtained from:
 	http://www.ctan.org/tex-archive/support/pmx/
 
 Remove:

Modified: trunk/Build/source/utils/pmx/pmx-src/Makefile.am
===================================================================
--- trunk/Build/source/utils/pmx/pmx-src/Makefile.am	2016-12-09 01:02:43 UTC (rev 42655)
+++ trunk/Build/source/utils/pmx/pmx-src/Makefile.am	2016-12-09 07:17:59 UTC (rev 42656)
@@ -233,11 +233,11 @@
 	libf2c/patch-07-MuslLibc \
         libf2c/patch-08-WIN64 \
         libf2c/patch-09-tmpfile \
-	PATCH-pmx274.for
+	PATCH-pmx276.for
 ## pmx.test
 EXTRA_DIST += tests/barsant.mid tests/barsant.pml tests/barsant.pmx \
 	tests/barsant.tex tests/barsant1.pmx tests/barsant2.pmx
-EXTRA_DIST += scor2prt.for pmx274.for.orig pmx274.for 
+EXTRA_DIST += scor2prt.for pmx276.for.orig pmx276.for 
 EXTRA_DIST += $(PATCHES)
 EXTRA_DIST += version.ac configure.ac Makefile.am Makefile.f2c
 DISTCLEANFILES = barsant* pmxaerr.dat

Deleted: trunk/Build/source/utils/pmx/pmx-src/PATCH-pmx274.for
===================================================================
--- trunk/Build/source/utils/pmx/pmx-src/PATCH-pmx274.for	2016-12-09 01:02:43 UTC (rev 42655)
+++ trunk/Build/source/utils/pmx/pmx-src/PATCH-pmx274.for	2016-12-09 07:17:59 UTC (rev 42656)
@@ -1,166 +0,0 @@
-*** pmx274.for.orig	2016-02-20 22:48:43.793458913 -0500
---- pmx274.for	2016-02-20 23:08:55.803226069 -0500
-***************
-*** 11062,11068 ****
-        end if
-        go to 1
-        end
-!       subroutine getmidi(noinst,lineq,iccount,ibarcnt,ibaroff,nbars,
-       *                   lenbar,
-  c      subroutine getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar,
-       *                    mtrdenl,first)
---- 11062,11068 ----
-        end if
-        go to 1
-        end
-!       subroutine getmidi(noinstarg,lineq,iccount,ibarcnt,ibaroff,nbars,
-       *                   lenbar,
-  c      subroutine getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar,
-       *                    mtrdenl,first)
-***************
-*** 11091,11097 ****
-       *       debugmidi
-        logical debugmidi
-        common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
-!      *                ,miditran(nm),midtc(0:nm),noinstdum,iinsiv(nm)
-        integer*2 iinsiv
-        character*1 durq
-        character*2 instq
---- 11091,11097 ----
-       *       debugmidi
-        logical debugmidi
-        common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
-!      *                ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
-        integer*2 iinsiv
-        character*1 durq
-        character*2 instq
-***************
-*** 11168,11174 ****
-  c  Instrument numbers or letters.  Expect noinst of them.
-  c
-  c        do 2 ivx = 1 , nv
-!         do 2 ivx = 1 , noinst
-            call getchar(lineq,iccount,durq)
-            if (ichar(durq) .gt. 96) then
-  c
---- 11168,11174 ----
-  c  Instrument numbers or letters.  Expect noinst of them.
-  c
-  c        do 2 ivx = 1 , nv
-!         do 2 ivx = 1 , noinstarg
-            call getchar(lineq,iccount,durq)
-            if (ichar(durq) .gt. 96) then
-  c
-***************
-*** 11213,11219 ****
-  c    Follow same pattern as for insttrument numbers above.
-  c 	
-  c        do 7 ivx = 1 , nv
-!         do 7 ivx = 1 , noinst
-            call getchar(lineq,iccount,durq)
-            if (index('123456789',durq) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
---- 11213,11219 ----
-  c    Follow same pattern as for insttrument numbers above.
-  c 	
-  c        do 7 ivx = 1 , nv
-!         do 7 ivx = 1 , noinstarg
-            call getchar(lineq,iccount,durq)
-            if (index('123456789',durq) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-***************
-*** 11236,11242 ****
-  c    Follow same pattern as for instrument numbers above.
-  c 	
-  c        do 8 ivx = 1 , nv
-!         do 8 ivx = 1 , noinst
-            call getchar(lineq,iccount,durq)
-            if (index('123456789',durq) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
---- 11236,11242 ----
-  c    Follow same pattern as for instrument numbers above.
-  c 	
-  c        do 8 ivx = 1 , nv
-!         do 8 ivx = 1 , noinstarg
-            call getchar(lineq,iccount,durq)
-            if (index('123456789',durq) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-***************
-*** 11259,11265 ****
-  c    Follow similar pattern as above, but separator is +|-.
-  c 	
-  c        do 9 ivx = 1 , nv
-!         do 9 ivx = 1 , noinst
-            call getchar(lineq,iccount,durq)
-            ipm = index('-+',durq)
-            if (ipm .eq. 0) then
---- 11259,11265 ----
-  c    Follow similar pattern as above, but separator is +|-.
-  c 	
-  c        do 9 ivx = 1 , nv
-!         do 9 ivx = 1 , noinstarg
-            call getchar(lineq,iccount,durq)
-            ipm = index('-+',durq)
-            if (ipm .eq. 0) then
-***************
-*** 11592,11597 ****
---- 11592,11598 ----
-        common /commidisig/ midisig
-        common /comlyr/ inputmlyr
-        logical inputmlyr
-+       data inputmlyr /.false./
-        cdot = .false.
-  1     call getchar(lineq,iccount,charq)
-        if (lastchar) return
-***************
-*** 14491,14497 ****
-  c
-  c 160130 Replace '\' by '/'
-  c
-! 12    ipos = index(pathnameq,'\')
-        if (ipos .gt. 0) then
-          pathnameq(ipos:ipos)='/'
-          print*,'Changed pathname to ',pathnameq(1:lpath)
---- 14492,14498 ----
-  c
-  c 160130 Replace '\' by '/'
-  c
-! 12    ipos = index(pathnameq,'\\')
-        if (ipos .gt. 0) then
-          pathnameq(ipos:ipos)='/'
-          print*,'Changed pathname to ',pathnameq(1:lpath)
-***************
-*** 19855,19861 ****
-        common /comclefrests/ centrests
-        logical newclef, centrests
-        common /comlyr/ inputmlyr
-!       logical inputmlyr /.false./
-        if (.not.optimize) then
-          print*
-          print*,'Starting second PMX pass'
---- 19856,19862 ----
-        common /comclefrests/ centrests
-        logical newclef, centrests
-        common /comlyr/ inputmlyr
-!       logical inputmlyr 
-        if (.not.optimize) then
-          print*
-          print*,'Starting second PMX pass'
-***************
-*** 24497,24503 ****
-  c   (unless preceded with '\'), check length
-  c
-        character*128 lineq,lineqt
-!       character*1 sq /'\'/
-        iend = lenstr(lineq,128)
-  c
-  c      i2nd = iccount+index(lineq(iccount+1:128),'"')
---- 24498,24505 ----
-  c   (unless preceded with '\'), check length
-  c
-        character*128 lineq,lineqt
-!       character*1 sq 
-!       data sq /'\\'/
-        iend = lenstr(lineq,128)
-  c
-  c      i2nd = iccount+index(lineq(iccount+1:128),'"')

Added: trunk/Build/source/utils/pmx/pmx-src/PATCH-pmx276.for
===================================================================
--- trunk/Build/source/utils/pmx/pmx-src/PATCH-pmx276.for	                        (rev 0)
+++ trunk/Build/source/utils/pmx/pmx-src/PATCH-pmx276.for	2016-12-09 07:17:59 UTC (rev 42656)
@@ -0,0 +1,132 @@
+*** pmx276.for.orig	2016-12-07 08:56:24.231733002 -0500
+--- pmx276.for	2016-12-07 14:55:34.769485275 -0500
+***************
+*** 11104,11110 ****
+        end if
+        go to 1
+        end
+!       subroutine getmidi(noinst,lineq,iccount,ibarcnt,ibaroff,nbars,
+       *                   lenbar,
+  c      subroutine getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar,
+       *                    mtrdenl,first)
+--- 11104,11110 ----
+        end if
+        go to 1
+        end
+!       subroutine getmidi(noinstarg,lineq,iccount,ibarcnt,ibaroff,nbars,
+       *                   lenbar,
+  c      subroutine getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar,
+       *                    mtrdenl,first)
+***************
+*** 11210,11216 ****
+  c  Instrument numbers or letters.  Expect noinst of them.
+  c
+  c        do 2 ivx = 1 , nv
+!         do 2 ivx = 1 , noinst
+            call getchar(lineq,iccount,durq)
+            if (ichar(durq) .gt. 96) then
+  c
+--- 11210,11216 ----
+  c  Instrument numbers or letters.  Expect noinst of them.
+  c
+  c        do 2 ivx = 1 , nv
+!         do 2 ivx = 1 , noinstarg
+            call getchar(lineq,iccount,durq)
+            if (ichar(durq) .gt. 96) then
+  c
+***************
+*** 11255,11261 ****
+  c    Follow same pattern as for insttrument numbers above.
+  c 	
+  c        do 7 ivx = 1 , nv
+!         do 7 ivx = 1 , noinst
+            call getchar(lineq,iccount,durq)
+            if (index('123456789',durq) .eq. 0) then
+              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+--- 11255,11261 ----
+  c    Follow same pattern as for insttrument numbers above.
+  c 	
+  c        do 7 ivx = 1 , nv
+!         do 7 ivx = 1 , noinstarg
+            call getchar(lineq,iccount,durq)
+            if (index('123456789',durq) .eq. 0) then
+              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+***************
+*** 11278,11284 ****
+  c    Follow same pattern as for instrument numbers above.
+  c 	
+  c        do 8 ivx = 1 , nv
+!         do 8 ivx = 1 , noinst
+            call getchar(lineq,iccount,durq)
+            if (index('123456789',durq) .eq. 0) then
+              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+--- 11278,11284 ----
+  c    Follow same pattern as for instrument numbers above.
+  c 	
+  c        do 8 ivx = 1 , nv
+!         do 8 ivx = 1 , noinstarg
+            call getchar(lineq,iccount,durq)
+            if (index('123456789',durq) .eq. 0) then
+              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+***************
+*** 11301,11307 ****
+  c    Follow similar pattern as above, but separator is +|-.
+  c 	
+  c        do 9 ivx = 1 , nv
+!         do 9 ivx = 1 , noinst
+            call getchar(lineq,iccount,durq)
+            ipm = index('-+',durq)
+            if (ipm .eq. 0) then
+--- 11301,11307 ----
+  c    Follow similar pattern as above, but separator is +|-.
+  c 	
+  c        do 9 ivx = 1 , nv
+!         do 9 ivx = 1 , noinstarg
+            call getchar(lineq,iccount,durq)
+            ipm = index('-+',durq)
+            if (ipm .eq. 0) then
+***************
+*** 11634,11639 ****
+--- 11634,11640 ----
+        common /commidisig/ midisig
+        common /comlyr/ inputmlyr
+        logical inputmlyr
++       data inputmlyr /.false./
+        cdot = .false.
+  1     call getchar(lineq,iccount,charq)
+        if (lastchar) return
+***************
+*** 19899,19905 ****
+        common /comclefrests/ centrests
+        logical newclef, centrests
+        common /comlyr/ inputmlyr
+!       logical inputmlyr /.false./
+        if (.not.optimize) then
+          print*
+          print*,'Starting second PMX pass'
+--- 19900,19906 ----
+        common /comclefrests/ centrests
+        logical newclef, centrests
+        common /comlyr/ inputmlyr
+!       logical inputmlyr 
+        if (.not.optimize) then
+          print*
+          print*,'Starting second PMX pass'
+***************
+*** 24541,24547 ****
+  c   (unless preceded with '\'), check length
+  c
+        character*128 lineq,lineqt
+!       character*1 sq /'\'/
+        iend = lenstr(lineq,128)
+  c
+  c      i2nd = iccount+index(lineq(iccount+1:128),'"')
+--- 24542,24549 ----
+  c   (unless preceded with '\'), check length
+  c
+        character*128 lineq,lineqt
+!       character*1 sq 
+!       data sq /'\'/
+        iend = lenstr(lineq,128)
+  c
+  c      i2nd = iccount+index(lineq(iccount+1:128),'"')

Deleted: trunk/Build/source/utils/pmx/pmx-src/pmx274.for
===================================================================
--- trunk/Build/source/utils/pmx/pmx-src/pmx274.for	2016-12-09 01:02:43 UTC (rev 42655)
+++ trunk/Build/source/utils/pmx/pmx-src/pmx274.for	2016-12-09 07:17:59 UTC (rev 42656)
@@ -1,24550 +0,0 @@
-      program pmxab
-c
-c This program, PMX, developed by Don Simons
-c (dsimons at roadrunner.com), is a preprocessor for MusiXTeX. In concert with
-c MusiXTeX and TeX, its purpose is to allow the user to create high-quality
-c typeset musical scores by including a sequence of PMX commands in an ASCII
-c input file.
-c
-c This program is free software: you can redistribute it and/or modify
-c it under the terms of the GNU General Public License as published by
-c the Free Software Foundation, either version 3 of the License, or
-c (at your option) any later version.
-c 
-c This program is distributed in the hope that it will be useful,
-c but WITHOUT ANY WARRANTY; without even the implied warranty of
-c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-c GNU General Public License for more details.
-c 
-c You should have received a copy of the GNU General Public License
-c along with this program.  If not, see <http://www.gnu.org/licenses/>.
-c
-c
-      character*9 date
-	character*5 version,versionc
-	common /comver/ versionc
-c
-c To compile with gfortran:
-c   1. Merge all files using copy *.for epmx[nnnn].for
-c   2. Search and replace all character*65536 with character*131072
-c   3. Comment/uncomment getarg lines
-c   4. gfortran -O pmx[nnnn].for -o pmxab.exe
-c
-c To do
-c   Correct Rainer's email address in manual
-c   Linesplit (\\) in h
-c   Tt at start of a movement.
-c   Toggle midi on or off; allow midi only.
-c   Page number printed on 1st page even if 1 system.
-c   Still need inserted space for chordal accidentals
-c   Voicewise transposition.
-c   better segno
-c   coda
-c   duevolte
-c   Fix xtup bracket direction in 2-line staves?? (maybe leave as is)
-c   Sticky ornaments with shifts.
-c   Deal with Werner's vertical spacing thing associated with title.
-c   Multiple ties in midi
-c   Werner's missing c in MIDI due to start/stop ties on same note.
-c   Beams with single 64ths
-c   128ths and/or dotted 64ths
-c   Close out MIDI with integral # of beats?
-c   Increase ast dimensions or redo logic.
-c   Does slur direction get set for user-defined single-note stem dir'ns?
-c   Transpose by sections.
-c   Optimization loop over sections only
-c   Command-line option to read nbarss in. Write out nbarss when optimizing.
-c     (or just read from .plg?)
-c   Beams over bar lines.
-c   2-digit figures
-c   A real coule (slanted line between notes in a chord)
-c   Dotted slurs for grace notes.
-c   Undotted chord notes with dotted main note.
-c   Forced line break without line number
-c   Fix dot moving when 2nds in chord get flipped
-c   To do: increase length on notexq in dodyn
-c 2.74
-c   For staff-crossing beamed xtuplet chords, if 2nd segment of a joined beam
-c     starts with a blank rest, put '\sk' into the TeX. 
-c     To enable high-to-both beamed etup staff-crossing chord, for blank
-c     rest at start of forced beam, shift \sk's from before to after \ib..;
-c     so \ib is at start and note in upper voice has a beam to connect to.
-c   Expand range of vertical xtup number shift, now stored in mult(16-22) 
-c   Check for and allow \" within lyrics strings, for umlauts.
-c 2.73 (160121)
-c   Dirk's "..." command, to convert "text" into \pmxlyr{text}\ and insert as
-c     inline TeX. Replace all '~' inside "..." and not preceded with '\', by 
-c     '\lk '. Right after 2nd ", replace @[a,b][+,-]n with \at{[a,b][+,-]n}\
-c     Include definitions of \ly and \at in pmx.tex (2 Feb 16). After first ",
-c     add (as type 2 string) '\\input musixlyr \'
-c   After inputting pathname, change any '\' to '/', for Linux compatibility.
-c 2.72 (160110)
-c   Really finalize \mbrest...go back to 3 args to deal with clef changes.
-c   Fine tune centered whole bar rests to deal with clef changes
-c   Fix bug in wsclef when >1 staff per instrument, since \setclef
-c     needs to know instrument and specify clefs on all staves for that
-c     instrument. Ones that were not changed by user will not be printed,
-c     and will be kept the same as before.
-c   Fix bug with arpegii from one voice to another in same staff.
-c 2.71 (151226)
-c   Finalize mbrest mods
-c 2.705
-c   Fix error message
-c 2.704 (140614) 
-c   Octave treble clef
-c   Make horizontal ornament shift (ornhshft) floating
-c 2.703 (140323)
-c   Option v[-]n at end of any figure will alter figdrop for rest of system
-c 2.702
-c   Stem slurs. Only for ps, assume no other pos'n adjustments. Option "v"
-c 2.701
-c   oC = coda (\code{10})
-c     Move iornq(29) (blank barline) to ipl(0) (changes in pmxb, getnote)
-c   oG = new seqno
-c   To do: fix grace note spacing problem (partially done)
-c 2.622
-c   Redefine midtc(..) and miditran(..); clean up all transpositions/key changes
-c   Kn[+/-...] \ignorenats at signature changes
-c   Fix tie checks in doslur() and dopsslur() to subtract iTransAmt from nolevs
-c     before checking and setting pitch levels levson() and levsoff()
-c   Define midisig separately from isig. Put in common commidisig.
-c     Use for explicit midi signature and for accid corrections to midi piches
-c     in addmidi.
-c 2.621
-c   Make keyboard rest option work in xtuplets. Created subroutine
-c     chkkbdrests, modified make2bar to include calls to chkkbdrests as rqd.
-c 2.620
-c   Allow user-defined rest height tweaks at start of beam.
-c 2.619
-c   At movement break, change \nbinstruments in \newmovement macro; add
-c     3rd arg to \newmovement in pmx.tex; modify pmxb.for and getnote.for
-c     to remove call to newnoi and change call to \newmovement
-c 2.618
-c   Add option Ac[l,4] to set vert and horiz size and offsets to properly
-c     center page for letter or a4 paper.
-c 2.617
-c   In g1etnote, change if-check for note to use index(...) instead
-c     of ichar(charq) since it was messing up gfortran optimizer
-c   After pmxa, search for and remove penultimate line <blank><blank>/
-c     because it was screwing up linux-compiled versions
-c   Bugfix: Increase dimension of kicrd from 7 to 10 in crdaccs(...)
-c 2.616 (111110)
-c   Allow hairpins to span multiple notes groups (gulps).
-c 2.615+ (110810)
-c   Fix midi when some instruments are transposed, by subtracting
-c     iTransAmt(instno(iv)) from pitch values sent to via addmidi in
-c     make2bar.for (for main notes) and docrd (for chord notes)
-c 2.615 (110725)
-c   Fig bug with size-setting (in topfile) when instrument has >1 staves 
-c 2.615 (110724)
-c   Make AS[0|-|s|t]... really set sizes
-c 2.614
-c   Mod notex.for to fix Terry's bug with raised dotted rests (caused 
-c     by double-hboxing). 
-c 2.613
-c   Bugfix: In pmxa, change "do while" limit to keep from overwriting instno.
-c 2.612
-c   Enhance AS to allow s or t for smallsize or tinysize
-c 2.611
-c   Error trap for "D" before any notes in a block.
-c 2.610
-c   Instrument-wise key changes and transposition (incomplete)
-c 2.603
-c   101211 In getpmxmod.for, decreased nline by 2 to fix locating errors 
-c     following reading in an include file.
-c   101121 Added some error messages in g1etset.for setup data 
-c 2.602
-c   Correct slur indexing in linebreakslurs. 
-c   Account for comment lines in line count for error messages
-c 2.601
-c   Bug fix: allow 24 slurs with graces
-c 2.60 Changes made make it really big
-c   increase mv (size of midi) ? Note: MIDI can't have >16 voices w/o 
-c     major reprogramming, and 16 may also be a problem (icmm)
-c   nm=24 (voices) done
-c   24 slurs done
-c   24 simultaneous beams (Replace index 24 by 0, so get 0-23)
-c   bufq*131072 (gfortran only)
-c   getarg syntax (gfortran only)
-c 2.523+
-c   Fix voice numbering for normal dynamics and text dynamics
-c 2.523
-c   Version of bigpmx first posted to Hiroaki's web site.
-c 2.522
-c   5/26/10 Replace ipl bits 0-7 with ipl2, add new common for it.
-c   With 2.521+ as starting version, incorporate bigpmx mods to allow 24 voices.
-c   5/13/10 Fix log2 function
-c   5/15/10 Fix bitwise storage for dynamics, fix segnoo string length. 
-c 2.521+
-c   091025 Enable dotting 2nd part of linebreak slur or tie.
-c   To adjust barno height due to linebreak slur, use \bnrs instead of
-c     explicitly redefining \raisebarno (pmxb) 
-c 2.521
-c   Bugfix
-c 2.520
-c   090519 Enable ligfonts (special figured bass characters)
-c 2.519
-c   Fix another bug which kept \sk from being output so misaligned some notes.
-c 2.518
-c   Fix bugs: referencing fig data, char declaration for member of 
-c      common/comfig/
-c 2.517
-c   Allow figures in voice 1 + any one other.
-c 2.516
-c   Allow figures in voice #2
-c 2.515+ to do: Change manual and activate rule against clef change in voice #2.
-c 2.515
-c   071222 Changes in getnote to allow auto forced beams to start anywhere.
-c   071206 In make2bar, shift fermataup7 to left over centered pause.
-c   070901 In doslur, check for nolev <=2 in case slur ends on rest in 2-line
-c       staff (it was screwing up vertical justification).
-c   n34 for tweaks to midi durations of quarter note septuplets.
-c   To do: In ref250.tex, the tables where 's,t,)' is explained, the line
-c       [+,- i]   ... Vertical adjustment of the start of second segment
-c     should it be replaced by
-c       [s +,- i]   ... Vertical adjustment of the start of second segment
-c 2.514
-c   Changes in make2bar to get horizontal spacing right when normal grace
-c     follows after grace
-c   Changes in dograce to get octaves right for any material entered inside
-c     \gaft, which shields transpose register changes from the outside world.
-c 2.513
-c   In make1bar, near end, for forced beams starting with a rest, copy hgt and
-c     slope tweaks to ALL notes after first, not just the second one, so if
-c     there's more than one rest at start the tweaks are still observed.
-c   In beamid and beamend, add stand-alone triply-flagged notes for xtups.
-c 2.512
-c   Near end of pmxb, fix error trap to allow redundant 'RD'
-c   Enable multiplicity down-up '][' within xtup.
-c 2.511
-c   Introduce eskz2 for xtup #'s and bracket lengths, to remove bug caused by 
-c     adjusteskz as in bar 7 of barsant.
-c 2.510a
-c   Test: remove restriction on tempo changes in MIDI macros
-c     Send to CM for beta testing.
-c 2.509+
-c   To do: Correct manual on AS. "-" is for smaller staves.
-c 2.510
-c   Forgot to declare litq, voltxtq as character in subroutine getgrace
-c 2.509
-c   Corrected small bug in arpeggio shifting (ivx <= iv in call putarp)
-c 2.508
-c   Allow graces in xtups. New subroutine getgrace. 
-c 2.507
-c   To do: Raise/lower figures.
-c   To do: Add 24, 29 to list of musicsizes in manual
-c   New sub adjusteskz to account for ask's when computing lengths of
-c     brackets for unbeamed xtups, slopes and horizontal posn's of number 
-c   Bug fix: in beamn1, beamid, and beamend, allow unbeamed xtups w/ 2 flags
-c   Add look-left option for keyboard rests, "L" in rest command, set iornq(30)
-c 2.506
-c   Fix bug with AK, when simultaneous rests have same duration, use defaults.
-c 2.505
-c   Keyboard rests AK
-c 2.504
-c   Space after normal grace: option X[n]
-c   Fixed og when nv .ne. noinst, by using sepsymq instead of '&'
-c   (To do) length of xtup bracket when there is added non-collision space.
-c   Trap musicsize if .ne. 16,20,24,29.
-c 2.503
-c   Enable arpeggio left shift with ?-x
-c   To do: In manual, arpeggio over 2 staves.
-c   Allow musicsize of 24 and 29. Had to define meter font size explicitly,
-c     also change font size for text dynamics, but not much else so far.
-c   Bugfix in beamstrt, introduced in 2415, ip was changed before putxtn
-c     was called, causing error in printing replacement number.
-c 2.502
-c   Incorporate Dirk Laurie's patch to use { , } , for ties.
-c   Figure height adjustment: append +[n]
-c   Change ec font stuff in pmx.tex per Olivier Vogel's comment (CM email?)
-c 2.501
-c   Readjust horizontal offset back to .8 in LineBreakTies
-c   Fix zero-subscript (iudorn) in putorn
-c 2.50
-c   Increase number of text-dynamics (dimension of txtdynq) per block 
-c     from 12 to 41.
-c   Slur option n to override altered default curvature.
-c   Allow default ps slur curvature tweaks with Ap+/-c
-c 2.416
-c   Increase length of textdynq from 24 to 128
-c   (Todo) Add comment in manual about blank lines at end.
-c   Configuration file: Define subroutine getpmxmod, check path in environment
-c     variable pmxmoddir, check existence, read lines into bufq after setup. 
-c   Increase dimension on idynn in dodyn from 4 to 10 for max number 
-c     of marks in a bar
-c   Increase allowable # of lines from 2000 to 4000.
-c   (To do) Replace definition of \liftpausc per Olivier.
-c   (To do) Fix extraneous error message if RD is placed at very end.
-c 2.415
-c   Fix "AT" option: replace putxtn,topfile,beamstrt,beamid to use \xnumt
-c     instead of redefining \xnum. Change font used to \smallfont (as for
-c     normal xtups,
-c   Allow slur to start on rest.
-c 2.414
-c   Correct bug in crdacc when adding accidental to boundary causes number of
-c     segments to decrease
-c   Special rule for 3-accidental chords: If no 2nds, place them in order
-c     top, bottom, middle.
-c 2.413
-c   Correct bugs in chordal accidentals, related to left-shifted noteheads
-c     (a) Special problems with downstem when main note needs shifting
-c     (b) Assign 0 rank to boundary segs due to left-shifted noteheads
-c 2.412
-c   Change default horiz shift of start of seg 2 of linebreak slurs:
-c     -.7 for slurs, -1.2 for ties,
-c   Use height of start of seg 1 slur itself for end of 1 and start of 2.
-c 2.411
-c   "Apl" activates special treatment of linebreak slur/tie's; breaks all in 2.
-c   "s" option in start of slur/tie as precursor to vert/horiz tweaks for end
-c      of seg 1. of linebreak slur/tie, 2nd "s" for start of seg2.
-c   With "Apl", curvature adjustments on starting slur command apply to seg 1, 
-c      those on ending command to seg 2.
-c 2.410
-c   "AT" to allow Col. S.'s tuplet option. Simply input tuplet.tex and redefine
-c      \xnum, \unbkt, \ovbkt. 
-c   "s" option in main xtup input after "x": slope tweak for bracket. mult(4) is
-c      flag, mult(5-9) is tweak value+16
-c 2.409
-c   Bugfix in docrd for MIDI: Use original pitch in case main/chord were
-c     switched due to 2nds.
-c   Remove "o" from error message for "A" command.
-c   New syntax: optional instrument number separator ":" in movement 
-c     break command to precede a 2-digit instrument. 
-c   Conditional output formats for \setname at movement break to allow 
-c     instrument numbers >9.
-c   Bugfix in coding to raise barno due to slur over line break (pmxb)
-c   Move date/version data statement in pmxab to a better place.
-c 2.408
-c   Allow pnotes{x} when x>9.995 (mod is only to format stmt in make2bar).
-c   Bug fix in \liftPAusep in notex.for and in pmx.tex
-c   Character variables for version and date
-c   For up-stem single graces slurred to down-stem, shift slur start left by 
-c     0.8 so slur doesn't get too short.
-c   Initialize and slide mult, same as other full-program variables in /all/.
-c 2.407
-c   Allow AN[n]"[partname]" to be parsed by scor2prt as filename for part n,
-c 2.406
-c   Alter PMX: put \dnstrut into \znotes in \starteq (for system spacing
-c     equalization).
-c   Put dimensions of double sharps and flats in crdacc (for chords).
-c   Bugfix: Use sepsymq in LineBreakTies(..) instead of '&'
-c   Use only first 4 bits of mult for multiplicity+8, so rest can be used
-c     for other stuff.
-c   Move stemlength stuff in nacc(27-30) to mult(27-30) to remove conflict.
-c 2.405: Not published but saved for safety.
-c   Option Aph to write \special{header=psslurs.pro} top of each page, so
-c     dviselec will work OK.
-c 2.404
-c   Allow slur to end on rest, but not start on a rest.  Efaults height 
-c     of ending is default height of start (before any automatic or user-
-c     defined djustments). User may adjust height as normal from default.
-c 2.403
-c   Bugfix: turn off repeated beaming patterns.at end of non-last voice.
-c 2.402
-c   Automatic repeated forced beams.  Start with "[:"  End with next explicit 
-c     forced beam or end of input block.
-c   Increase # of forced beams per line of music per input block from 20 to 40
-c 2.401
-c   Optional K-Postscript Linebreak Ties, Apl. New subroutine LineBreakTies.
-c     Makes 1st part normal shape, and starts 2nd part a little further left.
-c   Enable arpeggios in xtuplets.  Had to make time itar(narp) a real.
-c 2.40
-c   Set up WrotePsslurDefaults (logical) so only write defaults on 1st Ap.
-c   Fix non-ps-slur input to \midslur (third signed integer). Do not reverse
-c     sign for down-slurs.
-c 2.359
-c   Add error exit subroutine stop1 to make exit status g77-compatible..
-c   Absolute octave on xtup chord note was 2 octave too high, fixed in getnote
-c   Fermata on vertically shifted rest: special trap in putorn() to set height.
-c   Correct multiple grace note spacing for small staves (in dograce, 
-c        define wheadpt1 depending on staff size)
-c 2.358
-c   Allow curvature corrections at start of postscript slur, in dopsslur()
-c   Local slur options p[+|-][s|t] for [nos|s]luradjust,[not|t]ieadjust
-c   Options for [Nos|S]luradjust,[Not|T]ieadjust,[noh|h]alfties: Ap[+|-][s|t|h]
-c   Make t[ID] act like s[ID]t, most mods in spsslur().
-c   Add spsslur() to read in data for ps slurs, call from getnote.
-c   In beamstrt, save args for SetupB in common comipb to save them for 
-c      2nd call when xtup starts with rest
-c   Add spacing for ornament ")" as if it were accidental, in make2bar().
-c   Horiz shift start and end of ps ties, dep. on stem dir'n, in dopsslur()
-c   Horiz. shift start of ps grace slur, 2 places in dograce().
-c   Horiz shift end of grace slur in endslur()
-c   Make st slurs into postscript ties.  Separate subroutine dopsslur(),    
-c   Non-beamed xtup: "a" in 1st note or rest, before "x" (sets drawbm=.false.)
-c   Allow two D"x" on same note. Introduced jtxtdyn1 in dodyn.
-c 2.357a
-c   Fix missing "end" in backfill.com, too-long lines in g1etnote, getnote
-c 2.357
-c   Increase dimension for # of lit TeX strings from 52 to 83.
-c   Allow blank rest in middle of xtuplet. Only mods in g*etnote().
-c 2.356
-c   Increased some dimensions from 30 to 40 to allow up to 40 pages.
-c   In unbeamed xtups, "n" did not suppress bracket.  Fixed in beamstrt().
-c   Fix parsing of "f,h,H,HH" in sslur.
-c   Fix bug with cdot, note-level for slur termination (in getnote)
-c 2.355
-c   Midi transposition:  IT[+|-][n1][+|-][n2]...[+|-][n(noinst)], 
-c      n=# of half-steps.  Restrict to mult. of 12 now, to avoid key-sig issues
-c   Make midi recognize ps ties in doslur.
-c   Correct ttieforsl so that it eats 2nd argument properly, using \zcharnote 
-c      to get octave right.
-c 2.354
-c   With postscript slurs, make t-slurs real ties by inserting replacement 
-c     macros \tieforisu, etc, defined in pmx.tex
-c   Check for open cresc or decresc at end of input block, using list[de]cresc
-c   Hairpin syntax conditional on postscript slurs. Backup to fill in start 
-c     level, using new backfill(...).  Separate height tweaks for 
-c     start and finish.
-c 2.353
-c   K-0+n to transpose by half step (rather than just change key)
-c   Allow "rm[n]" when nv>1.  Require it in all parts. Just write a stack of 
-c     \mbrest's
-c   Enable "Rz"; define \setzalaligne in pmx.tex. Special treatment at end
-c     of input block before movement break, and at start of block after 
-c     movement break, using \newmovement rather than \setzalaligne, since
-c     former already redefines \stoppiece. In second case, set rptfg2='z'.
-c   Make clefq(nm) common between pmxb and getnote; change references in 
-c     getnote at 'M' to array elements, setting all new clefs as you go.
-c 2.352
-c   Remove \parskip redefinition from pmx.tex; write it into TeX file when
-c     "Ae" is invoked.
-c   Ap to activate postscript slurs. Add macro \psforts to pmx.tex to redefine 
-c     \tslur in case \midslur was used.  Allow slur inputs 'f','h','H','HH',
-c     translate them thru mapping to (1,4,5,6) as \midslur params, then let
-c     \psforts translate them back to ps slur macors.
-c 2.351
-c   Number slurs from 0 up instead of 11 down, anticipating postscript slurs.
-c   Write "\eightrm" instead of "\cmr8" for \figfont with small baseline size.
-c   Increase length of basenameq to 44 characters everywhere.
-c   Increase dimension of mcpitch (midi-chord-pitch) to 20.
-c   Set default systems per page to 1 if nv>7
-c   In pmxb, move place where isystpg is reset to 0, so that \eject gets
-c     written when there is just one system per page.
-c 2.35
-c   Cautionary accidentals with 'c' anywhere in note symbol.
-c   NEW pmx.tex with \resetsize to set size to normal or small depending on 
-c     current \internote.  Used with new coding in dograce() to get right
-c     new size in case user has \setsize'ed some lines to \smallvalue. For
-c     \smallvalue-sized staves, redefine \tinynotesize to give 11-pt font. 
-c     Affects pmx.tex.
-c   Continuation figure with fractional length. May now mix with other figures.
-c     If another figure follow Cont-fig, separate with colon.   
-c 2.342
-c   Bugfix in getnote to recognize relative octave shift in grace at start of  
-c     input block.
-c   In make2bar, initialize islhgt=0 earlier than before (possible solution
-c     to Suse g77 compile problem that I could not reproduce)..
-c   Bugfix in beamstrt & beamn1 for r2x6 c4D d d d
-c 2.341
-c   Syntax check: Forced page break page number must be > than previous.
-c   Bugfix: Define ivx when "sliding down" breath/caesure data in pmxb.
-c 2.34
-c   New pmx.tex with redefined liftpausc
-c   Bug fix with dotted, non-beamed xtups.
-c 2.332
-c   Fix bugs in horizonal shifts, spacing, for accid's, graces, noteheads.
-c   Allow arbitrary pos. input to W in g1etnote and getnote.
-c 2.331
-c   Bug-fix in dodyn(..): typo on length of arg of txtdyn
-c 2.33
-c   Caesura (oc), breath (ob).  Set iornq(28), store rest of data in ibcdata()
-c 2.321
-c   Rescale accidental shifts. Still use 7 bits but now map (0,127) 
-c      onto (-1.,5.35)
-c   Fix ihornb bug in dodyn, seen with dynamics on lower-voice non-beamed xtups
-c 2.32 (Noticed after posting)
-c   Prohibit "/" as figure.
-c 2.32 (Posted)
-c   Tidied up accidentals in chords, do spacing.
-c   Still to do: 
-c       check for "(" on chord notes in spacing algo
-c       small accids
-c       double accids
-c       autoshift slurs
-c 2.310
-c   Extra call to precrd ahead of spacing chk, and single-note crd/acc
-c      shifts seem OK, but not multiple.  crd/acc shifts not recorded 1st time. 
-c 2.309
-c   Alternate algo for accid shifts in chords.
-c 2.308
-c   Auto horiz. notehead shifting added to precrd. 
-c 2.307
-c   Auto shifting of multiple accidentals in chords.
-c   "Ao" in main chord note to keep accidentals in order. Set nacc(28).
-c   If there are any manual main or chord note shifts, then
-c      If any manual shift is preceded by "A" then
-c         1. Auto-shifting proceeds
-c         2. "A"-shifts add to autoshifts
-c         3. non-"A" shifts are ignored!
-c      Else (>0 man shifts, none has "A")
-c         No auto-ordering, No autoshifts, 
-c      End if
-c   End if 
-c 2.306
-c   Initialize legacy note level to middle C in case user forgets to set 
-c     octave.
-c   Shift xtup note?
-c   Shift in elemskips rather than noteheads?
-c 2.305
-c   Stop pmxb from multiple endvolta's at start of new page.
-c 2.304
-c   "Sx" in a note means shorten stemlength by x \internotes.  "Sx:" turn on
-c       for multiple notes in the voice, "S:" last shortened note.
-c 2.303
-c   vshrink stuff all OK? Description is in pmxb.  
-c 2.302
-c   Toggle vshrink with "Av". vshrink normally kicks in when \interstaff 
-c     hits 20. This still needs work.
-c   Add " /" to last line if last char is not % or /.
-c 2.301
-c   Check in beamn1 for single note before multiplicity down-up.
-c   allow '.PMX' as well as '.pmx'
-c 2.299
-c   Correct typo in pmxb involving PMXbarnotrue.
-c   Replacement printed number for xtup: Unsigned integer after 'n' after 'x'
-c   Minor upgrade parsing xtuplet options 'x...'
-c   Correct dimension of nxtinbm in make2bar.
-c 2.298
-c   Account for doubled xtup notes in subroutine getx (user-defined spaces), 
-c     by adding ndoub as an argument..
-c 2.297
-c   Created and solved compiler problem.  Put drawbm(NM) in its own common.
-c   Add new def'ns [\a|PA]usc, \lift[pa|PA]usc to pmx.tex, use them in make2bar
-c     when \centerbar is used.
-c   Modify \mbrest & \CenterBar in pmx.tex to use \volta at endcor etc.  Have PMX
-c     use right 2nd and 3rd args for \mbrest when key, meter, or clef changes.
-c 2.296
-c   Correct printed numbers for forced beams with multiple xtups. For each beam
-c     make list in setupb by voice of eloff (h-offset) and mtupv (printed #)
-c   Increase lengths of jobname and infileq by 20 characters
-c   Enable whole notes and breves as 1st or last note of xtup in beamn1 and
-c     beamend, and wholes in beamid.
-c 2.295
-c   Midi balance Ib[n1]:[n2]:...[nn]
-c   Single-slope beam groups [...]-[...]
-c   Trap "i" unless after accidental (main notes, xtups, chord notes)
-c 2.294
-c   Unequal xtups with "D" to double a note in an xtup.
-c   As above, "F" will (a) increase multiplicity by 1 for marked note and next
-c     one and (b) add a dot to the first one. 
-c   Fix bug with e.g. c84 [ .d e.f ] by checking whether forced beam is on 
-c     when "." is encountered, then correcting beam start time.(end of getnote)
-c   MIDI velocity (volume) set: Iv[n1]:[n2]:[n3]...
-c 2.293
-c   Check for single notes spanning bar lines.
-c   Correct various bugs with staff-jumping beams. (1) for 2nd segment, vxtup 
-c     must be set in make2bar since beamstrt is not called, fixing problem with
-c     dot at end. (2) add ivjb2 to flag which voice has 2nd segment and fix 
-c     problem when >2 staves.
-c   Add nodur to args of dodyn, so can check if stemless and avoid height tweak
-c   Correct bug in getdyn setting flag in idynda2(0) for manual horiz. tweak
-c 2.292a
-c   Undo syntax check for Type 2 or 3 TeX string starting in column 1. 
-c     Meanwhile, Werner's problem with a mid-line Type 3 string has gone away?! 
-c 2.292
-c   Allow comments in xtuplets
-c   Enable multiple octave jumps in grace notes.
-c   Allow dynamics in xtuplets.
-c   Fix bug in getdyn searching for end of text string (correct length of lineq
-c     to 128)
-c   Fix bug in dodyn, must ignore horiz. interaction tweak for 
-c     user-text (idno = 0)
-c   Syntax check for Type 2 or 3 TeX string starting in column 1 
-c     (NOTE: later undone!)
-c   Syntax check for page number > npages at forced line break.
-c 2.291
-c   Fix error in AS command (accid spacing for small systems), making only
-c     one spec per staff, nv total.
-c   Stop using MIDI channel 10
-c 2.29
-c   Fix error in console output format for # of bytes used in MIDI file.
-c   Fix bug in dograce so no space is added between grace and main note when
-c       there is a MIDI-only accidental.
-c   Fix bug so oes?+4 works.  It was too ugly to explain. 
-c     ...Different ways of storing accidental specs on input and output.
-c   No longer zap \writezbarno in special situations.
-c   Fix bug in dyntxt level on rest
-c   Line spacing equalization.  Add macros \starteq, \endeq, \spread, etc.
-c     Activate with Ae.  (Maybe later could input alternate values for
-c     \upamt, \dnamt, \parskip).  Put \starteq on 1st note in voice 1 
-c     in the page, and \endeq on 1st note of next-to-last line in page.
-c 2.28
-c   Flip direction of forced beam "[f..."
-c   Fix beam numbering for staff jumping beams. Uses irest(23,24,29,30) 
-c   Fix bug in sliding ip's for txtdyn's
-c   In dyn's allow vert. offsets +/-64, horiz +/-25.6 (store in idnyda2(1-99)
-c 2.27
-c   Comment out lines in dodyn checking number of dynamic marks found.  Voice
-c     order may not be monotonic if two lines on a staff.
-c   Literal dynamic: D"[text]"
-c 2.26
-c   Allow hairpin start-stop on same note by disabling auto-tweaks in dodyn,
-c     increasing dimension of idynn to 4 to allow 4 symbols on same note.
-c   Increase voltxtq length from 10 to 20.
-c   AS[-/0][-/0]...  to inform PMX that "-" voices are small, and rough 
-c      accounting for ast's is done by defining effective headwidth 
-c      whead1 in makebar2 to be 0.8*whead.  
-c 2.25
-c   Fix logic bug with sepsym's when # of instruments changes.
-c   Slight increases in default offsets for hairpin starts after "p"
-c 2.24
-c   Hairpins D< or D> as toggle.
-c   Many automatic position tweaks for letter-group dynamics and hairpins.
-c 2.23
-c   Continued rhythmic shortcuts: space followed by "." or ","
-c 2.22
-c   In call to doslur, change tno(...) to tnote(...).  This was only
-c     used when checking to slurs per stem directions, and should have been
-c     the note duration all along.
-c   MIDI-only accidental, bit 17 in nacc, or 27 in icrdat. 
-c       Use "i" anywhere in note symbol.
-c 2.21
-c   Increase from 20 to 30 dimensions for movement breaks and midi sections.
-c   Fix out-of-order declarations per mutex comments
-c   Add "Bad error" and "Kluging" messages to log file.
-c 2.197
-c   add /comips/ to save tie-check midi variables
-c   For spacing of clef changes at start of input block, changed integer time
-c     lastnodur to prevtn, so it works with xtups. Possible incompatibility!
-c 2.196
-c   Fix Ickbug with time check in ncmid()
-c   Interchange \fermataup7 and \pausec to get proper alignment
-c   Enable French violin clef "f",  number 7 in PMX, but 9 in MusiXTeX.
-c   Add defn's of \hsp, \hspp to pmx.tex 
-c   Fix pre-slurs on xtup chord notes.
-c   Fixed raised PAuse, define \liftPAuse
-c   Replace \zbreve\sk with \breve.
-c   Made "1" work as mtrdenl by doubling it and mtrnuml.  BUT WAIT...what 
-c     about "o" and 1 as shorthand for 16???? Search for "Kluge"
-c   Added "vo" (voice) as MIDI instrument 55 
-c   Allow 3-digit page numbers (search for "toppageno")
-c   Fix bug caused by prior fix (cancelling accid after bar line was ignored).
-c   Fix double accids in chords
-c 2.194
-c   Fix bug with accid/tie/barline/chord in addmidi by restructuring accid if 
-c     block.
-c   Add meter to MIDI file with every pause
-c   Purify FORTRAN?
-c 2.193
-c   Increased # of in-line TeX strings from 36 to 52.
-c   Fix entry of # of bytes in header of tempo/meter/key track to allow >255.
-c 2.191
-c   Event track: Tempos, meters, keys all together.  Data in comevent
-c 2.15
-c   Pretty good midi capability.  Still no attention to slurs on chord notes.
-c 2.11
-c   11 Dec 99 c   rm1
-c   11 Dec 99 "oes?", "oe?"
-c   11 Dec 99 Cancel slur horizontal tweaks with non-stemmed notes
-c   11 Dec 99 Error message for shifted, repeated ornaments.
-c 2.10 (Version 2.1)
-c   Fix bug with lowdot and xtuplets
-c 2.09
-c   Fix bug with multiple ornament heights over beams, when one is . or _
-c   Error message from pmxa if rest on last note of xtup.
-c   Enable 12 slurs.
-c   Reinstate multiple rests at start of xtup.
-c 2.07
-c   Combine consecutive type-1 TeX strings.
-c   \midslur and \curve as 3rd signed digit in slur termination, + 2 opt.int's.
-c   Fixed breve chord notes in docrd
-c   Check irest(28) as well as vxtup when setting nodur for chord notes, since
-c     vxtup isn't set until 1st *main* note in xtup
-c   Vectorize nolev1, slope, ixrest.  Klug fix for xtups with variable spacing.
-c 2.06+
-c   Make deterministic the beam slope calculation when there are an even # of
-c     slopes in list and middle two are equal magnitude but opposite sign.
-c   pmxa Trap for "o:" before 1st note in block
-c   Partial bug fix for 64th notes in xtuplets.
-c   Make ixrest a vector, since with new time scheme may not finish xtup in
-c     same notes block.
-c   Increase max # of pages from 20 to 30 (dimensions of nsystp,..., in pmxb)
-c 2.06
-c   Account for changes in nv when computing \interstaff. Add a counter 
-c     nistaff(iflb) = # of interstaff spaces per system = nv-1.  Set whenever
-c     setting isysflb(iflb). Note nv can only change at a forced line break.  
-c     Note also, iflb starts at 0!
-c 2.05
-c   Automatic start of new notes group with part 2 of staff-jump beam
-c     In make1bar, set irest bit 29 of lowest-voice note at same time,
-c     use as flag when making notes groups.
-c   For now, remove dummy blank line at end...it zaps terminal repeats.
-c 2.02
-c   Fixed slur-counting bug for multiple, slurred, aftergraces.
-c 2.01
-c  Increase to ask(1400)
-c  Increase max forced page breaks to 18
-c  Define pausc for centered pause
-c 2.0a
-c  Insert dummy blank line at very end to handle input files w/o terminal CR-LF
-c pmx03r
-c   Option m[n] in S symbol to change musicsize (for parts)
-c   Double dotted rests now work.
-c   Write file name to log file
-c   Check existence of input file
-c   Allow 24-char jobname, may end with ".pmx"
-c   Comment out time stuff
-c   Replace 3-argument getarg with 2-argument + iargc
-c   Fix bug with negative noinst due to nint<=int replacement
-c   move lovation of iv in isdat1 to allow iv>7.
-c   Set nm=12 
-c pmx03q
-c   replace int(x+.001) with nint(x)
-c   Write TeX file name to screen and to pml.
-c   Replace char(...) with chax(...) to sovle msdev bug.
-c   Bug fix: macro terminations when M is on a line by itself.
-c   Bug fix: don't accumulate space for XS in pmxa.
-c   Streamline Macros: use pointers to bufq instead of scratch files
-c pmx03p
-c   Store input file in single character array bufq. 
-c     lbuf(i)*2 is length of line i
-c     ipbuf is position just before next line to be read.
-c pmx03
-c   Optimize read/writes
-c pmx02
-c   Fix line count (for errors) when there are saved macros
-c pmx01
-c   In optimize mode, open/close macros (Watch out for residual zz files!)
-c   Command line input
-c   Option Ao to optimize, otherwise normal processing
-c
-ccccccc
-      parameter (nks=125,nm=24,mv=24576,maxblks=4000)
-      character*128 lnholdq
-      character*65536 bufq
-      integer*2 lbuf(maxblks)
-      common /comevent/ miditime,lasttime
-      logical slmon,dbltie
-      common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm),
-     *       naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl,
-     *       slmon(0:nm),dbltie
-      integer*2 mmidi
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
-     *                ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
-      integer*2 iinsiv
-      common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
-      common /commus/ musize,whead20
-      integer*4 nbars0(nks),nbars(nks),ipoe(nks),nbari(nks)
-      real*4 poe0(nks),poe(nks)
-      logical isfirst,optimize
-      logical*4 fexist
-      character*44 jobname
-      character*47 infileq
-      common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm),
-     *   nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount,
-     *   idum,itsofar(nm),nib(nm,15),nn(nm),
-     *   rest(nm,200),lenbr0,lenbr1,firstline,newmeter
-      logical rest,firstline,newmeter
-      common /comdiag/ n69(0:nm),n34(0:nm)
-      logical mmacrec,gottempo
-      common /commmac/ mmacstrt(0:nm,20),mmacend(0:nm,20),immac,
-     *       mmactime(20),nmidsec,msecstrt(0:nm,60),msecend(0:nm,60),
-     *       mmacrec,gottempo
-      common /truelinecount/ linewcom(20000)
-c
-c Added 130302 only to get nsperi from g1etnote, for use in midi setup
-c
-      common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
-     *     fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
-      logical lastchar,fbon,issegno,isheadr,isvolt
-c
-c  immac(i) is the index of i-th macro, i=1,nmac.  Also make a list containing
-c   nmidsec  section starts and stops based on PLAYING macros (not recording).
-c 
-ccccccccccccccccccccccccc
-c
-	data date /'20 Feb 16'/
-	data version /'2.74'/
-c
-ccccccccccccccccccccccccc
-      data maxit,ncalls /200,0/
-      data isfirst /.true./
-c      itstart = mytime()
-      versionc = version
-c
-c  Initialize midi parameters
-c
-      gottempo = .false.
-      ismidi = .false.
-      debugmidi = .false.
-      relacc = .false.
-      mmacrec = .false.
-      nmidsec = 1
-      mgap = 10
-      miditime = 0
-      lasttime = 0
-      nmidcrd = 0
-      nusebl = 0
-      notmain = .false.
-      do 3 ivx = 1 , nm
-        twoline(ivx) = .false.
-        midinst(ivx) = 6
-        midivel(ivx) = 127
-        midibal(ivx) = 64
-        miditran(ivx) = 0
-3     continue
-      do 12 icm = 0 , nm
-        imidi(icm) = 0
-        restpend(icm) = .false.
-        trest(icm) = 0.
-        levson(icm) = 0
-        levsoff(icm) = 0
-        slmon(icm) = .false.
-        naccbl(icm) = 0
-        n69(icm) = 0
-        n34(icm) = 0
-        msecstrt(icm,1) = 1
-12    continue
-c
-c  End of midi parameter initialization
-c
-      musize = 0
-      optimize = .false.
-      numargs = iargc()
-      if (numargs .eq. 0) then
-        print*,'You could have entered a jobname on the command line,'
-        print*,'      but you may enter one now:'
-        read(*,'(a)')jobname
-        numargs = 1
-      else 
-c        call getarg(1,jobname,idum) ! May need to replace this w/ next line 
-        call getarg(1,jobname) 
-      end if
-10    ljob = lenstr(jobname,44)
-      if (ljob .gt. 44) then
-        print*,'Jobname is too long. Try again.'
-        call stop1()
-      else if (ljob .eq. 0) then
-        print*,'No was jobname entered. Try again.'
-        call stop1()
-      else if (numargs .eq. 2) then
-        if (ljob.eq.2 .and. jobname(1:2).eq.'-o') then
-          optimize = .true.
-c          call getarg(2,jobname,idum) ! May need to replace this w/ next line 
-          call getarg(2,jobname) 
-          numargs = 1 
-          go to 10
-        else
-          print*,'Illegal option on command line'
-          call stop1()
-        end if
-      end if
-c
-c  Strip ".pmx" if necessary
-c
-      ndxpmx = max(index(jobname,'.pmx'),index(jobname,'.PMX'))
-      if (ndxpmx .gt. 0) then
-        jobname = jobname(1:ndxpmx-1)
-        ljob = ljob-4
-      end if
-c
-c  Check for existence of input file
-c
-      infileq = jobname(1:ljob)//'.pmx'
-      inquire(file=infileq,EXIST=fexist)
-      if (.not.fexist) then
-        inquire(file=jobname(1:ljob)//'.PMX',EXIST=fexist)
-        if (.not.fexist) then
-          print*,'Cannot find file '//infileq
-          call stop1()
-        else
-         infileq = jobname(1:ljob)//'.PMX'
-        end if      
-      end if
-c
-c  Open a log file
-c
-      open(15,file=jobname(1:ljob)//'.pml')
-      call printl('This is PMX, Version '//version//', '//date)
-      ljob4 = ljob
-      call printl('Opening '//infileq)
-      open(18,file=infileq)
-c
-c  Copy input file into common buffer 
-c
-      ipbuf = 0
-      linewcom(1) = 1
-      do 8 ilbuf = 1 , maxblks
-        ncomments = 0
-14      read(18,'(a)',end=9)lnholdq
-        lbuf(ilbuf) = lenstr(lnholdq,128)
-        if (lbuf(ilbuf) .eq. 0) then
-c
-c  Blank line.  Make it a single blank with length 1
-c
-          lbuf(ilbuf) = 1
-          lnholdq = ' '
-        end if
-c
-c  Now line has at least one non blank character. Check for comment
-c  As of Version 260, do not copy comments into bufq
-c  But need to count %'s for error messaging
-c        if (lnholdq(1:1).eq.'%') go to 14           
-        if (lnholdq(1:1).eq.'%') then
-          ncomments = ncomments+1
-          go to 14           
-        end if
-c
-c  When here, have counted all preceding comments and have a real line
-c
-        if (ilbuf .gt. 1) then
-          linewcom(ilbuf) = linewcom(ilbuf-1)+1+ncomments
-        else
-          linewcom(1) = 1+ncomments
-        end if
-        if (ipbuf+lbuf(ilbuf).gt.65536) then
-          print*,'Too many characters in file, stopping'
-          call stop1()
-        end if
-        bufq(ipbuf+1:ipbuf+lbuf(ilbuf)) = lnholdq
-        ipbuf = ipbuf+lbuf(ilbuf)
-8     continue
-      call printl('Too many lines in input file')
-      call stop1()
-9     continue
-c
-c  Insert dummy line to handle input files w/o CR-LF at end.
-c
-      nlbuf = ilbuf-1
-c      nlbuf = ilbuf
-c      bufq(ipbuf+1:ipbuf+3) = ' / '
-c      lbuf(nlbuf) = 3
-      close(18)
-      do 6 numit = 1 , maxit
-        if (optimize) call printl('Starting an iteration')
-c
-c  When isfirst=.true., pmxa() generates linebreaks normally, output in nbars0.
-c    Otherwise, nbars0 is the input
-c  When islast=.false., pmxb only returns poe's, otherwise does whole job
-c
-        call pmxa(jobname,ljob4,isfirst,nsyst,nbars0,optimize)
-        if (.not.optimize) then
-          if (ismidi) then
-c
-c  This was moved here from writemidi 130302 to allow midivel,bal,tran, to be
-c    set up here as functions of instrument rather than iv (staff).
-c  Count up staves(iv,nv) vs instruments.  Store instr# for iv in iinsiv(iv)
-c
-            nstaves = 0
-            ivt = 0
-            do 16 iinst = 1 , nm
-              nstaves = nstaves+nsperi(iinst)
-              do 17 ivtt = 1 , nsperi(iinst)
-                ivt = ivt+1
-                iinsiv(ivt) = iinst
-17            continue
-              if (nstaves .eq. nv) go to 18
-16          continue
-            print*,'Screwup!'
-            call stop1()
-18          continue
-c
-c  Set up channel numbers for midi. 
-c
-            numchan = 0
-            do 11 iv = nv , 1 , -1
-              if (twoline(iv)) then
-                midchan(iv,2) = numchan
-                numchan = numchan+1
-              end if
-              midchan(iv,1) = numchan
-              numchan = numchan+1
-11          continue
-c
-c  numchan will now be the number of channels, but max channel # is numchan-1
-c
-c  Set up velocities, balances, and midi-transpositions
-c
-            do 13 iv = nv , 1 , -1
-              if (twoline(iv)) then
-c  130302 Make these functions of instrument rather than staff (iv)
-c                midvelc(midchan(iv,2)) = midivel(iv)
-c                midbc(midchan(iv,2)) = midibal(iv)
-c                midtc(midchan(iv,2)) = miditran(iv)
-                midvelc(midchan(iv,2)) = midivel(iinsiv(iv))
-                midbc(midchan(iv,2)) = midibal(iinsiv(iv))
-                midtc(midchan(iv,2)) = miditran(iinsiv(iv))
-              end if
-c              midvelc(midchan(iv,1)) = midivel(iv)
-c              midbc(midchan(iv,1)) = midibal(iv)
-c              midtc(midchan(iv,1)) = miditran(iv)
-              midvelc(midchan(iv,1)) = midivel(iinsiv(iv))
-              midbc(midchan(iv,1)) = midibal(iinsiv(iv))
-              midtc(midchan(iv,1)) = miditran(iinsiv(iv))
-13          continue
-          end if
-c
-c  TEMPORARY!!!
-c
-      write(15,*)'nlbuf: ',nlbuf
-      ip1 = 1
-      do 10000 ilb = 1 , nlbuf
-c        write(15,'(2i5,a40,3i5)')ilb,lbuf(ilb),
-c     *     bufq(ip1:ip1+lbuf(ilb)-1),
-c     *     (ichar(bufq(ip1+lbuf(ilb)-k:ip1+lbuf(ilb)-k)),
-c     *      k=min(3,lbuf(ilb)),1,-1)
-        ip1 = ip1+lbuf(ilb)
-10000 continue
-      iplast = ip1-1
-c
-c  Check to see if (1) last line is "<blank><blank>/" and (2) next to last
-c    line is "/"
-c
-c      print*,'iplast:',iplast
-c      print*,'Last line:'
-c      print*,bufq(iplast+1-lbuf(nlbuf):iplast)
-c      print*,'Last char of next to last line:'
-c      print*,bufq(iplast-lbuf(nlbuf):iplast-lbuf(nlbuf))
-      if (bufq(iplast+1-lbuf(nlbuf):iplast) .eq. '  /') then
-        if (bufq(iplast-lbuf(nlbuf):iplast-lbuf(nlbuf)).eq.'/') then
-          print*,'Removing last line of "<blank><blank>/"'
-          write(15,*)'Removing last line of "<blank><blank>/"'
-          nlbuf = nlbuf-1
-        end if
-      end if
-c
-          call pmxb(.true.,poe0,ncalls,optimize)
-          if (ismidi) then
-c
-c  Write midi file
-c
-            open(51,file=jobname(1:ljob)//'.mid')
-            if (debugmidi) open(52,file=jobname(1:ljob)//'.dbm')
-            call printl(' ')
-            call printl('Writing '//jobname(1:ljob)//'.mid')
-            call writemidi(jobname,ljob)
-          end if
-          close(15)
-          stop
-        end if
-      write(15,*)'nlbuf: ',nlbuf
-      ip1 = 1
-        call pmxb(.false.,poe0,ncalls,optimize)
-        call poestats(nsyst,poe0,poebar0,devnorm0)
-c
-c  Save initial deviation and line breaks for later comparison
-c
-        if (numit .eq. 1) then
-          devpmx = devnorm0
-          do 20 isys = 1 , nsyst 
-            nbari(isys) = nbars0(isys)
-20        continue
-        end if
-        call sortpoe(nsyst,poe0,ipoe)
-        do 1 iupord = nsyst , 1 , -1
-          isysu = ipoe(iupord)
-          print*,'isysu=',isysu
-          write(15,*)'isysu=',isysu
-c
-c  Skip if system isysu has poe0 < avg or isysd has poe0 > avg
-c
-          if (poe0(isysu).lt.poebar0) go to 1
-          do 5 idnord = 1 , nsyst
-            isysd = ipoe(idnord)
-            if (isysu.eq.isysd .or. nbars0(isysd).eq.1
-     *                     .or. poe0(isysd).gt.poebar0) go to 5
-            do 2 isyst = 1 , nsyst
-              nbars(isyst) = nbars0(isyst)
-              if (isyst .eq. isysu) then
-                nbars(isyst) = nbars(isyst)+1
-              else if (isyst .eq. isysd) then
-                nbars(isyst) = nbars(isyst)-1
-              end if
-2           continue
-            call pmxa(jobname,ljob4,isfirst,nsyst,nbars,optimize)
-            call pmxb(.false.,poe,ncalls,optimize)
-            call poestats(nsyst,poe,poebar,devnorm)
-            if (devnorm .lt. devnorm0) then
-              devnorm0 = devnorm
-              poebar0 = poebar
-              do 4 isys = 1 , nsyst
-                nbars0(isys) = nbars(isys)
-                poe0(isys) = poe(isys)
-4             continue
-              print*,'Improved with iup,idown,devnorm:',
-     *                 isysu,isysd,devnorm0
-              write(15,*)'Improved with iup,idown,devnorm:',
-     *                 isysu,isysd,devnorm0
-              write(*,'(5x,20i3)')(nbars0(isys),isys=1,nsyst)
-              write(15,'(5x,20i3)')(nbars0(isys),isys=1,nsyst)
-              call sortpoe(nsyst,poe0,ipoe)
-              go to 6
-            end if
-5         continue
-1       continue
-c
-c  If we get here, must have gone thru all switches and found nothing better,
-c  so done!
-c
-        go to 7
-6     continue
-7     continue
-      print*,'Optimum located, numit:',numit,',  ncalls:',ncalls
-      write(15,*)'Optimum located, numit:',numit,',  ncalls:',ncalls
-      print*,'Final error:',devnorm0,', initial error:',devpmx
-      write(15,*)'Final error:',devnorm0,', initial error:',devpmx
-      print*,'Percentage improvement:',100.*(1-devnorm0/devpmx)
-      write(15,*)'Percentage improvement:',100.*(1-devnorm0/devpmx)
-      call printl('Initial bars/system:')
-      write(*,'(5x,20i3)')(nbari(isys),isys=1,nsyst)
-      write(15,'(5x,20i3)')(nbari(isys),isys=1,nsyst)
-      call printl('Final bars/system:')
-      write(*,'(5x,20i3)')(nbars0(isys),isys=1,nsyst)
-      write(15,'(5x,20i3)')(nbars0(isys),isys=1,nsyst)
-      call pmxa(jobname,ljob4,.false.,nsyst,nbars0,optimize)
-      call pmxb(.true.,poe0,ncalls,optimize)
-c      itend = mytime()
-c      print*,'Elapsed time in ms:',itend-itstart
-c      write(15,*)'Elapsed time in ms:',itend-itstart
-      close(15)
-      end
-      subroutine accsym(nacc,acsymq,lacc)
-      character*3 acsymq
-      iacc = iand(nacc,7)
-      if (iacc .eq. 1) then
-        acsymq = 'fl'
-        lacc = 2
-      else if (iacc .eq. 2) then
-        acsymq = 'sh'
-        lacc = 2
-      else if (iacc .eq. 3) then
-        acsymq = 'na'
-        lacc = 2
-      else if (iacc .eq. 5) then
-        acsymq = 'dfl'
-        lacc = 3
-      else if (iacc .eq. 6) then
-        acsymq = 'dsh'
-        lacc = 3
-      else
-        print*,'bad accidental: ',iacc
-      end if
-      return
-      end
-      subroutine addask(taskn,waskn,elaskn,
-     *                  fixednew,scaldold,tglp1,isudsp)
-      parameter (nm=24)
-      logical isudsp
-      common /comas1/ naskb,task(40),wask(40),elask(40)
-      common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
-      common /comtol/ tol
-      if (isudsp) then
-c
-c  Find which udsp we're dealing with
-c
-        do 1 iudsp = 1 , nudsp
-          if (abs(taskn+tglp1-tudsp(iudsp)) .lt. tol) go to 2
-1       continue
-        print*,'You should note BEEE here in addask!'
-        call stop1()
-2       continue
-c
-c  Fixednew and scaldold must not be changed, since udsp's are already included
-c  in fsyst from pmxa, and udsp don't involve scaled space..
-c
-        if (naskb.gt.0 .and. abs(taskn-task(max(1,naskb))).lt.tol) then
-c
-c  Must add user-defined space to what's there already.
-c
-          wask(naskb) = wask(naskb)+udsp(iudsp)
-        else
-c
-c  This place has no other space.
-c
-          naskb = naskb+1
-          task(naskb) = taskn
-          wask(naskb) = udsp(iudsp)
-          elask(naskb) = 0.
-        end if
-      else
-c 130330 start
-      oldwask = 0.
-      oldelask = 0.
-c 130330 end
-c
-c  This is a normal space, no effect if smaller than existing space
-c
-        if (naskb.gt.0 .and. abs(taskn-task(max(1,naskb))).lt.tol) then
-c
-c  We already put in some space at this time
-c  Check if new one needs more space than old one at same time
-c
-          if (waskn .gt. wask(naskb)) then
-c
-c 130330 We were double counting the larger space when it came 2nd
-c Need to fix but don't see how yet. Assume times came in order and 
-c that last naskb defined spaces that need updating
-c            
-            oldwask = wask(naskb)
-            oldelask = elask(naskb)
-c End of 130330 insertions
-            naskb = naskb-1
-          else
-            return
-          end if
-        end if
-        naskb = naskb+1
-        task(naskb) = taskn
-        wask(naskb) = waskn
-        elask(naskb) = elaskn
-c 130330 start
-c        fixednew = fixednew+waskn
-c        scaldold = scaldold+elaskn
-        fixednew = fixednew+waskn-oldwask
-        scaldold = scaldold+elaskn-oldelask
-c 130330 end
-      end if
-      return
-      end
-      subroutine addblank(noteq,lnoten)
-      character*8 noteq
-      character*1 tchar
-      tchar = noteq(1:1)
-      noteq = ' '//tchar
-      lnoten = 2
-      return
-      end
-      subroutine addfb(nfb,iv,tnew,t1fb,t2fb,ulfbq,ifbadd)
-      parameter (nm=24)
-      integer nfb(nm)
-      common /comtol/ tol
-      real*4 t1fb(nm,20),t2fb(nm,20)
-      character*1 ulfbq(nm,20)
-      ifbadd = 1
-      nfb(iv) = nfb(iv)+1
-      do 1 ifb = nfb(iv)-1 , 1 , -1
-        if (tnew .lt. t1fb(iv,ifb)-tol) then
-          t1fb(iv,ifb+1) = t1fb(iv,ifb)
-          t2fb(iv,ifb+1) = t2fb(iv,ifb)
-          ulfbq(iv,ifb+1) = ulfbq(iv,ifb)
-        else
-          ifbadd = ifb+1
-          go to 2
-        end if
-1     continue
-2     continue
-      t1fb(iv,ifbadd) = tnew
-      ulfbq(iv,ifbadd) = 'x'
-      return
-      end
-      subroutine addmidi(icm,nolev,iacc,midisig,time,rest,endrest)
-c      subroutine addmidi(icm,nolev,iacc,isig,time,rest,endrest)
-      parameter(nm=24,mv=24576)
-      integer*2 mmidi,itk(25)
-      integer*4 itiesav(5,100)
-      character*1 notenumq
-      logical endrest,eximacc,it1found
-      logical rest
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
-     *                ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
-      integer*2 iinsiv
-      logical slmon,dbltie
-      common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm),
-     *       naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl,
-     *       slmon(0:nm),dbltie
-      common /comevent/ miditime,lasttime
-      common /comdiag/ n69(0:nm),n34(0:nm)
-c      common /commidisig/ midisig(nm)
-c
-c  Following variables are local but must be saved.  I hope they are.
-c  (3/18/00) With g77 they are not, so add a common block here.
-c
-c      integer*2 ipslon(0:nm),lusebl(10),jusebl(10),icmm(0:12)
-      integer*2 ipslon(0:nm),lusebl(10),jusebl(10),icmm(0:15)
-      common /comips/ ipslon,lusebl,jusebl
-c      data icmm /0,1,2,3,4,5,6,7,8,10,11,12,13/
-      data icmm /0,1,2,3,4,5,6,7,8,10,11,12,13,14,15,16/
-c
-c  Cancel out barline accidentals if there's a rest.
-c
-      if (rest) naccbl(icm) = 0
-c
-c  Special path to insert dummy rest at end of a section
-c
-      if (endrest) go to 20
-c
-      do 7 ion = 0 , nmidcrd
-c
-c  check if this is only to get pitch of a chord note
-c
-        if (notmain) go to 6
-c
-c  check for rest
-c
-        if (rest) then
-c
-c  Will not put in a note, but must update timing
-c
-          if (.not.restpend(icm)) then
-c
-c  First rest in sequence, save the time
-c
-            restpend(icm) = .true.
-            trest(icm) = time
-          else 
-            trest(icm) = trest(icm)+time
-          end if
-c
-c  Note: code checkers don't like the above due to calling addmidi(trest(icm))
-c    but this only happens if rest at end of section (endrest=.true.) (called
-c    from getmidi(), in which case these above lines are bypassed.
-c
-          call chkimidi(icm)
-          return
-        end if
-c
-c  time tics
-c
-        if (imidi(icm).gt.0 .and. ion.eq.0) then
-          idur = mgap
-        else
-          idur = 0
-        end if
-        if (restpend(icm)) then
-          restpend(icm) = .false.
-          idur = idur+nint(15*trest(icm))
-        end if
-c
-c  time to start of note
-c
-        idurvar = isetvarlen(idur,nby2on)
-        if (nby2on .gt. 4) then
-          print*,'You got >4 bytes, something is bogus.'
-          call stop1()
-        end if
-        imidi(icm) = imidi(icm)+1
-        do 2 i = 1 , nby2on
-c
-c  imidi points to cell before highest (leftmost) byte.  Start with lowest byte 
-c    at far right, fill in backwards
-c
-          mmidi(icm,imidi(icm)+nby2on-i) = mod(idurvar,256)
-          if (nby2on .gt. 1) idurvar = idurvar/256
-2       continue
-        imidi(icm) = imidi(icm)+nby2on-1
-c
-c  Note-on signal
-c  
-        imidi(icm) = imidi(icm)+1
-c        mmidi(icm,imidi(icm)) = 9*16+icm
-        mmidi(icm,imidi(icm)) = 9*16+icmm(icm)
-c
-c  Entry point for chord note pitch determination
-c
-6       continue
-c
-c  Get midi pitch.  On chord iteration, only do this first time (main note),
-c  since pitch was already computed for nonmain chord notes.
-c
-        if (ion .eq. 0) then
-          ipsav = nolev*12./7+11
-          ipsav0 = ipsav
-          if (midisig .ne. 0) then
-c
-c  Adjust for signature 
-c
-            notenumq = char(48+mod(nolev,7))
-            if (midisig.ge.index('4152630',notenumq)) then
-              ipsav = ipsav+1
-            else if (-midisig.ge.index('0362514',notenumq)) then
-              ipsav = ipsav-1
-            end if
-          end if
-c
-c  Deal with accidentals.  
-c
-c  iacc   0   1   2   3   4   5   6   7
-c effect  X   fl  sh  na  X  dfl dsh  X
-c iashft  X   -1  1   0   X  -2   2   X
-c
-          jacc = 0
-          eximacc = .false.
-          if (iacc .gt. 0) then
-c
-c  Adjust key-sig-adjusted pitch for explicit accidental (and exit)
-c
-            jacc = iashft(iacc)
-            eximacc = .true.
-            if (.not.relacc) jacc = jacc+ipsav0-ipsav
-c		   
-c  (Above) Shift applies to diatonic pitch but will be added to adjusted one
-c
-          else if (naccim(icm) .gt. 0) then
-c
-c  Possible implicit accidental from earlier in the bar
-c    Check for prior accid in this bar at this note level
-c
-            do 3 kacc = 1 , naccim(icm)
-              if (laccim(icm,kacc) .eq. nolev) then
-                jacc = jaccim(icm,kacc)
-                eximacc = .true.
-                if (.not.relacc) jacc = jacc+ipsav0-ipsav
-                go to 4
-              end if
-3           continue
-4           continue
-          end if
-c
-c  Must split off the following if block from those above because chord
-c  notes can cause naccim>0, forcing us to miss other chord note's
-c  accross-bar-line accidental
-c
-          if (naccbl(icm).gt.0 .and. .not.eximacc) then
-c
-c  Possible carryover accid from prior bar (or prior same-pitch note).    
-c
-            do 21 kacc = 1 , naccbl(icm)
-              if (laccbl(icm,kacc) .eq. nolev) then
-                jacc = jaccbl(icm,kacc)
-c
-c  Since we are *using* the bar-line accid, must flag it to be saved for next.
-c 
-                nusebl = nusebl+1
-                jusebl(nusebl) = jacc
-                lusebl(nusebl) = nolev
-                if (.not.relacc) jacc = jacc+ipsav0-ipsav
-                go to 22
-              end if
-21          continue
-22          continue
-          end if
-          ipsav = ipsav+jacc
-        end if
-        if (notmain) then
-          mcpitch(nmidcrd) = ipsav
-c
-c  Save pitch for tie checks
-c
-          if (levson(icm).eq.nolev.and..not.slmon(icm)) 
-     *           ipslon(icm) = ipsav
-        else 
-          imidi(icm) = imidi(icm)+1
-          if (ion.eq.0) then
-            mmidi(icm,imidi(icm)) = ipsav
-            if (levson(icm).eq.nolev.and..not.slmon(icm)) 
-     *           ipslon(icm) = ipsav
-          else
-            mmidi(icm,imidi(icm)) = mcpitch(ion)
-          end if
-        end if
-        if (ion .eq. 0) then
-c
-c  Only record accids for non-chords, main chord note during chord iteration
-c    and chordnotes on first call but not during iteration
-c
-          if (iacc.gt.0) then
-c
-c  Set marker for accidental for possible continuations later this bar
-c    but first check and clear earlier ones on same note. 
-c
-            do 23 kacc = 1 , naccim(icm)
-              if (laccim(icm,kacc) .eq. nolev) then
-                do 24 macc = kacc , naccim(icm)-1
-                  laccim(icm,macc) = laccim(icm,macc+1)
-                  jaccim(icm,macc) = jaccim(icm,macc+1)
-24              continue
-                go to 25
-              end if
-23          continue
-            go to 26
-25          continue
-            naccim(icm) = naccim(icm)-1
-26          continue
-c
-c  Flag new accidental
-c
-            naccim(icm) = naccim(icm)+1
-            laccim(icm,naccim(icm)) = nolev
-            jaccim(icm,naccim(icm)) = iashft(iacc)
-          end if
-c
-c  Bail if this is a chord note on the first call (from docrd)
-c
-          if (notmain) then
-            call chkimidi(icm)
-		  return
-          end if
-        end if
-c
-c  Vel
-c
-        imidi(icm) = imidi(icm)+1
-c        mmidi(icm,imidi(icm)) = 127
-        mmidi(icm,imidi(icm)) = midvelc(icm)
-        call chkimidi(icm)
-7     continue
-c
-c  For tie checks
-c
-      if (levson(icm).gt.0.and..not.slmon(icm)) imidso(icm) = imidi(icm)
-c
-c  Entry point for special rests at section ends (endrest=T)
-c
-20    continue
-c
-c  Now insert all the ends
-c
-      do 8 ioff = 0 , nmidcrd
-        if (ioff .eq. 0) then
-c
-c  time to end
-c
-          idur1 = nint(15*time)    
-          if (.not.endrest .or. miditime.eq.nint(15*trest(icm))) then 
-            idur = idur1-mgap
-          else
-            idur = idur1
-          end if
-c
-c  Deal with roundoff problems with 7-tuplets on half or quarters
-c
-          if (idur1 .eq. 69) then
-            n69(icm) = n69(icm)+1
-c            if (mod(n69(icm)+6,7) .gt. 3) idur = 58
-            if (mod(n69(icm)+6,7) .gt. 3) idur = idur1-mgap-1
-          else if (idur1 .eq. 34) then
-            n34(icm) = n34(icm)+1
-            if (mod(n34(icm)+6,7) .gt. 4) idur = idur1-mgap+1
-          end if
-          idurvar = isetvarlen(idur,nby2off)
-          if (nby2off .gt. 4) then
-            print*,'You got >4 bytes, something is bogus.'
-            call stop1()
-          end if
-          imidi(icm) = imidi(icm)+1
-          call chkimidi(icm)
-          do 1 i = 1 , nby2off
-            mmidi(icm,imidi(icm)+nby2off-i) = mod(idurvar,256)
-            if (nby2off .gt. 1) idurvar = idurvar/256
-1         continue
-          imidi(icm) = imidi(icm)+nby2off-1
-        else
-c
-c  Inserting end of chord note, delta time is 0
-c
-          imidi(icm) = imidi(icm)+1
-          mmidi(icm,imidi(icm)) = 0
-        end if
-c
-c  Note off
-c
-        imidi(icm) = imidi(icm)+1
-c        mmidi(icm,imidi(icm)) = 8*16+icm
-        mmidi(icm,imidi(icm)) = 8*16+icmm(icm)
-c
-c  Pitch
-c
-        imidi(icm) = imidi(icm)+1
-        if (ioff .eq. 0) then
-          mmidi(icm,imidi(icm)) = ipsav
-        else
-          mmidi(icm,imidi(icm)) = mcpitch(ioff)
-        end if
-c
-c  Vel
-c
-        imidi(icm) = imidi(icm)+1
-        mmidi(icm,imidi(icm)) = 0
-        call chkimidi(icm)
-        if (endrest) then
-          return
-        end if
-c
-c      print*,'Off, icm,imidi,ipsav,idur:',icm,imidi(icm),ipsav,time
-c
-8     continue
-      naccbl(icm) = nusebl
-      if (nusebl .gt. 0) then
-c
-c  Fix tables of "bar-line" accids that are saved due to consecutive notes.
-c
-        do 30 kacc = 1 , nusebl
-          laccbl(icm,kacc) = lusebl(kacc)
-          jaccbl(icm,kacc) = jusebl(kacc)
-30      continue 
-        nusebl = 0
-      end if
-c
-c  Begin tie checks
-c
-      if (slmon(icm)) then
-c
-c  Prior note had a slur start
-c
-        if (levson(icm).eq.levsoff(icm) .and. iacc.eq.0) then
-c
-c  We have a tie! (Assumed there would be no accidental on tie-ending note)
-c  Make a list of times of all events back to the one starting at imidso+1, 
-c    which is at or before where the tie started.  Ident tie start and stop by
-c    comparing pitches.  Save the 4 pieces of data in itiesav(1...4,nsav4tie)
-c    Store actual time in itiesav(5,nsav4tie), using itiesav(1,1) as initial 
-c    time.
-          nsav4tie = 0
-          imidt = imidso(icm)
-10        nsav4tie = nsav4tie+1
-          itiesav(1,nsav4tie) = igetvarlen(mmidi,icm,imidt,nbytes)
-          imidt = imidt+nbytes
-          do 11 j = 1 , 3
-            itiesav(j+1,nsav4tie) = mmidi(icm,imidt+j)
-11        continue
-          imidt = imidt+3
-          if (nsav4tie .eq. 1) then
-            itiesav(5,1) = itiesav(1,1)
-          else
-            itiesav(5,nsav4tie) = itiesav(1,nsav4tie)+
-     *                              itiesav(5,nsav4tie-1)
-          end if
-          if (imidt .ne. imidi(icm)) go to 10
-c
-c  Find which two pitches agree with saved slur pitch.
-c
-          it1found = .false.
-          do 12 it2 = 1 , nsav4tie
-            if (itiesav(3,it2) .eq. ipslon(icm)) then
-              if (it1found) go to 13
-              it1 = it2
-              it1found = .true.
-            end if
-12        continue
-          call printl(
-     *          'Program error, tied notes, send source to Dr. Don')
-          it1 = nsav4tie+1
-          it2 = nsav4tie+1
-13        continue
-c
-c  List the positions we want to keep
-c
-          jsav = 0
-          do 14 isav = 1 , nsav4tie
-            if (isav.eq.it1 .or. isav.eq.it2) go to 14
-            jsav = jsav+1
-            itk(jsav) = isav
-14        continue
-          nsav4tie = nsav4tie-2
-c
-c  Now dump events it1 & it2, recompute times, restack mmidi.         
-c
-          imidi(icm) = imidso(icm)
-          do 15 isav = 1 ,nsav4tie
-            if (isav .eq. 1) then
-              idurvar = isetvarlen(itiesav(5,itk(isav)),nbytes)
-            else
-              idurvar = isetvarlen(itiesav(5,itk(isav))-
-     *                             itiesav(5,itk(isav-1)),nbytes)
-            end if
-            imidi(icm) = imidi(icm)+1
-            do 16 i = 1 , nbytes
-              mmidi(icm,imidi(icm)+nbytes-i) = mod(idurvar,256)
-              if (nbytes .gt. 1) idurvar = idurvar/256
-16          continue
-            imidi(icm) = imidi(icm)+nbytes-1
-            do 17 i = 2 , 4
-              imidi(icm) = imidi(icm)+1
-              mmidi(icm,imidi(icm)) = itiesav(i,itk(isav))
-17          continue
-15        continue
-        end if
-        slmon(icm) = .false.
-        levsoff(icm) = 0
-        if (.not.dbltie) levson(icm) = 0
-      end if
-      if (levson(icm).gt.0) slmon(icm) = .true.
-      if (nmidcrd .gt. 0) nmidcrd = 0
-      call chkimidi(icm)
-      return
-      end
-      subroutine addstr(notexq,lnote,soutq,lsout)
-      common /comlast/ islast,usevshrink
-      logical islast,usevshrink
-        character*(*) notexq
-        character*80 soutq
-        if (lsout+lnote .gt. 72) then
-          if (islast) write(11,'(a)')soutq(1:lsout)//'%'
-          lsout = 0
-        end if
-        if (lsout .gt. 0) then
-          soutq = soutq(1:lsout)//notexq(1:lnote)
-        else
-          soutq = notexq(1:lnote)
-        end if
-        lsout = lsout+lnote
-      return
-      end
-      subroutine adjusteskz(ib,istart,poenom)
-c
-c  For block ib, this adds accidental spaces to eskz, for use in getting
-c  length of xtup bracket and slopes of brackets and beams.
-c
-      parameter (nm=24)
-      common /comas1/ naskb,task(40),wask(40),elask(40)
-      integer*4 istart(80)
-      common /comnsp/ space(80),nb,prevtn(nm),
-     *    flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm)
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      character*1 ulq,sepsymq,sq
-      logical beamon,firstgulp,figbass,figchk,isfig
-      common /comeskz2/ eskz2(nm,200)
-      common /comtol/ tol
-      common /comntot/ ntot
-      inmin = istart(ib)+1
-      do 10 iaskb = 1 , naskb
-        if (task(iaskb) .lt. to(istart(ib))-tol) go to 10
-        eskadd = wask(iaskb)/poenom-elask(iaskb) 
-        do 11 in = inmin , ntot 
-          if (to(in) .gt. task(iaskb)-tol) then
-            eskz2(ivxo(in),ipo(in)) = eskz2(ivxo(in),ipo(in))+eskadd
-            if (abs(to(in)-task(iaskb)).lt. tol) inmin=inmin-1
-          else
-            inmin = inmin+1
-          end if
-11      continue
-10    continue
-      return
-      end
-      subroutine askfig(pathnameq,lpath,basenameq,lbase,figbass,istype0)
-      logical figbass,ispoi,topmods,istype0,done,isbbm
-      common /comhsp/ hpttot(176)
-      common /compoi/ ispoi
-      common /combbm/ isbbm
-      common /comas3/ ask(2500),iask,topmods
-      character*40 pathnameq
-      character*44 basenameq
-      character*1 sq,chax
-      character*129 outq
-      sq = chax(92)
-      open(12,file=pathnameq(1:lpath)//basenameq(1:lbase)//'.tex')
-c
-c  Transfer first 5 lines of main internal TeX file
-c
-      do 11 il = 1 , 5
-        call moveln(11,12,done)
-11    continue
-      if (istype0) then
-c
-c  Transfer literal TeX stuff from special scratch file
-c
-        rewind(17)
-10      call moveln(17,12,done)
-        if (.not.done) go to 10
-        close(17)
-      end if
-c
-c  Transfer next 2 lines from main scratch file
-c
-      do 3 il = 1 , 2
-        call moveln(11,12,done)
-3     continue
-      if (ispoi) write(12,'(a)')sq//'input musixpoi'
-      if (isbbm) write(12,'(a)')sq//'input musixbbm'
-      if (figbass) then
-c
-c  Transfer .fig data from scratch (unit 14) into external .tex (unit 12)
-c
-4       call moveln(14,12,done)
-        if (.not.done) go to 4
-        close(14)
-      end if
-      iask = 0
-      ihs = 0
-1     read(11,'(a129)',end=999)outq
-c
-c  Hardspaces.
-c
-      if (outq(1:5) .eq. sq//'xard') then
-        ihs = ihs+1
-        outq(2:2) = 'h'
-        write(outq(12:15),'(f4.1)')hpttot(ihs)
-        lenout = 19
-        go to 9
-      end if
-c
-c  This part hard-wires ask's into new .tex file as ast's
-c
-2     indxask = index(outq,sq//'ask')
-      if (indxask .ne. 0) then
-        iask = iask+1
-        call putast(ask(iask),indxask,outq)
-        go to 2
-      end if
-      lenout = llen(outq,129)
-9     continue
-      write(12,'(a)')outq(1:lenout)
-c
-c  If this is the line with "readmod", check for topmods.
-c
-      if (topmods .and. outq(2:8).eq.'readmod') then
-        topmods = .false.
-        rewind(16)
-        do 7 il = 1 , 1000
-          read(16,'(a129)',end=8)outq
-          lenout = llen(outq,129)
-c
-c  We inserted the '%' in subroutine littex, to guarantee including blank.
-c
-          write(12,'(a)')outq(1:lenout)
-7       continue
-8       continue
-        close(16)
-      end if
-      go to 1
-999   close(11)
-      close(12)
-      return
-      end
-      subroutine backfill(iunit,oldq,lenold,newq,lennew)
-c
-c  In iunit, looks backward for oldq, overwrites newq
-c  Safest if both are same length!
-c
-      character*128 lineq(200),nowq
-	character*(*) oldq,newq
-      linesback = 0
-1     continue
-      backspace(iunit)
-	read(iunit,'(a)')nowq
-	ndx = index(nowq,oldq(1:lenold))
-c
-c  Save the line just read
-c
-      linesback = linesback+1
-	lineq(linesback) = nowq
-      if (ndx .eq. 0) then
-        backspace(iunit)
-	  go to 1
-	end if
-c
-c  If here, it's replacement time.
-c
-      lineq(linesback) = nowq(1:ndx-1)//newq(1:lennew)
-     *  //nowq(ndx+lenold:128)
-      backspace(iunit)
-      do 2 line = linesback , 1 , -1
-        write(iunit,'(a128)')lineq(line)
-2     continue
-      return
-      end
-      subroutine beamend(notexq,lnote)
-      parameter (nm=24)
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      character*1 ulq,sepsymq,sq,ulqq,chax
-      logical beamon,firstgulp,figbass,figchk,flipend,btest,
-     *        isfig,vxtup,isdotm,isbjmp,isbj2,drawbm
-      common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2
-      common /comoct/ noctup
-      common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
-     *                 mtupv(nm,9),nxtinbm(nm),
-     *                 islope(nm),xelsk(24),eloff(nm,9),
-     *                 nssb(nm),issb(nm),lev1ssb(nm,20)
-      common /comdraw/ drawbm(nm)
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      common /strtmid/ ihnum3,flipend(nm),ixrest(nm)
-      character*4 tempq
-      character*8 noteq
-      character*79 notexq
-      ip = ipo(jn)
-      multip = iand(mult(ivx,ip),15)-8
-      if (ixrest(ivx) .eq. 4) then
-c
-c  This is the LAST note in the xtup (i.e., all rests before).  Make single.
-c
-        nodur(ivx,ip) = 2**(4-multip)
-        call notex(notexq,lnote)
-        ixrest(ivx) = 0
-        return
-      end if
-      nole = nolev(ivx,ip)
-c
-c  Check for special situations with 2nds (see precrd)
-c
-      if (btest(nacc(ivx,ip),30)) then
-        nole = nole - 1
-      else if (btest(nacc(ivx,ip),31)) then
-        nole = nole + 1
-      end if
-      if (.not.drawbm(ivx)) then
-c
-c  Xtuplet with no beam, just put in the right kind of note
-c
-        if (btest(islur(ivx,ip),30)) then
-c
-c  Forced stem direction
-c
-          ndsav = nodur(ivx,ip)
-          nodur(ivx,ip) = 2**(4-multip)
-          if (btest(nacc(ivx,ip-1),27)) 
-     *            nodur(ivx,ip)=nodur(ivx,ip)/2
-          call notex(notexq,lnote)
-          nodur(ivx,ip) = ndsav
-        else
-          call notefq(noteq,lnoten,nole,ncmid(iv,ip))
-          if (lnoten .eq. 1) call addblank(noteq,lnoten)
-          lnote = lnoten+3
-          if (.not.btest(nacc(ivx,ip-1),27)) then
-c
-c  Prior note is not regular-dotted
-c              
-
-            if (multip .eq. 0) then
-              notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))//noteq
-            else if (multip .eq. -1) then
-              notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq
-            else if (multip .eq. 1) then
-              notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))//noteq
-            else if (multip .eq. 2) then
-              notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))//noteq
-              lnote = lnote+1
-            else if (multip .eq. 3) then
-              notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))//noteq
-              lnote = lnote+2
-            else if (multip .eq. -2) then
-              notexq = sq//'wh'//noteq
-            else if (multip .eq. -3) then
-              notexq = sq//'breve'//noteq
-              lnote = lnote+3
-            else
-              print*
-              print*,'(Error in beamend, send source to Dr. Don)'
-              call stop1()
-            end if
-          else
-c
-c  Prior note is regular-dotted so this one is halved
-c
-            if (multip .eq. 0) then
-              notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))//noteq
-            else if (multip .eq. -1) then
-              notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))//noteq
-            else if (multip .eq. -2) then
-              notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq
-            end if
-          end if
-        end if
-        return
-      end if
-      call notefq(noteq,lnoten,nole,ncmid(iv,ip))
-      lnote = 0
-c
-c New way, with flipend, which was computed in beamstrt.
-c
-      if (flipend(ivx) .and. btest(ipl(ivx,ip),30))
-     *  ulq(ivx,ibmcnt(ivx)) = chax(225-ichar(ulq(ivx,ibmcnt(ivx))))
-      if (ip .gt. ibm1(ivx,ibmcnt(ivx))) then
-c
-c This is not a one-noter from beam-jump.  Check if multiplicity has increased
-c
-        if (btest(irest(ivx,ip-1),0)) then
-c
-c  Prior note is a rest, check one before that
-c
-          mp = iand(mult(ivx,ip-2),15)-8
-        else
-          mp = iand(mult(ivx,ip-1),15)-8
-        end if
-        if (multip .gt. mp) then
-c
-c  Assume 1-3, 2-3, or 1-2
-c
-          do 2 imp = multip , mp+1 , -1
-            call ntrbbb(imp,'t',ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote)
-2         continue
-        else if (btest(nacc(ivx,ip-1),27)) then
-c
-c  2nd member of dotted xtup
-c
-          call ntrbbb(multip+1,'t',
-     *                       ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote)
-        end if
-      end if
-c
-c Beam termination and direction analysis
-c
-      if (btest(irest(ivx,ip),23) .and. .not.isbjmp) then
-c
-c This is the end of the first segment in a jump-beam.  ivbj1=ivx will be number 
-c   of the jump-beam.  ivbj2 will be tested along with isbjmp to see if in the
-c   voice of the 2nd part of jumped beam.  (May need special treatment for
-c   multi-segment jump-beams
-c
-        isbjmp = .true.
-        ivbj1 = ivx      
-        ivbj2 = 0      
-      end if
-      if (.not.btest(irest(ivx,ip),23)) then
-c
-c This is either a normal beamend or end of a sequence of jump-beam segments, 
-c so some sort of termination is required
-c
-        ulqq = ulq(ivx,ibmcnt(ivx))
-        if (.not.isbjmp .or. ivx.ne.ivbj2) then
-c
-c Normal termination
-c
-          call ntrbbb(1,'t',ulqq,mod(ivx,24),notexq,lnote)
-        else 
-c
-c Terminate a sequence of jump-beam segments.
-c
-          ulqq = chax(225-ichar(ulqq)) 
-          call ntrbbb(1,'t',ulqq,mod(ivbj1,24),notexq,lnote)
-        end if
-      end if
-c
-c Check for end of 2nd seg of staff-jump xtup chord blank rest
-c
-c      if (isbjmp.and.ivx.eq.ivbj2
-      if (isbjmp
-     *    .and.btest(islur(ivx,ip),29)) then
-        notexq = notexq(1:lnote)//sq//'sk'
-        return
-      end if
-c
-c  And now the note
-c
-      if (lnote .gt. 0) then
-        notexq = notexq(1:lnote)//sq//'qb'
-      else
-        notexq = sq//'qb'
-      end if
-      lnote = lnote+3
-      isdotm = .false.
-      if (.not.vxtup(ivx)) then
-        if (2**log2(nodur(ivx,ip)) .ne. nodur(ivx,ip)) then
-          if (.not.btest(iornq(ivx,ip),13)) then
-            notexq = notexq(1:lnote)//'p'
-          else
-            notexq = notexq(1:lnote)//'m'
-            isdotm = .true.
-          end if
-          lnote = lnote+1
-        end if
-      end if
-c
-c  5/25/08 Allow >12
-c  5/9/10 Up to 24; replace 24 with 0
-c
-      if (.not.(isbjmp.and.ivx.eq.ivbj2)) then
-c        call istring(mod(ivx,12),tempq,len)
-        call istring(mod(ivx,24),tempq,len)
-      else
-c        call istring(mod(ivbj1,12),tempq,len)
-        call istring(mod(ivbj1,24),tempq,len)
-      end if
-      if (isbjmp .and. ivx.eq.ivbj2 
-     *     .and..not.btest(irest(ivx,ip),23)) isbjmp=.false.      
-      notexq = notexq(1:lnote)//tempq(1:len)
-      lnote = lnote+len
-      notexq = notexq(1:lnote)//noteq(1:lnoten)
-      lnote = lnote+lnoten
-      if (isdotm) then
-        if (lnoten .eq. 1) then
-          notexq = notexq(1:lnote)//'{'//noteq(1:1)//'}'
-          lnote = lnote+3
-        else
-          notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1)
-          lnote = lnote+1
-        end if
-      end if
-      return
-      end
-      subroutine beamid(notexq,lnote)
-      parameter (nm=24)
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      character*1 ulq,sepsymq,sq,ulqq,chax
-      logical beamon,firstgulp,figbass,figchk,flipend,btest,
-     *        isfig,vxtup,isdotm,isbjmp,bar1syst,isdotted,isbj2,drawbm
-      character*79 notexq
-      common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2
-      common /comoct/ noctup
-      common /strtmid/ ihnum3,flipend(nm),ixrest(nm)
-      common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
-     *                 mtupv(nm,9),nxtinbm(nm),
-     *                 islope(nm),xelsk(24),eloff(nm,9),
-     *                 nssb(nm),issb(nm),lev1ssb(nm,20)
-      common /comdraw/ drawbm(nm)
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      common /comask/ bar1syst,fixednew,scaldold,
-     *                wheadpt,fbar,poenom
-      character*8 noteq
-      character*4 tempq
-        lnote = 0
-        ip = ipo(jn)
-        nole = nolev(ivx,ip)
-c
-c  Check for special situations with 2nds (see precrd)
-c
-        if (btest(nacc(ivx,ip),30)) then
-          nole = nole - 1
-        else if (btest(nacc(ivx,ip),31)) then
-          nole = nole + 1
-        end if
-        if (.not.btest(irest(ivx,ip),0)) then
-          multip = iand(mult(ivx,ip),15)-8
-c          if (btest(islur(ivx,ip-1),3)) multip = multip+1
-c
-c  (Above test OK since must have ip>1).  Double dotted note preceding
-c
-c  Move the following, because can't ask for note until after checking for
-c  embedded xtup with number, due to ordering/octave feature.
-c
-c         call notefq(noteq,lnoten,nolev(ivx,ip),ncmid(iv,ip))
-        end if
-        if (btest(irest(ivx,ip),28)) vxtup(ivx) = .true.
-        if (vxtup(ivx)) then
-c
-c  In an xtup
-c
-          if (btest(irest(ivx,ip),0)) then
-c
-c  Intermediate rest in xtup, put in the rest.  Reset nodur so notex works OK
-c
-            nodur(ivx,ip) = 2**(4-(iand(mult(ivx,ip),15)-8))
-            call notex(notexq,lnote)
-c
-c  Re-zero so next note does not get confused
-c
-            nodur(ivx,ip) = 0
-            return
-          end if
-c          if (multip.le.0) then
-c          if (multip.le.0 .or. 
-c     *        (multip.eq.1.and.btest(nacc(ivx,ip-1),18))) then
-          if (.not.drawbm(ivx)) then
-c
-c  Xtuplet with no beam, just put in the right kind of note
-c
-            if (btest(islur(ivx,ip),30)) then
-c
-c  Forced stem direction
-c
-              ndsav = nodur(ivx,ip)
-              nodur(ivx,ip) = 2**(4-multip)
-              if (btest(nacc(ivx,ip),19) .or. 
-     *                     btest(nacc(ivx,ip),27)) then
-                nodur(ivx,ip)=3*nodur(ivx,ip)/2
-              else if (btest(nacc(ivx,ip-1),27)) then
-                nodur(ivx,ip)=nodur(ivx,ip)/2
-              end if
-              call notex(notexq,lnote)
-              nodur(ivx,ip) = ndsav
-            else
-c
-c  Use ulq for stem direction
-c
-              call notefq(noteq,lnoten,nole,ncmid(iv,ip))
-              if (lnoten .eq. 1) call addblank(noteq,lnoten)
-              lnote = 3
-              if (.not.btest(nacc(ivx,ip-1),27)) then
-c
-c  Prior note is not regular-dotted
-c              
-                if (multip .eq. 0) then
-                  notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))
-                else if (multip .eq. -1) then
-                  notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))
-                else if (multip .eq. 1) then
-                  notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))
-                else if (multip .eq. 2) then
-                  notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))
-                  lnote = 4
-                else if (multip .eq. 3) then
-                  notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))
-                  lnote = 5
-                else if (multip .eq. -2) then
-                  notexq = sq//'wh'
-                end if
-                if (btest(nacc(ivx,ip),27)) then
-c
-c  This note is regular dotted non-beamed xtup
-c
-                  notexq = notexq(1:3)//'p'
-                  lnote = 4
-                end if
-              else
-c
-c  Prior note is regular-dotted so this one is halved
-c
-                if (multip .eq. 0) then
-                  notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))
-                else if (multip .eq. -1) then
-                  notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))
-                else if (multip .eq. -2) then
-                  notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))
-                end if
-              end if
-              notexq = notexq(1:lnote)//noteq
-              lnote = lnote+lnoten
-            end if
-            return
-          else if (nodur(ivx,ip).eq.0) then
-c
-c  In the beamed xtup but not the last note
-c
-            if (nodur(ivx,ip-1).gt.0) then
-c
-c  Embedded Xtup, mult>0, starts here.  Put in number if needed
-c
-              nxtinbm(ivx) = nxtinbm(ivx)+1
-              iud = 1
-              if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') iud = -1
-c
-c  Get ip#, notelevel of middle note (or gap) in xtup
-c
-              ipmid = ip+ntupv(ivx,nxtinbm(ivx))/2
-              xnlmid = levrn(nolev(ivx,ipmid),irest(ivx,ipmid),iud,
-     *                       ncmid(iv,ipmid),iand(15,mult(ivx,ipmid))-8)
-              if (mod(ntupv(ivx,nxtinbm(ivx)),2).eq.0) xnlmid = (xnlmid+
-     *            levrn(nolev(ivx,ipmid-1),irest(ivx,ipmid-1),iud,
-     *            ncmid(iv,ipmid-1),iand(15,mult(ivx,ipmid-1))-8))/2
-              iflop = 0
-              if (abs(xnlmid-ncmid(iv,ip)).lt.3.) iflop = -iud
-              iup = iud+2*iflop
-              if (btest(irest(ivx,ip),14)) then
-                iup = -iup
-                iflop = 0
-                if (iud*iup .lt. 0) iflop = iup
-              end if
-c
-c  Place number if needed
-c
-              if (.not.btest(islur(ivx,ip),31)) then
-                mprint = igetbits(nacc(ivx,ip),5,22)
-                if (mprint.eq.0) mprint=mtupv(ivx,nxtinbm(ivx))
-                call putxtn(mprint,iflop,multip,iud,wheadpt,poenom,
-     *            nolev1(ivx),islope(ivx),slfac,
-     *            xnlmid,islur(ivx,ip),lnote,notexq,ncmid(iv,ip),nlnum,
-c     *            eloff(ivx,nxtinbm(ivx)),iup,irest(ivx,ip),.false.)
-     *            eloff(ivx,nxtinbm(ivx)),iup,irest(ivx,ip),
-     *            mult(ivx,ip),.false.)
-                end if
-              call notefq(noteq,lnoten,nole,ncmid(iv,ip))
-            else
-c
-c  Intermediate note of xtup
-c
-              call notefq(noteq,lnoten,nole,ncmid(iv,ip))
-            end if
-          else
-c
-c  Last note of xtup (but not last note of beam!)
-c
-            call notefq(noteq,lnoten,nole,ncmid(iv,ip))
-          end if
-        else if (btest(irest(ivx,ip),0)) then
-          call notex(notexq,lnote)
-          return
-        else
-          call notefq(noteq,lnoten,nole,ncmid(iv,ip))
-        end if
-c
-c Check if multiplicity changes in a way requiring action,
-c unless (160211) it's blank rest on start of 2nd seg of joined beam
-c
-        if(.not.btest(irest(ivx,ip-1),24)
-     *         .or..not.btest(islur(ivx,ip-1),29)) then
-          ipleft = ip-1
-          if (btest(irest(ivx,ipleft),0)) ipleft = ipleft-1
-          if (.not.btest(islur(ivx,ipleft),20)) then
-            multl = iand(15,mult(ivx,ipleft))-8
-          else
-            multl = 1
-          end if
-          mub = multip - multl
-          ipright = ip+1
-          if (btest(irest(ivx,ipright),0)) ipright = ipright+1
-          if (.not.btest(islur(ivx,ip),20)) then
-            multr = iand(15,mult(ivx,ipright))-8
-          else
-            multr = 1
-          end if
-          mua = multr-multip
-          if (mub.gt.0 .or. mua .lt. 0) then
-c
-c  Multiplicity has increased from left or will decrease to right. Need action.
-c
-            if (isbjmp .and. ivx.eq.ivbj2) then
-              ivb = ivbj1
-              ulqq = chax(225-ichar(ulq(ivx,ibmcnt(ivx))))
-            else
-              ivb = ivx
-              ulqq = ulq(ivx,ibmcnt(ivx))
-            end if
-            if (mua .ge. 0) then
-              call ntrbbb(multip,'n',ulqq,ivb,notexq,lnote)
-c            else if (multl .ge. multr) then
-c  Test for next note being blank rest, assuming staff-crossing
-c    xtup chord
-c
-            else if (multl .ge. multr .and.
-     *               .not.btest(islur(ivx,ip+1),29)) then
-              do 1 im = multip , 1+multr, -1
-                call ntrbbb(im,'t',ulqq,ivb,notexq,lnote)
-1             continue
-c            else
-c  Test for next note being blank rest, assuming staff-crossing
-c    xtup chord
-c
-            else if (.not.btest(islur(ivx,ip+1),29)) then
-              do 2 im = 1+multr, multip
-                call ntrbbb(im,'r',ulqq,ivb,notexq,lnote)
-2             continue
-              call ntrbbb(multr,'n',ulqq,ivb,notexq,lnote)
-            end if
-          else if (ip .gt. 1) then
-c
-c  Check for 2nd member of dotted xtup
-c
-            if (btest(nacc(ivx,ip-1),27)) call ntrbbb(multip+1,'t',
-     *                       ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote)
-          end if
-        end if
-c
-c Now put in the note
-c
-        if (lnote .gt. 0) then
-          notexq = notexq(1:lnote)//sq//'qb'
-        else
-          notexq = sq//'qb'
-        end if
-        lnote = lnote+3
-        isdotm = .false.
-        if (isdotted(nodur,ivx,ip)) then
-c
-c rule out ')'
-c
-          if (.not.btest(iornq(ivx,ip),13)) then
-            if (.not.btest(islur(ivx,ip),3)) then
-              notexq = notexq(1:lnote)//'p'
-            else
-c
-c  Double dot
-c
-              notexq = notexq(1:lnote)//'pp'
-              lnote = lnote+1
-            end if
-          else
-            notexq = notexq(1:lnote)//'m'
-            isdotm = .true.
-          end if
-          lnote = lnote+1
-        else if (btest(nacc(ivx,ip),19) 
-     *           .or. btest(nacc(ivx,ip),27)) then
-c
-c  Special dotted notation for 2:1 xtup, or normal dot in xtup
-c
-          notexq = notexq(1:lnote)//'p'
-          lnote = lnote+1
-        end if
-c
-c 5/25/08 Allow >12
-c
-        if (.not.(isbjmp.and.ivx.eq.ivbj2)) then
-c          call istring(mod(ivx,12),tempq,len)
-          call istring(mod(ivx,24),tempq,len)
-        else
-c          call istring(mod(ivbj1,12),tempq,len)
-          call istring(mod(ivbj1,24),tempq,len)
-        end if
-        notexq = notexq(1:lnote)//tempq(1:len)
-        lnote = lnote+len
-        notexq = notexq(1:lnote)//noteq(1:lnoten)
-        lnote = lnote+lnoten
-        if (isdotm) then
-          if (lnoten .eq. 2) then
-            notexq = notexq(1:lnote)//'{'//noteq(2:2)//'}'
-            lnote = lnote+3
-          else
-            notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1)
-            lnote = lnote+1
-          end if
-        end if
-      return
-      end
-      subroutine beamn1(notexq,lnote)
-      parameter (nm=24)
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      character*1 ulq,sepsymq,sq
-      logical beamon,firstgulp,figbass,figchk,btest,
-     *        isfig,vxtup,isdotm,isbjmp,isbj2,drawbm
-      common /comoct/ noctup
-      common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2
-      common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
-     *                 mtupv(nm,9),nxtinbm(nm),
-     *                 islope(nm),xelsk(24),eloff(nm,9),
-     *                 nssb(nm),issb(nm),lev1ssb(nm,20)
-      common /comdraw/ drawbm(nm)
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      character*8 noteq
-      character*79 notexq
-      ip1 = ipo(jn)
-      multip = iand(15,mult(ivx,ip1))-8
-c     if (multip.le.0 .and. btest(irest(ivx,ip1),0)) then
-      if (.not.drawbm(ivx) .and. btest(irest(ivx,ip1),0)) then
-        lnote = 0
-c
-c  The rest was already written in beamstrt, so just get out of here
-c
-        return
-      end if
-      nole = nolev(ivx,ipo(jn))
-c
-c  Check for special situations with 2nds (see precrd)
-c
-      if (btest(nacc(ivx,ipo(jn)),30)) then
-        nole = nole - 1
-      else if (btest(nacc(ivx,ipo(jn)),31)) then
-        nole = nole + 1
-      end if
-      if (vxtup(ivx) .and. .not.drawbm(ivx)) then
-c
-c  Xtuplet with no beam, just put in the right kind of note
-c
-        if (btest(islur(ivx,ip1),30)) then
-c
-c  Forced stem direction
-c
-          ndsav = nodur(ivx,ip1)
-          nodur(ivx,ip1) = 2**(4-multip)
-          if (btest(nacc(ivx,ip1),19) .or. 
-     *       btest(nacc(ivx,ip1),27)) nodur(ivx,ip1)=3*nodur(ivx,ip1)/2
-          call notex(notexq,lnote)
-          nodur(ivx,ip1) = ndsav
-        else
-          call notefq(noteq,lnoten,nole,ncmid(iv,ip1))
-          if (lnoten .eq. 1) call addblank(noteq,lnoten)
-          lnote = 3
-          if (multip .eq. 0) then
-            notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))
-          else if (multip .eq. -1) then
-            notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))
-          else if (multip .eq. 1) then
-            notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))
-          else if (multip .eq. 2) then
-            notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))
-            lnote = 4
-          else if (multip .eq. 3) then
-            notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))
-            lnote = 5
-          else if (multip .eq. -2) then
-            notexq = sq//'wh'
-          else if (multip .eq. -3) then
-            notexq = sq//'breve'
-            lnote = 6
-          else
-            print*
-            print*,'(Error in beamn1, send source to Dr. Don)'
-            call stop1()
-          end if
-          if (btest(nacc(ivx,ip1),19) .or. btest(nacc(ivx,ip1),27)) then 
-            notexq = notexq(1:3)//'p'
-            lnote = 4
-          end if
-          notexq = notexq(1:lnote)//noteq
-          lnote = lnote+lnoten
-        end if
-        return
-      end if
-c
-c  Check if mult. decreases from 1st note to 2nd
-c
-      if (ibm2(ivx,ibmcnt(ivx)).gt.ip1 
-     *           .or. btest(islur(ivx,ip1),20)) then
-c
-c  More than one note or single-note before a multiplicity-down-up "]["
-c
-        if (btest(islur(ivx,ip1),20)) then
-          multr = 1
-        else if (.not.btest(irest(ivx,ip1+1),0)) then
-          multr = iand(15,mult(ivx,ip1+1))-8
-        else
-          multr = iand(15,mult(ivx,ip1+2))-8
-        end if
-        lnote = 0
-        if (multr .lt. multip) then
-          do 1 im = multip , multr+1 , -1
-            call ntrbbb(im,'r',ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote)
-1         continue
-        end if
-      end if
-c
-c  Put in the note
-c
-      if (lnote .gt. 0) then
-        notexq = notexq(1:lnote)//sq//'qb'
-      else
-        notexq = sq//'qb'
-      end if
-      lnote = lnote+3
-c
-c  Check for dot
-c
-      isdotm = .false.
-      if (.not.vxtup(ivx)) then
-        nd = nodur(ivx,ipo(jn))
-        if (nd.ne.0) then
-          if (2**log2(nd).ne.nd) then
-            if (.not.btest(iornq(ivx,ip1),13)) then
-              if (.not.btest(islur(ivx,ip1),3)) then
-                notexq = notexq(1:lnote)//'p'
-              else
-c
-c  Double dot
-c
-                notexq = notexq(1:lnote)//'pp'
-                lnote = lnote+1
-              end if
-            else
-              notexq = notexq(1:lnote)//'m'
-              isdotm = .true.
-            end if
-            lnote = lnote+1
-          end if
-        end if
-      else if (btest(nacc(ivx,ip1),19) .or. 
-     *               btest(nacc(ivx,ip1),27)) then
-c
-c  In an xtup with special 2:1 notation with a dot on 1st note, or normal dot
-c
-        notexq = notexq(1:lnote)//'p'
-        lnote = lnote+1
-      end if
-c
-c  Do the number; 0 if 12
-c
-c  5/25/08 allow >12
-c
-      if (.not.btest(irest(ivx,ip1),24)) then
-c        call istring(mod(ivx,12),noteq,len)
-        call istring(mod(ivx,24),noteq,len)
-      else
-c        call istring(mod(ivbj1,12),noteq,len)
-        call istring(mod(ivbj1,24),noteq,len)
-      end if
-      notexq = notexq(1:lnote)//noteq(1:len)
-      lnote = lnote+len
-      call notefq(noteq,lnoten,nole,ncmid(iv,ip1))
-      notexq = notexq(1:lnote)//noteq(1:lnoten)
-      lnote = lnote+lnoten
-      if (isdotm) then
-        if (lnoten .eq. 1) then
-          notexq = notexq(1:lnote)//'{'//noteq(1:1)//'}'
-          lnote = lnote+3
-        else
-          notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1)
-          lnote = lnote+1
-        end if
-      end if
-      return
-      end
-      subroutine beamstrt(notexq,lnote,nornb,ihornb,space,squez,ib)
-      parameter (nm=24)
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      character*1 ulq,sepsymq,sq
-      character*40 restq
-      character*79 inameq
-      logical beamon,firstgulp,figbass,figchk,btest,
-     *        isfig,vxtup,bar1syst,addbrack,flipend,xto,drawbm
-      common /comeskz2/ eskz2(nm,200)
-      common /comoct/ noctup
-      common /strtmid/ ihnum3,flipend(nm),ixrest(nm)
-      common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
-     *                 mtupv(nm,9),nxtinbm(nm),
-     *                 islope(nm),xelsk(24),eloff(nm,9),
-     *                 nssb(nm),issb(nm),lev1ssb(nm,20)
-      common /comdraw/ drawbm(nm)
-      common /comas1/ naskb,task(40),wask(40),elask(40)
-      common /comask/ bar1syst,fixednew,scaldold,
-     *                wheadpt,fbar,poenom
-      common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
-     *   isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
-     *   lnam(nm),inameq(nm)
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-c
-c  The following is just to save the outputs from SetupB for the case of
-c  xtups starting with a rest, where beamstrt is called twice.
-c
-      common /comipb/ nnb,sumx,sumy,ipb(24),smed
-      character*1 chax
-      character*8 noteq
-      character*79 notexq,tempq
-      integer nornb(nm),ihornb(nm,24)
-      real*4 space(80),squez(80)
-      logical novshrinktop,cstuplet,usexnumt,writebrests
-      common /comnvst/ novshrinktop,cstuplet
-      common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
-     *                fullsize(nm),ivxfig2,ivvfig(2,74)
-      character*10 figq
-      common /xjbeambrests/ nbrests
-      writebrests = .true.
-      ibc = ibmcnt(ivx)
-      ipb1 = ibm1(ivx,ibc)
-      multb = iand(15,mult(ivx,ipb1))-8
-      ip = ipo(jn)
-c
-c  Compute slopes and note offsets from start of beam.  Inside SetupB, for each
-c  xtup in the beam, set eloff,mtupv (in comxtup) for printed number.
-c
-      if (ixrest(ivx).eq.0 .and. .not.btest(nacc(ivx,ip),21)) 
-     *      call SetupB(xelsk,nnb,sumx,sumy,ipb,smed,ixrest(ivx))
-      if (btest(nacc(ivx,ip),21)) then
-c
-c  This is start of later segment of single-slope beam group so use slope and 
-c    height from prior beam.   Slope is already OK.
-c
-        issb(ivx) = issb(ivx)+1  
-        nolev1(ivx) = lev1ssb(ivx,issb(ivx))
-      end if
-      lnote = 0
-      drawbm(ivx) = .true.
-      if (btest(irest(ivx,ipb1),28) .and. ixrest(ivx).ne.2) then
-        vxtup(ivx) = .true.
-        nxtinbm(ivx) = nxtinbm(ivx)+1
-c
-c  irest(28)=>Xtup starts on this note.  Set up for xtuplet.
-c  Number goes on notehead side at middle note (or gap) of xtup, unless that
-c  puts it in staff, then it flops to stem (or beam) side.
-c               __          __
-c         |    |  |   O    |  |
-c         O      |    |      O
-c       |___|    O  |__|     |
-c
-c  iud   -1     -1    1      1    ...stem direction
-c iflop   0      1   -1      0    ...direction of flop
-c  iup   -1      1   -1      1    ...direction of number and bracket
-c
-        iud = 1
-        if (ulq(ivx,ibc) .eq. 'u') iud = -1
-c
-c  Get ip#, note level of middle note (or gap) in xtup
-c
-        ipmid = ipb1+ntupv(ivx,nxtinbm(ivx))/2
-c
-c  130129 If middle note is a rest, go to next note. Note last note cannot
-c    be a rest
-c
-14      continue
-        if (btest(irest(ivx,ipmid),0)) then
-          ipmid = ipmid+1
-          go to 14
-        end if
-        xnlmid = levrn(nolev(ivx,ipmid),irest(ivx,ipmid),iud,
-     *                 ncmid(iv,ipmid),iand(15,mult(ivx,ipmid))-8)
-        if (mod(ntupv(ivx,nxtinbm(ivx)),2) .eq. 0) xnlmid = (xnlmid+
-     *            levrn(nolev(ivx,ipmid-1),irest(ivx,ipmid-1),iud,
-     *            ncmid(iv,ipmid-1),iand(15,mult(ivx,ipmid-1))-8))/2
-        iflop = 0
-        if (abs(xnlmid-ncmid(iv,ipb1)).lt.3.) iflop = -iud
-        iup = iud+2*iflop
-        if (btest(irest(ivx,ipb1),14)) then
-c
-c  Alter iud, iflop, iup to flip number/bracket. (Stare at above pic)
-c
-          iup = -iup
-          iflop = 0
-          if (iud*iup .lt. 0) iflop = iup
-        end if
-c
-c  Determine if a beam is to be drawn
-c
-        do 5 ipp = ibm1(ivx,ibc),ibm2(ivx,ibc)
-          if (iand(15,mult(ivx,ipp))-8 .le. 0) then
-            drawbm(ivx) = .false.
-            go to 6
-          end if
-5       continue
-        drawbm(ivx) = .not.btest(islur(ivx,ibm1(ivx,ibc)),18)
-6       continue
-c
-c Are we using tuplet.tex?
-c
-        usexnumt = cstuplet .and. .not.drawbm(ivx)
-c
-c  Place xtup number if needed
-c
-        if (.not.btest(islur(ivx,ipb1),31) .or. multb.le.0) then 
-          mprint = igetbits(nacc(ivx,ip),5,22)
-          if (mprint.eq.0) mprint=mtupv(ivx,nxtinbm(ivx))
-          call putxtn(mprint,iflop,multb,iud,wheadpt,
-     *      poenom,nolev1(ivx),islope(ivx),slfac,xnlmid,islur(ivx,ipb1),
-     *      lnote,notexq,ncmid(iv,ipb1),nlnum,eloff(ivx,nxtinbm(ivx)),
-c     *      iup,irest(ivx,ipb1),usexnumt)
-     *      iup,irest(ivx,ipb1),mult(ivx,ipb1),usexnumt)
-        end if
-        if (.not.drawbm(ivx)) then
-c
-c  Xtuplet with no beam
-c
-          if (.not.btest(islur(ivx,ipb1),31)) then
-c
-c  Number printing has not been suppressed, so put in the bracket. 
-c    scale = stretch factor for bracket if there are asx's
-c    xnsk = length of the bracket in \noteskips = (\elemskips)/(eon)
-c
-            xnsk = (eskz2(ivx,ipb1+ntupv(ivx,nxtinbm(ivx))-1)
-     *          -eskz2(ivx,ipb1))/squez(ib)/feon(space(ib)/squez(ib))
-            if (iup .eq. 1) then
-              if (lnote .gt. 0) then
-                notexq = notexq(1:lnote)//sq//'ovbkt'
-              else
-                notexq = sq//'ovbkt'
-              end if
-            else
-              if (lnote .gt. 0) then
-                notexq = notexq(1:lnote)//sq//'unbkt'
-              else
-c
-c  Introduced 12/5/98, req'd due to possible presence of in-line TeX
-c
-                notexq = sq//'unbkt'
-              end if
-            end if
-            lnote = lnote+6
-            if (iline.eq.1) then
-              smed = smed/(1.-fracindent)
-            end if
-            xslope = 1.8*smed*slfac
-            islope(ivx) = nint(xslope)
-            nolev1(ivx) = nlnum - nint(smed*eloff(ivx,1))
-            if (islope(ivx) .eq. 0) nolev1(ivx) = nolev1(ivx)-1
-            if (iup .eq. 1) nolev1(ivx) = nolev1(ivx)+4
-            levbracket = nolev1(ivx)
-            if (iup.eq.1 .and. cstuplet) levbracket = levbracket-1
-            call notefq(noteq,lnoten,levbracket,ncmid(iv,ipb1))
-            if (lnoten .eq. 1) call addblank(noteq,lnoten)
-            notexq = notexq(1:lnote)//noteq(1:lnoten)//'{'
-            lnote = lnote+lnoten+1
-            if (xnsk .lt. 0.995) then
-              write(notexq(lnote+1:lnote+4),'(i1,f3.2)')0,xnsk
-              lnote = lnote+4
-            else if (xnsk .lt. 9.995) then
-              write(notexq(lnote+1:lnote+4),'(f4.2)')xnsk
-              lnote = lnote+4
-            else
-              write(notexq(lnote+1:lnote+5),'(f5.2)')xnsk
-              lnote = lnote+5
-            end if
-            notexq = notexq(1:lnote)//'}'
-            lnote = lnote+1
-            if (btest(mult(ivx,ipb1),4)) then
-c
-c Tweak slope of bracket
-c
-              islope(ivx) = islope(ivx)+igetbits(mult(ivx,ipb1),5,5)-16
-            end if
-            if (islope(ivx).lt.0 .or. islope(ivx).ge.10) then
-              notexq = notexq(1:lnote)//'{'
-              lnote = lnote+1
-              if (islope(ivx) .lt. -9) then
-                write(notexq(lnote+1:lnote+3),'(i3)')islope(ivx)
-                lnote = lnote+3
-              else
-                write(notexq(lnote+1:lnote+2),'(i2)')islope(ivx)
-                lnote = lnote+2
-              end if
-              notexq = notexq(1:lnote)//'}'
-              lnote = lnote+1
-            else
-              write(notexq(lnote+1:lnote+1),'(i1)')islope(ivx)
-              lnote = lnote+1
-            end if
-c
-c  Done with bracket
-c
-          end if
-          if (ixrest(ivx) .eq. 1) then
-c
-c  Put in the rest.  Possible problem: Rest is a spacing char, but between
-c  beamstrt and beamn1 some non-spacing chars. are inserted.
-c
-c  130126 Deal with vertical shifts of rest starting xtuplet
-c
-c            if (multb .eq. 0) then
-c              notexq = notexq(1:lnote)//sq//'qp'
-c              lnote = lnote+3
-c            else if (.not.drawbm(ivx).and.multb.eq.1) then
-c              notexq = notexq(1:lnote)//sq//'ds'
-c              lnote = lnote+3
-c            else if (.not.drawbm(ivx).and.multb.eq.2) then
-c              notexq = notexq(1:lnote)//sq//'qs'
-c              lnote = lnote+3
-c            else if (.not.drawbm(ivx).and.multb.eq.3) then
-c              notexq = notexq(1:lnote)//sq//'hs'
-c              lnote = lnote+3
-c            else
-c              notexq = notexq(1:lnote)//sq//'hpause'
-c              lnote = lnote+7
-c            end if
-
-            lrest = 3
-            if (multb .eq. 0) then
-              restq = sq//'qp'
-            else if (.not.drawbm(ivx).and.multb.eq.1) then
-              restq = sq//'ds'
-            else if (.not.drawbm(ivx).and.multb.eq.2) then
-              restq = sq//'qs'
-            else if (.not.drawbm(ivx).and.multb.eq.3) then
-              restq = sq//'hs'
-            else
-              restq = sq//'hpause'
-              lrest = 7
-            end if
-            nole = mod(nolev(ivx,ip)+20,100)-20
-            if (nole .eq. 0) then
-c
-c Rest is not raised
-c
-              notexq = notexq(1:lnote)//restq
-              lnote = lnote+lrest
-            else
-              if (abs(nole) .lt. 10) then
-                tempq = chax(48+abs(nole))
-                ltemp = 1
-              else
-                write(tempq(1:2),'(i2)')abs(nole)
-                ltemp = 2
-              end if
-              if (nole .gt. 0) then
-                tempq = sq//'raise'//tempq(1:ltemp)//sq//'internote'
-              else
-                tempq = sq//'lower'//tempq(1:ltemp)//sq//'internote'
-              end if
-              ltemp = 16+ltemp
-              notexq = notexq(1:lnote)//tempq(1:ltemp)//restq(1:lrest)
-              lnote = lnote+ltemp+lrest
-            end if
-c
-c  No need to come back through this subroutine (as would if rest starts bar
-c  & multb>0), so do not advance ibm1. But must check in beamn1 and do nothing.
-c
-            ixrest(ivx) = 0
-          end if
-          return
-        end if
-c
-c  End if block for non-beamed xtup start...note we returned
-c
-        if (ixrest(ivx) .eq. 1) then
-c
-c  Insert rest at start of beamed xtup.  See above note for possible problem.
-c  But first check if blank rest and if in forced beam (assuming xtuplet),
-c    and if so, count rest from beginning, add \sk's AFTER starting beam '\ib*'
-c
-          if (btest(islur(ivx,ip),29) .and. btest(ipl(ivx,ip),30)) then
-            nbrests = nbrests+1
-            writebrests = .false.
-          else
-            nodur(ivx,ipb1) = 2**(4-multb)
-            call notex(tempq,ltemp)
-            if (lnote .gt. 0) then
-              notexq = notexq(1:lnote)//tempq(1:ltemp)
-            else
-              notexq = tempq(1:ltemp)
-            end if
-            lnote = lnote+ltemp
-          end if
-c
-c  Re-zero just in case!
-c
-          nodur(ivx,ipb1) = 0
-          ibm1(ivx,ibc) = ibm1(ivx,ibc)+1
-c
-c  See if next note is a non-rest
-c
-          if (.not.btest(irest(ivx,ipb1+1),0)) then
-            ixrest(ivx) = 2
-          else
-c
-c  Suppress reprinting xtup number next time through beamstrt
-c
-            islur(ivx,ipb1+1) = ibset(islur(ivx,ipb1+1),31)
-c
-c  Set new xtup start flag
-c
-            irest(ivx,ipb1+1) = ibset(irest(ivx,ipb1+1),28)
-          end if
-          return
-        end if
-      end if
-c
-c  Just ended if block for xtups
-c
-      if (vxtup(ivx) .and. ipb1.eq.ibm2(ivx,ibc)) then
-c
-c  Move actual note writing to beamend
-c
-        ixrest(ivx) = 4
-        return
-      end if
-      if (issb(ivx) .eq. 0) then
-c
-c  1st bmstrt in single-slope bm grp, Adjust start level(s) and slope if needed
-c
-        iadj = igetbits(ipl(ivx,ipb1),6,11)-30
-        if (iadj .ne. -30) then 
-          nolev1(ivx) = nolev1(ivx)+iadj
-          do 2 isssb = 1 , nssb(ivx)
-            lev1ssb(ivx,isssb) = lev1ssb(ivx,isssb)+iadj
-2         continue
-        end if
-        iadj = igetbits(ipl(ivx,ipb1),6,17)-30
-        if (iadj .ne. -30) then
-          islope(ivx) = islope(ivx)+iadj
-          if (abs(islope(ivx)) .gt. 9) islope(ivx) = sign(9,islope(ivx))
-          if (nssb(ivx) .gt. 0) then
-c
-c  Cycle thru non-rest notes in SSBG, looking for bmstrts.
-c
-            isssb = 0
-            do 4 inb = 2, nnb
-              if (btest(nacc(ivx,ipb(inb)),21)) then
-c
-c  Beam segment start.  New start level              
-                isssb = isssb+1
-                lev1ssb(ivx,isssb) = 
-     *           lev1ssb(ivx,isssb)+islope(ivx)*xelsk(inb)/slfac
-              end if
-4           continue
-          end if
-        end if
-      end if
-      iadj = igetbits(islur(ivx,ipb1),2,27)
-      addbrack = .false.
-      if (btest(ipl(ivx,ipb1),30)) then
-c
-c  Check for altered starting polarity.  Only in forced beams. Nominal start
-c  level is nolev1. So beam level is nolev1 +/- 6, to be compared w/ nolev(.,.).
-c
-        if (ulq(ivx,ibc).eq.'u' .and.
-     *                  nolev1(ivx)+6.lt.nolev(ivx,ipb1)) then
-          if (lnote .eq. 0) then
-            notexq = sq//'loff{'
-          else
-            notexq = notexq(1:lnote)//sq//'loff{'
-          end if
-          lnote = lnote+6
-          addbrack = .true.
-        else if (ulq(ivx,ibc).eq.'l' .and.
-     *                  nolev1(ivx)-6.gt.nolev(ivx,ipb1)) then
-          if (lnote .eq. 0) then
-            notexq = sq//'roff{'
-          else
-            notexq = notexq(1:lnote)//sq//'roff{'
-          end if
-          lnote = lnote+6
-          addbrack = .true.
-        end if
-c
-c  Check end level for possible flipping in forced beam.  Have to do it 
-c  here since with multiple voices, xelsk will not be preserved.
-c
-        if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then
-          bmlev = nolev1(ivx)+6+islope(ivx)*xelsk(nnb)/slfac
-          flipend(ivx) = bmlev.lt.nolev(ivx,ibm2(ivx,ibc))
-        else if (ulq(ivx,ibmcnt(ivx)) .eq. 'l') then
-          bmlev = nolev1(ivx)-6+islope(ivx)*xelsk(nnb)/slfac
-          flipend(ivx) = bmlev.gt.nolev(ivx,ibm2(ivx,ibc))
-        end if
-      end if
-      call ntrbbb(multb+iadj,'i',ulq(ivx,ibc),ivx,notexq,lnote)
-c
-c   Put in name of start level and slope, after correcting nolev1 if xtup
-c   started with a rest.
-c
-      if (ixrest(ivx).eq.2) nolev1(ivx) = 
-     *          nint(nolev1(ivx)+xelsk(1)*islope(ivx)/slfac)
-      call notefq(noteq,lnoten,nolev1(ivx),ncmid(iv,ipb1))
-      if (islope(ivx) .lt. 0) then
-        notexq = notexq(1:lnote)//noteq(1:lnoten)//'{'
-        lnote = lnote+4+lnoten
-        write(notexq(lnote-2:lnote),'(i2,a1)')islope(ivx),'}'
-      else
-        notexq = notexq(1:lnote)//noteq(1:lnoten)
-        lnote = lnote+1+lnoten
-        write(notexq(lnote:lnote),'(i1)')islope(ivx)
-      end if
-c
-c  Check for beam-thk fine-tuning
-c
-      if (iadj .gt. 0) then
-        do 1 imp = multb+iadj , multb+1 , -1
-          call ntrbbb(imp,'t',ulq(ivx,ibc),ivx,notexq,lnote)
-1       continue
-      end if
-c
-c  If we shifted, must close with right bracket
-c
-      if (addbrack) then
-        notexq = notexq(1:lnote)//'}'
-        lnote = lnote+1
-      end if
-c
-c  Add in \sk's for very special case of staff-crossing xtup chords
-c  Assumes we are in lower (first) voice of up-to-both beamed xtup
-c    that starts with blank rests (notes in upper voice here).
-c
-      if (nbrests.gt.0 .and. writebrests) then
-        do 7 isk = 1 , nbrests
-          notexq = notexq(1:lnote)//chax(92)//'sk'
-          lnote = lnote+3
-7       continue
-        nbrests = 0
-      end if
-c
-c  Get 'floor' zmin for figures
-c  Note: Will not come thru here on 1st note of unbeamed xtup, so figure height
-c    won't be adjusted. If anyone ever needs that, need to duplicate this
-c    functionality up above, before exiting.
-c
-      if (figbass .and. (ivx.eq.1 .or. ivx.eq.ivxfig2)) then
-        if (ivx .eq. 1) then
-          ivf = 1
-        else
-          ivf = ivxfig2
-        end if
-        zmult = 1.2*(multb-1)
-        ymin = 100.
-        do 3 inb = 1, nnb
-          if (isfig(ivf,ipb(inb))) then
-            if (ulq(iv,ibc) .eq. 'u') then
-              ybot = nolev(iv,ipb(inb))
-            else
-              ybot = islope(ivx)/slfac*xelsk(inb)+nolev1(ivx)
-     *                -stemlen-zmult
-            end if
-            ymin = min(ymin,ybot)
-          end if
-3       continue
-        maxdrop = ncmid(iv,ipb1)-4-ymin+5.01
-        ifigdr(ivf,iline) = max(ifigdr(ivf,iline),maxdrop)
-      end if
-c
-c  Compute ornament levels if needed
-c
-      NomOrnLev = ncmid(iv,ipb1)+5
-      iorn = 0
-      do 8 inb = 1 , nnb
-        ip = ipb(inb)
-        if (.not.btest(iornq(ivx,ip),23)) go to 8
-        if (btest(irest(ivx,ip),26) .and. ulq(ivx,ibc).eq.'l') then
-c
-c  letter-dynamic or hairpin ending under down-beamed 
-c
-          iorn = iorn+1
-          ybeam = nolev1(ivx)-stemlen+islope(ivx)*xelsk(inb)/slfac+1
-     *                  -1.2*(multb-1)
-          ihornb(ivx,iorn) = min(nint(ybeam-3.),NomOrnLev-10)
-        else if (.not.btest(ipl(ivx,ip),10)) then
-c
-c  Bits 0-13: (stmgx+Tupf._) , 14: Down fermata, was F
-c  15: Trill w/o "tr", was U , 16-18 Editorial s,f,n , 19-21 TBD
-c
-c  Non-chord.  There IS an ornament.  Need ihornb only if upbeam, and if
-c  ornament is 1,2,3,5,6,7,8,9,10,15-21 (up- but not domn ferm.)
-c
-          if (ulq(ivx,ibc).eq.'u' .and.
-     *          iand(iornq(ivx,ipb(inb)),4163566).gt.0) then
-            iorn = iorn+1
-            iornq(ivx,ip) = ibset(iornq(ivx,ip),22)
-            ybeam = nolev1(ivx)+stemlen+islope(ivx)*xelsk(inb)/slfac-1
-     *                  +1.2*(multb-1)
-            ihornb(ivx,iorn) = max(nint(ybeam+3.),NomOrnLev)
-          end if
-        else
-c
-c In a chord.  Orn may be on main note or non-main or both.  Set ihornb if
-c upbeam and highest note has orn, or down beam and lowest.  Find 1st chord note
-c
-          do 10 icrd1 = 1 , ncrd
-            if (iand(255,icrdat(icrd1)) .eq. ip  .and.
-     *           iand(15,ishft(icrdat(icrd1),-8)) .eq. ivx) go to 11
-10        continue
-11        continue
-c
-c Find outermost note, min or max depending on beam direction ulq.  xto is true
-c if there's an ornament on that note.  Expand orn list to include ._, since if
-c on extreme chord note in beam, will move.
-c So ornaments are all except 0,4,13 (,g,)
-c
-          levx = nolev(ivx,ip)
-          xto = iand(iornq(ivx,ipb(inb)),4186094).gt.0
-          icrdx = 0
-          do 12 icrd = icrd1 , ncrd
-            if (iand(255,icrdat(icrd)) .ne. ip  .or.
-     *               iand(15,ishft(icrdat(icrd),-8)) .ne. ivx) go to 13
-            levc = iand(127,ishft(icrdat(icrd),-12))
-            if ((ulq(ivx,ibc).eq.'u'.and.levc.gt.levx) .or.
-     *            (ulq(ivx,ibc).eq.'l'.and.levc.lt.levx)) then
-              levx = levc
-              icrdx = icrd
-              xto = iand(icrdorn(icrd),4186094).gt.0
-            end if
-12        continue
-13        continue
-c
-c  If there's orn on extreme note, do stuff
-c
-          if (xto) then
-            iorn = iorn+1
-            if (ulq(ivx,ibc) .eq. 'u') then
-              ybeam = nolev1(ivx)+stemlen+islope(ivx)*xelsk(inb)/slfac-1
-     *                  +1.2*(multb-1)
-              ihornb(ivx,iorn) = max(nint(ybeam+3.),NomOrnLev)
-            else
-              ybeam = nolev1(ivx)-stemlen+islope(ivx)*xelsk(inb)/slfac+1
-     *                  -1.2*(multb-1)
-              ihornb(ivx,iorn) = min(nint(ybeam-3.),NomOrnLev-10)
-            end if
-            if (icrdx .eq. 0) then
-c
-c  Affected ornament is on main note
-c
-              iornq(ivx,ip) = ibset(iornq(ivx,ip),22)
-            else
-              icrdorn(icrdx) = ibset(icrdorn(icrdx),22)
-            end if
-          end if
-        end if
-8     continue
-c
-c  Henceforth nornb will be a counter.
-c
-      if (iorn .gt. 0) nornb(ivx)=1
-      if (ixrest(ivx) .eq. 2) ixrest(ivx) = 0
-      return
-      end
-      block data
-	parameter (nm=24)
-      common /comtol/ tol
-      common /comtrans/ cheadq
-      common /compage/ widthpt,ptheight,hoffpt,voffpt,
-     *      nsyst,nflb,ibarflb(0:40),
-     *      isysflb(0:40),npages,nfpb,ipagfpb(0:18),isysfpb(0:18),
-     *      usefig,fintstf,gintstf,fracsys(30),nmovbrk,isysmb(0:30),
-     *      nistaff(0:40)
-      common /cblock/
-     *      etatop,etabot,etait,etatc,etacs1,hgtin,hgtti,hgtco,
-     *      xilbn,xilbtc,xilhdr,xilfig,a,b,inhnoh
-      common /cominbot/ inbothd
-      logical usefig
-      common /comstart/ facmtr
-      character*60 cheadq
-      character*120 instrq,titleq,compoq
-      logical headlog
-      common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip,
-     *    inhead
-      common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
-     *                flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
-     *                rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
-     *                rtshfac
-      common /combmh/ bmhgt,clefend
-      common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12),
-     *        hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41),
-     *        idynda2(99),levhssav(nm),listcresc,listdecresc
-      character*128 txtdynq
-      logical kbdrests
-      common /comkbdrests/ levbotr(8),levtopr(8),kbdrests
-      common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
-     *  instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
-      logical EarlyTransOn,LaterInstTrans
-      common /comsize/ isize(nm)
-c
-      data tol /.001/
-      data cheadq 
-     *  /'                                                            '/
-      data gslfac /9./
-      data instrq,titleq,compoq,headlog /3*' ',.false./
-c
-c  meter space (pts) = xb4mbr = musicsize*facmtr
-c
-      data facmtr /0.55/
-      data grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
-     *                flagfac,dotfac,bacfac,agc1fac,clefend,bmhgt
-     * / 1.3333,.4   ,   .7 ,  .3  ,  0.2 ,  2.0 , 1.0 ,
-     *               .7,.7 ,.9 ,.5 ,2.3 ,1.1  /
-      data rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,arpfac
-     *  /   1.32 ,  2.25   ,  0.47 , 0.83  ,   0.17 , 0.5 ,  1.7   /
-      data rtshfac / 1.0 /
-      data isize /nm*0/
-c
-c  From other
-c
-      data ptheight,widthpt,hoffpt,voffpt,
-     *      etatop,etabot,etait,etatc,etacs1,hgtin,hgtti,hgtco,
-     *      xilbn,xilbtc,xilhdr,xilfig,a,b,inbothd,inhnoh
-     *   / 740. , 524. , 0., 0.,
-     *   .50  ,  .25  , 0.4 , 0.4  , 0.2 , 12. ,21. , 12.,
-     *    4   ,   1.6 ,5.,5.7,1.071,2.714,16 ,16 /
-      data fracsys /30*0./
-	data ivowg,hoh1,hoh2,hoh2h1 /0,0,0,0,0,1,1,1,1,1,1,1,
-c     *   2.0,1.5,1.0,0.5,1.3,1.3,0.4,0.8,1.2,0.8,1.2,1.6,
-     *   2.2,1.7,1.2,0.7,1.3,1.3,0.4,0.8,1.2,0.8,1.2,1.6,
-     *   -2.7,-2.2,-1.7,-1.2,-2.3,-2.1,-1.0,-1.7,-2.1,-1.6,-1.9,-2.3,
-     *   -0.3,0.3 / 
-      data kbdrests /.false./, 
-     *       levtopr /9,7,5,5,7,5,6,6/, levbotr /0,0,0,2,1,4,5,4/
-      data EarlyTransOn, LaterInstTrans /2*.false./
-      data iInstTrans /nm*0/
-      data iTransAmt /nm*0/
-      end
-      subroutine catspace(space,squez,nnsk)
-      parameter (nkb=3999,maxblks=4000)
-      common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks),
-     *     iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr,
-c     *     ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks)
-     *     ibaroff,udsp(nkb),wheadpt,sqzb(maxblks)
-      common /comtol/ tol
-c      logical gotclef
-      do 16 iptr = nptr(ibarcnt) , nptr(ibarcnt+1)-1
-        if (abs(space-durb(iptr)) .lt. tol) then
-          if (abs(squez-sqzb(iptr)) .lt. tol) then
-c
-c  Increment pre-existing entry
-c
-            nnpd(iptr) = nnpd(iptr)+nnsk
-            return
-          end if
-        end if
-16    continue
-c
-c  Didn't find current duration & squez, so add a new entry.
-c  No particular reason to keep in order, so add at the end.
-c
-      nnpd(nptr(ibarcnt+1)) = nnsk
-      durb(nptr(ibarcnt+1)) = space
-      sqzb(nptr(ibarcnt+1)) = squez
-      nptr(ibarcnt+1) = nptr(ibarcnt+1)+1
-      return
-      end
-      character*1 function chax(n)
-c
-c The only reason for this seemingly do-nothing function is to get around an
-c  apparent bug in the Visual Fortran Standard Edition 5.0.A compiler!
-c
-      chax = char(n)
-      return
-      end
-      subroutine checkdyn(lineq,iccount,ibar)
-      character*128 lineq
-      character*1 durq,chax
-      character*4 dynsymq
-      logical txtdyn
-      txtdyn = .false.
-c
-c  On entry, iccount is on "D"
-c
-      if (lineq(iccount+1:iccount+1) .eq. '"') then
-c
-c  Dynamic text
-c
-        iend = index(lineq(iccount+2:128),'"')
-        if (iend .eq. 0) then
-          call errmsg(lineq,iccount+1,ibar,
-     *         'Dynamic text must be terminated with double quote!')
-          call stop1()
-        end if
-c
-c  Set iccount to character after 2nd ", and set ipm
-c
-        iccount = iccount+iend+2 
-        ipm = index('- +',lineq(iccount:iccount))
-        if (ipm .eq. 0) then
-          call errmsg(lineq,iccount,ibar,
-     *                'Expected "-", "+", or blank here!')
-          call stop1()
-        end if
-      else
-c
-c  Expect ordinary dynamic
-c
-        do 1 iend = iccount+2 , 128
-          ipm = index('- +',lineq(iend:iend))
-          if (ipm .gt. 0) go to 2
-1       continue
-2       continue
-        if (iend-iccount.gt.5 .or. iend-iccount.lt.2) then
-          call errmsg(lineq,iend-1,ibar,
-     *                'Wrong length for dynamic mark!')
-          call stop1()
-        end if
-        read(lineq(iccount+1:iend-1),'(a'//chax(47+iend-iccount)//')')
-     *     dynsymq
-        idno = (index(
-     *    'ppppppp pp  p   mp  mf  f   fp  sfz ff  fff ffff<   >   ',
-     *         dynsymq)+3)/4
-        if (idno .eq. 0) then
-          call errmsg(lineq,iccount+1,ibar,'Illegal dynamic mark!')
-          call stop1()
-        end if
-        iccount = iend
-      end if
-      if (ipm .ne. 2) then
-c
-c  There is a vertical shift, have "+" or "-"
-c
-        iccount = iccount+1
-        if (index('0123456789',lineq(iccount:iccount)) .eq. 0) then
-          call errmsg(lineq,iccount,ibar,
-     *       'Expected integer here for vertical offset!')
-          call stop1()
-        end if
-        call readnum(lineq,iccount,durq,fnum)
-        idno = nint(fnum)
-        if (idno .gt. 63) then
-          call errmsg(lineq,iccount-1,ibar,
-     *      'Vertical offset for dynamic mark must be (-63,63)!')
-          call stop1()
-        end if
-        ipm = index('- +',durq)
-        if (ipm .eq. 0) then
-          call errmsg(lineq,iccount,ibar,
-     *      'Expected "+", "-", or blank here!')
-          call stop1()
-        end if
-        if (ipm .ne. 2) then
-c
-c  There is a horizontal shift
-c
-          iccount = iccount+1
-          if (index('.0123456789',lineq(iccount:iccount)) .eq. 0) then
-            call errmsg(lineq,iccount,ibar,
-     *       'Expected number here for horizontal offset!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          idno = nint(10*fnum)
-          if (idno .gt. 255) then
-            call errmsg(lineq,iccount-1,ibar,
-     *       'Horizontal offset for dynamic mark must be (-25.5,25.5)!')
-            call stop1()
-          else if (durq .ne. ' ') then
-            call errmsg(lineq,iccount,ibar,
-     *        'There should be a blank here!')
-            call stop1()
-          end if
-        end if
-c
-c  iccount should be on the blank at the end of the entire symbol
-c
-      end if
-      return
-      end
-      subroutine chkarp(ncrd,icrdat,ivx,ip,iscacc,isarp)
-c      subroutine chkarp(found1,ncrd,icrdat,icrdot,ivx,ip,isacc,isarp,
-c     *                  icashft)
-      logical found1,iscacc,isarp,btest
-      integer icrdat(193)
-      found1 = .false.
-c
-c  icashft will be max left shift of accid's in chord notes.
-c  Used only for spacing checks.
-c  Will include left shift of chord note itself.
-c  Rezero after use.
-c
-      do 18 icrd = 1 , ncrd
-c
-c  This if block cycles thru all chord notes on ivx,ip; then returns.
-c
-        if (iand(255,icrdat(icrd)) .eq. ip  .and.
-     *          iand(15,ishft(icrdat(icrd),-8)) .eq. ivx) then
-          found1 = .true.
-          iscacc = iscacc .or. 
-     *       (btest(icrdat(icrd),19).and..not.btest(icrdat(icrd),27)) 
-c
-c  Accid on this chord note, and it's not midi-only.
-c
-c            irshft = igetbits(icrdot(icrd),7,20)
-cc
-cc  Include increment for notehead shift
-cc
-c            if (btest(icrdat(icrd),23)) then
-c              if (irshft .eq. 0) then
-c                irshft = 44
-c              else
-c                irshft=irshft-20
-c              end if
-c            end if
-c            if (irshft .ne. 0) then
-cc
-cc  Accid on chord note is shifted.  Include only left shift, in 20ths.
-cc
-c              if (irshft .lt. 64) icashft = max(icashft,64-irshft)
-c            end if
-c          end if
-          isarp = isarp .or. btest(icrdat(icrd),25)
-        else if (found1) then
-          return
-        end if
-18    continue
-      return
-      end
-      subroutine chkimidi(icm)
-      parameter (nm=24,mv=24576)
-      integer*2 mmidi
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      if (imidi(icm) .ge. mv) then
-        print*
-        print*,'Midi file is too long! It will be corrupted or worse'
-        write(*,'(a6,2x,4i8)')
-     *        'imidi:',imidi(0),imidi(1),imidi(2),imidi(3)
-      end if
-      return
-      end
-      subroutine chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,ivmx,
-c     * nib,nv,ibar,tnow,tol,nodur,mode,levtopr,levbotr,mult)
-     * nib,nv,ibar,tnow,tol,nodur,mode,levtopr,levbotr,mult,ipl)
-      parameter (nm=24)
-      integer*4 nn(nm),islur(nm,200),irest(nm,200),
-     * nolev(nm,200),nib(nm,15),nodur(nm,200),levbotr(8),levtopr(8),
-     * ivmx(nm,2),mult(nm,200),ipl(nm,200)
-c
-c  On 130127 put this code, formerly in make2bar right before calling notex for
-c  a single note/rest, into this subroutine, so the same logic could also be
-c  with the calls to beamstrt/mid/end to adjust height of rests in xtups if the
-c  keyboard rest option is selected
-c
-c  mode=1 if called as before, 2 if for an xtup. Only affects check for
-c    quarter rests, which will fix later.
-c
-c  Get reference level: next following note if no intervening blank rests, 
-c    otherwise next prior note. Relative to bottom line.
-c
-c      if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then
-      if (ip.ne.nn(ivx).and..not.btest(ipl(ivx,ip),1)) then
-c
-c  Not the last note and not "look-left" for level
-c
-        do 8 kkp = ip+1 , nn(ivx)
-          if (btest(islur(ivx,kkp),29)) go to 4
-          if (.not.btest(irest(ivx,kkp),0)) then
-            levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line
-            go to 9
-          end if
-8       continue
-      end if
-4     continue
-c
-c  If here, there were no following notes or came to a blank rest, or
-c    "look-left" option set. So look before
-c
-c      if (ip .eq. 1) go to 2 ! Get out if this is the first note.
-      if (ip .eq. 1) return ! Get out if this is the first note.
-      do 3 kkp = ip-1, 1, -1
-        if (.not.btest(irest(ivx,kkp),0)) then
-          levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line
-          go to 9
-        end if
-3     continue
-c      go to 2  ! Pretty odd, should never be here, but get out if so.
-      return  ! Pretty odd, should never be here, but get out if so.
-9     continue
-c
-c  Find note in other voice at same time
-c
-      iupdown = sign(1,ivx-nv-1)
-      ivother = ivmx(iv,(3-iupdown)/2)
-      tother = 0.
-      do 5 kkp = 1 , nib(ivother,ibar)
-        if (abs(tother-tnow) .lt. tol) go to 6
-        tother = tother+nodur(ivother,kkp)
-5     continue
-c
-c  If here, then no note starts in other voice at same time, so set default
-c
-      levother = -iupdown*50
-      go to 7
-6     continue
-c
-c  If here, have just identified a simultaneous note or rest in other voice
-c
-      if (.not.btest(irest(ivother,kkp),0)) then ! Not a rest, use it
-        levother = nolev(ivother,kkp)-ncmid(iv,ip)+4
-      else
-        if (nodur(ivother,kkp) .eq. nodur(ivx,ip)) then
-c
-c  Rest in other voice has same duration, get out (so defualt spacing is used)
-c
-c          go to 2
-          return
-        end if
-        levother = -iupdown*50
-      end if
-7     continue
-      if (mode.eq.1) then
-        indxr = log2(nodur(ivx,ip))+1
-      else
-c        nodu = 2**(4-(iand(mult(ivx,ip),15)-8))
-        indxr = 4-(iand(mult(ivx,ip),15)-8)+1      
-      end if
-      if (iupdown .lt. 0) then
-        levtop = levtopr(indxr)
-        iraise1 = levother-levtop-3  ! Based on other note
-        iraise2 = levnext-levtop     ! Based on following note
-        if (indxr.eq.5 .and. levnext.lt.1) iraise2=iraise2+2
-        iraise = min(iraise1,iraise2)
-        if (mod(iraise+50,2).eq.1 .and. 
-     *                iraise+levtop.gt.-1) iraise = iraise-1
-      else
-        levbot = levbotr(indxr)
-        iraise1 = levother-levbot+3
-        iraise2 = levnext-levbot
-        if (indxr.eq.5 .and. levnext.gt.8) iraise2=iraise2-1
-        iraise = max(iraise1,iraise2)
-        if (mod(iraise+50,2).eq.1 .and. 
-     *                iraise+levbot.le.9) iraise = iraise-1
-      end if
-      nolev(ivx,ip) = 100+iraise
-      return
-      end
-      subroutine chklit(lineq,iccount,literr)
-      character*128 lineq
-      character*1 charq,chax
-      literr = 0
-      itype = 1
-17    call g1etchar(lineq,iccount,charq)
-      if (charq .eq. chax(92)) then
-        itype = itype+1
-        if (itype .gt. 3) then
-          literr = 1
-          return
-        end if
-        go to 17
-      end if
-      lenlit = itype
-18    call g1etchar(lineq,iccount,charq)
-      if (charq.eq.chax(92)) then
-        call g1etchar(lineq,iccount,charq)
-        if (charq .ne. ' ') then
-c
-c  Starting a new tex command withing the string
-c
-          lenlit = lenlit+2
-          if (lenlit .gt. 128) then
-            literr = 2
-            return
-          end if
-          go to 18
-        end if
-      else
-        lenlit = lenlit+1
-        if (lenlit .gt. 128) then
-          literr = 2
-          return
-        end if
-        go to 18
-      end if
-      return
-      end
-      subroutine chkpm4ac(lineq,iccount,nacc,moved)
-c
-c  Called after getting +/-/</> in a note (not rest).  iccount is on the +-<>.
-c  Sets moved=.true. and sets move parameters in nacc if necc: horiz only (bits
-c    10-16) if < or >,  horiz and vert (bits 4-9) if two consecutive signed
-c    numbers.  If moved=.true., iccount on exit is on end of last number.
-c    If moved=.false., iccount still on +/-
-c
-      logical moved,ishorz
-      character*128 lineq
-      character*1 durq
-      if (index('sfnA',lineq(iccount-1:iccount-1)).gt.0 .and.
-     *      index('0123456789.',lineq(iccount+1:iccount+1)).gt.0) then
-c
-c  Prior char was accid & next is #; this may be start of accidental shift.
-c  Must test for "." above in case we get "<" or ">"
-c
-        ipm = index('- +< >',lineq(iccount:iccount))-2
-        if (lineq(iccount+1:iccount+1).eq.'.' .and.
-     *      index('0123456789',lineq(iccount+2:iccount+2)).eq.0) then
-c
-c  Rare case of [accid][+/-].[letter].  Bail out
-c
-          moved = .false.
-          return
-        end if
-        ishorz = ipm .gt. 1
-c
-c  Save iccount in case it's not accid shift and we have to reset.
-c
-        icsav = iccount
-        iccount = iccount+1
-        call readnum(lineq,iccount,durq,fnum)
-        if (ishorz .or. index('+-',durq).gt.0) then
-c
-c  This has to be accidental shift.  Set vert. shift.
-c
-          if (.not.ishorz) then
-c
-c  +/- syntax, both shifts set, vertical first
-c
-            call setbits(nacc,6,4,int(ipm*fnum+32.5))
-            ipm = index('- +',durq)-2
-            iccount = iccount+1
-            call readnum(lineq,iccount,durq,fnum)
-          else
-c
-c  </> syntax, only horiz set
-c
-            ipm = ipm-3
-          end if
-c
-c  Set horiz. shift
-c
-          call setbits(nacc,7,10,nint(20*(ipm*fnum+5.35)))
-          iccount = iccount-1
-          moved = .true.
-        else
-c
-c  False alarm.  Reset everything and flow onward
-c
-          moved = .false.
-          iccount = icsav
-        end if
-      else
-c
-c Either prior char was not 'sfn' or next was not digit, so take no action
-c
-        moved = .false.
-      end if
-      return
-      end
-      subroutine clefsym(isl,notexq,lnote,nclef)
-c
-c  Returns string calling Don's TeX macro \pmxclef, for drawing small clefs.
-c
-      character*(*) notexq
-      character*1 chax
-        nclef = iand(ishft(isl,-12),7)
-        if (nclef .eq. 0) then
-c
-c  treble
-c
-          nlev = 2
-        else if (nclef .gt. 6) then
-c
-c  French violin
-c
-          nlev = 0
-        else if (nclef .lt. 5) then
-c
-c  C-clef
-c
-          nlev = 2*nclef-2
-        else
-c
-c  F-clef
-c
-          nlev = 2*nclef-6
-        end if
-        notexq = chax(92)//'pmxclef'//chax(48+min(nclef,7))
-     *             //chax(48+nlev)
-        lnote = 10
-      return
-      end
-      subroutine crdacc(nacc,naccid,micrd,nolevm,rmsshift,lasttime,
-     *       levmaxacc,icrdot0,segrb0,ksegrb0,nsegrb0,twooftwo,icashft)  
-c
-c       nacc = accidental bitmap for main note
-c       naccid = # of accid's in chord
-c       micrd = array with icrd #'s for notes w/ acc's, 0=>main note
-c       nolevm = level of main note
-c       segrb(1|2,.) x|y-coord of right-bdry segment
-c       ksegrb(.) internal use; tells what defined this segment
-c           -2: Left-shifted notehead
-c           -1: Original right boundary
-c            0: Main note accidental
-c         icrd: Chord-note accidental        
-c       isetshft(i),i=1,naccid: what set shift for this accid, same codes
-c       icrdot0 = top-down level-rank of main note among accid-notes
-c       icrdot(icrd)(27-29) = level rank of chord-note among accid-notes
-c       twooftwo will be true 2nd time thru; signal to store shifts w/ notes
-c
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      real*4 segar(5,2,6),segal(5,2,6),segrb(2,50),segrb0(2,50)
-      integer*4 nsegar(5),nsegal(5),micrd(10),iacctbl(6),ksegrb(50),
-     *          isetshft(10),ksegrb0(50)
-      logical lasttime,mainnote,twooftwo
-      data nsegar / 3,4,3,3,2 /, nsegal / 2,4,3,3,2 /
-      data segar /
-c
-c  Fancy sharp boundary. fl,sh,na,dfl,dsh
-c
-     * -0.05,-0.38,-0.34,-.05, -.15,-1.4,-2.9,-3.0, -1.4, -1.2,   
-c     * -0.75,-0.20,-0.80, 0. , 0. , .96,-1.04,1.6, 0. , 0. ,   
-c           meas value for y, natural is 1.6
-     * -0.75,-0.20,-0.80,-.75,   0. , .96,-1.04,1.48, .96, 1.2,   
-     *  0.00,-0.38, 0.00, 0. ,   0. ,3.15, 1.64,3.0, 3.15, 0. ,   
-     * 0. ,   0.00, 0. ,  0. ,   0. , 0. , 2.90, 0. , 0. , 0. ,
-     * 0. ,   0.  , 0. ,  0. ,   0. , 0. , 0. ,  0. , 0. , 0. ,  
-     * 0. ,   0.  , 0. ,  0. ,   0. , 0. , 0. ,  0. , 0. , 0. /
-      data segal /
-c     *  0.00, 0.00,-1.04, 0. , 0. ,3.15, 2.9,-1.6, 0. , 0. ,
-cc		(meas. value is 3.08)    ^^^^
-cc  Raise top of flat so it interferes with bottom of sharp        
-     * -1.00,-1.02,-0.60,-1.65, -1.2,-1.4,-2.9, -3.0, -1.4, -1.2,   
-     *  0.00,-1.20,-1.04, 0.  ,  0. ,3.15,-1.64,-1.48,3.15, 1.2,
-     *  0.  ,-1.02, 0.00, 0.  ,  0. , 0. , 1.04, 3.0,  0. , 0. ,   
-     *  0. ,  0.00, 0. ,  0.  ,  0. , 0. , 2.9 , 0. ,  0. , 0. ,  
-     *  0. ,  0.  , 0. ,  0.  ,  0. , 0. , 0. ,  0. ,  0. , 0. ,  
-     *  0. ,  0.  , 0. ,  0.  ,  0. , 0. , 0. ,  0. ,  0. , 0. /
-c
-c  iacctbl(i) = internal accid # (1-5) when i=extern accid # (1,2,3,5,6)
-c
-      data iacctbl / 1 , 2 , 3 , 0 , 4 , 5 /
-c
-c  Set up barrier segrb(iseg,ipoint) to define coords of corner points 
-c    on stem+notes
-c
-      do 11 iseg = 1 , nsegrb0
-        segrb(1,iseg) = segrb0(1,iseg)
-        segrb(2,iseg) = segrb0(2,iseg)
-        ksegrb(iseg) = ksegrb0(iseg)
-11    continue
-      nsegrb = nsegrb0
-      rmsshift = 0.
-      shiftmin = 1000.
-	do 1 iwa = 1 , naccid
-c
-c  Initialize shift for this note
-c
-        shift = 0.
-        mainnote = micrd(iwa).eq.0
-        isetshft(iwa) = -1
-c
-c Get note level and accidental type
-c
-        if (mainnote) then
-          nolev = nolevm
-          iacctype = iacctbl(igetbits(nacc,3,0))
-        else
-          nolev = igetbits(icrdat(micrd(iwa)),7,12)
-          iacctype = iacctbl(igetbits(icrdat(micrd(iwa)),3,20))
-        end if
-c
-c  Cycle thru segments on right edge of this accidental
-c
-        do 2 isega = 1 , nsegar(iacctype)-1
-          ybotaseg = nolev+segar(iacctype,2,isega)
-          ytopaseg = nolev+segar(iacctype,2,isega+1)
-c
-c  Cycle thru segments of right-hand barrier
-c
-	    do 3 isegrb = 1 , nsegrb-1
-c
-c  Must find all barrier segments that start below ytopseg & end above ybotseg 
-c
-            if (segrb(2,isegrb) .lt. ytopaseg) then
-c
-c  Barrier seg starts below top of accid
-c  Check if barrier seg ends above bottom of accid
-c
-              if (segrb(2,isegrb+1) .gt. ybotaseg) then
-                if (shift .gt. 
-     *                segrb(1,isegrb)-segar(iacctype,1,isega)) then
-                  shift = segrb(1,isegrb)-segar(iacctype,1,isega)
-c
-c  Record the cause of the shift
-c
-                  isetshft(iwa) = ksegrb(isegrb)
-                end if
-              end if
-c
-c  Does barrier segment end above top of accid seg?
-c
-              if (segrb(2,isegrb+1) .gt. ytopaseg) go to 4
-            end if
-3         continue
-4         continue
-2       continue
-        if (.not.btest(nacc,28) .and. abs(shift).gt.0.0001
-     *       .and. .not.lasttime) then
-c          if (nolev .eq. levmaxacc) then
-          if (nolev.eq.levmaxacc .and. isetshft(iwa).eq.-1) then
-            rmsshift = 1000.
-            return
-          end if
-c
-c  Does the following properly account for left-shifted noteheads?
-c
-c  Top-down rank of this note we just shifted
-c
-          if (mainnote) then 
-            irank = icrdot0
-          else 
-            irank = igetbits(icrdot(micrd(iwa)),3,27)
-          end if
-c
-c  Compare level-rank of this note vs. that of note that caused the shift. 
-c    This has effect of checking for basic interferences from top down.
-c
-c       ksegrb(.) internal use; tells what defined this segment
-c           -2: Left-shifted notehead
-c           -1: Original right boundary
-c            0: Main note accidental
-c         icrd: Chord-note accidental        
-c       isetshft(i),i=1,naccid: what set shift for this accid, same codes
-c
-          if (isetshft(iwa) .lt. 0) then
-            iranksetter = 0
-          else if (isetshft(iwa) .eq. 0) then
-            iranksetter = icrdot0
-          else
-            iranksetter = igetbits(icrdot(isetshft(iwa)),3,27)
-          end if
-          if (iranksetter.ne.0 .and. irank.ne.iranksetter+1) then
-            rmsshift = 1000.
-            return
-          end if
-        end if
-        rmsshift = rmsshift+shift**2        
-        if (lasttime .and. abs(shift).gt..0001) then
-          if (mainnote) then
-            if (.not.btest(nacc,29)) go to 10
-          else
-            if (.not.btest(icrdat(micrd(iwa)),29)) go to 10
-          end if
-c
-c  If here, "A" was set on a manual shift, so must cumulate the shift.  Note that if there
-c    was a manual shift but auto-shift was zero, will not come thru here, but shift value
-c    will be left intact.
-c
-          if (mainnote) then
-            shift = shift+.05*(igetbits(nacc,7,10)-107)
-          else
-            shift = shift+.05*(igetbits(icrdot(micrd(iwa)),7,20)-107)
-          end if
-10        continue
-          if (twooftwo) then
-c
-c  Record the shift for this accidental
-c         
-            if (shift .lt. -5.35) then
-              call printl(' ')
-              call printl('WARNING: auto-generated accidental '//
-     *                               'shift too big for PMX, ignoring')
-            else
-              ishift = nint(20*(shift+5.35))
-              if (mainnote) then
-                call setbits(nacc,7,10,ishift)
-              else
-                call setbits(icrdot(micrd(iwa)),7,20,ishift)
-              end if
-            end if
-          else
-c
-c  This is the earlier call to precrd, so need minimum shift
-c
-            shiftmin = min(shiftmin,shift)
-          end if
-        end if
-c
-c  Bail out if this is the last accidental to check
-c
-        if (iwa .eq. naccid) go to 1
-c
-c  Add this accidental to the right barrier! Count down from highest barrier segment,
-c    find 1st one starting below top of accid, and first one starting below bot.
-c  
-        do 5 ibelowtop = nsegrb , 1 , -1
-          if (segrb(2,ibelowtop) .lt. 
-     *          nolev+segal(iacctype,2,nsegal(iacctype))) then
-            do 9 ibelowbot = ibelowtop , 1 , -1
-              if (segrb(2,ibelowbot) .lt. 
-     *            nolev+segal(iacctype,2,1)) go to 6
-9           continue
-            print*,'Oops2!'
-            call stop1()
-          end if
-5       continue
-        print*,'Ugh0! in crdaccs'
-        call stop1()
-6       continue
-        netgain = nsegal(iacctype)-ibelowtop+ibelowbot
-c
-c  Shift high segments up
-c
-        if (netgain .ge. 0) then
-          do 7 isegrb = nsegrb , ibelowtop+1 , -1
-            segrb(1,isegrb+netgain) = segrb(1,isegrb)
-            segrb(2,isegrb+netgain) = segrb(2,isegrb)
-            ksegrb(isegrb+netgain) = ksegrb(isegrb)
-7         continue
-c
-c  Set up 1st segment above accid
-c
-          segrb(1,ibelowtop+netgain) = segrb(1,ibelowtop)
-          segrb(2,ibelowtop+netgain) = 
-     *         nolev+segal(iacctype,2,nsegal(iacctype))
-          ksegrb(ibelowtop+netgain) = ksegrb(ibelowtop)
-        else
-c
-c  netgain<0, must remove segments. Use same coding but reverse order,
-c    work from bottom up
-c
-          segrb(1,ibelowtop+netgain) = segrb(1,ibelowtop)
-          segrb(2,ibelowtop+netgain) = 
-     *         nolev+segal(iacctype,2,nsegal(iacctype))
-          ksegrb(ibelowtop+netgain) = ksegrb(ibelowtop)
-          do 12 isegrb = ibelowtop+1 , nsegrb 
-            segrb(1,isegrb+netgain) = segrb(1,isegrb)
-            segrb(2,isegrb+netgain) = segrb(2,isegrb)
-            ksegrb(isegrb+netgain) = ksegrb(isegrb)
-12        continue
-        end if  
-c
-c  Insert new segments
-c
-        do 8 isega = 1 , nsegal(iacctype)-1
-          segrb(1,ibelowbot+isega) = shift+segal(iacctype,1,isega)
-          segrb(2,ibelowbot+isega) = nolev+segal(iacctype,2,isega)
-          if (mainnote) then 
-            ksegrb(ibelowbot+isega) = 0
-          else
-            ksegrb(ibelowbot+isega) = micrd(iwa)
-          end if
-8       continue
-c
-c  Update number of barrier segments
-c
-        nsegrb = nsegrb+netgain
-cc
-cc  Temporary printout for boundary segments as built up
-cc
-c      write(15,'()')
-c      write(15,'(a/(2f8.2,i5))')'  y       x       kseg',
-c     *    (segrb(2,iseg),segrb(1,iseg),ksegrb(iseg),iseg=1,nsegrb)
-c      write(15,'(a/(2i5))')' micrd isetshft',
-c     *    (micrd(iwa1),isetshft(iwa1),iwa1=1,iwa)
-cc
-1     continue   ! next accidental 
-      if (lasttime .and. .not.twooftwo) then
-c
-c  This is the final call on the pre-ask pass, so compute left-shift rqmt.
-c
-	  icashft = nint(-20*shiftmin)
-      end if
-cc
-cc  Temporary printout for boundary segments
-cc
-c      if (twooftwo) then
-c      write(15,'()')
-c      write(15,'(a/(2f8.2,i5))')'  y       x       kseg',
-c     *    (segrb(2,iseg),segrb(1,iseg),ksegrb(iseg),iseg=1,nsegrb)
-c      write(15,'(a/(2i5))')' micrd isetshft',
-c     *    (micrd(iwa),isetshft(iwa),iwa=1,naccid)
-c      end if
-cc
-      return
-      end
-      subroutine crdaccs(nacc,ipl,irest,naccid,kicrd,nolevm,
-     *                   levmaxacc,levminacc,icrdot0,twooftwo,icashft)
-c
-c       nacc = accidental bitmap for main note
-c       naccid = # of accid's in chord
-c       kicrd = array with icrd #'s for notes w/ acc's, 0=>main note
-c       nolevm = level of main note
-c
-c  This is called once per multi-accidental chord.  In here, loop over all
-c  permutations of the order of accidental as stored in kicrd.  Each time thru
-c  loop, call crdacc once, get rms shift.  Only save permutation and rms value
-c  if it is less than old value.
-c
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-c
-c  Make consistent? 120106
-c      integer*4 kicrd(7),iperm(7),micrd(10),ipermsav(7),ksegrb0(50)
-      integer*4 kicrd(10),iperm(7),micrd(10),ipermsav(7),ksegrb0(50)
-      real*4 segrb0(2,50)
-      logical btest,tagged,manual,lshift,twooftwo
-cc
-cc  Temporary printout of level-rankings
-cc
-c      write(15,'()')
-c      do 98 iacc = 1 , naccid
-c        if (kicrd(iacc) .eq. 0) then
-c          write(15,'(3i5)')nolevm,icrdot0
-c        else
-c          write(15,'(2i5)')igetbits(icrdat(kicrd(iacc)),7,12),
-c     *                     igetbits(icrdot(kicrd(iacc)),3,27)
-c        end if
-c98    continue
-cc
-c
-c  Initialize right-barrier
-c
-      segrb0(1,1) = 0.
-      segrb0(2,1) = -1000.
-      segrb0(1,2) = 0.
-      segrb0(2,2) = 1000.
-      nsegrb0 = 2
-      ksegrb0(1) = -1
-      ksegrb0(2) = -1
-c
-c  Search for left-shifted notes, Make up the initial right-barrier, which
-c     will be good for all permutations.
-c     irest()(27) is set if any notes are left-shifted
-c     Must use ALL chord notes, not just ones w/ accid's.
-c
-      if (btest(irest,27)) then
-        do 15 icrd = icrd1-1, icrd2
-          if (icrd .eq. icrd1-1) then
-c
-c  Main note
-c
-c            lshift = btest(ipl,8) 
-            lshift = btest(ipl,8) .or. btest(nacc,31) 
-            if (lshift) nolev = nolevm
-          else
-c
-c  Chord note
-c
-            lshift = btest(icrdat(icrd),23)
-c            if (lshift) nolev = igetbits(icrdat(icrd),7,12)
-            if (lshift) then
-              nolev = igetbits(icrdat(icrd),7,12)
-              if (btest(nacc,31) .and. nolev.eq.nolevm+1) then
-c
-c  This note is not really shifted, It is the upper of a 2nd with the main
-c    note on an upstem, and Main note must be shifted. 
-c    nacc(31) signals the real truth.
-c
-                lshift = .false.
-              end if
-            end if
-          end if
-          if (lshift) then
-            do 16 isegrb = 1 , nsegrb0-1
-              if (segrb0(2,isegrb+1) .gt. nolev-1) then
-c
-c  Add this notehead to the right boundary here.  Move all higher segs up 2.
-c
-                do 17 iiseg = nsegrb0 , isegrb+1 , -1
-                  segrb0(1,iiseg+2) = segrb0(1,iiseg)   
-                  segrb0(2,iiseg+2) = segrb0(2,iiseg)
-                  ksegrb0(iiseg+2) = ksegrb0(iiseg)
-17              continue
-                go to 18
-              end if
-16          continue
-18          continue
-c
-c  Insert notehead into list. Set kseg=-2 to signal notehead shift.
-c
-            iiseg = isegrb+1
-            segrb0(1,iiseg) = -1.2
-            segrb0(2,iiseg) = nolev-1.
-            ksegrb0(iiseg) = -2
-            segrb0(1,iiseg+1) = 0.
-            segrb0(2,iiseg+1) = nolev+1.
-            ksegrb0(iiseg+1) = -1
-            nsegrb0 = nsegrb0+2
-          end if
-15      continue
-      end if
-c
-c  Done setting right barrier for left-shifted noteheads
-c
-      tagged = .false.
-      manual = .false.
-c
-c  Preprocess to check for manual shifts.
-c   If are manual main [nacc(10-16)] or chord note [icrdot(20-26)]shifts, then
-c      If any manual shift is preceded by "A" [nacc(29), icrdat(29)] then
-c         1. Auto-shifting proceeds
-c         2. "A"-shifts add to autoshifts
-c         3. non-"A" shifts are ignored!
-c      Else (>0 man shifts, none has "A")
-c         No auto-ordering, No autoshifts, Observe all manual shifts.
-c      End if
-c   End if
-c
-	maxmanshft = 0
-      do 13 i = 1 , naccid
-        if (kicrd(i) .eq. 0) then
-c
-c  Main note
-c		
-          manshft = igetbits(nacc,7,10)
-          if (manshft .ne. 0) then
-            manual = .true.
-            if (btest(nacc,29)) then
-              tagged = .true.
-            else
-c              maxmanshft = max(maxmanshft,64-manshft)              
-              maxmanshft = max(maxmanshft,107-manshft)              
-            end if
-          end if
-        else
-c
-c  Chord note
-c
-          manshft = igetbits(icrdot(kicrd(i)),7,20)
-          if (manshft .ne. 0) then
-            manual = .true.
-            if (btest(icrdat(kicrd(i)),29)) then
-              tagged = .true.
-            else
-c              maxmanshft = max(maxmanshft,64-manshft)              
-              maxmanshft = max(maxmanshft,107-manshft)              
-            end if
-          end if
-        end if
-13    continue
-      if (manual) then
-        if (tagged) then
-c
-c  zero out all untagged shifts
-c
-          do 14 i = 1 , naccid
-            if (kicrd(i) .eq. 0) then
-              if (.not.btest(nacc,29)) call setbits (nacc,7,10,0)
-            else
-              if (.not.btest(icrdat(kicrd(i)),29)) 
-     *               call setbits (icrdot(kicrd(i)),7,20,0)
-            end if
-14        continue
-        else
-c
-c  There are manual shifts but none tagged. Only proceed if "Ao" was entered 
-c
-          if (.not.btest(nacc,28)) then
-            icashft = maxmanshft
-            return
-          end if
-        end if
-      end if
-      if (btest(nacc,28)) then
-c
-c  Take the accidentals in order as originally input, then exit.
-c
-        call crdacc(nacc,naccid,kicrd,nolevm,rmsshift,.true.,
-     *           idummy,idummy,segrb0,ksegrb0,nsegrb0,twooftwo,icashft)  
-        return
-c      end if
-      else if (naccid .eq. 3) then
-c
-c  Special treatment if 3 accidentals in chord. If there aren't accids on a 2nd
-c    then place in order top, bottom, middle. 
-c
-        do 20 i = 1 , 3
-          if (kicrd(i) .eq. 0) then
-            irank = icrdot0
-            nolev = nolevm
-		else
-            irank = igetbits(icrdot(kicrd(i)),3,27)
-            nolev = igetbits(icrdat(kicrd(i)),7,12) 
-          end if
-          if (irank .eq. 1 ) then
-            micrd(1) = kicrd(i)
-          else
-            micrd(5-irank) = kicrd(i)
-          end if
-	    if (irank .eq. 2) then
-		  levmidacc = nolev 
-          end if
-20      continue 
-        if (levmaxacc.ne.levmidacc+1 .and. 
-     *              levmidacc.ne.levminacc+1) then
-          call crdacc(nacc,naccid,micrd,nolevm,rmsshift,.true.,
-     *            idummy,idummy,segrb0,ksegrb0,nsegrb0,twooftwo,icashft)  
-          return
-        end if
-      end if
-      rmsmin = 100000.
-c
-c  Initialize permutation array
-c
-      do 7 i = 1 , naccid 
-        iperm(i) = i
-7     continue
-c
-c  Start looping over permutations
-c
-      do 8 ip = 1 , 5041
-        if (ip .ne. 1) then
-c
-c  Work the magic algorithm to get the next permutation
-c
-          do 1 k = naccid-1 , 1 , -1
-            if (iperm(k) .le. iperm(k+1)) go to 2
-1         continue
-c
-c  If here, we just got the last permutation, so exit the loop over permutations
-c
-          go to 10
-2         continue
-          do 3 j = naccid , 1 , -1
-            if (iperm(k) .le. iperm(j)) go to 4
-3         continue
-4         continue
-          it = iperm(j)
-          iperm(j) = iperm(k)
-          iperm(k) = it
-          is = k+1
-          do 5 ir = naccid , 1 , -1
-            if (ir .le. is) go to 6
-            it = iperm(ir)
-            iperm(ir) = iperm(is)
-            iperm(is) = it
-            is = is+1
-5         continue
-6         continue
-        end if
-c
-c  New we have a permutation.  Take icrd values out of kicrd and put them into
-c  micrd in the order of the permutation
-c
-        do 9 i = 1 , naccid
-          micrd(i) = kicrd(iperm(i))
-9       continue
-cc
-cc  Temporary printout
-cc
-c      write(15,'(/a6,10i3)')'perm:',(iperm(i),i=1,naccid)
-cc
-        call crdacc(nacc,naccid,micrd,nolevm,rmsshift,.false.,
-     *       levmaxacc,icrdot0,segrb0,ksegrb0,nsegrb0,twooftwo,icashft)  
-cc
-cc  Temporary printout
-cc
-c      write(15,*)'perm done, rmsshift:',rmsshift
-cc
-        if (rmsshift .lt. rmsmin) then
-c
-c  Save this permutation, reset minrms
-c
-          do 11 i = 1 , naccid
-            ipermsav(i) = iperm(i)
-            rmsmin = rmsshift
-11        continue
-        end if
-8     continue          
-      print*,'Should not BEEEEEE here!'
-      call stop1()
-10    continue          
-c
-c  Done looping, get info for the final choice
-c
-      do 12 i = 1 , naccid
-        micrd(i) = kicrd(ipermsav(i))
-12    continue
-cc
-cc  Temporary printout
-cc
-c      write(15,'(/a6,10i3)')'Final perm:',(ipermsav(i),i=1,naccid)
-cc
-      call crdacc(nacc,naccid,micrd,nolevm,rmsshift,.true.,
-     *            idummy,idummy,segrb0,ksegrb0,nsegrb0,twooftwo,icashft)  
-      return
-      end          
-      subroutine doacc(ihshft,ivshft,notexq,lnote,nacc,nolev,ncm,caut)
-      character*1 sq,chax
-      character*3 acsymq
-      character*8 noteq
-      character*79 notexq
-      logical btest,caut
-      sq = chax(92)
-      if (ihshft .eq. -107) ihshft=0
-cc
-cc  If main note shifted left, so shift accid.  Terminate below, when acc. is done.
-cc
-      if (ihshft .ne. 0) then
-c
-c  Accid must be shifted horizontally
-c
-        if (ihshft .lt. 0) then
-          notexq = sq//'loffset{'
-          ihshft = -ihshft
-        else
-          notexq = sq//'roffset{'
-        end if
-        hshft = .05*ihshft
-        if (hshft .lt. 1.) then
-          write(notexq(10:12),'(f3.2)')hshft
-          lnote = 12
-        else
-          write(notexq(10:13),'(f4.2)')hshft
-          lnote = 13
-        end if
-        notexq = notexq(1:lnote)//'}{'//sq
-        lnote = lnote+3
-      else
-        notexq = sq
-        lnote = 1
-      end if
-      if (btest(nacc,3)) then
-        notexq = notexq(1:lnote)//'big'
-        lnote = lnote+3
-      end if
-      if (caut) then
-c
-c  Cautionary accidental.  Need to define bigcna,... in pmx.tex
-c
-        notexq = notexq(1:lnote)//'c'
-        lnote = lnote+1
-      end if
-      call accsym(nacc,acsymq,lacc)
-      notexq = notexq(1:lnote)//acsymq(1:lacc)
-      lnote = lnote+lacc
-      noleva = nolev
-      if (ivshft .ne. 0) noleva = noleva+ivshft-32
-      call notefq(noteq,lnoten,noleva,ncm)
-      if (lnoten .eq. 1) call addblank(noteq,lnoten)
-      notexq = notexq(1:lnote)//noteq(1:lnoten)
-      lnote = lnote+lnoten
-      if (ihshft .ne. 0) then
-c
-c  Terminate horizontal shift
-c
-        notexq = notexq(1:lnote)//'}'
-        lnote = lnote+1
-      end if
-      return
-      end
-      subroutine docrd(ivx,ip,nodu,ncm,iv,tnow,soutq,lsout,ulq,ibmcnt,
-     *                 islur,nvmx,nv,beamon,nolevm,ihornb,nornb,stemlen,
-     *                 dotxtup,nacc)
-      parameter (nm=24,mv=24576)
-      common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
-     *                xinsnow,lowdot
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
-     *                flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
-     *                rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
-     *                rtshfac
-      integer*2 mmidi,iinsiv
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      logical lowdot,dotxtup
-      integer*4 ihornb(nm,24),nornb(nm)
-      character*1 ulq(nm,9),chax
-      character*7 nosymq
-      character*8 noteq
-      character*79 notexq,outq
-      character*80 soutq
-      logical btest,isleft,isright,beamon
-      character*79 inameq
-      common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
-     *   isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
-     *   lnam(nm),inameq(nm)
-      common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
-     *  instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
-      logical EarlyTransOn,LaterInstTrans
-      common /commidisig/ midisig
-c 130316
-      common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
-     *                ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
-c
-c
-c  This subr. once produced notexq for entire chord.  10/18/97 altered to write
-c    chord notes as we go.  10/22/97 find range of icrd first.
-c    2/25/98 moved rangefinding to precrd so done before slurs, so now
-c    on entry, icrd1, icrd2 define range of icrd for this chord.
-c
-c  Set counter (for this note) for chord notes present.  Set notmain=T.
-c    Will test for notmain=.true. in addmidi to tell whether to save pitch.  
-c
-      nmidcrd = 0
-      notmain = .true.
-      crdacc = .false.
-      do 5 icrd = icrd1 , icrd2
-        lnote = 0
-        nolev = igetbits(icrdat(icrd),7,12)
-c
-c  3/8/03 save original pitch to use in midi, in case 2nds alter things.
-c
-        nolevo = nolev
-c
-c  Check for special situations with 2nds (see precrd).
-c
-        if (btest(nacc,30)) then
-          if (nolev .eq. nolevm-1) nolev = nolevm
-        else if (btest(nacc,31)) then
-          if (nolev .eq. nolevm+1) nolev = nolevm
-        end if
-c
-c  Lower dot for lower-voice notes?.  Conditions are:
-c   1. Dotted time value
-c   2. Lower voice of two
-c   3. Note is on a line
-c   4. Not a rest (cannot be a rest in a chord!)
-c.  5. Flag (lowdot) is set to true
-c
-        if (lowdot .and. nvmx.eq.2 .and. ivx.le.nv) then
-	    if (2**log2(nodu).ne.nodu .and. mod(nolev-ncm,2).eq.0) then
-	      if (btest(icrdat(icrd),26)) then
-c
-c  Note already in movdot list.  Drop by 2.
-c
-	        call setbits(icrdot(icrd),7,0,
-     *                      igetbits(icrdot(icrd),7,0)-20)
-            else
-c
-c  Not in list so just move it right now
-c
-	        call dotmov(-2.,0.,soutq,lsout,igetbits(islur,1,3))
-	      end if
-	    end if
-	  end if
-	  if (btest(icrdat(icrd),26)) then
-c
-c  Move the dot.
-c
-	    updotc = 0.1*(iand(127,icrdot(icrd))-64)
-	    rtdotc = 0.1*(iand(127,ishft(icrdot(icrd),-7))-64)
-	    call dotmov(updotc,rtdotc,soutq,lsout,igetbits(islur,1,3))
-	  end if
-	  isleft = btest(icrdat(icrd),23)
-	  isright = btest(icrdat(icrd),24)
-c
-c  Check for ornament in chord.
-c
-	  if (icrdorn(icrd) .gt. 0) then
-	    call putorn(icrdorn(icrd),nolev,nolevm,nodu,nornb,ulq,
-     *         ibmcnt,ivx,ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout,
-     *         ip,0,beamon,.true.)
-c
-c     subroutin putorn(iornq,nolev,nolevm,nodur,nornb,ulq,ibmcnt,ivx,
-c    *     ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout,ip,islhgt,
-c    *     notcrd,beamon,iscrd)
-c
-          call addstr(outq,lout,soutq,lsout)
-        end if
-c
-c  Chord-note symbol.  First check for breve
-c
-        if (nodu .eq. 128) then
-          nosymq = chax(92)//'zbreve'
-          lsym = 7
-        else
-c
-c  Not a breve chord.  Get first letters in chord-note symbol
-c
-          if (isleft) then
-            nosymq = chax(92)//'l'
-          else if (isright) then
-            nosymq = chax(92)//'r'
-          else
-            nosymq = chax(92)//'z'
-          end if
-          if (nodu .ge. 64) then
-            nosymq = nosymq(1:2)//'w'
-          else if (nodu .ge. 32) then
-            nosymq = nosymq(1:2)//'h'
-          else
-            nosymq = nosymq(1:2)//'q'
-          end if
-          if (2**log2(nodu).eq.nodu .and. .not.dotxtup) then
-            lsym = 3
-          else if (.not.btest(islur,3) .or. dotxtup) then
-c
-c  Single dot
-c
-            nosymq = nosymq(1:3)//'p'
-            lsym = 4
-          else
-c
-c  Double dot
-c
-            nosymq = nosymq(1:3)//'pp'
-            lsym = 5
-          end if
-        end if
-        if (btest(icrdat(icrd),19).and..not.btest(icrdat(icrd),27)) then
-c
-c  Accidental and not MIDI-only.  Build up bits 0-3 of nacc
-c
-          nactmp = igetbits(icrdat(icrd),3,20)
-c
-c  Kluge for bigness.  Only means 'As' has not been issued
-c
-          if (bacfac .ne. 1.e6) nactmp = nactmp+8
-          call doacc(igetbits(icrdot(icrd),7,20)-107,
-     *        igetbits(icrdot(icrd),6,14),
-c     *        notexq,lnote,nactmp,nolev,ncmid(iv,ip))
-c  Get original nolev, not altered to deal with 2nds
-     *        notexq,lnote,nactmp,igetbits(icrdat(icrd),7,12),
-c     *        ncmid(iv,ip))
-     *        ncmid(iv,ip),btest(icrdat(icrd),31))
-          notexq = notexq(1:lnote)//nosymq
-          crdacc = .true.
-        else
-          notexq = nosymq
-        end if
-        lnote = lnote+lsym
-c
-c  Get note name (again if accid, due to possible octave jump)
-c
-        call notefq(noteq,lnoten,nolev,ncm)
-        if (lnoten.eq.1) call addblank(noteq,lnoten)
-c
-c  Put in note name
-c
-        notexq = notexq(1:lnote)//noteq
-        lnote = lnote+lnoten
-        if (btest(icrdat(icrd),25)) then
-c
-c  Arpeggio signal
-c
-          call putarp(tnow,ivx,ip,nolev,ncm,soutq,lsout)
-        end if
-        call addstr(notexq,lnote,soutq,lsout)
-        if (ismidi) then
-c
-c  Here is where we collect MIDI pitch info for the chord note.  By checking
-c    notmain, addmidi(...) knows to just compute the 
-c    pitch number and store it in mcpitch(nmidcrd).  Then on call to addmidi()
-c    for MAIN note, will put in note codes for all chord notes + main note.
-c   
-          kv = 1
-          if (ivx .gt. iv) kv=2
-          nmidcrd = nmidcrd+1
-          if (nmidcrd .gt. 20) then
-            print*
-            print*,'21 chord notes is too many for midi processor'
-            call stop1()
-          end if
-c
-c  Use original saved pitch level, unaltered by 2nds logic.
-c
-c 130316
-c          call addmidi(midchan(iv,kv),nolevo-iTransAmt(instno(iv)),
-          call addmidi(midchan(iv,kv),nolevo+miditran(instno(iv)),
-c     *             igetbits(icrdat(icrd),3,20),isig,1.,.false.,.false.)
-c 130316
-c     *      igetbits(icrdat(icrd),3,20),midisig(instno(iv)),1.,
-     *      igetbits(icrdat(icrd),3,20),midisig,1.,
-
-
-     *      .false.,.false.)
-        end if
-5     continue
-      notmain = .false.
-      return
-      end
-      subroutine dodyn(ivx,ip,nolev,ncm,ipl,islur,irest,nvmx,nv,
-     *                beamon,ihornb,nornb,ulq,ibmcnt,nostem,soutq,lsout) 
-      parameter (nm=24)
-c
-c  Inputs are array *elements* except ihornb,nornb,ulq
-c
-      common /commus/ musize,whead20
-      common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12),
-     *        hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41),
-     *        idynda2(99),levhssav(nm),listcresc,listdecresc
-      character*128 txtdynq
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      logical btest,beamon,upstem,nostem
-      common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
-     *                 ,WrotePsslurDefaults,SlurCurve
-      logical fontslur,upslur,WrotePsslurDefaults
-      character*1 udqq,chax,ulq(nm,9)
-      character*4 dynstrq
-      character*5 numpq
-      character*48 dyntablq,tempq
-      character*79 notexq
-      character*80 soutq
-      integer*4 ihornb(nm,24),nornb(nm),idynn(10)
-      data dyntablq /'ppppppp pp  p   mp  mf  f   fp  sfz ff  fff ffff'/
-      numdyn = 0
-c
-c  Find dynamics for (ivx,ip) in list.  May be as many as 4.  Store idyn values 
-c      in idynn(1...4)
-c
-      do 1 idyn = 1 , ndyn
-c        ivxtent = iand(idyndat(idyn),15)        
-        ivxtent = iand(idyndat(idyn),15)
-     *                 +16*igetbits(idynda2(idyn),1,10)
-	  if (ivxtent .eq. ivx) then
-          iptent = igetbits(idyndat(idyn),8,4)
-          if (iptent .eq. ip) then
-            numdyn = numdyn+1
-            idynn(numdyn) = idyn	  
-          else if (iptent .gt. ip) then
-c
-c  I don't think there are any more possible for this ivx,ip, so exit loop
-c
-            go to 2
-          end if
-c        else if (ivxtent .gt. ivx) then
-c          go to 2
-        end if
-1     continue
-2     continue
-c
-c  At this point there is a list of idyn's in idynn(1...numdyn)
-c  Compute level, and stem-dir'n-based horizontal tweaks
-c
-      hoffsd = 0.
-c
-c  Set upstem to false as default
-c
-      upstem = .false.
-      if (btest(irest,0)) then
-c
-c  It's a rest.  Assume it doesn't go below the staff
-c
-        lbot = ncm-4  
-      else if (.not.beamon) then
-        if (udqq(nolev,ncm,islur,nvmx,ivx,nv).eq.'u' .or. nostem) then
-          upstem = .true.
-          if (.not.btest(ipl,10)) then
-            lbot = min(nolev-1,ncm-4)
-          else
-            lbot = min(minlev-1,ncm-4)
-          end if
-        else
-          hoffsd = -.5
-          if (.not.btest(ipl,10)) then
-            lbot = min(nolev-7,ncm-4)
-          else
-            lbot = min(minlev-7,ncm-4)
-          end if
-        end if
-      else
-        if (ulq(ivx,ibmcnt) .eq. 'u') then
-          upstem = .true.
-          if (.not.btest(ipl,10)) then
-            lbot = min(nolev-1,ncm-4)
-          else
-            lbot = min(minlev-1,ncm-4)
-          end if
-        else
-          hoffsd = -.5
-          lbot = ihornb(ivx,nornb(ivx))+1
-          if (lbot .eq. 1) then
-c
-c Kluge for non-beamed, down xtup, for which ihorb was never set.
-c Assumes stem is shortened.
-c
-            lbot = nolev-5
-          end if
-          nornb(ivx) = nornb(ivx)+1
-        end if
-      end if
-      lbot = lbot-5
-      jtxtdyn1 = 1
-c
-c  Now ready to loop over current dyn's
-c
-      do 3 icntdyn = 1 , numdyn
-        idynd = idyndat(idynn(icntdyn))
-        idynd2 = idynda2(idynn(icntdyn))
-        idno = igetbits(idynd,4,12)
-c        ivx = iand(15,idynd)
-        ivx = iand(15,idynd)+16*igetbits(idynd2,1,10)
-c
-c  Build the command into notex in stages. Insert name & rq'd args in order:
-c
-c    Command name
-c	 hpstrt, hpcend, hpdend, pmxdyn
-c    ivx
-c        X       X       X
-c    level
-c                X       X       X
-c    hoff
-c        X       X       X       X
-c    d-mark
-c                                X
-c
-        if (idno .eq. 0) then
-c
-c  Text-dynamic
-c
-          notexq = chax(92)//'txtdyn'
-          lnote = 7
-        else if (idno .le. 12) then
-c
-c  Letter-group
-c
-          notexq = chax(92)//'pmxdyn'
-          lnote = 7
-        else if (fontslur) then
-          lnote = 7
-          if (idno .eq. 13) then
-c
-c  Start a hairpin
-c
-            notexq = chax(92)//'hpstrt'
-          else if (idno .eq. 14) then
-c
-c  End crescendo
-c
-            notexq = chax(92)//'hpcend'
-          else
-c
-c  End decrescendo
-c
-            notexq = chax(92)//'hpdend'
-          end if
-        else
-c
-c  Postscript hairpins
-c          
-          lnote = 7
-          if (idno .eq. 13) then
-            notexq = chax(92)//'Icresc'
-          else if (idno .eq.14) then
-            notexq = chax(92)//'Idecresc'
-            lnote = 9
-          else		         
-            notexq = chax(92)//'Tcresc'
-          end if
-        end if
-        if (idno .ge. 13) then
-c
-c  Put in voice number
-c
-          if (ivx .le. 9) then
-            notexq = notexq(1:lnote)//char(48+ivx)
-            lnote = lnote+1   
-          else if (ivx .le. 19) then
-            notexq = notexq(1:lnote)//'{1'//char(38+ivx)//'}'
-            lnote = lnote+4
-          else
-            notexq = notexq(1:lnote)//'{2'//char(28+ivx)//'}'
-            lnote = lnote+4
-          end if
-        end if
-c
-c  Begin setting level
-c
-        lbot1 = lbot
-        if (idno.gt.0 .and. idno.le.5) then
-c
-c  All letters are short so raise a bit.
-c
-          lbot1 = lbot1+1
-        else if (idno .ge. 13) then
-          lbot1 = lbot1+2
-        end if
-c
-c  Convert so reference is bottom line
-c
-        lbot1 = lbot1-ncm+4
-        if ((fontslur.and.idno.eq.13) .or. 
-     *      ((.not.fontslur).and.(idno.eq.13.or.idno.eq.14))) then
-c
-c  Hairpin start.  Save level and user-tweak before applying user tweak.
-c
-          levdsav(ivx) = lbot1
-          levhssav(ivx) = 0
-          if (btest(idynd,16)) levhssav(ivx) = -64+igetbits(idynd,7,17) 
-        else if ((fontslur.and.idno.ge.14) .or. idno.eq.15) then
-c
-c  Hairpin end; Compare level with saved start level before user-tweaks
-c
-          lbot1 = min(lbot1,levdsav(ivx))         
-c
-c  Save pre-tweak level
-c
-          lpretweak = lbot1
-        end if
-c
-c  Check for user-defined vertical tweak
-c
-        if (btest(idynd,16)) lbot1 = lbot1-64+igetbits(idynd,7,17)  
-c
-c  Now horizontal stuff
-c
-        hoff = hoffsd
-c
-c  Some special horizontal tweaks
-c
-        if (upstem .and. idno.gt.0 .and. 
-     *      (idno.le.4 .or. idno.eq.8 .or. idno.eq.9)) hoff = hoff+.4
-c
-c  User-defined tweaks
-c
-        if (btest(idynd2,0)) 
-     *          hoff = hoff+(igetbits(idynd2,9,1)-256)*.1
-        if (numdyn .gt. 1) then
-c
-c  Horizontal-interaction-based tweaks.  
-c
-c  Cases:
-c  numdyn  type1   type2    type3    data used
-c     2    wrd-grp hrpnstrt -        ivowg(1...12),hoh1(1...12)
-c     2	 hrpnend wrd-grp  -		   ivowg,hoh2
-c     2    hrpnend hrpnstrt -		   hoh2h1(1...2)
-c     3    hrpnend wrd-grp  hrpnstrt ivowg,hoh2,hoh1
-c
-          if (idno.gt.0 .and. idno.le.12) then
-c
-c  Word-group, may need vertical tweak to line up.
-c
-            lbot1 = lbot1+ivowg(idno)
-c
-c  Protecting against hp start-stop on same note
-c
-          else if (((fontslur.and.idno.ge.14).or.idno.eq.15)
-     *                .and. icntdyn.lt.numdyn) then
-c
-c  Hairpin ending, check next type 
-c
-            if ((fontslur .and. 
-     *             igetbits(idyndat(idynn(icntdyn+1)),4,12).eq.13)
-     *          .or. (.not.fontslur .and.   
-     *             ((igetbits(idyndat(idynn(icntdyn+1)),4,12).eq.13) 
-     *                .or.     
-     *              (igetbits(idyndat(idynn(icntdyn+1)),4,12).eq.14)))) 
-     *                     then
-c
-c  Hairpin end then hairpin start, no words, (remember dealing with end now)
-c
-              hoff = hoff+hoh2h1(1)
-            else	       
-c
-c  Hairpin end then word-group, need idno for w-g to set hp offset
-c
-              hoff = hoff +
-     *                hoh2(igetbits(idyndat(idynn(icntdyn+1)),4,12))
-            end if	       
-c
-c  Protecting against hp start-stop on same note
-c
-          else if (icntdyn.gt.1 .and. idno.gt.0 .and. 
-     *            ((fontslur.and.idno.lt.14).or.
-     *                    (.not.fontslur.and.idno.lt.15))) then
-c
-c  Hairpin start, check prior type
-c
-            if ((fontslur.and.
-     *               igetbits(idyndat(idynn(icntdyn-1)),4,12).ge.14) 
-     *          .or.
-     *          (.not.fontslur.and.
-     *               igetbits(idyndat(idynn(icntdyn-1)),4,12).eq.15))
-     *          then
-c
-c  Hairpin end then hairpin start, (remember dealing with start now)
-c
-              hoff = hoff+hoh2h1(2)
-            else	       
-c
-c  Hairpin start after word-group, need idno for w-g to set hp offset
-c
-              hoff = hoff+
-     *                hoh1(igetbits(idyndat(idynn(icntdyn-1)),4,12))
-            end if
-          end if
-        end if
-c
-c  End of if-block for 2- or 3-way interactions.
-c
-        if ((.not.fontslur) .and. idno.ge.13) 
-c
-c  Slur font and hairpin. Add hoff, and change from \interneote to \qn at width 
-c
-     *          hoff = (hoff+.5)*6./2.5
-c
-c  Position corrections all done now.  Put in the level.
-c
-        if ((fontslur.and.idno.eq.13) .or. 
-     *      ((.not.fontslur).and.(idno.eq.13.or.idno.eq.14))) then
-c
-c  Hairpin start.  
-c
-          if (.not.fontslur) then
-c
-c  Postscript hairpin start...inset placeholder for start level.
-
-            notexq = notexq(1:lnote)//'{   }'
-		  lnote = lnote+5
-          end if
-        else 
-c
-c  Insert actual level in all cases except hairpin start
-c  Create string with level in it
-c
-          if (lbot1 .gt. 9) then
-            numpq = '{'
-            write(numpq(2:3),'(i2)')lbot1
-            numpq = numpq(1:3)//'}'
-            lnumpq = 4
-          else if (lbot1 .gt. -1) then
-            numpq = char(48+lbot1)
-            lnumpq = 1
-          else if (lbot1 .gt. -10) then
-            numpq = '{'
-            write(numpq(2:3),'(i2)')lbot1
-            numpq = numpq(1:3)//'}'
-            lnumpq = 4
-          else
-            numpq = '{'
-            write(numpq(2:4),'(i3)')lbot1
-            numpq = numpq(1:4)//'}'
-            lnumpq = 5
-          end if
-c
-c  Level has now been computed and stored in numpq
-c  Append the level
-c
-          notexq = notexq(1:lnote)//numpq(1:lnumpq)
-          lnote = lnote+lnumpq
-        end if
-        if (abs(hoff) .lt. .001) then
-c
-c  No horiz offset  
-c
-          notexq = notexq(1:lnote)//'0'
-          lnote = lnote+1
-        else
-c
-c  Horizontal tweak
-c
-          lform = lfmt1(hoff)
-          notexq = notexq(1:lnote)//'{'
-          lnote = lnote+1
-          write(notexq(lnote+1:lnote+lform),
-     *             '(f'//chax(48+lform)//'.1)')hoff
-          lnote = lnote+lform
-          notexq = notexq(1:lnote)//'}'
-          lnote = lnote+1
-        end if
-        if (idno .eq. 0) then
-c
-c  text-dynamic.  Find the string and append it
-c
-          do 4 jtxtdyn = jtxtdyn1 , ntxtdyn
-c            ivxip = ivx+16*ip
-            ivxip = ivx+32*ip
-            if (ivxip .eq. ivxiptxt(jtxtdyn)) go to 5
-4         continue
-          call printl('Abnormal stop in putdyn')
-          call stop1()
-5         continue
-          ltxtdyn = lenstr(txtdynq(jtxtdyn),128)
-c
-c  Font size based on musicsize
-c
-          if (musize .eq. 20) then
-            notexq = notexq(1:lnote)//'{'//char(92)//'medtype'
-     *               //char(92)//'it '
-            lnote = lnote+13   
-          else if (musize .eq. 16) then
-            notexq = notexq(1:lnote)//'{'//char(92)//'normtype'
-     *               //char(92)//'it '
-            lnote = lnote+14   
-          else if (musize .eq. 24) then
-            notexq = notexq(1:lnote)//'{'//char(92)//'bigtype'
-     *               //char(92)//'it '
-            lnote = lnote+13   
-          else if (musize .eq. 29) then
-            notexq = notexq(1:lnote)//'{'//char(92)//'Bigtype'
-     *               //char(92)//'it '
-            lnote = lnote+13   
-          end if
-          notexq = notexq(1:lnote)//txtdynq(jtxtdyn)(1:ltxtdyn)
-     *             //'}'
-          lnote = lnote+ltxtdyn+1
-c
-c  Reset jtxtdyn1 just in case >1 txtdyn on same note.
-c
-          jtxtdyn1 = jtxtdyn+1
-        else if (idno .le. 12) then
-c
-c  Letter-group dynamic.  Append the letter-group command
-c
-          id = 4*idno
-          dynstrq = dyntablq(id-3:id)
-          id = lenstr(dynstrq,4)
-          notexq = notexq(1:lnote)//chax(92)//dynstrq(1:id)
-          lnote = lnote+1+id
-        end if 
-        call addstr(notexq(1:lnote),lnote,soutq,lsout)
-        if ((.not.fontslur).and.idno.eq.15) then
-c
-c  PS slurs on, hairpin is ending.  Go back and set height at beginning.
-c  Add user-defined tweak to default level
-c
-          lbot1 = lpretweak+levhssav(ivx)
-          if (lbot1 .gt. 9) then
-            numpq = '{'
-            write(numpq(2:3),'(i2)')lbot1
-            numpq = numpq(1:3)//'}'
-            lnumpq = 4
-          else if (lbot1 .gt. -1) then
-            numpq = char(48+lbot1)
-            lnumpq = 1
-          else if (lbot1 .gt. -10) then
-            numpq = '{'
-            write(numpq(2:3),'(i2)')lbot1
-            numpq = numpq(1:3)//'}'
-            lnumpq = 4
-          else
-            numpq = '{'
-            write(numpq(2:4),'(i3)')lbot1
-            numpq = numpq(1:4)//'}'
-            lnumpq = 5
-          end if
-c
-c  Construct string to search backwards for placeholder
-c
-          if (ivx .le. 9) then
-            tempq = 'cresc'//char(48+ivx)//'{   }'
-            ltemp = 11   
-          else if (ivx .le. 19) then
-            tempq = 'cresc'//'{1'//char(38+ivx)//'}{   }'
-            ltemp = 14   
-          else
-            tempq = 'cresc'//'{2'//char(28+ivx)//'}{   }'
-            ltemp = 14   
-          end if
-          write(11,'(a)')soutq(1:lsout)//'%'
-          lsout = 0
-          call backfill(11,tempq,ltemp,
-     *           tempq(1:ltemp-5)//numpq(1:lnumpq),ltemp-5+lnumpq)
-        end if
-3     continue
-c
-c  Shrink arrays, decrease ndyn 111109
-c
-      do 6 icntdyn = numdyn, 1 , -1
-        do 7 jdyn = idynn(icntdyn) , ndyn-1
-          idyndat(jdyn) = idyndat(jdyn+1) 
-          idynda2(jdyn) = idynda2(jdyn+1)
-7       continue
-        ndyn = ndyn-1
-6     continue
-      end
-      subroutine dograce(ivx,ip,ptgr,soutq,lsout,ncm,nacc,ig,ipl,
-     *  farend,
-     *  beamon,nolev,ncmidx,islur,nvmx,nv,ibmcnt,tnote,ulq,instno)
-c
-c  ip will be one LESS than current note, for way-after's before bar-end,
-c    It is only used to find ig.
-c  ig is returned to makeabar in case there's a slur that needs to be ended
-c
-      parameter (nm=24)
-      logical beamon,stemup
-      common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
-     *                nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
-     *                noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
-     *                graspace(37),
-     *                lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
-     *                naccg(74),voltxtq(6),litq(83)
-      common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
-     *                flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
-     *                rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
-     *                rtshfac
-      common /comask/ bar1syst,fixednew,scaldold,
-     *                wheadpt,fbar,poenom
-      common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
-     *                 ,WrotePsslurDefaults,SlurCurve
-      common /comoct/ noctup
-      logical upg,slurg,slashg,bar1syst,upslur,btest,isgaft,iswaft,
-     *        normsp,farend,fontslur,WrotePsslurDefaults
-      real*4 ptgr(37)
-      character*80 soutq
-      character*128 litq
-      character*79 notexq
-      character*20 voltxtq
-      character*10 figq
-      character*8 noteq,noteqGA
-      character*3 acsymq
-      character*1 sq,chax,udqq,ulq(nm,9)
-      common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
-     *                fullsize(nm),ivxfig2,ivvfig(2,74)
-      sq = chax(92)
-      isgaft = btest(ipl,29)
-      iswaft = btest(ipl,31)
-      normsp = .not. isgaft
-c
-c  Find ig.
-c
-      do 120 ig = 1 , ngrace
-        if (ipg(ig).eq.ip .and. ivg(ig).eq.ivx) go to 121
-120   continue
-      print*,'Problem finding grace index in dograce'
-      stop
-121   continue
-      ngs = ngstrt(ig)
-      mg = multg(ig)
-c	wheadpt1 = wheadpt*fullsize(ivx)
-	wheadpt1 = wheadpt*fullsize(instno)
-c
-c  For way-after-graces at end of bar, must set the octave.
-c
-      if (farend) then
-        noctup = 0
-        if (ncm .eq.23) noctup = -2
-      end if
-      if (slurg(ig) .and. .not.iswaft .and..not.isgaft) then
-         if (listslur .eq. 16777215) then
-          print*
-          print*,'You defined the twentyfifth slur, one too many!'
-          write(15,'(/,a)')
-     *           'You defined the twentyfifth slur, one too many!'
-          call stop1()
-        end if
-c
-c  Slur on fore-grace.  Get index of next slur not in use, from 23 down.
-c
-        ndxslur = log2(16777215-listslur)
-
-      end if
-      if (nng(ig) .eq. 1) then
-c
-c  Single grace.
-c
-        if (normsp) then
-c
-c  Anything but GA
-c
-          call addstr(sq//'shlft',6,soutq,lsout)
-          niptgr = nint(ptgr(ig))
-c
-c  Empirical tweak for postscript.
-c
-C          if (.not.fontslur) niptgr = niptgr+nint(wheadpt*.3)
-c++
-          if (niptgr .lt. 10) then
-            call addstr(chax(48+niptgr)//'{',2,soutq,lsout)
-          else if (niptgr .lt. 100) then
-            write(notexq(1:2),'(i2)')niptgr
-            call addstr('{'//notexq(1:2)//'}{',5,soutq,lsout)
-          else
-            print*,
-     *  'Call Dr. Don if you really want grace note group > 99 pt'
-            stop
-          end if
-        else
-          call addstr(sq//'gaft{1.5}{',11,soutq,lsout)
-c
-c  GA.  Compute aftshft, for later use.
-c
-          aftshft = grafac
-          if (naccg(ngstrt(ig)).gt.0) aftshft = aftshft+agc1fac
-          aftshft = aftshft*wheadpt
-        end if
-        if (slurg(ig) .and. .not.isgaft .and..not.iswaft) then
-c
-c  Start slur on pre-grace.  No accounting needed since will be ended very soon.
-c
-          call notefq(noteq,lnoten,nolevg(ngs),ncm)
-          if (fontslur) then
-            if (upg(ig)) then
-              call addstr(sq//'islurd',7,soutq,lsout)
-            else
-              call addstr(sq//'isluru',7,soutq,lsout)
-            end if
-          else
-c
-c  Start Postscript slur. 
-c
-            if (upg(ig)) then
-              call addstr(sq//'isd',4,soutq,lsout)
-            else
-              call addstr(sq//'isu',4,soutq,lsout)
-            end if
-          end if
-c
-c  Print slur number, 23-ndxslur
-c
-          lnote = 0
-          if (23-ndxslur .lt. 10) then
-c              notexq = notexq(1:lnote)//chax(59-ndxslur)
-            notexq = chax(71-ndxslur)
-            lnote = 1
-          else if (23-ndxslur .lt. 20) then
-c              notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}'
-            notexq = '{1'//chax(61-ndxslur)//'}'
-            lnote = 4
-          else 
-            notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
-            lnote = 4
-          end if
-c          if (11-ndxslur .lt. 10) then
-c            call addstr(chax(59-ndxslur)//noteq(1:lnoten),1+lnoten,
-c     *                 soutq,lsout)
-c          else
-c            call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten),
-c     *            4+lnoten,soutq,lsout)
-c          end if
-          call addstr(notexq(1:lnote)//noteq(1:lnoten),
-     *       lnote+lnoten,soutq,lsout)
-	    if (.not.fontslur) then
-c
-c  Horizontal tweaks for postscript slur on single grace
-c
-            stemup = .true.
-            if (upg(ig)) then
-c
-c  Check for up-grace + down stem. Get stem direction
-c
-              if (.not.beamon) then
-c
-c  Separate note.  Get stem direction.
-c
-                stemup = udqq(nolev,ncmidx,
-     *                     islur,nvmx,ivx,nv) .eq. 'u'
-              else
-c
-c  In a beam
-c
-                stemup = ulq(ivx,ibmcnt) .eq. 'u'
-              end if
-c
-c  Stop the shift if whole note
-c
-              stemup = stemup .or. tnote.gt.63
-            end if
-            if (stemup) then
-              call addstr('{-.3}',5,soutq,lsout)
-            else
-              call addstr('{-.8}',5,soutq,lsout)
-            end if
-          end if
-        end if
-        if (naccg(ngs) .gt. 0) then
-          call notefq(noteq,lnoten,nolevg(ngs),ncm)
-c
-c Save for checking octave shifts in GA
-c
-          if (isgaft) then
-            lnotenGA = lnoten
-            noteqGA = noteq
-          end if
-c
-          if (lnoten .eq. 1) call addblank(noteq,lnoten)
-          call accsym(naccg(ngs),acsymq,lacc)
-          call addstr(sq//'big'//acsymq(1:lacc)//
-     *         noteq(1:lnoten),4+lacc+lnoten,soutq,lsout)
-        end if
-        if (slashg(ig)) then
-          notexq = sq//'grc'
-          lnote = 4
-        else if (mg .eq. 0) then
-          notexq = sq//'zq'
-          lnote = 3
-        else
-          notexq = sq//'zc'
-          do 61 i = 2 , mg
-            notexq = notexq(1:i+1)//'c'
-61        continue
-          lnote = mg+2
-        end if
-        if (upg(ig)) then
-          notexq = notexq(1:lnote)//'u'
-        else
-          notexq = notexq(1:lnote)//'l'
-        end if
-        call addstr(notexq,lnote+1,soutq,lsout)
-        call notefq(noteq,lnoten,nolevg(ngs),ncm)
-c
-        if (isgaft .and. naccg(ngs).eq.0) then
-          lnotenGA = lnoten
-          noteqGA = noteq
-        end if
-c
-        if (lnoten .eq. 1) call addblank(noteq,lnoten)
-        call addstr(noteq,lnoten,soutq,lsout)
-        if (slashg(ig)) call addstr(sq//'off{-'//sq//
-     *      'noteskip}',16,soutq,lsout)
-c
-c  Above code needed since slashg causes spacing
-c
-        if (slurg(ig) .and. (iswaft.or.isgaft)) then
-c
-c  Terminate slur on single after-grace
-c
-c          ndxslur = igetbits(ipl,4,23)
-          ndxslur = igetbits(ipl,5,23)
-          call notefq(noteq,lnoten,nolevg(ngs),ncm)
-          call addstr(sq//'tslur',6,soutq,lsout)
-c
-cc  Print 11-ndxslur
-c  Print 24-ndxslur
-c
-c          if (11-ndxslur .lt. 10) then
-          if (23-ndxslur .lt. 10) then
-c            call addstr(chax(59-ndxslur)//noteq(1:lnoten),
-            call addstr(chax(71-ndxslur)//noteq(1:lnoten),
-     *              1+lnoten,soutq,lsout)
-          else if (23-ndxslur .lt. 20) then
-            call addstr('{2'//chax(61-ndxslur)//'}'//noteq(1:lnoten),
-     *              4+lnoten,soutq,lsout)
-          else
-c            call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten),
-            call addstr('{1'//chax(51-ndxslur)//'}'//noteq(1:lnoten),
-     *              4+lnoten,soutq,lsout)
-          end if
-          slurg(ig) = .false.
-          listslur = ibclr(listslur,ndxslur)
-        end if
-        call addstr('}',1,soutq,lsout)
-c
-c+++  Try to fix loss of octave with single gaft
-c
-c        if (isgaft) call addstr(sq//'zcharnote'//noteq(1:lnoten)//'{~}',
-c     *                          13+lnoten,soutq,lsout)
-        if (isgaft) then
-          itrans = 0
-          do 1 i = 1 , lnotenGA
-            if (noteqGA(i:i) .eq. chax(39)) then
-               itrans = itrans+7
-            else if (noteqGA(i:i) .eq. chax(96)) then
-               itrans = itrans-7
-            end if
-1         continue
-          if (itrans. eq. -14) then
-            call addstr(sq//'advance'//sq//'transpose-14',21,
-     *                  soutq,lsout)                       
-          else if (itrans .eq. -7) then
-            call addstr(sq//'advance'//sq//'transpose-7',20,
-     *                  soutq,lsout)                       
-          else if (itrans .eq. 7) then
-            call addstr(sq//'advance'//sq//'transpose7',19,
-     *                  soutq,lsout)                       
-          else if (itrans .eq. 14) then
-            call addstr(sq//'advance'//sq//'transpose14',20,
-     *                  soutq,lsout)                       
-          end if
-        end if
-      else
-c
-c  Multiple grace.  Put in literally.  Compute beam stuff
-c
-        sumx = 0.
-        sumy = 0.
-        sumxy = 0.
-        sumxx = 0.
-        sumyy = 0.
-        x = 0.
-        do 118 ing = ngs , ngs+nng(ig)-1
-          if (ing.gt.ngs .and. naccg(ing).gt.0) x = x+acgfac
-          y = nolevg(ing)
-          sumx = sumx + x
-          sumy = sumy + y
-          sumxy = sumxy + x*y
-          sumxx = sumxx + x*x
-          sumyy = sumyy + y*y
-          x = x+emgfac
-118     continue
-        delta = nng(ig)*sumxx-sumx*sumx
-        em = (nng(ig)*sumxy-sumx*sumy)/delta
-        islope = nint(0.5*em*gslfac)
-        if (iabs(islope) .gt. 9) islope = isign(9,islope)
-        beta = (sumy-islope/gslfac*sumx)/nng(ig)
-        nolev1 = nint(beta)
-c
-c  Back up
-c
-        notexq = sq//'settiny'//sq//'off{'
-        if (normsp) then
-          write(notexq(14:18),'(a1,f4.1)')'-',ptgr(ig)
-          call addstr(notexq(1:18)//'pt}',21,soutq,lsout)
-          finalshift = ptgr(ig)
-        else
-          aftshft = wheadpt*1.33
-          if (naccg(ngstrt(ig)).gt.0) aftshft = aftshft+wheadpt*0.5
-          write(notexq(14:17),'(f4.1)')aftshft
-          call addstr(notexq(1:17)//'pt}'//sq//'bsk',24,soutq,lsout)
-        end if
-c
-c  Start the beam
-c
-        notexq = sq//'ib'
-        do 119 ing = 2 , mg
-           notexq = notexq(1:ing+1)//'b'
-119     continue
-        if (upg(ig)) then
-          notexq = notexq(1:mg+2)//'u'
-        else
-          notexq = notexq(1:mg+2)//'l'
-        end if
-        notexq = notexq(1:mg+3)//'0'
-c
-c  Get starting note for beam
-c
-        call notefq(noteq,lnoten,nolev1,ncm)
-        call addstr(notexq(1:mg+4)//noteq(1:lnoten),
-     *    mg+4+lnoten,soutq,lsout)
-c
-c  Put in the slope
-c
-        if (islope .ge. 0) then
-          call addstr(chax(48+islope),1,soutq,lsout)
-        else
-          call addstr('{-'//chax(48-islope)//'}',4,soutq,lsout)
-        end if
-c
-c  Start a slur on multiple fore-grace
-c
-        if (slurg(ig) .and. .not.isgaft .and. .not.iswaft) then
-          call notefq(noteq,lnoten,nolevg(ngs),ncm)
-	    if (fontslur) then
-            if (upg(ig)) then
-              call addstr(sq//'islurd',7,soutq,lsout)
-            else
-              call addstr(sq//'isluru',7,soutq,lsout)
-            end if
-          else
-c
-c  Need a tweak for postscript slur
-c
-            if (upg(ig)) then
-              call addstr(sq//'isd',4,soutq,lsout)
-            else
-              call addstr(sq//'isu',4,soutq,lsout)
-            end if
-          end if
-c
-c  Print 11-ndxslur
-c
-          if (23-ndxslur .lt. 10) then
-            call addstr(chax(71-ndxslur)//noteq(1:lnoten),1+lnoten,
-     *                 soutq,lsout)
-          else if (23-ndxslur .lt. 2) then
-            call addstr('{1'//chax(61-ndxslur)//'}'//noteq(1:lnoten),
-     *                  4+lnoten,soutq,lsout)
-          else
-            call addstr('{1'//chax(51-ndxslur)//'}'//noteq(1:lnoten),
-     *                  4+lnoten,soutq,lsout)
-          end if
-c
-c  Put in tweak for postscript slur 
-c
-          if (.not.fontslur) call addstr('{-.3}',5,soutq,lsout)
-        end if
-c
-c  Put in first note.  Call notefq again in case octave changed
-c
-        call notefq(noteq,lnoten,nolevg(ngs),ncm)
-        if (naccg(ngs) .eq. 0) then
-          notexq = sq//'zqb0'//noteq(1:lnoten)
-          lnote = 5+lnoten
-        else
-          if (lnoten .eq. 1) call addblank(noteq,lnoten)
-          call accsym(naccg(ngs),acsymq,lacc)
-          notexq = sq//'big'//acsymq(1:lacc)//noteq(1:lnoten)
-          lnote = 4+lacc+lnoten
-          call notefq(noteq,lnoten,nolevg(ngs),ncm)
-          notexq =notexq(1:lnote)//sq//'zqb0'//noteq(1:lnoten)
-          lnote = lnote+5+lnoten
-        end if
-        call addstr(notexq,lnote,soutq,lsout)
-        do 127 ing = ngs+1 , ngs+nng(ig)-1
-c
-c  Skip
-c
-          ptoff = wheadpt1*emgfac
-          if (naccg(ing).gt.0) ptoff = ptoff+wheadpt1*acgfac
-          if (isgaft .and. .not.iswaft) aftshft = aftshft+ptoff
-          notexq = sq//'off{'
-          write(notexq(6:8),'(f3.1)')ptoff
-          if (normsp) finalshift = finalshift-ptoff
-          call addstr(notexq(1:8)//'pt}',11,soutq,lsout)
-          if (ing .eq. ngs+nng(ig)-1) then
-c
-c  Terminate beam if needed
-c
-            if (upg(ig)) then
-              call addstr(sq//'tbu0',5,soutq,lsout)
-            else
-              call addstr(sq//'tbl0',5,soutq,lsout)
-            end if
-c
-c  Terminate after slur if needed
-c
-            if ((isgaft.or.iswaft) .and. slurg(ig)) then
-c              if (iswaft) ndxslur = igetbits(ipl,4,23)
-              if (iswaft) ndxslur = igetbits(ipl,5,23)
-              call notefq(noteq,lnoten,nolevg(ing),ncm)
-              call addstr(sq//'tslur',6,soutq,lsout)
-c
-c  Print 11-ndxslur
-cc  Print 23-ndxslur
-c
-              if (23-ndxslur .lt. 10) then
-                call addstr(chax(71-ndxslur)//noteq(1:lnoten),
-     *              1+lnoten,soutq,lsout)
-              else if (23-ndxslur .lt. 20) then
-                call addstr('{2'//chax(61-ndxslur)//'}'
-     *                      //noteq(1:lnoten),4+lnoten,soutq,lsout)
-              else
-                call addstr('{1'//chax(51-ndxslur)//'}'
-     *                      //noteq(1:lnoten),4+lnoten,soutq,lsout)
-              end if
-c
-c  Stop slur terminator after exit from this subroutine
-c
-              listslur = ibclr(listslur,ndxslur)
-              slurg(ig) = .false.
-            end if
-          end if
-c
-c  Accidental if needed
-c
-          if (naccg(ing).gt.0) then
-            call notefq(noteq,lnoten,nolevg(ing),ncm)
-            if (lnoten .eq. 1) call addblank(noteq,lnoten)
-            call accsym(naccg(ing),acsymq,lacc)
-            call addstr(sq//'big'//acsymq(1:lacc)
-     *                  //noteq(1:lnoten),4+lacc+lnoten,soutq,lsout)
-          end if
-c
-c  Put in the (beamed) grace note
-c
-          call notefq(noteq,lnoten,nolevg(ing),ncm)
-          call addstr(sq//'zqb0'//noteq(1:lnoten),5+lnoten,
-     *                soutq,lsout)
-127     continue
-c
-c  Terminate the grace
-c
-c        notexq = sq//'normalnotesize'//sq//'off{'
-c        lnote = 20
-c        notexq = '}'//sq//'off{'
-c        lnote = 6
-        notexq = sq//'off{'
-        lnote = 5
-        ptoff = wheadpt*emgfac
-        if (iand(nacc,3).gt.0 .and. .not.btest(nacc,17)) 
-     *       ptoff = ptoff+wheadpt*accfac
-        if (isgaft .and. .not.iswaft) then
-          notexq = notexq(1:5)//'-'
-          lnote = 6
-          ptoff = aftshft
-        end if
-        if (normsp) ptoff = finalshift
-        if (ptoff .lt. 9.95) then
-          write(notexq(lnote+1:lnote+3),'(f3.1)')ptoff
-          lnote = lnote+3
-        else if (ptoff .lt. 99.95) then
-          write(notexq(lnote+1:lnote+4),'(f4.1)')ptoff
-          lnote = lnote+4
-	  else 
-          write(notexq(lnote+1:lnote+5),'(f5.1)')ptoff
-          lnote = lnote+5
-        end if
-        call addstr(notexq(1:lnote)//'pt}',lnote+3,soutq,lsout)
-        if (isgaft.and..not.iswaft) call addstr(sq//'sk',3,soutq,lsout)
-        call addstr(sq//'resetsize',10,soutq,lsout)
-      end if
-      return
-      end
-      subroutine dopsslur(nolev,isdat1,isdat2,isdat3,isdat4,nsdat,ip,
-     *                    iv,kv,nv,beamon,ncm,soutq,lsout,ulq,islur,
-     *                    ipl,iornq,islhgt,tno,nacc)
-c
-c  Called once per main note.  
-c  12 May 2002  Create this subroutine to isolate postscript slurs/ties.
-c    Always set \Nosluradjust\Notieadjust
-c
-      parameter (nm=24,mv=24576)
-      integer*4 isdat1(202),isdat2(202),isdat3(202),isdat4(202)
-      common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
-     *                 ,WrotePsslurDefaults,SlurCurve
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      common /comsln/ is1n1,is2n1,irzbnd,isnx
-      character*1 ulq,slurudq,udfq,udqq,chax
-      character*79 notexq
-      character*8 noteq
-      character*80 soutq
-      logical upslur,beamon,btest,stemup,iscrd,
-     *        settie,fontslur,pstie,WrotePsslurDefaults
-      logical slmon,dbltie
-      common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm),
-     *       naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl,
-     *       slmon(0:nm),dbltie
-      integer*2 mmidi,iinsiv
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
-     *  instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
-      logical EarlyTransOn,LaterInstTrans
-c 130316
-      common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
-     *                ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
-c
-c  Bits in isdat1:
-c  13-17    iv
-c  3-10     ip
-c  11       start/stop switch
-c  12       kv-1
-c  19-25    ichar(code$)
-c  26       force direction?
-c  27       forced dir'n = up if on, set in sslur; also
-c           final direction, set in doslur when beam is started, used on term.
-c  28-31    mod(ndxslur,16), set in doslur when slur is started, used on term.
-c  18       int(ndxslur/16), ditto. So this allows ndxslur>15.
-c  2        stem slur flag
-c
-c  Bits in isdat2
-c  0        Chord switch.  Not set on main note.
-c  1-2      left/right notehead shift.  Set only for chord note.
-c  3        tie positioning
-c  4        dotted flag
-c  6-11     voff1 1-63  =>  -31...+31
-c  12-18    hoff1 1-127 => -6.3...+6.3
-c  19-25    nolev
-c  26       \sluradjust    (p+s)
-c  27       \nosluradjust  (p-s)
-c  28       \tieadjust     (p+t)
-c  29       \notieadjust   (p-t)
-c
-c  Bits in isdat3: Only used for slur endings
-c  0        set if midslur (at least one argument)
-c  1        set if curve (2 more args)
-c  2-7      32+first arg (height correction) (1st arg may be negative)
-c  8-10     second arg (initial slope)
-c  11-13    third arg (closing slope)
-c  14-21    tie level for use in LineBreakTies
-c  22-29    ncm for use in LineBreakTies
-c
-c  Bits in isdat4  Only used for linebreak slurs
-c  0-5      Linebreak seg 1 voff 1-63  =>  -31...+31  
-c  6-12     Linebreak seg 1 hoff 1-127 => -6.3...+6.3
-c  16-21    Linebreak seg 2 voff 1-63  =>  -31...+31
-c  22-28    Linebreak seg 2 hoff 1-127 => -6.3...+6.3
-c
-c  In listslur bit ib is on if slur index ib is in use, ib=0-13.
-c  ndxslur = slur index
-c  Height of slur is nole+ivoff+iupdn.  iupdn is +/-1 if t&s slurs on same note,
-c  s-slur is blank (idcode=32), t-slur is idcode=1.
-c  ivoff is user-defined shift or shift due to . or _ , or chord adjustment.
-c  Ivoff will be set for ./_ only if no user-defined shift is specified.
-c  If highest note has upslur, save slur height in islhgt in case
-c  ornament must be moved.
-c
-      islhgt = 0
-      if (beamon) then
-        stemup = ulq .eq. 'u'
-      else if (nvmx(iv) .eq. 2) then
-        if (.not.btest(islur,30)) then
-c
-c  Single note, 2 lines of music, stem direction not forced
-c
-          stemup = ivx .gt. nv
-        else
-          stemup = btest(islur,17)
-        end if
-      else
-        stemup = udqq(nolev,ncm,islur,nvmx(iv),ivx,nv) .eq. 'u'
-      end if
-      iscrd = btest(ipl,10)
-      if (ismidi) then
-        settie = .false.
-        dbltie = .false.
-      end if
-      do 1 isdat = 1 , nsdat
-        isdata = isdat1(isdat)
-        if (iv .eq. igetbits(isdata,5,13) .and.
-     *      ip .eq. igetbits(isdata,8,3) .and.
-     *            kv .eq. igetbits(isdata,1,12)+1) then
-c
-c  Since iv and kv match, ivx will be correct
-c
-          idcode = igetbits(isdata,7,19)
-          ivoff = igetbits(isdat2(isdat),6,6)-32
-          ihoff = igetbits(isdat2(isdat),7,12)-64
-          iupdn = 0
-          slurudq = 'd'
-          nolevs = igetbits(isdat2(isdat),7,19)
-          pstie = btest(isdat2(isdat),3) .or. idcode.eq.1
-          if (btest(isdata,11)) then
-c
-c  Turnon
-c  Get slur direction
-c
-            if (btest(isdata,26)) then
-c
-c  Force slur direction
-c
-              if (btest(isdata,27)) slurudq = 'u'
-            else if (nvmx(iv) .eq. 1) then
-c
-c  Only one voice per line
-c
-              if (.not.beamon) then
-c
-c  Separate note.
-c
-                slurudq = udfq(nolev,ncm)
-              else
-c
-c  In a beam
-c
-                if (ulq .ne. 'u') slurudq = 'u'
-              end if
-              if (iscrd) then
-                if (nolevs .gt. ncm) then
-                  slurudq = 'u'
-                else
-                  slurudq = 'd'
-                end if
-              end if
-            else
-c
-c  Two voices per line.  Get default
-c
-              if (ivx .gt. nv) slurudq = 'u'
-c
-c  Upper voice of the two, so up slur
-c
-            end if
-            if (btest(isdata,2)) then
-c
-c  ADjust for stem slur. ASSUME this is the ONLY pos'n adjustment.
-c
-              if (stemup) then
-                slurudq = 'u'
-                ivoff = ivoff+4
-              else
-                slurudq = 'd'
-                ivoff = ivoff-4
-              end if
-            end if
-c
-c  Set level for slur starting on rest
-c
-            if (nolevs.eq.0 .or. nolevs.gt.60) then
-              if (slurudq .eq. 'u') then
-                nolevs = ncm+2
-              else
-                nolevs = ncm-2
-              end if
-            end if
-c
-c  Save up/down-ness for use at termination
-c
-            if (slurudq .eq. 'u') isdata = ibset(isdata,27)
-c
-c  End of section for setting slur direction, still in "Turnon" if-block.
-c
-            if (btest(iornq,11).or.btest(iornq,12)) then
-c
-c  Raise or lower slur by one unit provided . or _ is on same side as slur
-c
-              ivoffinc = 0
-              if ((stemup .and. slurudq.eq.'d') .or.
-     *             (.not.stemup .and. slurudq.eq.'u')) then
-c
-c  Must move the slur for _ or .
-c
-                if (stemup) then
-                  ivoffinc = -1
-                else
-                  ivoffinc = 1
-                end if
-                if (((stemup      .and. nolev.ge.ncm-2) .or.
-     *              (.not.stemup .and. nolev.le.ncm+2)) .and.
-     *                mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc
-                ivoff = ivoff+ivoffinc
-              end if
-            end if
-            if (listslur .eq. 16777215) then
-              print*
-              print*,'You1 defined the twentyfifth slur, one too many!'
-              write(15,'(/,a)')
-     *               'You defined the twentyfifth slur, one too many!'
-              call stop1()
-            end if
-c
-c  Get index of next slur not in use, starting from 12 down
-c
-            ndxslur = log2(16777215-listslur)
-c      write(*,'()')
-c      write(*,'(2i4,2x,B24)')ivx,ndxslur,listslur
-c
-c  Record slur index
-c
-            listslur = ibset(listslur,ndxslur)
-c      write(*,'(10x,B24)')listslur
-c
-c  Save for use on termination
-c
-c            call setbits(isdata,4,28,ndxslur)
-c  080531  Allow >16 slurs
-            call setbits(isdata,4,28,mod(ndxslur,16))
-            call setbits(isdata,1,18,ndxslur/16)
-c
-c  Shift for stem?
-c
-            if (stemup .and. slurudq.eq.'u' .and. tno.lt.63.) then
-              if (.not.pstie) then
-                ihoff = ihoff+8
-              else
-                ihoff = ihoff+2
-              end if
-	      end if
-            if (iscrd) then
-c
-c  Additional horiz shifts for h-shifted noteheads?
-c
-              if (btest(isdat2(isdat),1)) then
-c
-c  Slur start on left-shifted chord notehead.  ASSUME downstem.
-c
-                if (nolevs.eq.minlev .and. slurudq.eq.'d') then
-                  ihoff = ihoff-2
-                else
-                  ihoff = ihoff-10
-                end if
-              else if (btest(isdat2(isdat),2)) then
-c
-c  Right shifted chord notehead.  ASSUME upstem.
-c
-                if (nolevs.eq.maxlev .and. slurudq.eq.'u') then
-                  ihoff = ihoff+2
-                else
-                  ihoff = ihoff+10
-                end if
-              end if
-            end if
-            notexq = chax(92)
-            lnote = 1
-c
-c  Check for local adjustment default changes
-c
-            if (btest(isdat2(isdat),26)) then
-              notexq = chax(92)//'sluradjust'//chax(92)
-	        lnote = 12
-            else if (btest(isdat2(isdat),27)) then
-              notexq = chax(92)//'nosluradjust'//chax(92)
-	        lnote = 14
-            else if (btest(isdat2(isdat),28)) then
-              notexq = chax(92)//'tieadjust'//chax(92)
-	        lnote = 11
-            else if (btest(isdat2(isdat),29)) then
-              notexq = chax(92)//'notieadjust'//chax(92)
-	        lnote = 13
-            end if
-            if (ihoff .eq. 0) then
-c
-c  Write stuff for non-shifted start
-c
-              notexq = notexq(1:lnote)//'islur'//slurudq
-              lnote = lnote+6
-            else
-              notexq = notexq(1:lnote)//'is'//slurudq
-              lnote = lnote+3
-            end if
-c
-c  Prepend postscript tie switch
-c
-            if (pstie) then 
-              notexq = chax(92)//'tieforis'//slurudq//notexq(1:lnote)
-              lnote = lnote+10
-            end if
-            if (btest(isdat2(isdat),4)) then
-c
-c  Dotted slur
-c
-c              noteq = notexq
-c              notexq = chax(92)//'dotted'//noteq
-              notexq = chax(92)//'dotted'//notexq(1:lnote)
-              lnote = lnote+7
-            end if
-c
-c  Add slur index to string
-cc  Print 11-ndxslur
-c  Print 23-ndxslur
-c
-c            if (11-ndxslur .lt. 10) then
-            if (23-ndxslur .lt. 10) then
-c
-c  5/25/08 Allow 24 slurs
-c
-c              notexq = notexq(1:lnote)//chax(59-ndxslur)
-              notexq = notexq(1:lnote)//chax(71-ndxslur)
-              lnote = lnote+1
-            else if (23-ndxslur .lt. 20) then
-c              notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}'
-              notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}'
-              lnote = lnote+4
-            else 
-              notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
-              lnote = lnote+4
-            end if
-c
-c  Add note name to string
-c
-c            call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm)
-            islhgt = nolevs+iupdn+ivoff
-            call notefq(noteq,lnoten,islhgt,ncm)
-            notexq = notexq(1:lnote)//noteq(1:lnoten)
-            lnote = lnote+lnoten
-c
-c  Store height and staff mid level for use with LineBreakTies 
-c
-            call setbits(isdat3(isdat),8,14,islhgt)
-            call setbits(isdat3(isdat),8,22,ncm)
-c
-c  Save height (for ornament and barnobox interference) if topmost slur is up
-c
-            if (slurudq.eq.'u' .and.
-     *           (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then
-              islhgt = nolevs+iupdn+ivoff
-c
-c  Save height & idcode if top voice and slur start
-c
-              if (ivx.eq.ivmx(nv,nvmx(nv)) .and. islhgt.gt.is1n1) then
-                is1n1 = islhgt
-                is2n1 = idcode
-              end if
-            end if
-            if (ihoff .ne. 0.) then
-              shift = ihoff*0.1
-              notexq = notexq(1:lnote)//'{'
-              lnote = lnote+1
-              lform = lfmt1(shift)
-              write(notexq(lnote+1:lnote+lform),'(f'//
-     *                  chax(48+lform)//'.1)') shift
-              lnote = lnote+lform
-              notexq = notexq(1:lnote)//'}'
-              lnote = lnote+1
-            end if
-            call addstr(notexq,lnote,soutq,lsout)
-c
-c  Zero out ip1 to avoid problems if slur goes to next input blk.
-c
-            call setbits(isdata,8,3,0)
-c
-c  Set slur-on data for midi.  Only treat null-index slurs and ps ties for now.
-c
-            if (ismidi .and. (idcode.eq.32 .or. idcode.eq.1)) then
-c              levson(midchan(iv,kv)) = nolevs
-c 130316
-c              levson(midchan(iv,kv)) = nolevs-iTransAmt(instno(iv))
-              levson(midchan(iv,kv)) = nolevs+miditran(instno(iv))
-              if (settie) dbltie = .true.
-c
-c  Only way settie=T is if we just set a tie ending.  So there's also a slur
-c   start here, so set a flag telling addmidi not to zero out levson
-c 
-            end if
-          else
-c
-c  Slur is ending.  Back thru list to find starting slur
-c
-            do 3 j = isdat-1 , 1 , -1
-              if (iv.eq.igetbits(isdat1(j),5,13) .and.
-     *            kv.eq.igetbits(isdat1(j),1,12)+1) then
-                if (idcode .eq. igetbits(isdat1(j),7,19)) then
-                  ndxslur = igetbits(isdat1(j),4,28)
-c
-c  080531 Allow >16 slurs
-c
-     *                          +16*igetbits(isdat1(j),1,18)
-                  if (btest(isdat1(j),27)) slurudq = 'u'
-                  go to 4
-                end if
-              end if
-3           continue
-            print*,'Bad place in doslur'
-            call stop1()
-4           continue
-c
-c  Bugfix 070901 for slur ending on rest in 2-voice staff
-c
-c            if (nolevs.eq.0 .or. nolevs.gt.60) then
-            if (nolevs.le.2 .or. nolevs.gt.60) then
-c
-c  Ending is on a rest, reset nolevs to default starting height
-c
-              nolevs = igetbits(isdat2(j),7,19)
-            end if
-            if (btest(isdat3(isdat),0) .or. btest(isdat3(j),0)) then
-c
-c  Deal with \curve or \midslur. isdat is ending, j is start.
-c
-              if (btest(isdat3(isdat),0)) then
-                imid = igetbits(isdat3(isdat),6,2)-32 
-              else
-                imid = igetbits(isdat3(j),6,2)-32 
-              end if
-c
-c  Postscript slurs, and \midslur adjustment is needed.  Invoke macro 
-c   (from pmx.tex) that redefines \tslur as r'qd.  Tentative mapping:
-c       Abs(imid)  Postscript slur type
-c          1          f
-c          2-3        default
-c          4          h
-c          5          H
-c          6+         HH
-c
-              call addstr(chax(92)//'psforts'//
-     *                      chax(48+min(abs(imid),6)),9,soutq,lsout)
-            end if
-            if (btest(isdata,2)) then
-c
-c  ADjust for stem slur. 
-c
-              if (stemup) then
-                slurudq = 'u'
-                ivoff = ivoff+4
-              else
-                slurudq = 'd'
-                ivoff = ivoff-4
-              end if
-            end if
-c
-c  Shift slur ending for stem on any note?
-c
-            if (.not.stemup .and. slurudq.eq.'d' .and. tno.lt.63.) then
-              if (.not.pstie) then
-                ihoff = ihoff-8
-              else
-                ihoff = ihoff-3
-              end if
-            end if
-            if (iscrd) then
-c
-c  Shift termination for shifted notehead?
-c
-              if (btest(isdat2(isdat),1)) then
-c
-c  Left-shifted chord notehead.  ASSUME downstem.
-c
-                if (nolevs.eq.minlev .and. slurudq.eq.'d') then
-                  ihoff = ihoff-2
-                else
-                  ihoff = ihoff-10
-                end if
-              else if (btest(isdat2(isdat),2)) then
-c
-c  Right shifted chord notehead.  ASSUME upstem.
-c
-                if (nolevs.eq.maxlev .and. slurudq.eq.'u') then
-                  ihoff = ihoff+2
-                else
-                  ihoff = ihoff+10
-                end if
-              end if
-            end if
-            if (ihoff .eq. 0) then
-              notexq = chax(92)//'tslur'
-              lnote = 6
-            else
-c
-c  Shift needed
-c
-              notexq = chax(92)//'ts'
-              lnote = 3
-            end if
-c
-c  Switch to postscript tie
-c
-            if (pstie) then
-              notexq = chax(92)//'tieforts'//notexq(1:lnote)
-              lnote = lnote+9
-            end if
-c
-c  Print 13-ndxslur
-c  5/25/08 Allow 14 slurs
-c
-            if (23-ndxslur .lt. 10) then
-              notexq = notexq(1:lnote)//chax(71-ndxslur)
-              lnote = lnote+1
-            else if (23-ndxslur .lt. 20) then
-              notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}'
-              lnote = lnote+4
-            else 
-              notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
-              lnote = lnote+4
-            end if
-            if (btest(iornq,11).or.btest(iornq,12)) then
-c
-c  Raise or lower slur by one unit provided . or _ is on same side as slur
-c
-              ivoffinc = 0
-              if ((stemup .and. slurudq.eq.'d') .or.
-     *                 (.not.stemup .and. slurudq.eq.'u')) then
-                if (stemup) then
-                  ivoffinc = -1
-                else
-                  ivoffinc = 1
-                end if
-                if (((stemup .and. nolev.ge.ncm-2) .or.
-     *              (.not.stemup .and. nolev.le.ncm+2)) .and.
-     *               mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc
-              end if
-              ivoff = ivoff+ivoffinc
-            end if
-            call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm)
-            if (slurudq.eq.'u' .and.
-     *           (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then
-              islhgt = nolevs+iupdn+ivoff
-c
-c  If topvoice, upslur, and idcode checks, no more need to keep hgt for barno.
-c
-              if (ivx.eq.ivmx(nv,nvmx(nv)) .and. is1n1.gt.0) then
-                if (idcode .eq. is2n1) is1n1=0
-              end if
-            end if
-            notexq = notexq(1:lnote)//noteq(1:lnoten)
-            lnote = lnote+lnoten
-            if (ihoff .ne. 0) then
-              shift = ihoff*0.1
-              notexq = notexq(1:lnote)//'{'
-              lnote = lnote+1
-              lform = lfmt1(shift)
-              write(notexq(lnote+1:lnote+lform),
-     *            '(f'//chax(48+lform)//'.1)')shift
-              lnote = lnote+lform
-              notexq = notexq(1:lnote)//'}'
-              lnote = lnote+1
-            end if
-            call addstr(notexq,lnote,soutq,lsout)
-c
-c  Clear the bit from list of slurs in use
-c
-            listslur = ibclr(listslur,ndxslur)
-c
-c  Zero out the entire strings for start and stop
-c
-            isdata = 0
-            isdat2(isdat) = 0
-            isdat3(isdat) = 0
-            isdat4(isdat) = 0
-            isdat1(j) = 0
-            isdat2(j) = 0
-            isdat3(j) = 0
-            isdat4(j) = 0
-c
-c  Set midi info for slur ending
-c
-            if (ismidi .and. (idcode.eq.32 .or. idcode.eq.1)) then  
-              icm = midchan(iv,kv)
-              if (slmon(icm)) then
-c                if (nolevs.eq.levson(icm) .and. iand(7,nacc).eq.0) then
-c 130316
-c                if (nolevs-iTransAmt(instno(iv)).eq.levson(icm) .and.
-                if (nolevs+miditran(instno(iv)).eq.levson(icm) .and.
-     *                iand(7,nacc).eq.0) then
-c
-c  There is a tie here.  NB!!! assumed no accidental on 2nd member of tie.
-c
-c                  levsoff(icm) = nolevs
-c 130316
-c                  levsoff(icm) = nolevs-iTransAmt(instno(iv))
-                  levsoff(icm) = nolevs+miditran(instno(iv))
-                  settie = .true.
-                else
-                  levsoff(icm) = 0
-                  levson(icm) = 0
-                  slmon(icm) = .false.
-                end if
-              end if
-            end if 
-          end if
-          isdat1(isdat) = isdata
-        end if
-1     continue
-c
-c  Clear and collapse the slur data list
-c
-      numdrop = 0
-      do 2 isdat  = 1 , nsdat
-        if (isdat1(isdat) .eq. 0) then
-          numdrop = numdrop+1
-        else if (numdrop .gt. 0) then
-          isdat1(isdat-numdrop) = isdat1(isdat)
-          isdat2(isdat-numdrop) = isdat2(isdat)
-          isdat3(isdat-numdrop) = isdat3(isdat)
-          isdat4(isdat-numdrop) = isdat4(isdat)
-          isdat1(isdat) = 0
-          isdat2(isdat) = 0
-          isdat3(isdat) = 0
-          isdat4(isdat) = 0
-        end if
-2     continue
-      nsdat = nsdat-numdrop
-c      call report(nsdat,isdat1,isdat2)
-      return
-      end
-      subroutine doslur(nolev,isdat1,isdat2,isdat3,nsdat,ip,iv,kv,nv,
-     *     beamon,ncm,soutq,lsout,ulq,islur,ipl,iornq,islhgt,tno,nacc)
-c
-c  Called once per main note.  (5/26/02) for non-ps slurs only
-c
-      parameter (nm=24,mv=24576)
-      integer*4 isdat1(202),isdat2(202),isdat3(202)
-      common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
-     *                 ,WrotePsslurDefaults,SlurCurve
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      common /comsln/ is1n1,is2n1,irzbnd,isnx
-      character*1 ulq,slurudq,udfq,udqq,chax
-      character*79 notexq
-      character*8 noteq
-      character*80 soutq
-      logical upslur,beamon,btest,stemup,iscrd,sfound,tfound,tmove,
-     *        settie,fontslur,WrotePsslurDefaults
-      logical slmon,dbltie
-      common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm),
-     *       naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl,
-     *       slmon(0:nm),dbltie
-      integer*2 mmidi,iinsiv
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
-     *  instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
-      logical EarlyTransOn,LaterInstTrans
-c 130316
-      common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
-     *                ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
-c
-c  Bits in isdat1:
-c  13-17    iv
-c  3-10     ip
-c  11       start/stop switch
-c  12       kv-1
-c  19-25    ichar(code$)
-c  26       force direction?
-c  27       forced dir'n = up if on, set in sslur; also
-c           final direction, set in doslur when beam is started, used on term.
-c  28-31    ndxslur, set in doslur when beam is started, used on term.
-c
-c  Bits in isdat2
-c  0        Chord switch.  Not set on main note.
-c  1-2      left/right notehead shift.  Set only for chord note.
-c  3        tie positioning
-c  4        dotted flag
-c  6-11     voff1 1-63  =>  -31...+31
-c  12-18    hoff1 1-127 => -6.3...+6.3
-c  19-25    nolev
-c
-c  Bits in isdat3: Only used for slur endings
-c  0        set if midslur (at least one argument)
-c  1        set if curve (2 more args)
-c  2-7      32+first arg (height correction) (1st arg may be negative)
-c  8-10     second arg (initial slope)
-c  11-13    third arg (closing slope)
-c
-c  In listslur bit ib is on if slur index ib is in use, ib=0-23.
-c  ndxslur = slur index
-c  Height of slur is nole+ivoff+iupdn.  iupdn is +/-1 if t&s slurs on same note,
-c  s-slur is blank (idcode=32), t-slur is idcode=1.
-c  ivoff is user-defined shift or shift due to . or _ , or chord adjustment.
-c  Ivoff will be set for ./_ only if no user-defined shift is specified.
-c  If highest note has upslur, save slur height in islhgt in case
-c  ornament must be moved.
-c
-      islhgt = 0
-      if (beamon) then
-        stemup = ulq .eq. 'u'
-      else if (nvmx(iv) .eq. 2) then
-        if (.not.btest(islur,30)) then
-c
-c  Single note, 2 lines of music, stem direction not forced
-c
-          stemup = ivx .gt. nv
-        else
-          stemup = btest(islur,17)
-        end if
-      else
-        stemup = udqq(nolev,ncm,islur,nvmx(iv),ivx,nv) .eq. 'u'
-      end if
-      iscrd = btest(ipl,10)
-      if (btest(islur,1)) then
-c
-c  't'-slur (idcode=1) somewhere on this note.  Find it, check height against
-c    's'-slur (idcode=32)
-c
-        sfound = .false.
-        tfound = .false.
-        tmove = .false.
-        do 5 isdat = 1 , nsdat
-          if (iv .eq. igetbits(isdat1(isdat),5,13) .and.
-     *          ip .eq. igetbits(isdat1(isdat),8,3) .and.
-     *              kv .eq. igetbits(isdat1(isdat),1,12)+1) then
-            if (.not.tfound) then
-              tfound = igetbits(isdat1(isdat),7,19).eq.1
-              if (tfound) then
-                nolevt = igetbits(isdat2(isdat),7,19)
-                isdatt = isdat
-                if (sfound) go to 6
-              end if
-            end if
-            if (.not.sfound) then
-              sfound = igetbits(isdat1(isdat),7,19).eq.32
-              if (sfound) then
-                nolevs = igetbits(isdat2(isdat),7,19)
-                isdats = isdat
-                if (tfound) go to 6
-              end if
-            end if
-          end if
-5       continue
-c
-c  Will come thru here if there is a t with no s, so comment out the following
-c        print*,'Did not find s+t-slurs in doslur'
-c
-6       continue
-        if (sfound .and. tfound)
-     *    tmove = nolevs.eq.nolevt .and.
-c
-c  Check if 2 starts or two stops
-c
-     *     ((btest(isdat1(isdats),11).and.btest(isdat1(isdatt),11)) .or.
-     *      (.not.btest(isdat1(isdats),11).and.
-     *                               .not.btest(isdat1(isdatt),11)) )
-c
-c  This is a flag for later changing slur level, after we know slur dir'n.
-c
-      end if
-      if (ismidi) then
-        settie = .false.
-        dbltie = .false.
-      end if
-      do 1 isdat = 1 , nsdat
-        isdata = isdat1(isdat)
-        if (iv .eq. igetbits(isdata,5,13) .and.
-     *      ip .eq. igetbits(isdata,8,3) .and.
-     *            kv .eq. igetbits(isdata,1,12)+1) then
-c
-c  Since iv and kv match, ivx will be correct
-c
-          idcode = igetbits(isdata,7,19)
-          ivoff = igetbits(isdat2(isdat),6,6)-32
-          ihoff = igetbits(isdat2(isdat),7,12)-64
-          iupdn = 0
-          slurudq = 'd'
-          nolevs = igetbits(isdat2(isdat),7,19)
-          if (btest(isdata,11)) then
-c
-c  Turnon, 
-c
-            if (nolevs.eq.0 .or. nolevs.gt.60) then
-c
-c  Note was a rest, cannot start slur on rest.
-c
-              print*
-              call printl('Cannot start slur on a rest')
-              call stop1()
-            end if
-c
-c  Get slur direction
-c
-            if (btest(isdata,26)) then
-c
-c  Force slur direction
-c
-              if (btest(isdata,27)) slurudq = 'u'
-            else if (nvmx(iv) .eq. 1) then
-c
-c  Only one voice per line
-c
-              if (.not.beamon) then
-c
-c  Separate note.
-c
-                slurudq = udfq(nolev,ncm)
-              else
-c
-c  In a beam
-c
-                if (ulq .ne. 'u') slurudq = 'u'
-              end if
-              if (iscrd) then
-                if (nolevs .gt. ncm) then
-                  slurudq = 'u'
-                else
-                  slurudq = 'd'
-                end if
-              end if
-            else
-c
-c  Two voices per line.  Get default
-c
-              if (ivx .gt. nv) slurudq = 'u'
-c
-c  Upper voice of the two, so up slur
-c
-            end if
-c
-c  Save up/down-ness for use at termination
-c
-            if (slurudq .eq. 'u') isdata = ibset(isdata,27)
-c
-c  End of section for setting slur direction, still in "Turnon" if-block.
-c
-            if (idcode.eq.1 .and. tmove) then
-              iupdn = 1
-              if (slurudq .eq. 'd') iupdn = -1
-            end if
-            if (btest(iornq,11).or.btest(iornq,12)) then
-c
-c  Raise or lower slur by one unit provided . or _ is on same side as slur
-c
-              ivoffinc = 0
-              if ((stemup .and. slurudq.eq.'d') .or.
-     *             (.not.stemup .and. slurudq.eq.'u')) then
-c
-c  Must move the slur for _ or .
-c
-                if (stemup) then
-                  ivoffinc = -1
-                else
-                  ivoffinc = 1
-                end if
-                if (((stemup      .and. nolev.ge.ncm-2) .or.
-     *              (.not.stemup .and. nolev.le.ncm+2)) .and.
-     *                mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc
-                ivoff = ivoff+ivoffinc
-              end if
-            end if
-            if (listslur .eq. 16777215) then
-              print*
-              print*,'You1 defined the twenty-fifth slur, one too many!'
-              write(15,'(/,a)')
-     *               'You2 defined the twenty-fifth slur, one too many!'
-              call stop1()
-            end if
-c
-c  Get index of next slur not in use, starting from ? down
-c
-            ndxslur = log2(16777215-listslur)
-c
-c  Record slur index
-c
-            listslur = ibset(listslur,ndxslur)
-c
-c  Save for use on termination
-c
-c            call setbits(isdata,4,28,ndxslur)
-c  080531  Allow >16 slurs
-            call setbits(isdata,4,28,mod(ndxslur,16))
-            call setbits(isdata,1,18,ndxslur/16)
-c
-c  Shift for stem?
-c
-            if (stemup .and. slurudq.eq.'u' .and. tno.lt.63.) 
-     *              ihoff = ihoff+8
-            if (btest(isdat2(isdat),3)) then
-c
-c  Tie spacing, (slur start)
-c
-              if (slurudq.eq.'d') then
-                ivoff = ivoff+1
-                ihoff = ihoff+8
-              else if (slurudq.eq.'u') then
-                ivoff = ivoff-1
-                if (.not.(stemup.and.tno.lt.63.)) ihoff = ihoff+8
-c
-c  (already shifted if (stemup.and.tno.gt.63.) and slurudq='u')
-c
-              end if
-            end if
-            if (iscrd) then
-c
-c  Additional horiz shifts for h-shifted noteheads?
-c
-              if (btest(isdat2(isdat),1)) then
-c
-c  Slur start on left-shifted chord notehead.  ASSUME downstem.
-c
-                if (nolevs.eq.minlev .and. slurudq.eq.'d') then
-                  ihoff = ihoff-2
-                else
-                  ihoff = ihoff-10
-                end if
-              else if (btest(isdat2(isdat),2)) then
-c
-c  Right shifted chord notehead.  ASSUME upstem.
-c
-                if (nolevs.eq.maxlev .and. slurudq.eq.'u') then
-                  ihoff = ihoff+2
-                else
-                  ihoff = ihoff+10
-                end if
-              end if
-            end if
-            if (ihoff .eq. 0) then
-c
-c  Write stuff for non-shifted start
-c
-              notexq = chax(92)//'islur'//slurudq
-              lnote = 7
-            else
-              notexq = chax(92)//'is'//slurudq
-              lnote = 4
-            end if
-            if (btest(isdat2(isdat),4)) then
-c
-c  Dotted slur
-c
-              noteq(1:8) = notexq
-              notexq = chax(92)//'dotted'//noteq
-              lnote = lnote+7
-            end if
-c
-c  Add slur index to string
-cc  Print 11-ndxslur
-c  Print 23-ndxslur
-c
-c            if (11-ndxslur .lt. 10) then
-            if (23-ndxslur .lt. 10) then
-c
-c  5/25/08 Allow 24 slurs
-c
-c              notexq = notexq(1:lnote)//chax(59-ndxslur)
-              notexq = notexq(1:lnote)//chax(71-ndxslur)
-              lnote = lnote+1
-            else if (23-ndxslur .lt. 20) then
-c              notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}'
-              notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}'
-              lnote = lnote+4
-            else 
-              notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
-              lnote = lnote+4
-            end if
-c
-c  Add note name to string
-c
-            call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm)
-            notexq = notexq(1:lnote)//noteq(1:lnoten)
-            lnote = lnote+lnoten
-c
-c  Save height (for ornament and barnobox interference) if topmost slur is up
-c
-            if (slurudq.eq.'u' .and.
-     *           (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then
-              islhgt = nolevs+iupdn+ivoff
-c
-c  Save height & idcode if top voice and slur start
-c
-              if (ivx.eq.ivmx(nv,nvmx(nv)) .and. islhgt.gt.is1n1) then
-                is1n1 = islhgt
-                is2n1 = idcode
-              end if
-            end if
-            if (ihoff .ne. 0.) then
-              shift = ihoff*0.1
-              notexq = notexq(1:lnote)//'{'
-              lnote = lnote+1
-              lform = lfmt1(shift)
-              write(notexq(lnote+1:lnote+lform),'(f'//
-     *                  chax(48+lform)//'.1)') shift
-              lnote = lnote+lform
-              notexq = notexq(1:lnote)//'}'
-              lnote = lnote+1
-            end if
-            call addstr(notexq,lnote,soutq,lsout)
-c
-c  Zero out ip1 to avoid problems if slur goes to next input blk.
-c
-            call setbits(isdata,8,3,0)
-c
-c  Set slur-on data for midi.  Only treat null-index slurs and ps ties for now.
-c
-            if (ismidi .and. idcode.eq.32) then
-c              levson(midchan(iv,kv)) = nolevs
-c 130316
-c              levson(midchan(iv,kv)) = nolevs-iTransAmt(instno(iv))
-              levson(midchan(iv,kv)) = nolevs+miditran(instno(iv))
-              if (settie) dbltie = .true.
-c
-c  Only way settie=T is if we just set a tie ending.  So there's also a slur
-c   start here, so set a flag telling addmidi not to zero out levson
-c 
-            end if
-          else
-c
-c  Slur is ending.  Back thru list to find starting slur
-c
-            do 3 j = isdat-1 , 1 , -1
-              if (iv.eq.igetbits(isdat1(j),5,13) .and.
-     *            kv.eq.igetbits(isdat1(j),1,12)+1) then
-                if (idcode .eq. igetbits(isdat1(j),7,19)) then
-                  ndxslur = igetbits(isdat1(j),4,28)
-c
-c  080531 Allow >16 slurs
-c
-     *                          +16*igetbits(isdat1(j),1,18)
-                  if (btest(isdat1(j),27)) slurudq = 'u'
-                  go to 4
-                end if
-              end if
-3           continue
-            print*,'Bad place in doslur'
-            call stop1()
-4           continue
-            if (nolevs.eq.0 .or. nolevs.gt.60) then
-c
-c  Ending is on a rest, reset nolevs to default starting height
-c
-              nolevs = igetbits(isdat2(j),7,19)
-            end if
-            if (btest(isdat3(isdat),0)) then
-c
-c  Deal with \curve or \midslur
-c
-              imid = igetbits(isdat3(isdat),6,2)-32 
-c
-c  Remember, only dealing with non-ps slurs
-c
-c  Who knows where the following line came from.  Removed it 6/30/02 to 
-c  restore behavior of non-ps slurs to old way
-c              if (slurudq .eq. 'd') imid = -imid
-c  3/8/03 added the following
-c
-              if (slurudq .eq. 'd') imid = -abs(imid)
-c
-              if (btest(isdat3(isdat),1)) then
-                notexq = chax(92)//'curve'
-                lnote = 6
-              else
-                notexq = chax(92)//'midslur'
-                lnote = 8
-              end if
-              if (imid.lt.0 .or. imid.gt.9) then
-c
-c  Need brackets
-c
-                notexq = notexq(1:lnote)//'{'
-                lnote = lnote+1
-                if (imid .lt. -9) then
-                  write(notexq(lnote+1:lnote+3),'(i3)')imid
-                  lnote = lnote+3
-                else if (imid.lt.0 .or. imid.gt.9) then
-                  write(notexq(lnote+1:lnote+2),'(i2)')imid
-                  lnote = lnote+2
-                else
-                  write(notexq(lnote+1:lnote+1),'(i1)')imid
-                  lnote = lnote+1
-                end if
-                notexq = notexq(1:lnote)//'}'
-                lnote = lnote+1
-              else
-c
-c  1=<imid=<9, no brackets
-c
-                notexq = notexq(1:lnote)//char(48+imid)
-                lnote = lnote+1
-              end if
-              if (btest(isdat3(isdat),1)) then
-c
-c  \curve; 3 args
-c
-                notexq = notexq(1:lnote)
-     *                      //char(48+igetbits(isdat3(isdat),3,8))
-                notexq = notexq(1:lnote+1)
-     *                      //char(48+igetbits(isdat3(isdat),3,11))
-                lnote = lnote+2
-              end if 
-              call addstr(notexq,lnote,soutq,lsout)
-            end if
-c
-c  Shift slur ending for stem on any note?
-c
-            if (.not.stemup .and. slurudq.eq.'d' .and. tno.lt.63.) 
-     *                ihoff = ihoff-8
-            if (btest(isdat2(isdat),3)) then
-c
-c  Shift ending for tie spacing
-c
-              if (slurudq .eq. 'u') then
-                ihoff = ihoff-8
-                ivoff = ivoff-1
-              else if (slurudq .eq. 'd') then
-                ivoff = ivoff+1
-                if (stemup.or. tno.gt.63.) ihoff = ihoff-8
-              end if
-            end if
-            if (iscrd) then
-c
-c  Shift termination for shifted notehead?
-c
-              if (btest(isdat2(isdat),1)) then
-c
-c  Left-shifted chord notehead.  ASSUME downstem.
-c
-                if (nolevs.eq.minlev .and. slurudq.eq.'d') then
-                  ihoff = ihoff-2
-                else
-                  ihoff = ihoff-10
-                end if
-              else if (btest(isdat2(isdat),2)) then
-c
-c  Right shifted chord notehead.  ASSUME upstem.
-c
-                if (nolevs.eq.maxlev .and. slurudq.eq.'u') then
-                  ihoff = ihoff+2
-                else
-                  ihoff = ihoff+10
-                end if
-              end if
-            end if
-            if (ihoff .eq. 0) then
-              notexq = chax(92)//'tslur'
-              lnote = 6
-            else
-c
-c  Shift needed
-c
-              notexq = chax(92)//'ts'
-              lnote = 3
-            end if
-c
-c  Print 23-ndxslur
-c  5/25/08 Allow 14 slurs (???????????)
-c
-            if (23-ndxslur .lt. 10) then
-              notexq = notexq(1:lnote)//chax(71-ndxslur)
-              lnote = lnote+1
-            else if (23-ndxslur .lt. 20) then
-              notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}'
-              lnote = lnote+4
-            else 
-              notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
-              lnote = lnote+4
-            end if
-            if (btest(iornq,11).or.btest(iornq,12)) then
-c
-c  Raise or lower slur by one unit provided . or _ is on same side as slur
-c
-              ivoffinc = 0
-              if ((stemup .and. slurudq.eq.'d') .or.
-     *                 (.not.stemup .and. slurudq.eq.'u')) then
-                if (stemup) then
-                  ivoffinc = -1
-                else
-                  ivoffinc = 1
-                end if
-                if (((stemup .and. nolev.ge.ncm-2) .or.
-     *              (.not.stemup .and. nolev.le.ncm+2)) .and.
-     *               mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc
-              end if
-              ivoff = ivoff+ivoffinc
-            end if
-            if (idcode.eq.1 .and. tmove) then
-c
-c  t-slur height adjustment
-c
-              iupdn = 1
-              if (slurudq .eq. 'd') iupdn = -1
-            end if
-            call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm)
-            if (slurudq.eq.'u' .and.
-     *           (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then
-              islhgt = nolevs+iupdn+ivoff
-c
-c  If topvoice, upslur, and idcode checks, no more need to keep hgt for barno.
-c
-              if (ivx.eq.ivmx(nv,nvmx(nv)) .and. is1n1.gt.0) then
-                if (idcode .eq. is2n1) is1n1=0
-              end if
-            end if
-            notexq = notexq(1:lnote)//noteq(1:lnoten)
-            lnote = lnote+lnoten
-            if (ihoff .ne. 0) then
-              shift = ihoff*0.1
-              notexq = notexq(1:lnote)//'{'
-              lnote = lnote+1
-              lform = lfmt1(shift)
-              write(notexq(lnote+1:lnote+lform),
-     *            '(f'//chax(48+lform)//'.1)')shift
-              lnote = lnote+lform
-              notexq = notexq(1:lnote)//'}'
-              lnote = lnote+1
-            end if
-            call addstr(notexq,lnote,soutq,lsout)
-c
-c  Clear the bit from list of slurs in use
-c
-            listslur = ibclr(listslur,ndxslur)
-c
-c  Zero out the entire strings for start and stop
-c
-            isdata = 0
-            isdat2(isdat) = 0
-            isdat1(j) = 0
-            isdat2(j) = 0
-            isdat3(isdat) = 0
-c
-c  Set midi info for slur ending
-c
-            if (ismidi .and. idcode.eq.32) then 
-              icm = midchan(iv,kv)
-              if (slmon(icm)) then
-c                if (nolevs.eq.levson(icm) .and. iand(7,nacc).eq.0) then
-c 130316
-c                if (nolevs-iTransAmt(instno(iv)).eq.levson(icm) .and.
-                if (nolevs+miditran(instno(iv)).eq.levson(icm) .and.
-     *              iand(7,nacc).eq.0) then
-c
-c  There is a tie here.  NB!!! assumed no accidental on 2nd member of tie.
-c
-c                  levsoff(icm) = nolevs
-c 130316
-c                  levsoff(icm) = nolevs-iTransAmt(instno(iv))
-                  levsoff(icm) = nolevs+miditran(instno(iv))
-                  settie = .true.
-                else
-                  levsoff(icm) = 0
-                  levson(icm) = 0
-                  slmon(icm) = .false.
-                end if
-              end if
-            end if 
-          end if
-          isdat1(isdat) = isdata
-        end if
-1     continue
-c
-c  Clear and collapse the slur data list
-c
-      numdrop = 0
-      do 2 isdat  = 1 , nsdat
-        if (isdat1(isdat) .eq. 0) then
-          numdrop = numdrop+1
-        else if (numdrop .gt. 0) then
-          isdat1(isdat-numdrop) = isdat1(isdat)
-          isdat2(isdat-numdrop) = isdat2(isdat)
-          isdat3(isdat-numdrop) = isdat3(isdat)
-          isdat1(isdat) = 0
-          isdat2(isdat) = 0
-          isdat3(isdat) = 0
-        end if
-2     continue
-      nsdat = nsdat-numdrop
-c      call report(nsdat,isdat1,isdat2)
-      return
-      end
-      subroutine dotmov(updot,rtdot,soutq,lsout,iddot)
-c
-c  iddot = 0 for single dot, 1 for double
-c
-      character*80 soutq,notexq
-      character*1 sq,chax
-      sq = chax(92)
-      lfmtup = lfmt1(updot)
-      lfmtrt = lfmt1(rtdot)
-      write(notexq,'(a37,f'//chax(48+lfmtup)//'.1,a2,f'//chax(48+lfmtrt)
-     *    //'.1,a15)')
-     * sq//'makeatletter'//sq//'def'//sq//'C at Point#1#2{'//sq//
-     * 'PMXpt{',updot,'}{',rtdot,'}'//chax(48+iddot)//'}'//sq
-     * //'makeatother'
-c
-c   Example of string just created:
-c   \makeatletter\def\C at Point#1#2{\PMXpt{.5}{.5}}\makeatother\
-c
-      lnote = 54+lfmtup+lfmtrt
-      call addstr(notexq(1:lnote),lnote,soutq,lsout)
-      return
-      end
-      subroutine dotrill(iv,ip,iornq,noteq,lnoten,notexq,lnote)
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      character*1 chax
-      character*8 noteq
-      character*79 notexq
-      logical tronly,btest
-      do 1 itr = 1 , ntrill
-        if (iv.eq.ivtrill(itr) .and. ip.eq.iptrill(itr)) go to 2
-1     continue
-      print*,'Problem in dotrill.  Call Dr. Don'
-      stop
-2     continue
-      tronly = xnsktr(itr) .lt. 0.01
-      if (tronly) then
-        notexq = chax(92)//'zcharnote'
-        lnote = 10
-      else if (btest(iornq,7)) then
-        notexq = chax(92)//'Trille'
-        lnote = 7
-      else
-        notexq = chax(92)//'trille'
-        lnote = 7
-      end if
-      notexq = notexq(1:lnote)//noteq(1:lnoten)//'{'
-      lnote = lnote+lnoten+1
-c
-c  Write trill duration to nearest tenth of a noteskip
-c
-      if (tronly) then
-        notexq = notexq(1:lnote)//chax(92)//'it tr}'
-        lnote = lnote+7
-        return
-      end if
-      if (xnsktr(itr) .lt. .95) then
-        nfmt = 2
-      else if (xnsktr(itr) .lt. 9.95) then
-        nfmt = 3
-      else
-        nfmt = 4
-      end if
-      write(notexq(lnote+1:lnote+nfmt),'(f'//chax(48+nfmt)//'.1)')
-     *   xnsktr(itr)
-      lnote = lnote+nfmt
-      notexq = notexq(1:lnote)//'}'
-      lnote = lnote+1
-      return
-      end
-      subroutine endslur(stemup,upslur,nolev,iupdn,ndxslur,ivoff,ncm,
-     *  soutq,lsout,fontslur)
-c
-c  Only called to end slur started in dograce.
-c
-      logical shift,stemup,upslur,fontslur
-      character*80 soutq
-      character*79 notexq
-      character*8 noteq
-      character*1 chax
-      shift = .not.stemup .and. .not.upslur
-      if (.not.shift) then
-c
-c  No shift needed
-c
-         notexq = chax(92)//'tslur'
-         lnote = 6
-      else
-c
-c  Shift needed
-c
-         notexq = chax(92)//'ts'
-         lnote = 3
-      end if
-c      if (ndxslur .lt. 10) then
-c        notexq = notexq(1:lnote)//chax(48+ndxslur)
-c        lnote = lnote+1
-c      else
-c        notexq = notexq(1:lnote)//'{1'//chax(38+ndxslur)//'}'
-c        lnote = lnote+4
-c      end if
-c
-cc  Print 11-ndxslur
-c  Print 23-ndxslur
-c
-c      if (11-ndxslur .lt. 10) then
-      if (23-ndxslur .lt. 10) then
-c        notexq = notexq(1:lnote)//chax(59-ndxslur)
-        notexq = notexq(1:lnote)//chax(71-ndxslur)
-        lnote = lnote+1
-      else if (23-ndxslur .lt. 20) then
-c              notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}'
-        notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}'
-        lnote = lnote+4
-      else 
-        notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
-        lnote = lnote+4
-      end if
-      call notefq(noteq,lnoten,nolev+iupdn+ivoff,ncm)
-      notexq = notexq(1:lnote)//noteq(1:lnoten)
-      lnote = lnote+lnoten
-      if (shift) then
-        if (fontslur) then 
-          notexq = notexq(1:lnote)//'{-.6}'
-        else
-          notexq = notexq(1:lnote)//'{-.8}'
-        end if
-        lnote = lnote+5
-      end if
-      call addstr(notexq,lnote,soutq,lsout)
-      return
-      end
-      subroutine errmsg(lineq,iccount,ibarno,msgq)
-      parameter(nm=24)
-      common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
-     *     fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
-      logical lastchar,fbon,issegno,isheadr,isvolt
-      character*128 lineq
-      character*78 outq
-      character*(*) msgq
-      character*1 chax
-      common /truelinecount/ linewcom(20000)
-      if (iccount .le. 78) then
-        outq = lineq(1:78)
-        iposn = iccount
-      else
-        outq = '... '//lineq(55:128)
-        iposn = iccount-50
-      end if
-      print*
-      ibarnop = ibarno
-      if (linesinpmxmod.eq.0 .or. 
-     *    nline .gt. line1pmxmod+linesinpmxmod) then
-c
-c  Error is in main .pmx file
-c
-c        nlinep = nline-linesinpmxmod
-c       Correct for comments not copied into buffer
-        nlinep = linewcom(nline)-linesinpmxmod
-      else
-c
-c  Error is in include file
-c
-        ibarnop = 0
-        nlinep = nline-line1pmxmod+1
-        call printl(
-     *    'ERROR in include file named above, description given below')
-      end if
-      open(19,file='pmxaerr.dat')
-      write(19,'(i6)') nlinep
-      close(19)
-      ndigbn = max(1,int(log10(ibarnop+.1)+1))
-      ndignl = int(log10(nlinep+.1)+1)
-      lenmsg = index(msgq,'!')-1
-c
-c  Split off msgq(..) since UNIX compilers don't allow concat substring!!!
-c
-      write(*,'(/,a15,i'//chax(48+ndignl)//',a6,i'//chax(48+ndigbn)//
-     *',$)')' ERROR in line ',nlinep,', bar ',ibarnop
-      write(*,'(1x,a)')msgq(1:lenmsg)
-      write(15,'(/,a15,i'//chax(48+ndignl)//',a6,i'//chax(48+ndigbn)//
-     *',$)')' ERROR in line ',nlinep,', bar ',ibarnop
-      write(15,'(a)')msgq(1:lenmsg)
-      i10 = iposn/10
-      i1 = iposn-10*i10
-      write(*,'('//chax(48+i10)//chax(48+i1)//'x,a)')'v'
-      write(15,'('//chax(48+i10)//chax(48+i1)//'x,a)')'v'
-      print*,outq(1:78)
-      write(15,'(a)')' '//outq(1:78)
-      write(*,'('//chax(48+i10)//chax(48+i1)//'x,a)')'^'
-      write(15,'('//chax(48+i10)//chax(48+i1)//'x,a)')'^'
-      return
-      end
-      subroutine eskb4(ip,ivx,in,ib,space,tstart,fbar,itrpt,esk)
-c
-c  Get elemskips to previous note.  Called only for graces, no xtups involved.
-c
-      parameter (nm=24)
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      character*1 ulq,sepsymq,sq
-      logical beamon,firstgulp,figbass,figchk,isfig
-      real*4 tstart(80),space(80)
-      common /comtol/ tol
-      itnd = nint(to(in))
-      if (ip.eq.1 .or. itnd.eq.itrpt) then
-c
-c  Start of bar or after rpt.
-c
-        esk = fbar
-        return
-      else
-        esk = 0.
-        itprev = itnd-nodur(ivx,ip-1)
-        do 1 iib = ib , 1 , -1
-          if (tstart(iib) .lt. itprev+tol) then
-c
-c  This is the block
-c
-            nnsk = nint(float((itnd-itprev))/space(iib))
-            esk = esk+nnsk*feon(space(iib))
-            return
-          else
-            nnsk = nint((itnd-tstart(iib))/space(iib))
-            esk = esk+nnsk*feon(space(iib))
-            itnd = nint(tstart(iib))
-          end if
-1       continue
-      end if
-      print*,'Problem in eskb4.  Send files to Dr. Don'
-      stop
-      end
-      function f1eon(time)
-        f1eon = sqrt(time/2)
-      return
-      end
-      function feon(time)
-        common /comeon/ eonk,ewmxk
-        feon = sqrt(time/2)**(1.-eonk)*ewmxk
-      return
-      end
-      subroutine findbeam(ibmrep,numbms,mapfb)
-c
-c  Called once per voice per bar, after setting forced beams.
-c
-      parameter (nm=24)
-      dimension mask(49,3),nummask(3),eqonly(49,3)
-c      integer numbms(nm),ipr(48),nip1(0:47),nip2(0:47),mapfb(16),
-c     *       itr(48),nodue(48)
-c      logical short(48),eqonly
-      integer numbms(nm),ipr(248),nip1(0:247),nip2(0:247),mapfb(16),
-     *       itr(248),nodue(248)
-      logical short(248),eqonly
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      common /comipl2/ ipl2(nm,200)
-      common /combeam/ ibmtyp
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      common /comtol/ tol
-      character*1 ulq,sepsymq,sq
-      logical beamon,firstgulp,figbass,figchk,
-     *        isfig,btest
-      data nip1,nip2 /496*0/
-      data nummask / 29 , 49 , 12 /
-      data mask
-     * /  65535,     4095,    65520,      255,    65280,       63,
-     *      252,    16128,    64512,       15,      240,     3840,
-     *    61440,        7,       14,      112,      224,     1792,
-     *     3584,    28672,    57344,        3,       12,       48,
-     *      192,      768,     3072,    12288,    49152, 20*0 ,
-     * 16777215,    65535, 16776960,     4095,    65520,  1048320,
-     * 16773120,      255,    65280, 16711680,       63,      252,
-     *    16128,    64512,  4128768, 16515072,       15,       60,
-     *      240,     3840,    15360,    61440,   983040,  3932160,
-     * 15728640,        7,       14,      112,      224,     1792,
-     *     3584,    28672,    57344,   458752,   917504,  7340032,
-     * 14680064,        3,       12,       48,      192,      768,
-     *     3072,    12288,    49152,   196608,   786432,  3145728,
-     * 12582912,
-     *     4095,      255,     4080,       15,      240,     3840,
-     *        3,       12,       48,      192,      768,     3072,
-     *  37*0 /
-      data eqonly /3*.true.,46*.false.,7*.true.,91*.false./
-      ip = 0
-      nreal = 0
-      itnow = 0
-1     continue
-        ip = ip+1
-        if (ip .gt. nn(ivx)) go to 9
-11      if (nodur(ivx,ip).eq.0) then
-c
-c  Ignore all xtup notes except the last, the one with nodur > 0 .
-c  Xtups are irrelevant here since they are already all in forced beams.
-c  Will update itnow by nodur at the END of this loop
-c
-          ip = ip+1
-          go to 11
-        end if
-        nreal = nreal+1
-        nodue(nreal) = nodur(ivx,ip)
-        short(nreal) = nodue(nreal).lt.16 .and.
-     *                     .not.btest(irest(ivx,ip),0)
-c
-c  Rule out notes that have 'alone'-flag set
-c
-     *   .and..not.btest(islur(ivx,ip),18)
-        ipr(nreal) = ip
-        itr(nreal) = itnow
-        if (nodue(nreal) .eq. 1) then
-c
-c  64th gap
-c
-          if (mod(itnow,2) .eq. 0) then
-c
-c  Start of 32nd gap, lump with following note
-c
-            ip = ip+1
-		  nodue(nreal) = 1+nodur(ivx,ip)
-            itnow = itnow+nodue(nreal)
-          else
-c
-c  End of 32nd gap, lump with preceeding note
-c
-            nreal = nreal-1
-            nodue(nreal) = 1+nodue(nreal)
-            itnow = itnow+1
-          end if
-        else
-          itnow = itnow+nodur(ivx,ip)
-        end if
-      go to 1
-9     continue
-      ir1 = 1
-      itseg = lenbar/ibmrep
-      do 13 irep = 1 , ibmrep
-c
-c  Set bitmaps for all shorts neighbored by a short. Each bit represents a
-c  span of 32nd note.  maps, mapm, mape record start, full duration, and end
-c  of consecutive span of beamable (<1/4) notes.
-c
-        maps = 0
-        mapm = 0
-        mape = 0
-        itend = itseg*irep
-        itoff = itend-itseg
-        do 2 ir = ir1 , nreal
-          it2 = itr(ir)+nodue(ir)-2
-          if (it2 .ge. itend) then
-            ir1 = ir
-            go to 14
-          end if
-c         if (short(ir).and.((ir.gt.1.and.short(ir-1)).or.(ir.lt.nreal
-          if (short(ir).and.((ir.gt.1.and.short(max(ir-1,1))).or.
-     *          (ir.lt.nreal.and.short(ir+1)))) then
-            ib1 = (itr(ir)-itoff)/2
-            ib2 = (it2-itoff)/2
-            if (max(ib1,ib2).gt.47 .or. ir.gt.48 .or.
-     *                       min(ib1,ib2).lt.0) return
-c
-c  Must have an odd number obe beats in a long bar.  Auto-beam won't work
-c
-            nip1(ib1) = ipr(ir)
-            nip2(ib2) = ipr(ir)
-c
-c  nip1,2(ib) = 0 unless a real note starts,ends on bit ib; then = ip
-c
-            maps = ibset(maps,ib1)
-            mape = ibset(mape,ib2)
-            do 3 ib = ib1 , ib2
-              mapm = ibset(mapm,ib)
-3           continue
-          end if
-2       continue
-14      continue
-        if (mapm .eq. 0) go to 13
-c
-c  Zero out bits from forced beams
-c
-        maps = iand(maps,not(mapfb(irep)))
-        mapm = iand(mapm,not(mapfb(irep)))
-        mape = iand(mape,not(mapfb(irep)))
-c
-c  Compare map with template.
-c
-        do 4 it = 1 , nummask(ibmtyp)
-          masknow = mask(it,ibmtyp)
-          if (iand(masknow,mapm) .eq. masknow) then
-c
-c  Find least significant bit in the mask to check start time
-c
-            mtemp = masknow
-            maskm = masknow
-            do 5 is1 = 0 , 47
-              if (iand(1,mtemp) .eq. 1) go to 6
-              mtemp = ishft(mtemp,-1)
-5           continue
-6           continue
-            if (iand(ishft(1,is1),maps) .eq. 0) go to 4
-c
-c  is1 is the bit where the beam starts.  Continue shifting to
-c  find most significant bit in the mask to check ending time
-c
-            do 7 is2 = is1 , 47
-              mtemp = ishft(mtemp,-1)
-              if (iand(1,not(mtemp)) .eq. 1) go to 8
-7           continue
-8           continue
-c
-c  is2 is now the bit on which the beam ends.
-c
-            if (iand(ishft(1,is2),mape) .eq. 0) go to 4
-c
-c  Did we pick out a single note from the middle of a longer sequence?
-c
-            if (nip1(is1) .eq. nip2(is2)) go to 4
-c
-c  We almost have a beam.  Check equality of notes if needed.
-c
-            if (eqonly(it,ibmtyp)) then
-              do 10 ip = nip1(is1) , nip2(is2)
-                if (nodur(ivx,ip) .ne. 8) then
-c
-c  There is a non-1/8th note in this beam. Exit if not 2 quarters
-c
-                  if (is2-is1 .ne. 15) go to 4
-c
-c  Beam is 2 quarters long.  Check if can split in half.
-c
-                  ithalf = 0
-                  do 20 iip = nip1(is1) , nip2(is2)
-                    ithalf = ithalf+nodur(ivx,iip)
-                    if (ithalf .gt. 16) go to 4
-                    if (ithalf .eq. 16) go to 21
-20                continue
-                  print*,'Problem in findbeam, please call Dr. Don'
-                  go to 4
-21                continue
-c
-c  Otherwise, split in half by keeping only the first half.  Other half will
-c  be picked up later, assuming masks are listed longest first.
-c
-                  is2 = is1+7
-c
-c  Reset maskm (since only used part of mask), used later to zero out
-c  bits that contain beams
-c
-                  maskm = 0
-                  do 15 is = is1 , is2
-                    maskm = ibset(maskm,is)
-15                continue
-                  go to 16
-                end if
-10            continue
-            end if
-16          continue
-c
-c  This is a beam.  If last "effective" ends on odd 64th, add 1 more
-c
-c            if (abs(mod(to(iand(255,ipl(ivx,nip2(is2))))
-c     *           +nodur(ivx,nip2(is2)),2.)) .gt. tol) then
-            if (abs(amod(to(ipl2(ivx,nip2(is2)))
-     *           +nodur(ivx,nip2(is2))+.5*tol,2.)) .gt. tol) then
-              nip2(is2) = nip2(is2)+1
-            end if
-            numbms(ivx) = numbms(ivx)+1
-            numnew = numbms(ivx)
-            call logbeam(numnew,nip1(is1),nip2(is2))
-c
-c  Zero out the appropriate bits so these notes don't get used again
-c
-            mapm = iand(mapm,not(maskm))
-            if (mapm.eq.0) go to 13
-            maps = iand(maps,not(maskm))
-            mape = iand(mape,not(maskm))
-          end if
-4       continue
-13    continue
-      return
-      end
-      subroutine findeonk(nptr1,nptr2,wovera,xelsk,dtmin,dtmax,eonk0)
-      parameter (nkb=3999,maxblks=4000)
-c
-c  Compute an exponent eonk for use in the "flattened" formula for elemskips
-c   vs time.  We must solve the eqution f = 0.  Initial quess is eonk0.
-c
-c      logical gotclef
-      common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks),
-     *     iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr,
-c     *     ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks)
-     *     ibaroff,udsp(nkb),wheadpt,sqzb(maxblks)
-      common /comtol/ tol
-      common /comeon/ eonk,ewmxk
-      eonk = eonk0
-      niter = 0
-1     continue
-      ewmxk = f1eon(dtmax)**eonk
-      niter = niter+1
-      esum = 0.
-      desum = 0.
-      do 2 iptr = nptr1 , nptr2
-        targ = durb(iptr)/sqzb(iptr)
-        esum = esum+nnpd(iptr)*sqzb(iptr)*feon(targ)
-        detarg = sqrt(targ/2*(dtmax/targ)**eonk)*alog(dtmax/targ)
-        desum = desum+nnpd(iptr)*sqzb(iptr)*detarg
-2     continue
-      f = wovera*feon(dtmin)-xelsk-esum
-      fp = wovera*sqrt(dtmin/2*(dtmax/dtmin)**eonk)*alog(dtmax/dtmin)
-     *     -desum 
-      if (abs(fp).lt.tol .or. abs(eonk-.5).gt..5 .or. niter.gt.100) then
-        call printl(
-     *     'Error in findeonk.  Please send source to Dr. Don')
-        eonk = 0.
-        ewmxk = 1.
-        return
-      end if
-      dsoln = -f/fp
-      if (abs(dsoln) .lt. .1*tol) return
-c
-c  Not converged yet, try again
-c
-      eonk = eonk+dsoln
-      go to 1
-      end
-      function fnote(nodur,ivx,ip,nacc)
-c
-c  This return the real duration of a note
-c
-      parameter (nm=24)
-      integer*4 nodur(nm,200),nacc(nm,200)
-      logical btest
-      ipback = ip
-      if (nodur(ivx,ip) .gt. 0) then
-        if (ip .gt. 1) then
-c
-c  Check if this is last note of xtup
-c
-          if (nodur(ivx,ip-1).eq.0) then
-            ipback = ip-1
-            go to 2
-          end if
-        end if
-        fnote = nodur(ivx,ip)
-        return
-      end if
-2     continue
-c
-c  Count back to prior non zero note. Start at ip to avoid neg index if ip=1.
-c  Count how many doubled xtups notes there are from ip-1 to first note. 
-c
-      ndoub = 0
-      do 1 ip1m1 = ipback , 1 , -1
-        if (nodur(ivx,ip1m1) .gt. 0) go to 4
-        if (ip1m1.lt.ip .and. btest(nacc(ivx,ip1m1),18)) ndoub=ndoub+1
-1     continue
-4     continue      
-c
-c  count forward to next non-0 nodur. Start at ip in case last note of xtup. 
-c
-      do 3 iip = ip , 200
-c
-c  Count doubled xtup notes from ip to end.
-c
-        if (btest(nacc(ivx,iip),18)) ndoub = ndoub+1
-        if (nodur(ivx,iip) .gt. 0) then
-c          fnote = nodur(ivx,iip)/float(iip-ip1m1)
-          fnote = nodur(ivx,iip)/float(iip-ip1m1+ndoub)
-          if (btest(nacc(ivx,ip),18)) then
-            fnote = 2*fnote
-          else if (btest(nacc(ivx,ip),27)) then
-            fnote = 1.5*fnote
-          else if (ip .gt. 1) then
-            if (btest(nacc(ivx,ip-1),27)) fnote = .5*fnote
-          end if 
-          return
-        end if
-3     continue
-      print*,' '
-      call printl
-     *   ('Probable misplaced barline or incorrect meter, stopping')
-c      call printl('Program error in fnote, send source to Dr. Don')
-      call stop1()
-      end
-      subroutine g1etchar(lineq,iccount,charq)
-      parameter(nm=24)
-      common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
-     *     fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
-      logical lastchar,issegno,isheadr,isvolt,fbon
-      common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
-      logical mrecord,mplay,endmac
-      character*1 charq
-      character*128 lineq,lnholdq
-c
-c  Gets the next character out of lineq*128.  If pointer iccount=128 on entry,
-c  then reads in a new line.  Resets iccount.  Ends program if no more input.
-c
-      if (iccount .eq. 128) then
-        call read10(lineq,lastchar)
-        if (lastchar) return
-        if (.not.endmac) then
-          iccount = 0
-          if (.not.mplay) nline = nline+1
-        else
-          endmac = .false.
-          iccount = icchold
-          lineq = lnholdq
-        end if
-        if (mrecord) then
-          call m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm)
-        end if
-      end if
-      iccount = iccount+1
-      charq = lineq(iccount:iccount)
-      return
-      end
-      subroutine g1etnote(loop,ifig,optimize,fulltrans)
-      parameter (nm=24,nkb=3999,mv=24576,maxblks=4000)
-      character*1 chax
-      common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm),
-     *   nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount,
-     *   nbars,itsofar(nm),nib(nm,15),nn(nm),
-     *   rest(nm,200),lenbr0,lenbr1,firstline,newmeter
-      common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks),
-     *     iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr,
-c     *     ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks)
-     *     ibaroff,udsp(nkb),wheadpt,sqzb(maxblks)
-      common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
-     *     fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
-      common /compage/ widthpt,ptheight,hoffpt,voffpt,
-     *      nsyst,nflb,ibarflb(0:40),
-     *      isysflb(0:40),npages,nfpb,ipagfpb(0:18),isysfpb(0:18),
-     *      usefig,fintstf,gintstf,fracsys(30),nmovbrk,isysmb(0:30),
-     *      nistaff(0:40)
-      common /c1ommvl/ nvmx(nm),ivmx(nm,2),ivx,fbar,nacc(nm,200)
-      common /comkeys/ nkeys,ibrkch(18),newkey(18),iskchb,idsig,isig1,
-     *      mbrestsav,kchmid(18),ornrpt,shifton,barend,noinst,stickyS
-      logical lastchar,firstline,rest,loop,newmeter,fbon,issegno,barend,
-     *        isheadr,fulbrp,usefig,isvolt,iskchb,kchmid,plusmin,ornrpt,
-     *        stickyS
-      common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
-      common /commus/ musize,whead20
-      logical mrecord,mplay,endmac,shifton,gotclef,optimize
-      character*128 lineq,lnholdq
-      character*1 charq,dotq,dumq,durq,charlq
-      integer*2 mmidi
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc,cdot
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      character*65536 bufq
-      integer*2 lbuf(maxblks)
-      common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
-      logical novshrinktop,upslur,fontslur,ztrans,
-     *        WrotePsslurDefaults,cstuplet
-      common /comnvst/ novshrinktop,cstuplet
-      common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
-     *                 ,WrotePsslurDefaults,SlurCurve
-      character*51 literq(3),lyrerq(5)
-      common /comligfont/ isligfont
-      logical isligfont
-      common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
-     *  instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
-      logical EarlyTransOn,LaterInstTrans
-      logical fulltrans
-      common /comsize/ isize(nm)
-      common /commidisig/ midisig
-      data literq
-     *   /'Literal TeX string cannot start with 4 backslashes!',
-     *    'TeX string must have <129 char, end with backslash!',
-     *    'Type 2 or 3 TeX string can only start in column 1!'/
-      data lyrerq
-     *   /'pmxlyr string must end with " followed by blank!',
-     *    'pmxlyr string cannot extend past position 120!',
-     *    'There must be "a" or "b" here!',
-     *    'There must be "+" or "-" here!',
-     *    'There must be an integer here!'/
-      cdot = .false.
-1     call g1etchar(lineq,iccount,charq)
-      if (charq .ne. ' ') charlq = charq
-      if (lastchar) then
-        if (index('/%',charlq) .eq. 0) then
-          print*
-          print*,'WARNING:'
-          print*,'Last non-blank character is "',charlq,'", not "/,%"'
-          print*,'ASCII code:',ichar(charlq)
-          write(15,'(/a)')'Last non-blank character is "'//charlq//
-     *       '", not "/,%"'
-          write(15,'(a11,2x,i3)')'ASCII code:',ichar(charlq)
-c
-c  Append " /" to last line.  NB lastchar=.true. => ilbuf=nlbuf+1.
-c
-          ilbuf = ilbuf-1
-          lbuf(ilbuf) = lbuf(ilbuf)+2
-          bufq = bufq(1:ipbuf)//' /'
-          write(15,*)'appending <blank>/'
-          print*,'appending <blank>/'
-          lineq = lineq(1:iccount)//' /'
-          lastchar = .false.
-          go to 1 
-        end if
-        return
-      end if
-      if (charq .eq. ' ') then
-        go to 1
-      else if (charq.eq.'%' .and. iccount.eq.1) then
-        iccount = 128
-        go to 1
-c
-c  Replacement 1/22/12 since gfortran 4.7 with -O was choking here!
-c
-c      else if ((ichar(charq).ge.97.and.ichar(charq).le.103) .or.
-      else if (index('abcdefg',charq).gt.0 .or.
-     *       charq.eq.'r') then
-c
-c  This is a note/rest. gotclef is only used for checking for clef before "/"
-c
-        if (cdot) go to 28
-c        if (gotclef) gotclef=.false.
-        idotform = 0
-        numnum = 0
-        plusmin = .false.
-28      nnl(ivx) = nnl(ivx)+1
-        if (nnl(ivx) .gt. 200) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      '>200 notes in line of music. Use smaller blocks!')
-          call stop1()
-        end if
-        dotq = 'x'
-c
-c  Check if this is 'r ' and previous note was full-bar-pause
-c
-        fulbrp = charq.eq.'r' .and. lineq(iccount+1:iccount+1) .eq.' '
-     *    .and. nnl(ivx).gt.1 .and. rest(ivx,max(1,nnl(ivx)-1)) .and.
-     *    nodur(ivx,max(1,nnl(ivx)-1)) .eq. lenbar
-2       call g1etchar(lineq,iccount,durq)
-        ic = ichar(durq)
-        if (ic.le.57 .and. ic.ge.48) then
-c
-c  Digit
-c
-          if (numnum .eq. 0) then
-            nnodur = ic-48
-            numnum = 1
-            go to 2
-          else if (numnum .eq. 1) then
-            if (charq .eq. 'r') then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Only one digit allowed after rest symbol "r"!')
-              call stop1()
-            end if
-            numnum = 2
-            if (plusmin) then
-              print*
-              print*,'*********WARNING*********'
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Before version 1.2, +/- was ignored if octave was!')
-              print*,
-     *           'explicitly specified.  May need to edit old editions'
-            end if
-            go to 2
-          else
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             '>2 digits in note symbol!')
-            call stop1()
-          end if
-        else if (durq.eq.'d') then
-          dotq = durq
-          if (lineq(iccount+1:iccount+1) .eq. 'd') then
-            iddot = 1
-            iccount = iccount+1
-c
-c  Since we flow out, double dots won't work with other dot options
-c
-          end if
-          if (index('+-',lineq(iccount+1:iccount+1)) .gt. 0) then
-c
-c  move a dot, provided a number follows.
-c
-            call g1etchar(lineq,iccount,durq)
-            call g1etchar(lineq,iccount,durq)
-            if (index('0123456789-.',durq) .eq. 0) then
-c
-c  Backup, exit the loop normally
-c
-              iccount = iccount-2
-              go to 2
-            end if
-            call readnum(lineq,iccount,dumq,fnum)
-            if (index('+-',dumq) .gt. 0) then
-c
-c  Vertical shift also
-c
-              call g1etchar(lineq,iccount,durq)
-              if (index('0123456789-.',durq) .eq. 0) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               'Expected number after 2nd +/- (shift dot)!')
-                call stop1()
-              end if
-              call readnum(lineq,iccount,durq,fnum)
-            end if
-            iccount = iccount-1
-          end if
-          go to 2
-        else if (index('<>',durq) .gt. 0) then
-c
-c  Accidental shift
-c
-c          if (index('fsn',lineq(iccount-1:iccount-1)) .eq. 0) then 
-          if (index('fsnA',lineq(iccount-1:iccount-1)) .eq. 0) then 
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-c     *         'Expected "f", "s", or "n" before "<" or ">"!')
-     *         'Expected "f", "s", "n" or "A" before "<" or ">"!')
-            call stop1()
-          end if
-          ipm = 1
-          if (durq .eq. '<') ipm=-1
-          call g1etchar(lineq,iccount,durq)
-          if (index('123456789.0',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'Expected number after </> (accidental shift)!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          fnum = ipm*fnum
-          if (fnum.lt.-5.35 .or. fnum.gt.1.0) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *       'Horizontal accidental shift must be >-5.35 and <1.0!')
-            call stop1()
-          end if
-          iccount = iccount-1
-          go to 2
-        else if (index('+-',durq) .gt. 0) then
-          if (charq .ne. 'r') then
-            if (index('fsnA',lineq(iccount-1:iccount-1)) .gt. 0) then
-              ipm = 1
-              if (durq .eq. '-') ipm=-1
-              if (index('0123456789',lineq(iccount+1:iccount+1))
-     *                                                    .gt.0) then
-c
-c  This may be start of accidental shift, but may be octave jump; then duration
-c
-                icsav = iccount
-                iccount = iccount+1
-                call readnum(lineq,iccount,durq,fnum)
-                if (index('+-',durq) .gt. 0) then
-c
-c  This is an accid shift since there's a 2nd consecutive signed number.
-c  Check size of 1st number.
-c
-                  if (fnum .gt. 30.5) then
-                    call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *                'Vertical accidental shift must be less than 31!')
-                    call stop1()
-                  end if
-                  ipm = 1
-                  if (durq .eq. '-') ipm = -1
-                  call g1etchar(lineq,iccount,durq)
-                  if (index('1234567890.',durq) .eq. 0) then
-                    call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               'Expected 2nd number of accidental shift)!')
-                    call stop1()
-                  end if
-                  call readnum(lineq,iccount,durq,fnum)
-                  fnum = ipm*fnum
-                  if (fnum.lt.-5.35 .or. fnum.gt.1.0) then
-                    call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *             'Horiz. accidental shift must be >-5.35 and <1.0!')
-                    call stop1()
-                  end if
-                  iccount = iccount-1
-                  go to 2
-                else
-c
-c  Not accid shift, reset, then flow out
-c
-                  iccount = icsav
-                end if
-              end if
-            end if
-            plusmin = .true.
-            if (numnum .eq. 2) then
-              print*
-              print*,'*********WARNING*********'
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Before version 1.2, +/- was ignored if octave was!')
-              print*,
-     *           'explicitly specified.  May need to edit old editions'
-            end if
-            go to 2
-c
-c  It's a rest containing +|- .  Must refer to a vertical shift.  Read past.
-c
-          else
-            call g1etchar(lineq,iccount,durq)
-            call readnum(lineq,iccount,durq,dum)
-            iccount = iccount-1
-            go to 2
-          end if
-c        else if (index('ulare',durq) .gt. 0) then
-        else if (index('ularec',durq) .gt. 0) then
-          go to 2
-c        else if (durq .eq. 'S') then
-        else if (index('LS',durq) .gt. 0) then
-c
-c Stemlength change
-c
-          call g1etchar(lineq,iccount,durq)
-          if (index('.0123456789:',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'There must be a number or colon here!')
-            call stop1()
-          end if
-          if (durq .eq. ':') then
-            if (.not.stickyS) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Turned off sticky stemlegth changes without turning on!')
-              call stop1()
-            end if
-            stickyS = .false.
-            go to 2
-          end if
-          call readnum(lineq,iccount,durq,dum)
-c          if (dum.lt..5 .or. dum.gt.4.) then
-          if ((durq.eq.'L'.and.dum.gt.20.).or.
-     *                (durq.eq.'S'.and.dum.gt.4.)) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *         'Stemlength change amount too big!')
-            call stop1()
-          end if
-          if (durq .ne. ':') then
-            iccount = iccount-1
-          else
-            if (stickyS) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'Turned on sticky stemshrinks when already on!')
-              call stop1()
-            end if
-            stickyS = .true.
-          end if
-          go to 2                    
-        else if (index('fsn',durq) .gt. 0) then
-c
-c Check for midi-only accid. CANNOT coesist with accidental position tweaks, so
-c   MUST come right after "f,s,n"
-c
-          if (lineq(iccount+1:iccount+1) .eq. 'i') iccount=iccount+1
-          go to 2
-        else if (durq .eq. 'p') then
-          fulbrp = charq.eq.'r'
-          if (.not. fulbrp) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'The option "p" only works with "r" (rest)!')
-            call stop1()
-          end if
-          go to 2
-        else if (durq .eq. 'b') then
-          if (charq .ne. 'r') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'You entered "b"; I expected "rb"!')
-            call stop1()
-          else if (numnum .eq. 2) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'You entered "r" & "b" with two numbers!')
-          end if
-          go to 2
-        else if (durq .eq. 'x') then
-c
-c  Xtuplet. Count number of doubled notes (for unequal xtups)
-c
-          if (btest(nacc(ivx,nnl(ivx)),18)) then
-            ndoub = 1
-          else
-            ndoub = 0
-          end if
-c
-c  Will set all durations to 0 except last one.
-c
-          call g1etchar(lineq,iccount,durq)
-          if (index('123456789',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'First char after "x" in xtuplet must be "1"-"9"!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          if (fnum .gt. 99) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Xtuplet cannot have more than 99 notes!')
-            call stop1()
-          else if (index(' DFnd',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Only legal characters here are " ","D","F","n"!')
-            call stop1()
-          end if
-c
-c  End of mandatory xtup inputs.  Check for options. Note D,F,d must precede n.
-c
-          if (index('DF',durq) .gt. 0) then
-c
-c  Double xtup note to make an un= xtup. Here, number already set, but may also
-c    have used this before number was set.
-c
-            nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
-            ndoub = 1
-            call g1etchar(lineq,iccount,durq)
-          else if (durq .eq. 'd') then
-            nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27)
-            call g1etchar(lineq,iccount,durq)
-          end if
-		if (durq .eq. 'n') then
-c
-c  Number alteration stuff.  After 'n', require '+-123456789fs ', no more 'DF'.
-c
-            numshft = 0
-30          call g1etchar(lineq,iccount,durq)
-            if (durq .eq. 'f') then
-              go to 30
-            else if (index('+-',durq) .gt. 0) then
-              numshft = numshft+1
-              if (numshft .eq. 3) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Only 2 shifts are allowed after "n" in xtup!')
-                call stop1()
-              end if
-              call g1etchar(lineq,iccount,durq)
-              if (index('0123456789.',durq) .eq. 0) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'This character should be a digit or "."!')
-                call stop1()
-              end if
-              call readnum(lineq,iccount,durq,snum)
-              iccount = iccount-1
-c              if ((numshft.eq.1 .and. snum.gt.15.1) .or. 
-              if ((numshft.eq.1 .and. snum.gt.64.) .or. 
-     *            (numshft.eq.2 .and. snum.gt.1.51)) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *              'Shift number after "n" in xtup is out of range!')
-                call stop1()
-              end if
-              go to 30
-            else if (durq .eq. 's') then
-c
-c  Slope alteration for bracket
-c
-              call getchar(lineq,iccount,durq)
-              if (index('+-',durq) .eq. 0) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'For slope adjustment, this character must be "+" or "-"!')
-                call stop1()
-              end if
-              call g1etchar(lineq,iccount,durq)
-              if (index('123456789',durq) .eq. 0) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'This character should be a digit!')
-                call stop1()
-              end if
-              call readnum(lineq,iccount,durq,snum)
-              iccount = iccount-1
-              if (nint(snum) .gt. 15) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Slope adjustment cannot exceed 15!')
-                call stop1()
-              end if
-              go to 30
-            else if (index('123456789',durq) .gt. 0) then
-c
-c Unsigned integer => alternate printed number
-c
-              call readnum(lineq,iccount,durq,snum)
-              if (snum .gt. 15.1) then
-                call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *              'Alternate xtup number after "n" must be <16!')
-                call stop1()
-              end if
-              iccount = iccount-1
-              go to 30
-            else if (durq .ne. ' ') then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Illegal character after "n" in xtup!')
-              call stop1()
-            end if
-          end if
-          ntup = nint(fnum)
-          do 6 itup = 2 , ntup
-            nodur(ivx,nnl(ivx)) = 0
-            nnl(ivx) = nnl(ivx)+1
-110         call g1etchar(lineq,iccount,durq)
-            if (durq.eq.' ') then
-              go to 110
-            else if (durq .eq. 'o') then
-c
-c  Ornament in xtup.  "o" symbol must come AFTER the affected note
-c
-              call g1etchar(lineq,iccount,dumq)
-              if (index('(stmx+Tup._)e:>^bc',dumq) .eq. 0 ) then
-                if (index('fg',dumq) .gt. 0) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               'Fermata or segno not allowed in xtuplet!')
-                else
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *                 'Illegal ornament!')
-                end if
-                call stop1()
-              end if
-              if (dumq .eq. 'T') then
-c
-c  Trill.  may be followed by 't' and/or number.  read 'til blank
-c
-29              call g1etchar(lineq,iccount,dumq)
-                if (dumq .ne. ' ') go to 29
-              else if (dumq .eq. 'e') then
-                call g1etchar(lineq,iccount,dumq)
-                if (index('sfn?',dumq) .eq. 0) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'Illegal character after "e" in edit. accid. symbol!')
-                  call stop1()
-                end if
-                call g1etchar(lineq,iccount,dumq)
-                if (dumq .eq. '?') call g1etchar(lineq,iccount,dumq)
-              else if (dumq .eq. ':') then
-                if (lineq(iccount+1:iccount+1) .ne. ' ') then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            '":" must be followed by blank in "o: "!')
-                  call stop1()
-                else if (.not.ornrpt) then
-                  call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *            'Turned off repeated ornaments before they were on!')
-                  call stop1()
-                end if
-                ornrpt = .false.
-              else
-                call g1etchar(lineq,iccount,dumq)
-              end if
-              if (index('+- :',dumq) .eq. 0) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'Illegal character in ornament symbol!')
-                call stop1()
-              end if
-              if (dumq .eq. ':') then
-                if (lineq(iccount+1:iccount+1) .ne. ' ') then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            '":" must be followed by blank in "o: "!')
-                  call stop1()
-                else if (ornrpt) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               'Turned on repeated ornaments but already on!')
-                  call stop1()
-                end if
-                ornrpt = .true.
-              end if
-              if (index('+-',dumq) .gt. 0) then
-                if (index('0123456789',lineq(iccount+1:iccount+1))
-     *                                                   .eq. 0) then
-                  call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
-     *             'There should be an integer here!')
-                  call stop1()
-                end if
-                call readnum(lineq,iccount,durq,fnum)
-                if (durq .eq. ':') then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               'Cannot shift AND repeat an ornament!')
-                  call stop1()
-                end if
-c
-c  12/7/03 Allow horizontal shift on any ornament, not just breath and ceas.
-c
-                if (index('+-',durq) .gt. 0) then
-                  if (index('.0123456789',lineq(iccount+1:iccount+1))
-     *                                                   .eq. 0) then
-                    call errmsg(lineq,iccount+1,
-     *                            ibarcnt-ibaroff+nbars+1,
-     *                            'There should be a number here!')
-                    call stop1()
-                  end if
-                  call readnum(lineq,iccount,durq,fnum)
-                end if
-              end if
-              go to 110
-            else if (index('st(){}',durq) .gt. 0) then
-c
-c  Slur in xtup
-c
-              iposn = 0
-              numint = 0
-15            call g1etchar(lineq,iccount,dumq)
-              iposn = iposn+1
-              if (index('udlbfnhtv',dumq) .gt. 0) then
-                if (dumq.eq.'t' .and. durq.eq.'t') then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *              'Cannot use "t" as an option on a tie!')
-                  call stop1()
-                end if
-                go to 15
-              else if (index('+-',dumq) .gt. 0) then
-                numint = numint+1
-                iccount = iccount+1
-                call readnum(lineq,iccount,durq,fnum)
-                if (numint .eq. 1) then
-                  if (nint(fnum) .gt. 30) then
-                    call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *       'Magnitude of slur height adjustment cannot exceed 30!')
-                    call stop1()
-                  end if
-                else if (numint .eq. 2) then
-                  if (abs(fnum).gt.6.3) then
-                    call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *              'Slur horiz shift must be in the range (-6.3,6.3)!')
-                    call stop1()
-                  end if
-                else
-c
-c  Third signed integer, must be a midslur or curve spec.
-c
-                  if (abs(fnum).gt.31) then
-                    call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *                  'Slur midheight must be in the range (-31,31)!')
-                    call stop1()
-                  end if
-                  if (durq .eq. ':') then
-c
-c  Expecting curve parameters.  Get two numbers
-c
-                    do 40 i = 1 , 2
-                      iccount = iccount+1
-                      fnum = ichar(lineq(iccount:iccount))-48
-                      if (abs(fnum-3.5) .gt. 3.6) then
-                        call errmsg(lineq,iccount,
-     *                      ibarcnt-ibaroff+nbars+1,
-     *           'Slur curve parameter must be in range (0,7)!')
-                        call stop1()
-                      end if
-40                  continue
-                    iccount = iccount+1
-                  end if
-                end if
-                iccount = iccount-1
-                go to 15
-
-              else if (dumq .eq. 's') then
-c
-c What follows should be one or two signed numbers for adjustment of line break
-c slur, end of 1st segment or start of second.
-c
-                if (fontslur) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *    'May not use linebreak slur options with font-based slurs!')
-                  call stop1()
-                end if
-                call g1etchar(lineq,iccount,dumq)
-                if (index('+-',dumq) .eq. 0) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *              'This character must be "+" or "-"!')
-                  call stop1()
-                end if
-                iccount = iccount+1
-                call readnum(lineq,iccount,dumq,fnum)
-                if (nint(fnum) .gt. 30) then
-                  call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *     'Magnitude of slur height adjustment cannot exceed 30!')
-                  call stop1()
-                end if
-                if (index('+-',dumq) .gt. 0) then
-                  iccount = iccount+1
-                  call readnum(lineq,iccount,dumq,fnum)
-                  if (abs(fnum) .gt. 6.3) then
-                    call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *         'Slur horiz shift must be in range (-6.3,6.3)!')
-                    call stop1()
-                  end if
-                end if
-                iccount = iccount-1
-                go to 15
-              else if (dumq .eq. 'H' .and. iposn.gt.1) then
-                if (lineq(iccount+1:iccount+1) .eq. 'H') 
-     *                                     iccount=iccount+1
-                go to 15
-              else if (dumq .eq. 'p') then
-c
-c  local change in postscript slur/tie adjustment default
-c
-                if (fontslur) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Must use postscript slurs ("Ap") to use this option!')
-                  call stop1()                   
-                end if
-                call g1etchar(lineq,iccount,dumq)
-                if (index('+-',dumq) .eq. 0) then                
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *              'Expected "+" or "-" here!')
-                  call stop1()                   
-                end if
-                call g1etchar(lineq,iccount,dumq)
-                if (index('st',dumq) .eq. 0) then                
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *              'Expected "s" or "t" here!')
-                  call stop1()                   
-                end if
-	          go to 15
-              else if (dumq .ne. ' ') then
-                ic = ichar(dumq)
-                if ((ic.ge.48.and.ic.le.57) .or.
-     *                    (ic.ge.65.and.ic.le.90)) then
-                  if (iposn .eq. 1) then
-                    if (durq.eq.'t' .and. fontslur) then
-                      call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *                  'Slur ID not allowed on non-postscript tie!')
-                      call stop1()                   
-                    end if 
-                    go to 15
-                  end if
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *              'Slur ID must be 2nd character in slur symbol!')
-                  call stop1()
-                end if
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *                   'Illegal character in slur symbol!')
-                call stop1()
-              end if
-              go to 110
-            else if (index('0123456789#-nx_',durq) .gt. 0) then
-c
-c  We have a figure.  Only allow on 1st note of xtup
-c
-              if (itup .ne. 2) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Figure in xtup only allowed on 1st note!')
-                call stop1()
-              else if (durq.eq.'x') then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'No floating figures in xtuplets!')
-                call stop1()
-              end if
-              if (usefig .and. ivx.eq.1) ifig = 1
-26            call g1etchar(lineq,iccount,durq)
-c              if (index('0123456789#-n_.:',durq) .gt. 0) then
-              if (index('0123456789#-n_.:v',durq) .gt. 0) then
-                go to 26
-              else if (durq .eq. 's') then
-                isligfont = .true.
-                go to 26
-              else if (durq .eq. '+') then
-c
-c vertical offset, must be integer then blank
-c               
-                call g1etchar(lineq,iccount,durq)
-                if (index('123456789',durq) .ne. 0) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Integer for vertical offset expected here!')
-                  call stop1()
-                end if
-                call readnum(lineq,iccount,durq,fnum)
-                if (durq .ne. ' ') then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Vertical offset must terminate figure!')
-                  call stop1()
-                end if
-                iccount = iccount-1
-                go to 26                  
-              else if (durq .ne. ' ') then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'Illegal character in figure in xtuplet!')
-                call stop1()
-              end if
-              go to 110
-            else if (durq .eq. 'G') then
-              ngr = 1
-79            call g1etchar(lineq,iccount,charq)
-              if (index('123456789',charq) .gt. 0) then
-                call readnum(lineq,iccount,durq,fnum)
-                ngr = nint(fnum)
-                iccount = iccount-1
-                go to 79
-              else if (index('AWulxs',charq) .gt. 0) then
-                go to 79
-              else if (charq .eq. 'm') then
-                call g1etchar(lineq,iccount,charq)
-                if (index('01234',charq) .eq. 0) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'A digit less than 5 must follow "m" in a grace note!')
-                  call stop1()
-                end if
-                go to 79
-              else if (charq .eq. 'X') then
-c
-c Space before main note
-c
-                call g1etchar(lineq,iccount,charq)
-                if (index('0123456789.',charq) .gt. 0) then
-                  call readnum(lineq,iccount,durq,fnum)
-                  iccount = iccount-1
-                  go to 79
-                else
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               'A number must follow "X" in a grace note!')
-                  call stop1()
-                end if
-              end if
-c
-c  At this point, charq is first note name in rest (grace?)
-c
-              do 71 igr = 1 , ngr
-                numnum = 0
-                if (igr .gt. 1) then
-75                call g1etchar(lineq,iccount,charq)
-                  if (charq .eq. ' ') go to 75
-                end if
-                if (index('abcdefg',charq) .eq. 0) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               'In grace, expected "a"-"g"!')
-                  call stop1()
-                end if
-78              call g1etchar(lineq,iccount,charq)
-                if (charq .ne. ' ') then
-                 if (index('1234567',charq) .gt. 0) then
-                    if (numnum .eq. 1) then
-                      call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *                 'Only one of "+-1234567" allowed here in grace!')
-                      call stop1()
-                    end if
-                    numnum = 1
-                    go to 78
-                  else if (index('+-nfs',charq) .gt. 0) then
-                    go to 78
-                  end if
-c
-c  Digits are possible octave numbers
-c
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               'Illegal character after note name in grace!')
-                  call stop1()
-                end if
-71            continue
-              go to 110
-            else if (durq .eq. chax(92)) then
-              call chklit(lineq,iccount,literr)
-              if (literr .gt. 0) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               literq(literr))
-                call stop1()
-              end if
-              go to 110
-            else if (durq .eq. '"') then
-c
-c  pmx lyric
-c
-              call chkpmxlyr(lineq,iccount,lyrerr)
-              if (lyrerr .gt. 0) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               lyrerq(lyrerr))
-                call stop1()
-              end if
-              go to 110
-            else if (durq .eq. 'M') then
-c
-c  Temporary trap until I get around putting this in pmxb
-c
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Macros not yet allowed in xtuplets!')
-              call stop1()
-            else if (durq .eq. 'X') then
-              call g1etx(lineq,iccount,shifton,
-     *            ibarcnt-ibaroff+nbars+1,udsp(ibarcnt+nbars+1),wheadpt)
-              go to 110
-            else if (durq .eq. 'z') then
-c
-c  Chord note in xtup.  Read past for now.
-c
-33            call g1etchar(lineq,iccount,durq)
-              if (durq .ne. ' ') go to 33
-              go to 110
-            else if (durq .eq. 'D') then
-c
-c  Dynamic mark
-c
-              call checkdyn(lineq,iccount,ibarcnt-ibaroff+nbars+1)
-              go to 110
-            else if (durq .eq. '%') then
-              if (iccount .ne. 1) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'Comment must have "%" in column 1!')
-                call stop1()
-              end if
-              iccount = 128
-              go to 110
-            else if (durq .eq. '?') then
-              call getchar(lineq,iccount,durq)
-              if (durq .eq. ' ') then
-                iccount = iccount-1
-                go to 110
-              end if
-              if (durq .ne. '-') then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *                'Expecting "-"')
-                call stop1()
-              end if
-              call getchar(lineq,iccount,durq)
-              if (index('0123456789.',durq) .eq. 0) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *                'Expecting number')
-                call stop1()
-              end if
-              call readnum(lineq,iccount,durq,fnum)
-              iccount = iccount-1
-              go to 110
-c
-c  140215 Allow clef change inside xtup
-c
-            else if (durq .eq. 'C') then
-              call g1etchar(lineq,iccount,durq)
-              if (.not.(index('tsmanrbf',durq).gt.0 .or.
-c     *            (ichar(durq).ge.48 .and. ichar(durq).le.55))) then
-     *            (ichar(durq).ge.48 .and. ichar(durq).le.56))) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Must have t,s,m,a,n,r,b,f or 0-8 after C!')
-                call stop1()
-              end if
-c              gotclef = .true.
-              go to 110
-c+++
-            else if (durq.eq.']' .and. lineq(iccount+1:iccount+1).eq.'['
-     *           .and. lineq(iccount+2:iccount+2).eq.' ') then
-              iccount = iccount+2
-              go to 110
-c+++
-            end if
-c
-c  End of xtup options. At this point symbol can only be note or rest
-c
-            if (index('abcdefgr',durq) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'In xtup, this character is not allowed!')
-              call stop1()
-c            else if (durq.eq.'r' .and. itup.eq.ntup) then
-c              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-c     *         'Sorry, PMX cannot end an xtuplet with a rest!')
-c              call stop1()
-            else if (durq.eq.'r' .and. itup.eq.ntup .and.
-     *          index(lineq(iccount+1:iccount+2),'b').eq.0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Sorry, PMX cannot end an xtuplet with a non-blank rest!')
-              call stop1()
-            end if
-7           call g1etchar(lineq,iccount,durq)
-            if (index('2345678ulcb',durq) .gt. 0) then
-              go to 7
-            else if (index('sfn',durq) .gt. 0) then
-c
-c  Check for MIDI-only accidental. Cannot coexist with accid. pos'n shift.
-c
-              if (lineq(iccount+1:iccount+1) .eq. 'i') iccount=iccount+1
-              go to 7
-            else if (index('+-<>',durq) .gt. 0) then
-c
-c  May have either octave jump or shifted accid. on main xtup note
-c
-              if (index('+-',durq).gt.0 .and.
-     *          index('01234567890',lineq(iccount+1:iccount+1)).eq.0)
-     *          go to 7
-              iccount = iccount+1
-              call readnum(lineq,iccount,durq,fnum)
-              iccount = iccount-1
-              go to 7
-            else if (index('DF',durq) .gt. 0) then
-c
-c  Double an xtup note to make an unequal xtup
-c
-              nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
-              ndoub = ndoub+1
-              go to 7
-            else if (durq .eq. 'd') then
-              nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27)
-              go to 7
-            else if (durq .ne. ' ') then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Illegal option on xtuplet note!')
-              call stop1()
-            end if
-            if (itup .eq. ntup-ndoub) go to 3
-6         continue
-3         continue
-c
-c  6==End of loop for xtuplet input
-c
-        else if (durq .eq. 'm') then
-c
-c  Multi-bar rest: next 1 or two digits are # of bars.
-c
-          if (mod(itsofar(iv),lenbar) .ne. 0) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *             'Multibar rest must start at beginning of bar!')
-            call stop1()
-          else if (iv.eq.1.and.ibarmbr.gt.0) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *         'Multibar rest only OK at one time per block!')
-            call stop1()
-          end if
-c
-c  For some purposes, pretend its one bar only
-c
-          nodur(iv,nnl(iv)) = lenbar
-          ibarmbr = nbars+1
-          mbrest = 0
-c20        call g1etchar(lineq,iccount,durq)
-          call g1etchar(lineq,iccount,durq)
-          if (index('123456789',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Expected an integer after "rm"!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          mbrest = nint(fnum)
-          iccount = iccount-1
-c          if (ichar(durq).ge.48.and.ichar(durq).le.57) then
-c            mbrest = 10*mbrest+ichar(durq)-48
-c            go to 20
-c          end if
-          if (nv .gt. 1) then
-            if (iv .eq. 1) then
-              mbrestsav = mbrest
-            else 
-              if (mbrest .ne. mbrestsav) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Must enter same multi-bar rest in every voice!')
-                call stop1()
-              end if
-            end if
-c
-c  Zero out mbrestsav so can check at end of input block whether 
-c    all voices have one
-c
-            if (iv .eq. nv) mbrestsav=0
-          end if
-          if (durq .ne. ' ') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Illegal character after "rm"!')
-            call stop1()
-          end if
-        else if (durq .eq. '.') then
-c
-c  Dotted pattern.  Close out note.  Mult time by 3/4.
-c  Set time for next note to 1/4.  Start the note.
-c
-          idotform = 1
-        else if (durq .eq. ',') then
-          idotform = 3
-c
-c  Now flow to duration setting, as if durq=' '
-c
-        else if (index('oL',durq) .gt. 0) then
-c
-c  Suppress full bar rest, or look left for height
-c
-          if (charq .ne. 'r') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           '"o","L" options only legal for rest, not note!')
-            call stop1()
-          end if
-          go to 2
-        else if (index('DF',durq) .gt. 0) then
-c
-c  Double note for xtup.  Must check here in case "D" or "F" came before "x" or on
-c  last note of xtup.   Need to flag it in pmxa since affects horiz. spacing.
-c
-          nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
-          go to 2
-        else if (durq .eq. 'A') then
-c
-c  Main note accidental option
-c
-          call getchar(lineq,iccount,durq)
-          if (index('o+-<>',durq) .eq. 0) then 
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           '"o",+","-","<",">" are the only legal options here!')
-            call stop1()
-          end if
-c
-c  Need more stuff here
-c
-          if (durq .ne. "o") then
-c
-c  Back up 1, flow out, will get +|-|<|> next loop preceded by "A", and will
-c    proceed to number input checking
-c
-            iccount = iccount-1
-          end if
-          go to 2
-	  else if (durq .ne. ' ') then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Illegal character!')
-          print*,'ASCII code:',ichar(durq)
-          call stop1()
-        end if
-c
-c  End of block for note options.
-c
-c  Set the duration
-c
-        if (idotform .gt. 0) then
-          if (idotform .eq. 1) then
-            nodur(ivx,nnl(ivx)) = i1fnodur(nnodur,dotq)*3/2
-          else if (idotform .eq. 2) then
-            nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/3
-          else if (idotform .eq. 3) then
-            nodur(ivx,nnl(ivx)) = i1fnodur(nnodur,dotq)
-          else if (idotform .eq. 4) then
-            nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/2
-          end if
-        else if (ibarmbr.ne.nbars+1 .and. .not.fulbrp) then
-          nodur(ivx,nnl(ivx)) = i1fnodur(nnodur,dotq)
-c
-c  Check for double dot
-c
-          if (iddot .eq. 1) then
-            nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*7/6
-            iddot = 0
-          end if
-        else if (fulbrp) then
-          nodur(ivx,nnl(ivx)) = lenbar
-c
-c  Use a one-line function to set nnodur.  It gives inverse of ifnodur.
-c
-          nnodur = index('62514x0x37',
-     *                   chax(48+int(log(.1+lenbar)/.69315)))-1
-          fulbrp = .false.
-        end if
-        rest(ivx,nnl(ivx)) = charq.eq.'r'
-c
-c  If inside forced beam, check if note is beamable
-c
-        if (fbon) then
-          if (nodur(ivx,nnl(ivx)) .lt. 16) go to 120
-          if (nnl(ivx) .gt. 1) then
-            if (nodur(ivx,nnl(ivx)-1) .eq. 0) go to 120
-          end if
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Unbeamable thing in forced beam!')
-          call stop1()
-        end if
-120     continue
-c
-c Get number of prior bars for later check on whether note spans bar line
-c
-        nbb4 = itsofar(ivx)/lenbar
-        itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx))
-        if (mod(itsofar(ivx),lenbar) .eq. 0) then
-          nbars = nbars+1
-          if (shifton) barend = .true.
-c
-c  Will check barend when 1st note of next bar is entered.
-c
-          if (nbars .gt. 15) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'Cannot have more than 15 bars in an input block!')
-            call stop1()
-          end if
-          nib(ivx,nbars) = nnl(ivx)
-          if (firstline .and. lenbar.ne.lenbr1) then
-c
-c  Just finished the pickup bar for this voice.
-c
-            if (itsofar(ivx) .ne. lenbr0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               'Pickup bar length disagrees with mtrnum0!')
-              call stop1()
-            end if
-            lenbar = lenbr1
-            itsofar(ivx) = 0
-          end if
-        else if (barend) then
-          if (shifton) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'Bar ended with user-defined shift still on!')
-            call stop1()
-          end if
-          barend = .false.
-        else if (itsofar(ivx)/lenbar .gt. nbb4) then
-          call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *           'This note spans a bar line!')
-          call stop1()
-        end if
-        if (idotform.eq.1 .or. idotform.eq.3) then
-          call g1etchar(lineq,iccount,charq)
-          if (index('abcedfgr',charq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Expected note name or "r" here!')
-            call stop1()
-          end if
-          idotform = idotform+1
-          numnum = 1
-          go to 28
-        end if
-c
-c  End of sub block for note-rest
-c
-      else if (charq .eq. 'z') then
-        call g1etchar(lineq,iccount,charq)
-        if (index('abcdefg',charq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Expected chord note name here!')
-          call stop1()
-        end if
-25      call g1etchar(lineq,iccount,durq)
-c        if (index('dre12345678',durq) .gt. 0) then
-        if (index('dre12345678c',durq) .gt. 0) then
-          go to 25
-        else if (index('fsn',durq) .gt. 0) then
-c
-c Check for midi-only accid. CANNOT coesist with accidental position tweaks, so
-c   MUST come right after "f,s,n"
-c
-          if (lineq(iccount+1:iccount+1) .eq. 'i') iccount=iccount+1
-          go to 25
-        else if (durq .eq. 'A') then
-          if (index('fsn',lineq(iccount-1:iccount-1)) .eq. 0) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *        'Must have "f,s,n" before "A" in chord note!')
-            call stop1()
-          end if
-          go to 25
-        else if (index('<>',durq) .gt. 0) then
-          if (index('fsnA',lineq(iccount-1:iccount-1)) .eq. 0) then
-c          if (index('fsncA',lineq(iccount-1:iccount-1)) .eq. 0) then ! Causes problems
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *        'Must have "f,s,n,A" before "<" or ">"!')
-            call stop1()
-          end if
-          call g1etchar(lineq,iccount,durq)
-          if (index('1234567890.',durq) .eq. 0) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *        'Expected a number to start here for accidental shift!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          iccount = iccount-1
-          go to 25
-        else if (index('+-',durq) .gt. 0) then
-          if (index('1234567890.',lineq(iccount+1:iccount+1)) .eq. 0)
-     *         go to 25
-c
-c  Number or '.' (durq) follows +/- .   Get it.
-c
-          call g1etchar(lineq,iccount,durq)
-          if (durq .eq. '.' .and. index('1234567890',
-     *                  lineq(iccount+1:iccount+1)) .eq. 0) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *        '"." here must be followed by a digit!')
-            call stop1()
-          else if (index('sfndA',lineq(iccount-2:iccount-2)).eq.0) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *        'Number after +/- must follow "d,s,f,n,A"!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          if (index('+-',durq) .eq. 0) then
-            iccount = iccount-1
-            go to 25
-          end if
-c
-c  2nd +/-
-c
-          call g1etchar(lineq,iccount,durq)
-          if (durq .eq. '.') call g1etchar(lineq,iccount,durq)
-          if (index('1234567890',durq) .eq. 0) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *        'Expected a number here!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          iccount = iccount-1
-          go to 25
-        else if (durq .ne. ' ') then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Illegal character in chord note!')
-          call stop1()
-        end if
-      else if (charq .eq. 'G') then
-        ngr = 1
-9       call g1etchar(lineq,iccount,charq)
-        if (index('123456789',charq) .gt. 0) then
-          call readnum(lineq,iccount,durq,fnum)
-          ngr = nint(fnum)
-          iccount = iccount-1
-          go to 9
-        else if (index('AWulxs',charq) .gt. 0) then
-          go to 9
-        else if (charq .eq. 'm') then
-          call g1etchar(lineq,iccount,charq)
-          if (index('01234',charq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'A digit less than 5 must follow "m" in a grace note!')
-            call stop1()
-          end if
-          go to 9
-        else if (charq .eq. 'X') then
-c
-c Space before main note
-c
-          call g1etchar(lineq,iccount,charq)
-          if (index('0123456789.',charq) .gt. 0) then
-            call readnum(lineq,iccount,durq,fnum)
-            iccount = iccount-1
-            go to 9
-          else
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'A number must follow "X" in a grace note!')
-            call stop1()
-          end if
-        end if
-c
-c  At this point, charq is first note name in rest (grace?)
-c
-        do 19 igr = 1 , ngr
-          numnum = 0
-          if (igr .gt. 1) then
-55          call g1etchar(lineq,iccount,charq)
-            if (charq .eq. ' ') go to 55
-          end if
-          if (index('abcdefg',charq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'In grace, expected "a"-"g"!')
-            call stop1()
-          end if
-18        call g1etchar(lineq,iccount,charq)
-          if (charq .ne. ' ') then
-            if (index('1234567',charq) .gt. 0) then
-              if (numnum .eq. 1) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'Only one of "+-1234567" allowed here in grace!')
-                call stop1()
-              end if
-              numnum = 1
-              go to 18
-c            else if (index('nfs',charq) .gt. 0) then
-            else if (index('+-nfs',charq) .gt. 0) then
-              go to 18
-            end if
-c
-c  Digits are possible octave numbers
-c
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'Illegal character after note name in grace!')
-            call stop1()
-          end if
-19      continue
-      else if (charq .eq. chax(92)) then
-        call chklit(lineq,iccount,literr)
-        if (literr .gt. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               literq(literr))
-          call stop1()
-        end if
-      else if (charq .eq. '"') then
-c
-c  pmx lyric
-c
-        call chkpmxlyr(lineq,iccount,lyrerr)
-        if (lyrerr .gt. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         lyrerq(lyrerr))
-          call stop1()
-        end if
-      else if (charq .eq. 'o') then
-c
-c  Ornament on non-xtup note. "o" symbol must come AFTER the affected note
-c
-        if (nnl(ivx) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *     '"o" must be in same input block, after affected note!')
-          call stop1()
-        end if
-        call g1etchar(lineq,iccount,dumq)
-c        if (index('(stmgx+Tupf._)e:>^bc',dumq) .eq. 0 ) then
-        if (index('(stmgx+Tupf._)e:>^bcCG',dumq) .eq. 0 ) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Illegal ornament!')
-          call stop1()
-        end if
-        if (dumq .eq. ':') then
-          call g1etchar(lineq,iccount,dumq)
-          if (dumq .ne. ' ') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Expected blank after "o:"!')
-            call stop1()
-          else if (.not.ornrpt) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *            'Turned off repeated ornaments before they were on!')
-            call stop1()
-          end if
-          ornrpt = .false.
-        else if (dumq .eq. 'g') then
-          if (issegno) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Sorry, only one "segno" per input block!')
-            call stop1()
-          else if (ivx .ne. 1) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'segno can only be in voice 1!')
-            call stop1()
-          end if
-          issegno = .true.
-12        call g1etchar(lineq,iccount,dumq)
-          if (dumq.eq.'-' .or.
-     *        (ichar(dumq).ge.48.and.ichar(dumq).le.58)) go to 12
-          if (dumq .ne. ' ') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Illegal character in segno ornament symbol!')
-            call stop1()
-          end if
-        else if (dumq .eq. 'T') then
-c
-c  Trill.  may be followed by 't' and/or number.  read 'til blank
-c
-22        call g1etchar(lineq,iccount,dumq)
-          if (dumq .eq. ':') then
-            if (lineq(iccount+1:iccount+1) .ne. ' ') then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Expected blank after ":"!')
-              call stop1()
-            end if
-            go to 32
-          else if (dumq .ne. ' ') then
-            go to 22
-          end if
-        else if (dumq .eq. 'f') then
-          call g1etchar(lineq,iccount,dumq)
-          if (index(' d+-:',dumq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Illegal character after "f" in fermata ornament symbol!')
-            call stop1()
-          end if
-          if (dumq .eq. 'd') call g1etchar(lineq,iccount,dumq)
-          if (dumq .eq. ':') go to 32
-        else if (dumq .eq. 'e') then
-          call g1etchar(lineq,iccount,dumq)
-          if (index('sfn?',dumq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Illegal character after "e" in edit. accid. symbol!')
-            call stop1()
-          end if
-          call g1etchar(lineq,iccount,dumq)
-          if (dumq .eq. '?') call g1etchar(lineq,iccount,dumq)
-        else
-          call g1etchar(lineq,iccount,dumq)
-        end if
-        if (index('+- :',dumq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Illegal character in ornament symbol!')
-          call stop1()
-        end if
-        if (index('+-',dumq) .gt. 0) then
-          if (index('0123456789',lineq(iccount+1:iccount+1)).eq.0) then
-            call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
-     *       'There should be an integer here!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          if (durq .eq. ':') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Cannot shift AND repeat an ornament!')
-            call stop1()
-          end if
-c
-c  12/7/03 Allow horizontal shift on any ornament, not just breath and caes.
-c
-          if (index('+-',durq) .gt. 0) then
-            if (index('.0123456789',lineq(iccount+1:iccount+1)) 
-     *                                                   .eq. 0) then
-              call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
-     *           'There should be a number here!')
-              call stop1()
-            end if
-            call readnum(lineq,iccount,durq,fnum)
-          end if
-        end if
-32      continue
-        if (dumq .eq. ':') then
-          if (lineq(iccount+1:iccount+1) .ne. ' ') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      '":" must be followed by blank in "o: "!')
-            call stop1()
-          else if (ornrpt) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               'Turned on repeated ornaments but already on!')
-            call stop1()
-          end if
-          ornrpt = .true.
-        end if
-      else if (index('st(){}',charq) .gt. 0) then
-        numint = 0
-        iposn = 0
-8       call g1etchar(lineq,iccount,dumq)
-        iposn = iposn+1
-        if (charq.eq.'t' .and. dumq.eq.'t') then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Cannot use "t" as an option on a tie!')
-          call stop1()
-        end if
-        if (index('udltb+-fnhHpsv ',dumq) .eq. 0) then
-c
-c  Check for explicit ID code.
-c
-          ic = ichar(dumq)
-          if (ic.lt.48 .or. (ic.gt.57.and.ic.lt.65) .or.
-     *              ic.gt.90) then
-c
-c  Not 0-9 or A-Z, so exit
-c
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *                   'Illegal character in slur symbol!')
-            call stop1()
-          else
-c
-c  It is a possible ID code.  Right place?
-c
-            if (iposn .ne. 1) then
-c
-c  Slur ID is not 2nd!
-c
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'Slur ID must be second character in slur symbol!')
-              call stop1()
-            else if (charq.eq.'t' .and. fontslur) then 
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Slur ID not allowed on non-postscript tie!')
-              call stop1()                   
-            end if
-          end if
-c
-c  Slur ID is OK. Note it cannot be "H" at this point..
-c
-          go to 8
-        else if (dumq .eq. 'H') then
-          if (iposn .eq. 1) go to 8  
-c
-c  "H" is NOT an ID code.
-c
-          if (.not.fontslur .and. charq.eq.'t') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Cannot reshape postscript ties this way!')
-            call stop1()                   
-          end if        
-	    if (lineq(iccount+1:iccount+1) .eq. 'H') then
-            iccount=iccount+1
-            iposn = iposn+1
-          end if
-          go to 8
-        else if (index('fh',dumq).gt.0 .and. .not.fontslur 
-     *                                  .and. charq.eq.'t') then
-c
-c  3/9/03 Can't reshape postscript tie.
-c
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Cannot reshape postscript ties this way!')
-          call stop1()                   
-        else if (dumq .eq. 'p') then
-c
-c  local change in postscript slur/tie adjustment default
-c
-          if (fontslur) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Must use postscript slurs ("Ap") to use this option!')
-            call stop1()                   
-          end if
-          call g1etchar(lineq,iccount,dumq)
-          if (index('+-',dumq) .eq. 0) then                
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *              'Expected "+" or "-" here!')
-            call stop1()                   
-          end if
-          call g1etchar(lineq,iccount,dumq)
-          if (index('st',dumq) .eq. 0) then                
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *              'Expected "s" or "t" here!')
-            call stop1()                   
-          end if
-          iposn = iposn+2
-          go to 8
-        end if
-        if (index('udltbfnh',dumq) .gt. 0) then
-          go to 8
-        else if (index('+-',dumq) .gt. 0) then
-          numint = numint+1
-          if (fontslur .and. charq.eq.'t') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *     '"+|-" for slur height only allowed in "s"-slurs!')
-            call stop1()
-          end if
-          iccount = iccount+1
-          call readnum(lineq,iccount,durq,fnum)
-          if (numint .eq. 1) then
-            if (nint(fnum) .gt. 30) then
-              call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *       'Magnitude of slur height adjustment cannot exceed 30!')
-              call stop1()
-            end if
-          else if (numint .eq. 2) then
-            if (abs(fnum) .gt. 6.3) then
-              call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *       'Slur horiz shift must be in range (-6.3,6.3)!')
-              call stop1()
-            end if
-          else
-c
-c  Third signed integer, must be a midslur or curve spec.
-c
-            if (abs(fnum).gt.31) then
-              call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *                  'Slur midheight must be in the range (-31,31)!')
-              call stop1()
-            end if
-            if (durq .eq. ':') then
-c
-c  Expecting curve parameters.  Get two numbers
-c
-              do 41 i = 1 , 2
-                iccount = iccount+1
-                fnum = ichar(lineq(iccount:iccount))-48
-                if (abs(fnum-3.5) .gt. 3.6) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *                 'Slur curve parameter must be in range (0,7)!')
-                  call stop1()
-                end if
-41            continue
-              iccount = iccount+1
-            end if
-          end if
-          iccount = iccount-1
-          go to 8
-        else if (dumq .eq. 's') then
-c
-c What follows should be one or two signed numbers for adjustment of line break
-c slur, end of 1st segment or start of second.
-c
-          if (fontslur) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *    'May not use linebreak slur options with font-based slurs!')
-            call stop1()
-          end if
-          call g1etchar(lineq,iccount,dumq)
-          if (index('+-',dumq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'This character must be "+" or "-"!')
-            call stop1()
-          end if
-          iccount = iccount+1
-          call readnum(lineq,iccount,dumq,fnum)
-          if (nint(fnum) .gt. 30) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *     'Magnitude of slur height adjustment cannot exceed 30!')
-            call stop1()
-          end if
-          if (index('+-',dumq) .gt. 0) then
-            iccount = iccount+1
-            call readnum(lineq,iccount,dumq,fnum)
-            if (abs(fnum) .gt. 6.3) then
-              call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *         'Slur horiz shift must be in range (-6.3,6.3)!')
-              call stop1()
-            end if
-          end if
-          iccount = iccount-1
-          go to 8
-	  else if (dumq .eq. 'H' .and. iposn.gt.1) then
-          if (lineq(iccount+1:iccount+1) .eq. 'H') iccount=iccount+1
-          go to 8
-        end if
-      else if (charq .eq. '?') then
-        call getchar(lineq,iccount,durq)
-        if (durq .eq. ' ') then
-          iccount = iccount-1
-        else
-          if (durq .ne. '-') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Expecting "-"!')
-            call stop1()
-          end if
-          call getchar(lineq,iccount,durq)
-          if (index('0123456789.',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *                'Expecting number!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          iccount = iccount-1
-        end if
-      else if ((ichar(charq).ge.48.and.ichar(charq).le.57) .or.
-     *    index('#-nx_',charq) .gt. 0) then
-c
-c  We have a figure.  Must come AFTER the note it goes under
-c
-        if (itsofar(ivx).eq.0 .and.
-     *    (.not.firstline.or.lenbr0.eq.0.or.lenbar.eq.lenbr0)) then
-c
-c  Figure before first note in block
-c
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Cannot put figure before first note in block!')
-          call stop1()
-        end if
-        if (charq.eq.'x') then
-          indxb = index(lineq(iccount:128),' ')
-          if (indxb .lt. 5) then
-            call errmsg(lineq,iccount+indxb-1,ibarcnt-ibaroff+nbars+1,
-     *           'Cannot have a blank here in floating figure!')
-            call stop1()
-          end if
-        end if
-        if (usefig) ifig = 1
-5       call g1etchar(lineq,iccount,charq)
-        if (index(' 0123456789#-nx_.:+sv',charq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Illegal character in figure!')
-          call stop1()
-        else if (charq .eq. '+') then
-c
-c vertical offset, must be integer, then blank
-c               
-          call g1etchar(lineq,iccount,charq)
-          if (index('123456789',charq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Integer for vertical offset expected here!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,charq,fnum)
-          if (charq .ne. ' ') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Vertical offset must terminate figure!')
-            call stop1()
-          end if
-          iccount = iccount-1
-          go to 5                  
-        else if (charq .eq. 's') then
-          isligfont = .true.
-        end if
-        if (charq .ne. ' ') go to 5
-      else if (charq .eq. '[') then
-        if (fbon) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Started forced beam while another was open!')
-          call stop1()
-        end if
-        fbon = .true.
-17      call g1etchar(lineq,iccount,charq)
-        if (index('uljhf:',charq) .gt. 0) then
-          go to 17
-        else if (index('+-',charq) .gt. 0) then
-          iccount = iccount+1
-          call readnum(lineq,iccount,durq,fnum)
-          iccount = iccount-1
-          go to 17
-        else if (charq .eq. 'm') then
-c
-c  Forced multiplicity, next char should be 1-4
-c
-          call g1etchar(lineq,iccount,charq)
-          if (index('1234',charq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Forced multiplicity for a beam must be 1, 2, 3, or 4!')
-            call stop1()
-          end if
-          go to 17
-        else if (charq .ne. ' ') then
-          if (index('0123456789',charq) .gt. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'After "[", digits must now be preceeded by "+" or "-"!')
-        print*,'You will have to edit older sources to meet this rqmt,'
-        print*,'but it was needed to allow 2-digit height adjustments.'
-        print*,'Sorry for the inconvenience.  --The Management'
-          else
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Illegal character after [!')
-          end if
-        call stop1()
-        end if
-      else if (charq .eq. ']') then
-        if (.not.fbon) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Forced beam stop with no corresponding start!')
-          call stop1()
-        end if
-        call g1etchar(lineq,iccount,charq)
-	  if (charq .eq. '-') then
-          if (lineq(iccount+1:iccount+2) .ne. '[ ') then
-            call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
-     *        'Only sequence allowed here is "[ "!')
-            call stop1()
-          else 
-            iccount = iccount+2
-          end if            
-        else if (charq .eq. '[') then
-          if (lineq(iccount+1:iccount+1) .ne. ' ') then
-            call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
-     *           'This character must be a blank!')
-            call stop1()
-          end if
-        else
-c
-c  Forced beam is really ending
-c
-          fbon = .false.
-          if (charq .eq. 'j') then
-            if (lineq(iccount+1:iccount+1) .ne. ' ') then
-              call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
-     *           'This character must be a blank!')
-              call stop1()
-            end if
-          else if (charq .ne. ' ') then           
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         '"]" must be followed by blank, "j", "-", or "["!')
-            call stop1()
-          end if
-        end if
-      else if (charq .eq. 'D') then
-c
-c  Dynamic mark
-c
-        if (nnl(ivx) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      '"D" must not come before any notes have been entered!')
-          call stop1()
-        end if
-        call checkdyn(lineq,iccount,ibarcnt-ibaroff+nbars+1)
-      else if (index('lhw',charq) .gt. 0) then
-c
-c  Save position for later check
-c
-        icclhw = iccount
-        call g1etchar(lineq,iccount,durq)
-        if (index('0123456789.+- ',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Illegal character after "l", "w", or "h"!')
-          call stop1()
-        end if
-        isheadr = isheadr .or. charq .eq. 'h'
-        if (index(' +-',durq) .gt. 0) then
-c
-c  There is a header (or lower string?)
-c
-          if (index('+-',durq) .gt. 0) then
-c
-c  User-defined vert offset (\internote).
-c
-            if (charq .ne. 'h') then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               '"+" or "-" not permitted here!')
-              call stop1()
-            end if
-c
-c  Have "h" followed by +/- .  Check for digit.
-c     Can blow durq since not using fnum for now, but...
-c
-            call g1etchar(lineq,iccount,durq)
-            if (index('123456789',durq) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'There must be a digit here!')
-              call stop1()
-            end if
-c
-c  Have "h" followed by +/- followed by a digit.  No need to get the number.
-c
-c           call readnum(lineq,iccount,durq,fnum)
-          end if
-          if (charq .ne. 'w') then
-c
-c  Header or lower string.
-c
-            if (icclhw .ne. 1) then
-              call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *               '"h" or "l" must be first character in line!')
-              call stop1()
-            end if
-c
-c  Read past the next line, which has the string.
-c
-            call read10(charq,lastchar)
-            nline = nline+1
-            iccount = 128
-          else
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Symbol "w" (width) must be followed by a digit!')
-            call stop1()
-          end if
-        else
-c
-c  Height or width change spec.  Check if at start of piece.
-c
-          if (ibarcnt .gt. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Symbol must go at top of first input block!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,dimen)
-c
-c  Check units.  Convert to points
-c
-          if (durq .eq. ' ' .or. durq .eq. 'p') then
-            dimen = dimen+.5
-          else if (durq .eq. 'i') then
-            dimen = dimen*72+.5
-          else if (durq .eq. 'm') then
-            dimen = dimen/25.4*72+.5
-          else
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Illegal unit; must be "p","i",or"m"!')
-            call stop1()
-          end if
-c
-c 151211 fix. May have extra character. 
-c
-          if (index('pim',durq) .gt. 0) then
-c
-c Get another character, see if it's blank
-c
-            if (lineq(iccount+1:iccount+1) .ne. ' ') then
-              call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
-     *          'This character should be a blank!')
-              call stop1()
-            end if       
-          end if
-          if (charq .eq. 'h') then
-            ptheight = int(dimen)
-          else
-            widthpt = int(dimen)
-          end if
-        end if
-      else if (charq .eq. 'm') then
-c
-c  Time signature change.  Only allow at beginning of block.
-c    mtrnuml, mtrdenl (logical) and p (printable) will be input.
-c    mtrnuml=0 initially. (In common)
-c
-c  Check whether at beginning of a block
-c
-        if (ivx.ne.1 .or. nnl(1).ne.0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *     'Meter change only OK in voice 1, at start of block!')
-          print*,'voice number is',ivx
-          call stop1()
-        end if
-        newmeter = .true.
-        call readmeter(lineq,iccount,mtrnuml,mtrdenl)
-        if (mtrnuml .eq. 0) then
-          call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *     'Digit 0 not allowed here!')
-          call stop1()
-c        else if (mtrdenl .eq. 1) then
-cc
-cc  Kluge!!!
-cc
-c          mtrdenl = 2
-c          mtrnuml = 2*mtrnuml
-        end if
-        call readmeter(lineq,iccount,mtrnmp,mtrdnp)
-c
-c  Read past printed time signature; not used in pmxa.
-c
-        lenbeat = i1fnodur(mtrdenl,'x')
-        lenmult = 1
-        if (mtrdenl .eq. 2) then
-          lenbeat = 16
-          lenmult = 2
-        end if
-        lenbar = lenmult*mtrnuml*lenbeat
-        mtrnuml = 0
-      else if (charq .eq. 'C') then
-        call g1etchar(lineq,iccount,durq)
-        if (.not.(index('tsmanrbf',durq).gt.0 .or.
-c     *      (ichar(durq).ge.48 .and. ichar(durq).le.54))) then
-c     *      (ichar(durq).ge.48 .and. ichar(durq).le.55))) then
-     *      (ichar(durq).ge.48 .and. ichar(durq).le.56))) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-c     *           'Must have t,s,m,a,n,r,b,f or 1-6 after C!')
-     *           'Must have t,s,m,a,n,r,b,f or 0-8 after C!')
-          call stop1()
-        end if
-c        gotclef = .true.
-      else if (charq .eq. 'R') then
-        if (ivx .ne. 1) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Repeats can only go in voice 1!')
-          call stop1()
-        end if
-10      call g1etchar(lineq,iccount,durq)
-        if (index('lrdDbz',durq) .gt. 0) go to 10
-        if (durq .ne. ' ') then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Illegal character after "R" (repeat/double bar)!')
-          call stop1()
-        end if
-      else if (charq .eq. 'V') then
-c
-c  Ending
-c
-        if (iv .ne. 1) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Voltas are only allowed in voice #1!')
-          call stop1()
-        else if (isvolt) then
-          print*
-          print*,'*******WARNING********'
-          write(15,'(/,a)')'*******WARNING********'
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'There is more than one volta in this input block.!')
-          print*,'This may work in a score, but WILL NOT work in parts.'
-          print*,
-     *'Safest to have only 1 volta per block, at the start of the block'
-          write(15,'(a)')
-     *           'This may work in a score, but WILL NOT work in parts.'
-          write(15,'(a)')
-     *'Safest to have only 1 volta per block, at the start of the block'
-        end if
-        isvolt = .true.
-        lvoltxt = 0
-11      call g1etchar(lineq,iccount,durq)
-        if (durq .ne.' ') then
-          go to 11
-        end if
-      else if (charq .eq. 'B') then
-        continue
-      else if (charq .eq. 'P') then
-        if (ivx.ne.1 .or. nnl(1).ne.0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Only allowed at beginning of block!')
-          call stop1()
-        end if
-16      call g1etchar(lineq,iccount,durq)
-        if (durq.eq.'l'.or.durq.eq.'r'.or.(ichar(durq).ge.48 .and.
-     *       ichar(durq).le.57)) go to 16
-        if (durq .eq. 'c') then
-c
-c  Expect a centered name, and it has to be last option
-c
-          call g1etchar(lineq,iccount,durq)
-          if (durq .eq. '"') then
-c
-c  Quoted name, go to next quote mark
-c
-            do 35 iccount = iccount+1 , 127
-              if (lineq(iccount:iccount) .eq. '"') go to 36
-35          continue
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Missing close quote after page number command (P)!')
-            call stop1()
-36          continue
-          else if (durq .ne. ' ') then
-c
-c  Space-delimited name, look for next blank
-c
-            do 37 iccount = iccount+1 , 127
-              if (lineq(iccount:iccount) .eq. ' ') go to 38
-37          continue
-38          continue
-          end if
-        else if (durq .ne. ' ') then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Only "l","r","c" or digit allowed after "P"!')
-          call stop1()
-        end if
-      else if (charq .eq. 'W') then
-        call g1etchar(lineq,iccount,durq)
-        if (index('.0123456789',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Expected a number to start here!')
-          call stop1()
-        end if
-        call readnum(lineq,iccount,durq,wminnh(ibarcnt+nbars+1))
-      else if (charq .eq. 'T') then
-c
-c  Titles
-c
-        call g1etchar(lineq,iccount,durq)
-        if (index('itc',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Must put "i", "t", or "c" after "T"!')
-          call stop1()
-        end if
-        ihead = ihead+2**(index('itc',durq)-1)
-c
-c  Maybe a number after 'Tt', but ignore here.  Read past string on next line.
-c
-        call read10(charq,lastchar)
-        nline = nline+1
-        iccount = 128
-      else if (charq .eq. 'A') then
-27      call g1etchar(lineq,iccount,durq)
-        if (index('rbsdeK',durq) .gt. 0) then
-          go to 27
-        else if (durq .eq. 'v') then
-          if (ibarcnt .eq. 0) novshrinktop = .true.
-          go to 27
-        else if (durq .eq. 'a') then
-          call g1etchar(lineq,iccount,durq)
-          if (index('0123456789.',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'After "Aa", need decimal number!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fbar)
-          iccount = iccount-1
-          go to 27
-        else if (durq .eq. 'i') then
-          call g1etchar(lineq,iccount,durq)
-c
-c  Local interstaff correction.  Set to -1. if not specifiec, or after use,
-c  or anytime except at top, since pmxb handles all times except at top.
-c
-          call readnum(lineq,iccount,durq,tintstf)
-          if (ibarcnt .eq. 0) fintstf = tintstf
-          iccount = iccount-1
-          go to 27
-        else if (durq .eq. 'I') then
-c
-c  Global interstaff correction.  Use in place of fintstf if fintstf<0
-c
-          call g1etchar(lineq,iccount,durq)
-          call readnum(lineq,iccount,durq,gintstf)
-          iccount = iccount-1
-          go to 27
-        else if (durq .eq. 'o') then
-          optimize = .true.
-          go to 27
-        else if (durq .eq. 'S') then
-c 130324
-c          do 50 iiv = 1 , nv
-          do 50 iiv = 1 , noinst
-            call g1etchar(lineq,iccount,durq)
-            if (index('-0st',durq) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'After "AS", need nv instances of "s,t,-,0"!')
-              call stop1()
-            end if
-            if (durq.eq.'-'.or.durq.eq.'s') then
-              isize(iiv) = 1
-            else if (durq.eq.'t') then
-              isize(iiv) = 2
-            end if
-50        continue
-          go to 27
-        else if (durq .eq. 'p') then
-          fontslur = .false.
-42        continue
-          call g1etchar(lineq,iccount,durq)
-          if (index('+-',durq) .gt. 0) then
-c
-c  Characters to change defaults for ps slurs
-c
-            call g1etchar(lineq,iccount,durq)
-            if (index('shtc',durq) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Only letters allowed here are "s","h","t","c"!')
-              call stop1()
-            end if
-c
-c  Now check for another default modifier
-c
-            go to 42
-          else if (index('lh',durq) .gt. 0) then
-c
-c  Flags for optional linebreak ties or header specials
-c
-            go to 42
-          else
-            iccount = iccount-1
-          end if
-          go to 27
-        else if (durq .eq. 'N') then
-c
-c  Override default name for a part file. Must have part number, then
-c    partname in quotes. Must be on line by itself, and start in column 1. 
-c    Will only be passed thru to scor2prt.
-c
-          if (iccount .ne. 2) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        '"AN" must start in column 1!')
-            call stop1()
-          end if
-          ndxquote = index(lineq,'"')
-          if (ndxquote.lt.4 .or. ndxquote.gt.5 .or. 
-     *        index('123456789',lineq(3:3)).eq.0 .or.
-     *        (ndxquote.eq.5.and.index('012',lineq(4:4)).eq.0)) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        '"AN" must be followed by inst. #, then quote!')
-            call stop1()
-          end if
-          ndxquote = index(lineq(ndxquote+1:128),'"')
-          if (ndxquote .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'In "AN", file name must be in quotes!')
-            call stop1()
-          end if
-          iccount = 128
-        else if (durq .eq. 'T') then
-          cstuplet = .true.
-        else if (durq .eq. 'R') then
-c
-c  Get full name of normal include file; must occupy remainder of line
-c
-          call getpmxmod(.false.,lineq(iccount+1:128))
-          iccount = 128
-        else if (durq .eq. 'c') then
-          call g1etchar(lineq,iccount,durq)
-          if (index('l4',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Only "l" or "4" is allowed here!')
-            call stop1()
-          end if
-          if (durq .eq. 'l' ) then
-            hoffpt = -25
-            voffpt = -45
-          else if (durq .eq. '4') then
-            ptheight = 745
-            widthpt = 499
-            hoffpt = -24
-            voffpt = -24
-          end if
-          go to 27
-        else if (durq .ne. ' ') then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-c     *       'After "A" must follow one of the letters abcdeiINprRsST!')
-     *     'After "A" must follow one of the letters abcdeiILNprRsST!')
-          print*,'For AS, since ver. 2.7, must only have noinst args.'
-          write(15,'(a)')
-     *           'For AS, since ver. 2.7, must only have noinst args.'
-          call stop1()
-        end if
-      else if (charq .eq. 'K') then
-c
-c  Rules and function of K command
-c
-c  Only 1 K +/-n +/-m  allowed per block if n.ne.0 (transposition).  isig1 is
-c  initial sig, and must be passed to pmxb because it is needed when topfile
-c  is called, which is before the K+n+m command is read in pmxb.  Also, we
-c  compute and save ibrkch and newkey for each syst, accounting for key changes,
-c  then adjust fbar to make poenom much more accurate.
-c  Jan 02: Now K-0+[n] is used to transpose e.g. from f to f#.
-c
-77      continue
-        call g1etchar(lineq,iccount,durq)
-c        if (index('+-i',durq) .eq. 0) then
-        if (index('+-in',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *   '"K" (transpose or key change) must be followed by "+,-,i,n"!')
-          call stop1()
-        end if
-        if (durq .eq. 'n') go to 77
-        if (durq .ne. 'i') then
-c
-c Normal key change and/or transposition)
-c
-c          iccount = iccount+1
-          num1 = 44-ichar(durq)
-c
-c  num1= +1 or -1
-c
-          ztrans = num1.eq.-1 
-          call g1etchar(lineq,iccount,durq)
-          if (index('0123456789',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      '1st +/- must be followed by a number!')
-            call stop1()
-          end if
-c          iccount = iccount+1
-          call readnum(lineq,iccount,durq,fnum)
-          num1 = nint(fnum)*num1
-          ztrans = ztrans .and. num1.eq.0
-          if (index('+-',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      '1st number after "K" must be followed by "+,-"!')
-            call stop1()
-          end if
-          iccount = iccount+1
-          num2 = 44-ichar(durq)
-          call readnum(lineq,iccount,durq,fnum)
-          num2 = num2*int(fnum+.1)
-          if (num1.eq.0 .and. .not.ztrans) then
-c
-c  Key change, only one per block allowed
-c
-            if (iskchb) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Only one key change allowed per input block!')
-              call stop1()
-            end if
-            iskchb = .true.
-            nkeys = nkeys+1
-            kchmid(nkeys) = mod(itsofar(ivx),lenbar).ne.0
-c
-c  Make ibrkch = barnum-1 if at start of bar, so fsyst advances ok at linebreak.
-c
-            ibrkch(nkeys) = ibarcnt+nbars
-            if (kchmid(nkeys)) ibrkch(nkeys) = ibrkch(nkeys)+1
-            newkey(nkeys) = num2+idsig
-c 130316
-c            do 43 iinst = 1 , noinst
-              midisig = newkey(nkeys)
-c43          continue
-          else
-c
-c  Transposition
-c
-            fulltrans = .true.
-            if (ibarcnt .gt. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'Transposition must be at top of first input block!')
-              call stop1()
-            end if
-            isig1 = num2
-            idsig = isig1-newkey(1)
-c
-c  idsig is the difference between sig after transposition, and sig in setup.
-c  It may alter # of accid's in key changes if there is transposition.
-c
-          end if
-        else   ! durq='i'
-c
-c  110522/110529
-c  Instrument-wise transposition Ki[iInstTrans][+/-][iTransAmt][+/-][iTransKey]
-c    and repeat i[...] for multiple instruments. Store info here if ibarcnt=0
-c    so can pass to topfile (via comInstTrans), which is called before getnote. 
-c    Otherwise, will store info from getnote. Initialize EarlyTransOn and
-c    LaterInstTrans to .false. in blockdata. Set EarlyTransOn from here; 
-c    LaterInstTrans from g1etnote. Zero both out after use. nInstTrans really
-c    only needed for instrument-signatures, not transpositions. iTransAmt is
-c    ALWAYS active per instrument. Set up instno(iv) so can fetch iTransAmt for
-c    each staff.
-c
-c          if (fulltrans) then
-c            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-c     *       'Cannot yet combine full and instrument transposition!')
-c            call stop1()
-c          end if
-          call GetiTransInfo(.true.,ibarcnt,lineq,iccount,
-     *                         ibaroff,nbars,noinst)
-        end if
-      else if (charq .eq. '|') then
-c
-c  Optional bar symbol
-c
-        if (mod(itsofar(ivx),lenbar).ne.0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Bar line marker out of place!')
-          call stop1()
-        else if (shifton) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Bar ended with user-defined shift still on!')
-          call stop1()
-        end if
-      else if (charq .eq. '/') then
-        if (ornrpt) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'WARNING: Block ended with repeated ornament still on!')
-          ornrpt = .false.
-        end if
-        if (stickyS) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'WARNING: Block ended with sticky stemshrink still on!')
-          stickyS = .false.
-        end if
-        if (fbon) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Block ended with forced beam open!')
-          call stop1()
-        else if (shifton) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Bar ended with user-defined shift still on!')
-          call stop1()
-c
-c 140215 Temporary to allow clef change in stup
-c
-c        else if (gotclef) then
-c          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-c     *      'May not enter clef at end of input block!')
-c          call stop1()
-        end if
-        barend = .false.
-c
-c  Perform time checks
-c
-        if (mod(itsofar(ivx),lenbar).ne.0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Block duration not divisible by lenbar!')
-          print*,'lenbar is ',lenbar
-          call stop1()
-        else if (ivx.gt.1 .and. itsofar(ivx).ne.itsofar(1)) then
-          print*
-          print*,'# of bars in voice 1, current voice:',
-     *        itsofar(1)/lenbar,itsofar(ivx)/lenbar
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Block duration not equal to voice 1!')
-          call stop1()
-        end if
-        call g1etchar(lineq,iccount,durq)
-        if (durq .eq. ' ' .and. iv.eq.nv) then
-c
-c  End of input block
-c
-          loop = .false.
-        else
-c
-c  Start a new voice
-c
-          if (lenbr0.ne.0 .and. firstline) lenbar = lenbr0
-          nbars = 0
-          if (durq .eq. ' ') then
-c
-c  New voice is on next staff
-c
-            iv = iv+1
-            ivx = iv
-          else
-c
-c  New voice is on same staff.  Set up for it
-c
-            ivx = nv+1
-            do 23 iiv = 1 , nv
-              if (nvmx(iiv) .eq. 2) ivx = ivx+1
-23          continue
-            if (ivx .gt. nm) then
-              write(*,'(1x,a21,i3,a23)')'Cannot have more than',nm,
-     *          ' lines of music at once'
-              call stop1()
-            end if
-            nvmx(iv) = 2
-            ivmx(iv,2) = ivx
-            itsofar(ivx) = 0
-            nnl(ivx) = 0
-            do 24 j = 1 , 200
-              rest(ivx,j) = .false.
-              nacc(ivx,j) = 0
-24          continue
-c
-c  For midi stuff, record that there is a 2nd line of music in this voice
-c
-            if (ismidi) twoline(iv) = .true.
-          end if
-        end if
-        iccount = 128
-      else if (charq .eq. 'S') then
-c
-c  New nsyst: for use with partmaker scor2prt, for parts w/ diff # of systs.
-c
-        if (ibarcnt .gt. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           '"S" can only be in first input block!')
-          call stop1()
-        end if
-        call g1etchar(lineq,iccount,durq)
-        if (index('123456789 ',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'A digit must follow "S"!')
-          call stop1()
-        end if
-        call readnum(lineq,iccount,durq,fnsyst)
-        nsyst = nint(fnsyst)
-14      continue
-        if (durq .eq. 'P') then
-c
-c  New npages for parts.  
-c
-          call g1etchar(lineq,iccount,durq)
-          if (index('123456789 ',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Must have a number here!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnsyst)
-          npages = nint(fnsyst)
-          go to 14
-        else if (durq .eq. 'm') then
-c
-c  Reset musize (musicsize).
-c
-          call g1etchar(lineq,iccount,durq)
-          if (index('123456789 ',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Must have a number here!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnsyst)
-          musize = nint(fnsyst)
-          wheadpt = whead20*musize
-          go to 14
-        else if (durq .ne. ' ') then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Illegal character in "S" symbol!')
-          call stop1()
-        end if
-      else if (charq .eq. 'L') then
-        nflb = nflb+1
-        ibarflb(nflb) = ibarcnt+nbars+1
-        call g1etchar(lineq,iccount,durq)
-        if (index('123456789',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Need integer to define forced line break!')
-          call stop1()
-        end if
-        call readnum(lineq,iccount,durq,sysflb)
-        isysflb(nflb) = nint(sysflb)
-        if (nflb .gt. 1) then
-c
-c  Check if new number is > prior one
-c
-          if (isysflb(nflb) .le. isysflb(nflb-1)) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *       'You already forced a line break at a later line!')
-            call stop1()
-          end if
-        end if
-        if (npages .eq. 0) then
-          print*
-          print*,'WARNING! You forced a line break at line ',
-     *      isysflb(nflb),' but npage = 0.  Continue?'
-          read(*,'(a)') charq
-          if (index('yY',charq) .eq. 0) call stop1()
-        else if (isysflb(nflb) .gt. nsyst) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Forced line break at line num > nsyst!')
-          call stop1()
-        else if (index(' PM',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Must have " ", "P", or "M" here!')
-          call stop1()
-        end if
-        if (durq .eq. 'P') then
-c
-c  Forced page break here, get page number.
-c
-          call g1etchar(lineq,iccount,durq)
-          if (index('123456789',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Need integer to define forced page break!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          nfpb = nfpb+1
-          ipagfpb(nfpb) = nint(fnum)
-          isysfpb(nfpb) = isysflb(nflb)
-          if (ipagfpb(nfpb) .gt. npages) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *           'Forced page break at page num > npages!')
-            call stop1()
-          else if (nfpb .gt. 1) then
-            if (ipagfpb(nfpb) .le. (ipagfpb(nfpb-1))) then
-              call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *           'Forced page break numbers must increase!')
-              call stop1()
-            end if
-          end if
-        end if
-        if (index(' M',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Illegal character in linebreak symbol!')
-          call stop1()
-        else if (durq .eq. 'M') then
-          nmovbrk = nmovbrk+1
-          isysmb(nmovbrk) = isysflb(nflb)
-          call g1etchar(lineq,iccount,durq)
-31        if (durq .eq. '+') then
-c
-c  Vertical spacing, read past number.
-c
-            call g1etchar(lineq,iccount,durq)
-            if (index('123456789',durq) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Integer required here!')
-              call stop1()
-            end if
-            call readnum(lineq,iccount,durq,fnum)
-            go to 31
-          else if (durq .eq. 'i') then
-c
-c  Change indentation,
-c
-            call g1etchar(lineq,iccount,durq)
-            if (index('.123456789',durq) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Decimal number required here!')
-              call stop1()
-            end if
-c
-c  fracsys was initialized in block data to all 0.'s
-c
-            call readnum(lineq,iccount,durq,fracsys(nmovbrk))
-            go to 31
-          else if (durq .eq. 'c') then
-            call g1etchar(lineq,iccount,durq)
-            go to 31
-          else if (durq .eq. 'r') then
-            call g1etchar(lineq,iccount,durq)
-            if (index('+-',durq) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Must have "+" or "-" after "r" as movement break option!')
-              call stop1()
-            end if
-            call g1etchar(lineq,iccount,durq)
-            go to 31
-          else if (durq .eq. 'n') then
-c
-c  Change # of voices.  Input ninow, iorig(1...ninow).  Will use names,
-c  staves per inst. and clefs  corr. to iorig in original list of instruments.
-c
-            nv = 0
-            call g1etchar(lineq,iccount,durq)
-            if (durq .eq. ':') then
-c
-c  Signals a 2-digit number, get next two characters
-c
-              call g1etchar(lineq,iccount,durq)
-              call g1etchar(lineq,iccount,dumq)
-              if (index('12',durq).eq.0
-     *                   .or.index('0123456789',dumq).eq.0) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'Illegal new number of instruments '//durq//dumq//
-     *               ' at movement break!')
-                call stop1()
-              end if
-              read(lineq(iccount-1:iccount),'(i2)')ninow
-            else
-c
-c  durq is a single digit number for noinow
-c
-              if (index('123456789',durq) .eq. 0) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'Illegal new number of instruments '//durq//
-     *                                  ' at movement break!')
-                call stop1()
-              end if
-              ninow = ichar(durq)-48
-            end if
-            if (ninow.gt.noinst) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'New number of instruments must be <= original!')
-              call stop1()
-            end if
-            do 63 iinow = 1 , ninow
-              call g1etchar(lineq,iccount,durq)
-              if (durq .eq. ':') then
-c
-c  Signals a 2-digit number
-c
-                call g1etchar(lineq,iccount,durq)
-                call g1etchar(lineq,iccount,dumq)
-                if (index('12',durq).eq.0
-     *                   .or.index('0123456789',dumq).eq.0) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *              'Illegal 2-digit instrument number '//durq//dumq//
-     *               ' at movement break!')
-                  call stop1()
-                end if
-                read(lineq(iccount-1:iccount),'(i2)')iorig
-              else
-c
-c  durq is a single digit number for iorig
-c
-                if (index('123456789',durq) .eq. 0) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *              'Illegal instrument number '//durq//
-     *                                  ' at movement break!')
-                  call stop1()
-                end if
-                iorig = ichar(durq)-48
-              end if
-              if (iorig .gt. noinst) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'New instrument number must be <= original noinst!')
-                call stop1()
-              end if
-              nv = nv+nsperi(iorig)
-63          continue
-            do 61 iiv = 1 , nv
-c
-c  Get clef names
-c
-              call g1etchar(lineq,iccount,durq)
-              if (.not.(index('tsmanrbf',durq).gt.0 .or.
-     *             (ichar(durq).ge.48 .and. ichar(durq).le.55))) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Must have t,s,m,a,n,r,b,f or 1-7 as clef symbol here!')
-                call stop1()
-              end if
-c
-c  Initialize new voices
-c
-              nvmx(iiv) = 1
-              ivmx(iiv,1) = iiv
-              itsofar(iiv) = 0
-              nnl(iiv) = 0
-              do 62 j = 1 , 200
-                rest(iiv,j) = .false.
-62            continue
-61          continue
-c
-c  Loop back up, this might not be last option in M
-c
-            call g1etchar(lineq,iccount,durq)
-            go to 31
-          else if (durq .ne. ' ') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Illegal character after Movement break symbol!')
-            call stop1()
-          end if
-          if (fracsys(nmovbrk) .lt. 0.001) then
-c
-c  Since fracsys was not explicitly set, set it to prior value.
-c
-            if (nmovbrk .eq. 1) then
-              fracsys(nmovbrk) = fracindent
-            else
-              fracsys(nmovbrk) = fracsys(nmovbrk-1)
-            end if
-          end if
-        end if
-c
-c  Just before exiting if-block for forced line breaks, set counter to use when 
-c  dealing with vertical space calcs
-c
-        nistaff(nflb) = nv-1
-      else if (charq .eq. 'F') then
-        usefig = .false.
-      else if (charq .eq. 'X') then
-        call g1etx(lineq,iccount,shifton,ibarcnt-ibaroff+nbars+1,
-     *             udsp(ibarcnt+nbars+1),wheadpt)
-      else if (charq .eq. 'I') then
-c
-c  MIDI settings.  
-c
-        if (ivx.ne.1 .or. nnl(1).ne.0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *     'MIDI stuff only allowed at start of block!')
-          call stop1()
-        end if
-        if (nv .gt. 15) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *     'Sorry but MIDI does not work with more than 15 voices!')
-          call stop1()
-        end if
-        ismidi = .true.
-c        call getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar,
-        call getmidi(noinst,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar,
-     *               mtrdenl,.true.)
-      else if (charq .eq. 'M') then
-        call setmac(lineq,iccount,ibarcnt,ibaroff,nbars,charq,durq,ivx,
-     *                 nline)
-      else if (index(',.',charq) .gt. 0) then
-c
-c  Continued rhythmic shortcut
-c
-        idotform = index('. ,',charq)
-        if (idotform .eq. 1) then
-c
-c  Change duration of prior note 
-c
-          itsofar(ivx) = itsofar(ivx)-nodur(ivx,nnl(ivx))
-          nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*3/2 
-          itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx))
-        end if
-        idotform = idotform+1
-        numnum = 1
-        cdot = .true.
-        go to 1
-      else
-        print*,'ASCII code:',ichar(charq)
-        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'This character is not allowed here!')
-        print*,'ASCII code:',ichar(charq)
-        call stop1()
-      end if
-      return
-      end
-      subroutine g1etset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp,
-     *    xmtrnum0,newkey,npages,nsyst,musize,bottreb)
-      parameter(nm=24,maxblks=4000)
-      character*65536 bufq
-      character*1 chax
-      integer*2 lbuf(maxblks)
-      common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
-      character*128 lineq
-      logical lastchar,issegno,isheadr,isvolt,fbon,bottreb,
-     *        newway
-      common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
-     *     fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
-      common /commidisig/ midisig
-c
-c  Get the first line
-c
-      iccount = 0
-      nline = 1
-9     call getbuf(lineq)
-      if (lineq(1:1) .eq. '%') then
-        nline = nline+1
-        go to 9
-      end if
-      if (lineq(1:3) .eq. '---') then
-c
-c  Have TeX input until next line that starts with '---'
-c
-3       nline = nline+1
-        call getbuf(lineq)
-        if (ilbuf .gt. nlbuf) go to 1
-        go to 2
-1       print*,'You did not terminate type 0 TeX input with "---"'
-        call stop1()
-2       continue
-        if (lineq(1:3) .ne. '---') go to 3
-c
-c  Force a new line read on first call to readin
-c
-        iccount = 128
-      end if
-c
-c  Here, lineq and nline are first non-TeX lines.
-c
-      nv = nint(readin(lineq,iccount,nline))
-      if (nv .gt. nm) then
-        write(*,'(1x,a46,i3)')
-     *     'In setup data, number of voices cannot exceed',nm
-        call stop1()
-      end if
-      noinst = nint(readin(lineq,iccount,nline))
-      if (noinst .gt. nv) then
-        write(*,'(a)')
-     *    'In setup data, cannot have more instruments than staves'
-        call stop1()
-      end if
-      newway = noinst.le.0
-      if (newway) noinst = -noinst
-      do 10 iinst = 1 , noinst
-c
-c  Seve # of staves per inst in case later drop some inst's.
-c
-        if (newway) then
-          nsperi(iinst) = nint(readin(lineq,iccount,nline))
-        else if (iinst .gt. 1 ) then
-          nsperi(iinst) = 1
-        else
-          nsperi(iinst) = nv-noinst+1
-        end if
-10    continue
-      mtrnuml = nint(readin(lineq,iccount,nline))
-      mtrdenl = nint(readin(lineq,iccount,nline))
-cc
-cc  Kluge!!!
-cc
-c      if (mtrdenl .eq. 1) then
-c        mtrdenl = 2
-c        mtrnuml = mtrnuml*2
-c      end if
-      mtrnmp = nint(readin(lineq,iccount,nline))
-      mtrdnp = nint(readin(lineq,iccount,nline))
-      if (mtrnmp.eq.0 .and. mtrdnp .ge. 8) then
-        write(*,'(a)')'In setup data, with mtrnmp=0, mtrdnp must be <8'
-        call stop1()
-      end if
-      xmtrnum0 = readin(lineq,iccount,nline)
-      newkey = nint(readin(lineq,iccount,nline))
-c 130316
-c      do 11 iinst = 1 , noinst
-        midisig = newkey 
-c11    continue
-      npages = nint(readin(lineq,iccount,nline))
-      nsyst = nint(readin(lineq,iccount,nline))
-      musize = nint(readin(lineq,iccount,nline))
-      fracindent = readin(lineq,iccount,nline)
-      if (fracindent .ge. 1.) then
-        write(*,'(a)')'In setup data, fracindent must be <1'
-        call stop1()
-      end if
-      if (npages .gt. nsyst) then
-        print*,'Error in input file: npages > nsyst'
-        call stop1()
-      else if((musize-16)*(musize-20)*(musize-24)*(musize-29).ne.0) then
-        call printl('Musicsize must be 16, 20, 24, or 29')
-        call stop1() 
-      end if
-c
-c  Next noinst non-comment lines are names of instruments.
-c
-      do 4 i = 1 , abs(noinst)
-5       call getbuf(lineq)
-        nline = nline+1
-        if (lineq(1:1) .eq. '%') go to 5
-4     continue
-c
-c  Mext non-comment line has nv clef names
-c
-6     call getbuf(lineq)
-      nline = nline+1
-      if (lineq(1:1) .eq. '%') go to 6
-      do 7 iv = 1 , nv
-c        if (index('brnamstf01234567',lineq(iv:iv)) .eq. 0) then
-        if (index('brnamstf012345678',lineq(iv:iv)) .eq. 0) then
-          call errmsg(lineq,iv,0,
-     *       'There should be a clef symbol here!')
-          call stop1()
-        end if
-7     continue
-      if (lineq(nv+1:nv+1) .ne. ' ') then
-        call errmsg(lineq,nv+1,0,
-     *    'There should be a blank here!')
-        call stop1()
-      end if
-c
-c Set flag if voice 1 is treble, since it affects vertical spacing
-c
-c      bottreb = lineq(1:1).eq.'t'
-      bottreb = index('t08',lineq(1:1)).gt.0
-c
-c  Next non-comment line has path name
-c
-8     call getbuf(lineq)
-      nline = nline+1
-      if (lineq(1:1) .eq. '%') go to 8
-      lpath = index(lineq,' ')-1
-      if (index('/:'//chax(92),lineq(lpath:lpath)) .eq. 0) then
-        call errmsg(lineq,lpath,0,
-     *       'Last character of pathname is not "/",":", or "'
-     *                                        //chax(92)//'"!')
-        call stop1()
-      end if
-      return
-      end
-      subroutine g1etx(lineq,iccount,shifton,ibar,udsp,wheadpt)
-c
-c  Parse "X" commands.  Ignore all "B"; "P" means to ignore whole symbol.
-c  In scor2prt, must strip out "P", copy only "B" and "P"-type "X"-symbols.
-c
-      logical shifton,number,btest
-      character*128 lineq
-      character*1 charq,dumq
-      number = .false.
-      nPBSc = 0
-1     call g1etchar(lineq,iccount,charq)
-      if (index('PBS:',charq) .gt. 0) then
-c
-c  Continue checking here even if "P".
-c
-        ipbsc = index('PBS:',charq)
-        if (btest(nPBSc,ipbsc)) then
-          call errmsg(lineq,iccount,ibar,'Only one allowed per symbol!')
-          call stop1()
-        end if
-        nPBSc = ibset(nPBSc,ipbsc)
-        go to 1
-      else if (index('+-.0123456789',charq) .gt. 0) then
-        number = .true.
-        if (index('+-',charq) .gt. 0) then
-          call g1etchar(lineq,iccount,dumq)
-          if (index('.0123456789',dumq) .eq. 0) then
-            call errmsg(lineq,iccount,ibar,'Expected a number here!')
-            call stop1()
-          end if
-        end if
-        call readnum(lineq,iccount,dumq,fnum)
-        if (charq.eq.'-') fnum = -fnum
-        if (dumq .ne. 'p') then
-          iccount = iccount-1
-          fnum = fnum*wheadpt
-        end if
-        go to 1
-      else if (charq .ne. ' ') then
-        call errmsg(lineq,iccount,ibar,'Not allowed in "X" symbol!')
-        call stop1()
-      end if
-c
-c  Done with parsing.  Other checks
-c
-      if (iand(6,nPBSc).eq.6 .or. iand(24,nPBSc).eq.24) then
-        call errmsg(lineq,iccount-1,ibar,
-     *     'Cannot have both "P" and "B" or "S" and ":"!')
-        call stop1()
-      end if
-      if (btest(nPBSc,4)) then
-        if (number) then
-          if (shifton) then
-            call errmsg(lineq,iccount-1,ibar,
-     *            'Started a group shift without stopping prior one!')
-            call stop1()
-          else
-            shifton = .true.
-          end if
-        else
-          if (.not. shifton) then
-            call errmsg(lineq,iccount-1,ibar,
-     *            'Ended a group shift without starting one!')
-            call stop1()
-          else
-            shifton = .false.
-          end if
-        end if
-      end if
-c
-c  P off, S off, c off => normal user-defined space.  Add to udsp (later fsyst)
-c
-      if (iand(nPBSc,26).eq.0) udsp = udsp+fnum
-      if (.not.number .and. .not.btest(nPBSc,4)) then
-        call errmsg(lineq,iccount-1,ibar,
-     *      'Must have either a number or a colon in "X" symbol!')
-        call stop1()
-      end if
-      return
-      end
-c      integer*4 function mytime()
-c      CHARACTER(10) tq
-c      CALL DATE_AND_TIME(TIME=tq)
-c      read(tq,'(2i2,f6.3)')ih,im,ts
-c      mytime = 1000*(ts+60*(im+60*ih))
-c      return
-c      end  
-      subroutine getbuf(lineq)
-      parameter (maxblks=4000)
-      character*(*) lineq
-      character*65536 bufq
-      integer*2 lbuf(maxblks)
-      common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
-      lineq = bufq(ipbuf+1:ipbuf+lbuf(ilbuf))
-      ipbuf = ipbuf+lbuf(ilbuf)
-      ilbuf = ilbuf+1
-      return
-      end
-      subroutine getchar(lineq,iccount,charq)
-      parameter (nm=24)
-c
-c  Gets the next character out of lineq*128.  If pointer iccount=128 on entry,
-c  then reads in a new line.  Resets iccount.  Ends program if no more input.
-c
-      common /comget/ lastchar,rptnd1,sluron(nm,2),fbon,ornrpt,stickyS,
-     *       movbrk,movnmp,movdnp,movgap,parmov,fintstf,gintstf,
-     *       rptprev,equalize,rptfq1,rptfq2
-      logical lastchar,rptnd1,sluron,fbon,rptprev,ornrpt
-      common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
-      logical mrecord,mplay,endmac,equalize,stickyS
-      character*1 charq,rptfq1,rptfq2
-      character*128 lineq,lnholdq
-      if (iccount .eq. 128) then
-        call read10(lineq,lastchar)
-        if (lastchar) return
-        if (.not. endmac) then
-          iccount = 0
-        else
-          endmac = .false.
-          iccount = icchold
-          lineq = lnholdq
-        end if
-        if (mrecord) then
-          call mrec1(lineq,iccount,ndxm)
-        end if
-      end if
-      iccount = iccount+1
-      charq = lineq(iccount:iccount)
-      return
-      end
-      subroutine getdyn(ivx,ip,irest,iornq,lineq,iccount)
-      parameter (nm=24)
-      common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12),
-     *        hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41),
-     *        idynda2(99),levhssav(nm),listcresc,listdecresc
-      character*128 txtdynq
-      common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
-     *                 ,WrotePsslurDefaults,SlurCurve
-      logical fontslur,upslur,WrotePsslurDefaults
-      character*1 durq,chax
-      character*4 dynsymq
-      character*128 lineq
-c
-c  Get info for dynamic mark.  Enter after getting "D", iccount sits on "D"
-c  Bits in idyndat are as follows
-c    00-03 ivx
-c    04-11 ip
-c    12-15 code for type of mark
-c      0 => arbitrary text
-c      1-12 => pppp,ppp,pp,p,mp,mf,f,fp,sfz,ff,fff,ffff
-c      If (.not. fontslur)
-c        13 => hairpin start, 14,15 => <,> (ending)
-c      else 
-c         13 < start, 14 > start, 15 ending
-c      end if
-c    16    flag for vertical offset
-c    17-23 vertical offset + 64 , \internote
-c    31    Hairpin start (0), stop (1)
-c
-c  idynda2
-c
-c    00    flag for horizontal offset
-c    01-09 (horizontal offset)/10 + 25.6 notehead widths
-c    10  5th bit for ivx (5/15/10)
-c
-      irest = ibset(irest,26)
-      ndyn = ndyn+1
-      idyn = ivx
-      idynda2(ndyn) = 0
-      if (ivx .ge. 16) call setbits(idynda2(ndyn),1,10,1)
-      call setbits(idyn,8,4,ip)
-      if (lineq(iccount+1:iccount+1) .eq. '"') then
-c
-c  text-dynamic
-c
-        ntxtdyn = ntxtdyn+1
-        iend = iccount+index(lineq(iccount+2:128),'"')+2
-        txtdynq(ntxtdyn) = lineq(iccount+2:iend-2)
-c
-cc  Store ivx, ip in bits 0-11
-c  Store ivx, ip in bits 0-12
-c
-c        ivxiptxt(ntxtdyn) = idyn
-        ivxiptxt(ntxtdyn) = ivx+32*ip
-        ipm = index('- +',lineq(iend:iend))
-        idno = 0
-      else
-c
-c  Word-group or hairpin
-c
-        do 1 iend = iccount+2 , 128
-          ipm = index('- +',lineq(iend:iend))
-c
-c  Exit the loop at first blank, "+", or "-" 
-c
-          if (ipm .gt. 0) go to 2
-1       continue
-2       continue
-        read(lineq(iccount+1:iend-1),'(a'//chax(47+iend-iccount)//')')
-     *     dynsymq
-        idno = (index(
-     *   'ppppppp pp  p   mp  mf  f   fp  sfz ff  fff ffff    <   >   ',
-     *           dynsymq)+3)/4
-c
-c  Save for later down
-c
-        idno1 = idno
-      end if
-c
-c  Set flag to check level later if in beam
-c
-      iornq = ibset(iornq,23) 
-      if (idno.ge.14) then
-c
-c  Hairpin here.  Check if opposite type from one that's already on 
-c
-        if (idno.eq.14.and.btest(listdecresc,ivx) .or. 
-     *      idno.eq.15.and.btest(listcresc,ivx)) then
-	    call printl(' ')
-          call printl('Started one kind of hairpin while other is on')
-          call stop1()
-        end if         
-c
-c  Start or stop?
-c
-        if (btest(listcresc,ivx) .or. btest(listdecresc,ivx)) then
-c
-c  Cresc/decresc is on, this is an ending. If fontslur, leave idno as is.
-c
-          if (.not.fontslur) idno = 15
-        else if (fontslur) then
-c
-c  Start of font slur  
-c
-          idno = 13
-        else
-c
-c  Start of postscript slur
-c
-          idno = idno-1
-        end if
-      end if
-c
-c  Now that we used list[de]cresc, update 
-c
-      if (idno .ge.13) then
-        if (idno.eq.15 .or. (fontslur.and.idno.eq.14)) then
-c
-c  Something's ending
-c
-          if (btest(listcresc,ivx)) then
-c
-c  It's a cresc!
-c
-            listcresc = ibclr(listcresc,ivx)
-          else
-            listdecresc = ibclr(listdecresc,ivx)
-          end if
-        else 
-c
-c  Something's starting
-c
-          if (idno1 .eq. 14) then
-c
-c  It's a cresc!
-c
-            listcresc = ibset(listcresc,ivx)
-          else
-            listdecresc = ibset(listdecresc,ivx)
-          end if
-        end if
-      end if
-      call setbits(idyn,4,12,idno)
-      iccount = iend
-      if (ipm .ne. 2) then
-c
-c  There is a vertical shift
-c
-        idyn = ibset(idyn,16)
-        iccount = iccount+1
-        call readnum(lineq,iccount,durq,fnum)
-        idno = nint(fnum)
-        call setbits(idyn,7,17,(ipm-2)*idno+64)
-        ipm = index('- +',durq)
-        if (ipm .ne. 2) then
-c
-c  There is a horizontal shift
-c
-c          idynda2(ndyn) = ibset(idyn,23)
-          idynda2(ndyn) = ibset(idynda2(ndyn),0)
-          iccount = iccount+1
-          call readnum(lineq,iccount,durq,fnum)
-          idno = nint(10*fnum)
-          call setbits(idynda2(ndyn),9,1,(ipm-2)*idno+256)
-        end if
-c
-c  iccount should be on the blank at the end of the entire symbol
-c
-      end if
-      idyndat(ndyn) = idyn
-      return
-      end
-      subroutine getfig(itoff,charq,lineq,iccount,isfig,itfig,
-c     *   itsofar,nodur,figq,ivupfig,nfigs)
-     *   itsofar,nodur,figq,ivupfig,ivvfig,nfigs)
-      logical isfig
-      character*1 charq
-      character*10 figq
-      character*128 lineq
-      nfigs = nfigs+1
-      ivupfig = 0
-      ivvfig = 0
-      itoff = 0
-      if (charq .eq. 'x') then
-c
-c  Floating figure.
-c
-        call getchar(lineq,iccount,charq)
-        read(charq,'(i1)')noff
-        call getchar(lineq,iccount,charq)
-        read(charq,'(i1)')loff
-        itoff = noff*ifnodur(loff,'x')
-        call getchar(lineq,iccount,charq)
-      else
-c
-c  Figure on a note
-c
-        isfig = .true.
-      end if
-      itfig = itsofar+itoff-nodur
-      lfig = 1
-      figq = charq
-5     call getchar(lineq,iccount,charq)
-c      if (index(' +',charq) .eq. 0) then
-      if (index(' +v',charq) .eq. 0) then
-        figq = figq(1:lfig)//charq
-        lfig = lfig+1
-        go to 5
-      else if (charq .eq. '+') then
-c
-c  Get vertical offset for figure. Next character after number has to be blank.
-c
-        iccount = iccount+1
-        call readnum(lineq,iccount,charq,fnum)
-        ivupfig = nint(fnum)
-      else if (charq .eq. 'v') then
-c
-c  Get vertical change in figdrop. Must be last item in figure word.
-c
-        isign = 1
-        call getchar(lineq,iccount,charq)
-        if (charq .eq. '-') then
-          isign=-1
-          call getchar(lineq,iccount,charq)
-        end if
-        ivvfig = isign*(ichar(charq)-48)
-      end if
-      return
-      end
-      subroutine getgrace(ivx,nnl,lineq,iccount,islur,iornq,ipl,ndlev,
-     *                    lastlev,iv,nv)
-      parameter (nm=24)
-      common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
-     *                nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
-     *                noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
-     *                graspace(37),
-     *                lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
-     *                naccg(74),voltxtq(6),litq(83)
-      logical upg,slurg,slashg
-      character*1 charq,durq
-      character*20 voltxtq
-      character*128 lineq,litq
-      integer*4 islur(nm,200),iornq(nm,0:200),ipl(nm,200),nnl(nm),
-     *          ndlev(nm,2)
-      common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
-     *  instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
-      logical EarlyTransOn,LaterInstTrans
-c
-c Grace, comes *before* main note:
-c UNLESS there's an 'A' or 'W' after the 'G'
-c   ngrace = # of grace note groups so far in block
-c   ivg(ngrace), ipg(ngrace)
-c   nng(ngrace) = # of notes in this group: default = 1
-c   ngstrt(ngrace) = starting position in nolevg of levels for this grace
-c   multg(ngrace) = multiplicity: default = 1;  input as 'm(digit)'
-c   upg(ngrace) = logical for beam or stem dirn: default T, input'u,l'
-c   slurg(ngrace) = logical for slur; default F, input 's'
-c   slashg(ngrace) = T if slash; default is F, input 'x'
-c These data MUST precede note name of first note
-c   nolevg, naccg: lists of levels and accid's, indexed as described above.
-c
-      ngrace = ngrace+1
-      ivg(ngrace) = ivx
-      ipg(ngrace) = nnl(ivx)+1
-      if (ngrace .eq. 1) then
-        ngstrt(ngrace) = 1
-      else
-        ngstrt(ngrace) = ngstrt(ngrace-1)+nng(ngrace-1)
-      end if
-      islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),4)
-      nng(ngrace) = 1
-      multg(ngrace) = 1
-      upg(ngrace) = .true.
-      slurg(ngrace) = .false.
-      slashg(ngrace) = .false.
-18    call getchar(lineq,iccount,charq)
-      if (index('WA',charq) .gt. 0) then
-c
-c  Grace is on note that was already done, so shift flags forward one note.
-c  This puts flag on actual note with grace; later for W will go ahead one more.
-c
-        ipg(ngrace) = nnl(ivx)
-        islur(ivx,nnl(ivx)+1) = ibclr(islur(ivx,nnl(ivx)+1),4)
-        islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),4)
-        if (slurg(ngrace))
-     *      iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),24)
-        if (charq .eq. 'A') then
-c
-c  close After, clear way-after bit, to ensure priority of most recent A/W
-c
-          ipl(ivx,nnl(ivx)) = ibset(ibclr(ipl(ivx,nnl(ivx)),31),29)
-        else
-c
-c  Way after; later assign to following note, and position like normal grace.
-c
-          ipl(ivx,nnl(ivx)) = ibset(ibclr(ipl(ivx,nnl(ivx)),29),31)
-        end if
-      else if (charq .eq. 'm') then
-        call getchar(lineq,iccount,charq)
-        multg(ngrace) = ichar(charq)-48
-      else if (index('123456789',charq) .gt. 0) then
-        call readnum(lineq,iccount,durq,fnum)
-        iccount = iccount-1
-        nng(ngrace) = nint(fnum)
-      else if (charq .eq. 'l') then
-        upg(ngrace) = .false.
-      else if (charq .eq. 's') then
-        slurg(ngrace) = .true.
-        if (nnl(ivx) .gt. 0) then
-c
-c  If A- or W-grace, set signal to start slur on main note.
-c
-          if(btest(ipl(ivx,nnl(ivx)),31) .or.
-     *               btest(ipl(ivx,nnl(ivx)),29))
-     *       iornq(ivx,nnl(ivx))=ibset(iornq(ivx,nnl(ivx)),24)
-        end if
-      else if (charq .eq. 'x') then
-        slashg(ngrace) = .true.
-      else if (charq .eq. 'u') then
-      else if (charq .eq. 'X') then
-c
-c Space before main note of grace. Number will come next.
-c
-        iccount = iccount+1
-        call readnum(lineq,iccount,durq,graspace(ngrace))
-        iccount = iccount-1
-      end if
-      if (index('abcdefg',charq) .eq. 0) go to 18
-c
-c  At this point, charq is first note name in grace
-c
-      do 19 ing = ngstrt(ngrace), ngstrt(ngrace)+nng(ngrace)-1
-        naccg(ing) = 0
-        ioct = 0
-        if (ing .gt. ngstrt(ngrace)) then
-55        call getchar(lineq,iccount,charq)
-          if (charq .eq. ' ') go to 55
-        endif
-        iclastlev = 0
-9       call getchar(lineq,iccount,durq)
-        if (durq .ne. ' ') then
-          if (durq.eq.'+') then
-            lastlev = lastlev+7
-            iclastlev = iclastlev+7
-          else if (durq.eq.'-') then
-            lastlev = lastlev-7
-            iclastlev = iclastlev-7
-          else if (index('fsn',durq) .gt. 0) then
-            if (naccg(ing) .eq. 0) then
-              naccg(ing) = index('fsn',durq)
-            else
-c
-c  Double accidental
-c
-              naccg(ing) = ibset(naccg(ing),2)
-            end if
-          else
-            ioct = ichar(durq)-48
-          end if
-          go to 9
-        end if
-        if (ioct .gt. 0) then
-          lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv)))
-        else
-          if (nnl(ivx).eq.0 .and. ing.eq.ngstrt(ngrace)) then
-            if (ivx .le. nv) then
-              kv = 1
-            else
-              kv = 2
-            end if
-            lastlev = ndlev(iv,kv)+iclastlev
-          end if
-          lastlev = lastlev-3
-     *        +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7)
-        end if
-        nolevg(ing) = lastlev
-19    continue
-c
-c  Grace could come before first note of block, so reset end level.
-c
-      if (nnl(ivx).eq.0) then
-        if (ivx .le. nv) then
-          kv = 1
-        else
-          kv = 2
-        end if
-        ndlev(iv,kv) = lastlev
-      end if
-      return
-      end
-      subroutine GetiTransInfo(From1,ibarcnt,lineq,iccount,
-     *                         ibaroff,nbars,noinst)
-cccccccccccccccccccccccc
-cc
-cc GetiTransInfo.for
-cc
-cccccccccccccccccccccccc
-c
-c  Called from both g1etnote and getnote, after first 'i' in Ki[...]
-c  On entry, iccount points to last char retrieved, which is 'i'
-c  
-c  From1: locgical, true if called from g1etnote
-c  ibarcnt: tells whether to set EarlyTransOn to true. 
-c  EarlyTransOn set false in blkdata, true here, back to false in topfile.  
-c
-c  110522/110529
-c  Instrument-wise transposition Ki[iInstTrans][+/-][iTransAmt][+/-][iTransKey]
-c    and repeat i[...] for multiple instruments. Store info in g1etnot if ibarcnt=0
-c    so can pass to topfile (via comInstTrans), which is called before getnote. 
-c    Otherwise, will store info from getnote. Initialize EarlyTransOn and
-c    LaterInstTrans to .false. in blockdata. Set EarlyTransOn from g1etnote; 
-c    LaterInstTrans from getnote. Zero both out after use. nInstTrans really
-c    only needed for instrument-signatures, not transpositions. iTransAmt is
-c    ALWAYS active per instrument. Set up instno(iv) so can fetch iTransAmt for
-c    each staff.
-c
-c  iTransAmt stored as fn of instrument #, not like iTransKey which is 
-c    fn. of nm, just a counter, where corr. inst num is iInstTrans(nm). This
-c    simplifies use of iTransAmt for all calls to ifnolev. 
-c
-      parameter (nm=24)
-      logical From1
-      common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
-     *  instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
-      logical EarlyTransOn,LaterInstTrans,store
-      character*128 lineq
-      character*1 durq 
-      durq = 'x'  ! Can't initialize in declaration stmt, only works once.
-      if(.not.EarlyTransOn) EarlyTransOn = From1 .and. ibarcnt.eq.0
-      store = (EarlyTransOn.and.ibarcnt.eq.0) .or. 
-     *            (ibarcnt.gt.0.and..not.From1)
-      LaterInstTrans = .not.From1 .and. ibarcnt.gt.0
-      if (store) nInstTrans = 0
-1     continue
-      if (durq .eq. ' ') return
-      call g1etchar(lineq,iccount,durq)
-      if (index('123456789',durq) .eq. 0) then
-        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'There must be an instrument number here!')
-        call stop1()
-      end if
-      if (store) nInstTrans = nInstTrans+1
-      call readnum(lineq,iccount,durq,fnum)
-      instn = nint(fnum)
-      if (instn.gt.noinst) then
-        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Instrument number out of range!')
-        call stop1()
-      end if
-      if (store) iInstTrans(nInstTrans) = instn
-c
-c  durq is +/- following inst # (for iTransAmt), iccount is on it.
-c
-      if (index('+-',durq) .eq. 0) then
-        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      '1st character after instrument number must be "+,-"!')
-        call stop1()
-      end if
-      itramt = 44-ichar(durq) ! +1/-1 for itramt
-      call g1etchar(lineq,iccount,durq)
-      if (index('0123456789',durq) .eq. 0) then
-        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'There must be a transposition amount here!')
-        call stop1()
-      end if
-      call readnum(lineq,iccount,durq,fnum)
-      if (store) iTransAmt(instn) = nint(fnum)*itramt
-c
-c  durq is +/- following iTransAmt (for iTransKey), iccount is on it.
-c
-      if (index('+-',durq) .eq. 0) then
-        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      '1st character after transposition amount must be "+,-"!')
-        call stop1()
-      end if
-      ikey = 44-ichar(durq)  ! +1/-1
-      call g1etchar(lineq,iccount,durq)
-      if (index('0123456789',durq) .eq. 0) then
-        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'There must be a key indicator here!')
-        call stop1()
-      end if
-      call readnum(lineq,iccount,durq,fnum)
-      if (store) iTransKey(nInstTrans) = nint(fnum)*ikey
-c
-c  durq is now 1st character after iTransKey, should be either 'i' or ' '
-c
-      if (durq.ne.'i'.and.durq.ne.' ') then
-        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'There must be blank or "i" here!')
-        call stop1()
-      end if
-      go to 1
-      end
-      subroutine getmidi(noinstarg,lineq,iccount,ibarcnt,ibaroff,nbars,
-     *                   lenbar,
-c      subroutine getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar,
-     *                    mtrdenl,first)
-c
-c  Use this from both pmxa and pmxb to input and check midi data. "first" tells
-c  whether pmxa or pmxb.  If .not.first, then tempo and pause commands cause
-c  things to be written immediately into the midi storage buffers.
-c
-      parameter (nm=24,mv=24576)
-      common /comevent/ miditime,lasttime
-      logical mmacrec,gottempo
-      common /commmac/ mmacstrt(0:nm,20),mmacend(0:nm,20),immac,
-     *       mmactime(20),nmidsec,msecstrt(0:nm,60),msecend(0:nm,60),
-     *       mmacrec,gottempo
-c
-c  immac(i) is the index of i-th macro, i=1,nmac.  Also make a list containing
-c   nmidsec  section starts and stops based on PLAYING macros (not recording).
-c 
-      integer*2 mmidi,midinum(26)
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
-     *                ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
-      integer*2 iinsiv
-      character*1 durq
-      character*2 instq
-      character*128 lineq
-      logical first
-      common /comdiag/ n69(0:nm),n34(0:nm)
-c
-c      Instrument codes
-c
-      data midinum   
-     *    / 1, 5, 7, 13,20,25,33,41,42,43,44,57,58,59,61,65,66,67,
-c         XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbXtuXfrXsoXalXteX
-c
-     *      68,69,71,72,74,75, 8,55 /
-c           bsXobXbaXclXflXreXctXvo
-c
-1     call getchar(lineq,iccount,durq)
-      if (durq .eq. 't') then
-c
-c  Tempo in beats ber minute
-c
-        call getchar(lineq,iccount,durq)
-        if (index('0123456789',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Expected an integer here for the pause!')
-          call stop1()
-c        else if (mmacrec) then
-c          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-c     *      'Cannot change MIDI tempo while recording a MidiMacro!')
-c          call stop1()
-        end if
-        call readnum(lineq,iccount,durq,qpm)
-        iccount = iccount-1
-        if (.not.first) then
-          call midievent('t',nint(qpm),0)
-          gottempo = .true.
-        end if
-        go to 1
-      else if (durq .eq. 'p') then
-c
-c  Insert a pause.  pausemid = pause in 1/4's
-c
-        call getchar(lineq,iccount,durq)
-        if (index('0123456789.',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Expected a number here for the pause!')
-          call stop1()
-        end if
-        call readnum(lineq,iccount,durq,pausemid)
-        iccount = iccount-1
-        if (.not.first) then
-c
-c  Compute a meter for the pause.  This is only to keep MidiNotate on track.
-c  Round pause to nearest 16th.  Let denominator always be 16.
-c
-          numb16 = nint(pausemid*4)
-          call midievent('m',numb16,16)
-c
-c  Put in pausemid beats of rest 
-c
-          do 3 icm = 0 , numchan-1
-            call addmidi(icm,0,0,0,4.*numb16,.true.,.false.)
-3         continue
-          miditime = miditime+nint(240*pausemid)
-c
-c  Restore meter
-c
-          call midievent('m',mtrdenl*lenbar/64,mtrdenl)
-        end if
-        go to 1
-      else if (durq .eq. 'i') then
-c
-cc  Instrument numbers or letters.  Expect nv of them.
-c  Instrument numbers or letters.  Expect noinst of them.
-c
-c        do 2 ivx = 1 , nv
-        do 2 ivx = 1 , noinstarg
-          call getchar(lineq,iccount,durq)
-          if (ichar(durq) .gt. 96) then
-c
-c  It's a lowercase letter.  Get another, find corr. instrument #.
-c
-            instq(1:1) = durq
-            call getchar(lineq,iccount,durq)
-            instq = instq(1:1)//durq
-            iname = index('XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbX'//
-     *                'tuXfrXsoXalXteXbsXobXbaXclXflXreXctXvo',instq)/3
-            if (iname .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Unrecognized 2-letter midi instrument name!')
-              call stop1()
-            end if
-            midinst(ivx) = midinum(iname)-1
-          else
-c
-c  Expect a number, followed by ":" if that is followed by another number.
-c  I.e., if after call to readnum, durq is not ":", it must be either blank
-c  or next instrument letter.
-c
-            if (index('123456789',durq) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *                 'Expected a midi instrument number here!')
-              call stop1()
-            end if
-            call readnum(lineq,iccount,durq,fnum)
-            midinst(ivx) = nint(fnum)-1
-            if (midinst(ivx).lt.0 .or. midinst(ivx).gt.255) then
-              call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *           'Midi instrument number must be in range 1-128!')
-              call stop1()
-            end if
-            if (durq .ne. ':') iccount = iccount-1
-          end if
-2       continue
-        go to 1
-      else if (durq .eq. 'v') then 
-c
-c Get volumes for each instrument.  Expect nv of them.  
-c    Follow same pattern as for insttrument numbers above.
-c 	
-c        do 7 ivx = 1 , nv
-        do 7 ivx = 1 , noinstarg
-          call getchar(lineq,iccount,durq)
-          if (index('123456789',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'Expected a midi velocity number here!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          midivel(ivx) = nint(fnum)-1
-          if (midivel(ivx).lt.0 .or. midivel(ivx).gt.127) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *           'Midi velocity must be in range 1-128!')
-            call stop1()
-          end if
-          if (durq .ne. ':') iccount = iccount-1
-7       continue
-        go to 1
-      else if (durq .eq. 'b') then 
-c
-c Get balance for each instrument.  Expect nv of them.  
-c    Follow same pattern as for instrument numbers above.
-c 	
-c        do 8 ivx = 1 , nv
-        do 8 ivx = 1 , noinstarg
-          call getchar(lineq,iccount,durq)
-          if (index('123456789',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'Expected a balance number here!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          midibal(ivx) = nint(fnum)-1
-          if (midibal(ivx).lt.0 .or. midibal(ivx).gt.127) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *           'Midi balance must be in range 1-128!')
-            call stop1()
-          end if
-          if (durq .ne. ':') iccount = iccount-1
-8       continue
-        go to 1
-      else if (durq .eq. 'T') then 
-c
-c Get transposition for each instrument.  Expect nv of them.  
-c    Follow similar pattern as above, but separator is +|-.
-c 	
-c        do 9 ivx = 1 , nv
-        do 9 ivx = 1 , noinstarg
-          call getchar(lineq,iccount,durq)
-          ipm = index('-+',durq)
-          if (ipm .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'Expected "+" or "-" for midi transposition here!')
-            call stop1()
-          end if
-          ipm = 2*ipm-3
-          call getchar(lineq,iccount,durq)
-          if (index('0123456789',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'Expected a number here!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          miditran(ivx) = ipm*nint(fnum)
-c          if (mod(miditran(ivx),12).ne. 0) then
-c            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-c     *         'Midi transposition limited to multiples of 12!')
-c            call stop1()
-c          end if
-          iccount = iccount-1
-9       continue
-        go to 1
-      else if (durq .eq. 'g') then
-        call getchar(lineq,iccount,durq)
-        if (index('0123456789',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Expected an integer here for the midi gap!')
-          call stop1()
-        end if
-        call readnum(lineq,iccount,durq,fnum)
-        mgap = nint(fnum)
-        iccount = iccount-1
-        go to 1
-      else if (durq .eq. 'M') then
-c
-c  MidiMacros
-c
-        call getchar(lineq,iccount,durq)
-        if (durq .eq. 'R') then
-c
-c  Start recording
-c
-          if (mmacrec) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'You tried to record a MidiMacro while already recording!')
-            call stop1()
-          end if
-          mmacrec = .true.
-          call getchar(lineq,iccount,durq)
-          if (index('123456789',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Expected MidiMacro ID number here!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          iccount = iccount-1
-          if (.not.first) then
-            immac = nint(fnum)
-            if (immac .gt. 20) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'MidiMacro ID cannot exceed 20!')
-              call stop1()
-            end if
-c
-c  Save the start time
-c
-            mmactime(immac) = miditime
-            do 4 icm = 0 , numchan
-              if (icm .lt. numchan) then
-                if (restpend(icm)) then
-c
-c  Adjust if there's a rest at end of prior section.  Insert dummy turnoff.
-c    (This causes two turn-offs in a row, which testmidi sees as an error).
-c
-c  Before:    section1  ------rest-------  section2(to be recorded)
-c  After:     section1  rest1  now  rest2  section2(recorded)
-c
-                  call addmidi(icm,30,0,0,trest(icm),.false.,.true.)
-                  trest(icm) = 0
-                  restpend(icm) = .false.
-                end if
-              else
-                if (miditime .gt. lasttime) then
-c
-c  Insert a dummy turnoff in conductor track
-c
-                  call addmidi(icm,30,0,0,(miditime-lasttime)/15.,
-     *                         .false.,.true.)
-                  lasttime = miditime
-                end if
-              end if
-              mmacstrt(icm,immac) = imidi(icm)+1
-4           continue
-          end if
-          go to 1
-        else if (index('123456789P',durq) .eq. 0) then
-c
-c  End recording; close the open macro.  Get immac from common.
-c
-          if (.not.mmacrec) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *       'You tried to end a MidiMacro before starting one!')
-            call stop1()
-          end if
-          mmacrec = .false.
-          iccount = iccount-1
-          if (.not.first) then
-c
-c  Save the macro duration
-c
-            mmactime(immac) = miditime-mmactime(immac)
-            do 5 icm = 0 , numchan
-              if (icm .lt. numchan) then
-                if (restpend(icm)) then
-                  call addmidi(icm,30,0,0,trest(icm),.false.,.true.)
-                  trest(icm) = 0
-                  restpend(icm) = .false.
-                end if
-              else
-                if (miditime .gt. lasttime) then
-c
-c  Insert a dummy turnoff in conductor track if needed.
-c
-                  call addmidi(icm,30,0,0,(miditime-lasttime)/15.,
-     *                         .false.,.true.)
-                  lasttime = miditime
-                end if
-              end if
-              mmacend(icm,immac) = imidi(icm)
-5           continue
-          end if
-          if (durq .ne. ' ')go to 1
-        else if (durq .eq. 'P') then
-c
-c  Play Back a Macro
-c
-          call getchar(lineq,iccount,durq)
-          if (index('123456789',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Expected MidiMacro ID number here!')
-            call stop1()
-          end if
-          if (mmacrec) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'You tried to play a MidiMacro before ending recording!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          iccount = iccount-1
-          if (.not.first) then
-            immac = nint(fnum)
-            if (mmactime(immac) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Cannot play a MIDI macro before recording it!')
-              call stop1()
-            end if
-            do 6 icm = 0 , numchan
-              if (icm .lt. numchan) then
-                if (restpend(icm)) then
-                  call addmidi(icm,30,0,0,trest(icm),.false.,.true.)
-                  trest(icm) = 0.
-                  restpend(icm) = .false.
-                end if
-              else
-                if (miditime .gt. lasttime) then
-c
-c  Insert a dummy turnoff in conductor track
-c
-                  call addmidi(icm,30,0,0,(miditime-lasttime)/15.,
-     *                         .false.,.true.)
-                end if
-              end if
-              msecend(icm,nmidsec) = imidi(icm)
-              msecstrt(icm,nmidsec+1) = mmacstrt(icm,immac)
-              msecend(icm,nmidsec+1) = mmacend(icm,immac)
-              msecstrt(icm,nmidsec+2) = imidi(icm)+1
-6           continue
-            nmidsec = nmidsec+2
-c
-c  Update running time
-c
-            miditime = miditime+mmactime(immac) 
-            lasttime = miditime
-          end if
-          go to 1 
-        else
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Illegal character in MidiMacro sub-command!')
-          call stop1()
-        end if
-      else if (durq .eq. 'd') then
-        debugmidi = .true.
-        go to 1
-      else if (durq .ne. ' ') then
-        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Illegal character in MIDI input data!')
-        write(*,'(a)')
-     *    'May be too many args to i,v,b, or T. As of Ver. 2.7, '//
-     *    'should be noinst, not nv'   
-        write(15,'(a)')
-     *    'May be too many args to i,v,b, or T. As of Ver. 2.7, '//
-     *    'should be noinst, not nv'   
-        call stop1()
-      end if
-      if (.not.gottempo .and. .not.first) then
-c
-c  If no tempo is set on first call on the pmxb pass, then set it
-c
-        call midievent('t',96,0)
-        gottempo = .true.
-      end if
-      return
-      end
-      subroutine getnote(loop)
-      parameter (nm=24,mv=24576)
-      common /comlast/ islast,usevshrink
-      logical islast,usevshrink,ignorenats
-      common /comignorenats/ ignorenats
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      character*10 figq
-      character*1 ulq,sepsymq,sq,rptfq1,rptfq2,clefq,chax
-      logical beamon,firstgulp,figbass,figchk,isfig
-      character*60 cheadq
-      character*120 instrq,titleq,compoq
-      integer*2 mmidi
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc,autofbon
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2
-      common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip,
-     *    inhead
-      common /cominbot/ inbothd
-      common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
-     *                fullsize(nm),ivxfig2,ivvfig(2,74)
-      common /comnotes/ nnodur,lastlev,ndlev(nm,2),shifton,setis,notcrd,
-     *       npreslur,was2(nm),ninow,nobar1,nsystp(40),ipage,
-     *       OptLineBreakTies,HeaderSpecial
-      common /comget/ lastchar,rptnd1,sluron(nm,2),fbon,ornrpt,stickyS,
-     *       movbrk,movnmp,movdnp,movgap,parmov,fintstf,gintstf,
-     *       rptprev,equalize,rptfq1,rptfq2
-      common /comhead/ ihdht,lower,headrq,lowerq,ihdvrt
-      common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb,
-     *               tautofb,autofbon,t1autofb
-      common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
-     *                nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
-     *                noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
-     *                graspace(37),
-     *                lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
-     *                naccg(74),voltxtq(6),litq(83)
-      logical upg,slurg,slashg,fbon,ornrpt,shifton,setis,notcrd,isbjmp,
-     *        was2,nobar1,quoted,isbj2,stickyS,
-     *        OptLineBreakTies,HeaderSpecial
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      character*128 litq
-      common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
-     *               ndotmv(nm),updot(nm,20),rtdot(nm,20)
-      common /combc/ bcspec
-      common /comas3/ ask(2500),iask,topmods
-c
-c  nvmx is either 1 or 2.  ivmx(iv,1)=iv, ; ivmx(iv,2)>nv if defined
-c  ivx is current ivmx, and is the index for all notes, acc's etc.
-c
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
-     *                flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
-     *                rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
-     *                rtshfac
-      common /comtrans/ cheadq
-      common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
-     *   isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
-     *   lnam(nm),inameq(nm)
-      common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
-      common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
-      common /comask/ bar1syst,fixednew,scaldold,
-     *                wheadpt,fbar,poenom
-      common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
-     *                 ,WrotePsslurDefaults,SlurCurve
-      common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
-     *                xinsnow,lowdot
-      common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm)
-      common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20),
-     *                 ic1mac(20),ilmac,iplmac
-      common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12),
-     *        hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41),
-     *        idynda2(99),levhssav(nm),listcresc,listdecresc
-      common /comclefq/ clefq(nm)
-      common /comtol/ tol
-      common /comArpShift/NumArpShift,IvArpShift(20),IpArpShift(20),
-     *                    ArpShift(20)
-      character*128 txtdynq
-      logical mrecord,mplay,endmac,lowdot,rename,bar1syst,upslur,
-     *        fontslur,WrotePsslurDefaults
-      character*128 lineq,lnholdq,lineqt
-      character*80 headrq, lowerq
-      character*79 inameq
-      character*59 hdlndq
-      character*20 voltxtq
-      character*1 charq,dotq,durq,ulfbq,dumq
-      logical loop,lastchar,lower,rptnd1,rptprev,bcspec,moved,
-     *        topmods,headlog,btest,sluron,cdot,equalize
-      character*24 tempq
-      logical novshrinktop,cstuplet
-      common /comnvst/ novshrinktop,cstuplet
-      logical kbdrests
-      common /comkbdrests/ levbotr(8),levtopr(8),kbdrests
-      common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
-     *  instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
-      logical EarlyTransOn,LaterInstTrans
-      common /comkeys/ nkeys,ibrkch(18),newkey(18),iskchb,idumm1,isig1,
-     *     mbrestsav,kchmid(18),logdumm1,logdumm2,barend,noinst,logdumm3
-      logical barend,iskchb,kchmid,logdumm1,logdumm2,logdumm3
-      common /combibarcnt/ ibarcnt
-      common /commidisig/ midisig
-      common /comlyr/ inputmlyr
-      logical inputmlyr
-      data inputmlyr /.false./
-      cdot = .false.
-1     call getchar(lineq,iccount,charq)
-      if (lastchar) return
-      if (charq .eq. ' ') go to 1
-      if (charq .eq. '%') then
-c
-c  Check for a bar number format:
-c
-        if (iccount.eq.1 .and. lineq(2:2).eq.' ' .and.
-     *      index('bB1234567890',lineq(3:3)).gt.0) then
-          if (islast) write(11,'(a)')lineq(1:lenstr(lineq,128))
-        end if
-        iccount = 128
-        go to 1
-      end if
-c
-c  Closing repeat iff charq='/' and the prev. char was 'R' with 'd' or 'r'
-c
-      if (rptprev) then
-        rptnd1 = charq .eq. '/'
-        rptprev = .false.
-      end if
-c
-c  Repeat at end of a piece
-c
-      if ((ichar(charq).ge.97.and.ichar(charq).le.103) .or.
-     *       charq.eq.'r') then
-        if (cdot) go to 28
-c
-c  This is a note/rest.  
-c
-        idotform = 0
-        numnum = 0
-c
-c  If start of line of music, set pitch from previous
-c
-        if (ivx .le. nv) then
-          kv = 1
-        else
-          kv = 2
-        end if
-        if (nnl(ivx).eq.0) lastlev = ndlev(iv,kv)
-c
-c  notcrd is used to tell if orn. goes on main note or chord note
-c
-c        notcrd = .true.   !Move dow.  Was not observed if dotted shortcut.
-c
-c  Increase note count, then loop 'til blank. Label 28 is for dotted shortcuts.
-c
-28      continue
-c
-c  Moved this from just above, 2 Feb 02
-c
-        notcrd = .true.
-        nnl(ivx) = nnl(ivx)+1
-        if (ornrpt) then
-c
-c  Replicate ornament bits, also bit 23 for beam handling if chord.
-c
-          iornq(ivx,nnl(ivx)) = ior(iornq(ivx,nnl(ivx)),iornq(ivx,0))
-          if (iand(iornq(ivx,nnl(ivx)),32896) .gt. 0) then
-c
-c  This is a trill (bit 7 or 15) so must dup the parameters
-c
-            ntrill = ntrill + 1
-            ivtrill(ntrill) = ivx
-            iptrill(ntrill) = nnl(ivx)
-            xnsktr(ntrill) = xnsktr(ntrill-1)
-          end if
-        end if
-        if (stickyS) then
-c
-c  Grab stemlength shortening parameters from prior note
-c
-          mult(ivx,nnl(ivx)) = ibset(mult(ivx,nnl(ivx)),27)
-c          call setbits (mult(ivx,nnl(ivx)),3,28,
-c     *                  igetbits(mult(ivx,nnl(ivx)-1),3,28))
-          call setbits (mult(ivx,nnl(ivx)),6,10,
-     *                  igetbits(mult(ivx,nnl(ivx)-1),6,10))
-        end if
-        if (autofbon .and. tautofb.gt.tol .and. .not.fbon) then 
-c
-c  Doing auto forced beams, and period has been set, so check if this note
-c    starts a period.
-c
-c          if (mod(1.*itsofar(ivx),tautofb) .lt. tol) then
-          if (mod(itsofar(ivx)-t1autofb,tautofb) .lt. tol) then
-c
-c  Start a forced beam here
-c
-            nfb(ivx) = nfb(ivx)+1
-            fbon = .true.
-            ulfbq(ivx,nfb(ivx)) = 'x'
-            t1fb(ivx,nfb(ivx)) = itsofar(ivx)
-          end if
-        end if
-        if (fbon) ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),30)
-        dotq = 'x'
-        if (charq.eq.'r')
-     *      irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),0)
-        if (btest(irest(ivx,nnl(ivx)),0)) then
-c
-c  Rest stuff.  First check if previous note was full-bar-pause
-c
-          if (lineq(iccount+1:iccount+1) .eq.' '
-     *                    .and. nnl(ivx).gt.1) then
-            if (btest(islur(ivx,nnl(ivx)-1),19))
-     *          islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),19)
-          end if
-c
-c  Set default rest level at 0 unless 2 voices/staff in which case it's -4 or 2
-c  for voice a or b.  Set a-types at 0 as encountered and adjust later
-c  after '//'.  (Override heights will be set to 100+offset)
-c
-          if (ivx .le. nv) then
-            nolev(ivx,nnl(ivx)) = 0
-          else
-            nolev(ivx,nnl(ivx)) = 2
-          end if
-        end if
-2       call getchar(lineq,iccount,durq)
-        ic = ichar(durq)
-        if (ic.le.57 .and. ic.ge.48) then
-c
-c  Digit
-c
-          if (numnum .eq. 0) then
-            nnodur = ic-48
-            numnum = 1
-            go to 2
-          else if (numnum .eq. 1) then
-            ioct = ic-48
-            numnum = 2
-            go to 2
-          else
-            print*,'>2 digits in note sym., ivx,nn:',ivx,nnl(ivx)
-            call stop1()
-          end if
-        else if (durq .eq. 'd') then
-          dotq = durq
-          if (lineq(iccount+1:iccount+1) .eq. 'd') then
-c
-c  Double dot.
-c
-            iccount = iccount+1
-            islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),3)
-          end if
-          if (index('+-',lineq(iccount+1:iccount+1)) .gt. 0) then
-c
-c  move a dot, unless next char is not part of a number
-c
-            if (index('0123456789.',lineq(iccount+2:iccount+2)) .eq. 0)
-     *         go to 2
-            irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),19)
-            call getchar(lineq,iccount,durq)
-            ndotmv(ivx) = ndotmv(ivx)+1
-            iccount=iccount+1
-            call readnum(lineq,iccount,dumq,updot(ivx,ndotmv(ivx)))
-            if (durq .eq. '-')
-     *         updot(ivx,ndotmv(ivx)) = -updot(ivx,ndotmv(ivx))
-            if (index('+-',dumq) .gt. 0) then
-c
-c  Vertical shift also
-c
-              iccount=iccount+1
-              call readnum(lineq,iccount,durq,rtdot(ivx,ndotmv(ivx)))
-              if (dumq .eq. '-')
-     *         rtdot(ivx,ndotmv(ivx)) = -rtdot(ivx,ndotmv(ivx))
-            else
-              rtdot(ivx,ndotmv(ivx)) = 0.
-            end if
-            iccount = iccount-1
-          end if
-          go to 2
-        else if (durq .eq. 'p') then
-c
-c  Full-bar rest as pause
-c
-          islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),19)
-          go to 2
-        else if (durq .eq. 'b') then
-c
-c  Blank rest
-c
-          islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),29)
-          go to 2
-        else if (index('fsn',durq) .gt. 0) then
-c
-c  Accidental
-c
-          if (nacc(ivx,nnl(ivx)) .eq. 0) then
-c
-c  No accidental has been set yet
-c
-            nacc(ivx,nnl(ivx)) = index('fsn',durq)
-          else
-c
-c  Repeated accid, so must be double
-c
-            nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),2)
-          end if
-          go to 2
-        else if (durq .eq. 'i') then
-c
-c  Set flag for MIDI-only accidental.
-c
-          nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),17)
-          go to 2
-        else if (durq .eq. 'c') then
-c
-c  Set flags for cautionary accidental
-c
-          irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),31)
-          iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),31)
-          go to 2
-        else if (index('+-<>',durq) .gt. 0) then
-          ipm = index('- +',durq)-2
-          if (.not.btest(irest(ivx,nnl(ivx)),0)) then
-c
-c  A note, not a rest.
-c
-            call chkpm4ac(lineq,iccount,nacc(ivx,nnl(ivx)),moved)
-            if (moved) go to 2
-c
-c  Octave jump with a note
-c
-            if (numnum .lt. 2) then
-              lastlev = lastlev+ipm*7
-            else
-              ioct = ioct+ipm*1
-            end if
-            go to 2
-          else
-c
-c  Override default height of a rest
-c
-            iccount = iccount+1
-            call readnum(lineq,iccount,durq,fnum)
-            if (lineq(iccount-1:iccount-1) .eq. '.') then
-c
-c  Kluge in case there is a shortcut ".". It will have been sucked up by
-c  readnum.  (Same doesn't hold for ",")
-c
-               iccount = iccount-2
-               go to 2
-            end if
-            nolev(ivx,nnl(ivx)) = 100+ipm*nint(fnum)
-c
-c  There may be more characters for this rest
-c
-            iccount = iccount-1
-            go to 2
-          end if
-        else if (durq .eq. 'x') then
-c
-c  Xtuplet.  Count number of doubled notes (for unequal xtups)
-c
-          if (btest(nacc(ivx,nnl(ivx)),18)) then
-            ndoub = 1
-          else
-            ndoub = 0
-          end if
-c
-c  Will set all durations to 0 except last one.  Set flag on this note.
-c
-          irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),28)
-c
-c  Next input will be digit
-c
-          iccount = iccount+1
-          call readnum(lineq,iccount,durq,fnum)
-          ntup = nint(fnum)
-          if (index('DF',durq) .gt. 0) then
-c
-c  Double xtup note to make an un= xtup. Here xtup number already set but may also
-c    have this command before.
-c
-            nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
-            if (durq .eq. 'F') nacc(ivx,nnl(ivx)) = 
-     *                  ibset(nacc(ivx,nnl(ivx)),19)
-            ndoub = 1
-            call getchar(lineq,iccount,durq)
-          else if (durq .eq. 'd') then
-            nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27)
-            call getchar(lineq,iccount,durq)
-          end if
-c
-c  Only other possibilities here are ' ' or 'n'
-c
-          if (durq .eq. 'n') then
-c
-c  Alter xtup number
-c
-            if (lineq(iccount+1:iccount+1) .eq. ' ') then
-c
-c  If the only modifier is 'n', cancel the number
-c
-              islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),31)
-            else
-              numshft = 0
-30            call getchar(lineq,iccount,durq)
-              if (durq .eq. 'f') then
-c
-c  Flip up-down-ness
-c
-                irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),14)
-                go to 30
-              else if (index('+-',durq) .gt. 0) then
-c
-c  Vertical or horiz shift
-c
-                numshft = numshft+1
-                iofforn = 1
-                if (durq .eq. '-') iofforn = -1
-                iccount = iccount+1
-                call readnum(lineq,iccount,durq,xofforn)
-                iccount = iccount-1
-                if (numshft .eq. 1) then
-c
-c  Vertical shift
-c  160214 Allow (-64,64)
-c                  iofforn = iofforn*nint(xofforn) + 16
-                  iofforn = iofforn*nint(xofforn) + 64
-c
-cc  Turn on bit 1; set bits 2-6 to iofforn
-c  Turn on bit 1 of irest; set bits 16-22 of mult to iofforn
-c
-c                  irest(ivx,nnl(ivx)) =
-c     *               ior(irest(ivx,nnl(ivx)),2+4*iofforn)
-                  irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),1)
-                  call setbits(mult(ivx,nnl(ivx)),8,16,iofforn)
-                else
-c
-c  Horizontal shift
-c
-                  iofforn = iofforn*nint(xofforn*10)+16
-                  irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),7)
-                  call setbits(irest(ivx,nnl(ivx)),5,9,iofforn)
-                end if
-                go to 30
-              else if (durq .eq. 's') then
-c
-c Slope adjustment for bracket
-c
-                mult(ivx,nnl(ivx)) = ibset(mult(ivx,nnl(ivx)),4)
-                call getchar(lineq,iccount,durq)
-                iofforn = index('- +',durq)-2
-                iccount = iccount+1
-                call readnum(lineq,iccount,durq,xofforn)
-                iccount = iccount-1
-                iofforn = nint(iofforn*xofforn+16)
-                call setbits(mult(ivx,nnl(ivx)),5,5,iofforn)
-              else if (index('123456789',durq) .gt. 0) then
-c
-c  Replacement printed number
-c
-                call readnum(lineq,iccount,durq,xofforn)
-                call setbits(nacc(ivx,nnl(ivx)),5,22,nint(xofforn))             
-                iccount = iccount-1
-                go to 30
-              end if
-            end if
-          end if
-c
-c  Set note level of 1st note of xtup, provided not a rest
-c
-          if (.not.btest(irest(ivx,nnl(ivx)),0)) then
-            if (numnum .eq. 2) then
-              lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv)))
-              nolev(ivx,nnl(ivx)) = lastlev
-            else
-              lastlev = lastlev-3
-     *         +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7)
-              nolev(ivx,nnl(ivx)) = lastlev
-            end if
-          end if
-          do 40 npreslur = npreslur , 1 , -1
-c
-c  Set note level for preslur on starting note of xtuplet
-c
-            call setbits(isdat2(nsdat-npreslur+1),7,19,lastlev)
-40        continue
-          numnum = 0
-          nodur(ivx,nnl(ivx)) = 0
-          do 6 itup = 2 , ntup
-            if (ornrpt) then
-              iornq(ivx,nnl(ivx)) = ior(iornq(ivx,nnl(ivx)),
-     *           iand(iornq(ivx,nnl(ivx)-1),10026991))
-              if (iand(iornq(ivx,nnl(ivx)),32896) .gt. 0) then
-c
-c  This is a trill (bit 7 or 15) so must dup the parameters
-c
-                ntrill = ntrill + 1
-                ivtrill(ntrill) = ivx
-                iptrill(ntrill) = nnl(ivx)
-                xnsktr(ntrill) = xnsktr(ntrill-1)
-              end if
-            end if
-            nnl(ivx) = nnl(ivx)+1
-            if (fbon) ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),30)
-7           call getchar(lineq,iccount,charq)
-            if (charq .eq. ' ') then
-              go to 7
-            else if (charq .eq. '%') then
-              iccount = 128
-              go to 7
-            else if (charq .eq. 'o') then
-c
-c  Ornament in xtuplet.  "o" symbol must come AFTER the affected note
-c
-              if (notcrd) then
-                nole = nolev(ivx,nnl(ivx)-1)
-              else
-                nole = iand(127,ishft(icrdat(ncrd),-12))
-              end if
-              call getorn(lineq,iccount,iornq(ivx,nnl(ivx)-1),
-     *             iornq(ivx,0),ornrpt,noffseg,
-     *             nnl(ivx)-1,ivx,.false.,notcrd,nole)
-              go to 7
-            else if (index('st(){}',charq) .gt. 0) then
-              nnlivx = nnl(ivx)-1
-              if (charq.eq.'(' .or. charq.eq.'{') then
-c
-c  Detected preslur in xtuplet loop, non-chord note
-c
-                nnlivx = nnlivx+1
-                npreslur = npreslur+1
-              end if
-              islur(ivx,nnlivx) = ibset(islur(ivx,nnlivx),0)
-              if (charq.eq.'t') islur(ivx,nnlivx) =
-     *                    ibset(islur(ivx,nnlivx),1)
-              if (ivx .le. nv) then
-                kv = 1
-              else
-                kv = 2
-              end if
-              if (fontslur) then
-                call sslur(lineq,iccount,iv,kv,nnlivx,isdat1,isdat2,
-     *                   isdat3,nsdat,notcrd,nolev(ivx,nnlivx),charq)
-              else
-                call spsslur(lineq,iccount,iv,kv,nnlivx,isdat1,isdat2,
-     *               isdat3,isdat4,nsdat,notcrd,nolev(ivx,nnlivx),charq)
-              end if
-              go to 7
-            else if (charq .eq. 'G') then
-c
-c Kluge to get grace in xtup at right location
-c
-              nnl(ivx) = nnl(ivx)-1
-              call getgrace(ivx,nnl,lineq,iccount,islur,iornq,ipl,ndlev,
-     *                lastlev,iv,nv)
-              nnl(ivx) = nnl(ivx)+1
-              go to 7
-            else if (charq .eq. sq) then
-              call littex(islur,nnl(ivx),ivx,topmods,lineq,iccount)
-              go to 7
-            else if (charq .eq. '"') then
-c
-c  pmxlyr string in xtup. Expand "..." to \pmxlyr{...}\
-c
-              call dopmxlyr(lineq,iccount)
-              charq = sq
-              call littex(islur,nnl(ivx),ivx,topmods,lineq,iccount)
-              go to 7
-            else if (index('0123456789#-nx_',charq) .gt. 0) then
-c
-c  Figure.  Must come AFTER the first note of xtup
-c
-              ivf = 1
-              if (ivx .gt. 1) then
-                if (ivxfig2 .eq. 0) then
-                  ivxfig2 = ivx
-                else if (ivx .ne. ivxfig2) then
-                  print*
-                  print*,'Figures not allowed in >1 voice above first'
-                  stop
-                end if
-                ivf = 2
-              end if
-              nfig1 = nfigs(ivf)+1
-			call getfig(itoff(ivf,nfig1),charq,lineq,iccount,
-     *             isfig(ivf,nnl(ivx)-1),itfig(ivf,nfig1),itsofar(ivx),
-c     *             0,figq(ivf,nfig1),ivupfig(ivf,nfig1),nfigs(ivf))
-     *           0,figq(ivf,nfig1),ivupfig(ivf,nfig1),ivvfig(ivf,nfig1),
-     *           nfigs(ivf))
-              go to 7
-            else if (charq .eq. 'X') then
-              call getx(lineq,iccount,irest(ivx,max(1,nnl(ivx)-1)),
-     *            shifton,wheadpt,iornq(ivx,nnl(ivx)),ivx,
-     *            irest(ivx,nnl(ivx)),itsofar(ivx),ntup,itup,nnodur,
-     *            dotq,ndoub)
-              go to 7
-            else if (charq .eq. 'z') then
-c
-c  Chord note in xtup.  Goes with *prior* note.
-c
-              notcrd = .false.
-              ncrd = ncrd+1
-              ipl(ivx,nnl(ivx)-1) = ibset(ipl(ivx,nnl(ivx)-1),10)
-              numnum = 0
-c              icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8))
-              icrdat(ncrd) = nnl(ivx)-1
-              call setbits(icrdat(ncrd),4,8,mod(ivx,16))
-              if (ivx .ge. 16) icrdat(ncrd) = ibset(icrdat(ncrd),28)
-              icrdorn(ncrd) = 0
-c
-c  Get note name
-c
-              call getchar(lineq,iccount,charq)
-c
-c  Get optional inputs
-c
-34            call getchar(lineq,iccount,durq)
-c
-c  When chord note is done, will get ' ', making ndx=0, so go past this block
-c
-              ndx = index('fsn+-<>12345678reic',durq)
-              if (ndx .gt. 0) then
-                if (ndx .le. 3) then
-                  if (.not.btest(icrdat(ncrd),19)) then
-                    icrdat(ncrd) = ibset(icrdat(ncrd),19)
-                    icrdat(ncrd) = ior(icrdat(ncrd),ishft(ndx,20))
-                  else
-                    icrdat(ncrd) = ibset(icrdat(ncrd),22)
-                  end if
-                else if (ndx .eq. 19) then
-c
-c  Set flags for cautionary accidental
-c
-                  icrdat(ncrd) = ibset(icrdat(ncrd),31)
-                  iornq(ivx,nnl(ivx)-1) = 
-     *                       ibset(iornq(ivx,nnl(ivx)-1),31)
-                else if (ndx .le. 7) then
-c
-c +/-/</> Check whether octave or accidental shift
-c
-                  nactmp = 0
-                  call chkpm4ac(lineq,iccount,nactmp,moved)
-                  if (moved) then
-c
-c  Transfer accidental shift values
-c
-                    call setbits(icrdot(ncrd),6,14,
-     *                              igetbits(nactmp,6,4))
-                    call setbits(icrdot(ncrd),7,20,
-     *                              igetbits(nactmp,7,10))
-                  else
-                    if (durq .eq. '+') then
-                      lastlev = lastlev+7
-                    else if (durq .eq. '-') then
-                      lastlev = lastlev-7
-                    end if
-                  end if
-                else if (durq .eq. 'e') then
-                  icrdat(ncrd) = ibset(icrdat(ncrd),23)
-                  irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27)
-                else if (durq .eq. 'r') then
-                  icrdat(ncrd) = ibset(icrdat(ncrd),24)
-                  irest(ivx,nnl(ivx)-1) =
-     *                      ibset(irest(ivx,nnl(ivx)-1),20)
-                else if (durq .eq. 'i') then
-c
-c  Midi-only accidental
-c
-                  icrdat(ncrd) = ibset(icrdat(ncrd),27)
-                else
-c
-c must be a number, save it in ioct
-c
-                  numnum = 1
-                  ioct = ndx-7
-                end if
-                go to 34
-              end if
-              if (numnum .eq. 1) then
-                lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv)))
-              else
-                lastlev = lastlev-3
-     *         +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7)
-              end if
-              icrdat(ncrd) = ior(icrdat(ncrd),ishft(lastlev,12))
-              do 41 npreslur = npreslur , 1 , -1
-c
-c  Set note level for preslur on chord note in xtup
-c
-                call setbits (isdat2(nsdat-npreslur+1),7,19,lastlev)
-c
-c  Following lines copied from loop for non-xtup, chord note, preslur
-c  Initially I assigned the slur(s) to next note, so fix.
-c
-                islur(ivx,nnl(ivx)) = ibclr(islur(ivx,nnl(ivx)),0)
-                islur(ivx,nnl(ivx)-1) = ibset(islur(ivx,nnl(ivx)-1),0)
-                isdat2(nsdat-npreslur+1) = 
-     *                               ibset(isdat2(nsdat-npreslur+1),0)
-                call setbits(isdat1(nsdat-npreslur+1),8,3,
-     *               igetbits(isdat1(nsdat-npreslur+1),8,3)-1)
-41            continue
-              go to 7
-            else if (charq .eq. '?') then
-c
-c  Arpeggio
-c
-              if (btest(ipl(ivx,nnl(ivx)-1),10)) then
-c
-c  This is a chordal note.  Set a bit in icrdat.  But if *main* (spacing) note
-c  of chord, will not set icrdat(25), but iornq(27)
-c
-                icrdat(ncrd) = ibset(icrdat(ncrd),25)
-              else
-                iornq(ivx,nnl(ivx)-1) = ibset(iornq(ivx,nnl(ivx)-1),27)
-              end if
-c
-c  Check for shift
-c
-              call getchar(lineq,iccount,durq)
-              if (durq .eq. ' ') then
-                iccount = iccount-1
-              else
-c
-c  durq must be "-"
-c
-                iccount = iccount+1
-                call readnum(lineq,iccount,durq,fnum)
-                iccount = iccount-1
-c
-c  record the shift
-c
-                NumArpShift = NumArpShift+1
-                IvArpShift(NumArpShift) = ivx
-                IpArpShift(NumArpShift) = nnl(ivx)-1
-                ArpShift(NumArpShift) = fnum
-              end if
-              go to 7
-            else if (charq .eq. 'D') then
-              call getdyn(ivx,nnl(ivx)-1,irest(ivx,nnl(ivx)-1),
-     *              iornq(ivx,nnl(ivx)-1),lineq,iccount)
-              go to 7
-c
-c  140215 Allow clef change inside xtuplet. With normal code, came out one
-c         note too late, so try making it come earlier.
-c
-            else if (charq .eq. 'C') then
-c
-c  Clef change on next note.  Set bits 11-15.  Won't allow in 2nd line of music.
-c
-c              if (nnl(iv) .gt. 0) ncc(iv) = ncc(iv)+1
-              if (nnl(iv)-1 .gt. 0) ncc(iv) = ncc(iv)+1
-c
-c  140218 Need to get time differently inside xtup, since itsofar doesn't get
-c  updated until after xtup is done
-c
-c              tcc(iv,ncc(iv)) = itsofar(iv)
-              nodurt = ifnodur(nnodur,dotq)
-              tcc(iv,ncc(iv)) = itsofar(iv)+int(1.*nodurt/ntup*(itup-1))
-c      print*,'itsofar,ncc,nodurt,ntup,itup,tcc:'
-c      print*,itsofar(iv),ncc(iv),nodurt,ntup,itup,tcc(iv,ncc(iv))
-c              isl = ibset(islur(iv,nnl(iv)+1),11)
-              isl = ibset(islur(iv,nnl(iv)),11)
-              call getchar(lineq,iccount,durq)
-c
-c  Store clef number, or 7 if clef number = 9 (French violin clef)
-c
-              isl = ior(isl,ishft(min(numclef(durq),7),12))
-              ncmidcc(iv,ncc(iv)) = ncmidf(durq)
-              if (durq .eq. '8') then
-                ipl(iv,nnl(iv))=ibset(ipl(iv,nnl(iv)),2)
-                iTransAmt(instno(iv)) = 7
-              end if
-c
-c  Set marker on note with lowest voice # starting at same time.
-c
-              if (iv .eq. 1) then
-                isl = ibset(isl,15)
-              else
-                do 70 iiv = 1 , iv
-c                  nnliiv = nnl(iiv)
-                  nnliiv = nnl(iiv)-1
-                  if (iiv .eq. iv) nnliiv = nnliiv+1
-                  itother = 0
-                  do 71 iip = 1 , nnliiv
-                    if (itother .lt. itsofar(iv)) then
-                      itother = itother+nodur(iiv,iip)
-                      go to 71
-                    else if (itother .eq. itsofar(iv)) then
-                      islur(iiv,iip) = ibset(islur(iiv,iip),15)
-                      go to 72
-                    end if
-71                continue
-70              continue
-72              continue
-              end if
-c
-c  Need 'or' since may have set bit 15 in the above loop
-c
-c              islur(iv,nnl(iv)+1) = ior(isl,islur(iv,nnl(iv)+1))
-              islur(iv,nnl(iv)) = ior(isl,islur(iv,nnl(iv)))
-              go to 7
-c+++
-            else if (charq .eq. ']') then
-c
-c  Multiplicity up-down, must have '][ '
-c
-              islur(ivx,nnl(ivx)-1) = ibset(islur(ivx,nnl(ivx)-1),20)
-              iccount = iccount+2
-              go to 7
-cc+++
-            end if
-c
-c  End of loop for xtup options. If here, charq must be a (non-crd) note name.
-c  or rest
-c
-            if (charq .eq. 'r') then
-c
-c  Rest in xtup
-c
-              irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),0)
-              if (index('+-b',lineq(iccount+1:iccount+1)) .gt. 0) then
-                call getchar(lineq,iccount,durq)
-                if (durq .eq. 'b') then
-c
-c  Blank rest in middle of xtup
-c
-                  islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),29)
-                else
-c
-c  Override height of embedded xtup rest
-c
-                  ipm = index('- +',durq)-2
-                  iccount = iccount+1
-                  call readnum(lineq,iccount,durq,fnum)
-                  nolev(ivx,nnl(ivx)) = 100+ipm*nint(fnum)
-                  iccount = iccount-1
-                end if 
-              else if (ivx .le. nv) then
-                nolev(ivx,nnl(ivx)) = 0
-              else
-                nolev(ivx,nnl(ivx)) = 2
-              end if
-            end if
-            notcrd = .true.
-8           call getchar(lineq,iccount,durq)
-            if (durq .ne. ' ') then
-              if (index('+-<>',durq) .gt. 0) then
-c
-c  Accidental horizontal shift
-c
-                call chkpm4ac(lineq,iccount,nacc(ivx,nnl(ivx)),moved)
-                if (.not.moved) then
-                  if (durq.eq.'+') then
-                    lastlev = lastlev+7
-                  else if (durq.eq.'-') then
-                    lastlev = lastlev-7
-                  end if
-                end if
-              else if (index('fsn',durq) .gt. 0) then
-                if (nacc(ivx,nnl(ivx)) .eq. 0) then
-c
-c  No accid set yet
-c
-                  nacc(ivx,nnl(ivx)) = index('fsn',durq)
-                else
-c
-c  Symbol must be repeated, so it's a double
-c
-                  nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),2)
-                end if
-              else if (durq .eq. 'i') then
-c
-c  Set flag for midi-only accidental
-c
-                nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),17) 
-
-              else if (durq .eq. 'c') then
-c
-c  Set flags for cautionary accidental
-c
-                irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),31)
-                iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),31)
-              else if (index('ul',durq) .gt. 0) then
-c
-c  Force stem direction for non-beamed xtup note
-c
-                islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),30)
-                if (durq .eq. 'u') islur(ivx,nnl(ivx)) =
-     *                ibset(islur(ivx,nnl(ivx)),17)
-              else if (durq .eq. 'e') then
-c
-c  Left-shift main xtup note
-c
-                ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),8)
-                irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27)
-              else if (durq .eq. 'r') then
-c
-c  Right-shift main xtup note
-c
-                ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),9)
-                irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),20)
-              else if (index('DF',durq) .gt. 0) then
-c
-c  Double an xtup note to make an unequal xtup
-c
-                nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
-                if (durq .eq. 'F') nacc(ivx,nnl(ivx)) = 
-     *                  ibset(nacc(ivx,nnl(ivx)),19)
-                ndoub = ndoub+1
-              else if (durq .eq. 'd') then
-c
-c  Dotted xtup note
-c
-                nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27)
-              else
-c
-c  Must be an octave number
-c
-                lastlev = ifnolev(charq,ichar(durq)-48
-     *                          ,iTransAmt(instno(iv)))
-              end if
-              go to 8
-            end if
-            if (itup .lt. ntup) then
-c
-c  Last note is handled *after* flowing out of the xtup if block, but still
-c    within block for a note-rest.  Set note level now (rest already done).
-c    Could have problem here if rests & doubled notes are combined in xtup,
-c    since might exit the loop at the wrong place.  Worry about it later.
-c
-              if (.not.btest(irest(ivx,nnl(ivx)),0)) then
-                lastlev = lastlev-3+mod(ifnolev(charq,10,
-     *                      iTransAmt(instno(iv)))-lastlev+3,7)
-                nolev(ivx,nnl(ivx)) = lastlev
-              end if
-              nodur(ivx,nnl(ivx)) = 0
-              do 42 npreslur = npreslur , 1 , -1
-c
-c  Set note level for preslur on internal xtup note
-c
-                call setbits (isdat2(nsdat-npreslur+1),7,19,lastlev)
-42            continue
-            end if
-            if (itup .eq. ntup-ndoub) go to 12
-6         continue
-12        continue
-          if (ornrpt) then
-            iornq(ivx,nnl(ivx)) = ior(iornq(ivx,nnl(ivx)),
-     *           iand(iornq(ivx,nnl(ivx)-1),10026991))
-            if (iand(iornq(ivx,nnl(ivx)),32896) .gt. 0) then
-c
-c  This is a trill (bit 7 or 15) so must dup the parameters
-c
-              ntrill = ntrill + 1
-              ivtrill(ntrill) = ivx
-              iptrill(ntrill) = nnl(ivx)
-              xnsktr(ntrill) = xnsktr(ntrill-1)
-            end if
-          end if
-c
-c  End of if-block for xtuplet input
-c
-        else if (durq .eq. 'm') then
-c
-c  Multi-bar rest: next 1 or two digits are # of bars.
-c  For some purposes, pretend its one bar only
-c
-          nodur(ivx,nnl(ivx)) = lenbar
-          ibarmbr = nbars+1
-          mbrest = 0
-          xb4mbr = 0.
-20        call getchar(lineq,iccount,durq)
-          if (ichar(durq).ge.48.and.ichar(durq).le.57) then
-            mbrest = 10*mbrest+ichar(durq)-48
-            go to 20
-          end if
-        else if (index('ul',durq) .gt. 0) then
-c
-c  Set stem flipper
-c
-          islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),30)
-          if (durq .eq. 'u') islur(ivx,nnl(ivx)) =
-     *                ibset(islur(ivx,nnl(ivx)),17)
-          go to 2
-        else if (durq .eq. 'a') then
-c
-c  "Alone", i.e., prohibit beam
-c
-          islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),18)
-          go to 2
-        else if (durq .eq. 'r') then
-c
-c  Right offset by one notehead
-c
-          ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),9)
-          irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),20)
-          go to 2
-        else if (durq .eq. 'e') then
-c
-c  Left offset by one notehead
-c
-          ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),8)
-          irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27)
-          go to 2
-c        else if (durq .eq. 'S') then
-        else if (index('LS',durq) .gt. 0) then
-c
-c  Stemlength change.  Get dstemlen in \internotes.  Allowable values are -4 to 27.5
-c    Set mult(27).  Map value to 0 to 63, store in mult(10-15).  Later convert to
-c    interbeams = internotes*2/3.
-c
-c
-          isign = 1
-          if (durq .eq. 'S') isign = -1
-          mult(ivx,nnl(ivx)) = ibset(mult(ivx,nnl(ivx)),27)
-          call getchar(lineq,iccount,durq)
-          if (durq .eq. ':') then
-c
-c  End stickyS.  Grab data now from prior note, since we have to shut off stickyS.
-c
-            call setbits (mult(ivx,nnl(ivx)),6,10,
-     *                    igetbits(mult(ivx,nnl(ivx)-1),6,10))
-            stickyS = .false.  
-            go to 2
-          end if
-c
-c  If durq .ne. ':' then iccount is now on the start of the number
-c
-          call readnum(lineq,iccount,durq,dum)
-          dum = isign*dum
-          call setbits (mult(ivx,nnl(ivx)),6,10,nint((dum+4.)*2))
-          if (durq .eq. ':') then
-            stickyS = .true.
-          else
-            iccount = iccount-1
-          end if
-          go to 2                    
-        else if (durq .eq. ',') then
-c
-c  2:1 pattern
-c
-          idotform = 3
-c
-c  Now flow to duration setting, as if durq=' '
-c
-        else if (durq .eq. '.') then
-c
-c  Dotted pattern.  Close out note.  Mult time by 3/4.
-c  Set time for next note to 1/4.  Start the note.
-c
-          idotform = 1
-        else if (durq .eq. 'o') then
-c
-c  Suppress rest centering
-c
-          irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),25)
-          go to 2
-        else if (durq .eq.'L') then
-c
-c  With keyboard rest option, look left
-c
-c          iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),30)
-          ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),1)
-          go to 2
-        else if (index('DF',durq) .gt. 0) then
-c
-c  Double note for xtup.  Must check here in case "D" came before "x" or on
-c  last note of xtup.   Need to flag it in pmxa since affects horiz. spacing.
-c
-          nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
-          if (durq .eq. 'F') nacc(ivx,nnl(ivx)) = 
-     *                  ibset(nacc(ivx,nnl(ivx)),19)
-          go to 2
-        else if (durq .eq. 'A') then
-c
-c  Accidental option
-c
-          call getchar(lineq,iccount,durq)
-c
-          if (durq .eq. 'o') then
-c
-c  Ordered accidentals in a chord.  Mark the main note.
-c
-            nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),28)
-          else
-c
-c  Only other possibility is +-<> . Set tag, reduce iccount and loop to get #'s
-c
-            nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),29)
-            iccount = iccount-1
-          end if            
-          go to 2
-        else if (durq .ne. ' ') then
-          print*,'Illegal character in note: ',durq,', ivx,nn:',
-     *        ivx,nnl(ivx)
-          call stop1()
-        end if
-c
-c  Done with note/rest options.  Set level and duration.
-c
-        if (.not.btest(irest(ivx,nnl(ivx)),0)) then
-          if (numnum .eq. 2) then
-            lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv)))
-            nolev(ivx,nnl(ivx)) = lastlev
-          else
-            lastlev = lastlev-3
-     *         +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7)
-            nolev(ivx,nnl(ivx)) = lastlev
-          end if
-          do 43 npreslur = npreslur , 1 , -1
-c
-c  Set level for preslur on normal note, non-chord
-c
-            call setbits(isdat2(nsdat-npreslur+1),7,19,lastlev)
-43        continue
-        end if
-        if (idotform .gt. 0) then
-          if (idotform .eq. 1) then
-            nodur(ivx,nnl(ivx)) = ifnodur(nnodur,dotq)*3/2
-          else if (idotform .eq. 2) then
-            nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/3
-          else if (idotform .eq. 3) then
-            nodur(ivx,nnl(ivx)) = ifnodur(nnodur,dotq)
-          else if (idotform .eq. 4) then
-            nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/2
-          end if
-        else if (btest(islur(ivx,nnl(ivx)),19)) then
-c
-c  Set duration of full-bar rest as pause
-c
-          nodur(ivx,nnl(ivx)) = lenbar
-c
-c  Use a one-line function to set nnodur.  It gives inverse of ifnodur.
-c
-          nnodur = index('62514x0x37',
-     *                   chax(48+int(log(.1+lenbar)/.69315)))-1
-        else if (ibarmbr.ne.nbars+1) then
-          nodur(ivx,nnl(ivx)) = ifnodur(nnodur,dotq)
-          if (btest(islur(ivx,nnl(ivx)),3))
-     *      nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*7/6
-        end if
-        if (shifton .and. .not.btest(irest(ivx,nnl(ivx)),16)) then
-c
-c  Shift is on, and this is not first shifted note.  Check for duration change
-c
-          if (nodur(ivx,nnl(ivx)) .ne. nodur(ivx,nnl(ivx)-1)) then
-c
-c  Must stop and restart the offset.
-c
-            irest(ivx,nnl(ivx)-1) = ibset(irest(ivx,nnl(ivx)-1),17)
-            irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),16)
-            nudoff(ivx) = nudoff(ivx)+1
-            udoff(ivx,nudoff(ivx)) = udoff(ivx,nudoff(ivx)-1)
-          end if
-        end if
-        itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx))
-        if (autofbon .and. tautofb.gt.tol .and. fbon) then
-c
-c  Check to see if need to terminate auto forced beam
-c
-          if (mod(itsofar(ivx)-t1autofb,tautofb) .lt. tol) then
-c
-c  Terminate autofb
-c
-            t2fb(ivx,nfb(ivx)) = itsofar(ivx)
-            fbon = .false.
-          end if
-        end if
-        if (mod(itsofar(ivx)-lenb0,lenbar) .eq. 0) then
-c
-c  Finished a bar
-c
-          nbars = nbars+1
-          nib(ivx,nbars) = nnl(ivx)
-          if (firstgulp.and.lenb0.ne.0.and.nbars.eq.1) then
-c
-c  Just finished the pickup bar for this voice.
-c
-            lenbar = lenb1
-          end if
-        end if
-        if (idotform .eq. 1) then
-          call getchar(lineq,iccount,charq)
-          idotform = 2
-          numnum = 1
-          go to 28
-        else if (idotform .eq. 3) then
-          call getchar(lineq,iccount,charq)
-          idotform = 4
-          numnum = 1
-          go to 28
-        end if
-c
-c  End of sub block for note-rest
-c
-      else if (charq .eq. 'z') then
-c
-c  Chord note.  Must have note name, may have octave#,+,-,s,f,n,d
-c  Actually the 'd' is not used, since time value comes from
-c    basic note. Unless dot is to be shifted!
-c  Doesn't increase # of notes, so must handle separately
-c  ncrd: index of crd
-c  Set bit 10 of ipl on main note as flag
-c  Bits in icrdat:
-c     0-7   ip within voice
-c     8-11  ivx
-c     12-18 note level
-c     19    accidental?
-c     20-22 accidental value (1=natural, 2=flat, 3=sharp, 6=dflat, 7=dsharp)
-c     23    shift left
-c     24    shift right
-c     25    arpeggio start or stop
-c     26    flag for moved dot (here, not icrdot, since this is always reset!)
-c     27    Midi-only accidental
-c     29    Tag for accidental shift...means add to autoshifts.
-c     31    Cautionary accidental 
-c
-c  Bits in icrdot:
-c     0-6   10*abs(vertical dot shift in \internote) + 64
-c     7-13  10*abs(horizontal dot shift in \internote) + 64
-c     14-19 vert accidental shift-32
-c     20-26 20*(horiz accidental shift+3.2)
-c     27-29 top-down level rank of chord note w/accid. Set in crdaccs.
-c
-c  Bits in icrdorn are same as in iornq, even tho most orns won't go in crds.
-c
-        ncrd = ncrd+1
-        ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),10)
-        numnum = 0
-c        icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8))
-        icrdat(ncrd) = nnl(ivx)
-	  call setbits(icrdat(ncrd),4,8,mod(ivx,16))
-        if (ivx .ge. 16) icrdat(ncrd) = ibset(icrdat(ncrd),28)
-        icrdot(ncrd) = 0
-        icrdorn(ncrd) = 0
-c
-c  Get note name
-c
-        call getchar(lineq,iccount,charq)
-c
-c  Get optional inputs
-c
-25      call getchar(lineq,iccount,durq)
-c        ndx = index('fsn+-<>12345678rediA',durq)
-        ndx = index('fsn+-<>12345678rediAc',durq)
-        if (ndx .eq. 20) then
-c
-c  Expect +|-|<|> , set tag, loop
-c
-          icrdat(ncrd) = ibset(icrdat(ncrd),29)
-          go to 25
-	  else if (ndx .gt. 0) then
-          if (ndx .le. 3) then
-            if (.not.btest(icrdat(ncrd),19)) then
-              icrdat(ncrd) = ibset(icrdat(ncrd),19)
-              icrdat(ncrd) = ior(icrdat(ncrd),ishft(ndx,20))
-            else
-              icrdat(ncrd) = ibset(icrdat(ncrd),22)
-            end if
-          else if (ndx .eq. 21) then
-c
-c  Set flags for cautionary accidental
-c
-            icrdat(ncrd) = ibset(icrdat(ncrd),31)
-            iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),31)
-          else if (ndx .le. 7) then
-c
-c +/-/</> Check whether octave or accidental shift
-c
-            nactmp = 0
-            call chkpm4ac(lineq,iccount,nactmp,moved)
-            if (moved) then
-c
-c  Transfer accidental shift values
-c
-              call setbits(icrdot(ncrd),6,14,igetbits(nactmp,6,4))
-              call setbits(icrdot(ncrd),7,20,igetbits(nactmp,7,10))
-            else
-              if (durq .eq. '+') then
-                lastlev = lastlev+7
-              else if (durq .eq. '-') then
-                lastlev = lastlev-7
-              end if
-            end if
-          else if (durq .eq. 'e') then
-            icrdat(ncrd) = ibset(icrdat(ncrd),23)
-            irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27)
-          else if (durq .eq. 'r') then
-            icrdat(ncrd) = ibset(icrdat(ncrd),24)
-            irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),20)
-          else if (durq .eq. 'i') then
-c
-c  Midi-only accidental on chord note
-c
-            icrdat(ncrd) = ibset(icrdat(ncrd),27)
-          else if (durq .eq. 'd') then
-c
-c  Must keep 'd' optional (backward compatibility), unless it is moved!
-c
-            if (index('+-',lineq(iccount+1:iccount+1)) .gt. 0) then
-c
-c  move a dot, unless next char is not part of a number
-c
-              if (index('0123456789.',lineq(iccount+2:iccount+2))
-     *              .eq. 0) go to 25
-              icrdat(ncrd) = ibset(icrdat(ncrd),26)
-              call getchar(lineq,iccount,durq)
-              iccount=iccount+1
-              call readnum(lineq,iccount,dumq,fnum)
-              if (durq .eq. '+') then
-                icrdot(ncrd) = ior(icrdot(ncrd),nint(fnum*10)+64)
-              else
-                icrdot(ncrd) = ior(icrdot(ncrd),-nint(fnum*10)+64)
-              end if
-              if (index('+-',dumq) .gt. 0) then
-c
-c  Vertical shift specified also
-c
-                iccount=iccount+1
-                call readnum(lineq,iccount,durq,fnum)
-                if (dumq .eq. '+') then
-                  ifnum = nint(fnum*10)+64
-                else
-                  ifnum = -nint(fnum*10)+64
-                end if
-              else
-                ifnum = 64
-              end if
-              icrdot(ncrd) = ior(icrdot(ncrd),ishft(ifnum,7))
-              iccount = iccount-1
-            end if
-          else
-c
-c must be a single digit, save it in ioct
-c
-            numnum = 1
-            ioct = ndx-7
-          end if
-          go to 25
-        end if
-        if (numnum .eq. 1) then
-          lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv)))
-        else
-          lastlev = lastlev-3
-     *         +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7)
-        end if
-        icrdat(ncrd) = ior(icrdat(ncrd),ishft(lastlev,12))
-        do 44 npreslur = npreslur , 1 , -1
-          call setbits (isdat2(nsdat-npreslur+1),7,19,lastlev)
-c
-c  Set level for chord note.
-c  Initially I assigned the slur(s) to next note, so fix.
-c
-          islur(ivx,nnl(ivx)+1) = ibclr(islur(ivx,nnl(ivx)+1),0)
-          islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),0)
-          isdat2(nsdat-npreslur+1) = ibset(isdat2(nsdat-npreslur+1),0)
-          call setbits(isdat1(nsdat-npreslur+1),8,3,
-     *               igetbits(isdat1(nsdat-npreslur+1),8,3)-1)
-44      continue
-        if (notcrd) then
-c
-c  This is the first chord note in this chord.
-c
-          minlev = min(nolev(ivx,nnl(ivx)),lastlev)
-          maxlev = max(nolev(ivx,nnl(ivx)),lastlev)
-        else
-          minlev = min(minlev,lastlev)
-          maxlev = max(maxlev,lastlev)
-        end if
-        notcrd = .false.
-      else if (charq .eq. 'G') then
-        call getgrace(ivx,nnl,lineq,iccount,islur,iornq,ipl,ndlev,
-     *                lastlev,iv,nv)
-c
-c Grace, comes *before* main note:
-c UNLESS there's an 'A' or 'W' after the 'G'
-c   ngrace = # of grace note groups so far in block
-c   ivg(ngrace), ipg(ngrace)
-c   nng(ngrace) = # of notes in this group: default = 1
-c   ngstrt(ngrace) = starting position in nolevg of levels for this grace
-c   multg(ngrace) = multiplicity: default = 1;  input as 'm(digit)'
-c   upg(ngrace) = logical for beam or stem dirn: default T, input'u,l'
-c   slurg(ngrace) = logical for slur; default F, input 's'
-c   slashg(ngrace) = T if slash; default is F, input 'x'
-c These data MUST precede note name of first note
-c   nolevg, naccg: lists of levels and accid's, indexed as described above.
-c
-      else if (charq .eq. sq) then
-c
-c  Literal TeX string
-c
-        call littex(islur,nnl(ivx)+1,ivx,topmods,lineq,iccount)
-      else if (charq .eq. '"') then
-c
-c  pmxlyr string. Expand "..." to \pmxlyr{...}\
-c
-        if (.not. inputmlyr) then
-          ictemp = 0
-          lineqt = sq//sq//sq//'input musixlyr '//sq
-          call littex(islur,nnl(ivx)+1,ivx,topmods,lineqt,ictemp)
-          inputmlyr = .true.
-        end if
-        call dopmxlyr(lineq,iccount)
-        charq = sq
-        call littex(islur,nnl(ivx)+1,ivx,topmods,lineq,iccount)
-      else if (charq .eq. 'o') then
-c
-c  Ornament on non-xtup note.  Symbol must come AFTER the affected note
-c
-        if (notcrd) then
-          nole = nolev(ivx,nnl(ivx))
-        else
-          nole = iand(127,ishft(icrdat(ncrd),-12))
-        end if
-        call getorn(lineq,iccount,iornq(ivx,nnl(ivx)),
-     *       iornq(ivx,0),ornrpt,noffseg,nnl(ivx),ivx,
-     *      .true.,notcrd,nole)
-      else if (index('st(){}',charq) .gt. 0) then
-        nnlivx = nnl(ivx)
-        if (charq.eq.'(' .or. charq.eq.'{') then
-c
-c Detect preslur on normal non-chord note
-c
-          nnlivx = nnlivx+1
-          npreslur = npreslur+1
-        end if
-        islur(ivx,nnlivx) = ibset(islur(ivx,nnlivx),0)
-        if (charq.eq.'t')
-     *    islur(ivx,nnlivx) = ibset(islur(ivx,nnlivx),1)
-        if (ivx .le. nv) then
-          kv = 1
-        else
-          kv = 2
-        end if
-        if (fontslur) then
-          call sslur(lineq,iccount,iv,kv,nnlivx,isdat1,isdat2,isdat3,
-     *             nsdat,notcrd,nolev(ivx,nnlivx),charq)
-        else
-          call spsslur(lineq,iccount,iv,kv,nnlivx,isdat1,isdat2,isdat3,
-     *             isdat4,nsdat,notcrd,nolev(ivx,nnlivx),charq)
-        end if
-      else if (charq .eq. '?') then
-c
-c  Arpeggio
-c
-        if (btest(ipl(ivx,nnl(ivx)),10)) then
-c
-c  This is a chordal note.  Set a bit in icrdat.  But if *main* (spacing) note
-c  of chord, will not set icrdat(25), but iornq(27)
-c
-          icrdat(ncrd) = ibset(icrdat(ncrd),25)
-        else
-          iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),27)
-        end if
-c
-c  Check for shift
-c
-        call getchar(lineq,iccount,durq)
-        if (durq .eq. ' ') then
-          iccount = iccount-1
-        else
-c
-c  durq must be "-"
-c
-          iccount = iccount+1
-          call readnum(lineq,iccount,durq,fnum)
-          iccount = iccount-1
-c
-c  record the shift
-c
-          NumArpShift = NumArpShift+1
-          IvArpShift(NumArpShift) = ivx
-          IpArpShift(NumArpShift) = nnl(ivx)
-          ArpShift(NumArpShift) = fnum
-        end if
-      else if (index('0123456789#-nx_',charq) .gt. 0) then
-c
-c  We have a figure.  Must come AFTER the note it goes under
-c
-
-        ivf = 1
-        if (ivx .gt. 1) then
-          if (ivxfig2 .eq. 0) then
-            ivxfig2 = ivx
-          else if (ivx .ne. ivxfig2) then
-            print*
-            print*,'Figures not allowed in >1 voice above first'
-            stop
-          end if
-          ivf = 2
-        end if
-        nfig1 = nfigs(ivf)+1
-        call getfig(itoff(ivf,nfig1),charq,lineq,iccount,
-     *             isfig(ivf,nnl(ivx)),itfig(ivf,nfig1),itsofar(ivx),
-     *             nodur(ivx,nnl(ivx)),figq(ivf,nfig1),
-c     *             ivupfig(ivf,nfig1),nfigs(ivf))
-     *             ivupfig(ivf,nfig1),ivvfig(ivf,nfig1),nfigs(ivf))
-      else if (charq .eq. '[') then
-c
-c  Start forced beam.  Record barno & time since start of inp. blk.  Set signal
-c
-        nfb(ivx) = nfb(ivx)+1
-        fbon = .true.
-        ulfbq(ivx,nfb(ivx)) = 'x'
-        t1fb(ivx,nfb(ivx)) = itsofar(ivx)
-        nadj = 0
-        if (autofbon) then
-          autofbon = .false.
-        end if
-17      call getchar(lineq,iccount,charq)
-        if (index('ulf',charq) .gt. 0) then
-          ulfbq(ivx,nfb(ivx)) = charq
-          go to 17
-        else if (charq .eq. 'j') then
-c
-c  Continuing a jumped beam here
-c
-          irest(ivx,nnl(ivx)+1) = ibset(irest(ivx,nnl(ivx)+1),24)
-c
-c  Set flag to watch for END of this forced beam, so can set flag rest(30) on
-c  NEXT note as signal to start a new notes group there.
-c
-          isbj2 = .true.
-          go to 17
-        else if (charq .eq. 'h') then
-          islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),2)
-          go to 17
-        else if (charq .eq. 'm') then
-c
-c  Force multiplicity.  Next input is digit
-c
-          call getchar(lineq,iccount,charq)
-          islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),21)
-          call setbits(islur(ivx,nnl(ivx)+1),3,22,ichar(charq)-48)
-          go to 17
-        else if (charq .eq. ':') then
-c
-c  Start auto forced beam pattern
-c
-          autofbon = .true.
-c
-c  When forced later beam ends, check whether tautofv <=0; if so set it.
-c
-          tautofb = -itsofar(ivx)
-          t1autofb = itsofar(ivx)
-          go to 17
-        else if (charq .ne. ' ') then
-c
-c  Must be '+/-' for height or slope shift
-c
-          nadj = nadj+1
-c
-c  nadj = 1,2, or 3 for normal start level, slope, or beam-thk start level.
-c
-          iccount = iccount+1
-          call readnum(lineq,iccount,durq,fnum)
-          iccount = iccount-1
-          iadj = nint(fnum)
-          if (charq .eq. '-') iadj = -iadj
-          if (nadj .eq. 1) then
-c
-c  This is a level shift.  Note if 0 was entered, iadj = 30
-c
-            call setbits(ipl(ivx,nnl(ivx)+1),6,11,iadj+30)
-          else if (nadj .eq. 2) then
-c
-c  Must be a slope shift
-c
-            call setbits(ipl(ivx,nnl(ivx)+1),6,17,iadj+30)
-          else
-c
-c  Beam-thk fine tune
-c
-            call setbits(islur(ivx,nnl(ivx)+1),2,27,iadj)
-          end if
-          go to 17
-        end if
-      else if (charq .eq. ']') then
-        if (autofbon .and. tautofb.lt.tol) then
-          tautofb=itsofar(ivx)+tautofb
-        end if
-        call getchar(lineq,iccount,charq)
-        if (index('j ',charq) .gt. 0) then
-c
-c  Since ']' comes AFTER note, itsofar has been updated.  Set ending signal.
-c
-          t2fb(ivx,nfb(ivx)) = itsofar(ivx)
-          fbon = .false.
-          if (charq .eq. 'j') 
-     *          irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),23)
-          if (isbj2) then
-c
-c  This is the end of a fb segment of a jump beam.  Set flag on NEXT note to
-c  force start of new notes group, provided this is not last note in bar.
-c
-            if (mod(itsofar(ivx),lenbar) .ne. 0) 
-     *         irest(ivx,nnl(ivx)+1) = ibset(irest(ivx,nnl(ivx)+1),30)
-            isbj2 = .false.
-          end if
-        else if (charq .eq. '[') then
-c
-c  Multiplicity down-up signal
-c
-          islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),20)
-        else if (charq .eq. '-') then
-c
-c  Set signals for gap in single-slope beam [...]-[...]
-c
-          nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),20)
-          nacc(ivx,nnl(ivx)+1) = ibset(nacc(ivx,nnl(ivx)+1),21)
-c
-c  Next two characters must be "[ ".  Skip over them.
-c
-          iccount = iccount+2
-        end if
-      else if (charq .eq. 'D') then
-        call getdyn(ivx,nnl(ivx),irest(ivx,nnl(ivx)),
-     *              iornq(ivx,nnl(ivx)),lineq,iccount)
-      else if (charq .eq. 'h') then
-c
-c  Heading or height.  For heading, only OK if at start of block
-c  Check whether at beginning of a block
-c
-        if (iv.ne.1 .or. nnl(1).ne.0) then
-          print*,'You entered "h" not at beginning of block'
-          call stop1()
-        end if
-        call getchar(lineq,iccount,durq)
-        ihdvrt = 0
-        if (index('+-',durq) .gt. 0) then
-c
-c Vertical offset
-c
-          iccount = iccount+1
-          call readnum(lineq,iccount,charq,fnum)
-          ihdvrt = fnum+.1
-          if (durq .eq. '-') ihdvrt = -ihdvrt
-          durq = charq
-        end if
-        if (durq .ne. ' ') then
-c
-c  Height symbol.  Read past (until next blank)
-c
-3         call getchar(lineq,iccount,durq)
-          if (durq .ne. ' ') go to 3
-        else
-c
-c  Set flag for header & read it in
-c
-          ihdht = 16
-          call getbuf(headrq)
-          iccount = 128
-        end if
-      else if (charq .eq. 'L') then
-c
-c  Linebreak, already handled in pmxa, but check for movement break
-c
-        iccount = iccount+1
-        call readnum(lineq,iccount,durq,fmovbrk)
-        if (durq .eq. 'P') then
-          iccount = iccount+1
-          call readnum(lineq,iccount,durq,fnum)
-        end if
-        if (durq .eq. 'M') then
-          movbrk = nint(fmovbrk)
-          movgap = 0
-          parmov = -1.
-          call getchar(lineq,iccount,durq)
-31        if (durq .eq. '+') then
-c
-c  Get vertical space (\internotes)
-c
-            iccount = iccount+1
-            call readnum(lineq,iccount,durq,fnum)
-            movgap = nint(fnum)
-            go to 31
-          else if (durq .eq. 'i') then
-            iccount = iccount+1
-            call readnum(lineq,iccount,durq,parmov)
-            go to 31
-          else if (durq .eq. 'c') then
-            nobar1 = .true.
-            call getchar(lineq,iccount,durq)
-            go to 31
-          else if (durq .eq. 'r') then
-c
-c  "rename" can be set on or off.
-c
-            call getchar(lineq,iccount,durq)
-            rename = durq.eq.'+'
-            call getchar(lineq,iccount,durq)
-            go to 31
-          else if (durq .eq. 'n') then
-c
-c  Change # of voices.  Input ninow, iiorig(1...ninow).  Will use names,
-c  staves per inst. and clefs  corr. to iiorig in original list of instruments.
-c
-            nvold = nv
-            nv = 0
-            rename = .true.
-            call getchar(lineq,iccount,durq)
-            if (durq .eq. ':') then
-              iccount = iccount+2
-              read(lineq(iccount-1:iccount),'(i2)')ninow
-            else
-              ninow = ichar(durq)-48
-            end if
-            iiv = 0
-            do 63 iinow = 1 , ninow
-              call getchar(lineq,iccount,durq)
-              if (durq .eq. ':') then
-                iccount = iccount+2
-                read(lineq(iccount-1:iccount),'(i2)')iiorig(iinow)
-              else
-                iiorig(iinow) = ichar(durq)-48
-              end if
-              nspern(iinow) = nsperi(iiorig(iinow))
-              nv = nv+nspern(iinow)
-              sepsymq(iiv+nspern(iinow)) = '&'
-              if (nspern(iinow) .gt. 1) then
-                do 64 iis = 1 , nspern(iinow)-1
-                  sepsymq(iiv+iis) = '|'
-64              continue
-              end if
-              iiv = iiv+nspern(iinow)
-63          continue
-c
-c 120818 Per Rainer's suggestion, defer changing \nbinstruments until issuing \newmovement
-c
-c            if (islast) then
-c              if (ninow .lt. 10) then
-c                write(11,'(a)')sq//'newnoi{'//chax(ninow+48)//'}%'
-c              else
-c                write(11,'(a8,i2,a2)')sq//'newnoi{',ninow,'}%'
-c              end if
-c            end if
-            if (nv.eq.1 .and. nvold.gt.1) then
-              if (islast) write(11,'(a)')sq//'nostartrule'
-            else if (nv.gt.1 .and. nvold.eq.1) then
-              if (islast) write(11,'(a)')sq//'startrule'
-            end if
-            iiv = 0
-            do 60 iinow = 1 , ninow
-              do 61 iis = 1 , nspern(iinow)
-                iiv = iiv+1
-c
-c  May not really need to re-enter clefs, but it's easier to program since
-c  clef names are not saved but are needed in newvoice to set ncmidcc.
-c
-                call getchar(lineq,iccount,clefq(iiv))
-                call newvoice(iiv,clefq(iiv),.true.)
-                if (nspern(iinow) .eq. 1) then
-                  hdlndq = chax(48+numclef(clefq(iiv)))
-                  lclf = 1
-                else if (iis .eq. 1) then
-                  hdlndq = '{'//chax(48+numclef(clefq(iiv)))
-                  lclf = 2
-                else if (iis .lt. nspern(iinow)) then
-                  hdlndq = hdlndq(1:lclf)//chax(48+numclef(clefq(iiv)))
-                  lclf = lclf+1
-                else
-                  hdlndq = 
-     *                hdlndq(1:lclf)//chax(48+numclef(clefq(iiv)))//'}'
-                  lclf = lclf+2
-                end if
-61            continue
-c
-c  setstaffs & setclef go by instrument, not voice
-c
-              if (islast) then
-                if (iinow .lt. 10) then
-                  write(11,'(a)')sq//'setstaffs'
-     *              //chax(48+iinow)//chax(48+nspern(iinow))//'%'
-                  write(11,'(a)')sq//'setclef'//chax(48+iinow)
-     *              //hdlndq(1:lclf)//'%'
-                  if (fullsize(iiorig(iinow)).gt.0.9) then
-                    write(11,'(a)')sq//'setsize'//chax(48+iinow)
-     *                  //sq//'normalvalue%'
-c
-c 140526 Account for staff size specs when noinst changes. May be confusion
-c   here if more than one staff per instrument
-c
-                  else if (fullsize(iiorig(iinow)).gt..7) then
-                    write(11,'(a)')sq//'setsize'//chax(48+iinow)
-     *                  //sq//'smallvalue%'
-                  else
-                    write(11,'(a)')sq//'setsize'//chax(48+iinow)
-     *                  //sq//'tinyvalue%'
-                  end if
-                else
-                  write(11,'(a11,i2,a)')sq//'setstaffs{',iinow,
-     *                 '}'//chax(48+nspern(iinow))//'%'
-                  write(11,'(a9,i2,a)')sq//'setclef{',iinow,
-     *                 '}'//hdlndq(1:lclf)//'%'
-                end if
-              end if
-60          continue
-c
-c  Loop back up, this may not be last option in M.  Note flow out if durq=' '
-c
-            call getchar(lineq,iccount,durq)
-            go to 31
-          end if
-c
-c  Write instrument names
-c
-          if (.not.rename) then
-            do 62 iinst = 1 , ninow
-              if (islast) then
-                if (iinst .lt. 10) then
-                  write(11,'(a8,i1,a3)')sq//'setname',iinst,'{}%'
-                else
-                  write(11,'(a9,i2,a4)')sq//'setname{',iinst,'}{}%'
-                end if
-              end if
-62          continue
-          else
-            do 65 iinst = 1 , ninow
-              if (islast) then
-                if (iinst .lt. 10) then
-                  write(11,'(a8,i1,a)')sq//'setname',iinst,'{'//
-     *              inameq(iiorig(iinst))(1:lnam(iiorig(iinst)))//'}%'
-                else
-                  write(11,'(a9,i2,a)')sq//'setname{',iinst,'}{'//
-     *              inameq(iiorig(iinst))(1:lnam(iiorig(iinst)))//'}%'
-                end if
-              end if
-65          continue
-            rename = .false.
-          end if
-        end if
-      else if (charq .eq.'|' ) then
-c
-c  End of bar symbol.  Check about end of bar hardspace.
-c
-        if (btest(iornq(ivx,nnl(ivx)+1),26)) then
-c
-c  There was a hardspace followed by a bar line.  Remove it from the hardspace
-c  list, store with shifts instead, set special bit.  Need to repeat this code
-c  at '/'.
-c
-          irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),18)
-          nudoff(ivx) = nudoff(ivx)+1
-          udoff(ivx,nudoff(ivx)) = udsp(nudsp)
-          nudsp = nudsp-1
-          iornq(ivx,nnl(ivx)+1) = ibclr(iornq(ivx,nnl(ivx)+1),26)
-        end if
-      else if (index('wS',charq) .gt. 0) then
-c
-c  Width symbol or new nsyst.  Read past (until blank)
-c
-4       call getchar(lineq,iccount,durq)
-        if (durq .ne. ' ') go to 4
-      else if (charq .eq. 'l') then
-c
-c  Lower string.  Only OK if at start of block
-c  Check whether at beginning of a block
-c
-        if (iv.ne.1 .or. nnl(1).ne.0) then
-          print*,'You entered "l" not at beginning of block'
-          call stop1()
-        end if
-c
-c  Set flag for lower string & read it in
-c
-        lower = .true.
-        call getbuf(lowerq)
-        iccount = 128
-      else if (charq .eq. 'm') then
-c
-c  Meter change.  Only allow at beginning of block.
-c    mtrnuml, mtrdenl (logical) and p (printable) will be input.
-c    mtrnuml=0 initially. (In common)
-c
-c  Check whether at beginning of a block
-c
-        if (iv.ne.1 .or. nnl(1).ne.0) then
-          print*,'You entered "m" not at beginning of block'
-          call stop1()
-        end if
-        call readmeter(lineq,iccount,mtrnuml,mtrdenl)
-        call readmeter(lineq,iccount,mtrnmp,mtrdnp)
-        lenbeat = ifnodur(mtrdenl,'x')
-        if (mtrdenl .eq. 2) lenbeat = 16
-        lenbar = mtrnuml*lenbeat
-        if (mtrdenl .eq. 2) lenbar = lenbar*2
-        lenb1 = lenbar
-        lenb0 = 0
-        if (ismidi) call midievent('m',mtrnuml,mtrdenl)
-      else if (charq .eq. 'C') then
-c
-c  Clef change on next note.  Set bits 11-15.  Won't allow in 2nd line of music.
-c
-        if (nnl(iv) .gt. 0) ncc(iv) = ncc(iv)+1
-        tcc(iv,ncc(iv)) = itsofar(iv)
-        isl = ibset(islur(iv,nnl(iv)+1),11)
-        call getchar(lineq,iccount,durq)
-c
-c  Store clef number, or 7 if clef number = 9 (French violin clef)
-c
-        isl = ior(isl,ishft(min(numclef(durq),7),12))
-        ncmidcc(iv,ncc(iv)) = ncmidf(durq)
-        if (durq .eq. '8') then
-          ipl(iv,nnl(iv)+1)=ibset(ipl(iv,nnl(iv)+1),2)
-          iTransAmt(instno(iv)) = 7
-        else
-          if (iTransAmt(instno(iv)).eq.7)iTransAmt(instno(iv))=0
-        end if
-c
-c  Set marker on note with lowest voice # starting at same time.
-c
-        if (iv .eq. 1) then
-          isl = ibset(isl,15)
-        else
-          do 13 iiv = 1 , iv
-            nnliiv = nnl(iiv)
-            if (iiv .eq. iv) nnliiv = nnliiv+1
-            itother = 0
-            do 14 iip = 1 , nnliiv
-              if (itother .lt. itsofar(iv)) then
-                itother = itother+nodur(iiv,iip)
-                go to 14
-              else if (itother .eq. itsofar(iv)) then
-                islur(iiv,iip) = ibset(islur(iiv,iip),15)
-                go to 15
-              end if
-14          continue
-13        continue
-15        continue
-        end if
-c
-c  Need 'or' since may have set bit 15 in the above loop
-c
-        islur(iv,nnl(iv)+1) = ior(isl,islur(iv,nnl(iv)+1))
-      else if (charq .eq. 'R') then
-c
-c  Repeats.  set bits 5, 6, and/or 8 of islur(1,ip+1)
-c
-10      call getchar(lineq,iccount,durq)
-c
-c  Save designator in case it's a terminal Rr or Rd
-c
-        if (durq .eq. 'l') then
-          islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),5)
-          go to 10
-        else if (index('rdDbz',durq) .gt. 0) then
-          if (durq .eq. 'r') then
-            islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),6)
-          else if (durq .eq. 'd') then
-            islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),8)
-          else if (durq .eq. 'D') then
-            islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),26)
-          else if (durq .eq. 'b') then
-            islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),25)
-          else if (durq .eq. 'z') then
-c            iornq(1,nnl(1)+1) = ibset(iornq(1,nnl(1)+1),29)
-            ipl(1,nnl(1)+1) = ibset(ipl(1,nnl(1)+1),0)
-          end if
-          rptprev = .true.
-          rptfq1 = durq
-          go to 10
-        end if
-      else if (charq .eq. 'V') then
-c
-c  Ending
-c
-        nnnl = nnl(1)+1
-        lvoltxt = 0
-11      call getchar(lineq,iccount,durq)
-        if (durq.eq.'b' .or. durq .eq.'x') then
-c
-c  End Volta, set bit9, and bit10 on if 'b' (end w/ box)
-c
-          islur(1,nnnl) = ibset(islur(1,nnnl),9)
-          if (durq .eq. 'b') islur(1,nnnl) = ibset(islur(1,nnnl),10)
-          go to 11
-        else if (durq .ne. ' ') then
-c
-c  Start volta; Get text
-c
-          if (lvoltxt .eq. 0) then
-c
-c  First character for text
-c
-            lvoltxt = 1
-            islur(1,nnnl) = ibset(islur(1,nnnl),7)
-            nvolt = nvolt+1
-            voltxtq(nvolt) = durq
-          else
-            voltxtq(nvolt) = voltxtq(nvolt)(1:lvoltxt)//durq
-            lvoltxt = lvoltxt+1
-          end if
-          go to 11
-        end if
-      else if (charq .eq. 'B') then
-        bcspec = .not.bcspec
-      else if (charq .eq. 'P') then
-c
-c  Page numbers.  Print stuff right now.
-c
-        npg1 = 0
-c
-c  Will use ltopnam to signal whether there's a centered heading
-c
-        ltopnam = 0
-        ipg1r = 0
-16      call getchar(lineq,iccount,durq)
-        if (ichar(durq).ge.48 .and. ichar(durq).le.57) then
-          npg1 = npg1*10+ichar(durq)-48
-          go to 16
-        else if (durq .eq. 'l') then
-          if (npg1.eq.0 .or. mod(npg1,2).eq.1) ipg1r = 1
-          go to 16
-        else if (durq .eq. 'r') then
-          if (npg1.gt.0 .and. mod(npg1,2).eq.0) ipg1r = 1
-          go to 16
-        else if (durq .eq. 'c') then
-c
-c  Top-centered name.  Assume this is last option.  Read the name.
-c  May surround name in double quotes (to allow blanks).
-c
-          call getchar(lineq,iccount,durq)
-          if (durq .eq. ' ') then
-            ltopnam = lenstr(cheadq,60)
-          else
-            namstrt = iccount
-            if (durq .eq. '"') then
-c
-c  Using quote delimiters.
-c
-              quoted = .true.
-              namstrt = namstrt+1
-            else
-              quoted = .false.
-            end if
-            do 35 iccount = namstrt+1, 128
-              if ((quoted .and. lineq(iccount:iccount) .eq. '"') .or.
-     *           (.not.quoted .and. lineq(iccount:iccount) .eq. ' '))
-     *            go to 36
-c
-c  On exit, iccount is OK, and name is in (namstrt:iccount-1)
-c
-35          continue
-            print*,'Awww, cmon, should not be here.'
-            call stop1()
-36          continue
-            ltopnam = iccount-namstrt
-            cheadq = lineq(namstrt:iccount-1)
-          end if
-        end if
-c
-c  Done getting data, now assemble the command
-c
-        if (npg1.eq.0) npg1=1
-c
-c  2/23/03 Don't use \atnextline if on first page and only one system
-c
-c        if (ipage.gt.1 .or. nsystp(1).gt.1) then
-          hdlndq = sq//'def'//sq//'atnextline{'//sq//'toppageno{'
-          lhead = 27
-c        else
-c          hdlndq = sq//'toppageno{'
-c          lhead = 11
-c        end if
-        if (npg1 .lt. 10) then
-c
-c  Note we are overwriting the last "{"
-c
-          write(hdlndq(lhead:lhead),'(i1)')npg1
-        else if (npg1 .lt. 100) then
-          lhead = lhead+3
-          write(hdlndq(lhead-2:lhead),'(i2,a1)')npg1,'}'
-        else 
-          lhead = lhead+4
-          write(hdlndq(lhead-3:lhead),'(i3,a1)')npg1,'}'
-        end if
-        hdlndq = hdlndq(1:lhead)//chax(ipg1r+48)//'{'
-        lhead = lhead+2
-c        if (ipage.gt.1 .or. nsystp(1).gt.1) then
-          if (ltopnam .eq. 0) then
-            if (islast) write(11,'(a)')hdlndq(1:lhead)//'}}%'
-          else
-            if (islast)
-     *          write(11,'(a)')hdlndq(1:lhead)//cheadq(1:ltopnam)//'}}%'
-          end if
-c        else
-c          if (ltopnam .eq. 0) then
-c            if (islast) write(11,'(a)')hdlndq(1:lhead)//'}%'
-c          else
-c            if (islast)
-c     *          write(11,'(a)')hdlndq(1:lhead)//cheadq(1:ltopnam)//'}%'
-c          end if
-c        end if
-      else if (charq .eq. 'W') then
-c
-c  Just eat the number that must follow, it was used in pmxa
-c
-        iccount = iccount+1
-        call readnum(lineq,iccount,durq,fnum)
-      else if (charq .eq. 'T') then
-        headlog = .true.
-        inhead = 0
-        call getchar(lineq,iccount,durq)
-        if (durq .eq. 'i') then
-          call getbuf(instrq)
-c
-c  A kluge for parts from separate score file for later movements.
-c
-          if (instrq(1:1) .eq. ' ') headlog = .false.
-          cheadq = instrq(1:60)
-        else if (durq .eq. 't') then
-          call getchar(lineq,iccount,durq)
-c
-c  Optionally can include extra vertical \internotes above inbothd
-c
-          if (index('-+0123456789',durq) .gt. 0) then
-            ipm = 1
-            if (index('+-',durq) .gt. 0) then
-c
-c  Don't trust readnum to round this negative integer properly
-c
-              iccount = iccount+1
-              if (durq .eq. '-') ipm = -1
-            end if
-            call readnum(lineq,iccount,durq,fnum)
-            inhead = ipm*nint(fnum)
-          end if
-          call getbuf(titleq)
-        else
-          call getbuf(compoq)
-        end if
-        inhead = inhead+inbothd
-        iccount = 128
-      else if (charq .eq. 'A') then
-c
-c  Accidental handling etc.
-c
-27      call getchar(lineq,iccount,durq)
-        if (durq .eq. 'r') then
-          if (islast) then
-            relacc = .true.
-            write(11,'(a)')sq//'relativeaccid%'
-          end if
-        else if (durq .eq. 's') then
-          bacfac = 1.e6
-        else if (durq .eq. 'b') then
-          if (islast) write(11,'(a)')sq//'bigaccid%'
-          accfac = bacfac
-        else if (durq .eq. 'a') then
-          call getchar(lineq,iccount,durq)
-          call readnum(lineq,iccount,durq,fnum)
-          iccount = iccount-1
-        else if (durq .eq. 'i') then
-          call getchar(lineq,iccount,durq)
-          call readnum(lineq,iccount,durq,tintstf)
-          if (.not.firstgulp) fintstf = tintstf
-c
-c  Local corrections for first page were handled by pmxa
-c
-          iccount = iccount-1
-        else if (durq .eq. 'I') then
-          call getchar(lineq,iccount,durq)
-          call readnum(lineq,iccount,durq,gintstf)
-          iccount = iccount-1
-        else if (durq .eq. 'd') then
-          lowdot = .true.
-        else if (durq .eq. 'o') then
-          continue
-        else if (durq .eq. 'S') then
-c 130324
-c          do 50 iiv = 1 , nv
-          do 50 iiv = 1 , noinst
-            call getchar(lineq,iccount,durq)
-            if (index('-s',durq) .gt. 0) then
-              fullsize(iiv) = 0.8
-            else if (durq .eq. 't') then
-              fullsize(iiv) = 0.64
-            else
-c              fullsize(ivx) = 1.0
-              fullsize(iiv) = 1.0
-            end if
-50        continue
-        else if (durq .eq. 'e') then
-c
-c  Line-spacing equalization
-c
-          equalize = .true.
-c
-c  The following redefinition of \parskip was put into pmx.tex in version 2.25 or so.
-c    But it causes problems with some older scores and when excerpts are combined
-c    with LaTeX.  So as of 2.352 we write it here.
-c
-          write(11,'(a)')sq//'global'//sq//'parskip 0pt plus 12'//sq
-     *        //'Interligne minus 99'//sq//'Interligne%'
-          tempq = sepsymq(1)
-          lentemp = 1
-          do 51 iiv = 2 , nv-1
-            tempq = tempq(1:lentemp)//sepsymq(iiv)
-            lentemp = lentemp+1
-51        continue
-          write(11,'(a)')sq//'def'//sq//'upstrut{'//sq//'znotes'
-     *         //tempq(1:lentemp)//sq//'zcharnote{'//sq//'upamt}{~}'
-     *         //sq//'en}%'
-        else if (durq .eq. 'v') then
-c
-c  Toggle usevshrink
-c
-          usevshrink = .not.usevshrink
-        else if (durq .eq.'p') then
-c
-c  Postscript slurs. fontslur is already false (set in g1etnote) 
-c
-          if (.not.WrotePsslurDefaults) then
-c
-c  Set postscrirpt slur adjustment defaults
-c 
-            write(11,'(a)')sq//'Nosluradjust'//sq//'Notieadjust'
-     *                       //sq//'nohalfties' 
-            WrotePsslurDefaults = .true.
-          end if
-52        continue
-          call g1etchar(lineq,iccount,durq)  ! might be "+", "-", "h" or "l"
-          if (index('+-',durq) .gt. 0) then
-c
-c  Characters to change defaults for ps slurs
-c
-            call g1etchar(lineq,iccount,charq)  ! charq will be "s,t,h,c"
-            if (durq .eq. '+') then
-              if (charq .eq. 's') then
-                write(11,'(a)')sq//'Sluradjust'
-              else if (charq .eq. 't') then   
-                write(11,'(a)')sq//'Tieadjust'
-              else if (charq .eq. 'h') then
-                write(11,'(a)')sq//'halfties'
-              else
-                SlurCurve = SlurCurve + 1
-                if (SlurCurve .gt. 3.1) then
-                  call printl('WARNING!') 
-                  call printl
-     *            ('Default slur curvature advanced past HH, resetting')
-                  SlurCurve = 3
-                end if
-              end if
-            else
-              if (charq .eq. 's') then
-                write(11,'(a)')sq//'Nosluradjust'
-              else if (charq .eq. 't') then   
-                write(11,'(a)')sq//'Notieadjust'
-              else if (charq .eq. 'h') then
-                write(11,'(a)')sq//'nohalfties'
-              else
-                SlurCurve = SlurCurve - 1
-                if (SlurCurve .lt. -1.1) then
-                  call printl('WARNING!') 
-                  call printl(
-     *          'Default slur curvature decremented below f, resetting')
-                  SlurCurve = -1
-                end if
-              end if
-            end if
-            go to 52  ! Check for another set of default changes
-          else if (durq .eq. 'l') then
-c
-c  Set optional linebreak ties
-c
-            OptLineBreakTies = .true.
-            go to 52
-          else if (durq .eq. 'h') then
-c
-c  Set flag to write header special on every page
-c
-            HeaderSpecial = .true.
-            go to 52
-          else
-            iccount = iccount-1
-          end if
-        else if (durq .eq. 'K') then
-c
-c Toggle keyboard rest placement flag
-c
-          kbdrests = .not.kbdrests
-        else if (durq .eq. 'c') then
-          call g1etchar(lineq,iccount,durq)
-c
-c Just eat the input; it was used in pmxa
-c
-          go to 27
-        end if
-        if (index('NR',durq) .gt. 0) then
-c
-c  Override default part names for scor2prt, or normal include file. 
-c  Just bypass rest of input line
-c
-          iccount = 128
-        else if (durq .ne. ' ') then 
-          go to 27
-        end if         
-      else if (charq .eq. 'K') then
-77      continue
-        call getchar(lineq,iccount,durq)
-        if (durq .eq. 'n') then
-          ignorenats = .true.
-          go to 77
-        end if
-        if (durq .ne. 'i') then
-c
-c Normal, full-score key change and/or transposition
-c
-          num1 = 44-ichar(durq)
-          iccount = iccount+1
-          call readnum(lineq,iccount,durq,fnum)
-          num1 = num1*nint(fnum)
-c
-c  On exit, durq='+','-'.  But only need isig if after start, else done in pmxa
-c
-          iccount = iccount+1
-          call readnum(lineq,iccount,charq,fnum)
-          if (ismidi) then
-            midisig = nint(fnum)
-            if (durq.eq.'-') midisig = -midisig
-c 130317
-            midisig = midisig+idsig
-            call midievent('k',midisig,0)
-            
-          end if 
-c70        continue
-          if (num1 .eq. 0) then
-c
-c  Key change, not transposition.
-c
-            ipl(ivx,nnl(ivx)+1) = ibset(ipl(ivx,nnl(ivx)+1),28)
-            lastisig = isig
-            isig = nint(fnum)
-            if (durq .eq. '-') isig = -isig
-            isig = isig+idsig
-            if (ismidi) call midievent('k',isig,0)
-          else
-c
-c  num1 .ne. 0, so transposition, so must be at beginning.  isig came with K...
-c  but was passed to pmxb through pmxtex.dat.  isig0 comes from setup data
-c  (signature before transposition).  idsig must be added to future key changes.
-c
-            jv = 0
-            do while (jv .lt. nm)
-              jv = jv+1
-              iTransAmt(jv) = num1
-            end do
-            idsig = isig-isig0
-          end if
-        else
-c
-c Instrument specific transposition. 
-c
-          call GetiTransInfo(.false.,ibarcnt,lineq,iccount,
-     *                         ibaroff,nbars,noinst)
-c
-c  The sig parameters will have been set 1st time but that's OK
-c
-        end if
-      else if (charq .eq. '/') then
-        if (btest(iornq(ivx,nnl(ivx)+1),26)) then
-c
-c  There was a hardspace followed by end of block.  Remove it from the hardspace
-c  list, store with shifts instead, set special bit.  This code also at '|'
-c
-          irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),18)
-          nudoff(ivx) = nudoff(ivx)+1
-          udoff(ivx,nudoff(ivx)) = udsp(nudsp)
-          nudsp = nudsp-1
-          iornq(ivx,nnl(ivx)+1) = ibclr(iornq(ivx,nnl(ivx)+1),26)
-        end if
-        call getchar(lineq,iccount,durq)
-c
-c  Save ending note level:
-c
-        if (ivx .le. nv) then
-c
-c  This is the first line of music on this staff.  If previous block had only 1
-c  voice, save last pitch from line 1 of prev. block to line 2, in case a
-c  2nd line is started just below
-c
-          if (.not.was2(iv)) ndlev(iv,2) = ndlev(iv,1)
-          was2(iv) = .false.
-          ndlev(iv,1) = lastlev
-        else
-c
-c  This is the 2nd line of music on this staff.
-c
-          was2(iv) = .true.
-          ndlev(iv,2) = lastlev
-        end if
-        if (durq .eq. ' ' .and. iv.eq.nv) then
-c
-c  End of input block
-c
-          loop = .false.
-        else
-c
-c  Start a new line of music
-c
-          if (lenb0.ne.0 .and. firstgulp) lenbar = lenb0
-          nbars = 0
-          if (durq .eq. ' ') then
-c
-c  New line of music is on next staff
-c
-            iv = iv+1
-            ivx = iv
-          else
-c
-c  durq must be 2nd '/'.  New line of music is on same staff.  Set up for it
-c
-            ivx = nv+1
-            do 23 iiv = 1 , nv
-              if (nvmx(iiv) .eq. 2) ivx = ivx+1
-23          continue
-            nvmx(iv) = 2
-            ivmx(iv,2) = ivx
-            itsofar(ivx) = 0
-            nnl(ivx) = 0
-            nfb(ivx) = 0
-            nudoff(ivx) = 0
-            ndotmv(ivx) = 0
-            do 24 j = 1 , 200
-              irest(ivx,j) = 0
-              islur(ivx,j) = 0
-              nacc(ivx,j) = 0
-              iornq(ivx,j) = 0
-              ipl(ivx,j) = 0
-              mult(ivx,j) = 0
-24          continue
-c
-c  Go back and lower the rests in voice "a" that don't have over-ridden heights
-c
-            do 26 j = 1 , nnl(iv)
-              if (btest(irest(iv,j),0) .and. nolev(iv,j).eq.0)
-     *            nolev(iv,j) = -4
-26          continue
-          end if
-        end if
-        iccount = 128
-      else if (charq .eq. 'X') then
-c
-c  3rd arg is only for termination of group shifts.  Use "max" to avoid zero index, 
-c    which only happens for normal X at block start, and we took special measures to
-c    keep group shifts for crossing block boundaries.  
-c
-        call getx(lineq,iccount,irest(ivx,max(1,nnl(ivx))),
-     *            shifton,wheadpt,iornq(ivx,nnl(ivx)+1),ivx,
-     *            irest(ivx,nnl(ivx)+1),itsofar(ivx),0,0,0,' ',ndoub)
-      else if (charq .eq. 'I') then
-c
-c  Midi controls.  
-c
-c        call getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar,
-        call getmidi(noinst,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar,
-     *               mtrdenl,.false.)
-      else if (charq .eq. 'M') then
-c
-c  Macro action
-c
-        call getchar(lineq,iccount,charq)
-        if (index('RS',charq) .gt. 0) then
-c
-c  Record or save a macro.  Get the number of the macro.
-c
-          call getchar(lineq,iccount,durq)
-          call readnum(lineq,iccount,durq,fnum)
-          macnum = nint(fnum)
-          macuse = ibset(macuse,macnum)
-          if (charq .eq. 'R') then
-            call mrec1(lineq,iccount,ndxm)
-          else
-c
-c  Save (Record but don't activate)
-c
-5           call mrec1(lineq,iccount,ndxm)
-            if (mrecord) then
-              call getbuf(lineq)
-              iccount = 0
-              go to 5
-            end if
-            iccount = iccount+ndxm+1
-          end if
-        else if (charq .eq. 'P') then
-c
-c  Playback the macro
-c
-          call getchar(lineq,iccount,charq)
-          call readnum(lineq,iccount,durq,fnum)
-          macnum = nint(fnum)
-          icchold = iccount
-          lnholdq = lineq
-          iccount = 128
-          ilmac = il1mac(macnum)
-          mplay = .true.
-        end if
-      else if (index(',.',charq) .gt. 0) then
-c
-c  Continued rhythmic shortcut
-c
-        idotform = index('. ,',charq)
-        if (idotform .eq. 1) then
-c
-c  Check for start of forced beam on 2nd member of dotform=1 shortcut
-c
-          if (fbon) then
-            if (t1fb(ivx,nfb(ivx)).eq.itsofar(ivx)) 
-     *            t1fb(ivx,nfb(ivx)) = 
-     *                t1fb(ivx,nfb(ivx))+nodur(ivx,nnl(ivx))/2
-          end if
-c		
-c  Change duration of prior note 
-c
-          itsofar(ivx) = itsofar(ivx)-nodur(ivx,nnl(ivx))
-          nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*3/2 
-          itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx))
-        end if
-        idotform = idotform+1
-        numnum = 1
-        cdot = .true.
-        go to 1
-      end if
-      return
-      end
-      subroutine getorn(lineq,iccount,iornq,iornq0,ornrpt,noffseg,
-     *                  ip,ivx,noxtup,notcrd,nole)
-c
-c  iornq: Main note.  Do not alter if chord note, except turn on bit 23
-c  iornq0: Store iorni + bit 23, in case of repeated ornaments
-c  iorni: Internal use, 1st 21 bits of iornq or icrdorn, dep. on notcrd.
-c  noffseg: horiz. offset for segno
-c  nole: level of note w/ orn, used to ID the note/orn if there's a level shift.
-c							
-
-      common /comivxudorn/ivxudorn(63)
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      common /comcb/ nbc,ibcdata(36)
-      character*1 charq,durq
-      character*128 lineq
-      logical ornrpt,negseg,noxtup,notcrd
-c
-c  Bits 0-13: (stmgx+Tupf._), 14: Down fermata, was F, 15: Trill w/o "tr", was U
-c  16-18 Editorial sharp, flat, natural "oes,f,n"; 19-20: >^, 21 ? for ed. accid.
-c
-      call getchar(lineq,iccount,charq)
-      if (index('bc',charq) .gt. 0) then
-c
-c  caesura or breath, handle specially and exit. Set up data in ibcdata(1...nbc)
-c      ivx(0-3,28), ip(4-12),
-c      vshift (vshift+32 in bits 13-18),
-c      hshift (nint(10*vshift)+128 in bits 19-26)
-c      bit 27 = 0 if caesura, 1 if breath
-c      bit 28: 5th bit of ivx 
-c
-        iornq = ibset(iornq,28)
-        nbc = nbc+1
-c        ibcdata(nbc) = ivx+16*ip
-        ibcdata(nbc) = mod(ivx,16)+16*ip
-        if (ivx.ge.16) ibcdata(nbc) = ibset(ibcdata(nbc),28)
-        if (charq .eq. 'b') ibcdata(nbc) = ibset(ibcdata(nbc),27)
-        call getchar(lineq,iccount,durq)
-        if (index('+-',durq) .gt. 0) then
-c
-c  We have a vertical shift, get it
-c
-          iccount = iccount+1
-          call readnum(lineq,iccount,charq,fnum)
-          if (durq .eq. '-') fnum=-fnum
-          call setbits(ibcdata(nbc),6,13,nint(32+fnum))
-          if (index('+-',charq) .gt. 0) then
-c
-c  Horizontal shift, get it
-c
-            iccount = iccount+1
-            call readnum(lineq,iccount,durq,fnum)
-            if (charq .eq. '-') fnum=-fnum
-            call setbits(ibcdata(nbc),8,19,nint(10*fnum)+128)
-          end if
-        end if
-        return
-      end if
-c
-c  Set signal on main note that some note at this time has ornament.  ONLY used
-c  in beamstrt to activate further tests for whether ihornb is needed.
-c
-      iornq = ibset(iornq,23)
-c
-c  Isolate 21 bits defining exisiting ornaments
-c
-      if (notcrd) then
-c        iorni = iand(4194303,iornq)
-c        iorni = iand(541065215,iornq)
-        iorni = iand(1614807039,iornq)
-      else
-        iorni = iand(4194303,icrdorn(ncrd))
-      end if
-c      korn = index('stmgx+Tupf._)e:XXX>^',charq)
-      korn = index('stmgx+Tupf._)e:XXX>^XXXXXXXXCG',charq)
-      if (korn .ne. 15) iorni = ibset(iorni,korn)
-c
-c  Note that korn=0 => charq='(', and we set bit 0.  if "e" (14), alter later
-c    as follows: korn=16-18 for sfn, and or 21 for bare ?.
-c  When this if-block is done, korn will = bit# of actual ornament (unless "?").
-c
-      if (korn .eq. 15) then
-c
-cc  Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-20 prev iornq
-cc  Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-21 prev iornq
-c  Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-21,29 prev iornq
-c
-c        iorni = ior(iorni,iand(iornq0,1638383))
-c        iorni = ior(iorni,iand(iornq0,3735535))
-c        iorni = ior(iorni,iand(iornq0,540606447))
-        iorni = ior(iorni,iand(iornq0,1614348271))
-        ornrpt = .false.
-        call getchar(lineq,iccount,durq)
-c
-c  durq will be ' '
-c
-      else if (korn .eq. 14) then
-c
-c  Editorial accidental
-c
-        call getchar(lineq,iccount,durq)
-c        korn = 15+index('sfn',durq)
-        korn = 15+index('sfn?',durq)
-        if (korn .eq. 19) korn=21
-        iorni = ibset(ibclr(iorni,14),korn)
-        call getchar(lineq,iccount,durq)
-        if (durq .eq. '?') then
-c
-c  This is "oe[s|f|n]?".  Set 21st bit also.
-c
-          iorni = ibset(iorni,21)
-          korn = korn+6
-          call getchar(lineq,iccount,durq)
-        end if
-c        iorni = ibset(ibclr(iorni,14),korn)
-      else if (korn.eq.4 .and. noxtup) then
-c
-c  segno. Check in pmxa for just 1/block & notcrd.  Get horiz. offset in points
-c
-        noffseg = 0
-        negseg = .false.
-        call getchar(lineq,iccount,durq)
-        if (durq .ne. ' ') then
-c
-c  Segno shift is specified
-c
-          if (durq .eq. '-') then
-            negseg = .true.
-            call getchar(lineq,iccount,durq)
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          noffseg = int(fnum)
-          if (negseg) noffseg = -noffseg
-        end if
-      else if (korn .eq. 7) then
-c
-c  Trill.  Check in pmxa for notcrd.  Default is 1 noteskip long, with "tr"
-c
-        ntrill = ntrill + 1
-        ivtrill(ntrill) = ivx
-        iptrill(ntrill) = ip
-        xnsktr(ntrill) = 1.
-        call getchar(lineq,iccount,durq)
-        if (durq .eq. 't') then
-c
-c  Convert to new internal symbol for non-'"tr" trill
-c
-          korn = 15
-          iorni = ibset(ibclr(iorni,7),15)
-          call getchar(lineq,iccount,durq)
-        end if
-        if (index('0123456789.',durq) .gt. 0) then
-c
-c  We have a number for the length
-c
-          call readnum(lineq,iccount,durq,xnsktr(ntrill))
-        end if
-      else if (korn.eq.10 .and. noxtup) then
-c
-c  Fermata
-c
-        call getchar(lineq,iccount,durq)
-        if (durq .eq. 'd') then
-          korn = 14
-          iorni = ibset(ibclr(iorni,10),14)
-          call getchar(lineq,iccount,durq)
-        end if
-      else
-        call getchar(lineq,iccount,durq)
-      end if
-      if (index('+- :',durq) .eq. 0) then
-        print*,'Unexpected character at end of ornament: ',durq
-        call stop1()
-      end if
-      if (index('+-',durq) .gt. 0) then
-c
-c  Shift ornament up or down
-c
-        nudorn = nudorn+1
-c
-c  Set bit 25 in iorni as a signal.  This may not really be necessary.
-c
-        iorni = ibset(iorni,25)
-c
-c  Assemble info to put in kudorn(nudorn) Bits 0-7:ip, 8-11:ivx, 12-18:nolev,
-c     19-24: type of ornament to be shifted, 25-30: shift+32, 31:h-shft present
-c
-        xofforn = 44-ichar(durq)
-        iccount = iccount+1
-        call readnum(lineq,iccount,durq,fnum)
-        iofforn = nint(xofforn*fnum)
-        kudorn(nudorn) = ip+ishft(mod(ivx,16),8)+ishft(nole,12)
-     *        +ishft(korn,19)+ishft(iofforn+32,25)
-        ivxudorn(nudorn) = ivx
-        if (index('+-',durq) .gt. 0) then
-c
-c  Horizontal shift
-c
-          kudorn(nudorn) = ibset(kudorn(nudorn),31)
-          xofforn = 44-ichar(durq)
-          iccount = iccount+1
-          call readnum(lineq,iccount,durq,fnum)
-c 141226         ornhshft(nudorn) = nint(xofforn*fnum)
-          ornhshft(nudorn) = xofforn*fnum
-        end if
-      else if (durq .eq. ':') then
-c
-c  Turn on repeated ornaments
-c
-        ornrpt = .true.
-c
-c  Save the ornament value just set
-c
-        iornq0 = iorni
-      end if
-      if (notcrd) then
-        iornq = ior(iornq,iorni)
-      else
-        icrdorn(ncrd) = ior(icrdorn(ncrd),iorni)
-      end if
-      return
-      end
-      subroutine getpmxmod(global,includeq)
-c
-c  If global=.true., checks for environment variable with path to pmx.mod. 
-c    Then, if variable exists and points to pmx.mod, insert lines from 
-c    pmx.mod into buffer
-c  If global=.false., checks for existence of includeq and uses it.
-c
-c  lenbuf0 = total length of bufq on entry
-c  lbuf(i) = length of line (i)
-c  nlbuf = number of lines stored in bufq 
-c  ilbuf = index of first line after setup stuff (on entry). In general, index of 
-c          next line to be sucked from buffer.
-c  ilbufmod = counter for lines in pmx.mod as they are grabbed.
-c             Starts at ilbuf. Points to position of next line after 
-c             pmx.mod stuff in bufq on exiting loop 1 
-c  ilbuff = transient counter for shifting operations
-c  ipbuf = on entry, points to last character in setup stuff. In general, points
-c          to last character of most recent line sucked from buffer.
-c  ipbufmod = points to last character of most recent inserted line
-c             from pmx.mod
-c
-      parameter (maxblks=4000,nm=24)
-      common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
-     *     fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
-      logical lastchar,fbon,issegno,isheadr,isvolt
-      character*(*)includeq
-      character*80 pmxmoddirq
-      character*128 lnholdq
-      character*65536 bufq
-      integer*2 lbuf(maxblks)
-      common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
-      logical fexist,global
-      line1pmxmod = ilbuf
-      if (.not.global) then
-        inquire(file=includeq,EXIST=fexist)
-c
-c  Transfer includeq to temporary char variable with known length
-c
-        pmxmoddirq = includeq
-        lpmxmoddirq = lenstr(pmxmoddirq,80)
-        print*
-        write(15,'()')
-        if (.not.fexist) then
-          call printl('Could not find '//pmxmoddirq(1:lpmxmoddirq)
-     *           //', checking further.')
-c
-c  File named includeq doesn't not exist. Get directory from PMXMODDIR and
-c    see if it's there
-c
-          call getenv('PMXMODDIR',pmxmoddirq)
-          lpmxmoddirq = lenstr(pmxmoddirq,80)
-          if (lpmxmoddirq. gt. 0) then
-            pmxmoddirq = pmxmoddirq(1:lpmxmoddirq)//includeq
-            lpmxmoddirq = lenstr(pmxmoddirq,80)
-          else
-            call printl(
-     *            'No other directory defined by PMXMODDIR, stopping')
-            call stop1()
-          end if
-          inquire(file=pmxmoddirq,EXIST=fexist)
-          if (.not.fexist) then
-            call printl('Could not find '//pmxmoddirq(1:lpmxmoddirq)
-     *           //', stopping.')
-            call stop1()
-          end if
-        end if
-        call printl('Opening normal include file '
-     *                 //pmxmoddirq(1:lpmxmoddirq))
-        open(18,file=pmxmoddirq)
-      else
-c
-c  Check for existence of pmx.mod
-c
-        call getenv('PMXMODDIR',pmxmoddirq)
-        lpmxmoddirq = lenstr(pmxmoddirq,80)
-        if (lpmxmoddirq .eq. 0) return
-        pmxmoddirq = pmxmoddirq(1:lpmxmoddirq)//'pmx.mod'
-        lpmxmoddirq = lpmxmoddirq+7
-        inquire(file=pmxmoddirq,EXIST=fexist)
-        if (.not.fexist) return
-        call printl('Opening global include file '
-     *               //pmxmoddirq(1:lpmxmoddirq))
-        open(18,file=pmxmoddirq(1:lpmxmoddirq))
-      end if
-      call printl('Adding include data')
-c
-c  Read lines in from pmx.mod one at a time
-c
-      ipbufmod = ipbuf
-      lenbufmod = lenbuf0
-      do 1 ilbufmod = ilbuf , maxblks
-        read(18,'(a)',end=3)lnholdq
-c
-c  A line was read. Slide all existing lengths from here forward ahead by 1
-c
-        do 2 ilbuff = nlbuf , ilbufmod , -1 
-          lbuf(ilbuff+1) = lbuf(ilbuff)
-2       continue
-c
-c  Get length of line from include file
-c
-        lenmodline = lenstr(lnholdq,128)
-        if (lenmodline .eq. 0) then
-c
-c  Blank line.  Make it a single blank with length 1
-c
-          lenmodline = 1
-          lnholdq = ' '
-        end if
-        lbuf(ilbufmod) = lenmodline
-        call printl(lnholdq(1:lenmodline))
-c
-c  Insert new stuff into bufq
-c
-        bufq = bufq(1:ipbufmod)//lnholdq(1:lenmodline)//
-     *           bufq(ipbufmod+1:lenbufmod)
-c
-c  Update internal parameters
-c
-        ipbufmod = ipbufmod+lbuf(ilbufmod)
-        lenbufmod = lenbufmod+lbuf(ilbufmod)
-        nlbuf = nlbuf+1
-1     continue
-3     continue
-      call printl('Closing '//pmxmoddirq(1:lpmxmoddirq))
-      close(18)        
-      linesinpmxmod = linesinpmxmod+ilbufmod-ilbuf
-      lenbuf0 = lenbufmod
-c
-c  Fix Andre's error reporting problem 101211 leading to log(neg#) due
-c  to nline being 2 bigger than it should be
-c
-      nline=nline-2
-c
-      return 
-      end
-      subroutine getset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp,
-     *    xmtrnum0,npages,nsyst,musicsize,fracindent,istype0,
-     *    inameq,clefq,sepsymq,pathnameq,lpath,isig0)
-      parameter (nm=24)
-      common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm)
-      character*1 clefq(nm),sepsymq(nm)
-      character*40 pathnameq
-      character*79 inameq(nm)
-      character*128 lineq
-      logical istype0,newway,rename
-      common /commidisig/ midisig
-c
-c  Get the first line
-c
-      iccount = 0
-9     call getbuf(lineq)
-      if (lineq(1:1) .eq. '%') go to 9
-      istype0 = lineq(1:3).eq.'---'
-      if (istype0) then
-c
-c  Have TeX input until next line that starts with '---'.  Save in scratch.
-c
-        open(17,status='SCRATCH')
-3       call getbuf(lineq)
-        if (lineq(1:3) .ne. '---') then
-          write(17,'(a)')lineq
-          go to 3
-        end if
-c
-c  Force a new line read on first call to readin
-c
-        iccount = 128
-      end if
-c
-c  Here, lineq is first line w/ numerical setup data.
-c
-      nv = nint(readin(lineq,iccount,nline))
-      noinst = nint(readin(lineq,iccount,nline))
-      newway = noinst.le.0
-      if (newway) noinst = -noinst
-      do 2 iinst = 1 , noinst
-c
-c  Seve # of staves per inst in case later drop some inst's.
-c
-        if (newway) then
-c
-c  Read in nvi for each instrument
-c
-          nsperi(iinst) = nint(readin(lineq,iccount,nline))
-        else if (iinst .gt. 1 ) then
-          nsperi(iinst) = 1
-        else
-          nsperi(iinst) = nv-noinst+1
-        end if
-        iiorig(iinst) = iinst
-        nspern(iinst) = nsperi(iinst)
-2     continue
-      mtrnuml = nint(readin(lineq,iccount,nline))
-      mtrdenl = nint(readin(lineq,iccount,nline))
-cc
-cc  Kluge to make mtrdenl work
-cc
-c      if (mtrdenl .eq. 1) then
-c        mtrdenl = 2
-c        mtrnuml = mtrnuml*2
-c      end if
-      mtrnmp = nint(readin(lineq,iccount,nline))
-      mtrdnp = nint(readin(lineq,iccount,nline))
-      xmtrnum0 = readin(lineq,iccount,nline)
-c
-c  Original key sig (before any trnasposition) in next position.  Transposed
-c  sig for topfile was transferred thru pmxtex.dat.  Need isig0 for key
-c  changes if transposed.
-c
-      isig0 = nint(readin(lineq,iccount,nline))
-c 130316
-c      do 11 iinst = 1 , noinst
-c        midisig(iinst) = isig0
-        midisig = isig0
-c11    continue
-      npages = nint(readin(lineq,iccount,nline))
-      nsyst = nint(readin(lineq,iccount,nline))
-      musicsize = nint(readin(lineq,iccount,nline))
-      fracindent = readin(lineq,iccount,nline)
-c
-c  Next noinst non-comment lines are names of instruments.
-c
-      do 4 i = 1 , noinst
-5       call getbuf(inameq(i))
-        if (inameq(i)(1:1) .eq. '%') go to 5
-4     continue
-c
-c  Next non-comment line has nv clef names
-c
-6     call getbuf(lineq)
-      if (lineq(1:1) .eq. '%') go to 6
-      iv = 0
-      nvsofar = 0
-      do 1 jinst = 1 , noinst
-        nvsofar = nvsofar+nsperi(jinst)
-        do 10 ivi = 1 , nsperi(jinst)
-          iv = iv+1
-          clefq(iv) = lineq(iv:iv)
-          if (iv .eq. nvsofar) then
-            sepsymq(iv) = '&'
-          else
-            sepsymq(iv) = '|'
-          end if
-10      continue
-1     continue
-c
-c  Mext non-comment line has path name
-c
-8     call getbuf(pathnameq)
-      if (pathnameq(1:1) .eq. '%') go to 8
-      lpath = index(pathnameq,' ')-1
-c
-c 160130 Replace '\' by '/'
-c
-12    ipos = index(pathnameq,'\\')
-      if (ipos .gt. 0) then
-        pathnameq(ipos:ipos)='/'
-        print*,'Changed pathname to ',pathnameq(1:lpath)
-        go to 12
-      end if
-      return
-      end
-      function getsquez(n,ntot,space,tnote,to)
-      real*4 tnote(600),to(600)
-      common /comtol/ tol
-c
-c  Get the squez factor by checking space against tgovern=minimum duration
-c    of all notes sounding at time of n-th note in the list.  
-c  The starting time of base increment is to(n) and ending time is to(n)+space
-c  Sounding notes are those that start at or before to(n) .and. end at or
-c    after tend=to(n)+space
-c  Since notes are ordered by increasing start times, as soon as we find one 
-c    that starts too late, we are done checking.
-c  
-      tgovern = 1000.
-      tend = to(n)+space
-      do 1 in = 1 , ntot
-c
-c  Since to() is ordered by start times, exit loop after first note that 
-c    starts later than note of interest.
-c
-        if (to(in) .gt. to(n)+tol) go to 2
-        if (to(in)+tnote(in) .gt. tend-tol) then
-c
-c  If here, this note overlaps and must be tested.  
-c
-          tgovern = min(tgovern,tnote(in))
-        end if
-1     continue
-2     continue
-      getsquez = space/tgovern
-      return
-      end
-      subroutine getx(lineq,iccount,irest,shifton,wheadpt,iornq1,ivx,
-     *                     irest1,itsofar,ntup,itup,nnodur,dotq,ndoub)
-      parameter(nm=24)
-c
-c  Parse "X" commands.  Ignore all "B"; "P" means to ignore whole symbol.
-c  In scor2prt, must strip out "P", copy only "B" and "P"-type "X"-symbols.
-c  Since during getnote phase time is integer itsofar, which is not updated 
-c    during xtups, we use itup and ntup to get actual time.  On entry, ntup=0 if
-c    not in xtup.
-c      
-      common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
-      logical shifton,colon,ess,number
-      character*128 lineq
-      character*1 charq,durq,dotq
-      colon = .false.
-      ess = .false.
-      number = .false.
-      nextbl = iccount+index(lineq(iccount:128),' ')-1
-      if (index(lineq(iccount:nextbl),'P') .gt. 0) then
-c
-c  "Parts only", ignore entire symbol
-c
-        iccount = nextbl
-        return
-      end if
-1     call getchar(lineq,iccount,charq)
-      if (charq.eq.'B') then
-c
-c  "Both parts and score," ignore character
-c
-        go to 1
-      else if (charq .eq. ':') then
-        colon = .true.
-        go to 1
-      else if (charq .eq. 'S') then
-        ess = .true.
-        go to 1
-      else if (index('+-.0123456789',charq) .gt. 0) then
-        number = .true.
-        if (charq.eq.'-') iccount = iccount+1
-        call readnum(lineq,iccount,durq,fnum)
-        if (charq .eq. '-') fnum = -fnum
-        if (durq .ne. 'p') then
-          fnum = fnum*wheadpt
-          iccount = iccount-1
-        end if
-        go to 1
-      end if
-c
-c  charq must be blank, so done parsing
-c
-      if (.not.ess .and. .not.colon) then
-c
-c  Ordinary hardspace.  Goes before next note.
-c   (Later, at "|" or "/", check for presence and switch to udoff if there!)
-c
-        nudsp = nudsp+1
-        iornq1 = ibset(iornq1,26)
-        udsp(nudsp) = fnum
-        tudsp(nudsp) = itsofar
-        if (ntup .gt. 0) tudsp(nudsp) = tudsp(nudsp)
-c     *                       +float(itup-1)/ntup*ifnodur(nnodur,dotq)
-     *         +float(itup-1+ndoub)/ntup*ifnodur(nnodur,dotq)
-      else if (.not.number) then
-c
-c  Must be "X:"  End a group offset.
-c
-        irest = ibset(irest,17)
-        shifton = .false.
-        return
-      else
-c
-c  Only other possibility is start offset, "S" for single, ':' for multiple
-c
-        nudoff(ivx) = nudoff(ivx)+1
-        udoff(ivx,nudoff(ivx)) = fnum
-        if (ess) then
-          irest1 = ibset(irest1,15)
-        else
-          irest1 = ibset(irest1,16)
-          shifton = .true.
-        end if
-      end if
-      return
-      end
-      function i1fnodur(idur,dotq)
-        character*1 dotq
-        if (idur .eq. 6) then
-          i1fnodur=1
-        else if (idur .eq. 3) then
-          i1fnodur=2
-        else if (idur .eq. 1) then
-          i1fnodur=4
-        else if (idur .eq. 8) then
-          i1fnodur=8
-        else if (idur .eq. 4) then
-          i1fnodur=16
-        else if (idur .eq. 2) then
-          i1fnodur=32
-        else if (idur .eq. 0) then
-          i1fnodur=64
-        else if (idur .eq. 16) then
-c
-c  Only used for denominator of time signatures, not for notes
-c
-          i1fnodur=4
-        else if (idur .eq. 9) then
-          i1fnodur = 128
-        else
-          print*
-          print*,'You entered an invalid note-length value:',idur
-          call stop1()
-        end if
-        if (dotq .eq. 'd') i1fnodur = i1fnodur*3/2
-      return
-      end
-c      integer*4 function longi(ishort)
-c      integer*2 ishort
-c      longi = ishort
-c      return
-c      end
-      function iashft(nacc)
-      integer*4 ias(6)
-      data ias /-1,1,0,0,-2,2/
-      iashft = ias(nacc)
-      return
-      end
-      function ifnodur(idur,dotq)
-        character*1 dotq
-        if (idur .eq. 6) then
-          ifnodur=1
-        else if (idur .eq. 3)then
-          ifnodur=2
-        else if(idur .eq. 1) then
-          ifnodur=4
-        else if(idur .eq. 8) then
-          ifnodur=8
-        else if(idur .eq. 4) then
-          ifnodur=16
-        else if(idur .eq. 2) then
-          ifnodur=32
-        else if(idur .eq. 0) then
-          ifnodur=64
-        else if(idur .eq. 9) then
-          ifnodur=128
-        else if (idur .eq. 16) then
-c
-c  Only used for denominator of time signatures, not for notes
-c
-          ifnodur=4
-        else
-          print*,'You entered an invalid note value'
-          stop
-        end if
-        if (dotq .eq. 'd') ifnodur = ifnodur*3/2
-      return
-      end
-      function ifnolev(noq,oct,ntrans)
-        character*1 noq
-        integer oct
-        ifnolev = 7*oct+mod(ichar(noq)-92,7)+1+ntrans
-      return
-      end
-c      subroutine report(nsdat,isdat1,isdat2)
-c      integer*4 isdat1(202),isdat2(202)
-c      write(*,'(a)')
-c     *  ' isd on? iv  kv   ip  id ud1 ud2 ndx ivo iho lev crd lhd rhd'
-c      do 1 isdat = 1 , nsdat
-c        isdata = isdat1(isdat)
-c        ionoff = igetbits(isdata,1,11)
-cc        iv = iand(7,isdata)
-c        iv = igetbits(isdata,5,13)
-c        kv = igetbits(isdata,1,12)+1
-c        ip = igetbits(isdata,8,3)
-c        idcode = igetbits(isdata,7,19)
-c        iud1 = igetbits(isdata,1,26)
-c        iud2 = igetbits(isdata,1,27)
-c        ndxslur = igetbits(isdata,4,28)
-c        isdatb = isdat2(isdat)
-c        ivo = igetbits(isdatb,6,6)-32
-c        iho = igetbits(isdatb,7,12)-64
-c        lev = igetbits(isdatb,7,19)
-c        icrd = igetbits(isdatb,1,0)
-c        lhd = igetbits(isdatb,1,1)
-c        irhd = igetbits(isdatb,7,2)
-c        write(*,'(17i4)')isdat,ionoff,iv,kv,ip,idcode,iud1,iud2,ndxslur,
-c     *                     ivo,iho,lev,icrd,lhd,irhd
-c1     continue
-c      print*
-c      return
-c      end
-      function igetbits(isdata,iwidbit,ishift)
-c
-c  Extracts integer given by iwidbit bits of isdata, shifted by ishift, and
-c  then added to ioff
-c
-      igetbits = iand(2**iwidbit-1,ishft(isdata,-ishift))
-      return
-      end
-      function igetvarlen(mmidi,icm,imidi,nbytes)
-c
-c  Gets variable-length integer starting in mmidi at imidi+1. Returns nbytes.
-c
-      parameter (nm=24,mv=24576)
-      integer*2 mmidi(0:nm,mv)
-      igetvarlen = 0
-      do 1 nbytes = 1 , 4
-        igetvarlen = 128*igetvarlen
-     *               +iand(127,mmidi(icm,imidi+nbytes))
-c     *               +iand(127,longi(mmidi(icm,imidi+nbytes)))
-        if (.not.btest(mmidi(icm,imidi+nbytes),7)) return
-c        if (.not.btest(longi(mmidi(icm,imidi+nbytes)),7)) return
-1     continue
-      print*,'Messup in igetvarlen'
-      call stop1()
-      end
-      logical function isdotted(nodur,ivx,ip)
-      parameter (nm=24)
-c
-c  Function returns true if note is dotted or double-dotted.
-c    Return false for any xtuplet.
-c
-      common /comtol/ tol
-      integer*4 nodur(nm,200)
-      if (nodur(ivx,ip) .eq. 0) then
-        isdotted = .false.
-        return
-      else if (ip .gt. 1) then
-        if (nodur(ivx,ip-1) .eq. 0) then
-          isdotted = .false.
-          return
-        end if
-      end if
-c
-c  Ruled out all xtups, so is dotted or double-dotted if not a power of 2.
-c
-      isdotted = 
-     *    mod(alog(float(nodur(ivx,ip)))/.69314718+.5*tol,1.) .gt. tol
-      return
-      end
-      function isetvarlen(idur,nbytes)
-      isetvarlen = 0
-      itemp = idur
-      do 1 nbytes = 1 , 4
-        isetvarlen = isetvarlen + iand(itemp,127)*256**(nbytes-1)
-        itemp = ishft(itemp,-7)
-        if (itemp .gt. 0) then
-          isetvarlen = isetvarlen+2**(8*nbytes+7)
-        else 
-          return
-        end if
-1     continue
-      print*,'Problem in function isetvarlen'
-      call stop1()
-      end
-      subroutine istring(i,string,len)
-c
-c  Returns string with integer only if length is 1, otherwise enclosed in
-c   brackets.  
-c
-      character*(*) string
-      if (i .ne. 0) then
-        len = alog10(abs(i)*1.0001)+1
-        if (i .lt. 0) len = len+1
-      else
-        string = '0'
-        len = 1
-        return
-      end if
-      if (len .eq. 1) then
-        string = char(48+i)
-      else
-        string = '{'
-        write(string(2:1+len),'(i'//char(48+len)//')')i
-        string = string(1:len+1)//'}'
-        len = len+2
-      end if
-      return
-      end
-      function lenstr(string,n)
-      character*(*) string
-      do 1 lenstr = n , 1 , -1
-        if (string(lenstr:lenstr) .ne. ' ') return
-1     continue
-      lenstr = 0
-      return
-      end
-      function levrn(nolev,irest,iud,ncm,mult)
-c
-c  Used for placing numbers in xtups.  Returns note level if not a rest,
-c  else level of top or bottom of rest symbol opposite beam.  iud=-1 for upstm.
-c
-      logical btest
-      if (.not.btest(irest,0)) then
-        levrn = nolev
-      else
-c
-c  Restlevel is -4, 0, 2 or 100+offset.  First get offset from 1-voice default.
-c
-        if (mult .gt. 0) then
-          if (mult .eq. 2) then
-            ioff = -1+2*iud
-          else if (mult .ne. 4) then
-            ioff = iud*mult
-          else
-            ioff = 1+4*iud
-          end if
-        else
-c
-c  May need to futz with this later for non-beamed xtups (quarter, half rests)
-c
-          ioff = iud*2
-        end if
-        levrn = mod(nolev+20,100)-20+ncm+ioff
-      endif
-      return
-      end
-      function lfmt1(x)
-c
-c  Computes total length of an "f" format with one decimal place.
-c  First round to nearest 0.1
-c
-      if (abs(x) .lt. .001) then
-        lfmt1 = 2
-      else
-        y = sign(.1*int(10*abs(x)+.5),x)
-        lfmt1 = int(log10(1000*abs(y)+.001))
-        if (y .lt. 0) lfmt1 = lfmt1+1
-      end if
-      return
-      end
-      subroutine LineBreakTies(isdat1,isdat2,isdat3,isdat4,nsdat,
-     *                         ispstie,sepsymq)
-      parameter (nm=24)
-      common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
-     *                 ,WrotePsslurDefaults,SlurCurve
-      common /comoct/ noctup
-      integer*4 isdat1(202),isdat2(202),isdat3(202),isdat4(202)
-      logical fontslur,WrotePsslurDefaults,btest,upslur,ispstie,tie
-      character*1 udq,chax,sepsymq(nm)
-      character*8 noteq
-	character*128 notexq
-c
-c  This is called twice from pmxb after having input an entire block, before 
-c    making a bar that starts a new system.  So nsdat reflects all slur starts
-c    and stops in new block, while listslur, which is only set when bars are
-c    made, reflects only open slurs from the old block.  So we must check 
-c    listslur to find open ties, not all nsdat.
-c  First of two calls (ispstie=.false. on entry) terminates tie at end of line.
-c    Second (ispstie=.true. on entry) restarts tie at start of new line. Only
-c    need data from original tie-start for both of these. Tie/slur data from
-c    closing of full tie are not used except for shape alterations.
-c
-c	do 1 ndx = 0 , 11
-	do 1 ndx = 0 , 23
-        if (btest(listslur,ndx)) then
-c
-c  Slur or tie with index ndx is open. Find the one with right ndxb, see if tie
-c
-          do 2 isdat = 1 , nsdat
-c            if (igetbits(isdat1(isdat),4,28) .ne. ndx) go to 2 ! Wrong index
-            if (igetbits(isdat1(isdat),4,28)
-     *         +16*igetbits(isdat1(isdat),1,18) .ne. ndx) go to 2 ! Wrong index
-            if (.not.btest(isdat1(isdat),11)) go to 2 ! Bypass if stop
-            if (btest(isdat2(isdat),3)) go to 3       ! "st"
-            idcode = igetbits(isdat1(isdat),7,19)    
-            if (idcode.eq.1) go to 3                  ! "t" 
-            tie = .false.
-            go to 5
-2         continue
-        end if
-        go to 1
-3       continue
-        tie = .true.
-5       continue
-c
-c  A slur or tie is open, with index ndx
-c
-        iv = igetbits(isdat1(isdat),5,13)
-        kv = igetbits(isdat1(isdat),1,12)+1
-        udq = 'd'
-        if (btest(isdat1(isdat),27)) udq='u'
-        notexq = chax(92)//'znotes'
-        lnote = 7
-        do 4 iiv = 1 , iv-1
-          notexq = notexq(1:lnote)//sepsymq(iiv)
-          lnote = lnote+1
-4       continue
-        if (kv .eq. 2) then
-          notexq = notexq(1:lnote)//chax(92)//'nextvoice'
-          lnote = lnote+10
-        end if          
-c
-c  Compute horiz and vert offsets
-c
-c        nolev = igetbits(isdat2(isdat),7,19)
-        islhgt = igetbits(isdat3(isdat),8,14)
-        ilb12 = 0
-        if (ispstie) ilb12 = 1
-        ivoff = igetbits(isdat4(isdat),6,ilb12*16)-32
-        if (ivoff .eq. -32) ivoff = 0
-C        nolev = nolev+ivoff
-        islhgt = islhgt+ivoff
-        ihoff = (igetbits(isdat4(isdat),7,ilb12*16+6)-64)  ! This is 10X hoff
-        if (ihoff .eq. -64) ihoff = 0
-c
-c  Add starting stuff for command
-c
-        if (.not.ispstie) then                    ! End 1st segment
-          notexq = notexq(1:lnote)//chax(92)//'roffset{'
-          lnote = lnote+9
-c          hoff = ihoff*.1-.5
-c          hoff = ihoff*.1-.8
-          hoff = ihoff*.1-.4
-          if (hoff .lt. 0) then
-            hoff = -hoff
-            notexq = notexq(1:lnote)//'-'
-            lnote = lnote+1
-          end if
-          call writflot(hoff,notexq,lnote)
-          notexq = notexq(1:lnote)//'}{'
-          lnote = lnote+2
-        else
-          notexq = notexq(1:lnote)//chax(92)//'off{-'
-     *              //chax(92)//'afterruleskip}'
-          lnote = lnote+21
-c
-c 091025 add dotting for 2nd segment if needed
-c
-          if (btest(isdat2(isdat),4)) then
-            notexq = chax(92)//'dotted'//notexq(1:lnote)
-            lnote = lnote+7
-          end if  
-        end if
-        if (ispstie .and. tie) then
-          notexq = notexq(1:lnote)//chax(92)//'tieforis'//udq
-          lnote = lnote+10
-        end if
-        if (btest(isdat3(isdat),0)) then
-c
-c  Curvature tweak on termination of 1st seg
-c
-          imid = igetbits(isdat3(isdat),6,2)-32 
-c
-c  Invoke macro (from pmx.tex) that redefines \tslur as r'qd.  mapping:
-c       Abs(imid)  Postscript slur type
-c          1          f
-c          4          h
-c          5          H
-c          6         HH
-c
-          notexq = notexq(1:lnote)//chax(92)//'psforts'//chax(48+imid)
-          lnote = lnote+9
-c
-c  Zero out the flag in case there's a different curv on term of 2nd,
-c
-          isdat3(isdat) = ibclr(isdat3(isdat),0)
-        end if
-c
-c  Add the command name
-c
-        if (ispstie) then
-          notexq = notexq(1:lnote)//chax(92)//'is'//udq
-          lnote = lnote+4
-        else if (tie) then
-          notexq = notexq(1:lnote)//chax(92)//'ttie'
-          lnote = lnote+5
-        else 
-          notexq = notexq(1:lnote)//chax(92)//'tslur'
-          lnote = lnote+6
-        end if
-c
-c  Add index
-c
-c        if (11-ndx .lt. 10) then
-c          notexq = notexq(1:lnote)//chax(59-ndx)
-c          lnote = lnote+1
-c        else
-c          notexq = notexq(1:lnote)//'{1'//chax(49-ndx)//'}'
-c          lnote = lnote+4
-c        end if
-        if (23-ndx .lt. 10) then
-          notexq = notexq(1:lnote)//chax(71-ndx)
-          lnote = lnote+1
-        else if (23-ndx .lt. 20) then
-          notexq = notexq(1:lnote)//'{1'//chax(61-ndx)//'}'
-          lnote = lnote+4
-        else 
-          notexq = notexq(1:lnote)//'{2'//chax(51-ndx)//'}'
-          lnote = lnote+4
-        end if
-        if (ispstie .or. .not.tie) then
-c
-c  Add note name for slur height
-c
-          noctup = 0
-          ncm = igetbits(isdat3(isdat),8,22)
-          if (ncm .eq. 23) noctup = -2
-c          call notefq(noteq,lnoten,nolev,ncm)
-          call notefq(noteq,lnoten,islhgt,ncm)
-          notexq = notexq(1:lnote)//'{'//noteq(1:lnoten)//'}'
-          lnote = lnote+1+lnoten+1
-        end if
-        if (ispstie) then
-c
-c  Horizontal shift start of new thing
-c
-          notexq = notexq(1:lnote)//'{'
-          lnote = lnote+1
-c          ihoff = ihoff-13
-          if (tie) then
-            ihoff = ihoff-12
-          else
-            ihoff = ihoff-7
-          end if
-          if (ihoff .lt. 0) then
-            ihoff = -ihoff
-            notexq = notexq(1:lnote)//'-'
-            lnote = lnote+1
-          end if
-          call writflot(ihoff*.1,notexq,lnote)
-          notexq = notexq(1:lnote)//'}'
-          lnote = lnote+1          
-        end if
-c
-c  Add closing stuff
-c
-        if (ispstie) then
-          notexq = notexq(1:lnote)//chax(92)//'off{'
-     *              //chax(92)//'afterruleskip}'
-          lnote = lnote+20
-        else
-          notexq = notexq(1:lnote)//'}'
-          lnote = lnote+1
-        end if
-        notexq = notexq(1:lnote)//chax(92)//'en%'
-        lnote = lnote+4
-        write(11,'(a)')notexq(1:lnote)
-1     continue
-      ispstie = .not.ispstie
-      return
-      end
-      subroutine littex(islur,nnl,iv,topmods,lineq,iccount)
-      parameter (nm=24)
-      common /comlast/ islast,usevshrink
-      logical islast,usevshrink
-      integer islur(nm,200)
-      logical topmods
-      common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
-     *                nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
-     *                noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
-     *                graspace(37),
-     *                lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
-     *                naccg(74),voltxtq(6),litq(83)
-      logical upg,slurg,slashg,merge
-      character*128 lineq,litq
-      character*20 voltxtq
-      character*1 durq,chax
-      merge = .false.
-      if (nlit .gt. 0) then
-        merge = iv.eq.ivlit(nlit) .and. nnl.eq.iplit(nlit)
-      end if
-      nlit = nlit+1
-      ivlit(nlit) = iv
-      iplit(nlit) = nnl
-      itype = 1
-17    call getchar(lineq,iccount,durq)
-      if (durq .eq. chax(92)) then
-        itype=itype+1
-        go to 17
-      end if
-      litq(nlit) = chax(92)//durq
-      lenlit(nlit) = 2
-18    call getchar(lineq,iccount,durq)
-      if (durq.eq.chax(92)) then
-        call getchar(lineq,iccount,durq)
-        if (durq .ne. ' ') then
-c
-c  Starting a new tex command within the string
-c
-          litq(nlit) = litq(nlit)(1:lenlit(nlit))//chax(92)//durq
-          lenlit(nlit) = lenlit(nlit)+2
-          go to 18
-        end if
-      else
-        litq(nlit) = litq(nlit)(1:lenlit(nlit))//durq
-        lenlit(nlit) = lenlit(nlit)+1
-        go to 18
-      end if
-c
-c  If here, just read backslash-blank so string is done
-c
-      if (itype .eq. 1) then
-        islur(iv,nnl) = ibset(islur(iv,nnl),16)
-        if (merge) then
-c
-c  There are 2 separate strings on the same note, so merge them.
-c
-          nlit = nlit-1
-          litq(nlit) = litq(nlit)(1:lenlit(nlit))
-     *                //litq(nlit+1)(1:lenlit(nlit+1))
-          lenlit(nlit) = lenlit(nlit)+lenlit(nlit+1)
-          if (lenlit(nlit) .gt. 128) then
-            print*
-            print*,
-     *       'Merged type-1 TeX strings longer than 128 characters'
-            write(15,'(/,a)')
-     *       'Merged type-1 TeX strings longer than 128 characters'
-            call stop1()
-          end if  
-        end if
-      else
-c
-c  Type 2 or 3.
-c
-        if (itype .eq. 3) then
-c
-c  Write the string NOW
-c
-          if (islast)
-     *          write(11,'(a)')litq(nlit)(1:lenlit(nlit))//'%'
-        else
-c
-c  Must go at top
-c
-          if (.not.topmods) then
-            topmods = .true.
-            open(16,status='SCRATCH')
-          end if
-c
-c  Must write '%' here rather than later, in case string ends with blank.
-c
-          write(16,'(a)')litq(nlit)(1:lenlit(nlit))//'%'
-        end if
-        nlit = nlit-1
-      end if
-      return
-      end
-      function llen(strq,n)
-        character*129 strq
-        do 1 llen = n , 0 , -1
-          if (strq(llen:llen) .ne. ' ') return
-1       continue
-      end
-      function log2(n)
-c
-c 5/25/08 Modify to allow more slurs
-c
-c        log2 = alog(1.*n)/0.6931472+.0001
-c        log2 = dlog(1.d0*n)/0.693147181d0+.00000001d0
-        log2 = dlog(1.d0*n)/0.693147181d0+.00000002d0
-      return
-      end
-      subroutine logbeam(numnew,nip1,nip2)
-      parameter (nm=24)
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb,
-     *               tautofb,autofbon,t1autofb
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      character*1 ulq,sepsymq,sq,ulfq,ulfbq
-      logical beamon,firstgulp,figbass,figchk,isfig,isxtup,btest,
-     *        autofbon
-      ibm1(ivx,numnew) = nip1
-      ibm2(ivx,numnew) = nip2
-      numnow = numnew
-      if (numnew .gt. 1) then
-c
-c  If it starts before any others, must put it in order
-c
-        do 11 ib = numnew-1 , 1 , -1
-          if (ibm1(ivx,ib) .lt. nip1) go to 12
-          ibm1(ivx,ib+1) = ibm1(ivx,ib)
-          ibm2(ivx,ib+1) = ibm2(ivx,ib)
-          ulq(ivx,ib+1) = ulq(ivx,ib)
-          ibm1(ivx,ib) = nip1
-          ibm2(ivx,ib) = nip2
-          numnow = ib
-11      continue
-12      continue
-      end if
-      sum = 0.
-c
-c Beam has non-xtup within
-c
-      nrests = 0
-      isxtup = .false.
-      do 9 iip = nip1 , nip2
-        if (btest(islur(ivx,nip1),21)) then
-c
-c  Forced multiplicity
-c
-c          mult(ivx,iip) = igetbits(islur(ivx,nip1),3,22)
-          call setbits(mult(ivx,iip),4,0,
-     *                      igetbits(islur(ivx,nip1),3,22)+8)
-        else if (.not.isxtup) then
-          if (nodur(ivx,iip) .gt. 0) then
-c            mult(ivx,iip) = 4-log2(nodur(ivx,iip))
-            call setbits(mult(ivx,iip),4,0,4-log2(nodur(ivx,iip))+8)
-          else
-c
-c  Start xtup within forced beam
-c
-            isxtup = .true.
-            iip1 = iip
-          end if
-        else if (isxtup .and. nodur(ivx,iip).gt.0) then
-c
-c  End of xtup within forced beam.  Must count doubled notes
-c
-          ndoub = 0
-          do 1 iiip = iip1 , iip
-            if (btest(nacc(ivx,iiip),18)) ndoub = ndoub+1
-1         continue
-          multx = int(10.5+2.929+(0.952*alog(1.+iip-iip1+ndoub)-
-     *                   alog(nodur(ivx,iip)/2.))/0.69315)-10
-          do 74 iiip = iip1 , iip
-c            mult(ivx,iiip) = multx
-            call setbits(mult(ivx,iiip),4,0,multx+8)
-c
-c  Note the following still works after making mult only the 1st 4 bits.
-c
-            if (btest(nacc(ivx,iiip),18)) 
-     *        mult(ivx,iiip) = mult(ivx,iiip)-1
-            if (btest(nacc(ivx,iiip),19)) then 
-              mult(ivx,iiip) = mult(ivx,iiip)+1
-            else if (iiip .gt. 1) then
-              if (btest(nacc(ivx,iiip-1),19))
-     *                mult(ivx,iiip) = mult(ivx,iiip)+1
-            end if  
-74        continue
-          isxtup = .false.
-        end if
-        if (btest(irest(ivx,iip),0)) then
-          nrests = nrests+1
-        else
-          sum = sum+nolev(ivx,iip)
-        end if
-9     continue
-c
-c  Set beam up-down-ness
-c
-      if (ifb.gt.0 .and. ulfbq(ivx,max(1,ifb)).ne.'x') then
-        if (ulfbq(ivx,ifb) .eq. 'f') then
-c
-c  Get default, then trade "l" and "u"
-c
-          ulq(ivx,numnow) = char(225-ichar(
-     *      ulfq(sum/(nip2-nip1+1-nrests),ncmid(iv,nip1))))
-        else
-          ulq(ivx,ifb) = ulfbq(ivx,ifb)
-        end if
-c
-c  This probably works only because forced beams are done first, so they
-c  don't have to be re-sorted within each voice. ????
-c
-      else if (nvmx(iv) .eq. 2) then
-c
-c  Multi-voice per staff
-c
-        if (ivx .le. nv) then
-          ulq(ivx,numnow) = 'l'
-        else
-          ulq(ivx,numnow) = 'u'
-        end if
-      else
-c
-c  Defaults
-c
-        ulq(ivx,numnow) =
-     *      ulfq(sum/(nip2-nip1+1-nrests),ncmid(iv,nip1))
-      end if
-      return
-      end
-      subroutine m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm)
-c
-c  This is called when (a) macro recording is just starting and
-c  (b) at the start of a new line, if recording is on
-c
-      parameter (maxblks=4000)
-      character*128 lineq,lnholdq
-      common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
-      common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20),
-     *                 ic1mac(20),ilmac,iplmac
-      logical mrecord,mplay,endmac
-      character*65536 bufq
-      integer*2 lbuf(maxblks)
-      common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
-	lbuf(1) = lbuf(1)
-      if (.not.mrecord) then
-c
-c  Starting the macro
-c
-        ip1mac(macnum) = ipbuf-lbuf(ilbuf-1)+iccount
-        il1mac(macnum) = ilbuf-1
-        ic1mac(macnum) = iccount
-        mrecord = .true.
-      end if
-      if (iccount .lt. 128) then
-        ndxm = index(lineq(iccount+1:128),'M')
-        if (ndxm .gt. 0) ndxm = ntindex(lineq(iccount+1:128),'M',
-     *                                  128-iccount)
-        if (ndxm .gt. 0) then
-c
-c  This line ends the macro.
-c
-          if (lineq(iccount+ndxm+1:iccount+ndxm+1) .ne. ' ') then
-            call errmsg(lineq,iccount+ndxm+1,ibarcnt-ibaroff+nbars+1,
-     *           'Improper macro termination!')
-            call stop1()
-          end if
-          ip2mac(macnum) = ipbuf-lbuf(ilbuf-1)+iccount+ndxm
-          il2mac(macnum) = ilbuf-1
-          mrecord = .false.
-        end if
-      end if
-      return
-      end
-      subroutine make1bar(ibmrep,tglp1,tstart,cwrest,squez,
-     *    istop,numbms,istart)
-      parameter (nm=24,mv=24576)
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      common /comipl2/ ipl2(nm,200)
-      character*10 figq
-      character*1 ulq,sepsymq,sq
-      logical beamon,firstgulp,figbass,figchk,isfig,bar1syst
-      common /comeskz2/ eskz2(nm,200)
-      common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
-     *                fullsize(nm),ivxfig2,ivvfig(2,74)
-      common /combeam/ ibmtyp
-      common /comask/ bar1syst,fixednew,scaldold,
-     *                wheadpt,fbar,poenom
-      common /comas1/ naskb,task(40),wask(40),elask(40)
-      common /comas2/ nasksys,wasksys(800),elasksys(800)
-      common /comhead/ ihdht,lower,headrq,lowerq,ihdvrt
-      common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb,
-     *               tautofb,autofbon,t1autofb
-      common /comsln/ is1n1,is2n1,irzbnd,isnx
-      common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
-     *                nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
-     *                noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
-     *                graspace(37),
-     *                lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
-     *                naccg(74),voltxtq(6),litq(83)
-      logical upg,slurg,slashg,autofbon
-      character*128 litq
-      common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
-     *               ndotmv(nm),updot(nm,20),rtdot(nm,20)
-      integer cnn(nm),istart(80),istop(80),nxtnow(nm),ifbnow(nm),
-     *        numbms(nm),mapfb(16)
-      real*4 xit(nm),t1xtup(20),tstart(80),squez(80)
-      character*1 ulfbq
-      character*79 inameq
-      character*20 voltxtq
-      common /comoct/ noctup
-      character*80 headrq,lowerq
-      logical cwrferm
-      common /comcwrf/ cwrferm(nm)
-      common /comnsp/ space(80),nb,prevtn(nm),
-     *    flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm)
-      logical lower,cwrest(nm),vxtup,flgndb,btest,upslur,
-     *        infbmx(nm),lowdot,inxtup(nm),drawbm
-      common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
-     *                 mtupv(nm,9),nxtinbm(nm),
-     *                 islope(nm),xelsk(24),eloff(nm,9),
-     *                 nssb(nm),issb(nm),lev1ssb(nm,20)
-      common /comdraw/ drawbm(nm)
-      common /comstart/ facmtr
-      common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
-     *                flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
-     *                rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
-     *                rtshfac
-c
-c  Above are factors for grace note, clef spacing. (fraction of wheadpt)
-c  In 1.04, moved to block data subprogram
-c
-      common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
-     *                 ,WrotePsslurDefaults,SlurCurve
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
-     *   isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
-     *   lnam(nm),inameq(nm)
-      common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
-      common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
-     *                xinsnow,lowdot
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      common /comtol/ tol
-      integer*2 mmidi
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc,fontslur,
-     *        WrotePsslurDefaults
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      common /comntot/ ntot
-      if (ismidi) then
-c
-c  Initialize for this bar the accidental counter for the midi file.  
-c    naccim(icm) = # of accidentals from earlier in the bar
-c
-        do 45 iv = 1 , nv
-        do 45 kv = 1 , nvmx(iv)
-          naccim(midchan(iv,kv)) = 0
-45      continue
-      end if
-c
-c  Time from start of gulp to end of bar, used with forced beams
-c
-      tglp2 = lenb0+ibar*lenb1
-      if (lenb0 .gt. 0) tglp2 = tglp2-lenb1
-      tglp1 = tglp2-lenbar
-c
-c  infbmx will only be true if in xtup that is NOT in explicit forced beam.
-c
-      do 1 iv = 1 , nv
-      do 1 kv = 1 , nvmx(iv)
-        ivx = ivmx(iv,kv)
-        cwrest(ivx) = .false.
-        infbmx(ivx) = .false. 
-        inxtup(ivx) = .false.
-        if (ibar .gt. 1) then
-          nn(ivx) = nib(ivx,ibar)-nib(ivx,ibar-1)
-        else
-          nn(ivx) = nib(ivx,ibar)
-        end if
-1     continue
-c
-c initialize list note counter, time(iv), curr. note(iv).  The loop to 4
-c   ONLY initializes each voice.
-c
-      in = 1
-      nxtup = 0
-      narp = 0
-      do 4 iv = 1 , nv
-      do 4 kv = 1 , nvmx(iv)
-        ivx = ivmx(iv,kv)
-        cwrferm(ivx) = .false.
-        cnn(ivx) = 1
-        ivxo(in) = ivx
-        ipo(in) = cnn(ivx)
-        tnote(in) = fnote(nodur,ivx,1,nacc)
-        to(in) = 0.
-        xit(ivx) = tnote(in)
-c
-c  Note that xit(ivx) is to END of note in voice, but it1xtup is start time.
-c
-        if (nodur(ivx,ipo(in)) .eq. 0) then
-c
-c  First note of xtuplet at start of bar in voice ivx.
-c
-          nxtup = nxtup+1
-          nxtnow(ivx) = nxtup
-          inxtup(ivx) = .true.
-          t1xtup(nxtup) = 0.
-c
-c  Xtup at start of bar.  If no explicit forced beam, start one, set 
-c  signal infbmx, and save number ifbnow for use at termination.
-c
-          if (nfb(ivx) .gt. 0) then
-            do 60 ifb = 1 , nfb(ivx)
-              if (t1fb(ivx,ifb) .gt. tglp1+xit(ivx)+tol) then
-c
-c  No explicit fb here; so exit loop and insert one.  
-c
-                go to 61
-              else if (t1fb(ivx,ifb) .lt. tglp1+xit(ivx)+tol .and.
-     *                t2fb(ivx,ifb) .gt. tglp1+xit(ivx)+tol) then
-c
-c  IS explicit fb here; must NOT insert one
-c
-                go to 62
-              end if
-60          continue
-          end if
-61        continue
-c
-c  If here, xtup isn't in explicit fb, so must insert one
-c
-          infbmx(ivx) = .true.
-          call addfb(nfb,ivx,t1xtup(nxtup)+
-     *            tglp1,t1fb,t2fb,ulfbq,ifbadd)
-          ifbnow(ivx) = ifbadd
-        end if
-62      continue
-        if (abs(xit(ivx)-lenbar) .lt. tol) xit(ivx) = 1000.
-        in = in+1
-4     continue
-c
-c  Build the list:  This is a manual loop starting at 5
-c
-5     continue
-c
-c  Determine which voice comes next from end of notes done so far.
-c  tmin is the earliest ending time of notes done so far
-c
-      tmin = 1000.
-      do 6 iiv = 1 , nv
-      do 6 kv = 1 , nvmx(iiv)
-        iivx = ivmx(iiv,kv)
-        tminn = min(tmin,xit(iivx))
-        if(tminn .lt. tmin-tol) then
-          tmin = tminn
-          ivx = iivx
-        end if
-6     continue
-      if (abs(tmin-1000.) .lt. tol) go to 7
-      ivxo(in) = ivx
-      cnn(ivx) = cnn(ivx)+1
-      ipo(in) = cnn(ivx)
-      to(in) = tmin
-c
-c  Check if this voice is done
-c
-      tnote(in) = fnote(nodur,ivx,cnn(ivx),nacc)
-      if (cnn(ivx) .eq. nn(ivx)) then
-        xit(ivx) = 1000.
-      else
-        xit(ivx) = xit(ivx)+tnote(in)
-      end if
-c
-c  Flag xtups
-c
-      if (nodur(ivx,cnn(ivx)) .eq. 0) then
-        if (.not.inxtup(ivx)) then
-c
-c  First note of xtup, not at start of bar.
-c
-          nxtup = nxtup+1
-          nxtnow(ivx) = nxtup
-          inxtup(ivx) = .true.
-          t1xtup(nxtup) = xit(ivx)-tnote(in)
-c
-c  (Note: can't be on last note in voice, so xit(ivx) <> 1000)
-c  Put xtuplet in a forced beam if not already in forced beam
-c
-          if (nfb(ivx) .gt. 0) then
-            do 70 ifb = 1 , nfb(ivx)
-              if (t1fb(ivx,ifb) .gt. tglp1+xit(ivx)+tol) then
-c
-c  NO explicit bm; put one in
-c
-                go to 71
-              else if (t1fb(ivx,ifb) .lt. tglp1+xit(ivx)+tol .and.
-     *              t2fb(ivx,ifb) .gt. tglp1+xit(ivx)+tol) then
-c
-c  IS explicit bm.  Don't put one
-c
-                go to 72
-              end if
-70          continue
-          end if
-71        continue
-c
-c  If here, no explicit bm, so put one in
-c
-          infbmx(ivx) = .true.
-          call addfb(nfb,ivx,t1xtup(nxtup)+tglp1,
-     *             t1fb,t2fb,ulfbq,ifbadd)
-          ifbnow(ivx) = ifbadd
-        end if
-72      continue
-      else if (inxtup(ivx)) then
-c
-c  This test is sufficient because already know nodur>0
-c
-        inxtup(ivx) = .false.
-        if (infbmx(ivx)) then
-c
-c  Xtup is in auto-forced beam, so end it  
-c
-          t2fb(ivx,ifbnow(ivx)) = 
-     *            t1xtup(nxtnow(ivx))+nodur(ivx,cnn(ivx))+tglp1
-          infbmx(ivx) = .false.
-        end if
-      end if
-      if (btest(irest(ivxo(in),ipo(in)),24) .or.
-     *    btest(irest(ivxo(in),ipo(in)),30)) then
-c
-c  For staff jumped beam, flag the first note (lowest voice) at same time.
-c  Later will start new notes group here.
-c
-        inj = in
-        if (ivxo(in) .gt. 1) then
-          do 40 iin = in-1 , 1 , -1
-            if (to(iin)+tol .lt. to(in)) go to 41
-            if (abs(to(iin)-to(in)) .lt. tol) then
-              inj = iin
-              go to 40
-            end if
-40        continue
-        end if
-41      continue
-        irest(ivxo(inj),ipo(inj)) = ibset(irest(ivxo(inj),ipo(inj)),29)
-      end if
-      in = in+1
-      go to 5
-7     continue
-      ntot = in-1
-      do 8 in = 1 , ntot-1
-        tno(in) = to(in+1)-to(in)
-8     continue
-      tno(ntot) = tnote(ntot)
-c
-c  Debug writes
-c
-c      write(*,'()')
-c      write(*,'(a)')' Greetings from PMXB'
-c      write(*,'(16i5)')(ivxo(in),in=1,ntot)
-c      write(*,'(16i5)')(ipo(in),in=1,ntot)
-c      write(*,'(16f5.1)')(to(in),in=1,ntot)
-c      write(*,'(16f5.1)')(tno(in),in=1,ntot)
-c      write(*,'(16i5)')(nodur(ivxo(in),ipo(in)),in=1,ntot)
-c      write(*,'(16f5.1)')(fnote(nodur,ivxo(in),ipo(in),nacc),in=1,ntot)
-c
-c  Done w/ list. Loop for parsing into note blocks:
-c
-      ib = 1
-      istart(1) = 1
-      space(1) = 0.
-      in = 1
-c
-c  A manual loop to set space(ib) and istop(ib)
-c
-9     continue
-
-        ivx = ivxo(min(in+1,ntot))
-        ip = ipo(min(in+1,ntot))
-        isl = islur(ivx,ip)
-        if (in.eq.ntot .or. ((ivx.eq.1 .and.
-     *       (iand(isl,67109216).gt.0 .or. btest(ipl(1,ip),28)
-c    *      .or. ornq(1,ip).eq.'g')) .or. btest(isl,15) )) then
-c  Bits 1-13: stmgx+Tupf._)
-c  14: Down fermata, was F
-c  15: Trill w/o "tr", was U
-     *      .or. btest(iornq(1,ip),4))) .or. btest(isl,15) )
-c
-c  Checking for start of 2nd part of jumped beam
-c
-     *      .or. btest(irest(ivx,ip),29) ) then
-c
-c  Bar end, segno, int. rpt or sig change, clef,end of 1st part of jumped beam;
-c    flow out of if-loop and into block-wrapup
-c
-c  10/18/97:  Problem with clef alignment.  Got isl{15} set on lowest-numbered
-c  voice, but it wasn't first in the list at the same time.  So check if
-c  prior notes in list have same time
-c  5/25/98: This stuff causes trouble with just "c2 Ct c", maybe when clef
-c  changes on last note in the list?
-c
-          if (btest(isl,15) .and. in.lt.ntot) then
-            do 50 iin = in , 1 , -1
-              if (tno(iin) .gt. tol) then
-                in = iin
-                islur(ivx,ip) = ibclr(islur(ivx,ip),15)
-                islur(ivxo(in+1),ipo(in+1)) =
-     *             ibset(islur(ivxo(in+1),ipo(in+1)),15)
-                go to 51
-              end if
-50          continue
-51          continue
-          end if
-          if (space(ib) .lt. tol) then
-            space(ib) = tno(in)
-            squez(ib) = 1.
-          end if
-          istop(ib) = in
-        else if (space(ib) .lt. tol) then
-c
-c  space hasn't been set yet, so tentatively set:
-c
-          space(ib) = tno(in)
-          if (space(ib) .lt. tol) then
-            in=in+1
-          else
-            squez(ib) = getsquez(in,ntot,space(ib),tnote,to)
-            istop(ib) = in
-          end if
-          go to 9
-        else if (tno(in+1) .lt. tol) then
-c
-c  This is not the last note in the group, so
-c
-          in = in+1
-          go to 9
-        else if (abs(tno(in+1)-space(ib)) .lt. tol) then
-          xsquez = getsquez(in+1,ntot,space(ib),tnote,to)
-          if (abs(xsquez-squez(ib)) .lt. tol) then
-c
-c  Keep spacing the same, update tentative stop point
-c
-            in = in+1
-            istop(ib) = in
-            go to 9
-          end if
-        end if
-c
-c At this point istart and istop are good, so finalize block
-c
-        tstart(ib) = to(istart(ib))
-        if (istop(ib) .eq. ntot) go to 15
-        ib = ib+1
-        istart(ib) = istop(ib-1)+1
-        in = istart(ib)
-c
-c Set tentative block space and squeeze-factor for upcoming block
-c
-        space(ib) = tno(in)
-        if (space(ib).gt.tol) 
-     *        squez(ib)= getsquez(in,ntot,space(ib),tnote,to)
-        istop(ib) = in
-      go to 9
-15    continue
-      nb = ib
-c
-c  Invert the list of places into ipl(0-7), making it easier to analyze a voice
-c
-      do 13 in = 1 , ntot
-c
-c ??? This may fix extra \loff's (bit 8 of ipl) in measures with >255 notes. 
-c
-c        ipl(ivxo(in),ipo(in)) = ior(ipl(ivxo(in),ipo(in)),in)
-        ipl2(ivxo(in),ipo(in)) = in
-13    continue
-c
-c  Compute elemskips from start of bar to each note in the bar, for beam slopes
-c
-      eskzb = 0.
-      ib = 1 
-      do 30 in = 1 , ntot
-        if (in .eq. istart(ib)) then
-          deskb = squez(ib)*feon(space(ib)/squez(ib))
-        else if (tno(in-1) .gt. tol) then 
-          eskzb = eskzb+deskb
-        end if
-        eskz(ivxo(in),ipo(in)) = eskzb
-        eskz2(ivxo(in),ipo(in)) = eskzb
-        if (in .eq. istop(ib)) then
-          eskzb = eskzb+deskb
-          ib = ib+1
-        end if
-30    continue
-c
-c  Debug writes
-c
-c      print*
-c      write(*,'(16f5.1)')(eskz(ivxo(in),ipo(in)),in=1,ntot)
-c      print*,'PMXB has now got blocks'
-c      write(*,'(16i5)')(istart(ib),ib=1,nb)
-c      write(*,'(16i5)')(istop(ib),ib=1,nb)
-c      write(*,'(16f5.1)')(space(ib),ib=1,nb)
-c      write(*,'(16f5.1)')(squez(ib),ib=1,nb)
-c      write(*,'(16f5.1)')(fnote(nodur,ivxo(in),ipo(in),nacc),in=1,ntot)
-cc     write(*,'(26i3)')(iand(islur(ivxo(in),ipo(in)),30720)/2048,
-c    *                  in=1,ntot)
-c     write(*,'(1x,26a3)')(ornq(ivxo(in),ipo(in)),in=1,ntot)
-c
-c
-c  Analyze for beams.
-c
-      do 20 iv = 1 , nv
-      do 20 kv = 1 , nvmx(iv)
-        ivx = ivmx(iv,kv)
-        numbms(ivx) = 0
-        mapfb(1) = 0
-        mapfb(2) = 0
-        mapfb(3) = 0
-        mapfb(4) = 0
-c
-c  First forced beams.
-c
-        if (nfb(ivx) .gt. 0) then
-c
-c  tglp2 is time from start of gulp to end of current bar.
-c
-          nfbbar = 0
-          do 80 ifb = 1 , nfb(ivx)
-            if (t1fb(ivx,ifb).gt.tglp2-tol) go to 81
-            nfbbar = nfbbar+1
-            numbms(ivx) = numbms(ivx)+1
-            numnew = numbms(ivx)
-c
-c  Times from beginning of bar
-c
-            itbb1 = int(t1fb(ivx,ifb)-tglp1+tol)
-            itbb2 = int(t2fb(ivx,ifb)-tglp1+tol)
-            do 83 ip = 1 , nn(ivx)
-              if (int(to(ipl2(ivx,ip))+tol) .eq. itbb1) then
-                nip1fb = ip
-                do 84 ip1 = ip , nn(ivx)
-                  inip1 = ipl2(ivx,ip1)
-                  if (abs(to(inip1)+tnote(inip1)-itbb2) .lt. tol) then
-                    nip2fb = ip1
-                    itbb3 = itbb2-2
-                    go to 85
-                  end if
-84              continue
-              end if
-83          continue
-            print*
-            print*,'Timing problem w/ forced beams'
-            write(15,'(/a)')'Timing problem w/ forced beams'
-85          continue
-            call logbeam(numnew,nip1fb,nip2fb)
-c
-c  Set up mapfb for forced beam just logged:
-c
-            ib1 = itbb1/2
-            ib2 = itbb3/2
-            ibrep = lenbar/ibmrep/2
-            do 86 irep = 1 , ibmrep
-              ib1now = max(0,ib1-(irep-1)*ibrep)
-              ib2now = min(irep*ibrep-1,ib2-(irep-1)*ibrep)
-              mapnow = 0
-              do 87 ib = ib1now , ib2now
-                mapnow = ibset(mapnow,ib)
-87            continue
-              mapfb(irep) = ior(mapfb(irep),mapnow)
-86          continue
-c
-c  Since we are cycling thru forced beams, for those that start with a rest and 
-c    have height & slope adjustments, move adjustments to next note.
-c  060924: Copy to ALL later notes in fb, in case there's more than 1 rest at
-c    start of beam
-c
-            if (btest(irest(ivx,nip1fb),0)) then
-c              call setbits(ipl(ivx,nip1fb+1),6,11,
-c     *                 igetbits(ipl(ivx,nip1fb),6,11))
-c              call setbits(ipl(ivx,nip1fb+1),6,17,
-c     *                 igetbits(ipl(ivx,nip1fb),6,17))
-c              call setbits(islur(ivx,nip1fb+1),2,27,
-c     *                 igetbits(islur(ivx,nip1fb),2,27))
-              do 88 kp = nip1fb+1 , nip2fb
-                call setbits(ipl(ivx,kp),6,11,
-     *                 igetbits(ipl(ivx,nip1fb),6,11))
-                call setbits(ipl(ivx,kp),6,17,
-     *                 igetbits(ipl(ivx,nip1fb),6,17))
-                call setbits(islur(ivx,kp),2,27,
-     *                 igetbits(islur(ivx,nip1fb),2,27))
-88            continue
-            end if
-80        continue
-81        continue
-c
-c  Slide down, reduce nfb(ivx).  This lets us count up from 1 for each new bar.
-c  Remember, makeabar is called 1/bar, and it calls findbeam once per voice.
-c
-          if (nfbbar .gt. 0) then
-            nfb(ivx) = nfb(ivx)-nfbbar
-            do 82 ifb = 1 , nfb(ivx)
-              t1fb(ivx,ifb) = t1fb(ivx,ifb+nfbbar)
-              t2fb(ivx,ifb) = t2fb(ivx,ifb+nfbbar)
-              ulfbq(ivx,ifb) = ulfbq(ivx,ifb+nfbbar)
-82          continue
-          end if
-        end if
-        ifb = 0
-c
-c  Done with forced beam masks for this bar and voice.  Now get normal beams.
-c
-        call findbeam(ibmrep,numbms,mapfb)
-20    continue
-      return
-      end
-      subroutine make2bar(ninow,tglp1,tstart,cwrest,squez,
-     *    istop,numbms,istart,clefq)
-      parameter (nm=24,mv=24576)
-      common /comlast/ islast,usevshrink
-      logical islast,usevshrink
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      common /comipl2/ ipl2(nm,200)
-      character*10 figq
-      character*1 ulq,sepsymq,sq,chax
-      logical beamon,firstgulp,figbass,figchk,isfig,bar1syst,isbjmp,
-     *        isbj2
-      common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2
-      common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
-     *                fullsize(nm),ivxfig2,ivvfig(2,74)
-      common /combeam/ ibmtyp
-      common /comask/ bar1syst,fixednew,scaldold,
-     *                wheadpt,fbar,poenom
-      common /comas1/ naskb,task(40),wask(40),elask(40)
-      common /comas2/ nasksys,wasksys(800),elasksys(800)
-      common /comhead/ ihdht,lower,headrq,lowerq,ihdvrt
-      common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb,
-     *               tautofb,autofbon,t1autofb
-      common /comsln/ is1n1,is2n1,irzbnd,isnx
-      common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
-     *                nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
-     *                noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
-     *                graspace(37),
-     *                lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
-     *                naccg(74),voltxtq(6),litq(83)
-      logical upg,slurg,slashg,issig,rpndot,autofbon
-      character*128 litq
-      common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
-     *               ndotmv(nm),updot(nm,20),rtdot(nm,20)
-      integer istart(80),istop(80),iaskb(nm),numbms(nm),
-     *        nornb(nm),ihornb(nm,24),lcwr(nm),ibmcnt1(nm),ifig(2)
-      character*1 ulfbq,udqq,clefq(nm),slurudq
-      character*8 noteq
-      character*79 cwrq(nm),notexq,inameq
-      character*20 voltxtq
-      common /comoct/ noctup
-      character*80 soutq,headrq,lowerq
-      common /comnsp/ space(80),nb,prevtn(nm),
-     *    flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm)
-      logical bspend,lower,cwrest(nm),vxtup,
-     *        isgrace,isclef,nofirst,iscln,isdot,isflag,
-     *        isacc,isfirst,flgndb,btest,stemup,upslur,
-     *        isgaft,isarp,isrshft,isaccs,iscacc,
-     *        lowdot,flipend,iscwr,isdotted,beamon1(nm)
-      real*4 ptgr(37),ptclef(nm),ptsndg(nm),eskndg(nm),tstart(80),
-     *       squez(80)
-      logical cwrferm,drawbm
-      common /comcwrf/ cwrferm(nm)
-      common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
-     *                 mtupv(nm,9),nxtinbm(nm),
-     *                 islope(nm),xelsk(24),eloff(nm,9),
-     *                 nssb(nm),issb(nm),lev1ssb(nm,20)
-      common /comdraw/ drawbm(nm)
-      common /comstart/ facmtr
-      common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
-     *                flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
-     *                rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
-     *                rtshfac
-c
-c  Factors for grace note, clef spacing. (fraction of wheadpt)
-c  In 1.04, moved to block data subprogram
-c
-      common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
-     *                 ,WrotePsslurDefaults,SlurCurve
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
-     *   isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
-     *   lnam(nm),inameq(nm)
-      common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
-      common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
-     *                xinsnow,lowdot
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      common /strtmid/ ihnum3,flipend(nm),ixrest(nm)
-      common /comtol/ tol
-      common /comignorenats/ ignorenats
-      logical ignorenats
-      integer*2 mmidi,iinsiv
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc,fontslur
-     *       ,WrotePsslurDefaults
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      logical slmon,dbltie
-      common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm),
-     *       naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl,
-     *       slmon(0:nm),dbltie
-      common /comevent/ miditime,lasttime
-      logical kbdrests
-      common /comkbdrests/ levbotr(8),levtopr(8),kbdrests
-      logical secondgrace
-      common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
-     *  instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
-      logical EarlyTransOn,LaterInstTrans
-      common /commidisig/ midisig
-c 130316
-      common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
-     *                ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
-      common /comclefrests/ centrests
-      logical centrests
-      common /xjbeambrests/ nbrests
-      nbrests = 0
-c
-c  Set up main ib loop within which a block (notes group) is written
-c
-      do 25 iv = 1 , nv
-      do 25 kv = 1 , nvmx(iv)
-        ivx = ivmx(iv,kv)
-        ibmcnt(ivx) = 1
-        ibmcnt1(ivx) = 1
-        beamon(ivx) = .false.
-        beamon1(ivx) = .false.
-        nornb(ivx) = 0
-        iaskb(ivx) = 1
-        vxtup(ivx) = .false.
-        drawbm(ivx) = .true.
-25    continue
-      naskb = 0
-      ifig(1) = 1
-      ifig(2) = 1
-      ixtup = 0
-      bspend = .false.
-      iscwr = .false.
-      rpndot = .false.
-      do 16 ib = 1 , nb
-c
-c  Check for segno
-c
-        if (btest(iornq(1,ipo(istart(ib))),4) .and.
-     *       ivxo(istart(ib)).eq.1) then
-          if (noffseg.le.-10) then
-            write(noteq(1:5),'(1H{,i3,1H})')noffseg
-            lnoten = 5
-          else if (noffseg.lt.0 .or. noffseg.ge.10) then
-            write(noteq(1:4),'(1H{,i2,1H})')noffseg
-            lnoten = 4
-          else
-            write(noteq(1:1),'(i1)')noffseg
-            lnoten = 1
-          end if
-          notexq = sq//'znotes'//sq//'segnoo'//noteq(1:lnoten)//'9'
-          lnote = 15+lnoten
-          do 130 iv = 2 , nv
-            if (lnote .gt. 60) then
-              if (islast) write(11,'(a)')notexq(1:lnote)//'%'
-              notexq = sepsymq(iv-1)//sq//'segnoo'
-     *                           //noteq(1:lnoten)//'9'
-              lnote = lnoten+9                 
-            else
-              notexq = notexq(1:lnote)//sepsymq(iv-1)//sq//'segnoo'
-     *               //noteq(1:lnoten)//'9'
-              lnote = lnote+lnoten+9
-            end if
-130       continue
-          if (islast) write(11,'(a)')notexq(1:lnote)//sq//'en'
-          lnote = 0
-        end if
-c
-c  Check for new clefs
-c
-        isclef = .false.
-        if (btest(islur(ivxo(istart(ib)),ipo(istart(ib))),15))
-     *       then
-c
-c  In preceding line, fl32 gave wrong result for ... .gt.0 !!!
-c
-          do 140 in = istart(ib) , istop(ib)
-            if (btest(islur(ivxo(in),ipo(in)),11)) then
-              call wsclef(ivxo(in),ninow,
-     *          iand(ishft(islur(ivxo(in),ipo(in)),-12),7))
-c
-c If clefq = '8', must add eg \settrebleclefsymbol3\treblelowoct%
-c
-c              if (clefq(ivxo(in)) .eq. '8') then
-              if (btest(ipl(ivxo(in),ipo(in)),2)) then
-                if (iv .le. 9) then
-                  write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',nv,
-     *              sq//'treblelowoct%'
-                else
-                  write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',nv,
-     *              sq//'treblelowoct%'
-                end if
-              end if
-            end if
-140       continue
-          if (islast) write(11,'(a)')sq//'pmxnewclefs'
-          isclef = .true.
-        end if
-c
-c  Start a notes group.  We're just gonna define every one using pnotes{n}, 
-c    where \def\pnotes#1{\vnotes#1\elemskip}
-c
-        soutq = sq//'pnotes{'
-        eonsqz = squez(ib)*feon(space(ib)/squez(ib))
-        if (eonsqz .gt. 9.995) then
-          write(soutq(9:12),'(f4.1)')eonsqz
-        else if (eonsqz .gt. 0.995) then
-          write(soutq(9:12),'(f4.2)')eonsqz
-        else if (eonsqz .gt. 0.095) then
-          soutq = soutq(1:8)//'0.'
-          write(soutq(11:12),'(i2)')nint(100*eonsqz)
-        else
-          soutq = soutq(1:8)//'0.0'
-          write(soutq(12:12),'(i1)')nint(100*eonsqz)
-        end if
-        soutq = soutq(1:12)//'}'
-        lsout = 13
-c
-c  Check whole block, flag accidentals etc that are too close, one per *time*.
-c  Note about bar starts and after rpt's/boublebars: There is an afterruleskip
-c    (fbar*wheadpt) following, but rpts seem to occupy some of that gap, so
-c    (dotsfac*wheadpt) is presumed to be filled up.
-c
-        in = istart(ib)-1
-        itrpt = -1
-        itsig = -1
-c
-c  Begin big manual loop over notes in this block; ends at 112
-c
-111     in = in+1
-        if (in .gt. istop(ib)) go to 112
-        ip = ipo(in)
-        ivx = ivxo(in)
-        if (ivx .le. nv) then
-          iv = ivx
-        else
-          do 128 iv = 1 , nv
-            if (nvmx(iv) .eq. 2 .and. ivmx(iv,2).eq. ivx) go to 129
-128       continue
-        print*,'Trouble finding iv!, ivx,nvmx,ivmx:',ivx,nvmx(1),nvmx(2)
-        print*,ivmx(1,1),ivmx(1,2),ivmx(2,1),ivmx(2,2)
-          stop
-        end if
-129     continue
-c
-c  Call precrd here so we know how much space to add for accid's in chords
-c    After calling precrd, icashft>0 means there is a shifted chordal accid (incl.
-c    main note.
-c
-c  To call precrd, need up-downness, so must track if in beam.
-c
-c  Deal w/ staff-jumping beams later
-c         if ((numbms(ivx).gt.0 .and. ibmcnt(ivx).le.numbms(ivx)
-c     *          .and. ibm1(ivx,ibmcnt(ivx)) .eq. ip) .or. 
-c     *          btest(nacc(ivx,ip),21)) then
-c           if (.not.btest(irest(ivx,ip),24)) then
-        if ((numbms(ivx).gt.0 .and. ibmcnt1(ivx).le.numbms(ivx)
-     *        .and. ibm1(ivx,ibmcnt1(ivx)) .eq. ip)) then
-          beamon1(ivx)=.true.
-        end if
-        icashft = 0
-        if (btest(ipl(ivx,ip),10)) then
-c
-c  There is a chord on this note. Need up-down-ness in precrd to auto shift for 2nds.
-c
-          if (beamon1(ivx)) then 
-             call precrd(ivx,ip,nolev(ivx,ip),nacc(ivx,ip),
-     *          ipl(ivx,ip),irest(ivx,ip),ulq(ivx,ibmcnt1(ivx)),
-     *          .false.,icashft)
-          else
-            call precrd(ivx,ip,nolev(ivx,ip),nacc(ivx,ip),
-     *              ipl(ivx,ip),irest(ivx,ip),udqq(nolev(ivx,ip),
-     *              ncmid(iv,ip),islur(ivx,ip),nvmx(iv),ivx,nv),
-     *            .false.,icashft)
-          end if
-        end if
-c
-c  Turn beam off?
-c
-        if (beamon1(ivx) .and. ibm2(ivx,ibmcnt1(ivx)).eq.ip) then
-          beamon1(ivx) = .false.
-          ibmcnt1(ivx) = ibmcnt1(ivx)+1
-        end if
-c
-c  Remember, rpts & internal sigs can only come at start of (internal) block
-c
-        isacc = iand(nacc(ivx,ip),3).gt.0 
-     *            .and. .not.btest(nacc(ivx,ip),17)
-     *            .and. .not.btest(ipl(ivx,ip),10)
-c
-c  i.e., do not set for chord. Now check for "(" as ornament on main note, 
-c
-c!!!  Need to do this for chord notes too.  Maybe in chkarp?
-c 
-        isaccs = isacc .or. btest(iornq(ivx,ip),0)
-c
-c  5/15/02 Add check for ) ornament of prior note.
-c  5/16 Nope...fails when grace intervenes.
-c        if (ip .gt. 1) then
-c          isaccs = isaccs .or. btest(iornq(ivx,ip-1),13)
-c        end if
-        isarp = btest(iornq(ivx,ip),27)
-        iscacc = .false.
-        if (btest(ipl(ivx,ip),10)) then
-c
-c  There is a chord here; check for arpeggios and accidentals. Note accid shifts are
-c    not of concern here, only whether there's an accid, whick causes iscacc=.true.
-c
-          iscacc = igetbits(nacc(ivx,ip),3,0).gt.0 .and. 
-     *                .not.btest(nacc(ivx,ip),17)
-          call chkarp(ncrd,icrdat,ivx,ip,iscacc,isarp)
-        end if
-c
-c  When we get motivated, will do spacing for arpeggios here.
-c
-        if (ivx.eq.1 .and. iand(islur(ivx,ip),96).gt.0)
-     *        itrpt = nint(to(in))
-        issig  = btest(ipl(ivx,ip),28)
-        if (ivx.eq.1 .and. issig) itsig = nint(to(in))
-        isgrace = btest(islur(ivx,ip),4) .and.
-     *    .not.btest(ipl(ivx,ip),29) .and. .not.btest(ipl(ivx,ip),31)
-        isgaft = .false.
-        if (ip .gt. 1) then
-          xnd = tnote(ipl2(ivx,ip-1))
-          isgaft = btest(ipl(ivx,ip-1),29) .or. btest(ipl(ivx,ip-1),31)
-          isgrace = isgrace .or. isgaft
-        end if
-        iscln = isclef .and. btest(islur(ivx,ip),11)
-c
-c  Is prev. note non-beamed, up-stemmed, & flagged? Recall if ip>1, have nd
-c
-        isflag = ip.gt.1 .and. xnd.gt.tol .and. xnd.lt.16.-tol
-        if (isflag)
-     *       isflag = .not.btest(irest(ivx,ip-1),0)
-     *          .and. udqq(nolev(ivx,ip-1),
-     *         ncmid(iv,ip-1),islur(ivx,ip-1),nvmx(iv),ivx,nv).eq.'u'
-        if (isflag) then
-          do 116 ibmchk = 1 , numbms(ivx)
-            if (ip-1 .lt. ibm1(ivx,ibmchk)) then
-              go to 117
-c
-c  Add check for non-beamed xtuplets. May be problem with stem direction.
-c
-c            else if (ip-1.le.ibm2(ivx,ibmchk)) then
-            else if (ip-1.le.ibm2(ivx,ibmchk) .and. 
-     *                .not.btest(islur(ivx,ibm1(ivx,ibmchk)),18)) then
-              isflag = .false.
-              go to 117
-            end if
-116       continue
-        end if
-117     continue
-c
-c  If isflag, then won't need to check for dot on prev. note.
-c
-c  5/16/02 ???  Try using this for ) ornament.
-c
-        isflag = isflag .or. btest(iornq(ivx,ip-1),13)
-        isdot = ip.gt.1
-        if (isdot) isdot = isdotted(nodur,ivx,ip-1)
-        isrshft = ip .gt. 1
-        if (isrshft) isrshft = btest(irest(ivx,ip-1),20)
-        if (.not.(isaccs.or.isgrace.or.iscln.or.isflag.or.isrshft.or.
-     *          isdot.or.btest(iornq(ivx,ip),26).or.
-     *          btest(irest(ivx,ip),21).or.isarp.or.
-     *          btest(irest(ivx,ip),27).or.iscacc)) go to 111
-c
-c  Here is an accid,grace,clef,flag,rtshft,dot,udsp,arpeg,left-shift.
-c  Compute pts, the total occupied space including prior notehead.
-c
-c 130324
-c        wheadpt1 = wheadpt*fullsize(iv)
-        wheadpt1 = wheadpt*fullsize(instno(iv))
-        pts = wheadpt1
-c
-c  Set up for possible cautionary accidental here
-c
-        if (isaccs .or. iscacc) then
-          if (.not.btest(iornq(ivx,ip),31)) then
-            taccfac = accfac
-          else
-            taccfac = 1.4*accfac ! cautionary accidental
-          end if
-        end if
-        if (isgrace) then
-          secondgrace = .false.
-          do 122 ig = 1 , ngrace
-            if (.not. isgaft) then
-              if (ipg(ig).eq.ip .and. ivg(ig).eq.ivx) go to 123
-            else if (ip .gt. 1) then
-              if (ipg(ig).eq.ip-1 .and. ivg(ig).eq.ivx) go to 123
-            end if
-122       continue
-          print*,'Problem finding grace index in makeabar'
-          stop
-123       continue
-c
-c  wgr = distance to backspace (in headwidths), less main acc.
-c  ptgr = same in pts,+ main acc.  Not used for after-grace. Distance to backspace.
-c  spgr = total space needed (w/o main acc).
-c   Also, spgr is same for b4 or after, but xb4fac-space will be in diff. place.
-c
-          if (nng(ig) .eq. 1) then
-            wgr = grafac
-            if (multg(ig) .eq. 0) wgr = wgr-.4
-          else
-            wgr = nng(ig)*emgfac
-            do 126 ing = 2 , nng(ig)
-              if (naccg(ngstrt(ig)-1+ing) .gt. 0) wgr = wgr+acgfac
-126         continue
-          end if
-          if (graspace(ig) .gt. 0.) then
-c
-c  User-defined space before grace
-c
-            wgr = wgr+graspace(ig)
-          end if
-          ptgr(ig) = wgr*wheadpt1
-          spgr = ptgr(ig)+xb4fac*wheadpt1
-c
-c!!! May need to mod for chord accid's
-c
-          if (isaccs .or. iscacc) ptgr(ig) = ptgr(ig) + taccfac*wheadpt1
-          if (naccg(ngstrt(ig)) .gt. 0) spgr = spgr+wheadpt1*agc1fac
-          pts = pts+spgr
-c
-c  Special check for after-grace on ip-1 and normal on ip. Must go back thru
-c   loop again for the normal grace.
-c
-          if (isgaft .and. ig.lt.ngrace .and. .not.secondgrace) then
-            if (ipg(ig+1).eq.ip) then  
-              secondgrace = .true.
-              ig = ig+1
-              go to 123
-            end if
-          end if
-        end if
-        if (iscln) then
-          pts = pts+clefac*wheadpt1
-c
-c  How far to backspace when printing the clef
-c
-          ptclef(ivx) = 0.
-c
-c!!! May need to mod for chord accid's
-c
-          if (isaccs .or. iscacc)
-     *          ptclef(ivx) = ptclef(ivx)+taccfac*wheadpt1
-          if (isgrace) ptclef(ivx) = ptclef(ivx)+spgr
-        end if
-        if (isrshft) then
-          pts = pts+rtshfac*wheadpt1
-        else if (isflag) then
-          pts = pts+flagfac*wheadpt1
-        else if (isdot) then
-          pts = pts+dotfac*wheadpt1
-        end if
-        if (abs(to(in)-itrpt) .lt. tol) then
-c
-c  Repeat, need a little extra space
-c
-          pts = pts+dotsfac*wheadpt1
-        end if
-        if (isarp) then
-          pts = pts+arpfac*wheadpt1
-        end if
-c
-c  Add in padding space
-c
-        pts = pts+xspfac*wheadpt1
-c
-c  Now done with all items needing space except accidentals, 
-c    accidental shifts, and left-notehead-shifts, and will later 
-c    subtract a notehead if at start of bar.
-c
-c  Get available space in elemskips (esk)
-c
-c        isfirst = ip.eq.1 .or. to(in).eq.itrpt .or.
-c     *        to(in) .eq. itsig
-        isfirst = ip.eq.1 .or. abs(to(in)-itrpt).lt.tol .or.
-     *        abs(to(in)-itsig).lt.tol
-        if (isfirst) then
-c
-c  At start of bar or after repeat sign or new signature
-c
-c          if (to(in) .eq. itsig) then
-          if (abs(to(in)-itsig).lt.tol) then
-            esk = 0.
-          else
-            esk = fbar
-          end if
-        else
-c
-c  Not 1st note of bar
-c
-          esk = eskz(ivx,ip)-eskz(ivx,ip-1)
-        end if
-        if (isgrace) then
-c
-c  Since graces can be very long, cannot assume no interference if prior
-c  note uses >1 noteskip.  So must get elsk's back to prior note, whether or
-c  not it used only one noteskip.  
-c  <<But if it was xtup. don't need to call eskb4.>>????
-c
-c  10/8/05 Kluge to not zero out esk if in xtup
-c
-          esksav = esk
-          if ((ip.le.2 .or. nodur(ivx,max(1,ip-2)).gt.0) .and.
-c     *                                to(in).ne.itsig)
-     *                                abs(to(in)-itsig).gt.tol)
-     *          call eskb4(ip,ivx,in,ib,space,tstart,fbar,itrpt,esk)
-          if (abs(esk) .lt. tol) esk = esksav
-        end if
-c
-c  Done getting available elemskips.  Remove headwidth if first.  Must do here
-c  rather than earlier since check uses isfirst
-c
-        if (isfirst) pts = pts-wheadpt1
-c
-c  Deal with accidental shifts and left-notehead shifts
-c
-        if (btest(ipl(ivx,ip),10)) then
-c
-c  In a chord
-c
-          ptsl = 0.
-          if (btest(irest(ivx,ip),27)) ptsl = wheadpt1
-          ptsadd = max(ptsl,icashft*.05*wheadpt1)
-c
-c  Note: may have icashft=-20000 (if shftmin=-1000 in crdacc) but that's OK
-c 
-        else
-c
-c  Not in a chord
-c
-          ihshft = 0
-          if (isaccs) then
-            ihshft = igetbits(nacc(ivx,ip),7,10)
-c            if (ihshft .ne. 0) ihshft = max(0,64-ihshft)
-            if (ihshft .ne. 0) ihshft = max(0,107-ihshft)
-          end if
-c
-c Check for left-shifted main note
-c
-          if (btest(ipl(ivx,ip),8)) ihshft = max(20,ihshft)
-          ptsadd = ihshft*.05*wheadpt1
-        end if
-        pts = pts+ptsadd
-        if (isgrace) ptgr(ig) = ptgr(ig)+ptsadd
-        if (iscln) ptclef(ivx) = ptclef(ivx)+ptsadd
-c
-c  Left-shifted, non-chord note before?
-c
-        if (ip .gt. 1) then
-          if (.not.btest(ipl(ivx,ip-1),10) .and. 
-     *         btest(irest(ivx,ip-1),27)) pts = pts-wheadpt1
-        end if
-c
-c  Try big accidentals first
-c
-        ptbneed = pts
-        if (isaccs .or. iscacc) then
-          ptbneed = ptbneed+wheadpt1*bacfac
-        end if
-        if (poenom*esk .gt. ptbneed) then
-c
-c  Set flag for big accidental
-c
-          if (isacc) nacc(ivx,ip) = ibset(nacc(ivx,ip),3)
-          go to 99
-        end if
-c
-c  Cannot use big, so try small
-c
-        ptsneed = pts
-        if (isaccs .or. iscacc) then
-          ptsneed = ptsneed+taccfac*wheadpt1
-        end if
-        if (poenom*esk .lt. ptsneed) call addask(to(in),ptsneed,
-     *              esk,fixednew,scaldold,0.,.false.)
-99      continue
-        if (btest(iornq(ivx,ip),26)) then
-c
-c  User-defined space.  Warning, "zero" may change value in addask!
-c
-          zero = 0.
-          call addask(to(in),ptsneed,zero,
-     *                fixednew,scaldold,tglp1,.true.)
-        end if
-c
-c  End of big manual loop over "in" for accidental checking
-c
-        go to 111
-112     continue
-c
-c End of ask analysis for this block.  
-c
-c Adjust eskz if there are added spaces. Corrects length of xtup brackets.
-c
-        if (naskb.gt.0) call adjusteskz(ib,istart,poenom)
-c 
-c Check for internal repeat or sig change.
-c
-        if (ib.gt.1 .and. ivxo(istart(ib)).eq.1) then
-          iirpt = iand(islur(1,ipo(istart(ib))),67109216)
-          if (iirpt .gt. 0) then
-c
-c Internal repeat
-c
-            if (islast) write(11,'(a)')sq//'advance'//sq//'barno-1%'
-            if (iirpt .eq. 96) then
-              if (islast) write(11,'(a)')sq//'leftrightrepeat'
-              fixednew = fixednew+lrrptfac*wheadpt
-            else if (btest(iirpt,5)) then
-              if (islast) write(11,'(a)')sq//'leftrepeat'
-              fixednew = fixednew+rptfac*wheadpt
-            else if (btest(iirpt,6)) then
-              if (islast) write(11,'(a)')sq//'rightrepeat'
-              fixednew = fixednew+rptfac*wheadpt
-            else if (btest(iirpt,8)) then
-              if (islast) write(11,'(a)')sq//'doublebar'
-            else
-              print*,'Unexpected mid-bar repeat command R*'
-              call stop1()
-            end if
-            scaldold = scaldold-fbar
-          end if
-          if (btest(ipl(1,ipo(istart(ib))),28)) then
-c
-c  Internal signature change.
-c
-            notexq = sq//'generalsignature{'
-            lnote = 18
-            if (isig .lt. 0) then
-              notexq = notexq(1:lnote)//'-'
-              lnote = lnote+1
-            end if
-            if (islast) write(11,'(a)')notexq(1:lnote)
-     *          //chax(48+abs(isig))//'}%'
-            if (islast .and. ignorenats) 
-     *             write(11,'(a)')sq//'ignorenats%'              
-            if (islast) write(11,'(a)')sq//'zchangecontext'//sq
-     *          //'addspace{-.5'//sq//'afterruleskip}%'
-            lnote = 0
-          end if
-        end if
-        flgndb = .false.
-c
-c  Done with start-of-block stuff.  Begin main loop over voices.
-c
-        do 11 iv = 1 , nv
-        do 11 kv = 1 , nvmx(iv)
-          ivx = ivmx(iv,kv)
-          icm = midchan(iv,kv)
-c
-c  A rather klugey way to set flag for figure in this voice
-c  Must always check figbass before figchk.
-c
-          if (figbass) then
-            ivf = 0
-            if (ivx .eq. 1) then
-              ivf = 1
-            else if (ivx .eq. ivxfig2) then
-              ivf = 2
-            end if
-            if (ivf.gt.0) figchk(ivf) = nfigs(ivf).gt.0
-          end if
-          if (ivx .gt. 1) then
-            if (ivx .le. nv) then
-              call addstr(sepsymq(iv-1),1,soutq,lsout)
-            else
-              call addstr(sq//'nextvoice',10,soutq,lsout)
-            end if
-          end if
-          if (ihdht.gt.0 .and. ivx.eq.nv) then
-c
-c  Write header.  First adjust height if needed to miss barno.
-c
-            if (bar1syst .and. iline.ne.1) then
-              ihdht = 15+irzbnd+isnx
-            end if
-c
-c  Add user-defined vertical shift
-c
-            ihdht = ihdht+ihdvrt
-            lchead = lenstr(headrq,80)
-            notexq = sq//'zcharnote{'
-            write(notexq(12:13),'(i2)')ihdht
-            notexq = notexq(1:13)//'}{'//sq//'bigfont'//sq//'kern-30pt '
-            call addstr(notexq,34,soutq,lsout)
-            call addstr(headrq(1:lchead)//'}',1+lchead,soutq,lsout)
-            ihdht = 0
-          end if
-          if (lower .and. ivx.eq.nv) then
-            lclow = lenstr(lowerq,80)
-            call addstr(sq//'zcharnote{-6}{'//
-     *        sq//'tempo'//sq//'kern-10pt '//
-     *        lowerq(1:lclow)//'}',33+lclow,soutq,lsout)
-            lower=.false.
-          end if
-          tnow = tstart(ib)
-          nofirst = .true.
-c
-c  Done setting up voice ivx for start of block ib.  Loop over notes in voice.
-c
-          do 10 jn = istart(ib), istop(ib)
-            if (ivxo(jn) .ne. ivx) go to 10
-            ip = ipo(jn)
-c
-c  May have problem with not initializing islhgt, so do it here
-c
-            islhgt = 0
-c
-            if (nofirst) then
-              noctup = 0
-              if (ncmid(iv,ip) .eq. 23) noctup = -2
-              nofirst = .false.
-            end if
-c
-c  Check for internal floating figure (before last note of group).
-c
-12          if (figbass) then
-              if (ivx.eq.1 .or. ivx.eq.ivxfig2) then
-                ivf = 1
-                if (ivx .gt. 1) ivf = 2
-                if (figchk(ivf) .and. itfig(ivf,ifig(ivf)).lt.tnow-tol) 
-     *                            then
-c
-c  Bypassed figure location. Backup, place fig, return.
-c
-                  offnsk = (tnow-itfig(ivf,ifig(ivf)))/space(ib)
-                  call putfig(ivf,ifig(ivf),offnsk,figchk(ivf),soutq,
-     *              lsout)
-                  go to 12
-                end if
-              end if
-            end if
-c
-c  Put in \sk if needed
-c
-            if (to(jn) .gt. tnow+tol) then
-              call addstr(sq//'sk',3,soutq,lsout)
-              tnow = tnow+space(ib)
-              go to 12
-            end if
-c
-c  Check for user-defined shifts
-c
-            if (btest(irest(ivx,ip),15).or.btest(irest(ivx,ip),16))
-     *             call putshft(ivx,.true.,soutq,lsout)
-21          if (iaskb(ivx).le.naskb .and.
-     *            tnow.gt.task(iaskb(ivx))-tol) then
-              if (task(iaskb(ivx)) .gt. tstart(ib)-tol) then
-c
-c  Insert placeholder for accidental skip
-c
-                call addstr(sq//'ask     ',9,soutq,lsout)
-                nasksys = nasksys+1
-                wasksys(nasksys) = wask(iaskb(ivx))
-                if (wask(iaskb(ivx)) .gt. 0.) then
-                  elasksys(nasksys) = elask(iaskb(ivx))
-                else
-c
-c  This is a signal to permit negative ask's.  Should really have elask>=0.
-c
-                  elasksys(nasksys) = -elask(iaskb(ivx))
-                end if
-              end if
-c
-c  May have skipped some task's in earlier blocks (due to void voice)
-c
-              iaskb(ivx) = iaskb(ivx)+1
-              go to 21
-            end if
-            if (figbass) then
-              if (ivx.eq.1 .or. ivx.eq.ivxfig2) then
-                ivf = 1
-                if (ivx .gt. 1) ivf = 2
-                if (figchk(ivf) .and. 
-     *                 abs(itfig(ivf,ifig(ivf))-tnow).lt.tol) then
-c
-c  Figure on a note.  NB: later special check for late figs.
-c
-                  call putfig(ivf,ifig(ivf),0.,figchk(ivf),soutq,lsout)
-                end if
-              end if
-            end if
-c
-c  Check for new clef here.
-c
-            if (isclef .and. btest(islur(ivx,ip),11)) then
-c     print*,'At clef insertion, ptclef:',ptclef(iv)
-              if (ptclef(iv) .gt. 0.) then
-                notexq = sq//'off{-'
-                if (ptclef(iv) .lt. 9.95) then
-                  write(notexq(7:9),'(f3.1)')ptclef(iv)
-                  lnote = 9
-                else
-                  write(notexq(7:10),'(f4.1)')ptclef(iv)
-                  lnote = 10
-                end if
-                notexq = notexq(1:lnote)//'pt}'
-                lnote = lnote+3
-                call addstr(notexq,lnote,soutq,lsout)
-c     print*,'Just added: ',notexq(1:lnote)
-              end if
-              call clefsym(islur(iv,ip),notexq,lnote,nclef)
-c
-c 151220 If clef is treblelowoct, change '0' in pos'n 9 to '8'
-c
-              if (btest(ipl(ivx,ip),2)) notexq = 
-     *                   notexq(1:8)//'8'//notexq(10:10)
-              call addstr(notexq,lnote,soutq,lsout)
-              if (ptclef(iv) .gt. 0.) then
-                notexq = sq//'off{'
-                if (ptclef(iv) .lt. 9.95) then
-                  write(notexq(6:8),'(f3.1)')ptclef(iv)
-                  lnote = 8
-                else
-                  write(notexq(6:9),'(f4.1)')ptclef(iv)
-                  lnote = 9
-                end if
-                notexq = notexq(1:lnote)//'pt}'
-                lnote = lnote+3
-                call addstr(notexq,lnote,soutq,lsout)
-              end if
-            end if
-c
-c  Checking for literal TeX string BEFORE starting beams!!
-c
-            if (btest(islur(ivx,ip),16)) then
-              do 124 il = 1 , nlit
-                if (iplit(il).eq.ip .and. ivlit(il).eq.ivx) go to 125
-124           continue
-              print*,'Problem finding index for literal string'
-              call stop1()
-125           continue
-c
-c  Write a type 1 tex string.
-c
-              if (lenlit(il) .lt. 71) then
-c
-c  Add normally
-c
-                call addstr(litq(il),lenlit(il),soutq,lsout)
-              else
-c
-c  Longer than 71.  Write souq, Write string, start new soutq.
-c
-                if (islast) write(11,'(a)')soutq(1:lsout)//'%'
-                if (islast) write(11,'(a)')litq(il)(1:lenlit(il))//'%'
-                lsout = 0
-              end if
-            end if
-c
-c  Arpeggio on a main (non-chordal) note?
-c
-            if (btest(iornq(ivx,ip),27)) then
-c              call putarp(tnow,iv,ip,nolev(ivx,ip),ncmid(iv,ip),
-              call putarp(tnow,ivx,ip,nolev(ivx,ip),ncmid(iv,ip),
-     *                    soutq,lsout)
-            end if
-c
-c  See if a beam starts here
-c
-            if ((numbms(ivx).gt.0 .and. ibmcnt(ivx).le.numbms(ivx)
-     *          .and. ibm1(ivx,ibmcnt(ivx)) .eq. ip) .or. 
-     *          btest(nacc(ivx,ip),21)) then
-              if (.not.btest(irest(ivx,ip),24)) then
-c
-c  Not a jump start
-c
-                if (kbdrests .and. btest(irest(ivx,ip),0) .and.
-     *            .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and. 
-     *            nolev(ivx,ip).le.50) 
-     *            call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,
-     *                ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr,
-     *                mult,ipl)
-                call beamstrt(notexq,lnote,nornb,ihornb,space,squez,ib)
-c
-c  Shift beam start if notehead was shifted
-c
-                if (btest(ipl(ivx,ip),8)) then
-                  call addstr(sq//'loff{',6,soutq,lsout)
-                else if (btest(ipl(ivx,ip),9)) then
-                  call addstr(sq//'roff{',6,soutq,lsout)
-                end if
-                if (lnote .gt. 0) call addstr(notexq,lnote,soutq,lsout)
-                if (btest(ipl(ivx,ip),8) .or.
-     *            btest(ipl(ivx,ip),9)) call addstr('}',1,soutq,lsout)
-              else
-c
-c  Jump start.  Set marker for second part of a jump beam. Note ivbj2 was set 
-c  to 0 at end of first part of jump beam
-c
-                ivbj2 = ivx
-c
-c  Check for xtup since we bypassed beamstrt wherein vxtup is normally set
-c
-                if (btest(irest(ivx,ip),28) .and. ixrest(ivx).ne.2)
-     *                                             vxtup(ivx) = .true.
-c
-c  Since beamstrt is not called, and drawbm is normally set there, need to set
-c    it here.  This could cause problems if someone tries a staff-jumping,
-c    unbarred beam, which I'll deal with when it comes up.
-c
-                drawbm(ivx) = .true.
-              end if
-              if (ixrest(ivx) .eq. 0) then
-                beamon(ivx) = .true.
-                bspend = .true.
-                if (.not.btest(irest(ivx,ip),24))bspend = .true.
-              end if
-            end if
-c
-c  Setup for chords and possible slurs in chords
-c
-            if (btest(ipl(ivx,ip),10)) then
-c
-c  There is a chord on this note. Just rerun precrd. Klunky, but saves
-c    me from tracking down errors instroduced when I moved 1st call 
-c    forward for accidental spacing analysis.
-c
-              if (beamon(ivx)) then 
-                call precrd(ivx,ip,nolev(ivx,ip),nacc(ivx,ip),
-     *            ipl(ivx,ip),irest(ivx,ip),ulq(ivx,ibmcnt(ivx)),
-     *            .true.,icashft)
-              else
-                call precrd(ivx,ip,nolev(ivx,ip),nacc(ivx,ip),
-     *              ipl(ivx,ip),irest(ivx,ip),udqq(nolev(ivx,ip),
-     *               ncmid(iv,ip),islur(ivx,ip),nvmx(iv),ivx,nv),
-     *              .true.,icashft)
-              end if
-            end if
-c
-c  Is there slur or grace activity?
-c
-            isgrace = btest(islur(ivx,ip),4)
-            if (ip .gt. 1) isgrace = isgrace.or.btest(ipl(ivx,ip-1),31)
-c
-c  isgrace if not 1st note in bar and previous note has Way-after grace.
-c
-            if (btest(islur(ivx,ip),0) .or. isgrace) then
-              if (btest(islur(ivx,ip),0)) then
-                if (fontslur) then
-c
-c  Call routine for non-postscript slurs
-c
-                  call doslur(nolev(ivx,ip),isdat1,isdat2,isdat3,nsdat,
-     *           ip,iv,kv,nv,beamon(ivx),ncmid(iv,ip),soutq,lsout,
-     *           ulq(ivx,ibmcnt(ivx)),islur(ivx,ip),ipl(ivx,ip),
-     *           iornq(ivx,ip),islhgt,tnote(ipl2(ivx,ip)),
-     *           nacc(ivx,ip))
-                else
-c
-c  Postscript slurs
-c
-                 call dopsslur(nolev(ivx,ip),isdat1,isdat2,isdat3,
-     *           isdat4,nsdat,
-     *           ip,iv,kv,nv,beamon(ivx),ncmid(iv,ip),soutq,lsout,
-     *           ulq(ivx,ibmcnt(ivx)),islur(ivx,ip),ipl(ivx,ip),
-     *           iornq(ivx,ip),islhgt,tnote(ipl2(ivx,ip)),
-     *           nacc(ivx,ip))
-                end if
-	        end if
-              if (isgrace) then
-c
-c Grace note.
-c
-                iphold = ip
-                isgrace = .false.
-                if (ip .gt. 1) isgrace = btest(ipl(ivx,ip-1),31)
-                if (isgrace) iphold = iphold-1
-                isgrace = isgrace .or. (.not.btest(ipl(ivx,ip),31)
-     *            .and..not.btest(ipl(ivx,ip),29))
-c
-c Place grace now if (a) Way-after from prev note and ip>1 or (b) Pre-grace
-c   on current note.  Do A-grace on current note, and W-grace at barend, later.
-c
-                if (isgrace) then
-                  call dograce(ivx,iphold,ptgr,soutq,lsout,ncmid(iv,ip),
-     *                 nacc(ivx,ip),ig,ipl(ivx,iphold),.false.,
-     *                 beamon(ivx),nolev(ivx,ip),ncmid(iv,ip),
-     *                 islur(ivx,ip),nvmx(iv),nv,ibmcnt(ivx),
-c 130324
-c     *                 tnote(ipl2(ivx,ip)),ulq)
-     *                 tnote(ipl2(ivx,ip)),ulq,instno(iv))
-                  if (slurg(ig)) then
-c
-c Terminate slur started in dograce.  Get direction of main note stem
-c
-                    if (.not.beamon(ivx)) then
-c
-c  Separate note.  Get stem direction.
-c
-                      stemup = udqq(nolev(ivx,ip),ncmid(iv,ip),
-     *                     islur(ivx,ip),nvmx(iv),ivx,nv) .eq. 'u'
-                    else
-c
-c  In a beam
-c
-                      stemup = ulq(ivx,ibmcnt(ivx)) .eq. 'u'
-                    end if
-c
-c  Stop the shift if whole note
-c
-                    stemup = stemup .or. 
-     *                       tnote(ipl2(ivx,ip)).gt.63
-                    call endslur(stemup,.not.upg(ig),nolev(ivx,ip),0,
-     *                 ndxslur,0,ncmid(iv,ip),soutq,lsout,fontslur)
-                  end if
-                end if
-              end if
-              if (btest(iornq(ivx,ip),24)) then
-c
-c  Start slur on main note for After- or Way-after-grace.
-c
-c????                ndxslur = log2(33554431-listslur)
-                ndxslur = log2(16777215-listslur)
-c
-c  Get note name
-c
-                call notefq(noteq,lnoten,nolev(ivx,ip),ncmid(iv,ip))
-c
-c  Get slur direction
-c
-                slurudq = 'u'
-                if (.not.beamon(ivx)) then
-                  if (udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip),
-     *                  nvmx(iv),ivx,nv) .eq. 'u') slurudq = 'd'
-                else
-                   if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') slurudq = 'd'
-                end if
-c
-cc  Replace ndxslur by 11-ndxslur when printing only.
-c  Replace ndxslur by 23-ndxslur when printing only.
-c
-c                if (11-ndxslur .lt. 10) then
-                if (23-ndxslur .lt. 10) then
-c                  notexq = sq//'islur'//slurudq//chax(59-ndxslur)
-                  notexq = sq//'islur'//slurudq//chax(71-ndxslur)
-     *              //noteq(1:lnoten)
-                  call addstr(notexq,8+lnoten,soutq,lsout)
-                else if (23-ndxslur .lt. 20) then
-                  notexq = sq//'islur'//slurudq//'{1'//chax(61-ndxslur)
-     *              //'}'//noteq(1:lnoten)
-                  call addstr(notexq,11+lnoten,soutq,lsout)
-                else
-                  notexq = sq//'islur'//slurudq//'{2'//chax(51-ndxslur)
-     *              //'}'//noteq(1:lnoten)
-                  call addstr(notexq,11+lnoten,soutq,lsout)
-                end if
-c                call setbits(ipl(ivx,ip),4,23,ndxslur)
-                call setbits(ipl(ivx,ip),5,23,ndxslur)
-                if (btest(ipl(ivx,ip),31))
-c
-c  Starting slur on W-grace on THIS note.  Record ndxslur.
-c
-     *                listslur = ibset(listslur,ndxslur)
-              end if
-            end if
-c
-c  Process dynamic marks
-c
-            if (btest(irest(ivx,ip),26)) then
-		    call dodyn(ivx,ip,
-     *          nolev(ivx,ip),ncmid(iv,ip),ipl(ivx,ip),islur(ivx,ip),
-     *          irest(ivx,ip),nvmx(iv),nv,beamon(ivx),ihornb,nornb,ulq,
-     *          ibmcnt(ivx),nodur(ivx,ip).ge.64,soutq,lsout)
-            end if
-c
-c  Check for chord notes.  Moved up from below, 10/27/96 so chord orns done 1st.
-c
-            if (btest(ipl(ivx,ip),10)) then
-c
-c  Need a duration to set type of note head
-c
-c             if (.not. vxtup(ivx)) then
-c
-c  Clumsy test, but vxtup is not set until main note is processed.
-c
-              if (.not.(vxtup(ivx).or.btest(irest(ivx,ip),28))) then
-                nodu = nodur(ivx,ip)
-c              else if (mult(ivx,ip) .lt. 0) then
-              else if (iand(mult(ivx,ip),15)-8 .lt. 0) then
-                nodu = 32
-              else
-                nodu = 16
-              end if
-              call docrd(ivx,ip,nodu,ncmid(iv,ip),iv,tnow,soutq,lsout,
-     *                   ulq,ibmcnt(ivx),islur(ivx,ip),nvmx(iv),nv,
-     *                   beamon(ivx),nolev(ivx,ip),ihornb,nornb,stemlen,
-     *                   btest(nacc(ivx,ip),27),nacc(ivx,ip))
-            end if
-c
-c  Now that chords are done, add stuff to midi file
-c
-            if (ismidi) call addmidi(icm,
-c 130316
-c     *          nolev(ivx,ip)-iTransAmt(instno(iv)),
-     *          nolev(ivx,ip)+miditran(instno(iv)),
-c     *          iand(nacc(ivx,ip),7),midisig(instno(iv)),
-     *          iand(nacc(ivx,ip),7),midisig,
-     *          tnote(ipl2(ivx,ip)),
-     *          btest(irest(ivx,ip),0),.false.)
-c
-c  Check for breath or caesura
-c
-            if (btest(iornq(ivx,ip),28)) then
-              call putcb(ivx,ip,notexq,lnote)
-              call addstr(notexq,lnote,soutq,lsout)
-            end if
-c
-c  Check for main-note ornaments. ')' on dotted notes go in with note, not here.
-c  Bits 0-13: (stmgx+Tupf._) ; 14: Down fermata, was F
-c  15: Trill w/o "tr", was U , 16-18 edit. accid., 19-21 TBD
-c
-c            isacc = iand(iornq(ivx,ip),4194287) .gt. 0
-c            isacc = iand(iornq(ivx,ip),541065199) .gt. 0
-            isacc = iand(iornq(ivx,ip),1614807023) .gt. 0
-c
-c  isacc=.true. if any ornament except segno
-c
-            if (btest(iornq(ivx,ip),13) .and. nodur(ivx,ip).gt.0) then
-c
-c  If ).  is only ornament, bypass.  If with others, temporarirly zero the bit.
-c
-              if (2**log2(nodur(ivx,ip)) .ne. nodur(ivx,ip)) then
-                if (iand(iornq(ivx,ip),516079) .eq. 0) then
-c
-c  ). is the only non-segno ornament
-c
-                  isacc = .false.
-                else
-c
-c  There are other ornaments in addition
-c
-                  rpndot = .true.
-                  iornq(ivx,ip) = ibclr(iornq(ivx,ip),13)
-                end if
-              end if
-            end if
-            if (isacc .and. .not.cwrferm(ivx)) then
-c
-c  Check for centered whole-bar rest with fermata (bits 10 or 14).
-c
-              if (iand(iornq(ivx,ip),17408).gt.0
-     *                               .and. btest(irest(ivx,ip),0) .and.
-     *             nodur(ivx,ip).eq.lenbar .and.
-     *             .not.(firstgulp.and.ibar.eq.1.and.lenb0.gt.0)) then
-                cwrferm(ivx) = .true.
-                go to 30
-              end if
-              call putorn(iornq(ivx,ip),nolev(ivx,ip),nolev(ivx,ip),
-     *             nodur(ivx,ip),nornb,ulq,ibmcnt(ivx),ivx,ncmid(iv,ip),
-     *             islur(ivx,ip),nvmx(iv),nv,ihornb,stemlen,
-     *             notexq,lnote,ip,islhgt,beamon(ivx),
-     *             btest(ipl(ivx,ip),10))
-              call addstr(notexq,lnote,soutq,lsout)
-            end if
-            if (rpndot) then
-              iornq(ivx,ip) = ibset(iornq(ivx,ip),13)
-              rpndot = .false.
-            end if
-30          continue
-c
-c  Check for main note accidental
-c
-            if (iand(nacc(ivx,ip),3).gt.0 .and.
-     *            .not.btest(nacc(ivx,ip),17)) then
-              ihshft = igetbits(nacc(ivx,ip),7,10)
-              if (ihshft .ne. 0) ihshft=ihshft-107
-              if (.not.btest(ipl(ivx,ip),10) .and. btest(ipl(ivx,ip),8)) 
-c
-c Not a chord, and left-shifted main note, so left-shift accid
-c
-     *               ihshft = ihshft-20
-              call doacc(ihshft,igetbits(nacc(ivx,ip),6,4),
-     *           notexq,lnote,nacc(ivx,ip),nolev(ivx,ip),ncmid(iv,ip),
-     *           btest(irest(ivx,ip),31))
-              call addstr(notexq,lnote,soutq,lsout)
-            end if
-c
-c  Lower dot for lower-voice notes.  Conditions are:
-c   1. Dotted time value
-c   2. Lower voice of two
-c   3. Note is on a line
-c   4. Not a rest
-c.  5. Flag (lowdot) is set to true
-c   6. Not in an xtuplet
-c
-            if (lowdot .and. nvmx(iv).eq.2 .and. ivx.le.nv
-     *           .and. nodur(ivx,ip).ne.0) then
-              if (.not.btest(irest(ivx,ip),0) .and.
-     *            2**log2(nodur(ivx,ip)).ne.nodur(ivx,ip) .and.
-     *            mod(nolev(ivx,ip)-ncmid(ivx,ip),2).eq.0) then
-                if (btest(irest(ivx,ip),19)) then
-c
-c  Note already in movdot list.  Drop by 2.
-c
-                  updot(ivx,ndotmv(ivx)+1) =
-     *                   updot(ivx,ndotmv(ivx)+1)-2.
-                else
-c
-c  Not in list so just move it right now
-c
-                  call dotmov(-2.,0.,soutq,lsout,
-     *                          igetbits(islur(ivx,ip),1,3))
-                end if
-              end if
-            end if
-c
-c  Check for dotted notes with moved dots
-c
-            if (btest(irest(ivx,ip),19)) then
-              ndotmv(ivx) = ndotmv(ivx)+1
-              call dotmov(updot(ivx,ndotmv(ivx)),rtdot(ivx,ndotmv(ivx)),
-     *           soutq,lsout,igetbits(islur(ivx,ip),1,3))
-            end if
-c
-c  Stemlength changes
-c
-            if (btest(mult(ivx,ip),27)) then
-              dstemlen = igetbits(mult(ivx,ip),6,10)*.5-4. 
-              stemshort = 4.66+.667*dstemlen
-              call addstr(sq//'stemlength{',12,soutq,lsout)
-              write(notexq,'(f4.1)')stemshort
-              call addstr(notexq(1:4)//'}',5,soutq,lsout)
-            else if (ip .gt. 1) then
-              if (btest(mult(ivx,ip-1),27))
-c
-c  Cancel shortening.  Looks like it gets automatically restored if new inst. or
-c    new line, so no need to worry about affecting other lines
-c
-     *           call addstr(sq//'stemlength{4.66}',17,soutq,lsout)
-            end if
-c
-c  Zero out slur-height marker for raising ornaments
-c
-            islhgt = 0
-c
-c  Now start with spacing notes.  Is a beam start pending?
-c
-            if (bspend .and.
-     *            ibm2(ivx,ibmcnt(ivx)).gt.ibm1(ivx,ibmcnt(ivx))) then
-              if (ixrest(ivx) .eq. 4) then
-c
-c  Special path for single note at end of otherwise beamed xtup
-c
-                ixrest(ivx) = 0
-              else
-                if (kbdrests .and. btest(irest(ivx,ip),0) .and.
-     *            .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and. 
-     *            nolev(ivx,ip).le.50) 
-     *            call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,
-     *                ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr,
-     *                mult,ipl)
-                if (btest(islur(ivx,ip),29) 
-     *               .and.btest(irest(ivx,ip),24)) then
-                  notexq = chax(92)//'sk'
-                  lnote = 3
-                else
-                  call beamn1(notexq,lnote)
-                end if
-              end if
-              bspend = .false.
-c
-c  Is a beam ending?
-c
-            else if (numbms(ivx).gt.0 .and. ibmcnt(ivx).le.numbms(ivx)
-c     *           .and. ibm2(ivx,ibmcnt(ivx)) .eq. ip) then
-     *           .and. (ibm2(ivx,ibmcnt(ivx)).eq.ip .or.
-     *             btest(nacc(ivx,ip),20))) then
-              if (bspend) then
-c
-c  Must be a single-note ending of a jump-beam
-c
-                bspend = .false.
-              end if
-              call beamend(notexq,lnote)
-              if (.not.btest(nacc(ivx,ip),20)) then
-                vxtup(ivx) = .false.
-                nornb(ivx) = 0
-                ibmcnt(ivx) = ibmcnt(ivx)+1
-                beamon(ivx) = .false.
-              end if
-c
-c  Or if we're in the middle of a beam
-c
-            else if (numbms(ivx).gt.0 .and. beamon(ivx)) then
-c
-c  Added 130127 
-c          
-              if (kbdrests .and. btest(irest(ivx,ip),0) .and.
-     *            .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and. 
-     *            nolev(ivx,ip).le.50) 
-     *            call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,
-     *                ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr,
-     *                mult,ipl)
-              call beamid(notexq,lnote)
-c
-c      Or whole-bar rest
-c
-            else if (btest(irest(ivx,ip),0)
-     *          .and. nodur(ivx,ip).eq.lenbar
-     *          .and..not.(firstgulp.and.ibar.eq.1.and.lenb0.gt.0)
-     *          .and..not.btest(irest(ivx,ip),25)
-     *          .and..not.btest(islur(ivx,ip),29)) then
-c
-c  Rule out pickup bar, blank rests, non-centered.  Remember islur b19=> rp
-c
-              cwrest(ivx) = .true.
-              iscwr = .true.
-              call notex(cwrq(ivx),lcwr(ivx))
-              tnow = tnow+lenbar
-              go to 10
-            else if (ixrest(ivx) .eq. 0) then
-c
-c  Before writing note or rest, check for keyboard rest height adjustment. 
-c  Conditions are 0. This is a non-blank rest 
-c                 1. kbdrests = .true.
-c                 2. There are two voices on the staff
-c                 3. No user-def height adjustments have been applied (nolev<50)
-cc                 4. Not last note in bar 
-cc                 5. Followed by note (add better test later)
-c
-              if (kbdrests .and. btest(irest(ivx,ip),0) .and.
-     *            .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and. 
-c     *             nolev(ivx,ip).le.50 .and. ip.ne.nn(ivx) 
-c     *            .and. .not.(btest(irest(ivx,ip+1),0))) then
-     *             nolev(ivx,ip).le.50) then
-c
-c  130127 Replaced following code with a subroutine
-c
-cc  Get reference level: next following note if no intervening blank rests, 
-cc    otherwise next prior note.
-cc
-cc               levnext = nolev(ivx,ip+1)-ncmid(iv,ip)+4   ! Relative to bottom line
-c                if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then
-cc
-cc  Not the last note and not "look-left" for level
-cc
-c                  do 8 kkp = ip+1 , nn(ivx)
-c                    if (btest(islur(ivx,kkp),29)) go to 4
-c                    if (.not.btest(irest(ivx,kkp),0)) then
-c                      levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line
-c                      go to 9
-c                    end if
-c8                 continue
-c                end if
-c4               continue
-cc
-cc  If here, there were no following notes or came to a blank rest, or
-cc    "look-left" option set. So look before
-cc
-c                if (ip .eq. 1) go to 2 ! Get out if this is the first note.
-c                do 3 kkp = ip-1, 1, -1
-c                  if (.not.btest(irest(ivx,kkp),0)) then
-c                    levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line
-c                    go to 9
-c                  end if
-c3               continue
-c                go to 2  ! Pretty odd, should never be here, but get out if so.
-c9               continue
-cc
-cc  Find note in other voice at same time
-cc
-c                iupdown = sign(1,ivx-nv-1)
-c                ivother = ivmx(iv,(3-iupdown)/2)
-c                tother = 0.
-c                do 5 kkp = 1 , nib(ivother,ibar)
-c                  if (abs(tother-tnow) .lt. tol) go to 6
-c                  tother = tother+nodur(ivother,kkp)
-c5               continue
-cc
-cc  If here, then no note starts in other voice at same time, so set default
-cc
-c                levother = -iupdown*50
-c                go to 7
-c6               continue
-cc
-cc  If here, have just identified a simultaneous note or rest in other voice
-cc
-c                if (.not.btest(irest(ivother,kkp),0)) then ! Not a rest, use it
-c                  levother = nolev(ivother,kkp)-ncmid(iv,ip)+4
-c                else
-c                  if (nodur(ivother,kkp) .eq. nodur(ivx,ip)) then
-cc
-cc  Rest in other voice has same duration, get out (so defualt spacing is used)
-cc
-c                    go to 2
-c                  end if
-c                  levother = -iupdown*50
-c                end if
-c7               continue
-c                indxr = log2(nodur(ivx,ip))+1
-c                if (iupdown .lt. 0) then
-c                  levtop = levtopr(indxr)
-c                  iraise1 = levother-levtop-3  ! Based on other note
-c                  iraise2 = levnext-levtop     ! Based on following note
-c                  if (indxr.eq.5 .and. levnext.lt.1) iraise2=iraise2+2
-c                  iraise = min(iraise1,iraise2)
-c                  if (mod(iraise+50,2).eq.1 .and. 
-c     *                iraise+levtop.gt.-1) iraise = iraise-1
-c                else
-c                  levbot = levbotr(indxr)
-c                  iraise1 = levother-levbot+3
-c                  iraise2 = levnext-levbot
-c                  if (indxr.eq.5 .and. levnext.gt.8) iraise2=iraise2-1
-c                  iraise = max(iraise1,iraise2)
-c                  if (mod(iraise+50,2).eq.1 .and. 
-c     *                iraise+levbot.le.9) iraise = iraise-1
-c                end if
-c                nolev(ivx,ip) = 100+iraise
-c
-c  The new subroutine call, to replace above code
-c
-                call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,
-     *            ivmx,nib,nv,ibar,tnow,tol,nodur,1,levtopr,levbotr,
-c     *                mult)
-     *                mult,ipl)
-              end if
-c2             continue
-c
-c  Write a separate note or rest
-c
-              call notex(notexq,lnote)
-            end if
-c
-c  Right offset?  This may cause trouble
-c
-            if (btest(ipl(ivx,ip),8)) then
-              call addstr(sq//'loff{',6,soutq,lsout)
-            else if (btest(ipl(ivx,ip),9)) then
-              call addstr(sq//'roff{',6,soutq,lsout)
-            end if
-            if (ixrest(ivx).eq.0 .and. lnote.gt. 0)
-     *                call addstr(notexq,lnote,soutq,lsout)
-            if (btest(ipl(ivx,ip),8) .or.
-     *          btest(ipl(ivx,ip),9)) call addstr('}',1,soutq,lsout)
-c
-c  Terminate user-defined offsets.  Fix format
-c
-            if (btest(irest(ivx,ip),15) .or. btest(irest(ivx,ip),17))
-     *          call putshft(ivx,.false.,soutq,lsout)
-c
-c  Deal with After- and Way-after-graces.  First, if end of bar, compute space
-c    needed since it wasn't done during general ask-checks. If extra space is
-c    rq'd, convert GW to GA.  Therefore GW at end of bar never needs extra sp.
-c    But will still need to add extra space as hardspace.
-c
-            if (ip.eq.nn(ivx) .and. (btest(ipl(ivx,ip),31).or.
-     *                               btest(ipl(ivx,ip),29))) then
-              do 77 ig = 1 , ngrace
-                if (ipg(ig).eq.ip .and. ivg(ig).eq.ivx) go to 78
-77            continue
-              print*,'Problem finding grace index at "do 77"'
-              call stop1()
-78            continue
-c
-c  Get elemskip to end of bar.  WON'T WORK IF XTUPS !!
-c
-              esk = 0.
-              do 40 iib = ib , nb
-                if (iib .eq. ib) then
-                  itleft = nint(to(ipl2(ivx,ip)))
-                else
-                  itleft = nint(tstart(ib))
-                end if
-                if (iib .lt. nb) then
-                  itright = nint(tstart(iib+1))
-                else
-                  itright = lenbar
-                end if
-                esk = esk+feon(space(ib))*
-     *                          (itright-itleft)/space(ib)
-40            continue
-              ptsavail = poenom*esk-wheadpt
-              if (nng(ig) .eq. 1) then
-                wgr = grafac
-              else
-                wgr = nng(ig)*emgfac
-                do 41 ing = 1 , nng(ig)
-                  if (naccg(ngstrt(ig)-1+ing) .gt. 0) wgr = wgr+acgfac
-41              continue
-              end if
-              ptgr(ig) = wgr*wheadpt
-              ptsneed = (wgr+0.5)*wheadpt
-              ptsndg(ivx) = 0.
-              if (ptsavail .lt. ptsneed) then
-                ptsndg(ivx) = ptsneed
-                eskndg(ivx) = esk
-                if (btest(ipl(ivx,ip),31)) then
-c
-c  Convert GW to GA
-c
-                  ipl(ivx,ip) = ibset(ibclr(ipl(ivx,ip),31),29)
-                end if
-              end if
-            end if
-c
-c  Check for GA
-c
-            if (btest(ipl(ivx,ip),29))
-     *        call dograce(ivx,ip,ptgr,soutq,lsout,ncmid(iv,ip),
-     *            nacc(ivx,ip),ig,ipl(ivx,ip),.false.,
-c 130324
-c     *            .false.,0,0,0,0,0,0,0.,ulq)
-     *            .false.,0,0,0,0,0,0,0.,ulq,instno(iv))
-c
-c  Update running time
-c
-            tnow = tnow+space(ib)
-10        continue
-c
-c  Have finished last note in this voice and block
-c
-          itendb = nint(to(istop(ib))+space(ib))
-          if (figbass .and. ivx.eq.1 .or. ivx.eq.ivxfig2) then
-            ivf = 1
-            if (ivx .gt. 1) ivf = 2
-17          if (figchk(ivf) .and. itfig(ivf,ifig(ivf)).lt.itendb) then
-c
-c  There's at least one figure left. offnsk could be <0
-c
-              offnsk = (tnow-itfig(ivf,ifig(ivf)))/space(ib)
-              call putfig(ivf,ifig(ivf),offnsk,figchk(ivf),soutq,lsout)
-              go to 17
-            end if
-          end if
-c
-c  Check for flag, dot, or upstem on last note of bar.
-c
-          if (ib .eq. nb) then
-            ip = ipo(ipl2(ivx,nn(ivx)))
-            flgndv(ivx) = 0.
-            if (abs(tnote(ipl2(ivx,ip))-space(ib)).lt.tol) then
-              if (space(ib) .lt. 16.-tol) then
-c
-c  Note in last space, smaller than a quarter note.
-c
-                if ((.not.btest(irest(ivx,ip),0) .and.
-     *             udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip),
-     *             nvmx(iv),ivx,nv).eq.'u')
-     *            .or. isdotted(nodur,ivx,ip)) then
-c
-c  Upstem non-rest, or dotted
-c
-                  if (numbms(ivx).gt.0
-     *              .and. ip.eq.ibm2(ivx,max(1,numbms(ivx)))
-     *              .and. .not.isdotted(nodur,ivx,ip))
-     *               then
-c
-c  In beam and not dotted, so use smaller space
-c
-                    flgndv(ivx) = upstmfac
-                  else
-                    flgndv(ivx) = flagfac
-                  end if
-                end if
-              else
-c
-c  Last space, nonflagged (no beam) only worry dot or up
-c
-                if (isdotted(nodur,ivx,ip)) then
-                  flgndv(ivx) = flagfac
-                else if (tnote(ipl2(ivx,ip)).lt.64 .and.
-     *              udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip),
-     *                   nvmx(iv),ivx,nv).eq.'u') then
-c
-c  Upstem on last note , non-flagged
-c
-                  flgndv(ivx) = upstmfac
-                end if
-              end if
-            end if
-c
-c  Check for right-shifted chordal note
-c
-            if (btest(irest(ivx,ip),20)) flgndv(ivx) = rtshfac
-            flgndb = flgndb .or. flgndv(ivx).gt.0.
-            if (ismidi) then
-c
-c  For midi, set flags for accidentals on last note of bar.  Assume they affect 
-c    first note of next bar whether or not tied.  
-c  Note has already been done, so next entry into addmidi is 1st in new bar.
-c  First do main note, then chord notes
-c
-c  Gyrations needed to account for multi-bar tied full-bar notes?
-cc  Old old    lbacc(icm) = iand(nacc(ivx,ip),7)
-c   New old    if (lbacc(icm).eq.0) lbacc(icm) = iand(nacc(ivx,ip),7)
-c
-              if (iand(nacc(ivx,ip),7) .gt. 0) then
-c
-c  Explicit accidental on last main note in bar
-c
-                do 55 kacc = 1 , naccbl(icm)
-                  if (laccbl(icm,kacc) .eq. nolev(ivx,ip)) go to 56
-55              continue
-                naccbl(icm) = naccbl(icm)+1
-                laccbl(icm,naccbl(icm)) = nolev(ivx,ip)
-                jaccbl(icm,naccbl(icm)) = iashft(iand(nacc(ivx,ip),7))
-              end if
-56            continue
-              if (btest(ipl(ivx,ip),10) .and. crdacc) then
-                do 57 icrd = icrd1 , icrd2
-                  iacc = igetbits(icrdat(icrd),3,20)
-                  if (iacc .gt. 0) then
-c
-c  Explicit accidental on chord note at end of bar
-c
-                    nolevc = igetbits(icrdat(icrd),7,12)
-                    do 58 kacc = 1 , naccbl(icm)
-                      if (laccbl(icm,kacc) .eq. nolevc) go to 59 
-58                  continue
-                    naccbl(icm) = naccbl(icm)+1
-                    laccbl(icm,naccbl(icm)) = nolevc
-                    jaccbl(icm,naccbl(icm)) = iashft(iacc)
-                  end if
-59                continue
-57              continue
-              end if
-c              if (lbacc(icm).eq.0 .and. accb4(icm)) then
-              do 65 kacc = 1 , naccim(icm) 
-c
-c  If naccim(icm)>0, 
-c  possible implicit accidental from earlier in the bar.  Check for prior accid 
-c  in this bar at relevant note levels, main and chord notes.  Only act if no
-c  explicit action from just above.  Assuming any accid on last note in bar,
-c  either explicit or implicit, has same effect on 1st note of next bar. 
-c
-                if (nolev(ivx,ip) .eq. laccim(icm,kacc)) go to 66
-                if (btest(ipl(ivx,ip),10)) then
-                  do 67 icrd = icrd1 , icrd2
-                    if (iand(ishft(icrdat(icrd),-12),127) .eq.
-     *                                 laccim(icm,kacc)) go to 66
-67                continue
-                end if
-                go to 65
-66              continue
-c
-c  So far we know there is a main or chord note at level laccim(icm,kacc). So
-c   it will get a bl-accid if it didn't just already get one.
-c
-                do 68 macc = 1 , naccbl(icm)
-                  if (laccbl(icm,macc) .eq. laccim(icm,kacc)) go to 65 
-68              continue
-                naccbl(icm) = naccbl(icm)+1
-                laccbl(icm,naccbl(icm)) = laccim(icm,kacc)
-                jaccbl(icm,naccbl(icm)) = jaccim(icm,kacc)
-65            continue
-            end if
-          end if
-11      continue
-c
-c  Close out the notes group
-c
-        call addstr(sq//'en',3,soutq,lsout)
-        if (islast.and.lsout .gt. 0) write(11,'(a)')soutq(1:lsout)//'%'
-16    continue
-c
-c  Check for way-after graces at end of bar.  We could not link these to notes
-c  as in midbar since there is no note following grace!  Also, set flag if
-c  hardspace is needed. Also, save nvmx, ivmx for use in space checks on reloop.
-c
-      isgrace = .false.
-      do 75 iv = 1 , nv
-      nvmxsav(iv) = nvmx(iv)
-      do 75 kv = 1 , nvmx(iv)
-        ivmxsav(iv,kv) = ivmx(iv,kv)
-        ivx = ivmx(iv,kv)
-        ptsgnd = 0.
-        if ((btest(ipl(ivx,nn(ivx)),29).or.btest(ipl(ivx,nn(ivx)),31))
-     *      .and. ptsndg(ivx).gt.0.) then
-          flgndb = .true.
-          if (ptsndg(ivx) .gt. ptsgnd) then
-            ptsgnd = ptsndg(ivx)
-            eskgnd = eskndg(ivx)
-          end if
-        end if
-        if (btest(ipl(ivx,nn(ivx)),31)) then
-c
-c  This voice has a way-after grace here at end of bar
-c
-          if (.not.isgrace) then
-c
-c  This is the first one, so set up the string
-c
-            isgrace = .true.
-            ivlast = 1
-            soutq = sq//'znotes'
-            lsout = 7
-          end if
-          do 76 iiv = ivlast , iv-1
-            call addstr(sepsymq(iiv),1,soutq,lsout)
-76        continue
-          ivlast = iv
-c
-c  No need to put in 'nextvoice', even if 2 lines/staff
-c
-          call dograce(ivx,nn(ivx),ptgr,soutq,lsout,ncmid(iv,nn(ivx)),
-     *      nacc(ivx,nn(ivx)),ig,ipl(ivx,nn(ivx)),.true.,
-c 130324
-c     *      .false.,0,0,0,0,0,0,0.,ulq)
-     *      .false.,0,0,0,0,0,0,0.,ulq,instno(iv))
-        end if
-75    continue
-      if (isgrace) then
-        call addstr(sq//'en%',4,soutq,lsout)
-        if (islast .and. lsout .gt. 0) write(11,'(a)')soutq(1:lsout)
-      end if
-      lsout = 0
-c
-c  Write multibar rest.  Assuming nv = 1  and do not worry about cwbrest
-c  This has to be the only use of atnextbar
-c
-      if (ibar.eq.ibarmbr .and. islast) then
-        soutq = sq//'def'//sq//'atnextbar{'//sq//'znotes'
-        lsout = 22
-        notexq = sq//'mbrest'
-        lnote = 7
-        call istring(mbrest,noteq,len)
-        notexq = notexq(1:lnote)//noteq(1:len)
-        lnote = lnote+len
-        mtrspc = nint(xb4mbr)
-        xb4mbr = 0.
-        call istring(mtrspc,noteq,len)
-        notexq = notexq(1:lnote)//noteq(1:len)//'0'
-        lnote = lnote+len+1
-        do 62 iv = 1 , nv
-          call addstr(notexq,lnote,soutq,lsout)
-          if (iv .lt. nv) call addstr(sepsymq(iv),1,soutq,lsout)
-62      continue
-        call addstr(sq//'en}%',5,soutq,lsout)        
-        write(11,'(a)')soutq(1:lsout)
-        lsout = 0
-        if (mbrest .gt. 1) then
-          ndig = int(alog10(mbrest-1+.01))+1
-          write(11,'(a14,i'//chax(48+ndig)//',a1)')
-     *             sq//'advance'//sq//'barno',mbrest-1,'%'
-        end if
-      else if (iscwr) then
-c
-c  Centered whole-bar rests. Set flag to pass to pmxb at start of NEXT bar
-c    to check for new clef and add space by redefining \CenterBar
-c
-        centrests = .true.
-        call addstr(sq//'def'//sq//'value{0}',13,soutq,lsout)
-        call addstr(sq//'def'//sq//'atnextbar{'//sq//'znotes',22,
-     *              soutq,lsout)
-        do 60 iv = 1 , nv
-c added
-          lnote = 0
-c
-          do 61 kv = 1 , nvmx(iv)
-            ivx = ivmx(iv,kv)
-            if (cwrest(ivx)) then
-              call addstr(sq//'CenterBar{',11,soutq,lsout)              
-              if (.not.cwrferm(ivx)) then
-                if (lcwr(ivx).ge.11 .and. cwrq(ivx)(11:11).ne.'p') then
-c
-c  Kluge to use new definitions for centered, stacked rests
-c
-                  if (cwrq(ivx)(2:10).eq.'liftpause' .or.
-     *                cwrq(ivx)(2:10).eq.'liftPAuse') 
-     *                                   cwrq(ivx)(10:10) = 'c'
-                end if
-                call addstr(cwrq(ivx)(1:lcwr(ivx)),lcwr(ivx),soutq,
-     *             lsout)
-                call addstr('}{-2}{'//sq//'value}',13,soutq,lsout)
-              else
-c
-c  Fermata on centered rest.  Will need to fix up level.
-c  12/6/07 shift it left so it's centered over rest
-c
-                notexq = notexq(1:lnote)//sq//'loffset{.33}{'
-     *                   //sq//'fermataup7}'//cwrq(ivx)(1:lcwr(ivx))
-     *                   //'}{-2}{'//sq//'value}'
-                lnote = lnote+26+lcwr(ivx)+13
-                call addstr(notexq,lnote,soutq,lsout)
-                cwrferm(ivx) = .false.
-              end if
-            end if
-61        continue
-          if (iv .ne. nv) call addstr(sepsymq(iv),1,soutq,lsout)
-60      continue
-        if (islast) then
-          call addstr(sq//'en}%',5,soutq,lsout)
-          if (lsout.gt.0)write(11,'(a)')soutq(1:lsout)
-        end if
-      end if
-c
-c  End of block for centered whole-bar rests and multi-bar rests
-c
-c  If at end of block, save durations of last notes in bar, for possible use
-c  if clef changes at start of next bar
-c
-      if (ibar .eq. nbars) then
-        do 63 iv = 1 , nv
-        do 63 kv = 1 , nvmx(iv)
-          ivx = ivmx(iv,kv)
-          prevtn(ivx) = tnote(ipl2(ivx,nn(ivx)))
-63      continue
-      end if
-c
-c  Update time for midi.  This is only used for the event track
-c
-      if (ismidi) then
-        miditime = miditime+15*lenbar
-c
-c  If pickup, write the real time signature to the event track.  Cannot use
-c    mtrnuml since it was reset to 0, have to recompute it
-c
-        if (lenb0 .eq. lenbar) 
-     *        call midievent('m',mtrdenl*lenb1/64,mtrdenl)
-      end if
-      return
-      end
-      subroutine makeabar()
-c
-c  On input, have pseudo-durations in nodur(ivx,ip).  Not real durations for
-c    xtups, since only last note of xtup gets non-zero nodur, which 
-c    corresponds to single note of full length of xtup.
-c  In this subroutine we make an ordered list of all notes in all voices.
-c    ilnc      = list note counter
-c    ivxo(ilnc), ipo(ilnc) = voice# and position in voice of ilnc-th note.
-c    to(ilnc)  = real start time of note in PMX-units (64=whole note)
-c    tno(ilnc) = time to next event in the bar.   
-c    tnote(ilnc) = actual duration of note
-c  Then run thru list, grouping consecutive notes into \notes groups ib.  
-c    space(ib) = real time unit for the \notes group 
-c    squez(ib) = factor on space to get effective space.  This will be 1 if
-c                there is a note exactly spanning each interval of space, and
-c                <1 if not.  
-c  Details:  let eon = elemskips per noteskip (like length).  Basic formula is
-c    eon = sqrt(space/2.)  
-c  If tgovern >= space, then 
-c    eon = sqrt(tgovern/2)*(space/tgovern) = space/sqrt(2*tgovern). 
-c  Time needed to give this eon using basic formula is
-c    teq = space**2/tgovern
-c  Factor on space to get teq is
-c    squez(ib) = space/tgovern
-c  The eon for each ib can then be computed based on time of space*squez.
-c  Iff squez = 1, there is a note spanning every increment in the \notes group.
-c
-c    tnminb = minimum time span in the bar for increments spanned by notes,
-c             i.e., with squez=1.  Use after parsing into line to decide if
-c             spacing needs to be "flattened" among notes groups.   
-c
-      common /comtol/ tol
-      parameter (nm=24,nkb=3999,maxblks=4000)
-      common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm),
-     *   nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount,
-     *   nbars,itsofar(nm),nib(nm,15),nn(nm),
-     *   rest(nm,200),lenbr0,lenbr1,firstline,newmeter
-      common /linecom/ elskb,tnminb(nkb)
-      common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks),
-     *     iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr,
-c     *     ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks)
-     *     ibaroff,udsp(nkb),wheadpt,sqzb(maxblks)
-      common /c1ommvl/ nvmx(nm),ivmx(nm,2),ivx,fbar,nacc(nm,200)
-c      logical rest,firstline,newmeter,gotclef
-      logical rest,firstline,newmeter
-      integer cnn(nm),istart(80),istop(80)
-      real*4 xit(nm),space(80),tstart(80),squez(80),tnote(600)
-      elskb = 0.
-      tnminb(ibarcnt) = 1000.
-      do 1 iv = 1 , nv
-      do 1 kv = 1 , nvmx(iv)
-        ivx = ivmx(iv,kv)
-        if (ibar .gt. 1) then
-          nn(ivx) = nib(ivx,ibar)-nib(ivx,ibar-1)
-        else
-          nn(ivx) = nib(ivx,ibar)
-        end if
-1     continue
-c
-c initialize list note counter, time(iv), curr. note(iv)
-c
-      ilnc = 1
-      do 4 iv = 1 , nv
-      do 4 kv = 1 , nvmx(iv)
-        ivx = ivmx(iv,kv)
-        cnn(ivx) = 1
-        ivxo(ilnc) = ivx
-        ipo(ilnc) = 1
-        to(ilnc) = 0.
-        tnote(ilnc) = fnote(nodur,ivx,1,nacc)
-        xit(ivx) = tnote(ilnc)
-        if (abs(xit(ivx)-lenbar).lt.tol) xit(ivx) = 1000.
-        ilnc = ilnc+1
-4     continue
-c
-c  Build the list
-c
-5     continue
-c
-c  Determine which voice comes next from end of notes done so far.
-c  tmin is the earliest ending time of notes done so far
-c
-      tmin = 1000.
-      do 6 iv = 1 , nv
-      do 6 kv = 1 , nvmx(iv)
-        ivx = ivmx(iv,kv)
-        tminn = min(tmin,xit(ivx))
-        if(tminn .lt. tmin) then
-          tmin = tminn
-          ivnext = ivx
-        end if
-6     continue
-      if (tmin .gt. 999.) go to 7
-      ivxo(ilnc) = ivnext
-      cnn(ivnext) = cnn(ivnext)+1
-      ipo(ilnc) = cnn(ivnext)
-      to(ilnc) = tmin
-c
-c  Check if this voice is done
-c
-      tnote(ilnc) = fnote(nodur,ivnext,cnn(ivnext),nacc)
-      if (cnn(ivnext) .eq. nn(ivnext)) then
-        xit(ivnext) = 1000.
-      else
-        xit(ivnext) = xit(ivnext)+tnote(ilnc)
-      end if
-      ilnc = ilnc+1
-      go to 5
-7     continue
-      ntot = ilnc-1
-      if (ntot .gt. 600) then
-        call printl(' ')
-        call printl('Cannot have more than 600 notes per bar, stopping')
-        call stop1()
-      end if
-      do 8 in = 1 , ntot-1
-        tno(in) = to(in+1)-to(in)
-8     continue
-      tno(ntot) = fnote(nodur,ivxo(ntot),ipo(ntot),nacc)
-      tnote(ntot) = tno(ntot)
-c
-c  Debug writes
-c
-c      write(*,'()')
-c      write(*,'(16i5)')(ivxo(in),in=1,ntot)
-c      write(*,'(16i5)')(ipo(in),in=1,ntot)
-c      write(*,'(16f5.1)')(to(in),in=1,ntot)
-c      write(*,'(16f5.1)')(tno(in),in=1,ntot)
-c      write(*,'(16i5)')(nodur(ivxo(in),ipo(in)),in=1,ntot)
-c      write(*,'(16f5.1)')(tnote(in),in=1,ntot)
-c
-c  Done w/ list.  Initialize loop for building note blocks:
-c
-      ib = 1
-      istart(1) = 1
-      space(1) = 0.
-      in = 1
-c
-c  Start the loop
-c
-9     continue
-        if (in .eq. ntot) then
-          if (space(ib) .lt. tol) then
-            space(ib) = tno(in)
-c
-c  Last gap in bar is spanned by a note, so cannot need a squeeze. 
-c
-            squez(ib) = 1.
-          end if
-          istop(ib) = ntot
-c
-c From here flow out of this if block and into block-setup
-c
-        else if (space(ib) .lt. tol) then
-c
-c space hasn't been set yet, so tentatively set:
-c
-          space(ib) = tno(in)
-          if (space(ib) .lt. tol) then
-            in=in+1
-          else
-c
-c  Tentative space tno(in) is non-zero. Set squez, which will be kept (since
-c    it is a unique property of the particular increment starting here) :
-c
-            squez(ib) = getsquez(in,ntot,space(ib),tnote,to)
-            istop(ib) = in
-          end if
-          go to 9
-        else if (tno(in+1) .lt. tol) then
-c
-c This is not the last note in the space, so
-c
-          in = in+1
-          go to 9
-        else if (abs(tno(in+1)-space(ib)) .lt. tol) then
-c
-c  Next increment has same space.  Does it have same squez?
-c
-          xsquez = getsquez(in+1,ntot,space(ib),tnote,to)
-c
-c  If it does have the same squez, loop, otherwise flow out
-c
-          if (abs(xsquez-squez(ib)) .lt. tol) then
-c
-c Keep spacing the same, update tentative stop point
-c
-            in = in+1
-            istop(ib) = in
-            go to 9
-          end if
-        end if
-c
-c At this point istart, istop, space, and squez are good, so close out block
-c
-        tstart(ib) = to(istart(ib))
-c
-c  Compute elemskips assuming no flattening to increase min space.  The formula
-c  is only correct if f1eon(t) = sqrt(t/2); more generally (after possible
-c  flattening in pmxb), elsperns = squez*feon(space/squez)
-c
-        elsperns = f1eon(space(ib)*squez(ib))
-        if (istop(ib) .eq. ntot) then
-          nnsk = nint((lenbar-tstart(ib))/space(ib))
-        else
-          nnsk = nint((to(istop(ib)+1)-tstart(ib))/space(ib))
-        end if
-        elskb = elskb+elsperns*nnsk
-        if (nptr(ibarcnt+1) .gt. nptr(ibarcnt)) then
-          call catspace(space(ib),squez(ib),nnsk)
-        else
-c
-c  This is the first entry for this bar
-c
-          nnpd(nptr(ibarcnt)) = nnsk
-          durb(nptr(ibarcnt)) = space(ib)
-          sqzb(nptr(ibarcnt)) = squez(ib)
-          nptr(ibarcnt+1) = nptr(ibarcnt+1)+1
-        end if
-c
-c  Update minimum space spanned by a note
-c
-        if (abs(squez(ib)-1) .lt. tol) 
-     *       tnminb(ibarcnt) = min(tnminb(ibarcnt),space(ib))
-        if (istop(ib) .eq. ntot) go to 15
-c
-c  End of spatial accounting for now
-c
-        ib = ib+1
-        istart(ib) = istop(ib-1)+1
-        in = istart(ib)
-c
-c Set tentative block space for new block
-c
-        space(ib) = tno(in)
-        if (space(ib).gt.tol) 
-     *        squez(ib)= getsquez(in,ntot,space(ib),tnote,to)
-        istop(ib) = in
-      go to 9
-15    continue
-c     nb = ib
-c
-c  Debug writes
-c
-c      write(*,'(16i5)')(istart(ib),ib=1,nb)
-c      write(*,'(16i5)')(istop(ib),ib=1,nb)
-c      write(*,'(16f5.1)')(space(ib),ib=1,nb)
-c      write(*,'(16f5.1)')(squez(ib),ib=1,nb)
-c
-      return
-      end
-      subroutine midievent(typeq,in1,in2)
-c
-c  We now store "conductor" events in mmidi(numchan,.), and count bytes
-c    with imidi(numchan)
-c
-      parameter (nm=24,mv=24576)
-      integer*2 mmidi
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      common /comevent/ miditime,lasttime
-      character*1 typeq
-      idur = isetvarlen(miditime-lasttime,nbytes)
-      imidi(numchan) = imidi(numchan)+nbytes+1
-      do 1 i = 1 , nbytes
-        mmidi(numchan,imidi(numchan)-i) =  mod(idur,256)
-        idur = ishft(idur,-8)
-1     continue
-      mmidi(numchan,imidi(numchan)) = 255
-      if (typeq .eq. 't') then
-c
-c  Tempo event.  in1 = quarters per minute (integer)
-c
-        mmidi(numchan,imidi(numchan)+1) = 5*16+1
-        mmidi(numchan,imidi(numchan)+2) = 3
-        misperq = nint(60000000./in1)
-        do 2 i = 1 , 3
-          mmidi(numchan,imidi(numchan)+6-i) =  mod(misperq,256)
-          misperq = ishft(misperq,-8)
-2       continue
-        imidi(numchan) = imidi(numchan)+5
-      else if (typeq .eq. 'm') then
-c
-c  Meter event.  in1=numerator, in2=denom (power of 2)
-c
-        mmidi(numchan,imidi(numchan)+1) = 5*16+8
-        mmidi(numchan,imidi(numchan)+2) = 4
-        mmidi(numchan,imidi(numchan)+3) = in1
-        if (in2 .gt. 0) then
-          mmidi(numchan,imidi(numchan)+4) = log2(in2)
-        else
-          mmidi(numchan,imidi(numchan)+4) = 0
-        end if
-        mmidi(numchan,imidi(numchan)+5) = 24
-        mmidi(numchan,imidi(numchan)+6) = 8
-        imidi(numchan) = imidi(numchan)+6
-      else if (typeq .eq. 'k') then
-c
-c  Keychange event.  in1 = isig
-c
-        mmidi(numchan,imidi(numchan)+1) = 5*16+9
-        mmidi(numchan,imidi(numchan)+2) = 2
-        mmidi(numchan,imidi(numchan)+3) = mod(256+in1,256)
-        mmidi(numchan,imidi(numchan)+4) = 0
-        imidi(numchan) = imidi(numchan)+4
-      else
-        print*,'Program flameout in midievent'
-        call stop1()
-      end if
-      lasttime = miditime
-      return
-      end
-      subroutine moveln(iuin,iuout,done)
-      logical done
-      character*129 outq
-      done = .false.
-      read(iuin,'(a)',end=1) outq
-      lenout = llen(outq,129)
-      write(iuout,'(a)') outq(1:lenout)
-      return
-1     done = .true.
-      return
-      end
-      subroutine mrec1(lineq,iccount,ndxm)
-c
-c  This is called when (a) macro recording is just starting and
-c  (b) at the start of a new line, if recording is on
-c
-      parameter (maxblks=4000)
-      character*128 lineq,lnholdq
-      common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
-      logical mrecord,mplay,endmac
-      common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20),
-     *                 ic1mac(20),ilmac,iplmac
-      character*65536 bufq
-      integer*2 lbuf(maxblks)
-      common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
-      if (.not.mrecord) then
-c
-c  Starting the macro
-c
-        ip1mac(macnum) = ipbuf-lbuf(ilbuf-1)+iccount
-        il1mac(macnum) = ilbuf-1
-        ic1mac(macnum) = iccount
-        mrecord = .true.
-      end if
-      if (iccount .lt. 128) then
-        ndxm = index(lineq(iccount+1:128),'M')
-        if (ndxm .gt. 0) ndxm = ntindex(lineq(iccount+1:128),'M',
-     *                                  128-iccount)
-        if (ndxm .gt. 0) then
-c
-c  This line ends the macro.
-c
-          ip2mac(macnum) = ipbuf-lbuf(ilbuf-1)+iccount+ndxm
-          il2mac(macnum) = ilbuf-1
-          mrecord = .false.
-        end if
-      end if
-      return
-      end
-      function ncmid(iv,ip)
-      parameter (nm=24)
-      common /all/ mult(nm,200),jv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      common /comipl2/ ipl2(nm,200)
-      character*1 ulq,sepsymq,sq
-      logical beamon,firstgulp,figbass,figchk,isfig
-      common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
-     *               ndotmv(nm),updot(nm,20),rtdot(nm,20)
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-	common /comtol/ tol
-        if (ncc(iv) .eq. 1) then
-          ncmid = ncmidcc(iv,1)
-        else
-          xtime = to(ipl2(ivx,ip))
-          do 1 icc = ncc(iv) , 1 , -1
-            if (xtime .gt. tcc(iv,icc)-tol) then
-              ncmid = ncmidcc(iv,icc)
-              return
-            end if
-1         continue
-          print*,'Problem in ncmid()'
-          stop
-        end if
-      end
-      function ncmidf(clefq)
-c
-c  Return middle line of a clef
-c
-      character*1 clefq
-c      if (clefq.eq.'t' .or. clefq.eq.'0') then
-c        ncmidf = 35
-c      else if (clefq.eq.'s' .or. clefq.eq.'1') then
-c        ncmidf = 33
-c      else if (clefq.eq.'m' .or. clefq.eq.'2') then
-c        ncmidf = 31
-c      else if (clefq.eq.'a' .or. clefq.eq.'3') then
-c        ncmidf = 29
-c      else if (clefq.eq.'n' .or. clefq.eq.'4') then
-c        ncmidf = 27
-c      else if (clefq.eq.'r' .or. clefq.eq.'5') then
-c        ncmidf = 25
-c      else if (clefq.eq.'f' .or. clefq.eq.'7') then
-c        ncmidf = 37
-c      else
-c        ncmidf = 23
-c      end if
-      if (clefq .eq. '8') then
-c
-c  treblelowoct; will treat as treble for this purpose
-c
-        ncmidf = 35
-      else
-        ncmidf = 21+index(' b6r5n4a3m2s1t0f7',clefq)/2*2
-      end if
-      return
-      end
-      subroutine newvoice(jv,clefq,change)
-      parameter (nm=24)
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      character*1 ulq,sepsymq,sq
-      logical beamon,firstgulp,figbass,figchk,isfig
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb,
-     *               tautofb,autofbon,t1autofb
-      character*1 ulfbq,clefq
-      common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
-     *               ndotmv(nm),updot(nm,20),rtdot(nm,20)
-      common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
-      logical change,autofbon
-      nvmx(jv) = 1
-      ivmx(jv,1) = jv
-      itsofar(jv) = 0
-      nnl(jv) = 0
-      nfb(jv) = 0
-      if (firstgulp .or. change) then
-        ncmidcc(jv,1) = ncmidf(clefq)
-      else
-        ncmidcc(jv,1) = ncmidcc(jv,ncc(jv))
-      end if
-      tcc(jv,1) = 0.
-      ncc(jv) = 1
-      nudoff(jv) = 0
-      ndotmv(jv) = 0
-      do 5 j = 1 , 200
-        irest(jv,j) = 0
-        islur(jv,j) = 0
-        ipl(jv,j) = 0
-        nacc(jv,j) = 0
-        iornq(jv,j) = 0
-        mult(jv,j) = 0
-        if (jv.le.2) isfig(jv,j) = .false.
-5     continue
-      return
-      end
-      subroutine notefq(noteq,lnote,nolev,ncmid)
-c
-c  Returns name of note level with octave transpositions, updates noctup.
-c
-      common /comoct/ noctup
-      character*8 noteq
-      character*1 upcaseq,noteqt,chax
-      nupfroma = mod(nolev+1,7)
-      iname = 97+nupfroma
-      ioctup = (nolev+1)/7-4
-      noteqt = chax(iname)
-      if (ncmid .eq. 23) noteqt = upcaseq(noteqt)
-      if (ioctup .eq. noctup) then
-        noteq = noteqt
-        lnote = 1
-c
-c  Must ALWAYS check if lnote=1 for use with functions requiring a blank
-c
-      else if (ioctup .gt. noctup) then
-c
-c  Raise octave.  Encase in {}
-c
-        write(noteq,'(8a1)')'{',(chax(39),i=noctup,ioctup-1),
-     *                        noteqt,'}'
-        lnote = 3+ioctup-noctup
-        noctup = ioctup
-      else
-c
-c  Lower octave
-c
-        write(noteq,'(8a1)')'{',(chax(96),i=ioctup,noctup-1),
-     *                        noteqt,'}'
-        lnote = 3+noctup-ioctup
-        noctup = ioctup
-      end if
-      return
-      end
-      subroutine notex(notexq,lnote)
-c
-c  Returns non-beamed full note name
-c
-      parameter (nm=24)
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      character*1 ulq,sepsymq,sq
-      logical beamon,firstgulp,figbass,figchk,
-     *        isfig,ispoi,btest,even
-      character*1 udq,udqq,chax
-      character*4 dotq
-      character*2 numq
-      character*79 notexq
-      character*8 noteq
-      character*40 restq
-      common /compoi/ ispoi
-      common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
-     *                fullsize(nm),ivxfig2,ivvfig(2,74)
-      character*10 figq
-      ip = ipo(jn)
-      nole = nolev(ivx,ip)
-c
-c  Check for special situations with 2nds (see precrd)
-c
-      if (btest(nacc(ivx,ip),30)) then
-        nole = nole - 1
-      else if (btest(nacc(ivx,ip),31)) then
-        nole = nole + 1
-      end if
-      nodu = nodur(ivx,ip)
-      if (.not.btest(irest(ivx,ip),0)) then
-        udq = udqq(nole,ncmid(iv,ip),
-     *       islur(ivx,ip),nvmx(iv),ivx,nv)
-      end if
-c
-c  Check figure level
-c
-c      if (figbass .and. isfig(ivx,ip)
-c     *                    .and. .not.btest(irest(ivx,ip),0)) then
-      if (figbass .and. .not.btest(irest(ivx,ip),0) .and.
-     *    ((ivx.eq.1.and.isfig(1,ip))
-     *       .or.(ivx.eq.ivxfig2.and.isfig(2,ip)))) then
-        if (udq .eq. 'u' .or. nodu.ge.64) then
-c
-c  Upper or no stem, fnole (in noleunits) set by notehead
-c
-          fnole = nole
-        else
-c
-c  Lower stem, fnole set by bottom of stem
-c
-          fnole = nole-stemlen
-        end if
-        zmin = fnole-ncmid(ivx,ip)+4
-        if (ivx .eq. 1) then
-          ifigdr(1,iline) = max(ifigdr(1,iline),nint(4-zmin))
-        else
-          ifigdr(2,iline) = max(ifigdr(2,iline),nint(4-zmin))
-        end if
-      end if
-      if (.not.btest(irest(ivx,ip),0)) then
-        call notefq(noteq,lnoten,nole,ncmid(iv,ip))
-        if (lnoten .eq. 1) call addblank(noteq,lnoten)
-        if (nodu .eq. 1) then
-          notexq =sq//'cccc'//udq//noteq(1:lnoten)
-          lnote = lnoten+6
-        else if (nodu .eq. 2) then
-          notexq =sq//'ccc'//udq//noteq(1:lnoten)
-          lnote = lnoten+5
-        else if (nodu .eq. 4) then
-          notexq =sq//'cc'//udq//noteq(1:lnoten)
-          lnote = lnoten+4
-        else if (nodu .eq. 8) then
-          notexq =sq//'c'//udq//noteq(1:lnoten)
-          lnote = lnoten+3
-        else if (nodu .eq. 16) then
-          notexq =sq//'q'//udq//noteq(1:lnoten)
-          lnote = lnoten+3
-        else if (nodu .eq. 32) then
-          notexq =sq//'h'//udq//noteq(1:lnoten)
-          lnote = lnoten+3
-        else if (nodu .eq. 64) then
-          notexq =sq//'wh'//noteq(1:lnoten)
-          lnote = lnoten+3
-        else if (nodu .eq. 128) then
-c          notexq =sq//'zbreve'//noteq(1:lnoten)//sq//'sk'
-c          lnote = lnoten+10
-          notexq =sq//'breve'//noteq(1:lnoten)
-          lnote = lnoten+6
-        else
-          dotq = 'p'
-          ldot = 1
-          if (btest(iornq(ivx,ip),13)) then
-c
-c  Dotted note with ')' ornament
-c
-            dotq='m'
-          else if (btest(islur(ivx,ip),3)) then
-c
-c  Double dot
-c
-            dotq = 'pp'
-            ldot = 2
-          end if
-          if (nodu .ge. 192) then
-            notexq =sq//'breve'//dotq(1:ldot)//noteq(1:lnoten)
-            lnote = lnoten+6+ldot
-          else if (nodu .ge. 96) then
-            notexq =sq//'wh'//dotq(1:ldot)//noteq(1:lnoten)
-            lnote = lnoten+3+ldot
-          else if (nodu .ge. 48) then
-            notexq =sq//'h'//udq//dotq(1:ldot)//noteq(1:lnoten)
-            lnote = lnoten+3+ldot
-          else if (nodu .ge. 24) then
-            notexq =sq//'q'//udq//dotq(1:ldot)//noteq(1:lnoten)
-            lnote = lnoten+3+ldot
-          else if (nodu .ge. 12) then
-            notexq =sq//'c'//udq//dotq(1:ldot)//noteq(1:lnoten)
-            lnote = lnoten+3+ldot
-          else if (nodu .ge. 6) then
-            notexq =sq//'cc'//udq//dotq(1:ldot)//noteq(1:lnoten)
-            lnote = lnoten+4+ldot
-            ispoi = .true.
-          else
-            notexq =sq//'ccc'//udq//dotq(1:ldot)//noteq(1:lnoten)
-            lnote = lnoten+5+ldot
-            ispoi = .true.
-          end if
-          if (dotq(1:1) .eq. 'm') then
-c
-c  Need another call to the note, in case the first one has octave shifts
-c
-            if (lnoten .eq. 2) then
-              notexq = notexq(1:lnote)//'{'//noteq(2:2)//'}'
-              lnote = lnote+3
-            else
-              notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1)
-              lnote = lnote+1
-            end if
-          end if
-        end if
-      else if (btest(islur(ivx,ip),29)) then
-c
-c  Blank rest
-c
-        notexq = sq//'sk'
-        lnote = 3
-      else
-c
-c  Non-blank rest
-c
-        lnote = 0
-        nole = mod(nole+20,100)-20
-c
-c  Kluge to get pause symbol for rp:
-c
-        if (btest(islur(ivx,ip),19)) nodu = 64
-        if (nodu .le. 28) then
-c
-c  Normal rest < or = double-dotted quarter
-c
-          lrest = 3
-          if (nodu .gt. 14) then
-            restq =sq//'qp'
-          else if (nodu .gt. 7) then
-            restq =sq//'ds'
-          else if (nodu .gt. 3) then
-            restq =sq//'qs'
-          else if (nodu .gt. 1) then
-            restq =sq//'hs'
-          else
-            restq =sq//'qqs'
-            lrest = 4
-          end if
-c          if (2**log2(nodu) .ne. nodu) then
-cc
-cc  One or two dots on rest
-cc
-c            restq = restq(1:3)//'p'
-c            lrest = 4
-c            if (2*nodu .gt. 3*2**log2(nodu)) then
-cc
-cc  Double dotted rest
-cc
-c              restq = restq(1:4)//'p'
-c              lrest = 5
-c            end if 
-c          end if
-          notexq = restq
-          lnote = lrest
-c
-c  At this point notexq=restq,lnote=lrest are name of rest.  Now raise if necc.
-c
-          if (nole .ne. 0) then
-            if (abs(nole) .lt. 10) then
-              noteq = chax(48+abs(nole))
-              lnoten = 1
-            else
-              write(noteq(1:2),'(i2)')abs(nole)
-              lnoten = 2
-            end if
-            if (nole .gt. 0) then
-              notexq = sq//'raise'//noteq(1:lnoten)//sq//'internote'
-            else
-              notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote'
-            end if
-            lnote = 16+lnoten
-c            if (2**log2(nodu) .ne. nodu) then
-cc
-cc  Have dot in raised rest.  must put in hbox!
-cc
-c              notexq = notexq(1:lnote)//sq//'hbox{'
-c              lnote = lnote+6
-c            end if
-            notexq = notexq(1:lnote)//restq(1:lrest)
-            lnote = lnote+lrest
-c            if (2**log2(nodu) .ne. nodu) then
-c              notexq = notexq(1:lnote)//'}'
-c              lnote = lnote+1
-c            end if
-          end if
-          if (2**log2(nodu) .ne. nodu) then
-c
-c  Deal with dots (on rests shorter than half rest)
-c
-            restq = sq//'pt'
-            lrest = 3
-            if (2*nodu .gt. 3*2**log2(nodu)) then
-              restq = sq//'ppt'
-              lrest = 4
-            end if
-            nole = nole+4
-            raisedot = 0
-c
-c  Tweak dot positions for special cases
-c
-            even = (mod(100+nole,2).eq.0)
-c            if (.not.even.and.nodu.gt.8.and.
-c     *          (nole.lt.0.or.nole.gt.8)) then
-            if (.not.even .and. (nole.lt.0.or.nole.gt.8)) then
-              raisedot = 1
-            end if
-            if (nole.ge.10 .or. nole.le.-1) then
-              write(numq,'(i2)')nole
-              restq = restq(1:lrest)//'{'//numq//'}'
-              lrest = lrest+4
-            else
-              restq = restq(1:lrest)//chax(nole+48)
-              lrest = lrest+1
-            end if
-            if (raisedot.gt.0) then
-              restq = sq//'raise'//sq//'internote'//
-     *                    sq//'hbox{'//restq(1:lrest)//'}'
-              lrest = lrest+23
-            end if
-
-
-
-            notexq = restq(1:lrest)//notexq(1:lnote)
-            lnote = lnote+lrest
-          end if
-        else
-c
-c  Half rest or longer
-c
-          if (nole .eq. 0) then
-c
-c  Half or longer rest is not raised or lowered
-c
-            if (nodu .le. 56) then
-              notexq =sq//'hpause'
-              lnote = 7
-            else if (nodu .le. 112) then
-              if (.not.btest(islur(ivx,ip),19) .or. 
-     *                      btest(irest(ivx,ip),25)) then
-                notexq = sq//'pause'
-              else
-                notexq = sq//'pausc'
-              end if
-              lnote = 6
-            else
-              notexq =sq//'PAuse'
-              lnote = 6
-            end if
-            if (2**log2(nodu) .ne. nodu) then
-c
-c  Dotted rest, hpause or longer
-c
-              notexq = notexq(1:lnote)//'p'
-              lnote = lnote+1
-              if (2*nodu .gt. 3*2**log2(nodu)) then
-c
-c  Double dotted long rest
-c
-                notexq = notexq(1:lnote)//'p'
-                lnote = lnote+1
-              end if
-            end if
-          else
-c
-c  Raised or lowered half or whole rest
-c
-            if (nodu .eq. 32) then
-              notexq = sq//'lifthpause'
-              lnote = 11
-            else if (nodu .eq. 48) then
-              notexq = sq//'lifthpausep'
-              lnote = 12
-            else if (nodu .eq. 56) then
-              notexq = sq//'lifthpausepp'
-              lnote = 13
-            else if (nodu .eq. 64) then
-              notexq = sq//'liftpause'
-              lnote = 10
-            else if (nodu .eq. 96) then
-              notexq = sq//'liftpausep'
-              lnote = 11
-            else if (nodu .eq. 112) then
-              notexq = sq//'liftpausepp'
-              lnote = 12
-            else if (nodu .eq. 128) then
-              notexq = sq//'liftPAuse'
-              lnote = 10
-            else
-c
-c  Assume dotted double whole rest
-c
-              notexq = sq//'liftPAusep'
-              lnote = 11
-            end if
-c
-c  Set up height spec
-c
-            nole = sign(abs(nole)/2,nole)
-            if (nole.le.9 .and. nole.ge.0) then
-              noteq = chax(48+nole)
-              lnoten = 1
-            else
-              noteq = '{'
-              if (nole .ge. -9) then
-                write(noteq(2:3),'(i2)')nole
-                lnoten = 3
-              else
-                write(noteq(2:4),'(i3)')nole
-                lnoten = 4
-              end if
-              noteq = noteq(1:lnoten)//'}'
-              lnoten = lnoten+1
-            end if
-            notexq = notexq(1:lnote)//noteq(1:lnoten)
-            lnote = lnote+lnoten
-          end if
-        end if
-      end if
-      return
-      end
-      function ntindex(line,s2q,lenline)
-c
-c  Returns index(line,s2q) if NOT in TeX string, 0 otherwise
-c
-      character*(*) s2q,line
-      character*1 chax
-      logical intex
-      ndxs2 = index(line,s2q)
-      ndxbs = index(line,chax(92))
-      if (ndxbs.eq.0 .or. ndxs2.lt.ndxbs) then
-        ntindex = ndxs2
-      else
-c
-c  There are both bs and s2q, and bs is to the left of sq2. So check bs's to
-c  right of first: End is '\ ', start is ' \'
-c
-        len = lenstr(line,lenline)
-        intex = .true.
-        do 1 ic = ndxbs+1 , len
-          if (ic .eq. ndxs2) then
-            if (intex) then
-              ntindex = 0
-              ndxs2 = index(line(ic+1:len),s2q)+ic
-            else
-              ntindex = ndxs2
-              return
-            end if
-          else if (intex .and. line(ic+1:ic+2).eq.chax(92)//' ') then
-            intex = .false.
-          else if (.not.intex .and. line(ic+1:ic+2).eq.' '//chax(92))
-     *           then
-            intex = .true.
-          end if
-1       continue
-      end if
-      return
-      end
-      subroutine ntrbbb(n,char1q,ulqq,iv,notexq,lnote)
-c
-c  This appends to notexq e.g. '\ibbbu1'
-c
-      common /combbm/ isbbm
-      logical isbbm
-      character*79 notexq
-      character*1 char1q,ulqq,chax
-      character*4 tempq
-      if (n .ge. 5) isbbm = .true.
-      if (lnote .gt. 0) then
-        notexq = notexq(1:lnote)//chax(92)//char1q
-      else
-        notexq = chax(92)//char1q
-      end if
-      lnote = lnote+2
-      do 3 im = 1 , n
-        notexq = notexq(1:lnote)//'b'
-        lnote = lnote+1
-3     continue
-c
-c  add the number, 0 if 12
-c
-c  5/25/08 Allow >12
-c
-c      call istring(mod(iv,12),tempq,len)
-      if (iv .lt. 24) then
-        call istring(iv,tempq,len)
-      else if (iv .eq. 24) then
-        tempq(1:1) = '0'
-        len = 1
-      else
-        call printl('Sorry, too man open beams')
-        call stop1()
-      end if
-      notexq = notexq(1:lnote)//ulqq//tempq(1:len)
-      lnote = lnote+1+len
-      return
-      end
-      function numclef(clefq)
-c
-c  Returns the number to be used as argument of \setclef for MusiXTeX 
-c  For input 0-6 or tsmanrb return 0-7
-c            7      f              9
-c            8                     0
-c
-        character*1 clefq
-        if (ichar(clefq) .lt. 55) then
-c        if (ichar(clefq) .le. 55) then
-          numclef = ichar(clefq)-48
-c          if (numclef .eq. 7) numclef = 9
-        else if (clefq .eq. '7') then
-          numclef = 9
-        else if (clefq .eq. '8') then 
-          numclef = 0
-        else
-          numclef = index('tsmanrbxxf',clefq)-1
-        end if
-      return
-      end
-      subroutine outbar(i,jlast)
-      character*1 chax
-      nfmt = log10(i+.5)+2
-      if (jlast+5+nfmt .lt. 80) then
-        write(*,'(a5,i'//chax(48+nfmt)//',$)')'  Bar',i
-        write(15,'(a5,i'//chax(48+nfmt)//',$)')'  Bar',i
-        jlast = jlast+5+nfmt
-      else
-        write(*,'(/,a5,i'//chax(48+nfmt)//',$)')'  Bar',i
-        write(15,'(/,a5,i'//chax(48+nfmt)//',$)')'  Bar',i
-        jlast = 5+nfmt
-      end if
-      return
-      end
-      subroutine pmxa(basenameq,lbase,isfirst,nsyout,nbarss,optimize)
-cccccccccccccccccccccccccccccccccccccccccccccccc
-cc                                            cc
-cc Subroutine, combine with pmxb.for
-cc
-cccccccccccccccccccccccccccccccccccccccccccccccc
-cc
-cc  Need to consider X spaces in xtuplets when getting poenom, and
-cc      maybe fbar?
-cc  mx06a
-cc    ID numbers for voices when number of voices is reduced.
-cc
-cc  mx03a
-cc    account for new fracindent for new movements.
-cc
-cc  Known changes since pmxa. Version 1.1b (see pmxb for longer list)
-cc
-cc  Check ID codes for slurs.
-cc  Version 1.24 still does not have details for spacing/positioning
-cc    arpeggios if there are accidentals or shifted notes or crowded scores.
-cc  Fix problem in 1.22 with arpeggios across multi-line staves
-cc  Fix problem in 1.22 with flat key signatures
-cc  Read setup data as strings
-cc  Warning for octave designation plus +/-
-cc  Don't pause for volta warning,
-cc  Macros
-cc  Correct fsyst to account for transposition and key changes.
-cc  Check for nbars > nsyst
-cc
-ccccccccccccccccccccccccccccccccccc
-      parameter (nm=24,nkb=3999,nks=125,maxblks=4000)
-      logical loop,usefig,isfirst,optimize
-      character*65536 bufq
-      integer*2 lbuf(maxblks)
-      common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
-      integer nn(nm),nodur(nm,200),ivxo(600),ipo(600),
-     *        nnl(nm),itsofar(nm),nib(nm,15),lastbar(0:nks),nbarss(nks)
-      common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks),
-     *     iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr,
-c     *     ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks)
-     *     ibaroff,udsp(nkb),wheadpt,sqzb(maxblks)
-      common /compage/ widthpt,ptheight,hoffpt,voffpt,
-     *      nsyst,nflb,ibarflb(0:40),
-     *      isysflb(0:40),npages,nfpb,ipagfpb(0:18),isysfpb(0:18),
-     *      usefig,fintstf,gintstf,fracsys(30),nmovbrk,isysmb(0:30),
-     *      nistaff(0:40)
-      common /comkeys/ nkeys,ibrkch(18),newkey(18),iskchb,idsig,isig1,
-     *      mbrestsav,kchmid(18),ornrpt,shifton,barend,noinst,stickyS
-      real*4 elsk(nkb),celsk(0:nkb),elss(nks),to(600),tno(600)
-      character*128 lnholdq
-      character*44 basenameq
-      logical rest(nm,200),firstline,fbon,isvolt,iskchb,kchmid,ornrpt,
-     *        stickyS
-      common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
-     *     fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
-      logical lastchar,newmeter,newmb(nkb),issegno,bottreb,isheadr,
-     *     shifton,barend
-      common /a1ll/ iv,ivxo,ipo,to,tno,nnl,nv,ibar,mtrnuml,
-     *   nodur,lenbar,iccount,nbars,itsofar,nib,nn,
-     *   rest,lenbr0,lenbr1,firstline,newmeter
-      common /linecom/ elskb,tnminb(nkb)
-      common /cblock/
-     *      etatop,etabot,etait,etatc,etacs1,hgtin,hgtti,hgtco,
-     *      xilbn,xilbtc,xilhdr,xilfig,a,b,inhnoh
-      common /cominbot/ inbothd
-      common /c1ommvl/ nvmx(nm),ivmx(nm,2),ivx,fbar,nacc(nm,200)
-      common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
-      common /commus/ musize,whead20
-      common /comeon/ eonk,ewmxk
-c      logical mrecord,mplay,endmac,gotclef,cstuplet
-      logical mrecord,mplay,endmac,cstuplet
-      logical novshrinktop,upslur,fontslur,WrotePsslurDefaults
-      common /comnvst/ novshrinktop,cstuplte
-      common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
-     *                 ,WrotePsslurDefaults,SlurCurve
-      common /comligfont/ isligfont
-      logical isligfont
-      common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
-     *  instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
-      logical EarlyTransOn,LaterInstTrans
-      logical fulltrans
-      data wtimesig,wclef,wkeysig
-     *   / 0.72  , 0.8 ,  0.28 /
-      whead20 = 0.3
-      if (.not.optimize) then
-        print*
-        print*,'Starting first PMX pass'
-        write(15,'(a)') ' Starting first PMX pass'
-      end if
-      if (isfirst) then
-        open(19,file='pmxaerr.dat')
-        write(19,'(i6)') 0
-        close(19)
-      end if
-      if (.not.optimize) jprntb = 81
-      macuse = 0
-      ornrpt = .false.
-      stickyS = .false.
-      mrecord = .false.
-      mplay = .false.
-      lastchar = .false.
-      novshrinktop = .false.
-	cstuplet = .false.
-      fontslur = .true.
-      isligfont = .false.
-      fulltrans = .false.
-      do 42 ibarcnt = 1 , nkb
-        udsp(ibarcnt) = 0.
-        wminnh(ibarcnt) = -1.
-42    continue
-c
-c  Initialize input buffer
-c
-      lenbuf0 = ipbuf
-      ipbuf = 0
-      ilbuf = 1
-      call g1etset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp,
-     *    xmtrnum0,newkey(1),npages,nsyst,musize,bottreb)
-c
-c  Set up list of instrument numbers (iv)
-c
-      ivnow = 0
-      do 13 instnow = 1 , noinst
-        do 14 iscount = 1 , nsperi(instnow)
-          ivnow = ivnow+1
-          instno(ivnow) = instnow
-14      continue
-13    continue
-c
-c  Save initial meter for midi
-c
-      if (.not.isfirst .and. npages.eq.0) then
-        print*,'Sorry, must have npages>0 for optimization.'
-        call stop1()
-      end if
-      nsyout = nsyst
-c
-c  isig1 will be changed in getnote if there is a transposition
-c
-      isig1 = newkey(1)
-      if (npages .gt. nsyst) then
-        call printl('npages > nsyst in input.  Please fix the input.')
-        call stop1()
-      end if
-c
-c  fbar = afterruleskip/elemskip
-c  apt = width of small accidental + space in points (= 6 at 20pt) =wheadpt
-c
-      fbar = 1.
-      wheadpt = whead20*musize
-      ifig = 0
-      usefig = .true.
-      lenbeat = i1fnodur(mtrdenl,'x')
-      lenmult = 1
-      if (mtrdenl .eq. 2) then
-        lenbeat = 16
-        lenmult = 2
-      end if
-      lenbr1 = lenmult*mtrnuml*lenbeat
-      lenbr0 = nint(lenmult*xmtrnum0*lenbeat)
-      mtrnuml = 0
-      if (lenbr0 .ne. 0) then
-        ibaroff = 1
-        lenbar = lenbr0
-      else
-        ibaroff = 0
-        lenbar = lenbr1
-      end if
-      ibarcnt = 0
-      nptr(1) = 1
-      iccount = 128
-      nmovbrk = 0
-      nflb = 0
-      nfpb = 0
-      ipagfpb(0) = 1
-      isysfpb(0) = 1
-      ibarflb(0) = 1
-      isysflb(0) = 1
-      nistaff(0) = nv-1
-c
-c  Check for pmx.mod
-c
-      linesinpmxmod = 0
-c      line1pmxmod = ilbuf
-      call getpmxmod(.true.,' ')
-      if (.not.isfirst .and. linesinpmxmod .gt. 0) then
-        print*,'Sorry, cannot optimize if there is a pmx.mod file'
-        call stop1()
-      end if
-c
-c  Initialize for loop over lines
-c
-      nkeys = 1
-      ibrkch(1) = 1
-      mbrestsav = 0
-      shifton = .false.
-      firstline = .true.
-      newmeter = .false.
-      ihead = 0
-      isheadr = .false.
-c      gotclef = .false.
-      idsig = 0
-      iddot = 0
-      fintstf = -1.
-      gintstf = 1.0
-      listcresc = 0
-      listdecresc = 0
-30    loop = .true.
-      iskchb = .false.
-      issegno = .false.
-      nbars = 0
-      ibarmbr = 0
-      do 4 iv = 1 , nv
-        nvmx(iv) = 1
-        ivmx(iv,1) = iv
-        itsofar(iv) = 0
-        nnl(iv) = 0
-        do 5 j = 1 , 200
-          rest(iv,j) = .false.
-          nacc(iv,j) = 0.
-5       continue
-4     continue
-      iv = 1
-      ivx = 1
-      fbon = .false.
-      barend = .false.
-      isvolt = .false.
-2     if (loop) then
-c
-c  Within this short loop, nv voices are filled up for the duration of a block.
-c  On exit (loop=.false.) the following are set: nnl(nv),itsofar(nv)
-c  nodur(..),rest(..).  nnl will later be
-c  increased and things slid around as accidental skips are added.
-c
-        call g1etnote(loop,ifig,optimize,fulltrans)
-        if (lastchar) go to 20
-        go to 2
-      end if
-      if (mbrestsav .gt. 0) then
-        call printl(' ')
-        call printl(
-     *        'You must enter the same multibar rest in ALL parts')
-        call stop1()
-      end if
-      do 10 ibar = 1 , nbars
-        ibarcnt = ibarcnt+1
-c
-c  The following is just a signal to start a new bar when cataloging spaces 
-c    for catspace(...)
-c
-        nptr(ibarcnt+1) = nptr(ibarcnt)
-        newmb(ibarcnt) = .false.
-        if (newmeter.and.ibar.eq.1) newmb(ibarcnt) = .true.
-c
-c  Above is only for spacing calcs later on.  Remember new meter can only occur
-c  at START of a new input line (ibar = 1)
-c
-        if (ibar .ne. ibarmbr) then
-          if (.not.optimize) call outbar(ibarcnt-ibaroff,jprntb)
-        else
-          if (.not.optimize) then
-            write(15,'(/,a20,i4,a1,i4)')' Multibar rest, bars',
-     *        ibarcnt-ibaroff,'-',ibarcnt-ibaroff+mbrest-1
-            write(*,'(/,a20,i4,a1,i4)')' Multibar rest, bars',
-     *        ibarcnt-ibaroff,'-',ibarcnt-ibaroff+mbrest-1
-            jprntb = 0
-          end if
-          ibaroff = ibaroff-mbrest+1
-        end if
-        if (firstline .and. lenbr0.ne.0) then
-          if (ibar .eq. 1) then
-            lenbar = lenbr0
-          else
-            lenbar = lenbr1
-          end if
-        end if
-        if (ibar .gt. 1) then
-c
-c  For bars after first, slide all stuff down to beginning of arrays
-c
-          do 11 iv = 1 , nv
-          do 11 kv = 1 , nvmx(iv)
-            ivx = ivmx(iv,kv)
-            ioff = nib(ivx,ibar-1)
-            do 12 ip = 1 , nib(ivx,ibar)-ioff
-              nodur(ivx,ip) = nodur(ivx,ip+ioff)
-              rest(ivx,ip) = rest(ivx,ip+ioff)
-              nacc(ivx,ip) = nacc(ivx,ip+ioff)
-12          continue
-11        continue
-        end if
-        do 67 iv = 1 , nv
-        do 67 kv = 1 , nvmx(iv)
-          ioff= 0
-          if(ibar.gt.1)ioff = nib(ivmx(iv,kv),ibar-1)
-67      continue
-        call makeabar()
-        elsk(ibarcnt) = elskb+fbar
-10    continue
-      newmeter = .false.
-      firstline = .false.
-      go to 30
-20    continue
-c
-c Vertical analysis.
-c
-      if (npages .eq. 0) then
-        if (nsyst .eq. 0) then
-          print*,'When npages=0, must set nsyst=bars/syst, not 0'
-          call stop1()
-        end if
-        nsyst = (ibarcnt-1)/nsyst+1
-        if (nv .eq. 1) then
-          nsystpp = 12
-        else if (nv .eq. 2) then
-          nsystpp = 7
-        else if (nv .eq. 3) then
-          nsystpp = 5
-        else if (nv .eq. 4) then
-          nsystpp = 3
-        else if (nv .le. 7) then
-          nsystpp = 2
-        else
-          nsystpp = 1
-        end if
-        npages = (nsyst-1)/nsystpp+1
-      end if
-c
-c  Check nsyst vs ibarcnt
-c
-      if (nsyst .gt. ibarcnt) then
-        print*
-        print*,'nsyst,ibarcnt:',nsyst,ibarcnt
-        print*,'There are more systems than bars.'
-        write(15,'(a,2i5)')' nsyst,ibarcnt:',nsyst,ibarcnt
-        write(15,'(a)')' There are more systems than bars.'
-        call stop1()
-      end if
-c
-c  Set up dummy forced line & page breaks after last real one
-c
-      nflb = nflb+1
-      ibarflb(nflb) = ibarcnt+1
-      isysflb(nflb) = nsyst+1
-      nfpb = nfpb+1
-      ipagfpb(nfpb) = npages+1
-      isysfpb(nfpb) = nsyst+1
-      heightil = ptheight*4./musize
-      open(12,status='SCRATCH')
-      write(12,'(a)')basenameq(1:lbase)
-      write(12,*)lbase
-c
-c Pass to pmxb the initial signature, including effect of transposition.
-c
-      write(12,'(6f10.5/f10.5,3i5)')fbar,wheadpt,etait,
-     *     etatc,etacs1,etatop,etabot,inbothd,inhnoh,isig1
-      write(12,*)npages,widthpt,ptheight,hoffpt,voffpt,nsyst
-      iflbnow = -1
-      isysb4 = 0
-      do 8 ifpb = 1 , nfpb
-c
-c  Each time thru this loop is like a single score with several pages
-c
-        npages = ipagfpb(ifpb)-ipagfpb(ifpb-1)
-        nsyst = isysfpb(ifpb)-isysfpb(ifpb-1)
-        nomnsystp = (nsyst-1)/npages+1
-        nshort = nomnsystp*npages-nsyst
-        do 7 ipage = 1 , npages
-          nsystp = nomnsystp
-          if (ipage .le. nshort) nsystp = nsystp-1
-c
-c  Last system number on this page:
-          isysendpg = isysb4+nsystp
-          nintpg = 0
-          do 15 isy = isysb4+1, isysendpg
-            if (isysflb(iflbnow+1) .eq. isy) iflbnow = iflbnow+1
-            nintpg = nintpg+nistaff(iflbnow)
-15        continue
-          xilfrac = 0.
-          xiltxt = 0.
-          if (ipage.eq.1 .and. ihead.gt.0) then
-c
-c  Needn't zero out ihead after printing titles if we only allow titles at top?
-c
-            if (iand(ihead,1) .eq. 1) then
-              xiltxt = xiltxt+hgtin*4/musize
-              xilfrac = xilfrac+etait
-            end if
-            if (iand(ihead,2) .eq. 2) then
-              xiltxt = xiltxt+hgtti*4/musize
-              xilfrac = xilfrac+etatc
-            end if
-            if (iand(ihead,4) .eq. 4) then
-              xiltxt = xiltxt+hgtco*4/musize
-              xilfrac = xilfrac+etacs1
-            else
-c
-c Use double the title-composer space if there is no composer
-c
-              xilfrac = xilfrac+etatc
-            end if
-          end if
-          D = xilfrac+nsystp-1+etatop+etabot
-c          C = nsystp*(nv-1)
-          C = nintpg
-c          xN = heightil - xiltxt - 4*nsystp*nv - (nsystp-1)*xilbn
-          xN = heightil - xiltxt - 4*(nintpg+nsystp) - (nsystp-1)*xilbn
-          if (bottreb) xN = xN-(nsystp-1)*xilbtc
-          if (ihead.eq.0 .and. isheadr) xN = xN - xilhdr
-          if (ifig .eq. 1) then
-            xN = xN - nsystp*xilfig
-          end if
-          glueil = (xN-b*C)/(D+a*C)
-          omegaG = (b*D+a*xN)/(D+a*C)
-c
-c  G = \interlines between systems
-c  omega*G = \interlines between staves of the same system
-c  \interstaff = 4+omega*G
-c  C = total number of interstaff spaces in the page
-c  D = omega-indep factors for scalable height = nsy-1 (intersystem glue)
-c      + etatop + etabot + etatxt +
-c  N = scaleable height (\interlignes) = height - htext - staff heights - xil
-c  xil = extra interliges = (nsy-1)*xilbn + 10 if header and no titles
-c                          + (nsy-1)*xiltcb    for treble clef bottoms
-c                          + nsy*xilfig        for figures
-c  G = N/(D + omega * C) = glueil,   (1)
-c  But (empirically)  omega*G = a*G + b (2)
-c      with a=1.071 and b=2.714
-c  Solving (1) and (2) gives
-c      G = (N-b*C)/(D+a*C) , omega*G = (b*D+a*N)/(D+a*C)
-c  Pass to pmxb    omega*G (=\interstaff-4)
-c                  (etatop,bot,it,tc,cx)*G as inputs to \titles
-c
-c       glueil = (heightil-xiltxt-nsystp*(xil+4*nv))
-c    *             /(nsystp*(1+gfact*(nv-1))-1+etatop+etabot+xilfrac)
-c       xnsttop = glueil*etatop
-c       xintstaff = 4+gfact*glueil
-c
-c  Only the first page will get local adjustment now if needed, others in pmxb
-c
-          if (ifpb.eq.1 .and. ipage.eq.1 .and. fintstf.gt.0.) then
-            facins = fintstf
-            fintstf = -1.
-          else
-c
-c  gintstf = 1.0 by default, but may be changed with AI<x>
-c
-            facins = gintstf
-          end if
-          write(12,*)nsystp,max(0.,etatop*glueil),facins*(omegaG+4)
-          ihead = 0
-          isheadr = .false.
-          isysb4 = isysendpg
-7       continue
-8     continue
-c
-c  Done with vertical, now do horizontals
-c
-      celsk(1) = elsk(1)
-      do 21 ibar = 2 , ibarcnt
-        celsk(ibar) = celsk(ibar-1)+elsk(ibar)
-21    continue
-      lastbar(0) = 0
-      ibar1 = 1
-      wmins = -1.
-      iflb = 1
-      imovbrk = 0
-      ikey = 1
-c
-c  Return nsyst to its *total* value
-c
-      nsyst = isysfpb(nfpb)-1
-      do 22 isyst = 1 , nsyst
-        if (isyst .eq. isysflb(iflb)) iflb = iflb+1
-        if (nmovbrk.gt.0 .and. imovbrk.lt.nmovbrk) then
-          if (isyst .eq. isysmb(imovbrk+1)) imovbrk = imovbrk+1
-        end if
-        ibarb4 = lastbar(isyst-1)
-        if (isyst .eq. 1) then
-          if (isfirst) elsstarg = celsk(ibarflb(1)-1)/
-     *            (isysflb(1)-1-fracindent)*(1-fracindent)
-          celskb4 = 0.
-        else
-          celskb4 = celsk(ibarb4)
-c
-c  Must dimension isysmb(0:*) just so I can execute this test!
-c
-          if (isfirst) then
-            if (nmovbrk.gt.0 .and. isyst.eq.isysmb(imovbrk)) then
-c
-c  First syst after forced line break.  There may be indentation.
-c
-              elsstarg = (celsk(ibarflb(iflb)-1)-celskb4)
-     *          /(isysflb(iflb)-isyst-fracsys(imovbrk))
-     *          *(1-fracsys(imovbrk))
-            else
-c
-c  There is no indentation to deal with
-c
-              elsstarg = (celsk(ibarflb(iflb)-1)-celskb4)
-     *                           /(isysflb(iflb)-isyst)
-            end if
-          end if
-        end if
-        if (isfirst) then
-          diff1 = abs(elsstarg-elsk(ibarb4+1))
-          do 23 ibar = ibarb4+2 , ibarcnt
-            diff = elsstarg-(celsk(ibar)-celskb4)
-            if (abs(diff) .ge. diff1) go to 24
-            diff1 = abs(diff)
-23        continue
-24        ibar = ibar-1
-          lastbar(isyst) = ibar
-          nbarss(isyst) = ibar-ibarb4
-        else
-c
-c  nbarss is given as an input, must compute lastbar and ibar
-c
-          lastbar(isyst) = nbarss(isyst)+ibarb4
-          ibar = lastbar(isyst)
-        end if
-c
-c  elss is # of elemskip in the syst. from notes & ars's, not ruleskips, ask's.
-c
-        elss(isyst) = celsk(ibar)-celskb4
-        write(12,'(i5)')lastbar(isyst-1)+1
-c
-c  Transposed sigs are isig1, newkey(2,3,...).
-c
-        if (ikey .eq. 1) then
-          key1 = isig1
-        else
-          key1 = newkey(ikey)
-        end if
-        fsyst = wclef+abs(key1)*wkeysig+2./musize
-        xelsk = 0.
-1       if (ikey.lt.nkeys) then
-          if (ibrkch(ikey+1).le.lastbar(isyst)) then
-c
-c  Add space for all key changes
-c
-            ikey = ikey+1
-            key2 = newkey(ikey)
-            naccs = max(abs(key2-key1),max(abs(key1),abs(key2)))
-            fsyst = fsyst+naccs*wkeysig
-c
-c  Account for afterruleskips (fbar)
-c
-            xelsk = xelsk+fbar/2
-            if (ibrkch(ikey).lt.lastbar(isyst) .and. .not.kchmid(ikey))
-     *          xelsk = xelsk-1.
-            key1 = key2
-            go to 1
-          end if
-        end if
-c
-c  Add extra fixed space for double bar
-c
-        if (isyst .eq. nsyst) then
-          fsyst = fsyst+4.5/musize
-        end if
-c
-c  Add extra fixed space for initial time signature
-c
-        if (isyst .eq. 1) then
-          fsyst = fsyst+wtimesig
-        end if
-c
-c  Add extra fixed space for time signature changes & user-defined spaces
-c
-        do 26 ibars = ibarb4+1 , lastbar(isyst)
-          if (newmb(ibars)) fsyst = fsyst+wtimesig
-          fsyst = fsyst+udsp(ibars)/musize
-26      continue
-        if (isyst .eq. 1) then
-          wdpt = widthpt*(1-fracindent)
-        else
-          if (nmovbrk.gt.0 .and. imovbrk.gt.0 .and.
-     *                isyst.eq.isysmb(imovbrk)) then
-            wdpt = widthpt*(1-fracsys(imovbrk))
-          else
-            wdpt = widthpt
-          end if
-        end if
-        wsyspt = wdpt-fsyst*musize-0.4*nbarss(isyst)
-c
-c  Checks for min spacing
-c  Get min allowable space
-c
-        dtmin = 1000.
-        do 45 ibar = ibar1 , ibar1+nbarss(isyst)-1
-          dtmin = min(dtmin,tnminb(ibar))
-          if (wminnh(ibar).ge.0.) wmins = wminnh(ibar)
-45      continue
-        if (wmins .lt. 0) wmins = 0.3
-        wminpt = (1+wmins)*0.3*musize
-c
-c  Find max duration & # of notes for this system
-c
-        dtmax = 0.
-        nns = 0
-        do 43 iptr = nptr(ibar1) , nptr(ibar1+nbarss(isyst))-1
-          dtmax = max(dtmax,durb(iptr))
-          nns = nns + nnpd(iptr)
-43      continue
-        elmin0 = wsyspt*f1eon(dtmin)/(elss(isyst)+xelsk)
-        if (elmin0 .ge. wminpt) then
-c
-c  Subtract out fbar stuff to keep old way of passing sumelsk to pmxb;
-c    there is no need to "flatten"
-c
-          sumelsk = elss(isyst)-fbar*nbarss(isyst)
-          eonk = 0.
-          ewmxk = 1.
-        else
-          elmin1 = wsyspt/((fbar*nbarss(isyst)+xelsk)/f1eon(dtmax)+nns)
-          if (elmin1 .le. wminpt) then
-c            print*
-c            print*,'In system #',isyst,' cannot meet min. space rqmt'
-c            write(15,'(/a,i5,a)')
-c     *         'In system #',isyst,' cannot meet min. space rqmt'
-            eonk = 0.9
-          else
-c
-c  Find eonk by Newton method
-c
-c            eonk = min(.9,(wminpt-elmin0)/(elmin1-elmin0))
-            call findeonk(nptr(ibar1),nptr(ibar1+nbarss(isyst))-1,
-     *         wsyspt/wminpt,fbar*nbarss(isyst)+xelsk,dtmin,dtmax,
-     *         (wminpt-elmin0)/(elmin1-elmin0))
-            eonk = min(.9,eonk)
-          end if
-          ewmxk = f1eon(dtmax)**eonk
-c
-c  Recompute poenom!
-c
-          sumelsk = 0
-          do 44 iptr = nptr(ibar1) , nptr(ibar1+nbarss(isyst))-1
-            sumelsk = sumelsk
-     *       + nnpd(iptr)*sqzb(iptr)*feon(durb(iptr)/sqzb(iptr))
-44        continue
-        end if
-        poenom = wsyspt/(sumelsk+fbar*nbarss(isyst)+xelsk)
-c
-c Set fracindent for output: orig if isyst=1, fracsys(imovbrk) if movbrk, else 0
-c
-        if (isyst .gt. 0) then
-          if (nmovbrk.gt.0 .and. imovbrk.gt.0 .and.
-     *        isyst.eq.isysmb(imovbrk)) then
-            fracindent = fracsys(imovbrk)
-          else
-            fracindent = 0.
-          end if
-        end if
-        write(12,'(1pe12.5/i5,5e12.3)') poenom,nbarss(isyst),
-     *       sumelsk,fsyst,fracindent,eonk,ewmxk
-        ibar1 = ibar1+nbarss(isyst)
-22    continue
-      rewind(12)
-      open(13,status='SCRATCH')
-      write(13,'(i5)')ifig
-      rewind(13)
-      ilbuf = 1
-      ipbuf = 0
-      if (.not.optimize) then
-        write(*,'(/,a)')' Done with first pass'
-        print*
-        write(15,'(/,a)')' Done with first pass'
-        write(15,'()')
-      end if
-c
-c  Following syntax is needed since pmxa is called with literal argument .false.
-c
-      if (isfirst) isfirst = .false.
-      return
-      end
-      subroutine pmxb(inlast,poevec,ncalls,optimize)
-cccccccccccccccccccccccccc
-cc
-cc To Do
-cc
-cc  Resolve disagreement in final poe for 1st system, compared with *.mx2
-cc  Shift slurs on right- or left-shifted main notes (2/7/99)
-cc  Various end-of-input-block repeat problems (ick142.pmx).
-cc  Force multiplicity for un-beamed xtups.
-cc  Clef change at end of piece
-cc  Global "A" option to maximize "X" at a given time tick.
-cc  Tighten test for end-of-bar hardspace, flgndv(ivx) due to right-shifted
-cc       note.  See trubl18.pmx
-cc  Tab character as space.
-cc  Clef interference with second line of music.
-cc  Add space for interferences between *different* lines of music?
-cc  Shift arpeggios, both automatic and manual.
-cc  Different musicsize for different instruments.
-cc  Spacing checks for accid's on left-shifted chord notes
-cc  Spacing checks for double dots
-cc  Allow forced line breaks w/o setting nsyst.
-cc  Cresc-Decresc. (Enhance MusiXTeX first?)
-cc  Dynamic Marks.
-cc  Bug with Voltas at line end (MusiXTeX problem?).
-cc  Subtle bug w/ slur hgt over line brk, see trubl15.pmx
-cc  Stem-end slurs.
-cc  Allow units in indentation.
-cc  Make inline TeX more context sensitive.
-cc  Werner's 4/2/98 problem with "o?"
-cc  Scor2prt converts e.g. "r0+0" into "r0 0", which seems to be wrong.
-cc    converts e.g. "r2db" into "r2d", which might be wrong.
-cc  Werner's generalsignature problem with Key change and new transposition.
-cc    (wibug8.pmx)
-cc  Unequal xtuplets
-cc  Print both sets of bar #'s in tex file.
-cc  Make barlines invisible \def\xbar{\empty} , fix fbar.
-cc  Auto-tie slurs  'At'
-cc  Forced line break anywhere (e.g. at a mid-bar repeat).
-cc  Clef change at very start of file.
-cc  Tighten test for M as macro terminator.
-cc  Fix title so not separate limit on author length + composer length.
-cc  Arpeggios in xtups.
-cc
-cc mx10b
-cc  Option for instrument name at top center. Last item in P command:
-cc    P[n]c         text is instrument name (use in parts)
-cc    P[n]cstuff    text is stuff (up to 1st blank)
-cc    P[n]c"stuff with spaces"   text is stuff with spaces
-cc
-cc Post version 1.43
-cc  Reduced space rqmt for multiplicity-0 graces (no flag)
-cc  Removed last sepsym in centered whole-bar rests, fixes volta height bug.
-cc
-cc Version 1.43
-cc  Fix spacing for end-of-line signature change.
-cc  Adjust left-shift of grace group for shifted accidentals.
-cc  Put in extra space for left-shifted accidentals.
-cc  Fix bug with dot-shift before accid-shift on chord note.
-cc  Space-check for right-shifted main notes.
-cc  Enable forcing stem direction of single notes in non-beamed xtups.
-cc  Disallow clef change after last note before end of input block (pmxa)
-cc  Print meter change before page break
-cc  increase length of strings for \titles macro
-cc version 1.42
-cc  Loosen up input syntax for "X" commands.  Subroutine getx()
-cc  "B" and "P" in "X" commands
-cc mx09b
-cc  Allow multiple rests at start of xtup
-cc  Add 64th rest
-cc  Fix xtup numbers over rests. (subroutine levrn)
-cc  Initialize notcrd=.false. every gulp. Avoids undefined state with e.g.
-cc    c za / ( c a ...
-cc  Allow double dots to be shifted.
-cc  Fix spacing with double dotted notes; permit splitting small note.
-cc  Fix \dotted printout so it works with old compiler
-cc mx08b
-cc  Automatic spaces if needed for shifted accidentals.
-cc  Some Dynamics
-cc  Increase accid. horiz. shift resolution to .o5 (use one more bit in nacc)
-cc version 1.41
-cc  Allow ":" as last char of path name
-cc  Dotted slurs "sb"
-cc  Continue bar numbering at movement break "L[integer]Mc"
-cc mx07b
-cc  Whole-bar rests with double lines of music.  Fixed all options ?
-cc  Shift accidentals, either [+|-][integer][+|-][number] or [<|>][number].
-cc  Option to suppress centering full-bar rests. "o"
-cc mx06b
-cc  Shift accid on left-shifted chord note.
-cc  Rest as first note of xtup.
-cc  Wrong slopes with small widths.  Scale slfac1 by widthpt_default/widthpt
-cc  Allow Rb for single bar at movemnet break or end of piece. (islur(25))
-cc  Change # of inst at a movement break.  noinst is total # and must be used
-cc    in 1st movement.  ninow is current.  nspern(1,...,ninow) is current
-cc    staves/inst, nsperi(1,...,noinst) is original.  rename tells whether to
-cc    reprint names in parindent at a movement break.  Default is .false.
-cc    unless ninow changes, then .true.  But can force either with r+/- as
-cc    option in 'M'
-cc mx04b
-cc  Double-dotted notes, separate+beamed, main+chord, still no extra space.
-cc  ???  Don't shift slur ends on whole notes.
-cc  (pmxa) Write line number of error in pmxaerr.dat
-cc mx02b
-cc  Admit "RD" before "/" (search for "rptfq2:" )
-cc  In doslur, for multi-line staves, single notes, check forced stem dir'n
-cc    before setting stemup (used to set horiz offset).
-ccccccccccccccccccccccccccccccc
-      parameter (nm=24,nks=125,mv=24576,maxblks=4000)
-c
-c  FYI /all/ differs in appearance in function ncmid
-c
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      common /comipl2/ ipl2(nm,200)
-ccccccccccccc
-cc  islur  cc
-ccccccccccccc
-c  bit  meaning
-c  0     slur activity on this note
-c  1     t-slur here.
-c  2     force 0-slope beam starting on this note
-c  3     Double dotted note!
-c  4     grace before main note
-c  5     left repeat
-c  6     right repeat
-c  7     start Volta
-c  8     doublebar
-c  9     end Volta
-c  10    on=>endvoltabox
-c  11    on=>clefchange
-c  12-14 0=>treble, ... , 6=>bass
-c  15    on=> start new block for clef change (maybe diff. voice)
-c  16    literal TeX string
-c  17    1=up, 0=down stem for single note (override) See bit 30!
-c  18    if on, prohibit beaming
-c  19    if on, full bar rest as pause
-c  20    Beam multiplicity down-up
-c  21    Forced multiplicity for any beam including xtups
-c  22-24 Value of forced multiplicity
-c  25    single barline at movement break
-c  26    doubleBAR (see bits 5,6,8)
-c  27-28 Forced beam fine-tune height (1 to 3)
-c  29    Blank rest
-c  30    If on, get stem dir'n from bit 17
-c  31    If on, suppress printing number with xtuplet starting here
-ccccccccccccc
-cc  ipl    cc
-ccccccccccccc
-cc  0-7   Location in list [0,200]
-cc  0-7   Unused
-c  0     blank barline (must be iv=1) (would have used islur but no room)
-c  1     look left for K rests, moved here from iornq(30)
-c  2     treblelowoct
-cc  2-7   Unused
-c  3-7 unused
-c  8     left offset main note one headwidth
-c  9     right offset main note one headwidth
-c  10    chord present?
-c  11-16 Forced beam height adjustment (-30 to +30)
-c  17-22 Forced beam slope adjustment (-30 to +30)
-c  23-26 Slur index for Way-after grace.  Inserted when slur is started.
-cc  27      Unused? 
-c  27 5th bit for slur index for Way-after grace (100712)
-c  28    key change: only in voice 1
-c  29    Grace after main note. (Type A)
-c  30    In forced beam.  Signals need to check beam heights
-c  31    Grace way after main note. (stretch to next note, type W)
-ccccccccccccc
-cc  iornq  cc
-ccccccccccccc
-c  0     Ornament "(".  Was user-defined horizontal slur shift on this note
-c               until 9/24/97; changed that to irest(21)
-c  1-13  stmgx+Tupf._)
-c  14    Down fermata, was F
-c  15    Trill w/o "tr", was U
-c  16-18 Editorial s,f,n
-c  19-20 >^
-c  21    "?" for editorial accid, w/ or w/o s,f,n
-c  22    Set if ihornb governs ornament height.  Same in icrdorn.
-c  23    Set in getorn if ANY note at time of this main note has ornament.
-c             This is ONLY used in beamstrt to signal whether to do more
-c             tests for whether ihornb is needed.  (ihornb is only needed
-c             if nonchord+upbm, chord+upbm+top_note, chord+dnbm+bot_note)
-c     (7/1/00)Also set if any dynamic, as ihornb will be needed when dnbm. 
-c  24    Slur on after or way-after grace.  Use as signal to START slur.
-c  25    Tweak orn ht. Same in icrdorn for chord note
-c  26    Insert user-defined space before this note (was 22)
-c  27    Arpeggio stop or start (if 2 at same time), or all-in-this-chord
-c  28    caesura or breath
-cc  29    blank barline (must be iv=1) (would have used islur but no room)
-c  29    coda
-cc  30    "Look-left" option for keyboard rest
-c  30    Part-by-part segno oG
-c  31    Set if any note (main or chord) has cautionary accid, for space checks
-ccccccccccccc
-cc  irest  cc
-ccccccccccccc
-c  0        rest=1, no rest = 0
-c  1        There will be a vertical shift for number of this xtup
-c  Moved hgt shft to mult 16-22, so could span -64,64.
-cc  2-6      Height shift, 1 => -15, 31 => +15  Indicate by +/- [n] after 'n'
-c  7        There is a horizontal shift for xtup number
-c  9-13     Horiz shift, 1=>-1.5, ... , 31=>+1.5
-c  14       Flip up/down-ness of xtup number
-c  15       Single-voice, single note shift  X(...)[p]S
-c  16       Start single-voice, multinote shift with this note X(...)[p]:
-c  17       End single-voice, multinote shift after this note. Enter symbol
-c              after note. X:
-c  18       User-defined hardspace after last note of bar, *after* this note.
-c              Value still stored in udoff(ivx,nudoff(ivx)), not with other
-c              hardspaces in udsp, to avoid confusion with time checks.
-c  19       Move the dot.  Data stored in ndotmv,updot,rtdot
-c  20       Set if right-shifted main or chord note here.  Use for space checks.
-c  21       User-defined hardspace in xtup
-c  22       User-defined slur shift horizontal slur shift.
-c  23       Set on last note before staff-jumping a beam.
-c  24       Set on first note after staff-jumping a beam
-c  25       Suppress rest centering. "ro"
-c  26       Dynamic on this note
-c  27       Set if left-shifted main or chord note here.  Use for space checks.
-c  28       Set if xtup starts on this note.
-c  29       Set on lowest-voice note at same time as 1st note after jump-beam. 
-c  30       Set on note after end of jump-beam segment, to force new note group
-c  31       Flag for cautionary accidental
-ccccccccccccc
-cc  nacc   cc
-ccccccccccccc
-c  0-1      0=no accid, 1=fl, 2=sh, 3=na
-c  2        double
-c  3        big
-c  4-9      vertshift-32
-c  10-16    20*(horiz. shift + 5.35) (Recentered ver 2.32) 
-c  17       Midi-only accidental
-c  18       2:1 xtup
-c  19       Together with nacc(18), increase multiplicity by 1 and dot 1st note.
-c  20       Set on last note of each seg except last seg of single-slope beam.
-c  21       Set on 1st note of each seg except 1st seg of single-slope beam.
-c  22-26    If .ne.0, printed xtup number for xtup starting on this note.       
-c  27       Set for dotted xtup note.  Mult dur by 1.5, mult next by .5 & increase
-c             multiplicity by 1
-c  28       Set on main note of chord if accidentals are ordered.
-c  29       Tag for chordal accidental shift...means add to autoshifts.
-c  30-31    Set 30|31 if main note in a chord is part of a 2nd and needs to be shifted.
-c             If upstem|downstem, main is upper|lower member of 2nd
-c             Action is to interchange pitches only when notes are placed. 
-ccccccccccccc
-cc  mult   cc
-ccccccccccccc
-c  0-3      Multiplicity+8 (mult= # of flags)
-c  4        Set if slope adjustment for xtup bracket
-c  5-9      16+slope adjustment
-c  10-15    New stem length, [0-63] => (-4,0,+27.5)
-c  16-22    64+Vertical offset of xtup #
-c  27       Stemlength override
-cc  28-30    New stem length.
-ccccccccccccc
-cc  isdat1 cc
-ccccccccccccc
-c  13-17    iv
-c  3-10     ip
-c  11       start/stop switch
-c  12       kv-1
-c  19-25    ichar(code$)
-c  26       force direction?
-c  27       forced dir'n = up if on, set in sslur; also
-c           final direction, set in doslur when beam is started, used on term.
-c  28-31    ndxslur, set in doslur when beam is started, used on term.
-ccccccccccccc
-cc  isdat2 cc
-ccccccccccccc
-c  0        Chord switch.  Not set on main note.
-c  1-2      left/right notehead shift.  Set only for chord note.
-c  3        tie positioning
-c  4        dotted slur
-c  6-11     voff1 1-63  =>  -31...+31
-c  12-18    hoff1 1-127 => -6.3...+6.3
-c  19-25    nolev
-c  26       \sluradjust    (p+s)
-c  27       \nosluradjust  (p-s)
-c  28       \tieadjust     (p+t)
-c  29       \notieadjust   (p-t)
-ccccccccccccc
-cc  isdat3 cc
-ccccccccccccc
-c  0        set if midslur (at least one argument)
-c  1        set if curve (2 more args)
-c  2-7      32+first arg (height correction) (1st arg may be negative)
-c  8-10     second arg (initial slope)
-c  11-13    third arg (closing slope)
-c  14-21    tie level for use in LineBreakTies
-c  22-29    ncm for use in LineBreakTies
-ccccccccccccc
-cc  isdat4 cc  Set these all at turn-on using s option 
-ccccccccccccc
-c  0-5      Linebreak seg 1 voff 1-63  =>  -31...+31  
-c  6-12     Linebreak seg 1 hoff 1-127 => -6.3...+6.3
-c  16-21    Linebreak seg 2 voff 1-63  =>  -31...+31
-c  22-28    Linebreak seg 2 hoff 1-127 => -6.3...+6.3
-ccccccccccccc
-c  icrdat   c
-ccccccccccccc
-c     0-7   ip within voice
-c     8-11  ivx (together with 28th bit)
-c     12-18 note level
-c     19    accidental?
-c     20-22 accidental value (1=natural, 2=flat, 3=sharp, 6=dflat, 7=dsharp)
-c     23    shift left
-c     24    shift right
-c     25    arpeggio start or stop
-c     26    flag for moved dot (here, not icrdot, since this is always reset!)
-c     27    Midi-only accidental
-c     28    (6/27/10) 5th bit for ivx, to allow up to 24 voices 
-c     29    Tag for accidental shift...means add to autoshifts. 
-c     31    Flag for cautionary accidental on chord note
-ccccccccccccc
-c  icrdot   c:
-ccccccccccccc
-c     0-6   10*abs(vertical dot shift in \internote) + 64
-c     7-13  10*abs(horizontal dot shift in \internote) + 64
-c     14-19 vert accidental shift-32
-c     20-26 20*(horiz accidental shift+3.2)
-c     27-29 top-down level rank of chord note w/accid. Set in crdaccs.
-c
-c  Bits in icrdorn are same as in iornq, even tho most orns won't go in crds.
-c
-cccccccccccccccccccccccccccccccc
-      character*65536 bufq
-      integer*2 lbuf(maxblks)
-      common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
-      character*10 figq
-      common /comignorenats/ ignorenats
-      logical ignorenats
-      character*1 ulq,sepsymq,sq,chax
-      logical beamon,firstgulp,figbass,figchk,
-     *        isfig,rptnd1,rptprev
-      logical loop,lastchar,slint,svolta,evolta,onvolt,
-     *        cwrest(nm),islast,inlast,optimize
-      integer istop(80),numbms(nm),istart(80)
-      real*4 xnsttop(40),xintstaff(40),hesk(23),hpts(23),poevec(nks),
-     *        tstart(80),squez(80)
-      character*1  clefq(nm),ulfbq,rptfq1,rptfq2,charq
-      character*79 notexq,inameq
-      character*40 pathnameq
-      character*44 basenameq
-      character*24 fmtq
-      character*20 voltxtq
-      character*120 instrq,titleq,compoq
-      common /comlast/ islast,usevshrink
-      logical usevshrink,stickyS,OptLineBreakTies,autofbon
-      common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2
-      common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip,
-     *    inhead
-      common /cominbot/ inbothd
-      common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
-     *                fullsize(nm),ivxfig2,ivvfig(2,74)
-      common /comnsp/ space(80),nb,prevtn(nm),
-     *    flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm)
-      common /comstart/ facmtr
-      common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb,
-     *               tautofb,autofbon,t1autofb
-      common /comget/ lastchar,rptnd1,sluron(nm,2),fbon,ornrpt,stickyS,
-     *       movbrk,movnmp,movdnp,movgap,parmov,fintstf,gintstf,
-     *       rptprev,equalize,rptfq1,rptfq2
-      common /combeam/ ibmtyp
-      common /comnotes/ nnodur,lastlev,ndlev(nm,2),shifton,setis,notcrd,
-     *       npreslur,was2(nm),ninow,nobar1,nsystp(40),ipage,
-     *       OptLineBreakTies,HeaderSpecial
-      common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
-     *   isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
-     *   lnam(nm),inameq(nm)
-      common /comas1/ naskb,task(40),wask(40),elask(40)
-      common /comas2/ nasksys,wasksys(800),elasksys(800)
-      common /comas3/ ask(2500),iask,topmods
-      common /comask/ bar1syst,fixednew,scaldold,
-     *                wheadpt,fbar,poenom
-      common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
-     *                 ,WrotePsslurDefaults,SlurCurve
-      common /comsln/ is1n1,is2n1,irzbnd,isnx
-      common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
-     *                nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
-     *                noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
-     *                graspace(37),
-     *                lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
-     *                naccg(74),voltxtq(6),litq(83)
-      logical upg,slurg,slashg,fbon,ornrpt,shifton,isbjmp,notcrd,was2,
-     *        isbj2,fontslur,WrotePsslurDefaults,HeaderSpecial
-      common /comivxudorn/ivxudorn(63)
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      character*128 litq,lnholdq
-      logical upslur,bar1syst,vshrink,lrpt,rrpt,lrptpend,
-     *   ispoi,bcspec,topmods,headlog,clchb,clchv(nm),flgndb,
-     *   btest,sluron,setis,nobar1
-      common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
-     *               ndotmv(nm),updot(nm,20),rtdot(nm,20)
-      common /compoi/ ispoi
-      common /combc/ bcspec
-      common /comeon/ eonk,ewmxk
-      common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
-     *                flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
-     *                rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
-     *                rtshfac
-      common /comhsp/ hpttot(176)
-      common /combmh/ bmhgt,clefend
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
-      common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
-      common /strtmid/ ihnum3,flipend(nm),ixrest(nm)
-      common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
-     *                xinsnow,lowdot
-      common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm)
-      common /commus/ musize,whead20
-      common /comtol/ tol
-      common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12),
-     *        hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41),
-     *        idynda2(99),levhssav(nm),listcresc,listdecresc
-      character*128 txtdynq
-      logical mrecord,mplay,endmac,flipend,istype0,lowdot,rename,ispstie
-      integer*2 mmidi
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc,equalize,
-     *        ismbr,putmbr
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      common /comcb/ nbc,ibcdata(36)
-      common /comclefq/ clefq
-      common /comArpShift/NumArpShift,IvArpShift(20),IpArpShift(20),
-     *                    ArpShift(20)
-      common /comligfont/ isligfont
-      logical isligfont
-      common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
-     *  instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
-      logical EarlyTransOn,LaterInstTrans
-      common /combibarcnt/ ibarcnt
-      character*40 nmq
-      common /commidisig/ midisig
-      common /comclefrests/ centrests
-      logical newclef, centrests
-      common /comlyr/ inputmlyr
-      logical inputmlyr 
-      if (.not.optimize) then
-        print*
-        print*,'Starting second PMX pass'
-        print*
-        write(15,'(a)')'Starting second PMX pass'
-      end if
-      newclef = .false.
-      centrests = .false.
-      ncalls = ncalls+1
-      islast = inlast
-      macuse = 0
-      isyscnt = 0
-      stemmax = 8.2
-      stemmin = 3.9
-      stemlen = 6.0
-      sq = chax(92)
-      ignorenats = .false.
-      bcspec = .true.
-      topmods = .false.
-	ismbr = .false.
-      read(12,'(a)')basenameq
-      read(12,*)lbase
-      read(12,*)fbar,wheadpt,etait,etatc,etacs1,etatop,
-     *         etabot,inbothd,inhnoh,isig
-      ilbuf = 1
-      ipbuf = 0
-      call getset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp,xmtrnum0,
-     *            npages,nsyst,musicsize,fracindent,istype0,inameq,
-     *            clefq,sepsymq,pathnameq,lpath,isig0)
-      if (ismidi) then
-c
-c  Initial key signature and meter for pickup bar
-c  130313 Unless explicit miditranspose for all parts (to be dealt with later),
-c    want concert sig (isig0) here. K+n+m will have changed sig to isig 
-c        call midievent('k',isig,0)
-c 130316 
-c        call midievent('k',isig0,0)
-c        call midievent('k',midisig,0)
-c
-c  Above is probably cosmetic
-c        call midievent('k',midisig,0)
-        if (xmtrnum0 .gt. tol) then
-c
-c  We have a pickup.  Some tricky stuff to get a meter:
-c
-          xntrial = xmtrnum0
-          do 5 ip2 = 0 , 5
-            if (abs(mod(xntrial,1.)) .lt. tol) go to 6
-            xntrial = xntrial*2
-5         continue
-          print*,'Problem finding meter for pickup bar'
-          xntrial = 1.
-          ip2 = 0          
-6         continue
-          call midievent('m',nint(xntrial),2**ip2*mtrdenl)
-        else
-c
-c  No pickup, enter the starting meter
-c
-          call midievent('m',mtrnuml,mtrdenl)
-        end if          
-      end if
-c
-c  Set musicsize from value passed in common, due to possible reset by S[n]m16
-c
-      musicsize = musize
-      read(12,*)npages,widthpt,height,hoffpt,voffpt,nsyst,
-     *   (nsystp(ipa),xnsttop(ipa),xintstaff(ipa),ipa=1,npages),iauto
-c
-c  If default width ever changes, must adjust this stmt.
-c
-      slfac1 = 0.00569*524./widthpt
-      figbass = .false.
-      read(13,*)ifig
-      if (ifig .eq. 1) then
-        figbass = .true.
-        open(14,status='SCRATCH')
-        write(14,'(a)')sq//'def'//sq//'fixdrop{'//sq//'advance'//sq//
-     *      'sysno by 1'//sq//'ifcase'//sq//'sysno%'
-      end if
-      lastchar = .false.
-      ibcoff = 0
-      if (xmtrnum0 .gt. 0.) ibcoff = -1
-      open(11,status='SCRATCH')
-c
-c  vshrink for the first page is calculated in topfile,
-c  and if true set interstaff=10.  vshrink affects Titles.
-c  Must also save vshrink for page ending.
-c
-      call topfile(basenameq,lbase,nv,clefq,noinst,musicsize,
-     *      xintstaff(1),mtrnmp,mtrdnp,vshrink,fbar,fontslur)
-c
-c  ninow is working value of # of instruments.  noinst is max #, and # at start.
-c
-      ninow = noinst
-c
-c  Save original printed meter in case movement breaks
-c
-      movnmp = mtrnmp
-      movdnp = mtrdnp
-c
-      if (islast .and. figbass .and. musicsize.eq.16) 
-     *    write(11,'(a)')sq//'def'//sq//'figfont{'//sq//'eightrm}%'
-c
-      if (islast .and. isligfont) then
-        if (musicsize .eq. 16) then
-          write(11,'(a)')sq//'font'//sq//'ligfont=cmrj at 8pt%'
-        else
-          write(11,'(a)')sq//'font'//sq//'ligfont=cmrj at 10pt%'
-        end if
-      end if
-      lenbeat = ifnodur(mtrdenl,'x')
-      if (mtrdenl .eq. 2) lenbeat = 16
-      lenb1 = mtrnuml*lenbeat
-      if (mtrdenl .eq. 2) lenb1 = lenb1*2
-      call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
-      lenb0 = nint(xmtrnum0*lenbeat)
-      if (mtrdenl .eq. 2) lenb0 = lenb0*2
-      if (lenb0 .ne. 0) then
-        if (islast) write(11,'(a)')sq//'advance'//sq//'barno by -1'
-        lenbar = lenb0
-      else
-        lenbar = lenb1
-      end if
-c
-c  Initialize full-program variables
-c
-      fixednew = 0.
-      scaldold = 0.
-      fintstf = -1.
-      gintstf = 1.
-      nasksys = 0
-      ibarcnt = 0
-      iline = 0
-      movbrk = 0
-      isystpg = 0
-      ipage = 1
-      iccount = 128
-      iask = 0
-      nhstot = 0
-      nb = 1
-      if (.not.optimize) jprntb = 81
-      idsig = 0
-c
-c  Next 5 are raise-barno parameters.  irzbnd is integer part of default level.
-c
-      irzbnd = 3
-      if (isig.eq.3 .and. clefq(nv).eq.'t') irzbnd = 4
-      is1n1 = 0
-      isnx = 0
-      SlurCurve = 0.
-c
-c 111109 Made global rather than per gulp
-c
-      ndyn = 0
-      ispoi = .false.
-      slint = .false.
-      lrptpend = .false.
-      rptnd1 = .false.
-      rptfq2 = 'E'
-      rptprev = .false.
-      onvolt = .false.
-      flgndb = .false.
-      fbon = .false.
-      shifton = .false.
-      ornrpt = .false.
-      setis = .false.
-      lowdot = .false.
-      rename = .false.
-      nobar1 = .false.
-      equalize = .false.
-      usevshrink = .true.
-	WrotePsslurDefaults = .false.
-      OptLineBreakTies = .false.
-      HeaderSpecial = .false.
-c
-c  vshrink is initialized in topfile
-c
-      stickyS = .false.
-c
-c  ixrest = 1 or 2 if xtup has started with a rest
-c
-      do 1 ivx = 1 , nm
-        ixrest(ivx) = 0
-        fullsize(ivx) = 1.
-c
-c  Set legacy note level to middle c as default
-c
-        ndlev(ivx,1) = 29
-        ndlev(ivx,2) = 29
-1     continue
-      npreslur = 0
-      nhssys = 0
-      listslur = 0
-      do 31 i = 1 , 202
-        isdat1(i) = 0
-        isdat2(i) = 0
-31    continue
-      nsdat = 0
-c
-c  Initialize flag for figures in any other voice than 1
-c
-      ivxfig2 = 0
-c
-c  Initialize for loop over gulps
-c
-      firstgulp = .true.
-c
-c  Start a gulp
-c
-30    loop = .true.
-      notcrd = .true.
-      isbjmp = .false.
-      isbj2 = .false.
-      autofbon = .false.
-      tautofb = 0.
-      nbars = 0
-      nfigs(1) = 0
-      nfigs(2) = 0
-      ngrace = 0
-      ntrill = 0
-      ncrd = 0
-      nudorn = 0
-      nlit = 0
-      nvolt = 0
-      ibarmbr = 0
-      nudsp = 0
-c      ndyn = 0   ! 111109
-      ntxtdyn = 0
-      nbc = 0
-      NumArpShift = 0
-      do 3 i = 1 , 37
-        graspace(i) = 0.
-3     continue
-c
-c  Now initialize up to nv.  Do it in getnote as r'qd for 2nd voices per syst.
-c  and also if nv increases in an 'M' directive.
-c
-      do 4 iv = 1 , nv
-        call newvoice(iv,clefq(iv),.false.)
-4     continue
-c
-c  Check if endsymbol was set earlier
-c
-      if (rptnd1) then
-        rptnd1 = .false.
-        rptfq2 = rptfq1
-      else
-c
-c  Only use if movbrk>0, to signal default ('RD')
-c
-        rptfq2 = 'E'
-      end if
-      iv = 1
-      ivx = 1
-2     if (loop) then
-c
-c  Within this loop, nv voices are filled up for the duration of the block.
-c  On exit (loop=.false.) the following are set: nnl(nv),itsofar(nv)
-c  nolev(nv,nnl(nv)),nodur(..),accq(..),irest(..).
-c  nbars is for this input block.
-c  Only at the beginning of an input block will there be a possible mtr change,
-c  signalled by a nonzero mtrnuml. (which will be re-zeroed right after change)
-c
-        call getnote(loop)
-        if (lastchar) go to 40
-        go to 2
-      end if
-c
-c  Finished an input block (gulp).
-c
-      if (ismidi) then
-c
-c  Put rests into midi array for 2nd lines that were not used in this gulp.
-c
-        do 60 iv = 1 , nv
-          if (twoline(iv) .and. nvmx(iv).eq.1) then
-            if (firstgulp .and. lenb0.ne.0) then
-              call addmidi(midchan(iv,2),0,0,0,
-     *                   (nbars-1.)*lenbar+lenb0,.true.,.false.)
-            else
-              call addmidi(midchan(iv,2),0,0,0,1.*nbars*lenbar,.true.,
-     *                     .false.)
-            end if
-          end if
-60      continue
-      end if
-      nvolt = 0
-      do 28 iv = 1 , nm
-        nudoff(iv) = 0
-        ndotmv(iv) = 0
-28    continue
-c
-c  Put stuff at top of p.1.  Must wait until now to have read title info.
-c
-      if (ibarcnt .eq. 0) then
-        call puttitle(inhnoh,xnsttop(ipage),
-     *     etatop,sq,etait,etatc,etacs1,nv,vshrink,sepsymq)
-        if (HeaderSpecial) 
-c
-c  Write special header for first page
-c
-     *       write(11,'(a)')chax(92)//'special{header=psslurs.pro}%'
-      end if
-      do 10 ibar = 1 , nbars
-        ibarcnt = ibarcnt+1
-        bar1syst = ibarcnt .eq. iauto
-        ndig = max(0,int(log10(.001+ibarcnt+ibcoff)))
-        if (islast)
-     *    write(11,'(a11,i'//chax(50+ndig)//')')
-     *              '% Bar count',ibarcnt+ibcoff
-        if (ibar .ne. ibarmbr) then
-          if (.not.optimize) call outbar(ibarcnt+ibcoff,jprntb)
-        else
-          if (.not.optimize) then
-            write(*,'(/,a20,i4,a1,i4)')' Multibar rest, bars',
-     *         ibarcnt+ibcoff,'-',ibarcnt+ibcoff+mbrest-1
-            write(15,'(/,a20,i4,a1,i4)')' Multibar rest, bars',
-     *         ibarcnt+ibcoff,'-',ibarcnt+ibcoff+mbrest-1
-            jprntb = 0
-          end if
-          ibcoff = ibcoff+mbrest-1
-c          if (ibar.eq.1 .and. firstgulp .and.
-c     *       .not.btest(islur(1,1),5)) xb4mbr = facmtr*musicsize
-          if (ibar.eq.1 .and. firstgulp .and.
-     *       .not.btest(islur(1,1),5)) xb4mbr = -.2*musicsize
-        end if
-c
-c  Move the read to after end-of-bar hardspace checks, so we get right poenom
-c  at end of a line.
-c       if (bar1syst) read(12,*) poenom
-c
-c  Check for clef at start of bar.  No slide yet.  Also flags at end of prev.
-c  bar.  This block is run at the start of every bar.  May fail for flag at
-c  end of last bar.  To account for necc. hardspaces, compute and store
-c    nhssys = # of hard spaces for this system
-c    hesk(nhssys) = elemskips avialable
-c    hpts(nhssys) = hard points needed, including notehead
-c  Here, merely insert placeholder into output.  Later, when poe is computed,
-c  compute additional pts and store them in hpttot(1...nhstot).  Finally in
-c  subroutine askfig, write true pts where placeholders are.
-c
-        ioff = 0
-        if (ibar .gt. 1) ioff = nib(1,ibar-1)
-        clchb = btest(islur(1,ioff+1),15)
-        putmbr = .false.
-        if (ismbr) then
-          if (clchb) then
-ccc
-ccc  Clef change and multi-bar rest coming up.  Kluge to get space at end of rest.
-ccc
-            write(11,'(a)')sq//'let'//sq//'mbrt'//sq//'mbrest'
-     *       //sq//'def'//sq//'mbrest#1#2#3{%'
-            write(11,'(a14,f4.1,a)')sq//'mbrt{#1}{#2}{',musicsize*.55,
-     *        '}'//sq//'global'//sq//'let'//sq//'mbrest'//sq//'mbrt}%'
-cc
-cc  RDT suggestion is inset blank barline - 160103 Abandoned
-cc
-c            write(11,'(a)')sq//'setemptybar'//sq//'bar'//sq//'qspace'
-c     *        //sq//'advance'//sq//'barno-1'
-          end if
-          ismbr = .false.
-          putmbr = .true.
-        end if
-        if (ibar .eq. ibarmbr) ismbr = .true. 
-c
-c  Set flag here so at start of next bar, if there's a clef change, can add space
-c    after the mbr with the above kluge
-c
-        if (.not.(clchb .or. flgndb)) go to 23
-c
-c  Must check available space
-c
-        ptsndb = 0.
-c
-c  Zero out block signal
-c
-        if (clchb) islur(1,ioff+1) = ibclr(islur(1,ioff+1),15)
-c
-c  In this loop, we determine how much hardspace is needed (if any)
-c  9/7/97  Note that for last bar in input block, if number of lines of
-c    music decreases in new block, highest numbered ones won't be checked
-c    since the loop below covers the new nvmx(iv), not necessarily the old
-c    one.
-c  4/18/98 Apparently nmxsav was a solution to the above problem
-c
-        do 16 iv = 1 , nv
-        do 16 kv = 1 , nvmxsav(iv)
-          ivx = ivmxsav(iv,kv)
-          ptsndv = flgndv(ivx)*wheadpt
-          ioff = 0
-          if (ibar .gt. 1) then
-            ioff = nib(ivx,ibar-1)
-            ip = ioff
-            if (ibar.gt.2) ip = ioff-nib(ivx,ibar-2)
-c            prevtn(ivx) = tnote(iand(ipl(ivx,ip),255))
-            prevtn(ivx) = tnote(ipl2(ivx,ip))
-c
-c If ibar=1 (1st bar in input block), prevtn(ivx) was set at end of makeabar.
-c
-          end if
-c
-c  Only allow clef changes when ivx <= nv
-c
-          if (ivx .le. nv) then
-            clchv(iv) = clchb .and. btest(islur(iv,ioff+1),11)
-            if (clchv(iv)) then
-c
-c  Clef change in this voice.  Turn off signal.  Get space avail.
-c
-              islur(iv,ioff+1) = ibclr(islur(iv,ioff+1),11)
-              if (abs(prevtn(iv)-space(nb)).lt.tol) ptsndv =
-     *             ptsndv+clefend*wheadpt
-            end if
-          end if
-          ptsndb = max(ptsndb,ptsndv+wheadpt*xspfac)
-16      continue
-c
-c ????  where is nb set???  nb probably in left over from makeabar
-c
-        esk = feon(space(nb)*squez(nb))
-        ptsdflt = esk*poenom-wheadpt
-c        if ((ptsndb.gt.ptsdflt.or.ptsgnd.gt.0.) .and. movbrk.eq.0) then
-        if ((ptsndb.gt.ptsdflt.or.ptsgnd.gt.0.) .and. movbrk.eq.0
-     *       .and. .not.putmbr) then
-c
-c  Must ADD hardspace!  So put in a placeholder, and store params for later.
-c
-          if (islast) write(11,'(a)')sq//'xardspace{    pt}%'
-          nhssys = nhssys+1
-          if (ptsndb-ptsdflt .gt. ptsgnd-poenom*eskgnd) then
-            hesk(nhssys) = esk
-            hpts(nhssys) = ptsndb+wheadpt
-          else
-            hesk(nhssys) = eskgnd
-            hpts(nhssys) = ptsgnd+wheadpt
-          end if
-          fixednew = fixednew+hpts(nhssys)
-          scaldold = scaldold+hesk(nhssys)
-        end if
-        if (clchb) then
-          do 17 iv = 1 , nv
-            if (clchv(iv)) then
-              notexq = sq//'znotes'
-              lnote = 7
-              do 24 iiv = 2 , iv
-                notexq = notexq(1:lnote)//sepsymq(iiv-1)
-                lnote = lnote+1
-24            continue
-c
-c  Recompute ioff since it will vary from voice to voice
-c
-              if (ibar .eq. 1) then
-                ioff = 0
-              else
-                ioff = nib(iv,ibar-1)
-              end if
-c
-c  Must call clefsym to get nclef, even if there is a movement break
-c
-              call clefsym(islur(iv,ioff+1),fmtq,lclef,nclef)
-c
-c If clefq = '8', must change '0' in pos'n 9 to '8'
-c
-              if (btest(ipl(iv,ioff+1),2)) fmtq = 
-     *                           fmtq(1:8)//'8'//fmtq(10:10)
-              if (movbrk.eq.0 .and.
-     *            islast)
-     *          write(11,'(a)')notexq(1:lnote)//fmtq(1:lclef)//sq//'en%'
-c              call wsclef(iv,ninow,clefq,nclef)
-              call wsclef(iv,ninow,nclef)
-c
-c  Set new flag to be used just outside this loop, to kluge
-c    any calls to \CenterBar for full-bar rests, to make room for clef.
-c
-              newclef = .true.              
-c
-c 151220
-c wrong test:
-c If clefq = '8', must add eg \settrebleclefsymbol3\treblelowoct%
-c Replaced with right one. But also, clefq(iv) seems to stay at 8 here,
-c   and if we change from TLO to normal clef, need to resetclefsymbols
-c
-c              if (clefq(iv) .eq. '8') then
-              if (btest(ipl(iv,ioff+1),2)) then
-                if (iv .le. 9) then
-                  write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',nv,
-     *              sq//'treblelowoct%'
-                else
-                  write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',nv,
-     *              sq//'treblelowoct%'
-                end if
-              else
-                if (clefq(iv) .eq. '8') then
-                  write(11,'(a20)')sq//'resetclefsymbols'
-                end if
-              end if
-            end if
-17        continue
-          if (islast) write(11,'(a)')sq//'pmxnewclefs'
-        end if
-23      continue
-c
-c  Kluge \CenterBar for whole bar rests if necessary
-c
-        if (newclef .and. centrests) then
-c           write(11,'(a)')sq//'def'//sq//'value{11}%'
-          nvalue = nint(.55*musicsize)
-          if (nvalue .gt. 10) then
-            write(11,'(a11,i2,a2)')
-     *            sq//'def'//sq//'value{',nvalue,'}%'
-          else
-            write(11,'(a11,i1,a2)')
-     *            sq//'def'//sq//'value{',nvalue,'}%'
-          end if
-        end if
-        newclef = .false.
-        centrests = .false.
-c
-c  End of loop for end-of-bar hardspaces and non-movbrk clef symbol.
-c
-        if (bar1syst) then
-          read(12,*) poenom
-        end if
-c
-c  Repeat symbols.  Haven't slid down yet, so use islur(1,nib(1,ibar-1)+1)
-c
-        if (ibar .eq. 1) then
-          islnow = islur(1,1)
-c          iornqnow = iornq(1,1)
-          iplnow = ipl(1,1)
-        else
-          islnow = islur(1,nib(1,ibar-1)+1)
-c          iornqnow = iornq(1,nib(1,ibar-1)+1)
-          iplnow = ipl(1,nib(1,ibar-1)+1)
-        end if
-c
-c  Check for R-symbols set at end of prior input block
-c
-        if (movbrk.eq.0 .and. rptfq2.ne.'E') then
-          if (rptfq2 .eq. 'D') then
-            islnow = ibset(islnow,26)
-          else if (rptfq2 .eq. 'r') then
-            islnow = ibset(islnow,6)
-          else if (rptfq2 .eq. 'd') then
-            islnow = ibset(islnow,8)
-          else if (rptfq2 .eq. 'b') then
-            islnow = ibset(islnow,25)
-          else
-            print*
-            print*,'Illegal symbol with "R" at end of input block:',
-     *        rptfq2
-            call stop1()
-          end if
-          rptfq2 = 'E'
-        end if
-        if (iand(islnow,352) .ne. 0) then
-c
-c  Bit 5(lrpt), 6(rrpt), or 8(doublebar) has been set
-c
-          lrpt = btest(islnow,5)
-          rrpt = btest(islnow,6)
-          lrptpend = lrpt.and.bar1syst
-          if (lrpt .and. .not.lrptpend) then
-            if (rrpt) then
-              if (islast) write(11,'(a)')sq//'setleftrightrepeat'
-              fixednew = fixednew+wheadpt*lrrptfac-0.4
-            else
-              if (islast) write(11,'(a)')sq//'setleftrepeat'
-              fixednew = fixednew+wheadpt*rptfac-0.4
-            end if
-          else if (rrpt) then
-            if (islast) write(11,'(a)')sq//'setrightrepeat'
-            fixednew = fixednew+wheadpt*rptfac-0.4
-          else if (btest(islnow,8)) then
-            if (islast) write(11,'(a)')sq//'setdoublebar'
-            fixednew = fixednew+wheadpt*dbarfac-0.4
-          end if
-        else if (btest(islnow,26)) then
-c
-c  doubleBAR
-c
-          if (islast) write(11,'(a)')sq//'setdoubleBAR'
-          fixednew = fixednew+wheadpt*ddbarfac-0.4
-c        else if (btest(iornqnow,29)) then
-        else if (btest(iplnow,0)) then
-c
-c  no bar line
-c
-c--        if (islast) write(11,'(a)')sq//'setzalaligne'
-c++ 
-          if (islast) then
-            if (movbrk .eq. 0) then
-              write(11,'(a)')sq//'setzalaligne'
-            else
-c
-c  Encountered "Rz" at start of input block at start of new movement,  Must
-c    use newmovement macro with arg 4 rather than setzalaligne, since former 
-c    already redefines stoppiece.
-c
-              rptfq2 = 'z'
-            end if
-          end if
-c++
-          fixednew = fixednew-0.4
-        end if
-c
-c  1st and 2nd endings
-c
-        svolta = btest(islnow,7)
-        evolta = btest(islnow,9)
-        if (evolta) then
-          if (btest(islnow,10)) then
-            if (islast) write(11,'(a)')sq//'endvoltabox'
-          else
-            if (islast) write(11,'(a)')sq//'endvolta'
-          end if
-          onvolt = .false.
-        end if
-        if (svolta) then
-          nvolt = nvolt+1
-          lvoltxt = index(voltxtq(nvolt),' ')-1
-          if (lvoltxt .eq. 1) then
-            if (islast) write(11,'(a)')sq//'Setvolta'
-     *          //voltxtq(nvolt)(1:1)//'%'
-          else
-            if (islast) write(11,'(a)')sq//'Setvolta'//'{'//
-     *        voltxtq(nvolt)(1:lvoltxt)//'}%'
-          end if
-          onvolt = .true.
-        end if
-        if (ibar .gt. 1) then
-          ipnow = nib(1,ibar-1)+1
-        else
-          ipnow = 1
-        end if
-        iplnow = ipl(1,ipnow)
-        if (bar1syst) then
-c
-c  If listslur>0, then there is at least one slur or tie carried over the break
-c
-          ispstie = .false.
-          if (OptLineBreakTies .and. .not.fontslur .and. listslur.ne.0
-     *         .and. islast) 
-     *          call LineBreakTies(isdat1,isdat2,isdat3,isdat4, nsdat,
-     *                             ispstie,sepsymq)
-          iline = iline+1
-c
-c  End an old system, Start a new system
-c
-c  Reduce space before mbrest at start of system
-c  Need this even if no accidentals in key signature  
-c
-          if (ibar.eq.ibarmbr) xb4mbr = -.2*musicsize
-c
-          if (iline .ne. 1) then
-c
-c  Not first line.
-c  Get corrected poe = points/elemskip for *previous* system
-c
-            wdpt = widthpt*(1-fracindent)
-            poe = (wdpt-fsyst*musicsize-0.4*nbarss-fixednew)/
-     *            (elsktot+fbar*nbarss-scaldold)
-            isyscnt = isyscnt+1
-            poevec(isyscnt) = poe
-c
-c  Transfer data for system into global arrays to hold until very end
-c
-            do 9 ia = 1 , nasksys
-              iask = iask+1
-              ask(iask) = wasksys(ia)/poe-abs(elasksys(ia))
-c
-c  Only admit negative ask if it was user-defined space, signalled by elask<=0.
-c
-              if (elasksys(ia).gt.0) ask(iask)=dim(ask(iask),0.)
-9           continue
-            do 25 ia = 1 , nhssys
-              nhstot = nhstot+1
-              hpttot(nhstot) = max(hpts(ia)-hesk(ia)*poe,0.)
-25          continue
-c
-c  Reset counters for new system
-c
-            scaldold = 0.
-            fixednew = 0.
-            nasksys = 0
-            nhssys = 0
-          end if
-c
-c  End of if block for first bar of non-first system. Still 1st bar, any system
-c
-          if (islast.and.figbass) write(11,'(a)')sq//'fixdrop%'
-          isystpg = isystpg+1
-c
-c  Try moving the next stmt way down, to fix a bug and get \eject printed at
-c  end of single-system page.
-c          if (isystpg .eq. nsystp(ipage)) isystpg = 0
-          read(12,*)nbarss,elsktot,fsyst,frac,eonk,ewmxk
-          if (iline .gt. 1) fracindent=frac
-          if (figbass) then
-            ifigdr(1,iline) = 4
-            ifigdr(2,iline) = 4
-          end if
-          slfac = slfac1*musicsize*elsktot
-          if (iline .ne. 1) then
-c
-c  For the line just _finished_, put figdrop in separate file.
-c
-            if (figbass) write(14,'(a9,i2,a10,i2,1x,a4)')
-     *          sq//'figdrop=',ifigdr(1,iline-1),
-     *         ' '//sq//'figdtwo=',ifigdr(2,iline-1),sq//'or%'
-c
-c  Check slurs in top staff for interference w/ barno. Only check when
-c  # if digits in barno >= |isig|  But to keep on/off phasing, must ALWAYS
-c  keep track of ons and offs when |isig|<=3.
-c
-            ndigbn = int(alog10(ibarcnt+ibcoff+.01))+1
-            isnx = 0
-            if (ndigbn.ge.iabs(isig) .and. is1n1.gt.0) then
-c
-c  There's a slur in top voice over the line break, hgt=is1n1, idcode=is2n1
-c  Look for termination in remainder of this input block.  If not found,
-c  just use is1n1.  Remember, haven't slid down yet.
-c
-              ioff = 0
-              if (ibar .gt. 1) ioff = nib(ivmx(nv,nvmx(nv)),ibar-1)
-              do 50 isdat = 1 , nsdat
-                if (igetbits(isdat1(isdat),5,13).eq.ivmx(nv,nvmx(nv))
-     *              .and. .not.btest(isdat1(isdat),11)
-     *              .and. igetbits(isdat1(isdat),7,19).eq.is2n1) then
-c
-c  Found slur ending.  Just check note height, can't do fine adjustments.
-c
-c                 is1n1 = max(is1n1,igetbits(isdat2(nsdat),7,19))
-                  is1n1 = max(is1n1,igetbits(isdat2(isdat),7,19))
-                  go to 51
-                end if
-50            continue
-c
-c  If exiting loop normally, did not find end of slur.  c'est la vie.
-c
-51            continue
-              isnx = idim(is1n1,ncmid(nv,1)+1+irzbnd)
-              if (isnx .gt. 0) then
-c
-c  AHA! Slur likely to interfere with barno.
-c
-c  Modified 090525 to use \bnrs
-c
-                slint = .true.
-                fmtq = '(a16,i1,a14)'
-                if (irzbnd+isnx .gt. 9) fmtq = '(a16,i2,a14)'
-                if (islast) write(11,fmtq)sq//'def'//sq//'raisebarno{',
-     *             irzbnd+isnx,'.5'//sq//'internote}%'
-c                if (islast) then
-c                  if (isnx .le. 9) then
-c                    write(11,'(a5,i1,a2)')sq//'bnrs',isnx,'0%'
-c                  else
-c                    write(11,'(a6,i2,a3)')sq//'bnrs{',isnx,'}0%'
-c                  end if
-c                end if
-c
-              end if
-            end if
-            if (movbrk .gt. 0) then
-c
-c              movbrk = 0
-c  Move the reset down, so can use movbrk>0 to stop extra meter prints.
-c
-c  New movement.  Redefine stoppiece, contpiece.  These will be called either
-c     explicitly or as part of alaligne.
-c  indsym = 0,1,2 for doubleBAR , doublebar, rightrepeat.
-c     This is passed to \newmovement.
-c
-              if (rptfq2 .eq. 'E') rptfq2 = 'D'
-              indsym = index('Ddrbz',rptfq2)-1
-              rptfq2 = 'E'
-c
-c  Also check for Rd or Rr set the normal way
-c
-              if (btest(islnow,8)) then
-                indsym = 1
-              else if (btest(islnow,6)) then
-                indsym = 2
-              end if
-              if (indsym .lt. 0) then
-                print*
-                print*,'Illegal end symbol before "/"'
-                call stop1()
-              end if
-c
-c  Check for continuation (no bar number reset)
-c
-              if (islast.and.
-     *            nobar1) write(11,'(a)')sq//'advance'//sq//'barno1'
-     *           //sq//'startbarno'//sq//'barno%'
-c
-c Per Rainer's suggestion, changing \nbinstruments via 3rd arg of \newmovement
-c
-c              if (movgap .lt. 10) then
-c                if (islast) write(11,'(a12,2i1,a1)')
-c     *                sq//'newmovement',movgap,indsym,'%'
-c              else
-c                if (islast) write(11,'(a13,i2,a1,i1,a1)')
-c     *                sq//'newmovement{',movgap,'}',indsym,'%'
-c              end if
-              if (islast) then
-                nmq = sq//'newmovement'
-                lnmq = 12
-                if (movgap .lt. 10) then
-                  lnmq = 14
-				write(nmq(13:14),'(2i1)')movgap,indsym
-                else
-                  lnmq = 17
-                  write(nmq(13:17),'(a1,i2,a1,i1)')'{',movgap,'}',indsym
-                end if
-                if (ninow .lt. 10) then
-                  lnmq = lnmq+1
-                  write(nmq(lnmq:lnmq),'(i1)')ninow
-                else
-                  lnmq = lnmq+4
-                  write(nmq(lnmq-3:lnmq),'(a1,i2,a1)')'{',ninow,'}'
-                end if
-                lnmq = lnmq+1
-                write(nmq(lnmq:lnmq),'(a1)')'%'
-                write(11,'(a)')nmq(1:lnmq)
-              end if
-c
-c  Change generalmeter if necessary
-c
-              if (islast) call wgmeter(mtrnmp,mtrdnp)
-c
-c  (Moved all name-writing to getnote, right when 'M' is detected)
-c
-              if (btest(iplnow,28)) then
-c
-c  Key signature at movement break
-c
-                iplnow = ibclr(iplnow,28)
-                if (isig .gt. 0) then
-                  if (islast) write(11,'(a18,i1,a2)')
-     *                sq//'generalsignature{',isig,'}%'
-                else
-                  if (islast) write(11,'(a18,i2,a2)')
-     *                sq//'generalsignature{',isig,'}%'
-                end if
-                if (islast .and. LaterInstTrans) then
-                  call Writesetsign(nInstTrans,iInstTrans,iTransKey,
-     *              LaterInstTrans)
-                end if              
-              end if
-              if (parmov .ge. -.1) then
-c
-c  Resent paragraph indentation
-c
-                ipi = parmov*widthpt+.1
-                if (ipi .lt. 10) then
-                  if (islast) write(11,'(a11,i1,a2)')
-     *                sq//'parindent ',ipi,'pt'
-                else if (ipi .lt. 100) then
-                  if (islast)
-     *              write(11,'(a11,i2,a2)')sq//'parindent ',ipi,'pt'
-                else
-                  if (islast)
-     *              write(11,'(a11,i3,a2)')sq//'parindent ',ipi,'pt'
-                end if
-              end if
-            end if
-            if (isystpg .eq. 1) then
-c
-c  First line on a page (not 1st page, still first bar).  Tidy up old page
-c  then eject.
-c
-c  Removed this 5/13/01 as it was causing double endvoltas.  This probably
-c  is only needed at the end in case there is no endvolta specified.
-c              if (onvolt) then
-cc                if (islast) write(11,'(a)')sq//'endvoltabox%'
-cc                onvolt = .false.
-c              end if
-c
-c             
-c  Check for meter change at start of a new PAGE
-c
-              if (mtrnuml .gt. 0) then
-c
-c  Meter change at start of a new page.  Ugly repeated coding here.
-c
-                mtrnms = mtrnuml
-                call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
-                mtrnuml = mtrnms
-                if (movbrk .eq. 0 .and. islast) 
-     *              call wgmeter(mtrnmp,mtrdnp)
-              end if
-c
-c  Key signature change?
-c
-              if (btest(iplnow,28) .and. movbrk.eq.0) then
-                notexq = sq//'xbar'//sq//'addspace{-'//sq//
-     *            'afterruleskip}'//sq//'generalsignature{'
-                lnote = 49
-                if (isig .lt. 0) then
-                  notexq = notexq(1:49)//'-'
-                  lnote = 50
-                end if
-                if (islast) write(11,'(a)')
-     *              notexq(1:lnote)//chax(48+abs(isig))//'}%'
-                if (islast .and. LaterInstTrans) then
-                  call Writesetsign(nInstTrans,iInstTrans,iTransKey,
-     *              LaterInstTrans)
-                end if
-                if (islast .and. ignorenats)
-     *             write(11,'(a)')sq//'ignorenats%'              
-                if (islast) write(11,'(a)')sq//'zchangecontext'//sq
-     *              //'addspace{-'//sq//'afterruleskip}'
-     *              //sq//'zstoppiece'//sq//'PMXbarnotrue%'
-              else if (mtrnuml.gt.0 .and. movbrk.eq.0) then
-c
-c  Meter change but no signature change
-c
-                if (islast)
-     *          write(11,'(a)')sq//'xchangecontext'//sq//'addspace{-'//
-     *              sq//'afterruleskip}'//sq//'let'//sq//'bnat'//sq//
-     *              'barnoadd%'
-                if (islast)
-     *          write(11,'(a)')sq//'def'//sq//'barnoadd{'//sq//'let'//
-     *              sq//'barnoadd'//sq//'bnat}'//sq//'zstoppiece%'
-              else
-                if (islast) write(11,'(a)')sq//'stoppiece%'
-              end if
-c
-c  This is the key spot when vshrink is used.  Value of vshrink here comes from 
-c  just after the prior pagebreak, i.e., it is not affected by "Av" 
-c  that may have been entered at this pagebreak, since that only affects usevshrink.
-c  So choose page *ending* (with or without \vfill) depending on old vshrink.  Then
-c  check value of usevshrink to reset vshrink if necessary for the new page, where
-c  we have to set \interstaff and later call puttitle.  
-c  Top of first page needs special treatment.  For this we use
-c  novshrinktop, which was set in g1etnote on the first pass, since on 
-c  second pass, vshrink at top of page one is dealt with in topfile, which is called
-c  *before* any reading in any "Av" at the top of the first input block.
-c
-              if (.not.vshrink) then
-                xnstbot = xnsttop(ipage)*etabot/etatop
-                if (xnstbot .lt. 9.95) then
-                  fmtq = '(a,f3.1,a)'
-                else
-                  fmtq = '(a,f4.1,a)'
-                end if
-                if (islast) write(11,fmtq)sq//'vskip',xnstbot,
-     *              sq//'Interligne'//sq//'eject%'
-              else
-                if (islast) write(11,'(a)') sq//'vfill'//sq//'eject%'
-              end if
-              ipage = ipage+1
-c
-c  Now that page is ejected, compute new vshrink
-c
-              vshrink = xintstaff(ipage).gt.20 .and. usevshrink
-              if (vshrink) then
-                xinsnow = 10
-              else
-                xinsnow = xintstaff(ipage)
-              end if
-              if (fintstf.gt.0 .and. ipage.gt.1) then
-                xinsnow = xinsnow*fintstf/gintstf
-                fintstf = -1.
-              end if
-              if (xinsnow .lt. 9.95) then
-                fmtq = '(a,f3.1,a)'
-              else if (xinsnow .lt. 99.95) then
-                fmtq = '(a,f4.1,a)'
-              else
-                fmtq = '(a,f5.1,a)'
-              end if
-c
-c  Vertical spacing parameters, then restart
-c
-              if (islast) write(11,fmtq)sq//'interstaff{',xinsnow,
-     *            '}'//sq//'contpiece'
-c
-c  Check for meter change at start of a new PAGE
-c
-              if (mtrnuml .gt. 0) then
-c
-c  Meter change at start of a new page
-c
-                call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
-                if (movbrk .eq. 0) then
-                  if (islast) call wgmeter(mtrnmp,mtrdnp)
-                  if (mtrdnp .gt. 0) then
-                    if (islast) write(11,'(a)')sq//'newtimes2%'
-                    if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize
-                  end if
-                end if
-              end if
-c
-c  If no real titles here, which there probably will never be, make vertical
-c  space at page top with \titles{...}.  headlog=.false.<=>no real titles
-c
-              call puttitle(inhnoh,xnsttop(ipage),etatop,
-     *           sq,etait,etatc,etacs1,nv,vshrink,sepsymq)
-              if (HeaderSpecial) 
-c
-c  Write special header for first page
-c
-     *           write(11,'(a)')chax(92)//'special{header=psslurs.pro}%'
-            else
-c
-c  First bar of system, not a new page, force line break
-c
-              if (btest(iplnow,28)) then
-c
-c  Signature change
-c
-                notexq = sq//'xbar'//sq//'addspace{-'//sq//
-     *            'afterruleskip}'//sq//'generalsignature{'
-                lnote = 49
-                if (isig .lt. 0) then
-                  notexq = notexq(1:49)//'-'
-                  lnote = 50
-                end if
-                if (islast) write(11,'(a)')notexq(1:lnote)
-     *                   //chax(48+abs(isig))//'}%'
-                if (islast .and. LaterInstTrans) then
-                  call Writesetsign(nInstTrans,iInstTrans,iTransKey,
-     *              LaterInstTrans)
-                end if              
-                if (islast) write(11,'(a)')sq//'advance'//sq//'barno-1%'
-                if (mtrnuml .ne. 0) then
-c
-c  Meter+sig change, new line, may need mods if movement break here.
-c
-                  call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
-                  if (islast) then
-                    call wgmeter(mtrnmp,mtrdnp)
-                    if (ignorenats) write(11,'(a)')sq//'ignorenats%'
-                    write(11,'(a)')sq//'xchangecontext'//sq//
-c     *                'addspace{-'//sq//'afterruleskip}'//sq//'def'
-     *                'addspace{-'//sq//'afterruleskip}'
-c     *                //sq//'writezbarno{}'//sq//'zalaligne%'
-     *      //sq//'zstoppiece'//sq//'PMXbarnotrue'//sq//'contpiece%'
-                    write(11,'(a)')sq//'addspace{-'//sq
-     *                //'afterruleskip}%'
-                    call wgmeter(mtrnmp,mtrdnp)
-                    if (ignorenats) write(11,'(a)')sq//'ignorenats%'
-                    write(11,'(a)')sq//'zchangecontext'
-                  end if
-                else
-                 if (islast .and. ignorenats) 
-     *                 write(11,'(a)')sq//'ignorenats%'
-                 if (islast) write(11,'(a)')sq//'xchangecontext'//sq//
-c     *               'addspace{-'//sq//'afterruleskip}'//sq//'def'//
-     *               'addspace{-'//sq//'afterruleskip}'
-c     *               sq//'writezbarno{}'//sq//'zalaligne%'
-     *      //sq//'zstoppiece'//sq//'PMXbarnotrue'//sq//'contpiece%'
-                end if
-              else if (mtrnuml .eq. 0) then
-c
-c  No meter change
-c
-                if (islast) write(11,'(a)')sq//'alaligne'
-              else
-c
-c  New meter, no new sig, end of line, not new page.
-c
-c \generalmeter{\meterfrac{3}{4}}%
-c \xchangecontext\addspace{-\afterruleskip}%
-c \zalaligne\generalmeter{\meterfrac{3}{4}}\addspace{-\afterruleskip}%
-c \zchangecontext
-c
-                call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
-                if (movbrk .eq. 0) then
-                  if (islast) call wgmeter(mtrnmp,mtrdnp)
-                  if (mtrdnp .gt. 0) then
-                    if (islast) then
-                      write(11,'(a)')
-     *                    sq//'let'//sq//'bnat'//sq//'barnoadd'
-     *                    //sq//'def'//sq//'barnoadd{'//sq//'empty}%'
-                      write(11,'(a)')sq//'xchangecontext'//sq//
-     *                   'addspace{-'//sq//'afterruleskip}'//sq//
-     *                'zalaligne'//sq//'let'//sq//'barnoadd'//sq//'bnat'
-                      call wgmeter(mtrnmp,mtrdnp)
-                      write(11,'(a)')sq//'addspace{-'//sq//
-     *                   'afterruleskip}'//sq//'zchangecontext'
-                    end if
-                    if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize
-                  else
-                    if (islast) write(11,'(a)')sq//'alaligne'
-                  end if
-                else
-                  if (islast) write(11,'(a)')sq//'alaligne'
-                end if
-              end if
-            end if
-c
-c  Modified 090525 to use \bnrs
-c
-            if (slint) then
-              slint = .false.
-              if (islast) write(11,'(a16,i1,a14)')sq//'def'//sq//
-     *              'raisebarno{',irzbnd,'.5'//sq//'internote}%'
-            end if
-            movbrk = 0
-          end if
-c
-c  Clean up if we squelched bar number reset at movement break
-c
-          if (nobar1) then
-            if (islast) write(11,'(a)')sq//'startbarno1'
-            nobar1 = .false.
-          end if
-          read(12,*,end=14)iauto
-14        continue
-c
-c  We come thru here for the 1st bar of every system, so initialize is1n1
-c
-          is1n1 = 0
-c
-c  Brought down from above 
-c
-          if (isystpg .eq. nsystp(ipage)) isystpg = 0
-c
-c  Check for linebreak ties
-c
-          if (ispstie) 
-     *         call LineBreakTies(isdat1,isdat2,isdat3,isdat4,nsdat,
-     *                             ispstie,sepsymq)
-        else
-c
-c  Not first bar of system
-c
-          if (btest(iplnow,28)) then
-c
-c  Signature change
-c
-            if (mtrnuml .ne. 0) then
-c
-c  Meter+signature change mid line, assume no movement break
-c
-              call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
-              if (islast) call wgmeter(mtrnmp,mtrdnp)
-              notexq = sq//'generalsignature{'
-              lnote = 18
-              if (isig .lt. 0) then
-                notexq = notexq(1:18)//'-'
-                lnote = 19
-              end if
-              if (islast) then
-                iptemp = 48+abs(isig)
-                charq = chax(iptemp)
-                notexq = notexq(1:lnote)//charq//'}%'
-                lnote = lnote+3
-                write(11,'(a)')notexq(1:lnote)
-                if (islast .and. LaterInstTrans) then
-                  call Writesetsign(nInstTrans,iInstTrans,iTransKey,
-     *              LaterInstTrans)
-                end if
-              if (ignorenats) write(11,'(a)')sq//'ignorenats%'              
-              write(11,'(a)')sq//'xchangecontext%'
-              end if
-              if (ibar .eq. ibarmbr) then
-c
-c  Compute space for multibar rest
-c
-                if (lastisig*isig .ge. 0) then
-                  naccs = max(abs(lastisig),abs(isig))
-                else
-                  naccs = abs(lastisig-isig)
-                end if
-c                xb4mbr = (facmtr+naccs*.24)*musicsize
-                xb4mbr = -.2*musicsize
-              end if
-            else
-c
-c  Signature change only
-c
-              notexq = sq//'xbar'//sq//'addspace{-'//sq//
-     *            'afterruleskip}'//sq//'generalsignature{'
-              lnote = 49
-              if (isig .lt. 0) then
-                notexq = notexq(1:49)//'-'
-                lnote = 50
-              end if
-              if (islast)
-     *          write(11,'(a)')notexq(1:lnote)//chax(48+abs(isig))//'}%'
-              if (islast .and. LaterInstTrans) then
-                  call Writesetsign(nInstTrans,iInstTrans,iTransKey,
-     *              LaterInstTrans)
-              end if              
-              if (islast .and. ignorenats)
-     *             write(11,'(a)')sq//'ignorenats%'              
-              if (islast) write(11,'(a)')sq//'zchangecontext'//sq
-     *            //'addspace{-.5'// sq//'afterruleskip}%'
-              if (ibar .eq. ibarmbr) then
-c
-c  Compute space for multibar rest
-c
-                if (lastisig*isig .ge. 0) then
-                  naccs = max(abs(lastisig),abs(isig))
-                else
-                  naccs = abs(lastisig-isig)
-                end if
-c                xb4mbr = naccs*.24*musicsize
-                xb4mbr = -.2*musicsize
-              end if
-            end if
-          else if (mtrnuml .eq. 0) then
-c
-c  No meter change
-c
-            if (islast) write(11,'(a)')sq//'xbar'
-          else
-c
-c  Change meter midline
-c
-            call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
-            if (movbrk .eq. 0) then
-              if (islast) call wgmeter(mtrnmp,mtrdnp)
-              if (mtrdnp .gt. 0) then
-                if (islast) then
-c                  if (mbrest .gt. 0) then
-cc                    write(11,'(a)')sq//'addspace{-2'//sq//
-cc     *               'afterruleskip}'//sq//'setemptybar'//sq//'bar'
-c                    write(11,'(a)')sq//'setemptybar'//sq//'bar'//sq//
-c     *                    'advance'//sq//'barno-1%'
-c                  end if
-                  write(11,'(a,2i1,a)')sq//'newtimes0%'
-                end if
-c                if (ibar .eq. ibarmbr) xb4mbr = facmtr*musicsize
-                if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize
-              else
-                if (islast) write(11,'(a)')sq//'xbar'
-              end if
-            end if
-          end if
-        end if
-c
-c  Now that xbar's are written, can put in left-repeats at line beginnings
-c
-        if (lrptpend) then
-          if (islast) write(11,'(a)')sq//'advance'//sq//'barno-1'
-     *        //sq//'leftrepeat'
-          lrptpend = .false.
-        end if
-        if (ibar .gt. 1) then
-c
-c  For bars after first, slide all stuff down to beginning of arrays
-c
-          do 11 iv = 1 , nv
-          do 11 kv = 1 , nvmx(iv)
-            ivx = ivmx(iv,kv)
-            ioff = nib(ivx,ibar-1)
-            do 12 ip = 1 , nib(ivx,ibar)-ioff
-              nolev(ivx,ip) = nolev(ivx,ip+ioff)
-              nodur(ivx,ip) = nodur(ivx,ip+ioff)
-              nacc(ivx,ip) = nacc(ivx,ip+ioff)
-              irest(ivx,ip) = irest(ivx,ip+ioff)
-              islur(ivx,ip) = islur(ivx,ip+ioff)
-              ipl(ivx,ip) = ipl(ivx,ip+ioff)
-              iornq(ivx,ip) = iornq(ivx,ip+ioff)
-              mult(ivx,ip) = mult(ivx,ip+ioff)
-c              if (ivx.le.2 .and. figbass) 
-c     *                isfig(ivx,ip) = isfig(ivx,ip+ioff)
-              if (figbass .and. ivx.eq.1 .or. ivx.eq.ivxfig2) then
-                if (ivx.eq.1) then
-                  isfig(1,ip) = isfig(1,ip+ioff)
-                else
-                  isfig(2,ip) = isfig(2,ip+ioff)
-                end if
-              end if
-12          continue
-            if (ivx.le.nv .and. ncc(iv).gt.1) then
-              islide = 0
-              do 13 icc = 1 , ncc(iv)
-                if (tcc(iv,icc) .le. lenbar) then
-c
-c  This time will drop <=0 when slid.
-c
-                  islide = icc-1
-                  ncmidcc(iv,1) = ncmidcc(iv,icc)
-                else
-                  tcc(iv,icc-islide) = tcc(iv,icc)-lenbar
-                  ncmidcc(iv,icc-islide) = ncmidcc(iv,icc)
-                end if
-13            continue
-              ncc(iv) = ncc(iv)-islide
-              tcc(iv,1) = 0.
-            end if
-11        continue
-          do 15 ig = 1 , ngrace
-            ipg(ig) = ipg(ig)-nib(ivg(ig),ibar-1)
-            if (ibar .gt. 2) ipg(ig) = ipg(ig)+nib(ivg(ig),ibar-2)
-15        continue
-          do 21 il = 1 , nlit
-            iplit(il) = iplit(il)-nib(ivlit(il),ibar-1)
-            if (ibar .gt. 2) iplit(il) = iplit(il)+nib(ivlit(il),ibar-2)
-21        continue
-          do 22 it = 1 , ntrill
-            iptrill(it) = iptrill(it)-nib(ivtrill(it),ibar-1)
-            if (ibar .gt. 2) iptrill(it) =
-     *                    iptrill(it)+nib(ivtrill(it),ibar-2)
-22        continue
-          do 27 icrd = 1 , ncrd
-c            ivx = iand(15,ishft(icrdat(icrd),-8))
-            ivx = iand(15,ishft(icrdat(icrd),-8))
-     *               +16*igetbits(icrdat(icrd),1,28)
-            ipnew = iand(255,icrdat(icrd))-nib(ivx,ibar-1)
-            if (ibar .gt. 2) ipnew = ipnew+nib(ivx,ibar-2)
-            icrdat(icrd) = iand(not(255),icrdat(icrd))
-            icrdat(icrd) = ior(max(0,ipnew),icrdat(icrd))
-27        continue
-          do 29 iudorn = 1 , nudorn
-c            ivx = iand(15,ishft(kudorn(iudorn),-8))
-            ivx = ivxudorn(iudorn)
-            ipnew = iand(255,kudorn(iudorn))-nib(ivx,ibar-1)
-            if (ibar .gt. 2) ipnew = ipnew+nib(ivx,ibar-2)
-            kudorn(iudorn) = iand(not(255),kudorn(iudorn))
-            kudorn(iudorn) = ior(max(0,ipnew),kudorn(iudorn))
-29        continue
-          do 42 idyn = 1 , ndyn
-            idynd = idyndat(idyn)
-c            ivx = iand(15,idynd)
-            ivx = iand(15,idynd)+16*igetbits(idynda2(idyn),1,10)
-            ipnew = igetbits(idynd,8,4)-nib(ivx,ibar-1)
-c
-c The following construction avoids array bound errors in some compilers
-c
-            if (ibar .gt. 2) then
-              ipnew = ipnew+nib(ivx,ibar-2)
-            end if
-            ipnew = dim(ipnew,0)
-            call setbits(idynd,8,4,ipnew)
-            idyndat(idyn) = idynd
-42        continue
-          do 43 itxtdyn = 1 , ntxtdyn
-            idynd = ivxiptxt(itxtdyn)
-c            ivx = iand(15,idynd)
-            ivx = iand(31,idynd)
-c            ipnew = igetbits(idynd,8,4)-nib(ivx,ibar-1)
-            ipnew = igetbits(idynd,8,5)-nib(ivx,ibar-1)
-            if (ibar .gt. 2) then
-              ipnew = ipnew+nib(ivx,ibar-2)
-            end if
-            ipnew = dim(ipnew,0)
-c            call setbits(idynd,8,4,ipnew)
-            call setbits(idynd,8,5,ipnew)
-            ivxiptxt(itxtdyn) = idynd
-43        continue
-          do 41 isdat = 1 , nsdat
-            isdata = isdat1(isdat)
-            ivx = ivmx(igetbits(isdata,5,13),igetbits(isdata,1,12)+1)
-            ipnew = igetbits(isdata,8,3)-nib(ivx,ibar-1)
-            if (ibar .gt. 2) then
-              ipnew = ipnew+nib(ivx,ibar-2)
-            end if
-            ipnew = dim(ipnew,0)
-            call setbits(isdata,8,3,ipnew)
-            isdat1(isdat) = isdata
-41        continue
-          do 44 ibc = 1 , nbc
-c            ivx = iand(15,ibcdata(ibc))
-            ivx = iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28)
-            ipnew = igetbits(ibcdata(ibc),8,4)-nib(ivx,ibar-1)
-            if (ibar .gt. 2) then
-              ipnew = ipnew+nib(ivx,ibar-2)
-            end if
-            ipnew = dim(ipnew,0)
-            call setbits(ibcdata(ibc),8,4,ipnew)
-44        continue
-          do 45 iarps = 1 , NumArpShift
-            IpArpShift(iarps) = 
-     *           IpArpShift(iarps)-nib(IvArpShift(iarps),ibar-1)
-            if (ibar .gt. 2) then
-              IpArpShift(iarps) = 
-     *           IpArpShift(iarps)+nib(IvArpShift(iarps),ibar-2)
-            end if
-45        continue  
-c
-c  Bookkeeping for figures.  This will set nfigs = 0 if there are no figs left.
-c  If there are figs left, it will reset all times relative to start of
-c  current bar.
-c
-          do 46 ivx = 1 , 2
-            if (figbass) then
-              islide = 0
-              do 20 jfig = 1 , nfigs(ivx)
-                if (itfig(ivx,jfig) .lt. lenbar) then
-c
-c  This figure was already used
-c
-                  islide = jfig
-                else
-                  itfig(ivx,jfig-islide) = itfig(ivx,jfig)-lenbar
-                  figq(ivx,jfig-islide) = figq(ivx,jfig)
-                  itoff(ivx,jfig-islide) = itoff(ivx,jfig)
-                  ivupfig(ivx,jfig-islide) = ivupfig(ivx,jfig)
-                  ivvfig(ivx,jfig-islide) = ivvfig(ivx,jfig)
-                end if
-20            continue
-              nfigs(ivx) = nfigs(ivx)-islide
-            end if
-            if (nfigs(2) .eq. 0) go to 47
-46        continue
-47        continue
-        end if
-c
-c  End of sliding down for bars after first in gulp.
-c
-c  The following may not be needed by makeabar, but just in case...
-c
-        if (firstgulp .and. lenb0.ne.0) then
-          if (ibar .eq. 1) then
-            lenbar = lenb0
-          else
-            lenbar = lenb1
-          end if
-        end if
-c
-c  Equal line spacing stuff
-c
-        if (equalize .and. bar1syst) then
-          if (isystpg .eq. 1) then
-            write(11,'(a)')sq//'starteq%'
-          else if (isystpg .eq. nsystp(ipage)-1) then
-            write(11,'(a)')sq//'endeq%'
-          end if
-        end if
-        call make1bar(ibmrep,tglp1,tstart,cwrest,squez,
-     *      istop,numbms,istart)
-        call make2bar(ninow,tglp1,tstart,cwrest,squez,
-     *      istop,numbms,istart,clefq)
-c
-c  Hardspace before barline?
-c
-        hardb4 = 0.
-        do 35 iv = 1 , nv
-        do 35 kv = 1 , nvmx(iv)
-          ivx = ivmx(iv,kv)
-          if (btest(irest(ivx,nn(ivx)),18)) then
-            nudoff(ivx) = nudoff(ivx)+1
-            hardb4 = max(hardb4,udoff(ivx,nudoff(ivx)))
-          end if
-35      continue
-        if (hardb4 .gt. 0.) then
-          if (islast) write(11,'(a11,f5.1,a4)')sq
-     *        //'hardspace{',hardb4,'pt}%'
-c
-c This was causing an incorrect poe in an example, which did not affect main
-c   spacing, but did cause an extra accidental space to be too small
-c
-          fixednew = fixednew-hardb4
-        end if
-10    continue
-      firstgulp = .false.
-      lenb0 = 0
-      go to 30
-40    close(12)
-      close(13)
-      ilbuf = 1
-      ipbuf = 0
-      wdpt = widthpt
-      if (iline .eq. 1) wdpt = widthpt*(1-fracindent)
-      poe = (wdpt-fsyst*musicsize-0.4*nbarss-fixednew)/
-     *            (elsktot+fbar*nbarss-scaldold)
-      poevec(nsyst) = poe
-      if (.not.islast) then
-        close(11)
-        close(16)
-        if (figbass) close(14)
-        return
-      end if
-      do 19 ia = 1 , nasksys
-        iask = iask+1
-        ask(iask) = wasksys(ia)/poe-abs(elasksys(ia))
-        if (elasksys(ia).gt.0) ask(iask)=dim(ask(iask),0.)
-19    continue
-      do 26 ia = 1 , nhssys
-        nhstot = nhstot+1
-        hpttot(nhstot) = max(hpts(ia)-hesk(ia)*poe,0.)
-26    continue
-      if (islast .and.
-     *    onvolt) write(11,'(a)')sq//'endvoltabox'
-      if (rptfq2 .ne. 'E') then
-c
-c Terminal repeat.  Right or double?
-c
-        if (rptfq2 .eq. 'r') then
-          if (islast) write(11,'(a)')sq//'setrightrepeat'
-     *       //sq//'endpiece'
-        else if (rptfq2 .eq. 'd') then
-          if (islast) write(11,'(a)')sq//'setdoublebar'//sq//'endpiece'
-        else if (rptfq2 .eq. 'b') then
-          if (islast) write(11,'(a)')sq//'endpiece'
-        else if (rptfq2 .eq. 'z') then
-          if (islast) write(11,'(a)')sq//'setzalaligne'//sq//'Endpiece'
-        else
-c        else if (rptfq2 .ne. 'D') then
-          print*
-          print*,'R? , ? not "d","r",or"b","z"; rptfq2:',rptfq2
-          write(15,*)'R? , ? not "d","r",or"b","z"; rptfq2:',rptfq2
-          if (islast) write(11,'(a)')sq//'Endpiece'
-        end if
-      else
-        if (islast) write(11,'(a)')sq//'Endpiece'
-      end if
-      if (.not.vshrink) then
-        xnstbot = xnsttop(ipage)*etabot/etatop
-        if (xnstbot .lt. 9.95) then
-          fmtq = '(a,f3.1,a)'
-        else
-          fmtq = '(a,f4.1,a)'
-        end if
-        if (islast) write(11,fmtq)sq//'vskip',xnstbot,
-     *      sq//'Interligne'//sq//'eject'//sq//'endmuflex'
-        if (islast) write(11,'(a)')sq//'bye'
-      else
-        if (islast) write(11,'(a)')
-     *     sq//'vfill'//sq//'eject'//sq//'endmuflex'
-        if (islast) write(11,'(a)')sq//'bye'
-      end if
-      rewind(11)
-      if (figbass) then
-        write(14,'(a9,i2,a10,i2,1x,a5)')
-     *     sq//'figdrop=',ifigdr(1,iline),
-     *    ' '//sq//'figdtwo=',ifigdr(2,iline),sq//'fi}%'
-        rewind(14)
-      end if
-      call askfig(pathnameq,lpath,basenameq,lbase,figbass,istype0)
-      if (.not.optimize) then
-        print*
-        print*,'Writing '
-     *            //pathnameq(1:lpath)//basenameq(1:lbase)//'.tex'
-        print*,'Done with second PMX pass.'
-        write(15,'(/,a)')'Writing '
-     *            //pathnameq(1:lpath)//basenameq(1:lbase)//'.tex'
-        write(15,'(a)')' Done with second PMX pass.  Now run TeX'
-      end if
-      return
-      end
-      subroutine poestats(nsyst,poe,poebar,devnorm)
-      parameter (nks=125)
-c
-c  Compute avg. & norm. std. dev. of poe.
-c
-      real*4 poe(nks)
-      sumx = 0.
-      sumxx = 0.
-      do 1 isyst = 1 , nsyst
-        sumx = sumx+poe(isyst)
-        sumxx = sumxx+poe(isyst)**2
-1     continue
-      devnorm = sqrt(nsyst*sumxx/sumx**2-1)
-      poebar = sumx/nsyst
-      return
-      end
-      subroutine precrd(ivx,ip,nolevm,nacc,ipl,irest,udq,
-     *                  twooftwo,icashft)
-c
-c  Analyzes chords, data to be used with slurs on chords and plain chords.
-c  Check for 2nds, shift notes if neccesary.  
-c       ipl(10) chord present
-c       irest(20) set if any note is right shifted
-c       irest(27) set if any note is left shifted
-c       ipl(8|9) left|right shift main note
-c       icrdat(23|24)   ditto     chord note
-c       udq is updown-ness, needed to analyze 2nds.
-c       levtabl(i)=0 if no note at this level, -1 if main note, icrd if chord note.
-c       icrdot(icrd)(27-29) sequence order of chord note if accid, top down
-c
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      logical btest,is2nd,twooftwo
-      integer*4 kicrd(10),levtabl(88)
-      character*1 udq
-      do 11 i = 1 , 88
-        levtabl(i) = 0
-11    continue
-      do 1 icrd1 = 1 , ncrd
-        ivx1 = iand(15,ishft(icrdat(icrd1),-8))
-     *       +16*igetbits(icrdat(icrd1),1,28)
-        ip1 = iand(255,icrdat(icrd1))
-        if (ip1.eq.ip .and. ivx1.eq.ivx) go to 2
-1     continue
-      print*
-      print*,
-     * 'Cannot find first chord note in precrd. Send source to Dr. Don!'
-      call stop1()
-2     continue
-      maxlev = nolevm
-      minlev = nolevm
-      levtabl(nolevm) =  -1
-      is2nd = .false.
-	naccid = 0
-      levmaxacc = -100
-      levminacc = 1000
-c
-c  Check 1st 3 bits of nacc for accid on main note of chord. 
-c
-      if (iand(7,nacc) .gt. 0) then
-        naccid = 1
-c
-c  Start list of notes with accid's.  There will be naccid of them. kicrd=0 if main,
-c    otherwise icrd value for note with accidental.
-c
-        kicrd(1) = 0
-        levmaxacc = nolevm
-        levminacc = nolevm
-c
-c  Start the level-ranking
-c
-        icrdot0 = 1
-      end if
-      do 3 icrd2 = icrd1 , ncrd
-        nolev = igetbits(icrdat(icrd2),7,12)
-        levtabl(nolev) = icrd2
-        maxlev = max(maxlev,nolev)
-        minlev = min(minlev,nolev)
-c
-c  Check for accidental
-c
-        if (btest(icrdat(icrd2),19)) then
-          naccid = naccid+1
-          levmaxacc = max(levmaxacc,nolev)
-          levminacc = min(levminacc,nolev)
-c
-c  Add this icrd to list of values for notes with accid's.
-c
-          kicrd(naccid) = icrd2
-          if (.not.btest(nacc,28)) then
-c
-c  Order not forced, so get the level-ranking, top down
-c
-            iorder = 1
-            do 12 iaccid = 1 , naccid-1
-              if (kicrd(iaccid) .eq. 0) then
-                if (nolevm .gt. nolev) then
-                  iorder = iorder+1
-                else
-                  icrdot0 = icrdot0+1
-                end if
-              else
-                if (igetbits(icrdat(kicrd(iaccid)),7,12) 
-     *                                          .gt. nolev) then
-                  iorder = iorder+1
-                else
-                  iold = igetbits(icrdot(kicrd(iaccid)),3,27)
-                  call setbits(icrdot(kicrd(iaccid)),3,27,iold+1)
-                end if
-              end if
-12          continue
-            call setbits(icrdot(icrd2),3,27,iorder)
-          end if
-        end if
-c
-c  Exit loop if last note in this chord
-c
-        if (icrd2 .eq. ncrd) go to 4
-        if (igetbits(icrdat(icrd2+1),8,0) .ne. ip  .or.
-c     *      igetbits(icrdat(icrd2+1),4,8) .ne. ivx) go to 4
-     *      igetbits(icrdat(icrd2+1),4,8)
-     *        +16*igetbits(icrdat(icrd2+1),1,28) .ne. ivx) go to 4
-3     continue
-      print*
-      print*,'Failed to find last chord note. Send source to Dr. Don!'
-      call stop1()
-4     continue
-c
-c  Now icrd1, icrd2 define range of icrd for this chord.
-c
-c  Bypass autos-shifting if any manual shifts are present
-c
-      if (btest(irest,20) .or. btest(irest,27)) go to 10
-c
-c  Check for 2nds
-c
-      do 5 ilev = 1 , 87
-        if (levtabl(ilev).ne.0 .and. levtabl(ilev+1).ne.0) then
-c
-c  There is at least one 2nd..
-c
-          if (udq .eq. 'u') then
-c
-c  Upstem. Start with 2nd just found and go up, rt-shifting upper 
-c     member of each pair  
-c
-            ile = ilev
-c
-c  Set main-note flag for ANY right-shift
-c
-            irest = ibset(irest,20)
-7           continue
-            if (levtabl(ile+1) .lt. 0) then
-c
-c  Upstem, & upper member is main so must be rt-shifted. This would move
-c    stem too, so we rt-shift the OTHER note, and set flag that signals
-c    to interchange pitches just when these two notes are placed.
-c
-              nacc = ibset(nacc,30)
-              icrdat(levtabl(ile)) = ibset(icrdat(levtabl(ile)),24)
-            else
-c
-c  Upper member is chord note, must be rt-shifted
-c
-              icrdat(levtabl(ile+1)) = ibset(icrdat(levtabl(ile+1)),24)
-            end if
-            ile = ile+1
-8           continue
-            ile = ile+1
-            if (ile .lt. 87) then
-              if (levtabl(ile).ne.0 .and. levtabl(ile+1).ne.0) then
-                go to 7                
-              else
-                go to 8  
-              end if
-            end if
-            go to 10
-          else
-c
-c  Downstem. Start at top and work down, left-shifting lower member of each pair.
-c     We know that lowest pair is at (ilev,ilev+1).
-c
-            ile = 88
-c
-c  Set main-note flag for ANY right-shift
-c
-            irest = ibset(irest,27)
-9           continue
-            if (levtabl(ile).ne.0 .and. levtabl(ile-1).ne.0) then
-              if (levtabl(ile-1) .lt. 0) then      
-c                ipl = ibset(ipl,8)
-c
-c  Dnstem, & lower member is main so must be left-shifted. This would move
-c    stem too, so we left-shift the OTHER note, and set flag that signals
-c    to interchange pitches just when these two notes are placed.
-c
-                nacc = ibset(nacc,31)
-                icrdat(levtabl(ile)) = ibset(icrdat(levtabl(ile)),23)
-              else
-c
-c  Lower member is chord note, must be shifted
-c
-                icrdat(levtabl(ile-1)) = 
-     *                               ibset(icrdat(levtabl(ile-1)),23)
-              end if
-              ile = ile-1
-            end if
-            ile = ile-1
-            if (ile .ge. ilev+1) go to 9
-            go to 10
-          end if
-        end if
-5     continue
-10    continue
-c
-c  Done with 2nds, now do accid's.  Call even if just one, in case left shifts.
-c
-c      if (naccid .gt. 1) call crdaccs(nacc,ipl,irest,naccid,
-      if (naccid .ge. 1) call crdaccs(nacc,ipl,irest,naccid,
-     *        kicrd,nolevm,levmaxacc,levminacc,icrdot0,twooftwo,icashft)
-      return
-      end
-      subroutine printl(string)
-      character*(*) string
-c
-c  Send string to console and to log file
-c
-      print*,string
-      write(15,'(a)')string
-      return
-      end
-      subroutine putarp(tnow,iv,ip,nolev,ncm,soutq,lsout)
-      parameter (nm=24)
-      common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
-     *                xinsnow,lowdot
-      common /comtol/ tol
-      common /comArpShift/NumArpShift,IvArpShift(20),IpArpShift(20),
-     *                    ArpShift(20)
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      logical lowdot,IsArpShift
-      character*80 soutq
-      character*79 notexq
-      character*8 symq(2)
-      character*1 chax
-      data symq /'raisearp','arpeggio'/
-c
-c  NOTE iv in arg list is really ivx, referring to voice rather than staff.
-c
-c  Find which iarp, if any
-c
-      do 1 iarp = 1 , narp
-        if (abs(tnow-tar(iarp)).lt.tol) go to 2
-1     continue
-c
-c  If here, this is the *first* call for this arp.
-c
-      narp = narp+1
-      tar(narp) = tnow+tol*.5
-      ivar1(narp) = iv
-      ipar1(narp) = ip
-      levar1(narp) = nolev
-      ncmar1(narp) = ncm
-      return
-2     continue
-c
-c  If here, this is *second* call at this time, narp points to values from 1st.
-c
-c  Check for shift. Set IsArpShift and iarps
-c
-      do 3 iarps = 1 , NumArpShift
-        if (IvArpShift(iarps) .eq. ivar1(iarp) .and.  
-     *      IpArpShift(iarps) .eq. ipar1(iarp)) then
-          IsArpShift = .true.
-          notexq = chax(92)//'loffset{'
-          write(notexq(10:14),'(f3.1,a2)') Arpshift(iarps),'}{'
-          lnote = 14
-          go to 4
-        end if
-3     continue
-      IsArpShift = .false.
-      lnote = 0
-4     continue
-      if (iv .eq. ivar1(iarp)) then
-c
-c  Arp is in a single voice.
-c
-        levbot = min(levar1(iarp),nolev)-ncm+3
-        invert = abs(levar1(iarp)-nolev)+1
-      else
-c
-c  Arp covers >1 voice.  Lower voice has to be the first, upper is current and
-c    is where the symbol will be written.
-c  Check whether ivx's ivar1(iarp) & iv are in same staff
-c
-        do 5 iiv = 1 , nm
-          if (ivmx(iiv,1).eq.ivar1(iarp) .or. (nvmx(iiv).eq.2.and.
-     *         ivmx(iiv,2).eq.ivar1(iarp))) then
-            iivivx1 = iiv
-            go to 6
-          end if
-5       continue
-        print*,'Screwup#1 in putarp'
-        stop
-6       continue
-        do 7 iiv = 1 , nm
-          if (ivmx(iiv,1).eq.iv .or. (nvmx(iiv).eq.2.and.
-     *         ivmx(iiv,2).eq.iv)) go to 8
-c
-c  Found iv for both voices (iivivx1, iiv), done looking
-c
-7       continue
-        print*,'Screwup#2 in putarp'
-        stop
-8       continue
-        if (iivivx1 .eq. iiv) then
-          nstaffshift = 0
-        else
-          nstaffshift = -nint(2*xinsnow)
-        end if
-c        levbot = -nint(2*xinsnow)+3+levar1(iarp)-ncmar1(iarp)
-        levbot = nstaffshift+3+levar1(iarp)-ncmar1(iarp)
-        invert = -levbot+4+nolev-ncm
-c      print*,'xinsnow,levar1,ncmar1,levbot,nolev,ncm:'
-c      write(*,'(f5.1,5i5)')xinsnow,levar1(iarp),ncmar1(iarp),
-c     *levbot,nolev,ncm
-      end if
-c
-c  isym will be (1,2) if invert is (even,odd).  If even, raise .5\internote
-c
-      isym = mod(invert,2)+1
-      ilvert = (invert+1)/2
-      if (levbot .ge. 0 .and. levbot .le. 9) then
-c
-c  Single digit
-c
-        if (.not.IsArpShift) then
-          notexq = chax(92)//symq(isym)//chax(48+levbot)
-        else
-          notexq = notexq(1:lnote)//
-     *                chax(92)//symq(isym)//chax(48+levbot)
-        end if
-        lnote = lnote+10
-      else
-        if (.not.IsArpShift) then
-          notexq = chax(92)//symq(isym)//'{'
-        else
-          notexq = notexq(1:lnote)//chax(92)//symq(isym)//'{'
-        end if
-        lnote = lnote+10
-        if (levbot .ge. -9) then
-c
-c  Need two spaces for number
-c
-          write(notexq(lnote+1:lnote+3),'(i2,a1)')levbot,'}'
-          lnote = lnote+3
-        else
-          write(notexq(lnote+1:lnote+4),'(i3,a1)')levbot,'}'
-          lnote = lnote+4
-        end if
-      end if
-c      if (ilvert .le. 9) then
-c        call addstr(notexq(1:lnote)//chax(48+ilvert),lnote+1,
-c     *              soutq,lsout)
-c      else
-c        write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')'{',ilvert,'}'
-c        call addstr(notexq(1:lnote+4),lnote+4,soutq,lsout)
-c      end if
-
-      if (ilvert .gt. 9) then
-        write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')'{',ilvert,'}'
-        lnote = lnote+4
-	else
-        notexq = notexq(1:lnote)//chax(48+ilvert)
-        lnote = lnote+1
-      end if
-      if (IsArpShift) then
-        notexq = notexq(1:lnote)//'}'
-        lnote = lnote+1
-      end if
-      call addstr(notexq(1:lnote),lnote,soutq,lsout)
-c
-c  cancel out the stored time, to permit two arps at same time!
-c
-      tar(iarp) = -1.
-      return
-      end
-      subroutine putast(elask,indxask,outq)
-      character*129 outq,tag
-      character*9 fmtq
-      if (elask .ge. 0.) then
-        if (elask.lt.0.995) then
-          lp = 3
-        else if (elask .lt. 9.995) then
-          lp = 4
-        else
-          lp = 5
-        end if
-        write(fmtq,'(a5,i1,a3)')'(a2,f',lp,'.2)'
-      else
-        lp = 5
-        fmtq = '(a2,f5.1)'
-      end if
-c
-c  Overwrite as follows:  ...xyz*ask     *lmnop... ->
-c                         ...xyz*ast{.nn}*lmnop...
-c                         ...xyz*ast{n.nn}*lmnop...
-c                         ...xyz*ast{nn.nn}*lmnop...
-c  or for negative,       ...xyz*ast{-nn.n}*lmnop...
-        tag = outq(indxask+9:)
-        write(outq(indxask+3:),fmtq)'t{',elask
-        outq = outq(1:indxask+4+lp)//'}'//tag
-      return
-      end
-      subroutine putcb(ivx,ip,notexq,lnote)
-      common /comcb/ nbc,ibcdata(36)
-      character*79 notexq
-      logical btest
-c      ivxip = ivx+16*ip
-	do 1 ibc = 1 , nbc
-c        if (ivxip .eq. iand(1023,ibcdata(ibc))) go to 2
-c        if (ivx.eq.iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28)
-c     *    .and. ip.eq.iand(1008,ibcdata(ibc))) go to 2
-         ivxbc = iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28)
-         ipbc = igetbits(ibcdata(ibc),8,4)
-         if (ivx .eq. ivxbc .and. ip .eq.ipbc) go to 2
-1     continue
-      call printl('Error in putbc, Call Dr. Don')
-      stop
-2     continue
-      if (btest(ibcdata(ibc),27)) then
-        lnote = 8
-        notexq = char(92)//'pbreath'
-      else
-        lnote = 9
-        notexq = char(92)//'pcaesura'
-      end if
-      ivshft = igetbits(ibcdata(ibc),6,13)
-c??      ivshft = igetbits(ibcdata(ibc),6,13)-32
-      if (ivshft .gt. 0) ivshft = ivshft-32
-      if (ivshft.lt.0 .or. ivshft.gt.9) then
-        notexq = notexq(1:lnote)//'{'
-        lnote = lnote+1
-        if (ivshft .lt. -9) then
-          write(notexq(lnote+1:lnote+3),'(i3)')ivshft
-          lnote = lnote+3
-        else
-          write(notexq(lnote+1:lnote+2),'(i2)')ivshft
-          lnote = lnote+2
-        end if        
-        notexq = notexq(1:lnote)//'}'
-        lnote = lnote+1
-      else
-        notexq = notexq(1:lnote)//char(48+ivshft)
-        lnote = lnote+1
-      end if
-      ihshft = igetbits(ibcdata(ibc),8,19)
-      if (ihshft .eq. 0) then
-        notexq = notexq(1:lnote)//'0'
-        lnote = lnote+1
-      else
-        hshft = .1*(ihshft-128)
-c
-c  -12.8<hshft<12.8
-c
-        notexq = notexq(1:lnote)//'{'
-        lnote = lnote+1
-        if (hshft .lt. -9.95) then
-          write(notexq(lnote+1:lnote+5),'(f5.1)')hshft
-          lnote = lnote+5
-        else if (hshft.lt.-0.05 .or. hshft.gt.9.95) then
-          write(notexq(lnote+1:lnote+4),'(f4.1)')hshft
-          lnote = lnote+4
-        else
-          write(notexq(lnote+1:lnote+3),'(f3.1)')hshft
-          lnote = lnote+3
-        end if
-        notexq = notexq(1:lnote)//'}'
-        lnote = lnote+1
-      end if
-      return
-	end
-      subroutine putfig(ivx,ifig,offnsk,figcheck,soutq,lsout)
-      parameter (nm=24)
-      common /comfig/ itfig(2,74),figqq(2,74),ivupfig(2,74),nfigs(2),
-     *                fullsize(nm),ivxfig2,ivvfig(2,74)
-      character*10 figqq,figq
-      character*80 soutq,notexq
-      character*1 ch1q,ch2q,sq,chax
-      character*5 nofq,nofaq
-      character*4 Figutq,Conttq
-      logical figcheck
-      if (ivx .eq. 1) then
-        Figutq = 'Figu'
-        Conttq = 'Cont'
-      else
-        Figutq = 'Figt'
-        Conttq = 'Cott'
-      end if
-      sq = chax(92)
-      if (ivvfig(ivx,ifig) .ne. 0) then
-c
-c  Alter figdrop
-c
-        notexq = sq//'global'//sq//'advance'//sq//'figdrop'
-        lnote = 23
-        if (ivvfig(ivx,ifig) .lt. 0) then
-          notexq = notexq(1:lnote)//'-' 
-          lnote = lnote+1
-        endif
-        notexq = notexq(1:lnote)//char(48+abs(ivvfig(ivx,ifig))) 
-        lnote = lnote+1
-        call addstr(notexq,lnote,soutq,lsout)
-      end if
-      if (abs(offnsk) .gt. .0001) then
-c
-c  Write offset for floating figure, to two decimal places
-c
-        notexq = sq//'off{'
-        if (-offnsk .lt. -9.995) then
-          write(notexq(6:11),'(f6.2)')-offnsk
-          lnote = 11
-        else if (-offnsk.lt.-.995 .or. -offnsk.gt.9.995) then
-          write(notexq(6:10),'(f5.2)')-offnsk
-          lnote = 10
-        else if (-offnsk.lt.-.0001 .or. -offnsk.gt..995) then
-          write(notexq(6:9),'(f4.2)')-offnsk
-          lnote = 9
-        else
-          write(notexq(6:8),'(f3.2)')-offnsk
-          lnote = 8
-        end if
-        notexq = notexq(1:lnote)//sq//'noteskip}'
-        call addstr(notexq,lnote+10,soutq,lsout)
-      end if
-      figq = figqq(ivx,ifig)
-      ic = 1
-c      nof = 0
-c      nofa = -1
-      nof = -ivupfig(ivx,ifig)
-      nofa = -ivupfig(ivx,ifig)-1
-c
-c  Beginning of manual loop
-c
-1     ch1q = figq(ic:ic)
-c
-c  Exit when first blank is encountered
-c
-        if (ch1q .eq. ' ') go to 2
-c
-c  Starting a level.  Set up vertical offset.
-c
-c        lnof = 1
-c        nofq = chax(nof+48)
-c        if (nof .gt. 9) then
-c          lnof = 2
-c          nofq = '1'//chax(nof-10+48)
-c        end if
-c        if (nofa .eq.-1) then
-c          lnofa = 2
-c          nofaq = '-1'
-c        else if (nofa .lt. 10) then
-c          lnofa = 1
-c          nofaq = chax(nofa+48)
-c        else
-c          lnofa = 2
-c          nofaq = '1'//chax(nofa+38)
-c        end if
-        call istring(nof,nofq,lnof)
-        call istring(nofa,nofaq,lnofa)
-        if (ch1q .eq. '0') then
-c
-c  Continuation figure.  Next number is length (in noteskips). The number will 
-c    end at the first blank or char that is not digit or decimal point. If 
-c    colon, it is a separator and must be skipped
-c
-          icnum = ic+1
-3         continue
-          ic = ic+1
-          if (index('0123456789.',figq(ic:ic)) .gt. 0) go to 3
-          lnum = ic-icnum
-          call addstr(sq//Conttq//nofq(1:lnof)//'{'
-     *             //figq(icnum:ic-1)//'}',7+ic-icnum+lnof,soutq,lsout)
-          if (figq(ic:ic) .ne. ':') ic=ic-1
-        else if (ch1q.eq.'#'.or.ch1q.eq.'-'.or.ch1q.eq.'n') then
-          ic = ic+1
-          ch2q = figq(ic:ic)
-          if (ch2q .eq. ' ') then
-c
-c  Figure is a stand-alone accidental, so must be centered
-c
-            if (ch1q .eq. '#') then
-              call addstr(sq//Figutq//nofaq(1:lnofa)//
-     *          '{'//sq//'sharpfig}',16+lnofa,soutq,lsout)
-            else if (ch1q .eq. '-') then
-              call addstr(sq//Figutq//nofaq(1:lnofa)//
-     *          '{'//sq//'flatfig}',15+lnofa,soutq,lsout)
-            else if (ch1q .eq. 'n') then
-              call addstr(sq//Figutq//nofaq(1:lnofa)//
-     *                '{'//sq//'natfig}',14+lnofa,soutq,lsout)
-            end if
-            go to 2
-          else
-c
-c  Figure is an accidental followed by a number
-c  First put the accidental (offset to the left)
-c
-            if (ch1q .eq. '#') then
-              call addstr(sq//Figutq//
-     *               nofaq(1:lnofa)//'{'//sq//'fsmsh}',
-     *               13+lnofa,soutq,lsout)
-            else if (ch1q .eq. '-') then
-              call addstr(sq//Figutq//
-     *               nofaq(1:lnofa)//'{'//sq//'fsmfl}',
-     *               13+lnofa,soutq,lsout)
-            else if (ch1q .eq. 'n') then
-              call addstr(sq//Figutq//
-     *               nofaq(1:lnofa)//'{'//sq//'fsmna}',
-     *               13+lnofa,soutq,lsout)
-            end if
-c
-c  Now put the number
-c
-            call addstr(sq//Figutq//nofq(1:lnof)//'{'//ch2q//'}',
-     *           8+lnof,soutq,lsout)
-          endif
-        else if (ch1q .eq. '_') then
-c
-c  Placeholder only (for lowering a figure).  Don't do anything!
-c
-          continue
-        else
-c
-c  Figure is a single number, maybe with s after
-c
-          call addstr(sq//Figutq//nofq(1:lnof)//'{',
-     *           6+lnof,soutq,lsout)
-          ch2q = figq(ic+1:ic+1)
-          if (ch2q .eq. 's') then
-c
-c  Use a special character. Insert font call
-c
-            ic = ic+1
-            call addstr(sq//'ligfont',8,soutq,lsout)
-          end if             
-          call addstr(ch1q//'}',2,soutq,lsout)
-c          call addstr(sq//Figutq//nofq(1:lnof)//'{'//ch1q//'}',
-c     *           8+lnof,soutq,lsout)
-        end if
-        if (ic .ge. 10) go to 2
-        ic = ic+1
-        nof = nof+4
-        nofa = nofa+4
-        go to 1
-2     continue
-      if (abs(offnsk) .gt. .0001) then
-        notexq = sq//'off{'
-        if (offnsk .lt. -9.995) then
-          write(notexq(6:11),'(f6.2)')offnsk
-          lnote = 11
-        else if (offnsk.lt.-.995 .or. offnsk.gt.9.995) then
-          write(notexq(6:10),'(f5.2)')offnsk
-          lnote = 10
-        else if (offnsk.lt.-.0001 .or. offnsk.gt..995) then
-          write(notexq(6:9),'(f4.2)')offnsk
-          lnote = 9
-        else
-          write(notexq(6:8),'(f3.2)')offnsk
-          lnote = 8
-        end if
-        notexq = notexq(1:lnote)//sq//'noteskip}'
-        call addstr(notexq,lnote+10,soutq,lsout)
-      end if
-      if (ifig .lt. nfigs(ivx)) then
-        ifig = ifig+1
-      else 
-        nfigs(ivx) = 0
-        figcheck = .false.
-      end if
-      return
-      end
-      subroutine putorn(iornq,nolev,nolevm,nodur,nornb,ulq,ibmcnt,ivx,
-     *     ncm,islur,nvmx,nv,ihornb,stemlin,outq,lout,ip,islhgt,
-     *     beamon,iscrd)
-c
-c  All args are individual array element *values* except nornb,ihornb,ulq.
-c  notcrd = .true. if ornament is on main note.
-c    nolevm is level of main note (for chords)
-c
-      parameter (nm=24)
-      character*1 ulpzq,ulq(nm,9),udqq,sq,chax
-      character*8 noteq
-      character*79 notexq,outq
-      integer*4 ihornb(nm,24),nornb(nm)
-      logical btest,iscrd,usehornb,beamon
-      common /comivxudorn/ivxudorn(63)
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      sq = chax(92)
-      lout = 0
-      usehornb = .false.
-      if (nodur .lt. 64) then
-        stemlen = stemlin
-      else
-        stemlen = 0.
-      end if
-c
-c  Get up-downness. ulpzq is opposite from stem direction for both beams and
-c    non beams.  Can use in name of ornament [ . or _ ]
-c
-      if (beamon) then
-        if (ulq(ivx,ibmcnt) .eq. 'u') then
-          ulpzq = 'l'
-        else
-          ulpzq = 'u'
-        end if
-      else
-        if (udqq(nolevm,ncm,islur,nvmx,ivx,nv).eq.'l' ) then
-          ulpzq = 'u'
-        else
-          ulpzq = 'l'
-        end if
-      end if
-c
-c  To enable >1 ornament on a note, next line is top of manual loop.
-c
-2     continue
-c
-cc  Bit # of last ornament (last of bits 0-21)
-cc  Bit # of last ornament (last of bits 0-24)
-c  Bit # of last ornament (last of bits 0-24,29-30)
-      if (btest(iornq,29)) then
-        ibit = 29
-      else if (btest(iornq,30)) then
-        ibit = 30
-      else
-        ibit = log2(iand(iornq,4194303))
-c      ibit = log2(iand(iornq,33554431))
-      end if
-      iornt = 2**ibit
-c
-c  Begin routine to set height.  Bits 0-13: (stmgx+Tupf._)
-c  14: Down fermata, was F  15: Trill w/o "tr", was U, 16-18: edit. s,f,n
-c  19-20: >^, 21: ? (with or w/o 16-18)
-c  and 29-30: C (coda), G (new segno)
-c
-c  Do not use beam height for . or _
-c
-      if (btest(iornq,22) .and. iand(iornt,6144).eq.0) then
-c
-c  Height is set by special beam stuff.  
-c  Do not leave ihorn set, do separately for every ornament
-c
-        ihorn = ihornb(ivx,nornb(ivx))
-        if (ulpzq .eq. 'u') ihorn = ihorn-2
-c
-c  Following flag tells whether to increment nornb when exiting the subroutine.
-c
-        usehornb = .true.
-      else if (ibit .eq. 14) then
-c
-c  Down fermata.  Don't worry about upper chord notes.
-c
-        if (ulpzq .eq. 'l') then
-          ihorn = min(nolev,ncm-3)
-        else
-          ihorn = min(nolev-stemlen,ncm-3.)
-        end if
-      else if (btest(iornt,13) .or. btest(iornt,0)) then
-c
-c  ( or )
-c
-        ihorn = nolev
-      else if (iand(iornt,6144) .gt. 0) then
-c
-cc  Staccato . or tenuto _ , but not special beam stuff.  Need up-down info
-c  NOTE: removed .&_ from special beam treatment.
-c  Staccato . or tenuto _  Need up-down info
-c
-        if (.not.iscrd .or. (maxlev.ne.nolev.and.ulpzq.eq.'l') .or.
-     *                      (minlev.ne.nolev.and.ulpzq.eq.'u')) then
-          ihorn = nolev
-        else if (maxlev .eq. nolev) then
-          ulpzq = 'u'
-          ihorn = max(nolev+stemlen,ncm+3.)
-        else
-          ulpzq = 'l'
-          ihorn = min(nolev-stemlen,ncm-3.)
-        end if
-      else if (iscrd .and. nolev .eq. minlev) then
-        if (ulpzq .eq. 'l') then
-          ihorn = min(nolev-3,ncm-6)
-        else
-          ihorn = min(nolev-nint(stemlen)-3,ncm-6)
-        end if
-      else if (ibit.eq.10 .and. nolev.gt.90) then
-c
-c  Special treatment for fermata on a shifted rest
-c
-        ihorn = ncm+5
-      else if (ulpzq.eq.'l') then
-c
-c  (iscrd and nolev=maxlev) or (.not.iscrd)
-c
-        ihorn = max(nolev+stemlen+2,ncm+5.)
-      else if (ibit.eq.29 .or. ibit.eq.30) then
-c
-c  coda or new segno, no height tweak
-c
-        ihorn = ncm+5
-      else
-        ihorn = max(nolev+2,ncm+5)
-      end if
-      ioff = 0
-      iclracc = 0
-c
-c  Begin routine to set name.  Bits 0-13: (stmgx+Tupf._)
-c  14: Down fermata, was F  15: Trill w/o "tr", was U, 16-18: edit. s,f,n
-c
-      if (btest(iornt,2)) then
-        notexq = sq//'shake'
-        lnote = 6
-      else if (btest(iornt,3)) then
-        notexq = sq//'mordent'
-        lnote = 8
-      else if (btest(iornt,1)) then
-        notexq = sq//'mtr'
-        lnote = 4
-      else if (btest(iornt,5)) then
-        notexq = sq//'xtr'
-        lnote = 4
-      else if (btest(iornt,6)) then
-        notexq = sq//'ptr'
-        lnote = 4
-      else if (btest(iornt,13)) then
-        notexq = sq//'rpn'
-        lnote = 4
-      else if (btest(iornt,0)) then
-        notexq = sq//'lpn'
-        lnote = 4
-      else if (btest(iornt,12)) then
-        notexq = sq//ulpzq//'st'
-        lnote = 4
-      else if (btest(iornt,11)) then
-        notexq = sq//ulpzq//'pz'
-        lnote = 4
-      else if (btest(iornt,8)) then
-        notexq = sq//'upz'
-        lnote = 4
-        ioff = -2
-      else if (btest(iornt,9)) then
-        notexq = sq//'uppz'
-        lnote = 5
-        ioff = -2
-      else if (btest(iornt,10)) then
-        if (nodur .lt. 48) then
-          notexq = sq//'fermataup'
-        else
-          notexq = sq//'Fermataup'
-        end if
-        lnote = 10
-        ioff = -2
-      else if (btest(iornt,14)) then
-        if (nodur .lt. 48) then
-          notexq = sq//'fermatadown'
-        else
-          notexq = sq//'Fermatadown'
-        end if
-        lnote = 12
-      else if (btest(iornt,21)) then
-c
-c  "?" in editorial ornament.  Clear bit 16-18 after use, since ibit=21
-c
-        if (btest(iornq,16)) then
-          notexq = sq//'qsharp'
-          lnote = 7
-          ioff = 2
-          iornq = ibclr(iornq,16)
-          iclracc = 16 
-        else if (btest(iornq,17)) then
-          notexq = sq//'qflat'
-          lnote = 6
-          ioff = 1
-          iornq = ibclr(iornq,17)
-          iclracc = 17
-        else if (btest(iornq,18)) then
-          notexq = sq//'qnat'
-          lnote = 5
-          ioff = 2
-          iornq = ibclr(iornq,18)
-          iclracc = 18
-        else
-          notexq = sq//'qedit'
-          lnote = 6
-          ioff = 0
-        end if
-      else if (btest(iornt,16)) then
-        notexq = sq//'esharp'
-        lnote = 7
-        ioff = 2
-      else if (btest(iornt,17)) then
-        notexq = sq//'eflat'
-        lnote = 6
-        ioff = 1
-      else if (btest(iornt,18)) then
-        notexq = sq//'enat'
-        lnote = 5
-        ioff = 2
-      else if (btest(iornt,19)) then
-        notexq = sq//'usf'
-        lnote = 4
-        ioff = -2
-      else if (btest(iornt,20)) then
-        notexq = sq//'usfz'
-        lnote = 5
-        ioff = -2
-      else if (btest(iornt,29)) then
-        notexq = sq//'ccoda'
-        lnote = 6
-      else if (btest(iornt,30)) then
-        notexq = sq//'ssegno'
-        lnote = 7
-      end if
-      iudorn = 0
-c
-c  User-defined level shift of ornament from default?
-c
-      if (btest(iornq,25)) then
-c
-c  Find which (if any) element of kudorn has the shift.
-c
-        do 3 iudorn = 1 , nudorn
-c          if (ibit .lt. 21) then
-c          if (ibit.lt.21 .or. ibit.eq.29) then
-          if (ibit.lt.21 .or. ibit.eq.29 .or. ibit.eq.30) then
-            ibitt = ibit
-c
-c  Could have oes, but not oe? or oes?
-c
-          else if (iclracc .gt. 0) then
-c
-c  Earlier cleared edit. accid, meaning it was oes?
-c
-            ibitt = iclracc+6
-          else
-            ibitt = 21
-          end if
-          ibitt=ip+ishft(mod(ivx,16),8)+ishft(nolev,12)+ishft(ibitt,19)
-c          if (ibitt .eq. iand(33554431,kudorn(iudorn))) go to 4
-          if (ibitt .eq. iand(33554431,kudorn(iudorn)) 
-     *      .and. ivx.eq.ivxudorn(iudorn)) go to 4
-3       continue
-c
-c  Nothing shifted on this note; exit this if block
-c
-        iudorn = 0
-        go to 5
-4       continue
-        ioffinc = iand(63,ishft(kudorn(iudorn),-25))-32
-        if (ibit.eq.19 .and. ioffinc .lt. -7) then
-c
-c  Convert usf to lsf.  The reason has to do with positioning being impossile
-c  for some mysterious reason when you drop \usf below the staff
-c
-          notexq = sq//'lsf'
-          ioffinc = ioffinc+6
-        end if
-        ioff = ioff+ioffinc
-      end if
-5     continue
-c
-c  Shift level to avoid slur.  Conditions are
-c   1.  There is a slur
-c   2.  No user-defined orn height shift (btest(iornq,25))
-c   3.  upslur (islhgt>0)
-c   4.  ornament is not segno(4), ._)(11-13), down ferm(14) or "(" (0) Bin=30737
-c   5.  islhgt+3 >=  height already computed.
-c
-      if (.not.btest(iornq,25) .and.
-     *                islhgt.gt.0 .and. iand(iornt,30737).eq.0)
-     *  ioff = ioff+dim(islhgt+3,ihorn     )
-      call notefq(noteq,lnoten,ihorn+ioff,ncm)
-      if (lnoten.eq.1) call addblank(noteq,lnoten)
-      if (iand(iornt,32896) .gt. 0) then
-c
-c  T-trill or trill w/o "tr"
-c
-        call dotrill(ivx,ip,iornt,noteq,lnoten,notexq,lnote)
-      else
-        notexq = notexq(1:lnote)//noteq(1:lnoten)
-        lnote = lnote+lnoten
-      end if
-      if (iudorn .gt. 0) then
-        if (btest(kudorn(iudorn),31)) then
-c
-c  Horizontal shift
-c
-          lform = lfmt1(ornhshft(iudorn))
-          write(noteq(1:lform),'(f'//chax(48+lform)//'.1)')
-     *        ornhshft(iudorn)
-          notexq = sq//'roffset{'//noteq(1:lform)//'}{'
-     *           //notexq(1:lnote)//'}'
-          lnote = lnote+lform+12
-          ornhshft(iudorn) = 0.
-          kudorn(iudorn) = ibclr(kudorn(iudorn),31)
-        end if
-      end if
-c
-c  Zero out the bit for ornament just dealt with.
-c
-      iornq = ibclr(iornq,ibit)
-      if (lout .eq. 0) then
-        outq = notexq(1:lnote)
-      else
-        outq = outq(1:lout)//notexq(1:lnote)
-      end if
-      lout = lout+lnote
-c
-c  Check bits 0-21, go back if any are still set
-c  If bit 29 or 30 had been set, would have been used first time thru,
-c    and you wouldn't use both coda and segno on same note
-c
-      if (iand(iornq,4194303) .gt. 0) go to 2
-      if (usehornb) nornb(ivx) = nornb(ivx)+1
-      return
-      end
-      subroutine putshft(ivx,onoff,soutq,lsout)
-      parameter (nm=24)
-      common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
-      character*80 soutq,notexq
-      character*1 sq,chax
-      logical onoff
-      sq = chax(92)
-c
-c  Start user-defined offsets X(...): or X(...)S
-c
-      if (onoff) nudoff(ivx) = nudoff(ivx)+1
-c
-c  Xoff is in pts.  Round off to nearest .1.  Will use at end of shift.
-c
-      xoff = udoff(ivx,nudoff(ivx))
-      xoff = sign(int(10.*abs(xoff)+.5)/10.,xoff)
-      if (.not.onoff) xoff = -xoff
-      if (xoff .lt. -9.95) then
-        ifmt = 5
-      else if (xoff.lt.-.95 .or. xoff.gt.9.95) then
-        ifmt = 4
-      else
-        ifmt = 3
-      end if
-      write(notexq,'(f'//chax(48+ifmt)//'.1)')xoff
-         call addstr(sq//'off{'//notexq(1:ifmt)//'pt}',8+ifmt,
-     *                   soutq,lsout)
-      return
-      end
-      subroutine puttitle(inhnoh,xnsttop,etatop,sq,etait,etatc,
-     *  etacs1,nv,vshrink,sepsymq)
-c
-c  Called once per page, at top of page!  If vshrink, only called for p.1.
-c  Actual titles only allowed on p.1. (set by headlog).
-c  3/18/01:  The above comment is probably bogus...can use Tt on later pages.
-c
-      common /comlast/ islast,usevshrink
-      logical islast,usevshrink
-      common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip,
-     *    inhead
-      common /cominbot/ inbothd
-      character*127 notexq
-      character*120 instrq,titleq,compoq
-      parameter (nm=24)
-      character*1 sq,sepsymq(nm),chax
-      logical headlog,vshrink
-      notexq = sq//'znotes'
-      lenline = 7
-      do 22 iv = 1 , nv-1
-        notexq = notexq(1:lenline)//sepsymq(iv)
-        lenline = lenline+1
-22    continue
-      notexq = notexq(1:lenline)//sq//'zcharnote{'
-      lenline = lenline+11
-      if (.not.headlog) then
-        inhead = inhnoh
-      end if
-      if (vshrink .and. usevshrink) then
-        inhead = 16
-      end if
-      ndig = int(alog10(inhead+.01))+1
-      write(notexq(lenline+1:lenline+ndig+10),'(i'//chax(48+ndig)//
-     *    ',a10)')inhead,'}{'//sq//'titles{'
-      lenline = lenline+ndig+10
-c
-c  Vertical skip at top of page (\Il) = etatop*glueil.  Needed whether
-c    headers are present or not.
-c
-      glueil = xnsttop/etatop
-      vskil = etatop*glueil
-      if (vshrink .and. usevshrink) vskil = 2
-      call writflot(vskil,notexq,lenline)
-      if (.not.headlog) then
-        if (islast) write(11,'(a)')notexq(1:lenline)
-     *     //'}{}{0}{}{0}{}{0}}'//sq//'en%'
-      else
-        notexq = notexq(1:lenline)//'}{'
-        lenline = lenline+2
-        lcq = lenstr(instrq,120)
-        if (lcq .gt. 0) then
-          xitil = etait*glueil
-          if (vshrink .and. usevshrink) xitil = 2
-          notexq = notexq(1:lenline)//instrq(1:lcq)//'}{'
-c
-c Null out instrument once used
-c
-          instrq = ' '
-          lenline = lenline+lcq+2
-          call writflot(xitil,notexq,lenline)
-        else
-          notexq = notexq(1:lenline)//'}{0'
-          lenline = lenline+3
-        end if
-        if (islast) write(11,'(a)')notexq(1:lenline)//'}%'
-        notexq = '{'
-        lenline = 1
-        lcq = lenstr(titleq,120)
-        if (lcq .gt. 0) then
-          notexq = notexq(1:lenline)//titleq(1:lcq)
-          lenline = lenline+lcq
-        else
-          call printl(' ')
-          call printl('WARNING')
-          call printl(
-     *      '  In a title block, you have specified instrument and/or')
-          call printl(
-     *      '  composer but no title for the piece.')
-        end if
-        notexq = notexq(1:lenline)//'}{'
-        lenline = lenline+2
-        xtcil = etatc*glueil
-        lcq = lenstr(compoq,120)
-        if (lcq .eq. 0) xtcil = 2*xtcil
-        if (vshrink .and. usevshrink) xtcil = 2
-        call writflot(xtcil,notexq,lenline)
-        notexq = notexq(1:lenline)//'}{'
-        lenline = lenline+2
-        if (lcq .gt. 0) then
-          notexq = notexq(1:lenline)//compoq(1:lcq)//'}{'
-          lenline = lenline+2+lcq
-c
-c  Null out compoq so it does not get written later
-c
-          compoq = ' '
-          xcsil = etacs1*glueil
-          if (vshrink .and. usevshrink) xcsil = 2
-          call writflot(xcsil,notexq,lenline)
-        else
-          notexq = notexq(1:lenline)//'}{0'
-          lenline = lenline+3
-        end if
-        if (islast) write(11,'(a)')notexq(1:lenline)//'}}'//sq//'en%'
-        headlog = .false.
-      end if
-      return
-      end
-      subroutine putxtn(ntupv,iflop,multb,iud,wheadpt,poenom,
-     *  nolev1,islope,slfac,xnlmid,islur,lnote,notexq,ncmid,nlnum,
-c     *  eloff,iup,irest,usexnumt)
-     *  eloff,iup,irest,mult,usexnumt)
-c
-c  Places digit for xtuplet.
-c
-      character*1 chax
-      character*8 noteq
-      character*79 notexq
-      logical btest,usexnumt
-      if (iflop.ne.0 .and. multb.gt.0) then
-c
-c Number goes on beam side, move R/L by .5 wheadpt for upper/lower
-c
-        eloff = eloff-0.5*iud*wheadpt/poenom
-c
-c  Number goes on beam side, must use beam parameters to set pos'n
-c
-        nlnum = nolev1+islope/slfac*eloff+iup*(multb+8)
-        if (multb .ge. 2) nlnum = nlnum+iup
-      else
-        nlnum = nint(xnlmid-1+3*iud+iflop*11)
-      end if
-      if (.not.btest(islur,31)) then
-c
-c  Only print number when wanted.  First check vert, horiz offset
-c
-c        if (btest(irest,1)) nlnum = nlnum+iand(31,ishft(irest,-2))-16
-        if (btest(irest,1)) nlnum = nlnum+igetbits(mult,8,16)-64
-        if (btest(irest,7)) eloff = eloff+
-     *          (.1*iand(31,ishft(irest,-9))-1.6)*wheadpt/poenom
-        if (.not.usexnumt) then 
-          notexq = chax(92)//'xnum{'
-          lnote = 10
-          istrtn = 7
-        else
-          notexq = chax(92)//'xnumt{'
-          lnote = 11
-          istrtn = 8
-        end if
-        if (eloff .lt. 0.995) then
-          write(notexq(istrtn:istrtn+3),'(i1,f3.2)')0,eloff
-        else if (eloff .lt. 9.995) then
-          write(notexq(istrtn:istrtn+3),'(f4.2)')eloff
-        else
-          write(notexq(istrtn:istrtn+4),'(f5.2)')eloff
-          lnote = lnote+1
-        end if
-        call notefq(noteq,lnoten,nlnum,ncmid)
-        notexq = notexq(1:lnote)//'}'//noteq(1:lnoten)
-        lnote = lnote+1+lnoten
-        if (ntupv .lt. 10) then
-          write(notexq(lnote+1:lnote+1),'(i1)')ntupv
-          lnote = lnote+1
-        else
-          notexq = notexq(1:lnote)//'{'
-          write(notexq(lnote+2:lnote+3),'(i2)')ntupv
-          notexq = notexq(1:lnote+3)//'}'
-          lnote = lnote+4
-        end if
-      end if
-      return
-      end
-      subroutine read10(string,lastchar)
-      parameter (maxblks=4000)
-      character*65536 bufq
-      integer*2 lbuf(maxblks)
-      common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
-      character*(*) string
-      character*128 lnholdq
-      logical lastchar
-      common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
-      logical mrecord,mplay,endmac
-      common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20),
-     *                 ic1mac(20),ilmac,iplmac
-      if (.not.mplay) then
-        if (ilbuf .gt. nlbuf) go to 999
-        call getbuf(string)
-        return
-999     lastchar = .true.
-        return
-      else
-c
-c  Play a macro.  Set pointer to first character needed in buffer
-c
-        if (ilmac .eq. il1mac(macnum)) then
-c
-c  Getting first line of macro
-c
-          ip1 = ip1mac(macnum)
-          iplmac = ip1-ic1mac(macnum) 
-        else if (ilmac .le. il2mac(macnum)) then
-c
-c  Beyond first line of macro.  Advance line-start pointer.
-c
-          iplmac = iplmac+lbuf(ilmac-1)
-          ip1 = iplmac+1
-        else
-c
-c  Beyond last line of macro.  Terminate it!
-c
-          mplay = .false.
-          endmac = .true.
-          return
-        end if
-        if (ilmac .eq. il2mac(macnum)) then
-c
-c  Getting last line of macro.
-c
-          ip2 = ip2mac(macnum)
-        else 
-c
-c  Getting line before last line of macro.
-c
-          ip2 = iplmac+lbuf(ilmac)
-        end if
-        if (ip2 .ge. ip1) then
-          string = bufq(ip1:ip2)
-        else
-c
-c  Kluge for when macro start is on a line by itself
-c
-          string = ' '
-        end if
-        ilmac = ilmac+1
-        return
-      end if
-      end
-      function readin(lineq,iccount,nline)
-c
-c  Reads a piece of setup data from file lineq, gets a new lineq from
-c  file 10 (jobname.pmx) and increments nline if needed,  passes over
-c  comment lines
-c
-      character*128 lineq
-      character*1 durq,chax
-4     if (iccount .eq. 128) then
-1       call getbuf(lineq)
-        nline = nline+1
-        if (lineq(1:1) .eq. '%') go to 1
-        iccount = 0
-      end if
-      iccount = iccount+1
-c
-c  Find next non-blank or end of line
-c
-      do 2 iccount = iccount , 127
-        if (lineq(iccount:iccount) .ne. ' ') go to 3
-2     continue
-c
-c  If here, need to get a new line
-c
-      iccount = 128
-      go to 4
-3     continue
-c
-c  iccount now points to start of number to read
-c
-      i1 = iccount
-5     call getchar(lineq,iccount,durq)
-c
-c  Remember that getchar increments iccount, then reads a character.
-c
-      if (index('0123456789.-',durq) .gt. 0) go to 5
-      i2 = iccount-1
-      if (i2 .lt. i1) then
-        print*,'Found "'//durq//'" instead of number'
-        call stop1()
-      end if
-      icf = i2-i1+49
-      read(lineq(i1:i2),'(f'//chax(icf)//'.0)')readin
-      return
-      end
-      subroutine readmeter(lineq,iccount,mtrnum,mtrden)
-      character*128 lineq
-      character*1 durq,chax
-      if (index(lineq(iccount+1:iccount+3),'/') .eq. 0) then
-c
-c  No slashes, so use old method
-c
-        call getchar(lineq,iccount,durq)
-        if (durq .eq. '-') then
-c
-c  Negative numerator is used only to printed; signals vertical slash
-c
-          call getchar(lineq,iccount,durq)
-          mtrnum = -(ichar(durq)-48)
-        else if (durq .eq. 'o') then
-c
-c  Numerator is EXACTLY 1
-c
-          mtrnum = 1
-        else
-          mtrnum = ichar(durq)-48
-          if (mtrnum .eq. 1) then
-c
-c  Numerator is >9
-c
-            call getchar(lineq,iccount,durq)
-            mtrnum = 10+ichar(durq)-48
-          end if
-        end if
-        call getchar(lineq,iccount,durq)
-        if (durq .eq. 'o') then
-          mtrden = 1
-        else
-          mtrden = ichar(durq)-48
-          if (mtrden .eq. 1) then
-            call getchar(lineq,iccount,durq)
-            mtrden = 10+ichar(durq)-48
-          end if
-        end if
-      else
-c
-c  Expect the form m[n1]/[n2]/[n3]/[n4] . Advance iccount by one from '/' or 'm'
-c
-        iccount = iccount+1
-        ns = index(lineq(iccount:128),'/')
-        read(lineq(iccount:iccount+ns-2),'(i'//chax(47+ns)//')')mtrnum
-c
-c  Reset iccount to start of second integer
-c
-        iccount = iccount+ns
-c
-c  There must be either a slash or a blank at pos'n 2 or 3
-c
-        ns = index(lineq(iccount:iccount+2),'/')
-        if (ns .eq. 0) ns = index(lineq(iccount:iccount+2),' ')
-        read(lineq(iccount:iccount+ns-2),'(i'//chax(47+ns)//')')mtrden
-c
-c  Set iccount to last character used
-c
-        iccount = iccount+ns-1
-      end if
-      return
-      end
-      subroutine readnum(lineq,iccount,durq,fnum)
-c
-c  This reads a number starting at position iccount.  Remember that on exit,
-c  getchar leaves iccount at the last character retrieved.  So must only
-c  call this routine *after* detecting a number or decimal.
-c  On exit, durq is next character after end of number.
-c
-      character*128 lineq
-      character*1 durq,chax
-      i1 = iccount
-1     call getchar(lineq,iccount,durq)
-      if (index('0123456789.',durq) .gt. 0) go to 1
-      i2 = iccount-1
-      if (i2 .lt. i1) then
-        print*,'Found "'//durq//'" instead of number'
-        call stop1()
-      else if (lineq(i1:i1).eq.'.'.and.lineq(i2:i2).eq.'.') then
-        i2 = i2-1
-        iccount = iccount-1
-      end if
-      icf = i2-i1+49
-      read(lineq(i1:i2),'(f'//chax(icf)//'.0)')fnum
-      return
-      end
-      subroutine setbits(isdata,iwidbit,ishift,ivalue)
-c
-c  Sets iwidbits of isdata, shifted by ishift, to ivalue
-c
-      ibase = 2**iwidbit-1
-      if (ivalue.gt.ibase) then
-        print*
-        print*,'WARNING in setbits: ivalue > ibase'
-        write(15,'(/,a)')'WARNING in setbits: ivalue > ibase'
-      end if  
-      isdata = iand(not(ishft(ibase,ishift)),isdata)
-      isdata = ior(isdata,ishft(ivalue,ishift))
-      return
-      end
-      subroutine setbm2(xelsk,nnb,sumx,sumy,ipb,islope,nolev1)
-c
-c The MEAN SQUARE slope algorithm
-c
-      parameter (nm=24)
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      character*1 ulq,sepsymq,sq
-      logical beamon,firstgulp,figbass,figchk,
-     *        isfig
-      real*4 xelsk(24)
-      integer ipb(24)
-        ibc = ibmcnt(ivx)
-        sumxx = 0.
-        sumxy = 0.
-        do 2 inb = 1 , nnb
-          sumxx = sumxx+xelsk(inb)**2
-          sumxy = sumxy+xelsk(inb)*nolev(ivx,ipb(inb))
-2       continue
-        delta = nnb*sumxx-sumx*sumx
-        em = (nnb*sumxy-sumx*sumy)/delta
-        islope = nint(0.5*em*slfac)
-        if (iabs(islope) .gt. 9) islope = isign(9,islope)
-        beta = (sumy-islope/slfac*sumx)/nnb
-        nolev1 = nint(beta)
-c
-c   Check if any stems are too short
-c
-        smin = 100.
-        iul = -1
-        if (ulq(ivx,ibc) .eq. 'u') iul = 1
-        do 4 inb = 1 , nnb
-          ybeam = nolev1+iul*stemlen+islope*xelsk(inb)/slfac
-          ynote = nolev(ivx,ipb(inb))
-          smin = min(smin,iul*(ybeam-ynote))
-4       continue
-        if (smin .lt. stemmin) then
-          deficit = stemmin-smin
-          nolev1 = nint(nolev1+iul*deficit)
-        end if
-      return
-      end
-      subroutine setmac(lineq,iccount,ibarcnt,ibaroff,nbars,charq,durq,
-     *                  ivx,nline)
-      character*1 charq,durq
-      common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
-      logical mrecord,mplay,endmac,btest
-      character*128 lnholdq,lineq
-      common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20),
-     *                 ic1mac(20),ilmac,iplmac
-c
-c  Macro action
-c
-      call g1etchar(lineq,iccount,charq)
-      if (charq.eq.'S' .and. ivx.ne.1) then
-        print*
-        print*
-        print*,'*********WARNING*********'
-        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *    '"MS..." only put in parts by scor2prt if in voice #1!')
-      end if
-      if (index('RSP ',charq) .eq. 0) then
-        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Illegal character after "M" (macro)!')
-        call stop1()
-      else if (charq .ne. ' ') then
-c
-c  Record or playback a macro.  Get the number of the macro.
-c
-        call g1etchar(lineq,iccount,durq)
-        if (index('123456789',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Must input number after "MR","MP", or "MS"!')
-          call stop1()
-        end if
-        call readnum(lineq,iccount,durq,fnum)
-        macnum = nint(fnum)
-        if (durq .ne. ' ') then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Macro number must be followed by a blank!')
-          call stop1()
-        end if
-        if (index('RS',charq ).gt. 0) then
-c
-c  Record or save a macro
-c
-          if (macnum.lt.1 .or. macnum.gt.20) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *           'Macro number not in range 1-20!')
-            call stop1()
-c          else if (btest(macuse,macnum)) then
-c            print*
-c            print*,'WARNING: Redefining macro # ',macnum
-          end if
-          macuse = ibset(macuse,macnum)
-          if (charq .eq. 'R') then
-            call m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm)
-          else if (charq .eq. 'S') then
-c
-c  Save (Record but don't activate)
-c
-1           call m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm)
-            if (mrecord) then
-              call getbuf(lineq)
-              nline = nline+1
-              iccount = 0
-              go to 1
-            end if
-            iccount = iccount+ndxm+1
-          end if
-        else
-c
-c  Playback the macro
-c
-          if (.not.btest(macuse,macnum)) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *           'Cannot play a macro that has not been recorded!')
-            call stop1()
-          end if
-          icchold = iccount
-          lnholdq = lineq
-          iccount = 128
-          mplay = .true.
-          ilmac = il1mac(macnum)
-        end if
-      end if
-      return
-      end
-      subroutine setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
-c
-c  Sets last 2 args depending on 1st 2, (logical) num, denom.
-c  ibmtyp = 1, 2, or 3 defines set of masks for beam groupings.
-c  1: all duple meters
-c  2: triple w/ denom=4, subdivide in groups of 2 8ths
-c  3: triple w/ denom=8, subdivide in groups of 3 8ths
-c  Note that lenbar is set at top or when 'm' symbol is read in getnote
-c
-      if (mtrdenl .eq. 4) then
-        if (mod(mtrnuml,3) .eq. 0) then
-          ibmtyp = 2
-          ibmrep = mtrnuml/3
-        else
-          ibmtyp = 1
-          ibmrep = mtrnuml/2
-        end if
-      else if (mtrdenl .eq. 2) then
-        ibmtyp = 1
-        if (mtrnuml .eq. 3) then
-          ibmrep = 3
-        else
-          ibmrep = 2*mtrnuml/mtrdenl
-        end if
-      else
-c
-c  Assumes mtrdenl=8 and 3/8, 6/8, 9/8, or 12/8
-c
-        ibmtyp = 3
-        ibmrep = mtrnuml/3
-      end if
-c
-c  Reset so we don't keep writing new meters
-c
-      mtrnuml = 0
-c
-c  Prevent ibmrep=0.  Needed for odd bars, e.g. 1/8, where beams don't matter
-c
-      ibmrep = max(ibmrep,1)
-      return
-      end
-      subroutine SetupB(xelsk,nnb,sumx,sumy,ipb,smed,ixrest)
-c
-c The outer combo algorithm
-c
-      parameter (nm=24)
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      common /comipl2/ ipl2(nm,200)
-      character*1 ulq,sepsymq,sq
-      logical beamon,firstgulp,figbass,figchk,btest,
-     *        isfig,vxtup,l1ng,l2ng,bar1syst,drawbm
-      common /comeskz2/ eskz2(nm,200)
-      real*4 slope(800),xelsk(24)
-      integer ipb(24)
-      common /comask/ bar1syst,fixednew,scaldold,
-     *                wheadpt,fbar,poenom
-      common /comas1/ naskb,task(40),wask(40),elask(40)
-      common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
-     *                 mtupv(nm,9),nxtinbm(nm),
-     *                 islope(nm),xels11(24),eloff(nm,9),
-     *                 nssb(nm),issb(nm),lev1ssb(nm,20)
-      common /comdraw/ drawbm(nm)
-      common /combmh/ bmhgt,clefend
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      common /comtol/ tol
-      ibc = ibmcnt(ivx)
-      nxtinbm(ivx) = 0
-      n1 = ipl2(ivx,ibm1(ivx,ibc))
-c
-c  Initialize counters used in this subroutine, and then later during actual
-c    beam drawing, to count later segments of single-slope beam groups
-c
-      nssb(ivx) = 0
-      issb(ivx) = 0
-c
-c  Set flag for xtup beam starting with rest (no others can start with rest)
-c
-      if (btest(irest(ivx,ipo(n1)),0)) ixrest = 1
-c
-c Figure how many elemskips to each note. Use the list, counting only non-rests.
-c
-      eskz0 = eskz(ivx,ibm1(ivx,ibc))
-      nnb = 0
-      sumx = 0.
-      sumy = 0.
-      ipxt1 = 0
-      iplast = ibm2(ivx,ibc)
-      do 2 ip = ibm1(ivx,ibc) , iplast
-        if (.not.btest(irest(ivx,ip),0)) then
-          nnb = nnb+1
-          ipb(nnb) = ip
-          xelsk(nnb) = eskz(ivx,ip)-eskz0
-          sumx = sumx+xelsk(nnb)
-          sumy = sumy+nolev(ivx,ipb(nnb))
-          if (btest(nacc(ivx,ip),21)) then
-c
-c  This is the starting note of later segment of single-slope beam group
-c  Temporarily store ip here.
-c
-            nssb(ivx) = nssb(ivx)+1
-            lev1ssb(ivx,nssb(ivx)) = nnb
-          end if
-        end if
-c
-c  New xtup stuff here.  Final object is to get distance from start of xtup
-c    to number. xtinbm counts xtups in this beam only.  mtupv is the printed
-c    number.  ntupv is number of notes in xtup, and is only used to get
-c    eloff, the distance from start of xtup to the number.
-c
-        if (btest(nacc(ivx,ip),18)) ndoub = ndoub+1
-        if (ipxt1.eq.0 .and. nodur(ivx,ip).eq.0) then
-c
-c  Xtup is starting here
-c
-          nxtinbm(ivx) = nxtinbm(ivx)+1
-          ipxt1  = ip
-          if (btest(nacc(ivx,ip),18)) then
-            ndoub = 1
-          else
-            ndoub = 0
-          end if
-        else if (ipxt1.gt.0 .and. nodur(ivx,ip).gt.0) then
-c
-c  Xtup ends here.  Set total number of notes in xtup.
-c
-          ntupv(ivx,nxtinbm(ivx)) = ip+1-ipxt1
-c
-c  Set printed number for embedded xtup.
-c
-          mtupv(ivx,nxtinbm(ivx)) = ntupv(ivx,nxtinbm(ivx))+ndoub
-c
-c  Middle note of xtup if ntupv odd, note to left of gap if even.  
-c
-          ipxtmid = (ip+ipxt1)/2
-          eloff(ivx,nxtinbm(ivx)) = eskz2(ivx,ipxtmid)-eskz2(ivx,ipxt1)
-          if (mod(ntupv(ivx,nxtinbm(ivx)),2) .eq. 0) 
-     *        eloff(ivx,nxtinbm(ivx)) = eloff(ivx,nxtinbm(ivx))+
-     *        .5*(eskz2(ivx,ipxtmid+1)-eskz2(ivx,ipxtmid))
-          ipxt1 = 0
-        end if
-2     continue
-c
-c  Reset nxtinbm for use as counter as #'s are posted by putxtn(..)
-c
-      nxtinbm(ivx) = 0
-      smed = 0.
-      if (.not.btest(islur(ivx,ipb(1)),2)) then
-c
-c No forced 0 slope
-c
-        if (nnb .eq. 1) go to 6
-        nsc = 0
-        do 5 inb = 1 , nnb-1
-        do 5 jnb = inb+1 , nnb
-          nsc = nsc+1
-          slope(nsc) = (nolev(ivx,ipb(jnb))-nolev(ivx,ipb(inb)))/
-     *                   (xelsk(jnb)-xelsk(inb))
-          if (abs(slope(nsc)) .lt. 1.e-4) then
-            nsc = nsc+1
-            slope(nsc) = slope(nsc-1)
-            nsc = nsc+1
-            slope(nsc) = slope(nsc-1)
-          end if
-5       continue
-        if (nsc .eq. 1) then
-          smed = slope(1)
-          go to 6
-        end if
-        nscmid = nsc/2+1
-        do 7 i = 1 , nscmid
-          do 7 j = i+1 , nsc
-            if (slope(j) .lt. slope(i)) then
-              t = slope(j)
-              slope(j) = slope(i)
-              slope(i) = t
-            end if
-7       continue
-        smed = slope(nscmid)
-        if (nsc .eq. 2*(nsc/2)) then 
-c
-c  Even number of slopes in the list, so median is ambiguous
-c
-          if (abs(slope(nscmid-1)) .lt. abs(slope(nscmid))-tol) then
-c
-c  Lower-numbered one is truly less in absolute value, so use it
-c
-            smed=slope(nscmid-1)
-          else if (abs(slope(nscmid-1)+slope(nscmid)) .lt. tol) then
-c
-c  Two slopes are effectively equal.  Take the one with sign of the average
-c
-            sum = 0.
-            do 1 i = 1 , nsc
-              sum = sum+slope(i)
-1           continue
-            smed = sign(smed,sum)
-          end if
-        end if
-6       continue
-        islope(ivx) = nint(0.5*smed*slfac)
-        if (iabs(islope(ivx)) .gt. 9) 
-     *         islope(ivx) = isign(9,islope(ivx))
-      else
-c
-c  Forced horizontal beam
-c
-        islope(ivx) = 0
-      end if
-      beta = (sumy-islope(ivx)/slfac*sumx)/nnb
-c
-c  If ixrest>0, this is a virtual nolev1 at location of rest.  Will first use
-c  as is for placing xtup number and/or bracket, then reset it for start of
-c  actual beam
-c
-      nolev1(ivx) = nint(beta)
-c
-c  Check if any stems are too short
-c
-      smin = 100.
-      iul = -1
-      if (ulq(ivx,ibc) .eq. 'u') iul = 1
-      ssq = 0.
-      syb = 0.
-c      yb1 = nolev1(ivx)+iul*(stemlen+bmhgt*(mult(ivx,ipb(1))-1))
-      yb1 = nolev1(ivx)
-     *       +iul*(stemlen+bmhgt*(iand(15,mult(ivx,ipb(1)))-8-1))
-      do 4 inb = 1 , nnb
-        ybeam = yb1+islope(ivx)*xelsk(inb)/slfac
-c     *              -iul*bmhgt*(mult(ivx,ipb(inb))-1)
-     *              -iul*bmhgt*(iand(15,mult(ivx,ipb(inb)))-8-1)
-        syb = syb+ybeam
-        ynote = nolev(ivx,ipb(inb))
-        off = ybeam-ynote
-        if (inb .eq. 1) then
-          off1 = off
-        else if (inb .eq. nnb) then
-          off2 = off
-        end if
-        ssq = ssq+off*off
-        smin = min(smin,iul*off)
-4     continue
-      dnolev = 0.
-      if (smin .lt. stemmin) then
-        deficit = stemmin-smin
-        nolevo = nolev1(ivx)
-        nolev1(ivx) = nint(nolev1(ivx)+iul*deficit)
-        dnolev = nolev1(ivx)-nolevo
-        off1 = off1+dnolev
-        off2 = off2+dnolev
-      end if
-      ssq = ssq+2*dnolev*(syb-sumy)+dnolev**2
-      if (.not.vxtup(ivx) .and. sqrt(ssq/nnb) .gt. stemmax .and.
-     *    (abs(off1).lt.stemmax .or. abs(off2).lt.stemmax)
-     *    .and. .not.btest(islur(ivx,ipb(1)),2)) then
-c
-c  The first check is to save trouble of putting xtup's in setbm2.
-c  The penultimate check is that first and last stems aren't both excessive.
-c  The last check is that a 0 slope has not been forced
-c
-        call setbm2(xelsk,nnb,sumx,sumy,ipb,islope(ivx),nolev1(ivx))
-      end if
-c
-c  Check if beam starts or ends too high or low.
-c
-c      xboff = bmhgt*(mult(ivx,ipb(1))-1)
-      xboff = bmhgt*(iand(15,mult(ivx,ipb(1)))-8-1)
-      l1ng = iul*(nolev1(ivx)-ncmid(iv,ipb(1)))+xboff+7 .lt. 0.
-      xnolev2 = nolev1(ivx)+islope(ivx)/slfac*xelsk(nnb)
-      l2ng = iul*(xnolev2-ncmid(iv,ipb(nnb)))+xboff+7 .lt. 0
-      if (l1ng .or. l2ng) then
-c
-c  Need to correct start or stop, also slope
-c
-        if (l1ng) then
-          nolev1(ivx) = nint(ncmid(iv,ipb(1))-(7.+xboff)*iul)
-        end if
-        if (l2ng) then
-          xnolev2 = nint(ncmid(iv,ipb(nnb))-(7.+xboff)*iul)
-        end if
-c
-c  Since one or the other end has changed, need to change slope
-c
-        if (.not.btest(islur(ivx,ipb(1)),2))
-     *       islope(ivx) = nint(slfac*(xnolev2-nolev1(ivx))/xelsk(nnb))
-      end if
-      if (nssb(ivx) .gt. 0) then
-c
-c  This is a single-slope beam group.  Store start heights for later segs.
-c
-        do 3 issbs = 1 , nssb(ivx)
-          lev1ssb(ivx,issbs) = nolev1(ivx)+islope(ivx)/slfac*
-     *                                  xelsk(lev1ssb(ivx,issbs))
-3       continue
-      end if
-      return
-      end
-      subroutine sortpoe(nsyst,poe,ipoe)
-      parameter (nks=125)
-      real*4 poe(nks)
-      integer*4 ipoe(nks)
-c
-c  Initialize ipoe:
-c
-      do 3 iord = 1 , nsyst
-        ipoe(iord) = iord
-3     continue
-c
-c  Construct ipoe vector with pairwise interchanges.  When done, ipoe(1) will
-c  be index of smallest poe, and ipoe(nsyst) will be index of biggest poe.
-c
-      do 4 io1 = 1 , nsyst-1
-        do 5 io2 = io1+1 , nsyst
-          if (poe(ipoe(io1)) .gt. poe(ipoe(io2))) then
-c
-c Interchange the indices
-c
-            itemp = ipoe(io1)
-            ipoe(io1) = ipoe(io2)
-            ipoe(io2) = itemp
-          end if
-5       continue
-4     continue
-      return
-      end
-      subroutine spsslur(lineq,iccount,iv,kv,ip,isdat1,isdat2,isdat3,
-     *                   isdat4,nsdat,notcrd,nolev,starter)
-      parameter (nm=24)
-c
-c  Reads in slur data.  Record all h/v-shifts for non-chords, user-specified
-c  ones for chords.  
-c  5/26/02  This subr is called ONLY for postscript slurs.
-c
-c  See subroutine doslur for bit values in isdat1,2,3
-c
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      integer*4 isdat1(202),isdat2(202),isdat3(202),isdat4(202)
-      logical notcrd,btest
-      character*128 lineq
-      character*1 durq,dumq,starter
-      common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
-     *                 ,WrotePsslurDefaults,SlurCurve
-      logical upslur,fontslur,WrotePsslurDefaults
-c
-c  Counter for signed integers.  1st is height, 2nd is horiz, 3rd is curve
-c
-      numint = 0
-      ivoff = 0
-      ihoff = 0
-      nsdat = nsdat+1
-      if (starter.eq.'{' .or. starter.eq.'}') 
-     *           isdat2(nsdat)=ibset(isdat2(nsdat),3)
-      call setbits(isdat1(nsdat),5,13,iv)
-      call setbits(isdat1(nsdat),1,12,kv-1)
-      call setbits(isdat1(nsdat),8,3,ip)
-      isdat3(nsdat) = 0
-	isdat4(nsdat) = 0
-	ilb12 = 0 ! flag for tweaks of 1st or 2nd (0|1) seg of linebreak slur 
-c
-c  Get ID code
-c
-      call getchar(lineq,iccount,durq)
-c      if (index('uldtb+-hfnHps ',durq) .gt. 0) then
-      if (index('uldtb+-hfnHpsv ',durq) .gt. 0) then
-c
-c  Null id. Note for ps slurs, 'H' cannot be an ID
-c
-        iccount = iccount-1
-        if (lineq(iccount:iccount) .eq. 't') then
-          idcode = 1
-        else
-          idcode = 32
-        end if
-      else
-c
-c  Set explicit idcode
-c
-        idcode = ichar(durq)
-        if (lineq(iccount-1:iccount-1) .eq. 't') then
-c
-c  Make t[ID] look like s[ID]t
-c
-          isdat2(nsdat) = ibset(isdat2(nsdat),3)  
-        end if
-      end if
-      call setbits(isdat1(nsdat),7,19,idcode)
-c
-c  Set start/stop: look thru list from end for same idcode,iv,kv
-c
-      do 2 isdat = nsdat-1 , 1 , -1
-        if (idcode .eq. igetbits(isdat1(isdat),7,19) .and.
-     *      iv .eq. igetbits(isdat1(isdat),5,13) .and.
-     *      kv-1 .eq. igetbits(isdat1(isdat),1,12)) then
-c
-c  Matched idcode & ivx.  On/off?.  If on, new is turnoff, leave bit 11 at 0.
-c
-          if (btest(isdat1(isdat),11)) go to 3
-c
-c  Found slur is a turnoff, so new one is a turnon.  Jump down to set bit
-c
-          go to 4
-        end if
-2     continue
-c
-c  If here, this is turnon.
-c
-4     continue
-      isdat1(nsdat) = ibset(isdat1(nsdat),11)
-3     continue
-c
-c  Now done with initial turnon- or turnoff-specifics.  
-c
-      if (nint(SlurCurve).ne.0 .and. btest(isdat1(nsdat),11)) then
-c
-c  There's a default curvature tweak
-c
-        icurv1 = nint(SlurCurve)+3
-        if (icurv1 .eq. 2) icurv1 = 1
-        isdat3(nsdat) = ibset(isdat3(nsdat),0)
-        call setbits(isdat3(nsdat),6,2,32+icurv1)
-      end if
-c
-c  Loop for rest of input
-c
-1     call getchar(lineq,iccount,durq)
-      if (index('uld',durq) .gt. 0) then
-c
-c  Force direction
-c
-        isdat1(nsdat) = ibset(isdat1(nsdat),26)
-        if (durq .eq. 'u') isdat1(nsdat) = ibset(isdat1(nsdat),27)
-        go to 1
-      else if (index('+-',durq) .gt. 0) then
-        numint = numint+1
-        if (numint .eq. 1) then
-c
-c  Vertical offset
-c
-          iccount = iccount+1
-          call readnum(lineq,iccount,dumq,fnum)
-          iccount = iccount-1
-          ivoff = nint(fnum)
-          if (durq .eq. '-') ivoff = -ivoff
-        else if (numint .eq. 2) then
-c
-c  Horizontal offset
-c
-          iccount = iccount+1
-          call readnum(lineq,iccount,dumq,fnum)
-          iccount = iccount-1
-c
-c  fnum is abs(hshift), must be 0 to 6.3
-c
-          ihoff = fnum*10 + .5
-          if (durq .eq. '-') ihoff = -ihoff
-c
-c  Later will set bits to 1...127 to represent -6.3,...+6.3
-c
-        else
-c
-c  Must be the 3rd signed integer, so it's a curve specification
-c
-          isdat3(nsdat) = ibset(isdat3(nsdat),0)
-          iccount = iccount+1
-          call readnum(lineq,iccount,dumq,fnum)
-          icurv1 = nint(fnum)
-          if (durq .eq. '-') icurv1 = -icurv1
-          call setbits(isdat3(nsdat),6,2,32+icurv1)
-          if (dumq .ne. ':') then 
-c
-c  Back up the pointer and loop for more input
-c
-            iccount = iccount-1
-          else
-c
-c  Expect two single digits as parameters for curve
-c
-            isdat3(nsdat) = ibset(isdat3(nsdat),1)
-            call setbits(isdat3(nsdat),3,8,
-     *            ichar(lineq(iccount+1:iccount+1))-48)
-            call setbits(isdat3(nsdat),3,11,
-     *            ichar(lineq(iccount+2:iccount+2))-48)
-            iccount = iccount+2
-          end if             
-        end if
-        go to 1
-      else if (durq .eq. 't') then
-        isdat2(nsdat) = ibset(isdat2(nsdat),3)
-        go to 1
-      else if (durq .eq. 'b') then
-        isdat2(nsdat) = ibset(isdat2(nsdat),4)
-        go to 1
-      else if (durq .eq. 's') then
-c
-c  Endpoint tweaks for linebreak slurs. 
-c
-        call getchar(lineq,iccount,durq) ! Must be +|-
-c
-c  Next is vertical offset
-c
-        iccount = iccount+1
-        call readnum(lineq,iccount,dumq,fnum)
-        if (durq .eq. '-') fnum=-fnum
-        call setbits(isdat4(nsdat),6,ilb12*16,nint(fnum)+32)        
-        if (index('+-',dumq) .gt. 0) then
-c
-c  Also a horizontal offset
-c
-          iccount = iccount+1
-          call readnum(lineq,iccount,durq,fnum)
-          if (dumq .eq. '-') fnum=-fnum
-          call setbits(isdat4(nsdat),7,ilb12*16+6,nint(10*fnum)+64)
-        end if
-        iccount = iccount-1
-        ilb12 = 1
-        go to 1
-      else if (index('fnhH',durq).gt.0) then
-c
-c  Special ps slur curvatures.  
-c  Translate to old \midslur args (1,4,5,6)
-c
-        icurv1 = index('fnxhH',durq)
-        if (icurv1 .eq. 5) then
-c
-c  check for 2nd H
-c
-          if (lineq(iccount+1:iccount+1) .eq. 'H') then
-            iccount = iccount+1
-            icurv1 = 6
-          end if   
-        end if
-        isdat3(nsdat) = ibset(isdat3(nsdat),0)
-        call setbits(isdat3(nsdat),6,2,32+icurv1)
-        go to 1
-      else if (durq .eq. 'p') then        ! Local adjustment  
-        call getchar(lineq,iccount,durq)  !  +|-
-        call getchar(lineq,iccount,dumq)  !  s|t
-c  26       \sluradjust    (p+s)
-c  27       \nosluradjust  (p-s)
-c  28       \tieadjust     (p+t)
-c  29       \notieadjust   (p-t)
-        if (durq .eq. '+') then
-          if (dumq .eq. 's') then
-	      isdat2(nsdat) = ibset(isdat2(nsdat),26)
-          else
-	      isdat2(nsdat) = ibset(isdat2(nsdat),28)
-          end if
-        else
-          if (dumq .eq. 's') then
-	      isdat2(nsdat) = ibset(isdat2(nsdat),27)
-          else
-	      isdat2(nsdat) = ibset(isdat2(nsdat),29)
-          end if
-        end if
-        go to 1
-      else if (durq .eq. 'v') then        ! Stem slur
-        isdat1(nsdat) = ibset(isdat1(nsdat),2)  
-        go to 1
-      end if
-c
-c  Record shifts
-c
-      call setbits(isdat2(nsdat),6, 6,ivoff+32)
-      call setbits(isdat2(nsdat),7,12,ihoff+64)
-c
-c  Record chord flag, note level, notehead shift
-c
-      if (notcrd) then
-        call setbits(isdat2(nsdat),7,19,nolev)
-      else
-        nolevc = igetbits(icrdat(ncrd),7,12)
-        call setbits(isdat2(nsdat),7,19,nolevc)
-        isdat2(nsdat) = ibset(isdat2(nsdat),0)
-        call setbits(isdat2(nsdat),2,1,igetbits(icrdat(ncrd),2,23))
-      end if
-      return
-      end
-      subroutine sslur(lineq,iccount,iv,kv,ip,isdat1,isdat2,isdat3,
-     *                 nsdat,notcrd,nolev,starter)
-      parameter (nm=24)
-c
-c  Reads in slur data.  Record all h/v-shifts for non-chords, user-specified
-c  ones for chords.
-c  5/26/02 now only for non-postscript slurs, use spsslur() for postscript
-c
-c  See subroutine doslur for bit values in isdat1,2,3
-c
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      integer*4 isdat1(202),isdat2(202),isdat3(202)
-      logical notcrd,btest
-      character*128 lineq
-      character*1 durq,dumq,starter
-      common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
-     *                 ,WrotePsslurDefaults,SlurCurve
-      logical upslur,fontslur,WrotePsslurDefaults
-c
-c  Counter for signed integers.  1st is height, 2nd is horiz, 3rd is curve
-c
-      numint = 0
-      ivoff = 0
-      ihoff = 0
-      nsdat = nsdat+1
-      if (starter.eq.'{' .or. starter.eq.'}') 
-     *           isdat2(nsdat)=ibset(isdat2(nsdat),3)
-      call setbits(isdat1(nsdat),5,13,iv)
-      call setbits(isdat1(nsdat),1,12,kv-1)
-      call setbits(isdat1(nsdat),8,3,ip)
-      isdat3(nsdat) = 0
-c
-c  Get id letter
-c
-      if (lineq(iccount:iccount) .eq. 't') then
-c
-c  Old-style t-slur. Use special idcode = 1
-c
-        idcode = 1
-      else
-        call getchar(lineq,iccount,durq)
-        if (index('uldtb+-hf ',durq) .gt. 0) then
-c
-c  Null id
-c
-          idcode = 32
-          iccount = iccount-1
-        else if (durq.eq.'H') then
-c
-c  Postscript slur, cannot use 'H' as code, must check for 2nd 'H'
-c
-          idcode = 32
-          iccount = iccount-1
-c
-c  There may be another "H", but no need to deal with it yet
-c
-        else
-c
-c  Set explicit idcode
-c
-          idcode = ichar(durq)
-        end if
-      end if
-      call setbits(isdat1(nsdat),7,19,idcode)
-c
-c  Set start/stop: look thru list from end for same idcode,iv,kv
-c
-      do 2 isdat = nsdat-1 , 1 , -1
-        if (idcode .eq. igetbits(isdat1(isdat),7,19) .and.
-     *      iv .eq. igetbits(isdat1(isdat),5,13) .and.
-     *      kv-1 .eq. igetbits(isdat1(isdat),1,12)) then
-c
-c  Matched idcode & ivx.  On/off?.  If on, new is turnoff, leave bit 11 at 0.
-c
-          if (btest(isdat1(isdat),11)) go to 3
-c
-c  Found slur is a turnoff, so new one is a turnon.  Jump down to set bit
-c
-          go to 4
-        end if
-2     continue
-c
-c  If here, this is turnon.
-c
-4     continue
-      isdat1(nsdat) = ibset(isdat1(nsdat),11)
-3     continue
-c
-c  Now done with initial turnon- or turnoff-specifics.  Loop for rest of input
-c
-1     call getchar(lineq,iccount,durq)
-      if (index('uld',durq) .gt. 0) then
-c
-c  Force direction
-c
-        isdat1(nsdat) = ibset(isdat1(nsdat),26)
-        if (durq .eq. 'u') isdat1(nsdat) = ibset(isdat1(nsdat),27)
-        go to 1
-      else if (index('+-',durq) .gt. 0) then
-        numint = numint+1
-        if (numint .eq. 1) then
-c
-c  Vertical offset
-c
-          iccount = iccount+1
-          call readnum(lineq,iccount,dumq,fnum)
-          iccount = iccount-1
-          ivoff = nint(fnum)
-          if (durq .eq. '-') ivoff = -ivoff
-        else if (numint .eq. 2) then
-c
-c  Horizontal offset
-c
-          iccount = iccount+1
-          call readnum(lineq,iccount,dumq,fnum)
-          iccount = iccount-1
-c
-c  fnum is abs(hshift), must be 0 to 6.3
-c
-          ihoff = fnum*10 + .5
-          if (durq .eq. '-') ihoff = -ihoff
-c
-c  Later will set bits to 1...127 to represent -6.3,...+6.3
-c
-        else
-c
-c  Must be the 3rd signed integer, so it's a curve specification
-c
-          isdat3(nsdat) = ibset(isdat3(nsdat),0)
-          iccount = iccount+1
-          call readnum(lineq,iccount,dumq,fnum)
-          icurv1 = nint(fnum)
-          if (durq .eq. '-') icurv1 = -icurv1
-          call setbits(isdat3(nsdat),6,2,32+icurv1)
-          if (dumq .ne. ':') then 
-c
-c  Back up the pointer and loop for more input
-c
-            iccount = iccount-1
-          else
-c
-c  Expect two single digits as parameters for curve
-c
-            isdat3(nsdat) = ibset(isdat3(nsdat),1)
-            call setbits(isdat3(nsdat),3,8,
-     *            ichar(lineq(iccount+1:iccount+1))-48)
-            call setbits(isdat3(nsdat),3,11,
-     *            ichar(lineq(iccount+2:iccount+2))-48)
-            iccount = iccount+2
-          end if             
-        end if
-        go to 1
-      else if (durq .eq. 't') then
-        isdat2(nsdat) = ibset(isdat2(nsdat),3)
-        go to 1
-      else if (durq .eq. 'b') then
-        isdat2(nsdat) = ibset(isdat2(nsdat),4)
-        go to 1
-      else if (index('fhH',durq) .gt. 0) then
-c
-c  Special ps slur curvatures.  Translate to old \midslur args (1,4,5,6)
-c
-        icurv1 = 2+index('fhH',durq)
-        if (icurv1 .eq. 3) then
-          icurv1 = 1
-        else if (icurv1 .eq. 5) then
-c
-c  check for 2nd H
-c
-          if (lineq(iccount+1:iccount+1) .eq. 'H') then
-            iccount = iccount+1
-            icurv1 = 6
-          end if   
-        end if
-        isdat3(nsdat) = ibset(isdat3(nsdat),0)
-c
-c  Must change sign if downslur, but cannot do it now since we don't know
-c    slur direction for sure.
-c
-        call setbits(isdat3(nsdat),6,2,32+icurv1)
-        go to 1
-      end if
-c
-c  Record shifts
-c
-      call setbits(isdat2(nsdat),6, 6,ivoff+32)
-      call setbits(isdat2(nsdat),7,12,ihoff+64)
-c
-c  Record chord flag, note level, notehead shift
-c
-      if (notcrd) then
-        call setbits(isdat2(nsdat),7,19,nolev)
-      else
-        nolevc = igetbits(icrdat(ncrd),7,12)
-        call setbits(isdat2(nsdat),7,19,nolevc)
-        isdat2(nsdat) = ibset(isdat2(nsdat),0)
-        call setbits(isdat2(nsdat),2,1,igetbits(icrdat(ncrd),2,23))
-      end if
-      return
-      end
-      subroutine stop1()
-        call exit(1)
-      end
-      subroutine topfile(basenameq,lbase,nv,clefq,noinst,musicsize,
-     *                   xinstf1,mtrnmp,mtrdnp,vshrink,fbar,fontslur)
-      parameter (nm=24)
-      common /comlast/ islast,usevshrink
-      logical islast,usevshrink,fontslur
-      common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
-     *   isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
-     *   lnam(nm),inameq(nm)
-      common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
-     *                xinsnow,lowdot
-      common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm)
-      character*79 inameq
-      character*44 basenameq
-      character*24 fmtq
-      character*5 fbarq
-      character*1 clefq(nm),sq,chax,clefqiv
-      common /comstart/ facmtr
-      logical vshrink,lowdot,rename
-      logical novshrinktop,cstuplet
-      common /comnvst/ novshrinktop,cstuplet
-      common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
-     *  instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
-      logical EarlyTransOn,LaterInstTrans
-      common /comsize/ isize(nm)
-      sq = chax(92)
-      vshrink = xinstf1.gt.20. .and. .not.novshrinktop 
-      if (vshrink) then
-        xinsnow = 10.
-      else
-        xinsnow = xinstf1
-      end if
-      if (.not.islast) return 
-      write(11,'(a)')'%%%%%%%%%%%%%%%%%'
-      write(11,'(a)')'%'
-      write(11,'(a)')'% '//basenameq(1:lbase)//'.tex'
-      write(11,'(a)')'%'
-      write(11,'(a)')'%%%%%%%%%%%%%%%%'
-      write(11,'(a)')sq//'input musixtex'
-      write(11,'(a)')sq//'input pmx'
-c      write(11,'(a)')sq//'input musixmad'
-c      write(11,'(a)')sq//'input musixxad'
-      write(11,'(a)')
-     *     sq//'setmaxslurs{24}'//sq//'setmaxinstruments{24}%' 
-      if (.not.fontslur) write(11,'(a)')sq//'input musixps'
-c
-c Need to input musixmad to permit more slurs.
-c
-      if (musicsize .eq. 20) then
-        write(11,'(a)')sq//'normalmusicsize%'
-      else if (musicsize .eq. 16) then
-        write(11,'(a)')sq//'smallmusicsize%'
-      else if (musicsize .eq. 24) then
-        write(11,'(a)')sq//'largemusicsize%'
-        write(11,'(a)')sq//'def'//sq//'meterfont{'//sq//
-     *                  'meterlargefont}%'
-      else if (musicsize .eq. 29) then
-        write(11,'(a)')sq//'Largemusicsize%'
-        write(11,'(a)')sq//'def'//sq//'meterfont{'//sq//
-     *                   'meterLargefont}%'
-      end if
-c
-c  Set sizes. Have sizes per staff in isize(.) and noinst per staff in
-c    nsperi(.)
-c
-c 130324
-c      iiv = 1
-      do 5 iinst = 1 , noinst
-c        if (isize(iiv) .eq. 1) then
-        if (isize(iinst) .eq. 1) then
-          if(iinst.le.9) then
-            write(11,'(a8,i1,a)')
-     *          sq//'setsize',iinst,sq//'smallvalue%'
-          else
-            write(11,'(a9,i2,a)')
-     *          sq//'setsize{',iinst,'}'//sq//'smallvalue%'
-          end if
-c        else if (isize(iiv) .eq. 2) then
-        else if (isize(iinst) .eq. 2) then
-          if(iinst.le.9) then
-            write(11,'(a8,i1,a)')
-     *          sq//'setsize',iinst,sq//'tinyvalue%'
-          else
-            write(11,'(a9,i2,a)')
-     *          sq//'setsize{',iinst,'}'//sq//'tinyvalue%'
-          end if 
-        end if
-c        iiv = iiv+nsperi(iinst)
-5     continue
-      write(fbarq,'(f5.3)')fbar
-      write(11,'(a)')sq//'nopagenumbers'
-      write(11,'(a)')sq//'tracingstats=2'//sq//'relax'
-      write(11,'(a7,i3,a2)')sq//'hsize=',nint(widthpt),'pt'
-      write(11,'(a6,i'//chax(49+int(log10(height+.1)))//',a2)')
-     *    sq//'vsize',int(height+.1),'pt'
-      if (abs(hoffpt) .gt. 0.1) then
-        if (hoffpt .le. -10.) then
-          write(11,'(a8,i3,a2)')sq//'hoffset',nint(hoffpt),'pt'
-        else if (hoffpt .lt. 0.) then
-          write(11,'(a8,i2,a2)')sq//'hoffset',nint(hoffpt),'pt'
-        else if (hoffpt .lt. 10.) then
-          write(11,'(a8,i1,a2)')sq//'hoffset',nint(hoffpt),'pt'
-        else
-          write(11,'(a8,i2,a2)')sq//'hoffset',nint(hoffpt),'pt'
-        end if
-      end if
-      if (abs(voffpt) .gt. 0.1) then
-        if (voffpt .le. -10.) then
-          write(11,'(a8,i3,a2)')sq//'voffset',nint(voffpt),'pt'
-        else if (voffpt .lt. 0.) then
-          write(11,'(a8,i2,a2)')sq//'voffset',nint(voffpt),'pt'
-        else if (voffpt .lt. 10.) then
-          write(11,'(a8,i1,a2)')sq//'voffset',nint(voffpt),'pt'
-        else
-          write(11,'(a8,i2,a2)')sq//'voffset',nint(voffpt),'pt'
-        end if
-      end if
-c
-c  The default  raisebarno=3.5 internote, set in pmx.tex.  Increase to 4.5 if
-c  3 sharps and treble clef, to avoid vertical clash with top space g#
-c
-      if (isig.eq.3 .and. clefq(nv).eq.'t') write(11,'(a)')
-     *     sq//'def'//sq//'raisebarno{4.5'//sq//'internote}'
-      if (noinst .lt. 10) then
-        write(11,'(a19,i1,a1)')sq//'def'//sq//'nbinstruments{',
-     *       noinst,'}'
-      else
-        write(11,'(a19,i2,a1)')sq//'def'//sq//'nbinstruments{',
-     *     noinst,'}'
-      end if
-      iv = 0
-      do 1 iinst = 1 , noinst
-        nstaves = nsperi(iinst)
-        if (iinst .lt. 10) then
-          write(11,'(a)')sq//'setstaffs'//chax(48+iinst)
-     *        //chax(48+nstaves)
-        else
-          write(11,'(a11,i2,a)')sq//'setstaffs{',iinst,'}'
-     *        //chax(48+nstaves)
-        end if
-        iv = iv+1
-        clefqiv = clefq(iv)
-        if (clefqiv.eq.'8') then
-          clefqiv='t'
-          iTransAmt(instno(iv)) = 7
-        end if
-        if (nstaves .eq. 1) then
-          fmtq = chax(48+numclef(clefq(iv)))
-          lfmtq = 1
-        else
-          fmtq = '{'//chax(48+numclef(clefq(iv)))
-          lfmtq = 2
-          do 2 k = 2 , nstaves
-            iv = iv+1
-            fmtq = fmtq(1:lfmtq)//chax(48+numclef(clefq(iv)))
-            lfmtq = lfmtq+1
-2         continue
-          fmtq = fmtq(1:lfmtq)//'}'
-          lfmtq = lfmtq+1
-        end if
-        if (iinst .lt. 10) then
-          write(11,'(a)')sq//'setclef'//chax(48+iinst)//fmtq(1:lfmtq)
-        else
-          write(11,'(a9,i2,a)')sq//'setclef{',iinst,'}'//fmtq(1:lfmtq)
-        end if
-        if (clefq(iv) .eq. '8') then
-          if (iinst .lt. 10) then
-            write(11,'(a)')sq//'settrebleclefsymbol'//chax(48+iinst)//
-     *        sq//'treblelowoct%'
-          else
-            write(11,'(a21,i2,a)')sq//'settrebleclefsymbol{',iinst,'}'//
-     *        sq//'treblelowoct%'
-          end if
-        end if
-        do 3 lname = 79 , 2 , -1
-          if (inameq(iinst)(lname:lname) .ne. ' ') go to 4
-3       continue
-4       continue
-        lnam(iinst) = lname
-        if (iinst .lt. 10) then
-          write(11,'(a8,i1,a)')sq//'setname',iinst,
-     *         '{'//inameq(iinst)(1:lname)//'}'
-        else
-          write(11,'(a9,i2,a)')sq//'setname{',iinst,
-     *         '}{'//inameq(iinst)(1:lname)//'}'
-        end if
-1     continue
-      write(11,'(a18,i2,a2)')sq//'generalsignature{',isig,'}%'
-      if (EarlyTransOn) 
-     *  call Writesetsign(nInstTrans,iInstTrans,iTransKey,EarlyTransOn)
-      call wgmeter(mtrnmp,mtrdnp)
-      ipi = nint(fracindent*widthpt)
-      if (ipi .lt. 10) then
-        write(11,'(a11,i1,a2)')sq//'parindent ',ipi,'pt'
-      else if (ipi .lt. 100) then
-        write(11,'(a11,i2,a2)')sq//'parindent ',ipi,'pt'
-      else
-        write(11,'(a11,i3,a2)')sq//'parindent ',ipi,'pt'
-      end if
-      write(11,'(a)')sq//'elemskip1pt'//sq//'afterruleskip'
-     *      //fbarq//'pt'//sq//'beforeruleskip0pt'//sq//'relax'
-      if (.not.vshrink) then
-        if (xinstf1 .lt. 9.95) then
-          fmtq = '(a,f3.1,a)'
-        else
-          fmtq = '(a,f4.1,a)'
-        end if
-        write(11,fmtq)sq//'stafftopmarg0pt'//sq//'staffbotmarg0pt'
-     *       //sq//'interstaff{',xinstf1,'}'//sq//'relax'
-      else 
-        write(11,'(a)')sq//'stafftopmarg0pt'//
-     *         sq//'staffbotmarg5'//sq//'Interligne'//sq//
-     *         'interstaff{10}'//sq//'relax'
-      end if
-      if (nv.eq.1) write(11,'(a)')sq//'nostartrule'
-      write(11,'(a)')sq//'readmod{'//basenameq(1:lbase)//'}'
-      if (cstuplet) then     
-        write(11,'(a)')sq//'input tuplet'
-     *    //sq//'def'//sq//'xnumt#1#2#3{'//sq//'zcharnote{#2}{~}'
-     *      //sq//'def'//sq//'tuplettxt{'//sq//'smalltype'//sq//'it{#3}'
-     *      //sq//'/'//sq//'/}}%'
-        write(11,'(a)')sq//'let'//sq//'ovbkt'//sq//'uptuplet'
-     *    //sq//'let'//sq//'unbkt'//sq//'downtuplet%'
-      end if
-      write(11,'(a)')sq//'startmuflex'//sq//'startpiece'//sq//
-     *      'addspace'//sq//'afterruleskip%'
-      return
-      end
-      character*1 function udfq(nolev,ncm)
-c
-c  Slur directions
-c
-      common /combc/ bcspec
-      logical bcspec
-        ntest = nolev-ncm
-        if (ntest.lt.0 .or.
-     *         (ntest.eq.0 .and. bcspec .and. ncm.eq.23) ) then
-          udfq = 'd'
-        else
-          udfq = 'u'
-        end if
-      return
-      end
-      character*1 function udqq(nole,ncm,isl,nvmx,ivx,nv)
-c
-c  Stem direction for single notes
-c
-      character*1 ulfq
-      character*1 udqqq
-      logical btest
-      if (btest(isl,30)) then
-c
-c  Absolute override
-c
-        if (btest(isl,17)) then
-          udqqq = 'u'
-        else
-          udqqq = 'l'
-        end if
-      else if (nvmx .eq. 1) then
-c
-c  Single voice per staff, default
-c
-        udqqq = ulfq(1.*nole,ncm)
-      else
-c
-c  Multi-voice per staff, 1st is lower, 2nd upper
-c
-        if (ivx .le. nv) then
-          udqqq = 'l'
-        else
-          udqqq = 'u'
-        end if
-      end if
-      udqq = udqqq
-      return
-      end
-      character*1 function ulfq(xnolev,ncm)
-c
-c  Stem directions
-c
-      common /combc/ bcspec
-      logical bcspec
-        test = xnolev-ncm
-        if (test.lt.-.001 .or.
-     *         (test.lt..001.and.bcspec.and.ncm.eq.23) ) then
-          ulfq = 'u'
-        else
-          ulfq = 'l'
-        end if
-      return
-      end
-      function upcaseq(chq)
-      character*1 chq,upcaseq,chax
-        if (ichar(chq).ge.61.and.ichar(chq).lt.122) then
-          upcaseq = chax(ichar(chq)-32)
-        else
-          upcaseq = chq
-          print*,'Warning, upcaseq was called with improper argument: '
-     *            //chq
-      stop
-        end if
-      return
-      end
-      subroutine wgmeter(mtrnmp,mtrdnp)
-c
-c  Writes meter stuff to file 11, so only called if islast=.true.
-c
-      character*1 sq,chax
-      if (mtrdnp .eq. 0) return
-      sq=chax(92)
-      if (mtrnmp.gt.0 .and. mtrnmp.le.9) then
-        if (mtrdnp .lt. 10) then
-          write(11,'(a25,i1,a2,i1,a3)')
-     *           sq//'generalmeter{'//sq//'meterfrac{',
-     *           mtrnmp,'}{',mtrdnp,'}}%'
-        else
-          write(11,'(a25,i1,a2,i2,a3)')
-     *           sq//'generalmeter{'//sq//'meterfrac{',
-     *           mtrnmp,'}{',mtrdnp,'}}%'
-        end if
-      else if (mtrnmp .ge. 10) then
-        if (mtrdnp .lt. 10) then
-          write(11,'(a25,i2,a2,i1,a3)')
-     *           sq//'generalmeter{'//sq//'meterfrac{',
-     *           mtrnmp,'}{',mtrdnp,'}}%'
-        else
-          write(11,'(a25,i2,a2,i2,a3)')
-     *           sq//'generalmeter{'//sq//'meterfrac{',
-     *           mtrnmp,'}{',mtrdnp,'}}%'
-        end if
-      else if (mtrnmp .lt. 0) then
-        write(11,'(a26,i1,a2,i1,a3)')
-     *           sq//'generalmeter{'//sq//'meterfracS{',
-     *           -mtrnmp,'}{',mtrdnp,'}}%'
-      else if (mtrdnp .le. 4) then
-          write(11,'(a21,i1,a2)')
-     *             sq//'generalmeter{'//sq//'meterN',mtrdnp,'}%'
-      else if (mtrdnp .eq. 5) then
-        write(11,'(a)')sq//'generalmeter'//sq//'allabreve%'
-      else if (mtrdnp .eq. 6) then
-        write(11,'(a)')sq//'generalmeter'//sq//'meterC%'
-      else if (mtrdnp .eq. 7) then
-        write(11,'(a)')sq//'generalmeter'//sq//'meterIIIS%'
-      end if
-      return
-      end
-      subroutine writemidi(jobname,ljob)
-      parameter(nm=24,mv=24576)
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      character*1 ulq,sepsymq,sq
-      logical beamon,firstgulp,figbass,figchk,isfig
-      character*1 byteq(4),char,chax
-      character*10 tempoq,instq
-      character*44 jobname
-      integer*2 mmidi
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
-     *                ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
-      common /comevent/ miditime,lasttime
-      logical mmacrec,gottempo
-      common /commmac/ mmacstrt(0:nm,20),mmacend(0:nm,20),immac,
-     *       mmactime(20),nmidsec,msecstrt(0:nm,60),msecend(0:nm,60),
-     *       mmacrec,gottempo
-      character*79 inameq
-      common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
-     *   isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
-     *   lnam(nm),inameq(nm)
-      logical rename
-      common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm)
-c
-c  Used to be icmm(0:nm); did midi fail when nv>16?
-c
-      integer*2 iinsiv,icmm(0:15)
-	character*5 versionc
-	common /comver/ versionc
-c
-c  These are not consecutive because channel 9 is reserved for percussion.
-c
-      data icmm /0,1,2,3,4,5,6,7,8,10,11,12,13,14,15,16/
-c
-c  Write Header
-c
-      write(51,'(a,$)')'MThd'//char(0)//char(0)//char(0)//char(6)
-     *  //char(0)//char(1)//char(0)//char(numchan+1)//char(0)//char(240)
-      if (debugmidi)
-     *  write(52,'(a6,10Z4)')'"MThd"',0,0,0,6,
-     *  0,1,0,numchan+1,0,240
-c
-c  Write the "conductor" track, for keys, meter, and tempos
-c  Get the number of bytes in the conductor event stream
-c
-      ndata = 1+imidi(numchan)-msecstrt(numchan,nmidsec)
-      do 15 isec = 1 , nmidsec-1
-        ndata = ndata+1+msecend(numchan,isec)-msecstrt(numchan,isec)
-15    continue
-c      ib1 = (4+ljob+26+ndata+4)/256
-c      ib0 = 4+ljob+26+ndata+4-256*ib1
-      ib1 = (4+ljob+27+ndata+4)/256
-      ib0 = 4+ljob+27+ndata+4-256*ib1
-      write(51,'(a,$)')'MTrk'//char(0)//char(0)//char(ib1)//char(ib0)
-c
-c  Text header
-c
-c     *  //char(0)//char(255)//char(1)//char(ljob+26)
-     *  //char(0)//char(255)//char(1)//char(ljob+27)
-      if (debugmidi)
-     *  write(52,'(a6,8z4)')'"MTrk"',0,0,ib1,ib0,
-     *         0,255,1,ljob+27
-      write(51,'(a,$)')jobname(1:ljob)
-      if (debugmidi) write(52,'(a)')'"'//jobname(1:ljob)//'"'
-c
-c  (separate writes are needed to defeat compiler BUG!!!)
-c
-c      write(51,'(a,$)')'.mid, produced by PMX 2.30'
-      write(51,'(a,$)')'.mid, produced by PMX '//versionc
-      if (debugmidi) write(52,'(a)')
-     *  '".mid, produced by PMX '//versionc//'"'
-c
-c  Conductor event data: Loop over sections. 
-c
-      do 16 isec = 1 , nmidsec
-        if (isec .lt. nmidsec) then
-          mend = msecend(numchan,isec)
-        else
-          mend = imidi(numchan)
-        end if
-        do 17 i = msecstrt(numchan,isec) , mend
-          write(51,'(a,$)')char(mmidi(numchan,i))
-          if (debugmidi) write(52,'(z4)')mmidi(numchan,i)
-17      continue
-16    continue
-c
-c  And close out the time sig / tempo track.
-c
-      write(51,'(a,$)')char(0)//char(255)//char(2*16+15)//char(0)
-      if (debugmidi) write(52,'(4z4)')0,255,2*16+15,0
-c
-c  Loop over track for each voice:  The following sets up iv.
-c
-      iv = nv
-      if (twoline(nv)) then
-        kv = 2
-      else
-        kv = 1
-      end if
-c
-c Moved to pmxab to allow midivel, bal, tran as functions of instrument
-c   rather than staff (iv)
-cc
-cc  Count up staves(iv,nv) vs instruments.  Store instr# for iv in iinsiv(iv)
-cc
-c      nstaves = 0
-c      ivt = 0
-c      do 12 iinst = 1 , nm
-c        nstaves = nstaves+nsperi(iinst)
-c        do 13 ivtt = 1 , nsperi(iinst)
-c          ivt = ivt+1
-c          iinsiv(ivt) = iinst
-c13      continue
-c        if (nstaves .eq. nv) go to 14
-c12    continue
-c      print*,'Screwup!'
-c      call stop1()
-c14    continue
-c
-      do 5 icm = 0 , numchan-1
-c
-c  Get the number of bytes in the data stream
-c
-        ndata = 1+imidi(icm)-msecstrt(icm,nmidsec)
-        do 11 isec = 1 , nmidsec-1
-          ndata = ndata+1+msecend(icm,isec)-msecstrt(icm,isec)
-11      continue
-c
-cc  Add 3 (for instrum) plus 4 (for closing) to byte count, 
-c  Add 3 for instrum, 4 for bal,  plus 4 (for closing) to byte count, 
-c
-c        ndata = ndata+7
-        ndata = ndata+11
-c
-c  Add 4+lnam(iinsiv(iv)) if lnam>0 ,
-c
-        if (lnam(iinsiv(iv)).gt.0) ndata = ndata+4+lnam(iinsiv(iv))
-c
-c  Separate total byte counts into 4 bytes
-c
-        do 2 ibyte = 1 , 4
-          if (ndata .gt. 0) then
-            byteq(ibyte) = char(mod(ndata,256))
-            ndata = ishft(ndata,-8)
-          else
-            byteq(ibyte) = char(0)
-          end if
-2       continue
-c
-c  Now write front stuff for this track
-c
-        write(51,'(a,$)')'MTrk'//byteq(4)//byteq(3)//byteq(2)//byteq(1)
-c     *    //char(0)//char(12*16+icmm(icm))//char(midinst(iv))
-     *    //char(0)//char(12*16+icmm(icm))//char(midinst(iinsiv(iv)))
-     *    //char(0)//char(11*16+icmm(icm))//char(10)//char(midbc(icm))
-        if (debugmidi) write(52,'(a4,z2,a7,11z4)')'icm=',icm,
-     *    ' "MTrk"',ichar(byteq(4)),ichar(byteq(3)),ichar(byteq(2)),
-c     *    ichar(byteq(1)),0,12*16+icmm(icm),midinst(iv),
-     *    ichar(byteq(1)),0,12*16+icmm(icm),midinst(iinsiv(iv)),
-     *    0,11*16+icmm(icm),10,midbc(icm)
-        if (lnam(iinsiv(iv)) .gt. 0) then
-c
-c  Add instrument name as sequence name
-c
-          write(51,'(a,$)')char(0)//char(255)//char(3)
-     *        //char(lnam(iinsiv(iv)))
-          if (debugmidi) write(52,'(4z4)')0,255,3,lnam(iinsiv(iv))
-          write(51,'(a,$)')
-     *        inameq(iinsiv(iv))(1:lnam(iinsiv(iv)))
-          if (debugmidi) write(52,'(a)')
-     *        '"'//inameq(iinsiv(iv))(1:lnam(iinsiv(iv)))//'"'
-        end if
-        write(tempoq,'(i2)')icm
-        write(instq,'(i3)')midinst(iinsiv(iv))
-        call printl('MIDI instrument '//tempoq(1:2)//' is '//instq(1:3))
-c
-c  Notes: Loop over sections. 
-c
-        do 9 isec = 1 , nmidsec
-          if (isec .lt. nmidsec) then
-            mend = msecend(icm,isec)
-          else
-            mend = imidi(icm)
-          end if
-          do 10 i = msecstrt(icm,isec) , mend
-            write(51,'(a,$)')char(mmidi(icm,i))
-            if (debugmidi) write(52,'(z4)')mmidi(icm,i)
-10        continue
-9       continue
-c
-c  Closing 4 bytes
-c
-        write(51,'(a,$)')chax(0)//char(255)//char(2*16+15)//char(0)
-        if (debugmidi) write(52,'(4z4)')0,255,2*16+15,0
-        if (kv .eq. 2) then
-          kv = 1
-        else if (iv .eq. 1) then
-          go to 5
-        else
-          iv = iv-1
-          if (twoline(iv)) kv=2 
-        end if
-5     continue
-      write(*,'(1x,a12,(10i6))')'Bytes used:',(imidi(icm),icm=0,numchan)
-      write(15,'(1x,a12,(10i6))')
-     *                          'Bytes used:',(imidi(icm),icm=0,numchan)
-      close(51)
-      if (debugmidi) close(52)
-      return
-      end
-      subroutine Writesetsign(nInstTrans,iInstTrans,iTransKey,flag)
-      parameter(nm=24)
-      integer*4 iInstTrans(nm),iTransKey(nm)
-      character*79 notexq
-      character*1 chax
-	logical flag
-c
-c  Assumes notexq is blank
-c
-      do 1 i = 1 , nInstTrans
-        notexq = chax(92)//'setsign'
-        lnote = 8
-        if (iInstTrans(i) .lt. 10) then
-          notexq = notexq(1:lnote)//chax(48+iInstTrans(i))
-          lnote = lnote+1
-        else
-          write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')
-     *         '{',iInstTrans(i),'}'
-          lnote = lnote+4
-        end if
-        if (iTransKey(i) .lt. 0) then
-          write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')
-     *          '{',iTransKey(i),'}'
-          lnote = lnote+4
-        else
-          notexq = notexq(1:lnote)//chax(48+iTransKey(i))
-          lnote = lnote+1
-        end if
-        write(11,'(a)')notexq(1:lnote)//'%'
-1     continue
-      flag = .false.
-	return
-      end
-      subroutine writflot(x,notexq,lenline)
-      character*(*) notexq
-      if (x .lt. 0.95) then
-        write(notexq(lenline+1:lenline+2),'(f2.1)')x
-        lenline = lenline+2
-      else if (x .lt. 9.95) then
-        write(notexq(lenline+1:lenline+3),'(f3.1)')x
-        lenline = lenline+3
-      else
-        write(notexq(lenline+1:lenline+4),'(f4.1)')x
-        lenline = lenline+4
-      end if
-      return
-      end
-      subroutine wsclef(iv,ninow,nclef)
-c      subroutine wsclef(iv,ninow,clefq,nclef)
-c
-c  Writes \setclef for instrument containing *staff* iv
-c    
-      parameter (nm=24)
-      common /comlast/ islast,usevshrink
-      logical islast,usevshrink
-      common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm)
-      logical rename
-c
-c In pmx271, had removed clefq, so with 2 or more staves in
-c   an instrument, had problems. So replace in 272
-c
-      common /comclefq/ clefq(nm)      
-      character*1 clefq,chax
-      character*20 temq
-      if (nclef .lt. 7) then
-        clefq(iv) = chax(48+nclef)
-      else
-        clefq(iv)='9'
-      end if
-      if (.not.islast) return
-      iv1 = 1
-      do 1 iinst = 1 , ninow
-        if (iv .lt. iv1+nspern(iinst)) go to 2
-        iv1 = iv1+nspern(iinst)
-1     continue
-      print*
-      print*,'Should not be here in wsclef!'
-      call stop1()
-2     continue
-c
-c  Here, iinst is the instrument number with staff of clef change
-c
-      iv2 = iv1+nspern(iinst)-1
-      if (iinst .lt. 10) then
-        temq = chax(92)//'setclef'//chax(48+iinst)
-        ltem = 9
-      else
-        write(temq,'(a9,i2,a1)') chax(92)//'setclef{',iinst,'}'
-        ltem = 12
-      end if
-      if (iv1 .eq. iv2) then
-c
-c  Only one staff (iv) in instrument with clef change
-c
-        write(11,'(a)')temq(1:ltem)//clefq(iv)//'%'
-      else
-        temq = temq(1:ltem)//'{'
-        ltem = ltem+1
-c
-c  Loop over staves, but clefq has only changed for one of them
-c
-        do 3 iiv = iv1 , iv2
-          temq = temq(1:ltem)//chax(48+numclef(clefq(iiv)))
-          ltem = ltem+1
-3       continue
-        write(11,'(a)')temq(1:ltem)//'}%'
-      end if
-      return
-      end
-      subroutine chkpmxlyr(lineq,iccount,lyrerr)
-      character*128 lineq
-      character*1 charq
-      lyrerr = 0
-c
-c  On entry, last char was "
-c
-18    call g1etchar(lineq,iccount,charq)
-      if (iccount .eq. 121) then
-        lyrerr = 2
-        return
-c      else if (charq.eq.'"') then
-      else if (charq.eq.'"' .and. 
-     *  .not.(lineq(iccount-1:iccount-1).eq.char(92))) then
-        call g1etchar(lineq,iccount,charq)
-c
-c  Check for raise/lower command
-c
-        if (charq .eq. '@') then
-c
-c   @  positions lyrics vertically for current voice
-c     [a,b]  above or below of the staff
-c        +/- i offset, \internotes
-c
-          call g1etchar(lineq,iccount,charq)
-          if (index('ab',charq).eq.0) then
-            lyrerr = 3
-            return
-          end if
-          call g1etchar(lineq,iccount,charq)
-          if (index('+-',charq).eq.0) then
-            lyrerr = 4
-            return
-          end if
-          call g1etchar(lineq,iccount,charq)
-          if (index('123456789',charq).eq.0) then
-            lyrerr = 5
-            return
-          end if
-        else if (charq .ne. ' ') then
-c
-c  2nd " must be followed by ' '
-c
-          lyrerr = 1
-          return
-        end if
-        return
-      end if
-      go to 18
-      end
-      subroutine dopmxlyr(lineq,iccount)
-c
-c lineq has " at iccount. Find end of lyrics string, replace "..." 
-c   with \pmxlyr{...}\, but also look for ~ in lyrics and replace with '\ll ',
-c   (unless preceded with '\'), check length
-c
-      character*128 lineq,lineqt
-      character*1 sq 
-      data sq /'\\'/
-      iend = lenstr(lineq,128)
-c
-c      i2nd = iccount+index(lineq(iccount+1:128),'"')
-c Find position of closing '"'; must bypass any \" which is used for umlaut
-c
-      i2nd = iccount+index(lineq(iccount+1:128),'"')
-2     continue
-      if (lineq(i2nd-1:i2nd-1).eq.char(92)) then
-        i2nd = i2nd+index(lineq(i2nd+1:128),'"')
-        go to 2
-      end if
-      istart = iccount
-1     itilde = istart+index(lineq(istart+1:i2nd-1),'~')
-      if (itilde.gt.istart.and.itilde.lt.i2nd) then
-c
-c  Replace tilde if not preceded by \
-c
-        if (iend .ge. 117) then
-          print*,'Sorry, lyric string is too long, stopping'
-          call stop1()
-        else if (lineq(itilde-1:itilde-1) .eq. sq) then
-          istart = itilde
-          go to 1
-        end if
-        lineqt = lineq(1:itilde-1)//sq//'lk '
-     *                             //lineq(itilde+1:iend)
-        iend = lenstr(lineqt,128)
-        i2nd = i2nd+3
-        lineq = lineqt
-        go to 1
-      end if
-      if (iccount .eq. 1) then
-        lineqt = sq//'pmxlyr{'//lineq(2:i2nd-1)//'}'//sq
-     *             //lineq(i2nd+1:128)
-      else
-        lineqt = lineq(1:iccount-1)//sq//'pmxlyr{'
-     *             //lineq(iccount+1:i2nd-1)//'}'//sq
-     *             //lineq(i2nd+1:128)
-      end if
-      i2nd = i2nd+8
-      lineq = lineqt
-      if (lineq(i2nd+1:i2nd+1) .eq. '@') then
-        lineqt = lineq(1:i2nd)//'at{'//lineq(i2nd+2:i2nd+4)//'}'//sq
-     *           //lineq(i2nd+5:128)
-        lineq = lineqt
-      end if
-      return
-      end

Deleted: trunk/Build/source/utils/pmx/pmx-src/pmx274.for.orig
===================================================================
--- trunk/Build/source/utils/pmx/pmx-src/pmx274.for.orig	2016-12-09 01:02:43 UTC (rev 42655)
+++ trunk/Build/source/utils/pmx/pmx-src/pmx274.for.orig	2016-12-09 07:17:59 UTC (rev 42656)
@@ -1,24548 +0,0 @@
-      program pmxab
-c
-c This program, PMX, developed by Don Simons
-c (dsimons at roadrunner.com), is a preprocessor for MusiXTeX. In concert with
-c MusiXTeX and TeX, its purpose is to allow the user to create high-quality
-c typeset musical scores by including a sequence of PMX commands in an ASCII
-c input file.
-c
-c This program is free software: you can redistribute it and/or modify
-c it under the terms of the GNU General Public License as published by
-c the Free Software Foundation, either version 3 of the License, or
-c (at your option) any later version.
-c 
-c This program is distributed in the hope that it will be useful,
-c but WITHOUT ANY WARRANTY; without even the implied warranty of
-c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-c GNU General Public License for more details.
-c 
-c You should have received a copy of the GNU General Public License
-c along with this program.  If not, see <http://www.gnu.org/licenses/>.
-c
-c
-      character*9 date
-	character*5 version,versionc
-	common /comver/ versionc
-c
-c To compile with gfortran:
-c   1. Merge all files using copy *.for epmx[nnnn].for
-c   2. Search and replace all character*65536 with character*131072
-c   3. Comment/uncomment getarg lines
-c   4. gfortran -O pmx[nnnn].for -o pmxab.exe
-c
-c To do
-c   Correct Rainer's email address in manual
-c   Linesplit (\\) in h
-c   Tt at start of a movement.
-c   Toggle midi on or off; allow midi only.
-c   Page number printed on 1st page even if 1 system.
-c   Still need inserted space for chordal accidentals
-c   Voicewise transposition.
-c   better segno
-c   coda
-c   duevolte
-c   Fix xtup bracket direction in 2-line staves?? (maybe leave as is)
-c   Sticky ornaments with shifts.
-c   Deal with Werner's vertical spacing thing associated with title.
-c   Multiple ties in midi
-c   Werner's missing c in MIDI due to start/stop ties on same note.
-c   Beams with single 64ths
-c   128ths and/or dotted 64ths
-c   Close out MIDI with integral # of beats?
-c   Increase ast dimensions or redo logic.
-c   Does slur direction get set for user-defined single-note stem dir'ns?
-c   Transpose by sections.
-c   Optimization loop over sections only
-c   Command-line option to read nbarss in. Write out nbarss when optimizing.
-c     (or just read from .plg?)
-c   Beams over bar lines.
-c   2-digit figures
-c   A real coule (slanted line between notes in a chord)
-c   Dotted slurs for grace notes.
-c   Undotted chord notes with dotted main note.
-c   Forced line break without line number
-c   Fix dot moving when 2nds in chord get flipped
-c   To do: increase length on notexq in dodyn
-c 2.74
-c   For staff-crossing beamed xtuplet chords, if 2nd segment of a joined beam
-c     starts with a blank rest, put '\sk' into the TeX. 
-c     To enable high-to-both beamed etup staff-crossing chord, for blank
-c     rest at start of forced beam, shift \sk's from before to after \ib..;
-c     so \ib is at start and note in upper voice has a beam to connect to.
-c   Expand range of vertical xtup number shift, now stored in mult(16-22) 
-c   Check for and allow \" within lyrics strings, for umlauts.
-c 2.73 (160121)
-c   Dirk's "..." command, to convert "text" into \pmxlyr{text}\ and insert as
-c     inline TeX. Replace all '~' inside "..." and not preceded with '\', by 
-c     '\lk '. Right after 2nd ", replace @[a,b][+,-]n with \at{[a,b][+,-]n}\
-c     Include definitions of \ly and \at in pmx.tex (2 Feb 16). After first ",
-c     add (as type 2 string) '\\input musixlyr \'
-c   After inputting pathname, change any '\' to '/', for Linux compatibility.
-c 2.72 (160110)
-c   Really finalize \mbrest...go back to 3 args to deal with clef changes.
-c   Fine tune centered whole bar rests to deal with clef changes
-c   Fix bug in wsclef when >1 staff per instrument, since \setclef
-c     needs to know instrument and specify clefs on all staves for that
-c     instrument. Ones that were not changed by user will not be printed,
-c     and will be kept the same as before.
-c   Fix bug with arpegii from one voice to another in same staff.
-c 2.71 (151226)
-c   Finalize mbrest mods
-c 2.705
-c   Fix error message
-c 2.704 (140614) 
-c   Octave treble clef
-c   Make horizontal ornament shift (ornhshft) floating
-c 2.703 (140323)
-c   Option v[-]n at end of any figure will alter figdrop for rest of system
-c 2.702
-c   Stem slurs. Only for ps, assume no other pos'n adjustments. Option "v"
-c 2.701
-c   oC = coda (\code{10})
-c     Move iornq(29) (blank barline) to ipl(0) (changes in pmxb, getnote)
-c   oG = new seqno
-c   To do: fix grace note spacing problem (partially done)
-c 2.622
-c   Redefine midtc(..) and miditran(..); clean up all transpositions/key changes
-c   Kn[+/-...] \ignorenats at signature changes
-c   Fix tie checks in doslur() and dopsslur() to subtract iTransAmt from nolevs
-c     before checking and setting pitch levels levson() and levsoff()
-c   Define midisig separately from isig. Put in common commidisig.
-c     Use for explicit midi signature and for accid corrections to midi piches
-c     in addmidi.
-c 2.621
-c   Make keyboard rest option work in xtuplets. Created subroutine
-c     chkkbdrests, modified make2bar to include calls to chkkbdrests as rqd.
-c 2.620
-c   Allow user-defined rest height tweaks at start of beam.
-c 2.619
-c   At movement break, change \nbinstruments in \newmovement macro; add
-c     3rd arg to \newmovement in pmx.tex; modify pmxb.for and getnote.for
-c     to remove call to newnoi and change call to \newmovement
-c 2.618
-c   Add option Ac[l,4] to set vert and horiz size and offsets to properly
-c     center page for letter or a4 paper.
-c 2.617
-c   In g1etnote, change if-check for note to use index(...) instead
-c     of ichar(charq) since it was messing up gfortran optimizer
-c   After pmxa, search for and remove penultimate line <blank><blank>/
-c     because it was screwing up linux-compiled versions
-c   Bugfix: Increase dimension of kicrd from 7 to 10 in crdaccs(...)
-c 2.616 (111110)
-c   Allow hairpins to span multiple notes groups (gulps).
-c 2.615+ (110810)
-c   Fix midi when some instruments are transposed, by subtracting
-c     iTransAmt(instno(iv)) from pitch values sent to via addmidi in
-c     make2bar.for (for main notes) and docrd (for chord notes)
-c 2.615 (110725)
-c   Fig bug with size-setting (in topfile) when instrument has >1 staves 
-c 2.615 (110724)
-c   Make AS[0|-|s|t]... really set sizes
-c 2.614
-c   Mod notex.for to fix Terry's bug with raised dotted rests (caused 
-c     by double-hboxing). 
-c 2.613
-c   Bugfix: In pmxa, change "do while" limit to keep from overwriting instno.
-c 2.612
-c   Enhance AS to allow s or t for smallsize or tinysize
-c 2.611
-c   Error trap for "D" before any notes in a block.
-c 2.610
-c   Instrument-wise key changes and transposition (incomplete)
-c 2.603
-c   101211 In getpmxmod.for, decreased nline by 2 to fix locating errors 
-c     following reading in an include file.
-c   101121 Added some error messages in g1etset.for setup data 
-c 2.602
-c   Correct slur indexing in linebreakslurs. 
-c   Account for comment lines in line count for error messages
-c 2.601
-c   Bug fix: allow 24 slurs with graces
-c 2.60 Changes made make it really big
-c   increase mv (size of midi) ? Note: MIDI can't have >16 voices w/o 
-c     major reprogramming, and 16 may also be a problem (icmm)
-c   nm=24 (voices) done
-c   24 slurs done
-c   24 simultaneous beams (Replace index 24 by 0, so get 0-23)
-c   bufq*131072 (gfortran only)
-c   getarg syntax (gfortran only)
-c 2.523+
-c   Fix voice numbering for normal dynamics and text dynamics
-c 2.523
-c   Version of bigpmx first posted to Hiroaki's web site.
-c 2.522
-c   5/26/10 Replace ipl bits 0-7 with ipl2, add new common for it.
-c   With 2.521+ as starting version, incorporate bigpmx mods to allow 24 voices.
-c   5/13/10 Fix log2 function
-c   5/15/10 Fix bitwise storage for dynamics, fix segnoo string length. 
-c 2.521+
-c   091025 Enable dotting 2nd part of linebreak slur or tie.
-c   To adjust barno height due to linebreak slur, use \bnrs instead of
-c     explicitly redefining \raisebarno (pmxb) 
-c 2.521
-c   Bugfix
-c 2.520
-c   090519 Enable ligfonts (special figured bass characters)
-c 2.519
-c   Fix another bug which kept \sk from being output so misaligned some notes.
-c 2.518
-c   Fix bugs: referencing fig data, char declaration for member of 
-c      common/comfig/
-c 2.517
-c   Allow figures in voice 1 + any one other.
-c 2.516
-c   Allow figures in voice #2
-c 2.515+ to do: Change manual and activate rule against clef change in voice #2.
-c 2.515
-c   071222 Changes in getnote to allow auto forced beams to start anywhere.
-c   071206 In make2bar, shift fermataup7 to left over centered pause.
-c   070901 In doslur, check for nolev <=2 in case slur ends on rest in 2-line
-c       staff (it was screwing up vertical justification).
-c   n34 for tweaks to midi durations of quarter note septuplets.
-c   To do: In ref250.tex, the tables where 's,t,)' is explained, the line
-c       [+,- i]   ... Vertical adjustment of the start of second segment
-c     should it be replaced by
-c       [s +,- i]   ... Vertical adjustment of the start of second segment
-c 2.514
-c   Changes in make2bar to get horizontal spacing right when normal grace
-c     follows after grace
-c   Changes in dograce to get octaves right for any material entered inside
-c     \gaft, which shields transpose register changes from the outside world.
-c 2.513
-c   In make1bar, near end, for forced beams starting with a rest, copy hgt and
-c     slope tweaks to ALL notes after first, not just the second one, so if
-c     there's more than one rest at start the tweaks are still observed.
-c   In beamid and beamend, add stand-alone triply-flagged notes for xtups.
-c 2.512
-c   Near end of pmxb, fix error trap to allow redundant 'RD'
-c   Enable multiplicity down-up '][' within xtup.
-c 2.511
-c   Introduce eskz2 for xtup #'s and bracket lengths, to remove bug caused by 
-c     adjusteskz as in bar 7 of barsant.
-c 2.510a
-c   Test: remove restriction on tempo changes in MIDI macros
-c     Send to CM for beta testing.
-c 2.509+
-c   To do: Correct manual on AS. "-" is for smaller staves.
-c 2.510
-c   Forgot to declare litq, voltxtq as character in subroutine getgrace
-c 2.509
-c   Corrected small bug in arpeggio shifting (ivx <= iv in call putarp)
-c 2.508
-c   Allow graces in xtups. New subroutine getgrace. 
-c 2.507
-c   To do: Raise/lower figures.
-c   To do: Add 24, 29 to list of musicsizes in manual
-c   New sub adjusteskz to account for ask's when computing lengths of
-c     brackets for unbeamed xtups, slopes and horizontal posn's of number 
-c   Bug fix: in beamn1, beamid, and beamend, allow unbeamed xtups w/ 2 flags
-c   Add look-left option for keyboard rests, "L" in rest command, set iornq(30)
-c 2.506
-c   Fix bug with AK, when simultaneous rests have same duration, use defaults.
-c 2.505
-c   Keyboard rests AK
-c 2.504
-c   Space after normal grace: option X[n]
-c   Fixed og when nv .ne. noinst, by using sepsymq instead of '&'
-c   (To do) length of xtup bracket when there is added non-collision space.
-c   Trap musicsize if .ne. 16,20,24,29.
-c 2.503
-c   Enable arpeggio left shift with ?-x
-c   To do: In manual, arpeggio over 2 staves.
-c   Allow musicsize of 24 and 29. Had to define meter font size explicitly,
-c     also change font size for text dynamics, but not much else so far.
-c   Bugfix in beamstrt, introduced in 2415, ip was changed before putxtn
-c     was called, causing error in printing replacement number.
-c 2.502
-c   Incorporate Dirk Laurie's patch to use { , } , for ties.
-c   Figure height adjustment: append +[n]
-c   Change ec font stuff in pmx.tex per Olivier Vogel's comment (CM email?)
-c 2.501
-c   Readjust horizontal offset back to .8 in LineBreakTies
-c   Fix zero-subscript (iudorn) in putorn
-c 2.50
-c   Increase number of text-dynamics (dimension of txtdynq) per block 
-c     from 12 to 41.
-c   Slur option n to override altered default curvature.
-c   Allow default ps slur curvature tweaks with Ap+/-c
-c 2.416
-c   Increase length of textdynq from 24 to 128
-c   (Todo) Add comment in manual about blank lines at end.
-c   Configuration file: Define subroutine getpmxmod, check path in environment
-c     variable pmxmoddir, check existence, read lines into bufq after setup. 
-c   Increase dimension on idynn in dodyn from 4 to 10 for max number 
-c     of marks in a bar
-c   Increase allowable # of lines from 2000 to 4000.
-c   (To do) Replace definition of \liftpausc per Olivier.
-c   (To do) Fix extraneous error message if RD is placed at very end.
-c 2.415
-c   Fix "AT" option: replace putxtn,topfile,beamstrt,beamid to use \xnumt
-c     instead of redefining \xnum. Change font used to \smallfont (as for
-c     normal xtups,
-c   Allow slur to start on rest.
-c 2.414
-c   Correct bug in crdacc when adding accidental to boundary causes number of
-c     segments to decrease
-c   Special rule for 3-accidental chords: If no 2nds, place them in order
-c     top, bottom, middle.
-c 2.413
-c   Correct bugs in chordal accidentals, related to left-shifted noteheads
-c     (a) Special problems with downstem when main note needs shifting
-c     (b) Assign 0 rank to boundary segs due to left-shifted noteheads
-c 2.412
-c   Change default horiz shift of start of seg 2 of linebreak slurs:
-c     -.7 for slurs, -1.2 for ties,
-c   Use height of start of seg 1 slur itself for end of 1 and start of 2.
-c 2.411
-c   "Apl" activates special treatment of linebreak slur/tie's; breaks all in 2.
-c   "s" option in start of slur/tie as precursor to vert/horiz tweaks for end
-c      of seg 1. of linebreak slur/tie, 2nd "s" for start of seg2.
-c   With "Apl", curvature adjustments on starting slur command apply to seg 1, 
-c      those on ending command to seg 2.
-c 2.410
-c   "AT" to allow Col. S.'s tuplet option. Simply input tuplet.tex and redefine
-c      \xnum, \unbkt, \ovbkt. 
-c   "s" option in main xtup input after "x": slope tweak for bracket. mult(4) is
-c      flag, mult(5-9) is tweak value+16
-c 2.409
-c   Bugfix in docrd for MIDI: Use original pitch in case main/chord were
-c     switched due to 2nds.
-c   Remove "o" from error message for "A" command.
-c   New syntax: optional instrument number separator ":" in movement 
-c     break command to precede a 2-digit instrument. 
-c   Conditional output formats for \setname at movement break to allow 
-c     instrument numbers >9.
-c   Bugfix in coding to raise barno due to slur over line break (pmxb)
-c   Move date/version data statement in pmxab to a better place.
-c 2.408
-c   Allow pnotes{x} when x>9.995 (mod is only to format stmt in make2bar).
-c   Bug fix in \liftPAusep in notex.for and in pmx.tex
-c   Character variables for version and date
-c   For up-stem single graces slurred to down-stem, shift slur start left by 
-c     0.8 so slur doesn't get too short.
-c   Initialize and slide mult, same as other full-program variables in /all/.
-c 2.407
-c   Allow AN[n]"[partname]" to be parsed by scor2prt as filename for part n,
-c 2.406
-c   Alter PMX: put \dnstrut into \znotes in \starteq (for system spacing
-c     equalization).
-c   Put dimensions of double sharps and flats in crdacc (for chords).
-c   Bugfix: Use sepsymq in LineBreakTies(..) instead of '&'
-c   Use only first 4 bits of mult for multiplicity+8, so rest can be used
-c     for other stuff.
-c   Move stemlength stuff in nacc(27-30) to mult(27-30) to remove conflict.
-c 2.405: Not published but saved for safety.
-c   Option Aph to write \special{header=psslurs.pro} top of each page, so
-c     dviselec will work OK.
-c 2.404
-c   Allow slur to end on rest, but not start on a rest.  Efaults height 
-c     of ending is default height of start (before any automatic or user-
-c     defined djustments). User may adjust height as normal from default.
-c 2.403
-c   Bugfix: turn off repeated beaming patterns.at end of non-last voice.
-c 2.402
-c   Automatic repeated forced beams.  Start with "[:"  End with next explicit 
-c     forced beam or end of input block.
-c   Increase # of forced beams per line of music per input block from 20 to 40
-c 2.401
-c   Optional K-Postscript Linebreak Ties, Apl. New subroutine LineBreakTies.
-c     Makes 1st part normal shape, and starts 2nd part a little further left.
-c   Enable arpeggios in xtuplets.  Had to make time itar(narp) a real.
-c 2.40
-c   Set up WrotePsslurDefaults (logical) so only write defaults on 1st Ap.
-c   Fix non-ps-slur input to \midslur (third signed integer). Do not reverse
-c     sign for down-slurs.
-c 2.359
-c   Add error exit subroutine stop1 to make exit status g77-compatible..
-c   Absolute octave on xtup chord note was 2 octave too high, fixed in getnote
-c   Fermata on vertically shifted rest: special trap in putorn() to set height.
-c   Correct multiple grace note spacing for small staves (in dograce, 
-c        define wheadpt1 depending on staff size)
-c 2.358
-c   Allow curvature corrections at start of postscript slur, in dopsslur()
-c   Local slur options p[+|-][s|t] for [nos|s]luradjust,[not|t]ieadjust
-c   Options for [Nos|S]luradjust,[Not|T]ieadjust,[noh|h]alfties: Ap[+|-][s|t|h]
-c   Make t[ID] act like s[ID]t, most mods in spsslur().
-c   Add spsslur() to read in data for ps slurs, call from getnote.
-c   In beamstrt, save args for SetupB in common comipb to save them for 
-c      2nd call when xtup starts with rest
-c   Add spacing for ornament ")" as if it were accidental, in make2bar().
-c   Horiz shift start and end of ps ties, dep. on stem dir'n, in dopsslur()
-c   Horiz. shift start of ps grace slur, 2 places in dograce().
-c   Horiz shift end of grace slur in endslur()
-c   Make st slurs into postscript ties.  Separate subroutine dopsslur(),    
-c   Non-beamed xtup: "a" in 1st note or rest, before "x" (sets drawbm=.false.)
-c   Allow two D"x" on same note. Introduced jtxtdyn1 in dodyn.
-c 2.357a
-c   Fix missing "end" in backfill.com, too-long lines in g1etnote, getnote
-c 2.357
-c   Increase dimension for # of lit TeX strings from 52 to 83.
-c   Allow blank rest in middle of xtuplet. Only mods in g*etnote().
-c 2.356
-c   Increased some dimensions from 30 to 40 to allow up to 40 pages.
-c   In unbeamed xtups, "n" did not suppress bracket.  Fixed in beamstrt().
-c   Fix parsing of "f,h,H,HH" in sslur.
-c   Fix bug with cdot, note-level for slur termination (in getnote)
-c 2.355
-c   Midi transposition:  IT[+|-][n1][+|-][n2]...[+|-][n(noinst)], 
-c      n=# of half-steps.  Restrict to mult. of 12 now, to avoid key-sig issues
-c   Make midi recognize ps ties in doslur.
-c   Correct ttieforsl so that it eats 2nd argument properly, using \zcharnote 
-c      to get octave right.
-c 2.354
-c   With postscript slurs, make t-slurs real ties by inserting replacement 
-c     macros \tieforisu, etc, defined in pmx.tex
-c   Check for open cresc or decresc at end of input block, using list[de]cresc
-c   Hairpin syntax conditional on postscript slurs. Backup to fill in start 
-c     level, using new backfill(...).  Separate height tweaks for 
-c     start and finish.
-c 2.353
-c   K-0+n to transpose by half step (rather than just change key)
-c   Allow "rm[n]" when nv>1.  Require it in all parts. Just write a stack of 
-c     \mbrest's
-c   Enable "Rz"; define \setzalaligne in pmx.tex. Special treatment at end
-c     of input block before movement break, and at start of block after 
-c     movement break, using \newmovement rather than \setzalaligne, since
-c     former already redefines \stoppiece. In second case, set rptfg2='z'.
-c   Make clefq(nm) common between pmxb and getnote; change references in 
-c     getnote at 'M' to array elements, setting all new clefs as you go.
-c 2.352
-c   Remove \parskip redefinition from pmx.tex; write it into TeX file when
-c     "Ae" is invoked.
-c   Ap to activate postscript slurs. Add macro \psforts to pmx.tex to redefine 
-c     \tslur in case \midslur was used.  Allow slur inputs 'f','h','H','HH',
-c     translate them thru mapping to (1,4,5,6) as \midslur params, then let
-c     \psforts translate them back to ps slur macors.
-c 2.351
-c   Number slurs from 0 up instead of 11 down, anticipating postscript slurs.
-c   Write "\eightrm" instead of "\cmr8" for \figfont with small baseline size.
-c   Increase length of basenameq to 44 characters everywhere.
-c   Increase dimension of mcpitch (midi-chord-pitch) to 20.
-c   Set default systems per page to 1 if nv>7
-c   In pmxb, move place where isystpg is reset to 0, so that \eject gets
-c     written when there is just one system per page.
-c 2.35
-c   Cautionary accidentals with 'c' anywhere in note symbol.
-c   NEW pmx.tex with \resetsize to set size to normal or small depending on 
-c     current \internote.  Used with new coding in dograce() to get right
-c     new size in case user has \setsize'ed some lines to \smallvalue. For
-c     \smallvalue-sized staves, redefine \tinynotesize to give 11-pt font. 
-c     Affects pmx.tex.
-c   Continuation figure with fractional length. May now mix with other figures.
-c     If another figure follow Cont-fig, separate with colon.   
-c 2.342
-c   Bugfix in getnote to recognize relative octave shift in grace at start of  
-c     input block.
-c   In make2bar, initialize islhgt=0 earlier than before (possible solution
-c     to Suse g77 compile problem that I could not reproduce)..
-c   Bugfix in beamstrt & beamn1 for r2x6 c4D d d d
-c 2.341
-c   Syntax check: Forced page break page number must be > than previous.
-c   Bugfix: Define ivx when "sliding down" breath/caesure data in pmxb.
-c 2.34
-c   New pmx.tex with redefined liftpausc
-c   Bug fix with dotted, non-beamed xtups.
-c 2.332
-c   Fix bugs in horizonal shifts, spacing, for accid's, graces, noteheads.
-c   Allow arbitrary pos. input to W in g1etnote and getnote.
-c 2.331
-c   Bug-fix in dodyn(..): typo on length of arg of txtdyn
-c 2.33
-c   Caesura (oc), breath (ob).  Set iornq(28), store rest of data in ibcdata()
-c 2.321
-c   Rescale accidental shifts. Still use 7 bits but now map (0,127) 
-c      onto (-1.,5.35)
-c   Fix ihornb bug in dodyn, seen with dynamics on lower-voice non-beamed xtups
-c 2.32 (Noticed after posting)
-c   Prohibit "/" as figure.
-c 2.32 (Posted)
-c   Tidied up accidentals in chords, do spacing.
-c   Still to do: 
-c       check for "(" on chord notes in spacing algo
-c       small accids
-c       double accids
-c       autoshift slurs
-c 2.310
-c   Extra call to precrd ahead of spacing chk, and single-note crd/acc
-c      shifts seem OK, but not multiple.  crd/acc shifts not recorded 1st time. 
-c 2.309
-c   Alternate algo for accid shifts in chords.
-c 2.308
-c   Auto horiz. notehead shifting added to precrd. 
-c 2.307
-c   Auto shifting of multiple accidentals in chords.
-c   "Ao" in main chord note to keep accidentals in order. Set nacc(28).
-c   If there are any manual main or chord note shifts, then
-c      If any manual shift is preceded by "A" then
-c         1. Auto-shifting proceeds
-c         2. "A"-shifts add to autoshifts
-c         3. non-"A" shifts are ignored!
-c      Else (>0 man shifts, none has "A")
-c         No auto-ordering, No autoshifts, 
-c      End if
-c   End if 
-c 2.306
-c   Initialize legacy note level to middle C in case user forgets to set 
-c     octave.
-c   Shift xtup note?
-c   Shift in elemskips rather than noteheads?
-c 2.305
-c   Stop pmxb from multiple endvolta's at start of new page.
-c 2.304
-c   "Sx" in a note means shorten stemlength by x \internotes.  "Sx:" turn on
-c       for multiple notes in the voice, "S:" last shortened note.
-c 2.303
-c   vshrink stuff all OK? Description is in pmxb.  
-c 2.302
-c   Toggle vshrink with "Av". vshrink normally kicks in when \interstaff 
-c     hits 20. This still needs work.
-c   Add " /" to last line if last char is not % or /.
-c 2.301
-c   Check in beamn1 for single note before multiplicity down-up.
-c   allow '.PMX' as well as '.pmx'
-c 2.299
-c   Correct typo in pmxb involving PMXbarnotrue.
-c   Replacement printed number for xtup: Unsigned integer after 'n' after 'x'
-c   Minor upgrade parsing xtuplet options 'x...'
-c   Correct dimension of nxtinbm in make2bar.
-c 2.298
-c   Account for doubled xtup notes in subroutine getx (user-defined spaces), 
-c     by adding ndoub as an argument..
-c 2.297
-c   Created and solved compiler problem.  Put drawbm(NM) in its own common.
-c   Add new def'ns [\a|PA]usc, \lift[pa|PA]usc to pmx.tex, use them in make2bar
-c     when \centerbar is used.
-c   Modify \mbrest & \CenterBar in pmx.tex to use \volta at endcor etc.  Have PMX
-c     use right 2nd and 3rd args for \mbrest when key, meter, or clef changes.
-c 2.296
-c   Correct printed numbers for forced beams with multiple xtups. For each beam
-c     make list in setupb by voice of eloff (h-offset) and mtupv (printed #)
-c   Increase lengths of jobname and infileq by 20 characters
-c   Enable whole notes and breves as 1st or last note of xtup in beamn1 and
-c     beamend, and wholes in beamid.
-c 2.295
-c   Midi balance Ib[n1]:[n2]:...[nn]
-c   Single-slope beam groups [...]-[...]
-c   Trap "i" unless after accidental (main notes, xtups, chord notes)
-c 2.294
-c   Unequal xtups with "D" to double a note in an xtup.
-c   As above, "F" will (a) increase multiplicity by 1 for marked note and next
-c     one and (b) add a dot to the first one. 
-c   Fix bug with e.g. c84 [ .d e.f ] by checking whether forced beam is on 
-c     when "." is encountered, then correcting beam start time.(end of getnote)
-c   MIDI velocity (volume) set: Iv[n1]:[n2]:[n3]...
-c 2.293
-c   Check for single notes spanning bar lines.
-c   Correct various bugs with staff-jumping beams. (1) for 2nd segment, vxtup 
-c     must be set in make2bar since beamstrt is not called, fixing problem with
-c     dot at end. (2) add ivjb2 to flag which voice has 2nd segment and fix 
-c     problem when >2 staves.
-c   Add nodur to args of dodyn, so can check if stemless and avoid height tweak
-c   Correct bug in getdyn setting flag in idynda2(0) for manual horiz. tweak
-c 2.292a
-c   Undo syntax check for Type 2 or 3 TeX string starting in column 1. 
-c     Meanwhile, Werner's problem with a mid-line Type 3 string has gone away?! 
-c 2.292
-c   Allow comments in xtuplets
-c   Enable multiple octave jumps in grace notes.
-c   Allow dynamics in xtuplets.
-c   Fix bug in getdyn searching for end of text string (correct length of lineq
-c     to 128)
-c   Fix bug in dodyn, must ignore horiz. interaction tweak for 
-c     user-text (idno = 0)
-c   Syntax check for Type 2 or 3 TeX string starting in column 1 
-c     (NOTE: later undone!)
-c   Syntax check for page number > npages at forced line break.
-c 2.291
-c   Fix error in AS command (accid spacing for small systems), making only
-c     one spec per staff, nv total.
-c   Stop using MIDI channel 10
-c 2.29
-c   Fix error in console output format for # of bytes used in MIDI file.
-c   Fix bug in dograce so no space is added between grace and main note when
-c       there is a MIDI-only accidental.
-c   Fix bug so oes?+4 works.  It was too ugly to explain. 
-c     ...Different ways of storing accidental specs on input and output.
-c   No longer zap \writezbarno in special situations.
-c   Fix bug in dyntxt level on rest
-c   Line spacing equalization.  Add macros \starteq, \endeq, \spread, etc.
-c     Activate with Ae.  (Maybe later could input alternate values for
-c     \upamt, \dnamt, \parskip).  Put \starteq on 1st note in voice 1 
-c     in the page, and \endeq on 1st note of next-to-last line in page.
-c 2.28
-c   Flip direction of forced beam "[f..."
-c   Fix beam numbering for staff jumping beams. Uses irest(23,24,29,30) 
-c   Fix bug in sliding ip's for txtdyn's
-c   In dyn's allow vert. offsets +/-64, horiz +/-25.6 (store in idnyda2(1-99)
-c 2.27
-c   Comment out lines in dodyn checking number of dynamic marks found.  Voice
-c     order may not be monotonic if two lines on a staff.
-c   Literal dynamic: D"[text]"
-c 2.26
-c   Allow hairpin start-stop on same note by disabling auto-tweaks in dodyn,
-c     increasing dimension of idynn to 4 to allow 4 symbols on same note.
-c   Increase voltxtq length from 10 to 20.
-c   AS[-/0][-/0]...  to inform PMX that "-" voices are small, and rough 
-c      accounting for ast's is done by defining effective headwidth 
-c      whead1 in makebar2 to be 0.8*whead.  
-c 2.25
-c   Fix logic bug with sepsym's when # of instruments changes.
-c   Slight increases in default offsets for hairpin starts after "p"
-c 2.24
-c   Hairpins D< or D> as toggle.
-c   Many automatic position tweaks for letter-group dynamics and hairpins.
-c 2.23
-c   Continued rhythmic shortcuts: space followed by "." or ","
-c 2.22
-c   In call to doslur, change tno(...) to tnote(...).  This was only
-c     used when checking to slurs per stem directions, and should have been
-c     the note duration all along.
-c   MIDI-only accidental, bit 17 in nacc, or 27 in icrdat. 
-c       Use "i" anywhere in note symbol.
-c 2.21
-c   Increase from 20 to 30 dimensions for movement breaks and midi sections.
-c   Fix out-of-order declarations per mutex comments
-c   Add "Bad error" and "Kluging" messages to log file.
-c 2.197
-c   add /comips/ to save tie-check midi variables
-c   For spacing of clef changes at start of input block, changed integer time
-c     lastnodur to prevtn, so it works with xtups. Possible incompatibility!
-c 2.196
-c   Fix Ickbug with time check in ncmid()
-c   Interchange \fermataup7 and \pausec to get proper alignment
-c   Enable French violin clef "f",  number 7 in PMX, but 9 in MusiXTeX.
-c   Add defn's of \hsp, \hspp to pmx.tex 
-c   Fix pre-slurs on xtup chord notes.
-c   Fixed raised PAuse, define \liftPAuse
-c   Replace \zbreve\sk with \breve.
-c   Made "1" work as mtrdenl by doubling it and mtrnuml.  BUT WAIT...what 
-c     about "o" and 1 as shorthand for 16???? Search for "Kluge"
-c   Added "vo" (voice) as MIDI instrument 55 
-c   Allow 3-digit page numbers (search for "toppageno")
-c   Fix bug caused by prior fix (cancelling accid after bar line was ignored).
-c   Fix double accids in chords
-c 2.194
-c   Fix bug with accid/tie/barline/chord in addmidi by restructuring accid if 
-c     block.
-c   Add meter to MIDI file with every pause
-c   Purify FORTRAN?
-c 2.193
-c   Increased # of in-line TeX strings from 36 to 52.
-c   Fix entry of # of bytes in header of tempo/meter/key track to allow >255.
-c 2.191
-c   Event track: Tempos, meters, keys all together.  Data in comevent
-c 2.15
-c   Pretty good midi capability.  Still no attention to slurs on chord notes.
-c 2.11
-c   11 Dec 99 c   rm1
-c   11 Dec 99 "oes?", "oe?"
-c   11 Dec 99 Cancel slur horizontal tweaks with non-stemmed notes
-c   11 Dec 99 Error message for shifted, repeated ornaments.
-c 2.10 (Version 2.1)
-c   Fix bug with lowdot and xtuplets
-c 2.09
-c   Fix bug with multiple ornament heights over beams, when one is . or _
-c   Error message from pmxa if rest on last note of xtup.
-c   Enable 12 slurs.
-c   Reinstate multiple rests at start of xtup.
-c 2.07
-c   Combine consecutive type-1 TeX strings.
-c   \midslur and \curve as 3rd signed digit in slur termination, + 2 opt.int's.
-c   Fixed breve chord notes in docrd
-c   Check irest(28) as well as vxtup when setting nodur for chord notes, since
-c     vxtup isn't set until 1st *main* note in xtup
-c   Vectorize nolev1, slope, ixrest.  Klug fix for xtups with variable spacing.
-c 2.06+
-c   Make deterministic the beam slope calculation when there are an even # of
-c     slopes in list and middle two are equal magnitude but opposite sign.
-c   pmxa Trap for "o:" before 1st note in block
-c   Partial bug fix for 64th notes in xtuplets.
-c   Make ixrest a vector, since with new time scheme may not finish xtup in
-c     same notes block.
-c   Increase max # of pages from 20 to 30 (dimensions of nsystp,..., in pmxb)
-c 2.06
-c   Account for changes in nv when computing \interstaff. Add a counter 
-c     nistaff(iflb) = # of interstaff spaces per system = nv-1.  Set whenever
-c     setting isysflb(iflb). Note nv can only change at a forced line break.  
-c     Note also, iflb starts at 0!
-c 2.05
-c   Automatic start of new notes group with part 2 of staff-jump beam
-c     In make1bar, set irest bit 29 of lowest-voice note at same time,
-c     use as flag when making notes groups.
-c   For now, remove dummy blank line at end...it zaps terminal repeats.
-c 2.02
-c   Fixed slur-counting bug for multiple, slurred, aftergraces.
-c 2.01
-c  Increase to ask(1400)
-c  Increase max forced page breaks to 18
-c  Define pausc for centered pause
-c 2.0a
-c  Insert dummy blank line at very end to handle input files w/o terminal CR-LF
-c pmx03r
-c   Option m[n] in S symbol to change musicsize (for parts)
-c   Double dotted rests now work.
-c   Write file name to log file
-c   Check existence of input file
-c   Allow 24-char jobname, may end with ".pmx"
-c   Comment out time stuff
-c   Replace 3-argument getarg with 2-argument + iargc
-c   Fix bug with negative noinst due to nint<=int replacement
-c   move lovation of iv in isdat1 to allow iv>7.
-c   Set nm=12 
-c pmx03q
-c   replace int(x+.001) with nint(x)
-c   Write TeX file name to screen and to pml.
-c   Replace char(...) with chax(...) to sovle msdev bug.
-c   Bug fix: macro terminations when M is on a line by itself.
-c   Bug fix: don't accumulate space for XS in pmxa.
-c   Streamline Macros: use pointers to bufq instead of scratch files
-c pmx03p
-c   Store input file in single character array bufq. 
-c     lbuf(i)*2 is length of line i
-c     ipbuf is position just before next line to be read.
-c pmx03
-c   Optimize read/writes
-c pmx02
-c   Fix line count (for errors) when there are saved macros
-c pmx01
-c   In optimize mode, open/close macros (Watch out for residual zz files!)
-c   Command line input
-c   Option Ao to optimize, otherwise normal processing
-c
-ccccccc
-      parameter (nks=125,nm=24,mv=24576,maxblks=4000)
-      character*128 lnholdq
-      character*65536 bufq
-      integer*2 lbuf(maxblks)
-      common /comevent/ miditime,lasttime
-      logical slmon,dbltie
-      common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm),
-     *       naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl,
-     *       slmon(0:nm),dbltie
-      integer*2 mmidi
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
-     *                ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
-      integer*2 iinsiv
-      common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
-      common /commus/ musize,whead20
-      integer*4 nbars0(nks),nbars(nks),ipoe(nks),nbari(nks)
-      real*4 poe0(nks),poe(nks)
-      logical isfirst,optimize
-      logical*4 fexist
-      character*44 jobname
-      character*47 infileq
-      common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm),
-     *   nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount,
-     *   idum,itsofar(nm),nib(nm,15),nn(nm),
-     *   rest(nm,200),lenbr0,lenbr1,firstline,newmeter
-      logical rest,firstline,newmeter
-      common /comdiag/ n69(0:nm),n34(0:nm)
-      logical mmacrec,gottempo
-      common /commmac/ mmacstrt(0:nm,20),mmacend(0:nm,20),immac,
-     *       mmactime(20),nmidsec,msecstrt(0:nm,60),msecend(0:nm,60),
-     *       mmacrec,gottempo
-      common /truelinecount/ linewcom(20000)
-c
-c Added 130302 only to get nsperi from g1etnote, for use in midi setup
-c
-      common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
-     *     fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
-      logical lastchar,fbon,issegno,isheadr,isvolt
-c
-c  immac(i) is the index of i-th macro, i=1,nmac.  Also make a list containing
-c   nmidsec  section starts and stops based on PLAYING macros (not recording).
-c 
-ccccccccccccccccccccccccc
-c
-	data date /'20 Feb 16'/
-	data version /'2.74'/
-c
-ccccccccccccccccccccccccc
-      data maxit,ncalls /200,0/
-      data isfirst /.true./
-c      itstart = mytime()
-      versionc = version
-c
-c  Initialize midi parameters
-c
-      gottempo = .false.
-      ismidi = .false.
-      debugmidi = .false.
-      relacc = .false.
-      mmacrec = .false.
-      nmidsec = 1
-      mgap = 10
-      miditime = 0
-      lasttime = 0
-      nmidcrd = 0
-      nusebl = 0
-      notmain = .false.
-      do 3 ivx = 1 , nm
-        twoline(ivx) = .false.
-        midinst(ivx) = 6
-        midivel(ivx) = 127
-        midibal(ivx) = 64
-        miditran(ivx) = 0
-3     continue
-      do 12 icm = 0 , nm
-        imidi(icm) = 0
-        restpend(icm) = .false.
-        trest(icm) = 0.
-        levson(icm) = 0
-        levsoff(icm) = 0
-        slmon(icm) = .false.
-        naccbl(icm) = 0
-        n69(icm) = 0
-        n34(icm) = 0
-        msecstrt(icm,1) = 1
-12    continue
-c
-c  End of midi parameter initialization
-c
-      musize = 0
-      optimize = .false.
-      numargs = iargc()
-      if (numargs .eq. 0) then
-        print*,'You could have entered a jobname on the command line,'
-        print*,'      but you may enter one now:'
-        read(*,'(a)')jobname
-        numargs = 1
-      else 
-c        call getarg(1,jobname,idum) ! May need to replace this w/ next line 
-        call getarg(1,jobname) 
-      end if
-10    ljob = lenstr(jobname,44)
-      if (ljob .gt. 44) then
-        print*,'Jobname is too long. Try again.'
-        call stop1()
-      else if (ljob .eq. 0) then
-        print*,'No was jobname entered. Try again.'
-        call stop1()
-      else if (numargs .eq. 2) then
-        if (ljob.eq.2 .and. jobname(1:2).eq.'-o') then
-          optimize = .true.
-c          call getarg(2,jobname,idum) ! May need to replace this w/ next line 
-          call getarg(2,jobname) 
-          numargs = 1 
-          go to 10
-        else
-          print*,'Illegal option on command line'
-          call stop1()
-        end if
-      end if
-c
-c  Strip ".pmx" if necessary
-c
-      ndxpmx = max(index(jobname,'.pmx'),index(jobname,'.PMX'))
-      if (ndxpmx .gt. 0) then
-        jobname = jobname(1:ndxpmx-1)
-        ljob = ljob-4
-      end if
-c
-c  Check for existence of input file
-c
-      infileq = jobname(1:ljob)//'.pmx'
-      inquire(file=infileq,EXIST=fexist)
-      if (.not.fexist) then
-        inquire(file=jobname(1:ljob)//'.PMX',EXIST=fexist)
-        if (.not.fexist) then
-          print*,'Cannot find file '//infileq
-          call stop1()
-        else
-         infileq = jobname(1:ljob)//'.PMX'
-        end if      
-      end if
-c
-c  Open a log file
-c
-      open(15,file=jobname(1:ljob)//'.pml')
-      call printl('This is PMX, Version '//version//', '//date)
-      ljob4 = ljob
-      call printl('Opening '//infileq)
-      open(18,file=infileq)
-c
-c  Copy input file into common buffer 
-c
-      ipbuf = 0
-      linewcom(1) = 1
-      do 8 ilbuf = 1 , maxblks
-        ncomments = 0
-14      read(18,'(a)',end=9)lnholdq
-        lbuf(ilbuf) = lenstr(lnholdq,128)
-        if (lbuf(ilbuf) .eq. 0) then
-c
-c  Blank line.  Make it a single blank with length 1
-c
-          lbuf(ilbuf) = 1
-          lnholdq = ' '
-        end if
-c
-c  Now line has at least one non blank character. Check for comment
-c  As of Version 260, do not copy comments into bufq
-c  But need to count %'s for error messaging
-c        if (lnholdq(1:1).eq.'%') go to 14           
-        if (lnholdq(1:1).eq.'%') then
-          ncomments = ncomments+1
-          go to 14           
-        end if
-c
-c  When here, have counted all preceding comments and have a real line
-c
-        if (ilbuf .gt. 1) then
-          linewcom(ilbuf) = linewcom(ilbuf-1)+1+ncomments
-        else
-          linewcom(1) = 1+ncomments
-        end if
-        if (ipbuf+lbuf(ilbuf).gt.65536) then
-          print*,'Too many characters in file, stopping'
-          call stop1()
-        end if
-        bufq(ipbuf+1:ipbuf+lbuf(ilbuf)) = lnholdq
-        ipbuf = ipbuf+lbuf(ilbuf)
-8     continue
-      call printl('Too many lines in input file')
-      call stop1()
-9     continue
-c
-c  Insert dummy line to handle input files w/o CR-LF at end.
-c
-      nlbuf = ilbuf-1
-c      nlbuf = ilbuf
-c      bufq(ipbuf+1:ipbuf+3) = ' / '
-c      lbuf(nlbuf) = 3
-      close(18)
-      do 6 numit = 1 , maxit
-        if (optimize) call printl('Starting an iteration')
-c
-c  When isfirst=.true., pmxa() generates linebreaks normally, output in nbars0.
-c    Otherwise, nbars0 is the input
-c  When islast=.false., pmxb only returns poe's, otherwise does whole job
-c
-        call pmxa(jobname,ljob4,isfirst,nsyst,nbars0,optimize)
-        if (.not.optimize) then
-          if (ismidi) then
-c
-c  This was moved here from writemidi 130302 to allow midivel,bal,tran, to be
-c    set up here as functions of instrument rather than iv (staff).
-c  Count up staves(iv,nv) vs instruments.  Store instr# for iv in iinsiv(iv)
-c
-            nstaves = 0
-            ivt = 0
-            do 16 iinst = 1 , nm
-              nstaves = nstaves+nsperi(iinst)
-              do 17 ivtt = 1 , nsperi(iinst)
-                ivt = ivt+1
-                iinsiv(ivt) = iinst
-17            continue
-              if (nstaves .eq. nv) go to 18
-16          continue
-            print*,'Screwup!'
-            call stop1()
-18          continue
-c
-c  Set up channel numbers for midi. 
-c
-            numchan = 0
-            do 11 iv = nv , 1 , -1
-              if (twoline(iv)) then
-                midchan(iv,2) = numchan
-                numchan = numchan+1
-              end if
-              midchan(iv,1) = numchan
-              numchan = numchan+1
-11          continue
-c
-c  numchan will now be the number of channels, but max channel # is numchan-1
-c
-c  Set up velocities, balances, and midi-transpositions
-c
-            do 13 iv = nv , 1 , -1
-              if (twoline(iv)) then
-c  130302 Make these functions of instrument rather than staff (iv)
-c                midvelc(midchan(iv,2)) = midivel(iv)
-c                midbc(midchan(iv,2)) = midibal(iv)
-c                midtc(midchan(iv,2)) = miditran(iv)
-                midvelc(midchan(iv,2)) = midivel(iinsiv(iv))
-                midbc(midchan(iv,2)) = midibal(iinsiv(iv))
-                midtc(midchan(iv,2)) = miditran(iinsiv(iv))
-              end if
-c              midvelc(midchan(iv,1)) = midivel(iv)
-c              midbc(midchan(iv,1)) = midibal(iv)
-c              midtc(midchan(iv,1)) = miditran(iv)
-              midvelc(midchan(iv,1)) = midivel(iinsiv(iv))
-              midbc(midchan(iv,1)) = midibal(iinsiv(iv))
-              midtc(midchan(iv,1)) = miditran(iinsiv(iv))
-13          continue
-          end if
-c
-c  TEMPORARY!!!
-c
-      write(15,*)'nlbuf: ',nlbuf
-      ip1 = 1
-      do 10000 ilb = 1 , nlbuf
-c        write(15,'(2i5,a40,3i5)')ilb,lbuf(ilb),
-c     *     bufq(ip1:ip1+lbuf(ilb)-1),
-c     *     (ichar(bufq(ip1+lbuf(ilb)-k:ip1+lbuf(ilb)-k)),
-c     *      k=min(3,lbuf(ilb)),1,-1)
-        ip1 = ip1+lbuf(ilb)
-10000 continue
-      iplast = ip1-1
-c
-c  Check to see if (1) last line is "<blank><blank>/" and (2) next to last
-c    line is "/"
-c
-c      print*,'iplast:',iplast
-c      print*,'Last line:'
-c      print*,bufq(iplast+1-lbuf(nlbuf):iplast)
-c      print*,'Last char of next to last line:'
-c      print*,bufq(iplast-lbuf(nlbuf):iplast-lbuf(nlbuf))
-      if (bufq(iplast+1-lbuf(nlbuf):iplast) .eq. '  /') then
-        if (bufq(iplast-lbuf(nlbuf):iplast-lbuf(nlbuf)).eq.'/') then
-          print*,'Removing last line of "<blank><blank>/"'
-          write(15,*)'Removing last line of "<blank><blank>/"'
-          nlbuf = nlbuf-1
-        end if
-      end if
-c
-          call pmxb(.true.,poe0,ncalls,optimize)
-          if (ismidi) then
-c
-c  Write midi file
-c
-            open(51,file=jobname(1:ljob)//'.mid')
-            if (debugmidi) open(52,file=jobname(1:ljob)//'.dbm')
-            call printl(' ')
-            call printl('Writing '//jobname(1:ljob)//'.mid')
-            call writemidi(jobname,ljob)
-          end if
-          close(15)
-          stop
-        end if
-      write(15,*)'nlbuf: ',nlbuf
-      ip1 = 1
-        call pmxb(.false.,poe0,ncalls,optimize)
-        call poestats(nsyst,poe0,poebar0,devnorm0)
-c
-c  Save initial deviation and line breaks for later comparison
-c
-        if (numit .eq. 1) then
-          devpmx = devnorm0
-          do 20 isys = 1 , nsyst 
-            nbari(isys) = nbars0(isys)
-20        continue
-        end if
-        call sortpoe(nsyst,poe0,ipoe)
-        do 1 iupord = nsyst , 1 , -1
-          isysu = ipoe(iupord)
-          print*,'isysu=',isysu
-          write(15,*)'isysu=',isysu
-c
-c  Skip if system isysu has poe0 < avg or isysd has poe0 > avg
-c
-          if (poe0(isysu).lt.poebar0) go to 1
-          do 5 idnord = 1 , nsyst
-            isysd = ipoe(idnord)
-            if (isysu.eq.isysd .or. nbars0(isysd).eq.1
-     *                     .or. poe0(isysd).gt.poebar0) go to 5
-            do 2 isyst = 1 , nsyst
-              nbars(isyst) = nbars0(isyst)
-              if (isyst .eq. isysu) then
-                nbars(isyst) = nbars(isyst)+1
-              else if (isyst .eq. isysd) then
-                nbars(isyst) = nbars(isyst)-1
-              end if
-2           continue
-            call pmxa(jobname,ljob4,isfirst,nsyst,nbars,optimize)
-            call pmxb(.false.,poe,ncalls,optimize)
-            call poestats(nsyst,poe,poebar,devnorm)
-            if (devnorm .lt. devnorm0) then
-              devnorm0 = devnorm
-              poebar0 = poebar
-              do 4 isys = 1 , nsyst
-                nbars0(isys) = nbars(isys)
-                poe0(isys) = poe(isys)
-4             continue
-              print*,'Improved with iup,idown,devnorm:',
-     *                 isysu,isysd,devnorm0
-              write(15,*)'Improved with iup,idown,devnorm:',
-     *                 isysu,isysd,devnorm0
-              write(*,'(5x,20i3)')(nbars0(isys),isys=1,nsyst)
-              write(15,'(5x,20i3)')(nbars0(isys),isys=1,nsyst)
-              call sortpoe(nsyst,poe0,ipoe)
-              go to 6
-            end if
-5         continue
-1       continue
-c
-c  If we get here, must have gone thru all switches and found nothing better,
-c  so done!
-c
-        go to 7
-6     continue
-7     continue
-      print*,'Optimum located, numit:',numit,',  ncalls:',ncalls
-      write(15,*)'Optimum located, numit:',numit,',  ncalls:',ncalls
-      print*,'Final error:',devnorm0,', initial error:',devpmx
-      write(15,*)'Final error:',devnorm0,', initial error:',devpmx
-      print*,'Percentage improvement:',100.*(1-devnorm0/devpmx)
-      write(15,*)'Percentage improvement:',100.*(1-devnorm0/devpmx)
-      call printl('Initial bars/system:')
-      write(*,'(5x,20i3)')(nbari(isys),isys=1,nsyst)
-      write(15,'(5x,20i3)')(nbari(isys),isys=1,nsyst)
-      call printl('Final bars/system:')
-      write(*,'(5x,20i3)')(nbars0(isys),isys=1,nsyst)
-      write(15,'(5x,20i3)')(nbars0(isys),isys=1,nsyst)
-      call pmxa(jobname,ljob4,.false.,nsyst,nbars0,optimize)
-      call pmxb(.true.,poe0,ncalls,optimize)
-c      itend = mytime()
-c      print*,'Elapsed time in ms:',itend-itstart
-c      write(15,*)'Elapsed time in ms:',itend-itstart
-      close(15)
-      end
-      subroutine accsym(nacc,acsymq,lacc)
-      character*3 acsymq
-      iacc = iand(nacc,7)
-      if (iacc .eq. 1) then
-        acsymq = 'fl'
-        lacc = 2
-      else if (iacc .eq. 2) then
-        acsymq = 'sh'
-        lacc = 2
-      else if (iacc .eq. 3) then
-        acsymq = 'na'
-        lacc = 2
-      else if (iacc .eq. 5) then
-        acsymq = 'dfl'
-        lacc = 3
-      else if (iacc .eq. 6) then
-        acsymq = 'dsh'
-        lacc = 3
-      else
-        print*,'bad accidental: ',iacc
-      end if
-      return
-      end
-      subroutine addask(taskn,waskn,elaskn,
-     *                  fixednew,scaldold,tglp1,isudsp)
-      parameter (nm=24)
-      logical isudsp
-      common /comas1/ naskb,task(40),wask(40),elask(40)
-      common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
-      common /comtol/ tol
-      if (isudsp) then
-c
-c  Find which udsp we're dealing with
-c
-        do 1 iudsp = 1 , nudsp
-          if (abs(taskn+tglp1-tudsp(iudsp)) .lt. tol) go to 2
-1       continue
-        print*,'You should note BEEE here in addask!'
-        call stop1()
-2       continue
-c
-c  Fixednew and scaldold must not be changed, since udsp's are already included
-c  in fsyst from pmxa, and udsp don't involve scaled space..
-c
-        if (naskb.gt.0 .and. abs(taskn-task(max(1,naskb))).lt.tol) then
-c
-c  Must add user-defined space to what's there already.
-c
-          wask(naskb) = wask(naskb)+udsp(iudsp)
-        else
-c
-c  This place has no other space.
-c
-          naskb = naskb+1
-          task(naskb) = taskn
-          wask(naskb) = udsp(iudsp)
-          elask(naskb) = 0.
-        end if
-      else
-c 130330 start
-      oldwask = 0.
-      oldelask = 0.
-c 130330 end
-c
-c  This is a normal space, no effect if smaller than existing space
-c
-        if (naskb.gt.0 .and. abs(taskn-task(max(1,naskb))).lt.tol) then
-c
-c  We already put in some space at this time
-c  Check if new one needs more space than old one at same time
-c
-          if (waskn .gt. wask(naskb)) then
-c
-c 130330 We were double counting the larger space when it came 2nd
-c Need to fix but don't see how yet. Assume times came in order and 
-c that last naskb defined spaces that need updating
-c            
-            oldwask = wask(naskb)
-            oldelask = elask(naskb)
-c End of 130330 insertions
-            naskb = naskb-1
-          else
-            return
-          end if
-        end if
-        naskb = naskb+1
-        task(naskb) = taskn
-        wask(naskb) = waskn
-        elask(naskb) = elaskn
-c 130330 start
-c        fixednew = fixednew+waskn
-c        scaldold = scaldold+elaskn
-        fixednew = fixednew+waskn-oldwask
-        scaldold = scaldold+elaskn-oldelask
-c 130330 end
-      end if
-      return
-      end
-      subroutine addblank(noteq,lnoten)
-      character*8 noteq
-      character*1 tchar
-      tchar = noteq(1:1)
-      noteq = ' '//tchar
-      lnoten = 2
-      return
-      end
-      subroutine addfb(nfb,iv,tnew,t1fb,t2fb,ulfbq,ifbadd)
-      parameter (nm=24)
-      integer nfb(nm)
-      common /comtol/ tol
-      real*4 t1fb(nm,20),t2fb(nm,20)
-      character*1 ulfbq(nm,20)
-      ifbadd = 1
-      nfb(iv) = nfb(iv)+1
-      do 1 ifb = nfb(iv)-1 , 1 , -1
-        if (tnew .lt. t1fb(iv,ifb)-tol) then
-          t1fb(iv,ifb+1) = t1fb(iv,ifb)
-          t2fb(iv,ifb+1) = t2fb(iv,ifb)
-          ulfbq(iv,ifb+1) = ulfbq(iv,ifb)
-        else
-          ifbadd = ifb+1
-          go to 2
-        end if
-1     continue
-2     continue
-      t1fb(iv,ifbadd) = tnew
-      ulfbq(iv,ifbadd) = 'x'
-      return
-      end
-      subroutine addmidi(icm,nolev,iacc,midisig,time,rest,endrest)
-c      subroutine addmidi(icm,nolev,iacc,isig,time,rest,endrest)
-      parameter(nm=24,mv=24576)
-      integer*2 mmidi,itk(25)
-      integer*4 itiesav(5,100)
-      character*1 notenumq
-      logical endrest,eximacc,it1found
-      logical rest
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
-     *                ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
-      integer*2 iinsiv
-      logical slmon,dbltie
-      common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm),
-     *       naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl,
-     *       slmon(0:nm),dbltie
-      common /comevent/ miditime,lasttime
-      common /comdiag/ n69(0:nm),n34(0:nm)
-c      common /commidisig/ midisig(nm)
-c
-c  Following variables are local but must be saved.  I hope they are.
-c  (3/18/00) With g77 they are not, so add a common block here.
-c
-c      integer*2 ipslon(0:nm),lusebl(10),jusebl(10),icmm(0:12)
-      integer*2 ipslon(0:nm),lusebl(10),jusebl(10),icmm(0:15)
-      common /comips/ ipslon,lusebl,jusebl
-c      data icmm /0,1,2,3,4,5,6,7,8,10,11,12,13/
-      data icmm /0,1,2,3,4,5,6,7,8,10,11,12,13,14,15,16/
-c
-c  Cancel out barline accidentals if there's a rest.
-c
-      if (rest) naccbl(icm) = 0
-c
-c  Special path to insert dummy rest at end of a section
-c
-      if (endrest) go to 20
-c
-      do 7 ion = 0 , nmidcrd
-c
-c  check if this is only to get pitch of a chord note
-c
-        if (notmain) go to 6
-c
-c  check for rest
-c
-        if (rest) then
-c
-c  Will not put in a note, but must update timing
-c
-          if (.not.restpend(icm)) then
-c
-c  First rest in sequence, save the time
-c
-            restpend(icm) = .true.
-            trest(icm) = time
-          else 
-            trest(icm) = trest(icm)+time
-          end if
-c
-c  Note: code checkers don't like the above due to calling addmidi(trest(icm))
-c    but this only happens if rest at end of section (endrest=.true.) (called
-c    from getmidi(), in which case these above lines are bypassed.
-c
-          call chkimidi(icm)
-          return
-        end if
-c
-c  time tics
-c
-        if (imidi(icm).gt.0 .and. ion.eq.0) then
-          idur = mgap
-        else
-          idur = 0
-        end if
-        if (restpend(icm)) then
-          restpend(icm) = .false.
-          idur = idur+nint(15*trest(icm))
-        end if
-c
-c  time to start of note
-c
-        idurvar = isetvarlen(idur,nby2on)
-        if (nby2on .gt. 4) then
-          print*,'You got >4 bytes, something is bogus.'
-          call stop1()
-        end if
-        imidi(icm) = imidi(icm)+1
-        do 2 i = 1 , nby2on
-c
-c  imidi points to cell before highest (leftmost) byte.  Start with lowest byte 
-c    at far right, fill in backwards
-c
-          mmidi(icm,imidi(icm)+nby2on-i) = mod(idurvar,256)
-          if (nby2on .gt. 1) idurvar = idurvar/256
-2       continue
-        imidi(icm) = imidi(icm)+nby2on-1
-c
-c  Note-on signal
-c  
-        imidi(icm) = imidi(icm)+1
-c        mmidi(icm,imidi(icm)) = 9*16+icm
-        mmidi(icm,imidi(icm)) = 9*16+icmm(icm)
-c
-c  Entry point for chord note pitch determination
-c
-6       continue
-c
-c  Get midi pitch.  On chord iteration, only do this first time (main note),
-c  since pitch was already computed for nonmain chord notes.
-c
-        if (ion .eq. 0) then
-          ipsav = nolev*12./7+11
-          ipsav0 = ipsav
-          if (midisig .ne. 0) then
-c
-c  Adjust for signature 
-c
-            notenumq = char(48+mod(nolev,7))
-            if (midisig.ge.index('4152630',notenumq)) then
-              ipsav = ipsav+1
-            else if (-midisig.ge.index('0362514',notenumq)) then
-              ipsav = ipsav-1
-            end if
-          end if
-c
-c  Deal with accidentals.  
-c
-c  iacc   0   1   2   3   4   5   6   7
-c effect  X   fl  sh  na  X  dfl dsh  X
-c iashft  X   -1  1   0   X  -2   2   X
-c
-          jacc = 0
-          eximacc = .false.
-          if (iacc .gt. 0) then
-c
-c  Adjust key-sig-adjusted pitch for explicit accidental (and exit)
-c
-            jacc = iashft(iacc)
-            eximacc = .true.
-            if (.not.relacc) jacc = jacc+ipsav0-ipsav
-c		   
-c  (Above) Shift applies to diatonic pitch but will be added to adjusted one
-c
-          else if (naccim(icm) .gt. 0) then
-c
-c  Possible implicit accidental from earlier in the bar
-c    Check for prior accid in this bar at this note level
-c
-            do 3 kacc = 1 , naccim(icm)
-              if (laccim(icm,kacc) .eq. nolev) then
-                jacc = jaccim(icm,kacc)
-                eximacc = .true.
-                if (.not.relacc) jacc = jacc+ipsav0-ipsav
-                go to 4
-              end if
-3           continue
-4           continue
-          end if
-c
-c  Must split off the following if block from those above because chord
-c  notes can cause naccim>0, forcing us to miss other chord note's
-c  accross-bar-line accidental
-c
-          if (naccbl(icm).gt.0 .and. .not.eximacc) then
-c
-c  Possible carryover accid from prior bar (or prior same-pitch note).    
-c
-            do 21 kacc = 1 , naccbl(icm)
-              if (laccbl(icm,kacc) .eq. nolev) then
-                jacc = jaccbl(icm,kacc)
-c
-c  Since we are *using* the bar-line accid, must flag it to be saved for next.
-c 
-                nusebl = nusebl+1
-                jusebl(nusebl) = jacc
-                lusebl(nusebl) = nolev
-                if (.not.relacc) jacc = jacc+ipsav0-ipsav
-                go to 22
-              end if
-21          continue
-22          continue
-          end if
-          ipsav = ipsav+jacc
-        end if
-        if (notmain) then
-          mcpitch(nmidcrd) = ipsav
-c
-c  Save pitch for tie checks
-c
-          if (levson(icm).eq.nolev.and..not.slmon(icm)) 
-     *           ipslon(icm) = ipsav
-        else 
-          imidi(icm) = imidi(icm)+1
-          if (ion.eq.0) then
-            mmidi(icm,imidi(icm)) = ipsav
-            if (levson(icm).eq.nolev.and..not.slmon(icm)) 
-     *           ipslon(icm) = ipsav
-          else
-            mmidi(icm,imidi(icm)) = mcpitch(ion)
-          end if
-        end if
-        if (ion .eq. 0) then
-c
-c  Only record accids for non-chords, main chord note during chord iteration
-c    and chordnotes on first call but not during iteration
-c
-          if (iacc.gt.0) then
-c
-c  Set marker for accidental for possible continuations later this bar
-c    but first check and clear earlier ones on same note. 
-c
-            do 23 kacc = 1 , naccim(icm)
-              if (laccim(icm,kacc) .eq. nolev) then
-                do 24 macc = kacc , naccim(icm)-1
-                  laccim(icm,macc) = laccim(icm,macc+1)
-                  jaccim(icm,macc) = jaccim(icm,macc+1)
-24              continue
-                go to 25
-              end if
-23          continue
-            go to 26
-25          continue
-            naccim(icm) = naccim(icm)-1
-26          continue
-c
-c  Flag new accidental
-c
-            naccim(icm) = naccim(icm)+1
-            laccim(icm,naccim(icm)) = nolev
-            jaccim(icm,naccim(icm)) = iashft(iacc)
-          end if
-c
-c  Bail if this is a chord note on the first call (from docrd)
-c
-          if (notmain) then
-            call chkimidi(icm)
-		  return
-          end if
-        end if
-c
-c  Vel
-c
-        imidi(icm) = imidi(icm)+1
-c        mmidi(icm,imidi(icm)) = 127
-        mmidi(icm,imidi(icm)) = midvelc(icm)
-        call chkimidi(icm)
-7     continue
-c
-c  For tie checks
-c
-      if (levson(icm).gt.0.and..not.slmon(icm)) imidso(icm) = imidi(icm)
-c
-c  Entry point for special rests at section ends (endrest=T)
-c
-20    continue
-c
-c  Now insert all the ends
-c
-      do 8 ioff = 0 , nmidcrd
-        if (ioff .eq. 0) then
-c
-c  time to end
-c
-          idur1 = nint(15*time)    
-          if (.not.endrest .or. miditime.eq.nint(15*trest(icm))) then 
-            idur = idur1-mgap
-          else
-            idur = idur1
-          end if
-c
-c  Deal with roundoff problems with 7-tuplets on half or quarters
-c
-          if (idur1 .eq. 69) then
-            n69(icm) = n69(icm)+1
-c            if (mod(n69(icm)+6,7) .gt. 3) idur = 58
-            if (mod(n69(icm)+6,7) .gt. 3) idur = idur1-mgap-1
-          else if (idur1 .eq. 34) then
-            n34(icm) = n34(icm)+1
-            if (mod(n34(icm)+6,7) .gt. 4) idur = idur1-mgap+1
-          end if
-          idurvar = isetvarlen(idur,nby2off)
-          if (nby2off .gt. 4) then
-            print*,'You got >4 bytes, something is bogus.'
-            call stop1()
-          end if
-          imidi(icm) = imidi(icm)+1
-          call chkimidi(icm)
-          do 1 i = 1 , nby2off
-            mmidi(icm,imidi(icm)+nby2off-i) = mod(idurvar,256)
-            if (nby2off .gt. 1) idurvar = idurvar/256
-1         continue
-          imidi(icm) = imidi(icm)+nby2off-1
-        else
-c
-c  Inserting end of chord note, delta time is 0
-c
-          imidi(icm) = imidi(icm)+1
-          mmidi(icm,imidi(icm)) = 0
-        end if
-c
-c  Note off
-c
-        imidi(icm) = imidi(icm)+1
-c        mmidi(icm,imidi(icm)) = 8*16+icm
-        mmidi(icm,imidi(icm)) = 8*16+icmm(icm)
-c
-c  Pitch
-c
-        imidi(icm) = imidi(icm)+1
-        if (ioff .eq. 0) then
-          mmidi(icm,imidi(icm)) = ipsav
-        else
-          mmidi(icm,imidi(icm)) = mcpitch(ioff)
-        end if
-c
-c  Vel
-c
-        imidi(icm) = imidi(icm)+1
-        mmidi(icm,imidi(icm)) = 0
-        call chkimidi(icm)
-        if (endrest) then
-          return
-        end if
-c
-c      print*,'Off, icm,imidi,ipsav,idur:',icm,imidi(icm),ipsav,time
-c
-8     continue
-      naccbl(icm) = nusebl
-      if (nusebl .gt. 0) then
-c
-c  Fix tables of "bar-line" accids that are saved due to consecutive notes.
-c
-        do 30 kacc = 1 , nusebl
-          laccbl(icm,kacc) = lusebl(kacc)
-          jaccbl(icm,kacc) = jusebl(kacc)
-30      continue 
-        nusebl = 0
-      end if
-c
-c  Begin tie checks
-c
-      if (slmon(icm)) then
-c
-c  Prior note had a slur start
-c
-        if (levson(icm).eq.levsoff(icm) .and. iacc.eq.0) then
-c
-c  We have a tie! (Assumed there would be no accidental on tie-ending note)
-c  Make a list of times of all events back to the one starting at imidso+1, 
-c    which is at or before where the tie started.  Ident tie start and stop by
-c    comparing pitches.  Save the 4 pieces of data in itiesav(1...4,nsav4tie)
-c    Store actual time in itiesav(5,nsav4tie), using itiesav(1,1) as initial 
-c    time.
-          nsav4tie = 0
-          imidt = imidso(icm)
-10        nsav4tie = nsav4tie+1
-          itiesav(1,nsav4tie) = igetvarlen(mmidi,icm,imidt,nbytes)
-          imidt = imidt+nbytes
-          do 11 j = 1 , 3
-            itiesav(j+1,nsav4tie) = mmidi(icm,imidt+j)
-11        continue
-          imidt = imidt+3
-          if (nsav4tie .eq. 1) then
-            itiesav(5,1) = itiesav(1,1)
-          else
-            itiesav(5,nsav4tie) = itiesav(1,nsav4tie)+
-     *                              itiesav(5,nsav4tie-1)
-          end if
-          if (imidt .ne. imidi(icm)) go to 10
-c
-c  Find which two pitches agree with saved slur pitch.
-c
-          it1found = .false.
-          do 12 it2 = 1 , nsav4tie
-            if (itiesav(3,it2) .eq. ipslon(icm)) then
-              if (it1found) go to 13
-              it1 = it2
-              it1found = .true.
-            end if
-12        continue
-          call printl(
-     *          'Program error, tied notes, send source to Dr. Don')
-          it1 = nsav4tie+1
-          it2 = nsav4tie+1
-13        continue
-c
-c  List the positions we want to keep
-c
-          jsav = 0
-          do 14 isav = 1 , nsav4tie
-            if (isav.eq.it1 .or. isav.eq.it2) go to 14
-            jsav = jsav+1
-            itk(jsav) = isav
-14        continue
-          nsav4tie = nsav4tie-2
-c
-c  Now dump events it1 & it2, recompute times, restack mmidi.         
-c
-          imidi(icm) = imidso(icm)
-          do 15 isav = 1 ,nsav4tie
-            if (isav .eq. 1) then
-              idurvar = isetvarlen(itiesav(5,itk(isav)),nbytes)
-            else
-              idurvar = isetvarlen(itiesav(5,itk(isav))-
-     *                             itiesav(5,itk(isav-1)),nbytes)
-            end if
-            imidi(icm) = imidi(icm)+1
-            do 16 i = 1 , nbytes
-              mmidi(icm,imidi(icm)+nbytes-i) = mod(idurvar,256)
-              if (nbytes .gt. 1) idurvar = idurvar/256
-16          continue
-            imidi(icm) = imidi(icm)+nbytes-1
-            do 17 i = 2 , 4
-              imidi(icm) = imidi(icm)+1
-              mmidi(icm,imidi(icm)) = itiesav(i,itk(isav))
-17          continue
-15        continue
-        end if
-        slmon(icm) = .false.
-        levsoff(icm) = 0
-        if (.not.dbltie) levson(icm) = 0
-      end if
-      if (levson(icm).gt.0) slmon(icm) = .true.
-      if (nmidcrd .gt. 0) nmidcrd = 0
-      call chkimidi(icm)
-      return
-      end
-      subroutine addstr(notexq,lnote,soutq,lsout)
-      common /comlast/ islast,usevshrink
-      logical islast,usevshrink
-        character*(*) notexq
-        character*80 soutq
-        if (lsout+lnote .gt. 72) then
-          if (islast) write(11,'(a)')soutq(1:lsout)//'%'
-          lsout = 0
-        end if
-        if (lsout .gt. 0) then
-          soutq = soutq(1:lsout)//notexq(1:lnote)
-        else
-          soutq = notexq(1:lnote)
-        end if
-        lsout = lsout+lnote
-      return
-      end
-      subroutine adjusteskz(ib,istart,poenom)
-c
-c  For block ib, this adds accidental spaces to eskz, for use in getting
-c  length of xtup bracket and slopes of brackets and beams.
-c
-      parameter (nm=24)
-      common /comas1/ naskb,task(40),wask(40),elask(40)
-      integer*4 istart(80)
-      common /comnsp/ space(80),nb,prevtn(nm),
-     *    flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm)
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      character*1 ulq,sepsymq,sq
-      logical beamon,firstgulp,figbass,figchk,isfig
-      common /comeskz2/ eskz2(nm,200)
-      common /comtol/ tol
-      common /comntot/ ntot
-      inmin = istart(ib)+1
-      do 10 iaskb = 1 , naskb
-        if (task(iaskb) .lt. to(istart(ib))-tol) go to 10
-        eskadd = wask(iaskb)/poenom-elask(iaskb) 
-        do 11 in = inmin , ntot 
-          if (to(in) .gt. task(iaskb)-tol) then
-            eskz2(ivxo(in),ipo(in)) = eskz2(ivxo(in),ipo(in))+eskadd
-            if (abs(to(in)-task(iaskb)).lt. tol) inmin=inmin-1
-          else
-            inmin = inmin+1
-          end if
-11      continue
-10    continue
-      return
-      end
-      subroutine askfig(pathnameq,lpath,basenameq,lbase,figbass,istype0)
-      logical figbass,ispoi,topmods,istype0,done,isbbm
-      common /comhsp/ hpttot(176)
-      common /compoi/ ispoi
-      common /combbm/ isbbm
-      common /comas3/ ask(2500),iask,topmods
-      character*40 pathnameq
-      character*44 basenameq
-      character*1 sq,chax
-      character*129 outq
-      sq = chax(92)
-      open(12,file=pathnameq(1:lpath)//basenameq(1:lbase)//'.tex')
-c
-c  Transfer first 5 lines of main internal TeX file
-c
-      do 11 il = 1 , 5
-        call moveln(11,12,done)
-11    continue
-      if (istype0) then
-c
-c  Transfer literal TeX stuff from special scratch file
-c
-        rewind(17)
-10      call moveln(17,12,done)
-        if (.not.done) go to 10
-        close(17)
-      end if
-c
-c  Transfer next 2 lines from main scratch file
-c
-      do 3 il = 1 , 2
-        call moveln(11,12,done)
-3     continue
-      if (ispoi) write(12,'(a)')sq//'input musixpoi'
-      if (isbbm) write(12,'(a)')sq//'input musixbbm'
-      if (figbass) then
-c
-c  Transfer .fig data from scratch (unit 14) into external .tex (unit 12)
-c
-4       call moveln(14,12,done)
-        if (.not.done) go to 4
-        close(14)
-      end if
-      iask = 0
-      ihs = 0
-1     read(11,'(a129)',end=999)outq
-c
-c  Hardspaces.
-c
-      if (outq(1:5) .eq. sq//'xard') then
-        ihs = ihs+1
-        outq(2:2) = 'h'
-        write(outq(12:15),'(f4.1)')hpttot(ihs)
-        lenout = 19
-        go to 9
-      end if
-c
-c  This part hard-wires ask's into new .tex file as ast's
-c
-2     indxask = index(outq,sq//'ask')
-      if (indxask .ne. 0) then
-        iask = iask+1
-        call putast(ask(iask),indxask,outq)
-        go to 2
-      end if
-      lenout = llen(outq,129)
-9     continue
-      write(12,'(a)')outq(1:lenout)
-c
-c  If this is the line with "readmod", check for topmods.
-c
-      if (topmods .and. outq(2:8).eq.'readmod') then
-        topmods = .false.
-        rewind(16)
-        do 7 il = 1 , 1000
-          read(16,'(a129)',end=8)outq
-          lenout = llen(outq,129)
-c
-c  We inserted the '%' in subroutine littex, to guarantee including blank.
-c
-          write(12,'(a)')outq(1:lenout)
-7       continue
-8       continue
-        close(16)
-      end if
-      go to 1
-999   close(11)
-      close(12)
-      return
-      end
-      subroutine backfill(iunit,oldq,lenold,newq,lennew)
-c
-c  In iunit, looks backward for oldq, overwrites newq
-c  Safest if both are same length!
-c
-      character*128 lineq(200),nowq
-	character*(*) oldq,newq
-      linesback = 0
-1     continue
-      backspace(iunit)
-	read(iunit,'(a)')nowq
-	ndx = index(nowq,oldq(1:lenold))
-c
-c  Save the line just read
-c
-      linesback = linesback+1
-	lineq(linesback) = nowq
-      if (ndx .eq. 0) then
-        backspace(iunit)
-	  go to 1
-	end if
-c
-c  If here, it's replacement time.
-c
-      lineq(linesback) = nowq(1:ndx-1)//newq(1:lennew)
-     *  //nowq(ndx+lenold:128)
-      backspace(iunit)
-      do 2 line = linesback , 1 , -1
-        write(iunit,'(a128)')lineq(line)
-2     continue
-      return
-      end
-      subroutine beamend(notexq,lnote)
-      parameter (nm=24)
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      character*1 ulq,sepsymq,sq,ulqq,chax
-      logical beamon,firstgulp,figbass,figchk,flipend,btest,
-     *        isfig,vxtup,isdotm,isbjmp,isbj2,drawbm
-      common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2
-      common /comoct/ noctup
-      common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
-     *                 mtupv(nm,9),nxtinbm(nm),
-     *                 islope(nm),xelsk(24),eloff(nm,9),
-     *                 nssb(nm),issb(nm),lev1ssb(nm,20)
-      common /comdraw/ drawbm(nm)
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      common /strtmid/ ihnum3,flipend(nm),ixrest(nm)
-      character*4 tempq
-      character*8 noteq
-      character*79 notexq
-      ip = ipo(jn)
-      multip = iand(mult(ivx,ip),15)-8
-      if (ixrest(ivx) .eq. 4) then
-c
-c  This is the LAST note in the xtup (i.e., all rests before).  Make single.
-c
-        nodur(ivx,ip) = 2**(4-multip)
-        call notex(notexq,lnote)
-        ixrest(ivx) = 0
-        return
-      end if
-      nole = nolev(ivx,ip)
-c
-c  Check for special situations with 2nds (see precrd)
-c
-      if (btest(nacc(ivx,ip),30)) then
-        nole = nole - 1
-      else if (btest(nacc(ivx,ip),31)) then
-        nole = nole + 1
-      end if
-      if (.not.drawbm(ivx)) then
-c
-c  Xtuplet with no beam, just put in the right kind of note
-c
-        if (btest(islur(ivx,ip),30)) then
-c
-c  Forced stem direction
-c
-          ndsav = nodur(ivx,ip)
-          nodur(ivx,ip) = 2**(4-multip)
-          if (btest(nacc(ivx,ip-1),27)) 
-     *            nodur(ivx,ip)=nodur(ivx,ip)/2
-          call notex(notexq,lnote)
-          nodur(ivx,ip) = ndsav
-        else
-          call notefq(noteq,lnoten,nole,ncmid(iv,ip))
-          if (lnoten .eq. 1) call addblank(noteq,lnoten)
-          lnote = lnoten+3
-          if (.not.btest(nacc(ivx,ip-1),27)) then
-c
-c  Prior note is not regular-dotted
-c              
-
-            if (multip .eq. 0) then
-              notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))//noteq
-            else if (multip .eq. -1) then
-              notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq
-            else if (multip .eq. 1) then
-              notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))//noteq
-            else if (multip .eq. 2) then
-              notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))//noteq
-              lnote = lnote+1
-            else if (multip .eq. 3) then
-              notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))//noteq
-              lnote = lnote+2
-            else if (multip .eq. -2) then
-              notexq = sq//'wh'//noteq
-            else if (multip .eq. -3) then
-              notexq = sq//'breve'//noteq
-              lnote = lnote+3
-            else
-              print*
-              print*,'(Error in beamend, send source to Dr. Don)'
-              call stop1()
-            end if
-          else
-c
-c  Prior note is regular-dotted so this one is halved
-c
-            if (multip .eq. 0) then
-              notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))//noteq
-            else if (multip .eq. -1) then
-              notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))//noteq
-            else if (multip .eq. -2) then
-              notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq
-            end if
-          end if
-        end if
-        return
-      end if
-      call notefq(noteq,lnoten,nole,ncmid(iv,ip))
-      lnote = 0
-c
-c New way, with flipend, which was computed in beamstrt.
-c
-      if (flipend(ivx) .and. btest(ipl(ivx,ip),30))
-     *  ulq(ivx,ibmcnt(ivx)) = chax(225-ichar(ulq(ivx,ibmcnt(ivx))))
-      if (ip .gt. ibm1(ivx,ibmcnt(ivx))) then
-c
-c This is not a one-noter from beam-jump.  Check if multiplicity has increased
-c
-        if (btest(irest(ivx,ip-1),0)) then
-c
-c  Prior note is a rest, check one before that
-c
-          mp = iand(mult(ivx,ip-2),15)-8
-        else
-          mp = iand(mult(ivx,ip-1),15)-8
-        end if
-        if (multip .gt. mp) then
-c
-c  Assume 1-3, 2-3, or 1-2
-c
-          do 2 imp = multip , mp+1 , -1
-            call ntrbbb(imp,'t',ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote)
-2         continue
-        else if (btest(nacc(ivx,ip-1),27)) then
-c
-c  2nd member of dotted xtup
-c
-          call ntrbbb(multip+1,'t',
-     *                       ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote)
-        end if
-      end if
-c
-c Beam termination and direction analysis
-c
-      if (btest(irest(ivx,ip),23) .and. .not.isbjmp) then
-c
-c This is the end of the first segment in a jump-beam.  ivbj1=ivx will be number 
-c   of the jump-beam.  ivbj2 will be tested along with isbjmp to see if in the
-c   voice of the 2nd part of jumped beam.  (May need special treatment for
-c   multi-segment jump-beams
-c
-        isbjmp = .true.
-        ivbj1 = ivx      
-        ivbj2 = 0      
-      end if
-      if (.not.btest(irest(ivx,ip),23)) then
-c
-c This is either a normal beamend or end of a sequence of jump-beam segments, 
-c so some sort of termination is required
-c
-        ulqq = ulq(ivx,ibmcnt(ivx))
-        if (.not.isbjmp .or. ivx.ne.ivbj2) then
-c
-c Normal termination
-c
-          call ntrbbb(1,'t',ulqq,mod(ivx,24),notexq,lnote)
-        else 
-c
-c Terminate a sequence of jump-beam segments.
-c
-          ulqq = chax(225-ichar(ulqq)) 
-          call ntrbbb(1,'t',ulqq,mod(ivbj1,24),notexq,lnote)
-        end if
-      end if
-c
-c Check for end of 2nd seg of staff-jump xtup chord blank rest
-c
-c      if (isbjmp.and.ivx.eq.ivbj2
-      if (isbjmp
-     *    .and.btest(islur(ivx,ip),29)) then
-        notexq = notexq(1:lnote)//sq//'sk'
-        return
-      end if
-c
-c  And now the note
-c
-      if (lnote .gt. 0) then
-        notexq = notexq(1:lnote)//sq//'qb'
-      else
-        notexq = sq//'qb'
-      end if
-      lnote = lnote+3
-      isdotm = .false.
-      if (.not.vxtup(ivx)) then
-        if (2**log2(nodur(ivx,ip)) .ne. nodur(ivx,ip)) then
-          if (.not.btest(iornq(ivx,ip),13)) then
-            notexq = notexq(1:lnote)//'p'
-          else
-            notexq = notexq(1:lnote)//'m'
-            isdotm = .true.
-          end if
-          lnote = lnote+1
-        end if
-      end if
-c
-c  5/25/08 Allow >12
-c  5/9/10 Up to 24; replace 24 with 0
-c
-      if (.not.(isbjmp.and.ivx.eq.ivbj2)) then
-c        call istring(mod(ivx,12),tempq,len)
-        call istring(mod(ivx,24),tempq,len)
-      else
-c        call istring(mod(ivbj1,12),tempq,len)
-        call istring(mod(ivbj1,24),tempq,len)
-      end if
-      if (isbjmp .and. ivx.eq.ivbj2 
-     *     .and..not.btest(irest(ivx,ip),23)) isbjmp=.false.      
-      notexq = notexq(1:lnote)//tempq(1:len)
-      lnote = lnote+len
-      notexq = notexq(1:lnote)//noteq(1:lnoten)
-      lnote = lnote+lnoten
-      if (isdotm) then
-        if (lnoten .eq. 1) then
-          notexq = notexq(1:lnote)//'{'//noteq(1:1)//'}'
-          lnote = lnote+3
-        else
-          notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1)
-          lnote = lnote+1
-        end if
-      end if
-      return
-      end
-      subroutine beamid(notexq,lnote)
-      parameter (nm=24)
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      character*1 ulq,sepsymq,sq,ulqq,chax
-      logical beamon,firstgulp,figbass,figchk,flipend,btest,
-     *        isfig,vxtup,isdotm,isbjmp,bar1syst,isdotted,isbj2,drawbm
-      character*79 notexq
-      common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2
-      common /comoct/ noctup
-      common /strtmid/ ihnum3,flipend(nm),ixrest(nm)
-      common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
-     *                 mtupv(nm,9),nxtinbm(nm),
-     *                 islope(nm),xelsk(24),eloff(nm,9),
-     *                 nssb(nm),issb(nm),lev1ssb(nm,20)
-      common /comdraw/ drawbm(nm)
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      common /comask/ bar1syst,fixednew,scaldold,
-     *                wheadpt,fbar,poenom
-      character*8 noteq
-      character*4 tempq
-        lnote = 0
-        ip = ipo(jn)
-        nole = nolev(ivx,ip)
-c
-c  Check for special situations with 2nds (see precrd)
-c
-        if (btest(nacc(ivx,ip),30)) then
-          nole = nole - 1
-        else if (btest(nacc(ivx,ip),31)) then
-          nole = nole + 1
-        end if
-        if (.not.btest(irest(ivx,ip),0)) then
-          multip = iand(mult(ivx,ip),15)-8
-c          if (btest(islur(ivx,ip-1),3)) multip = multip+1
-c
-c  (Above test OK since must have ip>1).  Double dotted note preceding
-c
-c  Move the following, because can't ask for note until after checking for
-c  embedded xtup with number, due to ordering/octave feature.
-c
-c         call notefq(noteq,lnoten,nolev(ivx,ip),ncmid(iv,ip))
-        end if
-        if (btest(irest(ivx,ip),28)) vxtup(ivx) = .true.
-        if (vxtup(ivx)) then
-c
-c  In an xtup
-c
-          if (btest(irest(ivx,ip),0)) then
-c
-c  Intermediate rest in xtup, put in the rest.  Reset nodur so notex works OK
-c
-            nodur(ivx,ip) = 2**(4-(iand(mult(ivx,ip),15)-8))
-            call notex(notexq,lnote)
-c
-c  Re-zero so next note does not get confused
-c
-            nodur(ivx,ip) = 0
-            return
-          end if
-c          if (multip.le.0) then
-c          if (multip.le.0 .or. 
-c     *        (multip.eq.1.and.btest(nacc(ivx,ip-1),18))) then
-          if (.not.drawbm(ivx)) then
-c
-c  Xtuplet with no beam, just put in the right kind of note
-c
-            if (btest(islur(ivx,ip),30)) then
-c
-c  Forced stem direction
-c
-              ndsav = nodur(ivx,ip)
-              nodur(ivx,ip) = 2**(4-multip)
-              if (btest(nacc(ivx,ip),19) .or. 
-     *                     btest(nacc(ivx,ip),27)) then
-                nodur(ivx,ip)=3*nodur(ivx,ip)/2
-              else if (btest(nacc(ivx,ip-1),27)) then
-                nodur(ivx,ip)=nodur(ivx,ip)/2
-              end if
-              call notex(notexq,lnote)
-              nodur(ivx,ip) = ndsav
-            else
-c
-c  Use ulq for stem direction
-c
-              call notefq(noteq,lnoten,nole,ncmid(iv,ip))
-              if (lnoten .eq. 1) call addblank(noteq,lnoten)
-              lnote = 3
-              if (.not.btest(nacc(ivx,ip-1),27)) then
-c
-c  Prior note is not regular-dotted
-c              
-                if (multip .eq. 0) then
-                  notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))
-                else if (multip .eq. -1) then
-                  notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))
-                else if (multip .eq. 1) then
-                  notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))
-                else if (multip .eq. 2) then
-                  notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))
-                  lnote = 4
-                else if (multip .eq. 3) then
-                  notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))
-                  lnote = 5
-                else if (multip .eq. -2) then
-                  notexq = sq//'wh'
-                end if
-                if (btest(nacc(ivx,ip),27)) then
-c
-c  This note is regular dotted non-beamed xtup
-c
-                  notexq = notexq(1:3)//'p'
-                  lnote = 4
-                end if
-              else
-c
-c  Prior note is regular-dotted so this one is halved
-c
-                if (multip .eq. 0) then
-                  notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))
-                else if (multip .eq. -1) then
-                  notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))
-                else if (multip .eq. -2) then
-                  notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))
-                end if
-              end if
-              notexq = notexq(1:lnote)//noteq
-              lnote = lnote+lnoten
-            end if
-            return
-          else if (nodur(ivx,ip).eq.0) then
-c
-c  In the beamed xtup but not the last note
-c
-            if (nodur(ivx,ip-1).gt.0) then
-c
-c  Embedded Xtup, mult>0, starts here.  Put in number if needed
-c
-              nxtinbm(ivx) = nxtinbm(ivx)+1
-              iud = 1
-              if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') iud = -1
-c
-c  Get ip#, notelevel of middle note (or gap) in xtup
-c
-              ipmid = ip+ntupv(ivx,nxtinbm(ivx))/2
-              xnlmid = levrn(nolev(ivx,ipmid),irest(ivx,ipmid),iud,
-     *                       ncmid(iv,ipmid),iand(15,mult(ivx,ipmid))-8)
-              if (mod(ntupv(ivx,nxtinbm(ivx)),2).eq.0) xnlmid = (xnlmid+
-     *            levrn(nolev(ivx,ipmid-1),irest(ivx,ipmid-1),iud,
-     *            ncmid(iv,ipmid-1),iand(15,mult(ivx,ipmid-1))-8))/2
-              iflop = 0
-              if (abs(xnlmid-ncmid(iv,ip)).lt.3.) iflop = -iud
-              iup = iud+2*iflop
-              if (btest(irest(ivx,ip),14)) then
-                iup = -iup
-                iflop = 0
-                if (iud*iup .lt. 0) iflop = iup
-              end if
-c
-c  Place number if needed
-c
-              if (.not.btest(islur(ivx,ip),31)) then
-                mprint = igetbits(nacc(ivx,ip),5,22)
-                if (mprint.eq.0) mprint=mtupv(ivx,nxtinbm(ivx))
-                call putxtn(mprint,iflop,multip,iud,wheadpt,poenom,
-     *            nolev1(ivx),islope(ivx),slfac,
-     *            xnlmid,islur(ivx,ip),lnote,notexq,ncmid(iv,ip),nlnum,
-c     *            eloff(ivx,nxtinbm(ivx)),iup,irest(ivx,ip),.false.)
-     *            eloff(ivx,nxtinbm(ivx)),iup,irest(ivx,ip),
-     *            mult(ivx,ip),.false.)
-                end if
-              call notefq(noteq,lnoten,nole,ncmid(iv,ip))
-            else
-c
-c  Intermediate note of xtup
-c
-              call notefq(noteq,lnoten,nole,ncmid(iv,ip))
-            end if
-          else
-c
-c  Last note of xtup (but not last note of beam!)
-c
-            call notefq(noteq,lnoten,nole,ncmid(iv,ip))
-          end if
-        else if (btest(irest(ivx,ip),0)) then
-          call notex(notexq,lnote)
-          return
-        else
-          call notefq(noteq,lnoten,nole,ncmid(iv,ip))
-        end if
-c
-c Check if multiplicity changes in a way requiring action,
-c unless (160211) it's blank rest on start of 2nd seg of joined beam
-c
-        if(.not.btest(irest(ivx,ip-1),24)
-     *         .or..not.btest(islur(ivx,ip-1),29)) then
-          ipleft = ip-1
-          if (btest(irest(ivx,ipleft),0)) ipleft = ipleft-1
-          if (.not.btest(islur(ivx,ipleft),20)) then
-            multl = iand(15,mult(ivx,ipleft))-8
-          else
-            multl = 1
-          end if
-          mub = multip - multl
-          ipright = ip+1
-          if (btest(irest(ivx,ipright),0)) ipright = ipright+1
-          if (.not.btest(islur(ivx,ip),20)) then
-            multr = iand(15,mult(ivx,ipright))-8
-          else
-            multr = 1
-          end if
-          mua = multr-multip
-          if (mub.gt.0 .or. mua .lt. 0) then
-c
-c  Multiplicity has increased from left or will decrease to right. Need action.
-c
-            if (isbjmp .and. ivx.eq.ivbj2) then
-              ivb = ivbj1
-              ulqq = chax(225-ichar(ulq(ivx,ibmcnt(ivx))))
-            else
-              ivb = ivx
-              ulqq = ulq(ivx,ibmcnt(ivx))
-            end if
-            if (mua .ge. 0) then
-              call ntrbbb(multip,'n',ulqq,ivb,notexq,lnote)
-c            else if (multl .ge. multr) then
-c  Test for next note being blank rest, assuming staff-crossing
-c    xtup chord
-c
-            else if (multl .ge. multr .and.
-     *               .not.btest(islur(ivx,ip+1),29)) then
-              do 1 im = multip , 1+multr, -1
-                call ntrbbb(im,'t',ulqq,ivb,notexq,lnote)
-1             continue
-c            else
-c  Test for next note being blank rest, assuming staff-crossing
-c    xtup chord
-c
-            else if (.not.btest(islur(ivx,ip+1),29)) then
-              do 2 im = 1+multr, multip
-                call ntrbbb(im,'r',ulqq,ivb,notexq,lnote)
-2             continue
-              call ntrbbb(multr,'n',ulqq,ivb,notexq,lnote)
-            end if
-          else if (ip .gt. 1) then
-c
-c  Check for 2nd member of dotted xtup
-c
-            if (btest(nacc(ivx,ip-1),27)) call ntrbbb(multip+1,'t',
-     *                       ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote)
-          end if
-        end if
-c
-c Now put in the note
-c
-        if (lnote .gt. 0) then
-          notexq = notexq(1:lnote)//sq//'qb'
-        else
-          notexq = sq//'qb'
-        end if
-        lnote = lnote+3
-        isdotm = .false.
-        if (isdotted(nodur,ivx,ip)) then
-c
-c rule out ')'
-c
-          if (.not.btest(iornq(ivx,ip),13)) then
-            if (.not.btest(islur(ivx,ip),3)) then
-              notexq = notexq(1:lnote)//'p'
-            else
-c
-c  Double dot
-c
-              notexq = notexq(1:lnote)//'pp'
-              lnote = lnote+1
-            end if
-          else
-            notexq = notexq(1:lnote)//'m'
-            isdotm = .true.
-          end if
-          lnote = lnote+1
-        else if (btest(nacc(ivx,ip),19) 
-     *           .or. btest(nacc(ivx,ip),27)) then
-c
-c  Special dotted notation for 2:1 xtup, or normal dot in xtup
-c
-          notexq = notexq(1:lnote)//'p'
-          lnote = lnote+1
-        end if
-c
-c 5/25/08 Allow >12
-c
-        if (.not.(isbjmp.and.ivx.eq.ivbj2)) then
-c          call istring(mod(ivx,12),tempq,len)
-          call istring(mod(ivx,24),tempq,len)
-        else
-c          call istring(mod(ivbj1,12),tempq,len)
-          call istring(mod(ivbj1,24),tempq,len)
-        end if
-        notexq = notexq(1:lnote)//tempq(1:len)
-        lnote = lnote+len
-        notexq = notexq(1:lnote)//noteq(1:lnoten)
-        lnote = lnote+lnoten
-        if (isdotm) then
-          if (lnoten .eq. 2) then
-            notexq = notexq(1:lnote)//'{'//noteq(2:2)//'}'
-            lnote = lnote+3
-          else
-            notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1)
-            lnote = lnote+1
-          end if
-        end if
-      return
-      end
-      subroutine beamn1(notexq,lnote)
-      parameter (nm=24)
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      character*1 ulq,sepsymq,sq
-      logical beamon,firstgulp,figbass,figchk,btest,
-     *        isfig,vxtup,isdotm,isbjmp,isbj2,drawbm
-      common /comoct/ noctup
-      common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2
-      common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
-     *                 mtupv(nm,9),nxtinbm(nm),
-     *                 islope(nm),xelsk(24),eloff(nm,9),
-     *                 nssb(nm),issb(nm),lev1ssb(nm,20)
-      common /comdraw/ drawbm(nm)
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      character*8 noteq
-      character*79 notexq
-      ip1 = ipo(jn)
-      multip = iand(15,mult(ivx,ip1))-8
-c     if (multip.le.0 .and. btest(irest(ivx,ip1),0)) then
-      if (.not.drawbm(ivx) .and. btest(irest(ivx,ip1),0)) then
-        lnote = 0
-c
-c  The rest was already written in beamstrt, so just get out of here
-c
-        return
-      end if
-      nole = nolev(ivx,ipo(jn))
-c
-c  Check for special situations with 2nds (see precrd)
-c
-      if (btest(nacc(ivx,ipo(jn)),30)) then
-        nole = nole - 1
-      else if (btest(nacc(ivx,ipo(jn)),31)) then
-        nole = nole + 1
-      end if
-      if (vxtup(ivx) .and. .not.drawbm(ivx)) then
-c
-c  Xtuplet with no beam, just put in the right kind of note
-c
-        if (btest(islur(ivx,ip1),30)) then
-c
-c  Forced stem direction
-c
-          ndsav = nodur(ivx,ip1)
-          nodur(ivx,ip1) = 2**(4-multip)
-          if (btest(nacc(ivx,ip1),19) .or. 
-     *       btest(nacc(ivx,ip1),27)) nodur(ivx,ip1)=3*nodur(ivx,ip1)/2
-          call notex(notexq,lnote)
-          nodur(ivx,ip1) = ndsav
-        else
-          call notefq(noteq,lnoten,nole,ncmid(iv,ip1))
-          if (lnoten .eq. 1) call addblank(noteq,lnoten)
-          lnote = 3
-          if (multip .eq. 0) then
-            notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))
-          else if (multip .eq. -1) then
-            notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))
-          else if (multip .eq. 1) then
-            notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))
-          else if (multip .eq. 2) then
-            notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))
-            lnote = 4
-          else if (multip .eq. 3) then
-            notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))
-            lnote = 5
-          else if (multip .eq. -2) then
-            notexq = sq//'wh'
-          else if (multip .eq. -3) then
-            notexq = sq//'breve'
-            lnote = 6
-          else
-            print*
-            print*,'(Error in beamn1, send source to Dr. Don)'
-            call stop1()
-          end if
-          if (btest(nacc(ivx,ip1),19) .or. btest(nacc(ivx,ip1),27)) then 
-            notexq = notexq(1:3)//'p'
-            lnote = 4
-          end if
-          notexq = notexq(1:lnote)//noteq
-          lnote = lnote+lnoten
-        end if
-        return
-      end if
-c
-c  Check if mult. decreases from 1st note to 2nd
-c
-      if (ibm2(ivx,ibmcnt(ivx)).gt.ip1 
-     *           .or. btest(islur(ivx,ip1),20)) then
-c
-c  More than one note or single-note before a multiplicity-down-up "]["
-c
-        if (btest(islur(ivx,ip1),20)) then
-          multr = 1
-        else if (.not.btest(irest(ivx,ip1+1),0)) then
-          multr = iand(15,mult(ivx,ip1+1))-8
-        else
-          multr = iand(15,mult(ivx,ip1+2))-8
-        end if
-        lnote = 0
-        if (multr .lt. multip) then
-          do 1 im = multip , multr+1 , -1
-            call ntrbbb(im,'r',ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote)
-1         continue
-        end if
-      end if
-c
-c  Put in the note
-c
-      if (lnote .gt. 0) then
-        notexq = notexq(1:lnote)//sq//'qb'
-      else
-        notexq = sq//'qb'
-      end if
-      lnote = lnote+3
-c
-c  Check for dot
-c
-      isdotm = .false.
-      if (.not.vxtup(ivx)) then
-        nd = nodur(ivx,ipo(jn))
-        if (nd.ne.0) then
-          if (2**log2(nd).ne.nd) then
-            if (.not.btest(iornq(ivx,ip1),13)) then
-              if (.not.btest(islur(ivx,ip1),3)) then
-                notexq = notexq(1:lnote)//'p'
-              else
-c
-c  Double dot
-c
-                notexq = notexq(1:lnote)//'pp'
-                lnote = lnote+1
-              end if
-            else
-              notexq = notexq(1:lnote)//'m'
-              isdotm = .true.
-            end if
-            lnote = lnote+1
-          end if
-        end if
-      else if (btest(nacc(ivx,ip1),19) .or. 
-     *               btest(nacc(ivx,ip1),27)) then
-c
-c  In an xtup with special 2:1 notation with a dot on 1st note, or normal dot
-c
-        notexq = notexq(1:lnote)//'p'
-        lnote = lnote+1
-      end if
-c
-c  Do the number; 0 if 12
-c
-c  5/25/08 allow >12
-c
-      if (.not.btest(irest(ivx,ip1),24)) then
-c        call istring(mod(ivx,12),noteq,len)
-        call istring(mod(ivx,24),noteq,len)
-      else
-c        call istring(mod(ivbj1,12),noteq,len)
-        call istring(mod(ivbj1,24),noteq,len)
-      end if
-      notexq = notexq(1:lnote)//noteq(1:len)
-      lnote = lnote+len
-      call notefq(noteq,lnoten,nole,ncmid(iv,ip1))
-      notexq = notexq(1:lnote)//noteq(1:lnoten)
-      lnote = lnote+lnoten
-      if (isdotm) then
-        if (lnoten .eq. 1) then
-          notexq = notexq(1:lnote)//'{'//noteq(1:1)//'}'
-          lnote = lnote+3
-        else
-          notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1)
-          lnote = lnote+1
-        end if
-      end if
-      return
-      end
-      subroutine beamstrt(notexq,lnote,nornb,ihornb,space,squez,ib)
-      parameter (nm=24)
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      character*1 ulq,sepsymq,sq
-      character*40 restq
-      character*79 inameq
-      logical beamon,firstgulp,figbass,figchk,btest,
-     *        isfig,vxtup,bar1syst,addbrack,flipend,xto,drawbm
-      common /comeskz2/ eskz2(nm,200)
-      common /comoct/ noctup
-      common /strtmid/ ihnum3,flipend(nm),ixrest(nm)
-      common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
-     *                 mtupv(nm,9),nxtinbm(nm),
-     *                 islope(nm),xelsk(24),eloff(nm,9),
-     *                 nssb(nm),issb(nm),lev1ssb(nm,20)
-      common /comdraw/ drawbm(nm)
-      common /comas1/ naskb,task(40),wask(40),elask(40)
-      common /comask/ bar1syst,fixednew,scaldold,
-     *                wheadpt,fbar,poenom
-      common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
-     *   isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
-     *   lnam(nm),inameq(nm)
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-c
-c  The following is just to save the outputs from SetupB for the case of
-c  xtups starting with a rest, where beamstrt is called twice.
-c
-      common /comipb/ nnb,sumx,sumy,ipb(24),smed
-      character*1 chax
-      character*8 noteq
-      character*79 notexq,tempq
-      integer nornb(nm),ihornb(nm,24)
-      real*4 space(80),squez(80)
-      logical novshrinktop,cstuplet,usexnumt,writebrests
-      common /comnvst/ novshrinktop,cstuplet
-      common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
-     *                fullsize(nm),ivxfig2,ivvfig(2,74)
-      character*10 figq
-      common /xjbeambrests/ nbrests
-      writebrests = .true.
-      ibc = ibmcnt(ivx)
-      ipb1 = ibm1(ivx,ibc)
-      multb = iand(15,mult(ivx,ipb1))-8
-      ip = ipo(jn)
-c
-c  Compute slopes and note offsets from start of beam.  Inside SetupB, for each
-c  xtup in the beam, set eloff,mtupv (in comxtup) for printed number.
-c
-      if (ixrest(ivx).eq.0 .and. .not.btest(nacc(ivx,ip),21)) 
-     *      call SetupB(xelsk,nnb,sumx,sumy,ipb,smed,ixrest(ivx))
-      if (btest(nacc(ivx,ip),21)) then
-c
-c  This is start of later segment of single-slope beam group so use slope and 
-c    height from prior beam.   Slope is already OK.
-c
-        issb(ivx) = issb(ivx)+1  
-        nolev1(ivx) = lev1ssb(ivx,issb(ivx))
-      end if
-      lnote = 0
-      drawbm(ivx) = .true.
-      if (btest(irest(ivx,ipb1),28) .and. ixrest(ivx).ne.2) then
-        vxtup(ivx) = .true.
-        nxtinbm(ivx) = nxtinbm(ivx)+1
-c
-c  irest(28)=>Xtup starts on this note.  Set up for xtuplet.
-c  Number goes on notehead side at middle note (or gap) of xtup, unless that
-c  puts it in staff, then it flops to stem (or beam) side.
-c               __          __
-c         |    |  |   O    |  |
-c         O      |    |      O
-c       |___|    O  |__|     |
-c
-c  iud   -1     -1    1      1    ...stem direction
-c iflop   0      1   -1      0    ...direction of flop
-c  iup   -1      1   -1      1    ...direction of number and bracket
-c
-        iud = 1
-        if (ulq(ivx,ibc) .eq. 'u') iud = -1
-c
-c  Get ip#, note level of middle note (or gap) in xtup
-c
-        ipmid = ipb1+ntupv(ivx,nxtinbm(ivx))/2
-c
-c  130129 If middle note is a rest, go to next note. Note last note cannot
-c    be a rest
-c
-14      continue
-        if (btest(irest(ivx,ipmid),0)) then
-          ipmid = ipmid+1
-          go to 14
-        end if
-        xnlmid = levrn(nolev(ivx,ipmid),irest(ivx,ipmid),iud,
-     *                 ncmid(iv,ipmid),iand(15,mult(ivx,ipmid))-8)
-        if (mod(ntupv(ivx,nxtinbm(ivx)),2) .eq. 0) xnlmid = (xnlmid+
-     *            levrn(nolev(ivx,ipmid-1),irest(ivx,ipmid-1),iud,
-     *            ncmid(iv,ipmid-1),iand(15,mult(ivx,ipmid-1))-8))/2
-        iflop = 0
-        if (abs(xnlmid-ncmid(iv,ipb1)).lt.3.) iflop = -iud
-        iup = iud+2*iflop
-        if (btest(irest(ivx,ipb1),14)) then
-c
-c  Alter iud, iflop, iup to flip number/bracket. (Stare at above pic)
-c
-          iup = -iup
-          iflop = 0
-          if (iud*iup .lt. 0) iflop = iup
-        end if
-c
-c  Determine if a beam is to be drawn
-c
-        do 5 ipp = ibm1(ivx,ibc),ibm2(ivx,ibc)
-          if (iand(15,mult(ivx,ipp))-8 .le. 0) then
-            drawbm(ivx) = .false.
-            go to 6
-          end if
-5       continue
-        drawbm(ivx) = .not.btest(islur(ivx,ibm1(ivx,ibc)),18)
-6       continue
-c
-c Are we using tuplet.tex?
-c
-        usexnumt = cstuplet .and. .not.drawbm(ivx)
-c
-c  Place xtup number if needed
-c
-        if (.not.btest(islur(ivx,ipb1),31) .or. multb.le.0) then 
-          mprint = igetbits(nacc(ivx,ip),5,22)
-          if (mprint.eq.0) mprint=mtupv(ivx,nxtinbm(ivx))
-          call putxtn(mprint,iflop,multb,iud,wheadpt,
-     *      poenom,nolev1(ivx),islope(ivx),slfac,xnlmid,islur(ivx,ipb1),
-     *      lnote,notexq,ncmid(iv,ipb1),nlnum,eloff(ivx,nxtinbm(ivx)),
-c     *      iup,irest(ivx,ipb1),usexnumt)
-     *      iup,irest(ivx,ipb1),mult(ivx,ipb1),usexnumt)
-        end if
-        if (.not.drawbm(ivx)) then
-c
-c  Xtuplet with no beam
-c
-          if (.not.btest(islur(ivx,ipb1),31)) then
-c
-c  Number printing has not been suppressed, so put in the bracket. 
-c    scale = stretch factor for bracket if there are asx's
-c    xnsk = length of the bracket in \noteskips = (\elemskips)/(eon)
-c
-            xnsk = (eskz2(ivx,ipb1+ntupv(ivx,nxtinbm(ivx))-1)
-     *          -eskz2(ivx,ipb1))/squez(ib)/feon(space(ib)/squez(ib))
-            if (iup .eq. 1) then
-              if (lnote .gt. 0) then
-                notexq = notexq(1:lnote)//sq//'ovbkt'
-              else
-                notexq = sq//'ovbkt'
-              end if
-            else
-              if (lnote .gt. 0) then
-                notexq = notexq(1:lnote)//sq//'unbkt'
-              else
-c
-c  Introduced 12/5/98, req'd due to possible presence of in-line TeX
-c
-                notexq = sq//'unbkt'
-              end if
-            end if
-            lnote = lnote+6
-            if (iline.eq.1) then
-              smed = smed/(1.-fracindent)
-            end if
-            xslope = 1.8*smed*slfac
-            islope(ivx) = nint(xslope)
-            nolev1(ivx) = nlnum - nint(smed*eloff(ivx,1))
-            if (islope(ivx) .eq. 0) nolev1(ivx) = nolev1(ivx)-1
-            if (iup .eq. 1) nolev1(ivx) = nolev1(ivx)+4
-            levbracket = nolev1(ivx)
-            if (iup.eq.1 .and. cstuplet) levbracket = levbracket-1
-            call notefq(noteq,lnoten,levbracket,ncmid(iv,ipb1))
-            if (lnoten .eq. 1) call addblank(noteq,lnoten)
-            notexq = notexq(1:lnote)//noteq(1:lnoten)//'{'
-            lnote = lnote+lnoten+1
-            if (xnsk .lt. 0.995) then
-              write(notexq(lnote+1:lnote+4),'(i1,f3.2)')0,xnsk
-              lnote = lnote+4
-            else if (xnsk .lt. 9.995) then
-              write(notexq(lnote+1:lnote+4),'(f4.2)')xnsk
-              lnote = lnote+4
-            else
-              write(notexq(lnote+1:lnote+5),'(f5.2)')xnsk
-              lnote = lnote+5
-            end if
-            notexq = notexq(1:lnote)//'}'
-            lnote = lnote+1
-            if (btest(mult(ivx,ipb1),4)) then
-c
-c Tweak slope of bracket
-c
-              islope(ivx) = islope(ivx)+igetbits(mult(ivx,ipb1),5,5)-16
-            end if
-            if (islope(ivx).lt.0 .or. islope(ivx).ge.10) then
-              notexq = notexq(1:lnote)//'{'
-              lnote = lnote+1
-              if (islope(ivx) .lt. -9) then
-                write(notexq(lnote+1:lnote+3),'(i3)')islope(ivx)
-                lnote = lnote+3
-              else
-                write(notexq(lnote+1:lnote+2),'(i2)')islope(ivx)
-                lnote = lnote+2
-              end if
-              notexq = notexq(1:lnote)//'}'
-              lnote = lnote+1
-            else
-              write(notexq(lnote+1:lnote+1),'(i1)')islope(ivx)
-              lnote = lnote+1
-            end if
-c
-c  Done with bracket
-c
-          end if
-          if (ixrest(ivx) .eq. 1) then
-c
-c  Put in the rest.  Possible problem: Rest is a spacing char, but between
-c  beamstrt and beamn1 some non-spacing chars. are inserted.
-c
-c  130126 Deal with vertical shifts of rest starting xtuplet
-c
-c            if (multb .eq. 0) then
-c              notexq = notexq(1:lnote)//sq//'qp'
-c              lnote = lnote+3
-c            else if (.not.drawbm(ivx).and.multb.eq.1) then
-c              notexq = notexq(1:lnote)//sq//'ds'
-c              lnote = lnote+3
-c            else if (.not.drawbm(ivx).and.multb.eq.2) then
-c              notexq = notexq(1:lnote)//sq//'qs'
-c              lnote = lnote+3
-c            else if (.not.drawbm(ivx).and.multb.eq.3) then
-c              notexq = notexq(1:lnote)//sq//'hs'
-c              lnote = lnote+3
-c            else
-c              notexq = notexq(1:lnote)//sq//'hpause'
-c              lnote = lnote+7
-c            end if
-
-            lrest = 3
-            if (multb .eq. 0) then
-              restq = sq//'qp'
-            else if (.not.drawbm(ivx).and.multb.eq.1) then
-              restq = sq//'ds'
-            else if (.not.drawbm(ivx).and.multb.eq.2) then
-              restq = sq//'qs'
-            else if (.not.drawbm(ivx).and.multb.eq.3) then
-              restq = sq//'hs'
-            else
-              restq = sq//'hpause'
-              lrest = 7
-            end if
-            nole = mod(nolev(ivx,ip)+20,100)-20
-            if (nole .eq. 0) then
-c
-c Rest is not raised
-c
-              notexq = notexq(1:lnote)//restq
-              lnote = lnote+lrest
-            else
-              if (abs(nole) .lt. 10) then
-                tempq = chax(48+abs(nole))
-                ltemp = 1
-              else
-                write(tempq(1:2),'(i2)')abs(nole)
-                ltemp = 2
-              end if
-              if (nole .gt. 0) then
-                tempq = sq//'raise'//tempq(1:ltemp)//sq//'internote'
-              else
-                tempq = sq//'lower'//tempq(1:ltemp)//sq//'internote'
-              end if
-              ltemp = 16+ltemp
-              notexq = notexq(1:lnote)//tempq(1:ltemp)//restq(1:lrest)
-              lnote = lnote+ltemp+lrest
-            end if
-c
-c  No need to come back through this subroutine (as would if rest starts bar
-c  & multb>0), so do not advance ibm1. But must check in beamn1 and do nothing.
-c
-            ixrest(ivx) = 0
-          end if
-          return
-        end if
-c
-c  End if block for non-beamed xtup start...note we returned
-c
-        if (ixrest(ivx) .eq. 1) then
-c
-c  Insert rest at start of beamed xtup.  See above note for possible problem.
-c  But first check if blank rest and if in forced beam (assuming xtuplet),
-c    and if so, count rest from beginning, add \sk's AFTER starting beam '\ib*'
-c
-          if (btest(islur(ivx,ip),29) .and. btest(ipl(ivx,ip),30)) then
-            nbrests = nbrests+1
-            writebrests = .false.
-          else
-            nodur(ivx,ipb1) = 2**(4-multb)
-            call notex(tempq,ltemp)
-            if (lnote .gt. 0) then
-              notexq = notexq(1:lnote)//tempq(1:ltemp)
-            else
-              notexq = tempq(1:ltemp)
-            end if
-            lnote = lnote+ltemp
-          end if
-c
-c  Re-zero just in case!
-c
-          nodur(ivx,ipb1) = 0
-          ibm1(ivx,ibc) = ibm1(ivx,ibc)+1
-c
-c  See if next note is a non-rest
-c
-          if (.not.btest(irest(ivx,ipb1+1),0)) then
-            ixrest(ivx) = 2
-          else
-c
-c  Suppress reprinting xtup number next time through beamstrt
-c
-            islur(ivx,ipb1+1) = ibset(islur(ivx,ipb1+1),31)
-c
-c  Set new xtup start flag
-c
-            irest(ivx,ipb1+1) = ibset(irest(ivx,ipb1+1),28)
-          end if
-          return
-        end if
-      end if
-c
-c  Just ended if block for xtups
-c
-      if (vxtup(ivx) .and. ipb1.eq.ibm2(ivx,ibc)) then
-c
-c  Move actual note writing to beamend
-c
-        ixrest(ivx) = 4
-        return
-      end if
-      if (issb(ivx) .eq. 0) then
-c
-c  1st bmstrt in single-slope bm grp, Adjust start level(s) and slope if needed
-c
-        iadj = igetbits(ipl(ivx,ipb1),6,11)-30
-        if (iadj .ne. -30) then 
-          nolev1(ivx) = nolev1(ivx)+iadj
-          do 2 isssb = 1 , nssb(ivx)
-            lev1ssb(ivx,isssb) = lev1ssb(ivx,isssb)+iadj
-2         continue
-        end if
-        iadj = igetbits(ipl(ivx,ipb1),6,17)-30
-        if (iadj .ne. -30) then
-          islope(ivx) = islope(ivx)+iadj
-          if (abs(islope(ivx)) .gt. 9) islope(ivx) = sign(9,islope(ivx))
-          if (nssb(ivx) .gt. 0) then
-c
-c  Cycle thru non-rest notes in SSBG, looking for bmstrts.
-c
-            isssb = 0
-            do 4 inb = 2, nnb
-              if (btest(nacc(ivx,ipb(inb)),21)) then
-c
-c  Beam segment start.  New start level              
-                isssb = isssb+1
-                lev1ssb(ivx,isssb) = 
-     *           lev1ssb(ivx,isssb)+islope(ivx)*xelsk(inb)/slfac
-              end if
-4           continue
-          end if
-        end if
-      end if
-      iadj = igetbits(islur(ivx,ipb1),2,27)
-      addbrack = .false.
-      if (btest(ipl(ivx,ipb1),30)) then
-c
-c  Check for altered starting polarity.  Only in forced beams. Nominal start
-c  level is nolev1. So beam level is nolev1 +/- 6, to be compared w/ nolev(.,.).
-c
-        if (ulq(ivx,ibc).eq.'u' .and.
-     *                  nolev1(ivx)+6.lt.nolev(ivx,ipb1)) then
-          if (lnote .eq. 0) then
-            notexq = sq//'loff{'
-          else
-            notexq = notexq(1:lnote)//sq//'loff{'
-          end if
-          lnote = lnote+6
-          addbrack = .true.
-        else if (ulq(ivx,ibc).eq.'l' .and.
-     *                  nolev1(ivx)-6.gt.nolev(ivx,ipb1)) then
-          if (lnote .eq. 0) then
-            notexq = sq//'roff{'
-          else
-            notexq = notexq(1:lnote)//sq//'roff{'
-          end if
-          lnote = lnote+6
-          addbrack = .true.
-        end if
-c
-c  Check end level for possible flipping in forced beam.  Have to do it 
-c  here since with multiple voices, xelsk will not be preserved.
-c
-        if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then
-          bmlev = nolev1(ivx)+6+islope(ivx)*xelsk(nnb)/slfac
-          flipend(ivx) = bmlev.lt.nolev(ivx,ibm2(ivx,ibc))
-        else if (ulq(ivx,ibmcnt(ivx)) .eq. 'l') then
-          bmlev = nolev1(ivx)-6+islope(ivx)*xelsk(nnb)/slfac
-          flipend(ivx) = bmlev.gt.nolev(ivx,ibm2(ivx,ibc))
-        end if
-      end if
-      call ntrbbb(multb+iadj,'i',ulq(ivx,ibc),ivx,notexq,lnote)
-c
-c   Put in name of start level and slope, after correcting nolev1 if xtup
-c   started with a rest.
-c
-      if (ixrest(ivx).eq.2) nolev1(ivx) = 
-     *          nint(nolev1(ivx)+xelsk(1)*islope(ivx)/slfac)
-      call notefq(noteq,lnoten,nolev1(ivx),ncmid(iv,ipb1))
-      if (islope(ivx) .lt. 0) then
-        notexq = notexq(1:lnote)//noteq(1:lnoten)//'{'
-        lnote = lnote+4+lnoten
-        write(notexq(lnote-2:lnote),'(i2,a1)')islope(ivx),'}'
-      else
-        notexq = notexq(1:lnote)//noteq(1:lnoten)
-        lnote = lnote+1+lnoten
-        write(notexq(lnote:lnote),'(i1)')islope(ivx)
-      end if
-c
-c  Check for beam-thk fine-tuning
-c
-      if (iadj .gt. 0) then
-        do 1 imp = multb+iadj , multb+1 , -1
-          call ntrbbb(imp,'t',ulq(ivx,ibc),ivx,notexq,lnote)
-1       continue
-      end if
-c
-c  If we shifted, must close with right bracket
-c
-      if (addbrack) then
-        notexq = notexq(1:lnote)//'}'
-        lnote = lnote+1
-      end if
-c
-c  Add in \sk's for very special case of staff-crossing xtup chords
-c  Assumes we are in lower (first) voice of up-to-both beamed xtup
-c    that starts with blank rests (notes in upper voice here).
-c
-      if (nbrests.gt.0 .and. writebrests) then
-        do 7 isk = 1 , nbrests
-          notexq = notexq(1:lnote)//chax(92)//'sk'
-          lnote = lnote+3
-7       continue
-        nbrests = 0
-      end if
-c
-c  Get 'floor' zmin for figures
-c  Note: Will not come thru here on 1st note of unbeamed xtup, so figure height
-c    won't be adjusted. If anyone ever needs that, need to duplicate this
-c    functionality up above, before exiting.
-c
-      if (figbass .and. (ivx.eq.1 .or. ivx.eq.ivxfig2)) then
-        if (ivx .eq. 1) then
-          ivf = 1
-        else
-          ivf = ivxfig2
-        end if
-        zmult = 1.2*(multb-1)
-        ymin = 100.
-        do 3 inb = 1, nnb
-          if (isfig(ivf,ipb(inb))) then
-            if (ulq(iv,ibc) .eq. 'u') then
-              ybot = nolev(iv,ipb(inb))
-            else
-              ybot = islope(ivx)/slfac*xelsk(inb)+nolev1(ivx)
-     *                -stemlen-zmult
-            end if
-            ymin = min(ymin,ybot)
-          end if
-3       continue
-        maxdrop = ncmid(iv,ipb1)-4-ymin+5.01
-        ifigdr(ivf,iline) = max(ifigdr(ivf,iline),maxdrop)
-      end if
-c
-c  Compute ornament levels if needed
-c
-      NomOrnLev = ncmid(iv,ipb1)+5
-      iorn = 0
-      do 8 inb = 1 , nnb
-        ip = ipb(inb)
-        if (.not.btest(iornq(ivx,ip),23)) go to 8
-        if (btest(irest(ivx,ip),26) .and. ulq(ivx,ibc).eq.'l') then
-c
-c  letter-dynamic or hairpin ending under down-beamed 
-c
-          iorn = iorn+1
-          ybeam = nolev1(ivx)-stemlen+islope(ivx)*xelsk(inb)/slfac+1
-     *                  -1.2*(multb-1)
-          ihornb(ivx,iorn) = min(nint(ybeam-3.),NomOrnLev-10)
-        else if (.not.btest(ipl(ivx,ip),10)) then
-c
-c  Bits 0-13: (stmgx+Tupf._) , 14: Down fermata, was F
-c  15: Trill w/o "tr", was U , 16-18 Editorial s,f,n , 19-21 TBD
-c
-c  Non-chord.  There IS an ornament.  Need ihornb only if upbeam, and if
-c  ornament is 1,2,3,5,6,7,8,9,10,15-21 (up- but not domn ferm.)
-c
-          if (ulq(ivx,ibc).eq.'u' .and.
-     *          iand(iornq(ivx,ipb(inb)),4163566).gt.0) then
-            iorn = iorn+1
-            iornq(ivx,ip) = ibset(iornq(ivx,ip),22)
-            ybeam = nolev1(ivx)+stemlen+islope(ivx)*xelsk(inb)/slfac-1
-     *                  +1.2*(multb-1)
-            ihornb(ivx,iorn) = max(nint(ybeam+3.),NomOrnLev)
-          end if
-        else
-c
-c In a chord.  Orn may be on main note or non-main or both.  Set ihornb if
-c upbeam and highest note has orn, or down beam and lowest.  Find 1st chord note
-c
-          do 10 icrd1 = 1 , ncrd
-            if (iand(255,icrdat(icrd1)) .eq. ip  .and.
-     *           iand(15,ishft(icrdat(icrd1),-8)) .eq. ivx) go to 11
-10        continue
-11        continue
-c
-c Find outermost note, min or max depending on beam direction ulq.  xto is true
-c if there's an ornament on that note.  Expand orn list to include ._, since if
-c on extreme chord note in beam, will move.
-c So ornaments are all except 0,4,13 (,g,)
-c
-          levx = nolev(ivx,ip)
-          xto = iand(iornq(ivx,ipb(inb)),4186094).gt.0
-          icrdx = 0
-          do 12 icrd = icrd1 , ncrd
-            if (iand(255,icrdat(icrd)) .ne. ip  .or.
-     *               iand(15,ishft(icrdat(icrd),-8)) .ne. ivx) go to 13
-            levc = iand(127,ishft(icrdat(icrd),-12))
-            if ((ulq(ivx,ibc).eq.'u'.and.levc.gt.levx) .or.
-     *            (ulq(ivx,ibc).eq.'l'.and.levc.lt.levx)) then
-              levx = levc
-              icrdx = icrd
-              xto = iand(icrdorn(icrd),4186094).gt.0
-            end if
-12        continue
-13        continue
-c
-c  If there's orn on extreme note, do stuff
-c
-          if (xto) then
-            iorn = iorn+1
-            if (ulq(ivx,ibc) .eq. 'u') then
-              ybeam = nolev1(ivx)+stemlen+islope(ivx)*xelsk(inb)/slfac-1
-     *                  +1.2*(multb-1)
-              ihornb(ivx,iorn) = max(nint(ybeam+3.),NomOrnLev)
-            else
-              ybeam = nolev1(ivx)-stemlen+islope(ivx)*xelsk(inb)/slfac+1
-     *                  -1.2*(multb-1)
-              ihornb(ivx,iorn) = min(nint(ybeam-3.),NomOrnLev-10)
-            end if
-            if (icrdx .eq. 0) then
-c
-c  Affected ornament is on main note
-c
-              iornq(ivx,ip) = ibset(iornq(ivx,ip),22)
-            else
-              icrdorn(icrdx) = ibset(icrdorn(icrdx),22)
-            end if
-          end if
-        end if
-8     continue
-c
-c  Henceforth nornb will be a counter.
-c
-      if (iorn .gt. 0) nornb(ivx)=1
-      if (ixrest(ivx) .eq. 2) ixrest(ivx) = 0
-      return
-      end
-      block data
-	parameter (nm=24)
-      common /comtol/ tol
-      common /comtrans/ cheadq
-      common /compage/ widthpt,ptheight,hoffpt,voffpt,
-     *      nsyst,nflb,ibarflb(0:40),
-     *      isysflb(0:40),npages,nfpb,ipagfpb(0:18),isysfpb(0:18),
-     *      usefig,fintstf,gintstf,fracsys(30),nmovbrk,isysmb(0:30),
-     *      nistaff(0:40)
-      common /cblock/
-     *      etatop,etabot,etait,etatc,etacs1,hgtin,hgtti,hgtco,
-     *      xilbn,xilbtc,xilhdr,xilfig,a,b,inhnoh
-      common /cominbot/ inbothd
-      logical usefig
-      common /comstart/ facmtr
-      character*60 cheadq
-      character*120 instrq,titleq,compoq
-      logical headlog
-      common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip,
-     *    inhead
-      common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
-     *                flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
-     *                rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
-     *                rtshfac
-      common /combmh/ bmhgt,clefend
-      common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12),
-     *        hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41),
-     *        idynda2(99),levhssav(nm),listcresc,listdecresc
-      character*128 txtdynq
-      logical kbdrests
-      common /comkbdrests/ levbotr(8),levtopr(8),kbdrests
-      common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
-     *  instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
-      logical EarlyTransOn,LaterInstTrans
-      common /comsize/ isize(nm)
-c
-      data tol /.001/
-      data cheadq 
-     *  /'                                                            '/
-      data gslfac /9./
-      data instrq,titleq,compoq,headlog /3*' ',.false./
-c
-c  meter space (pts) = xb4mbr = musicsize*facmtr
-c
-      data facmtr /0.55/
-      data grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
-     *                flagfac,dotfac,bacfac,agc1fac,clefend,bmhgt
-     * / 1.3333,.4   ,   .7 ,  .3  ,  0.2 ,  2.0 , 1.0 ,
-     *               .7,.7 ,.9 ,.5 ,2.3 ,1.1  /
-      data rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,arpfac
-     *  /   1.32 ,  2.25   ,  0.47 , 0.83  ,   0.17 , 0.5 ,  1.7   /
-      data rtshfac / 1.0 /
-      data isize /nm*0/
-c
-c  From other
-c
-      data ptheight,widthpt,hoffpt,voffpt,
-     *      etatop,etabot,etait,etatc,etacs1,hgtin,hgtti,hgtco,
-     *      xilbn,xilbtc,xilhdr,xilfig,a,b,inbothd,inhnoh
-     *   / 740. , 524. , 0., 0.,
-     *   .50  ,  .25  , 0.4 , 0.4  , 0.2 , 12. ,21. , 12.,
-     *    4   ,   1.6 ,5.,5.7,1.071,2.714,16 ,16 /
-      data fracsys /30*0./
-	data ivowg,hoh1,hoh2,hoh2h1 /0,0,0,0,0,1,1,1,1,1,1,1,
-c     *   2.0,1.5,1.0,0.5,1.3,1.3,0.4,0.8,1.2,0.8,1.2,1.6,
-     *   2.2,1.7,1.2,0.7,1.3,1.3,0.4,0.8,1.2,0.8,1.2,1.6,
-     *   -2.7,-2.2,-1.7,-1.2,-2.3,-2.1,-1.0,-1.7,-2.1,-1.6,-1.9,-2.3,
-     *   -0.3,0.3 / 
-      data kbdrests /.false./, 
-     *       levtopr /9,7,5,5,7,5,6,6/, levbotr /0,0,0,2,1,4,5,4/
-      data EarlyTransOn, LaterInstTrans /2*.false./
-      data iInstTrans /nm*0/
-      data iTransAmt /nm*0/
-      end
-      subroutine catspace(space,squez,nnsk)
-      parameter (nkb=3999,maxblks=4000)
-      common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks),
-     *     iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr,
-c     *     ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks)
-     *     ibaroff,udsp(nkb),wheadpt,sqzb(maxblks)
-      common /comtol/ tol
-c      logical gotclef
-      do 16 iptr = nptr(ibarcnt) , nptr(ibarcnt+1)-1
-        if (abs(space-durb(iptr)) .lt. tol) then
-          if (abs(squez-sqzb(iptr)) .lt. tol) then
-c
-c  Increment pre-existing entry
-c
-            nnpd(iptr) = nnpd(iptr)+nnsk
-            return
-          end if
-        end if
-16    continue
-c
-c  Didn't find current duration & squez, so add a new entry.
-c  No particular reason to keep in order, so add at the end.
-c
-      nnpd(nptr(ibarcnt+1)) = nnsk
-      durb(nptr(ibarcnt+1)) = space
-      sqzb(nptr(ibarcnt+1)) = squez
-      nptr(ibarcnt+1) = nptr(ibarcnt+1)+1
-      return
-      end
-      character*1 function chax(n)
-c
-c The only reason for this seemingly do-nothing function is to get around an
-c  apparent bug in the Visual Fortran Standard Edition 5.0.A compiler!
-c
-      chax = char(n)
-      return
-      end
-      subroutine checkdyn(lineq,iccount,ibar)
-      character*128 lineq
-      character*1 durq,chax
-      character*4 dynsymq
-      logical txtdyn
-      txtdyn = .false.
-c
-c  On entry, iccount is on "D"
-c
-      if (lineq(iccount+1:iccount+1) .eq. '"') then
-c
-c  Dynamic text
-c
-        iend = index(lineq(iccount+2:128),'"')
-        if (iend .eq. 0) then
-          call errmsg(lineq,iccount+1,ibar,
-     *         'Dynamic text must be terminated with double quote!')
-          call stop1()
-        end if
-c
-c  Set iccount to character after 2nd ", and set ipm
-c
-        iccount = iccount+iend+2 
-        ipm = index('- +',lineq(iccount:iccount))
-        if (ipm .eq. 0) then
-          call errmsg(lineq,iccount,ibar,
-     *                'Expected "-", "+", or blank here!')
-          call stop1()
-        end if
-      else
-c
-c  Expect ordinary dynamic
-c
-        do 1 iend = iccount+2 , 128
-          ipm = index('- +',lineq(iend:iend))
-          if (ipm .gt. 0) go to 2
-1       continue
-2       continue
-        if (iend-iccount.gt.5 .or. iend-iccount.lt.2) then
-          call errmsg(lineq,iend-1,ibar,
-     *                'Wrong length for dynamic mark!')
-          call stop1()
-        end if
-        read(lineq(iccount+1:iend-1),'(a'//chax(47+iend-iccount)//')')
-     *     dynsymq
-        idno = (index(
-     *    'ppppppp pp  p   mp  mf  f   fp  sfz ff  fff ffff<   >   ',
-     *         dynsymq)+3)/4
-        if (idno .eq. 0) then
-          call errmsg(lineq,iccount+1,ibar,'Illegal dynamic mark!')
-          call stop1()
-        end if
-        iccount = iend
-      end if
-      if (ipm .ne. 2) then
-c
-c  There is a vertical shift, have "+" or "-"
-c
-        iccount = iccount+1
-        if (index('0123456789',lineq(iccount:iccount)) .eq. 0) then
-          call errmsg(lineq,iccount,ibar,
-     *       'Expected integer here for vertical offset!')
-          call stop1()
-        end if
-        call readnum(lineq,iccount,durq,fnum)
-        idno = nint(fnum)
-        if (idno .gt. 63) then
-          call errmsg(lineq,iccount-1,ibar,
-     *      'Vertical offset for dynamic mark must be (-63,63)!')
-          call stop1()
-        end if
-        ipm = index('- +',durq)
-        if (ipm .eq. 0) then
-          call errmsg(lineq,iccount,ibar,
-     *      'Expected "+", "-", or blank here!')
-          call stop1()
-        end if
-        if (ipm .ne. 2) then
-c
-c  There is a horizontal shift
-c
-          iccount = iccount+1
-          if (index('.0123456789',lineq(iccount:iccount)) .eq. 0) then
-            call errmsg(lineq,iccount,ibar,
-     *       'Expected number here for horizontal offset!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          idno = nint(10*fnum)
-          if (idno .gt. 255) then
-            call errmsg(lineq,iccount-1,ibar,
-     *       'Horizontal offset for dynamic mark must be (-25.5,25.5)!')
-            call stop1()
-          else if (durq .ne. ' ') then
-            call errmsg(lineq,iccount,ibar,
-     *        'There should be a blank here!')
-            call stop1()
-          end if
-        end if
-c
-c  iccount should be on the blank at the end of the entire symbol
-c
-      end if
-      return
-      end
-      subroutine chkarp(ncrd,icrdat,ivx,ip,iscacc,isarp)
-c      subroutine chkarp(found1,ncrd,icrdat,icrdot,ivx,ip,isacc,isarp,
-c     *                  icashft)
-      logical found1,iscacc,isarp,btest
-      integer icrdat(193)
-      found1 = .false.
-c
-c  icashft will be max left shift of accid's in chord notes.
-c  Used only for spacing checks.
-c  Will include left shift of chord note itself.
-c  Rezero after use.
-c
-      do 18 icrd = 1 , ncrd
-c
-c  This if block cycles thru all chord notes on ivx,ip; then returns.
-c
-        if (iand(255,icrdat(icrd)) .eq. ip  .and.
-     *          iand(15,ishft(icrdat(icrd),-8)) .eq. ivx) then
-          found1 = .true.
-          iscacc = iscacc .or. 
-     *       (btest(icrdat(icrd),19).and..not.btest(icrdat(icrd),27)) 
-c
-c  Accid on this chord note, and it's not midi-only.
-c
-c            irshft = igetbits(icrdot(icrd),7,20)
-cc
-cc  Include increment for notehead shift
-cc
-c            if (btest(icrdat(icrd),23)) then
-c              if (irshft .eq. 0) then
-c                irshft = 44
-c              else
-c                irshft=irshft-20
-c              end if
-c            end if
-c            if (irshft .ne. 0) then
-cc
-cc  Accid on chord note is shifted.  Include only left shift, in 20ths.
-cc
-c              if (irshft .lt. 64) icashft = max(icashft,64-irshft)
-c            end if
-c          end if
-          isarp = isarp .or. btest(icrdat(icrd),25)
-        else if (found1) then
-          return
-        end if
-18    continue
-      return
-      end
-      subroutine chkimidi(icm)
-      parameter (nm=24,mv=24576)
-      integer*2 mmidi
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      if (imidi(icm) .ge. mv) then
-        print*
-        print*,'Midi file is too long! It will be corrupted or worse'
-        write(*,'(a6,2x,4i8)')
-     *        'imidi:',imidi(0),imidi(1),imidi(2),imidi(3)
-      end if
-      return
-      end
-      subroutine chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,ivmx,
-c     * nib,nv,ibar,tnow,tol,nodur,mode,levtopr,levbotr,mult)
-     * nib,nv,ibar,tnow,tol,nodur,mode,levtopr,levbotr,mult,ipl)
-      parameter (nm=24)
-      integer*4 nn(nm),islur(nm,200),irest(nm,200),
-     * nolev(nm,200),nib(nm,15),nodur(nm,200),levbotr(8),levtopr(8),
-     * ivmx(nm,2),mult(nm,200),ipl(nm,200)
-c
-c  On 130127 put this code, formerly in make2bar right before calling notex for
-c  a single note/rest, into this subroutine, so the same logic could also be
-c  with the calls to beamstrt/mid/end to adjust height of rests in xtups if the
-c  keyboard rest option is selected
-c
-c  mode=1 if called as before, 2 if for an xtup. Only affects check for
-c    quarter rests, which will fix later.
-c
-c  Get reference level: next following note if no intervening blank rests, 
-c    otherwise next prior note. Relative to bottom line.
-c
-c      if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then
-      if (ip.ne.nn(ivx).and..not.btest(ipl(ivx,ip),1)) then
-c
-c  Not the last note and not "look-left" for level
-c
-        do 8 kkp = ip+1 , nn(ivx)
-          if (btest(islur(ivx,kkp),29)) go to 4
-          if (.not.btest(irest(ivx,kkp),0)) then
-            levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line
-            go to 9
-          end if
-8       continue
-      end if
-4     continue
-c
-c  If here, there were no following notes or came to a blank rest, or
-c    "look-left" option set. So look before
-c
-c      if (ip .eq. 1) go to 2 ! Get out if this is the first note.
-      if (ip .eq. 1) return ! Get out if this is the first note.
-      do 3 kkp = ip-1, 1, -1
-        if (.not.btest(irest(ivx,kkp),0)) then
-          levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line
-          go to 9
-        end if
-3     continue
-c      go to 2  ! Pretty odd, should never be here, but get out if so.
-      return  ! Pretty odd, should never be here, but get out if so.
-9     continue
-c
-c  Find note in other voice at same time
-c
-      iupdown = sign(1,ivx-nv-1)
-      ivother = ivmx(iv,(3-iupdown)/2)
-      tother = 0.
-      do 5 kkp = 1 , nib(ivother,ibar)
-        if (abs(tother-tnow) .lt. tol) go to 6
-        tother = tother+nodur(ivother,kkp)
-5     continue
-c
-c  If here, then no note starts in other voice at same time, so set default
-c
-      levother = -iupdown*50
-      go to 7
-6     continue
-c
-c  If here, have just identified a simultaneous note or rest in other voice
-c
-      if (.not.btest(irest(ivother,kkp),0)) then ! Not a rest, use it
-        levother = nolev(ivother,kkp)-ncmid(iv,ip)+4
-      else
-        if (nodur(ivother,kkp) .eq. nodur(ivx,ip)) then
-c
-c  Rest in other voice has same duration, get out (so defualt spacing is used)
-c
-c          go to 2
-          return
-        end if
-        levother = -iupdown*50
-      end if
-7     continue
-      if (mode.eq.1) then
-        indxr = log2(nodur(ivx,ip))+1
-      else
-c        nodu = 2**(4-(iand(mult(ivx,ip),15)-8))
-        indxr = 4-(iand(mult(ivx,ip),15)-8)+1      
-      end if
-      if (iupdown .lt. 0) then
-        levtop = levtopr(indxr)
-        iraise1 = levother-levtop-3  ! Based on other note
-        iraise2 = levnext-levtop     ! Based on following note
-        if (indxr.eq.5 .and. levnext.lt.1) iraise2=iraise2+2
-        iraise = min(iraise1,iraise2)
-        if (mod(iraise+50,2).eq.1 .and. 
-     *                iraise+levtop.gt.-1) iraise = iraise-1
-      else
-        levbot = levbotr(indxr)
-        iraise1 = levother-levbot+3
-        iraise2 = levnext-levbot
-        if (indxr.eq.5 .and. levnext.gt.8) iraise2=iraise2-1
-        iraise = max(iraise1,iraise2)
-        if (mod(iraise+50,2).eq.1 .and. 
-     *                iraise+levbot.le.9) iraise = iraise-1
-      end if
-      nolev(ivx,ip) = 100+iraise
-      return
-      end
-      subroutine chklit(lineq,iccount,literr)
-      character*128 lineq
-      character*1 charq,chax
-      literr = 0
-      itype = 1
-17    call g1etchar(lineq,iccount,charq)
-      if (charq .eq. chax(92)) then
-        itype = itype+1
-        if (itype .gt. 3) then
-          literr = 1
-          return
-        end if
-        go to 17
-      end if
-      lenlit = itype
-18    call g1etchar(lineq,iccount,charq)
-      if (charq.eq.chax(92)) then
-        call g1etchar(lineq,iccount,charq)
-        if (charq .ne. ' ') then
-c
-c  Starting a new tex command withing the string
-c
-          lenlit = lenlit+2
-          if (lenlit .gt. 128) then
-            literr = 2
-            return
-          end if
-          go to 18
-        end if
-      else
-        lenlit = lenlit+1
-        if (lenlit .gt. 128) then
-          literr = 2
-          return
-        end if
-        go to 18
-      end if
-      return
-      end
-      subroutine chkpm4ac(lineq,iccount,nacc,moved)
-c
-c  Called after getting +/-/</> in a note (not rest).  iccount is on the +-<>.
-c  Sets moved=.true. and sets move parameters in nacc if necc: horiz only (bits
-c    10-16) if < or >,  horiz and vert (bits 4-9) if two consecutive signed
-c    numbers.  If moved=.true., iccount on exit is on end of last number.
-c    If moved=.false., iccount still on +/-
-c
-      logical moved,ishorz
-      character*128 lineq
-      character*1 durq
-      if (index('sfnA',lineq(iccount-1:iccount-1)).gt.0 .and.
-     *      index('0123456789.',lineq(iccount+1:iccount+1)).gt.0) then
-c
-c  Prior char was accid & next is #; this may be start of accidental shift.
-c  Must test for "." above in case we get "<" or ">"
-c
-        ipm = index('- +< >',lineq(iccount:iccount))-2
-        if (lineq(iccount+1:iccount+1).eq.'.' .and.
-     *      index('0123456789',lineq(iccount+2:iccount+2)).eq.0) then
-c
-c  Rare case of [accid][+/-].[letter].  Bail out
-c
-          moved = .false.
-          return
-        end if
-        ishorz = ipm .gt. 1
-c
-c  Save iccount in case it's not accid shift and we have to reset.
-c
-        icsav = iccount
-        iccount = iccount+1
-        call readnum(lineq,iccount,durq,fnum)
-        if (ishorz .or. index('+-',durq).gt.0) then
-c
-c  This has to be accidental shift.  Set vert. shift.
-c
-          if (.not.ishorz) then
-c
-c  +/- syntax, both shifts set, vertical first
-c
-            call setbits(nacc,6,4,int(ipm*fnum+32.5))
-            ipm = index('- +',durq)-2
-            iccount = iccount+1
-            call readnum(lineq,iccount,durq,fnum)
-          else
-c
-c  </> syntax, only horiz set
-c
-            ipm = ipm-3
-          end if
-c
-c  Set horiz. shift
-c
-          call setbits(nacc,7,10,nint(20*(ipm*fnum+5.35)))
-          iccount = iccount-1
-          moved = .true.
-        else
-c
-c  False alarm.  Reset everything and flow onward
-c
-          moved = .false.
-          iccount = icsav
-        end if
-      else
-c
-c Either prior char was not 'sfn' or next was not digit, so take no action
-c
-        moved = .false.
-      end if
-      return
-      end
-      subroutine clefsym(isl,notexq,lnote,nclef)
-c
-c  Returns string calling Don's TeX macro \pmxclef, for drawing small clefs.
-c
-      character*(*) notexq
-      character*1 chax
-        nclef = iand(ishft(isl,-12),7)
-        if (nclef .eq. 0) then
-c
-c  treble
-c
-          nlev = 2
-        else if (nclef .gt. 6) then
-c
-c  French violin
-c
-          nlev = 0
-        else if (nclef .lt. 5) then
-c
-c  C-clef
-c
-          nlev = 2*nclef-2
-        else
-c
-c  F-clef
-c
-          nlev = 2*nclef-6
-        end if
-        notexq = chax(92)//'pmxclef'//chax(48+min(nclef,7))
-     *             //chax(48+nlev)
-        lnote = 10
-      return
-      end
-      subroutine crdacc(nacc,naccid,micrd,nolevm,rmsshift,lasttime,
-     *       levmaxacc,icrdot0,segrb0,ksegrb0,nsegrb0,twooftwo,icashft)  
-c
-c       nacc = accidental bitmap for main note
-c       naccid = # of accid's in chord
-c       micrd = array with icrd #'s for notes w/ acc's, 0=>main note
-c       nolevm = level of main note
-c       segrb(1|2,.) x|y-coord of right-bdry segment
-c       ksegrb(.) internal use; tells what defined this segment
-c           -2: Left-shifted notehead
-c           -1: Original right boundary
-c            0: Main note accidental
-c         icrd: Chord-note accidental        
-c       isetshft(i),i=1,naccid: what set shift for this accid, same codes
-c       icrdot0 = top-down level-rank of main note among accid-notes
-c       icrdot(icrd)(27-29) = level rank of chord-note among accid-notes
-c       twooftwo will be true 2nd time thru; signal to store shifts w/ notes
-c
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      real*4 segar(5,2,6),segal(5,2,6),segrb(2,50),segrb0(2,50)
-      integer*4 nsegar(5),nsegal(5),micrd(10),iacctbl(6),ksegrb(50),
-     *          isetshft(10),ksegrb0(50)
-      logical lasttime,mainnote,twooftwo
-      data nsegar / 3,4,3,3,2 /, nsegal / 2,4,3,3,2 /
-      data segar /
-c
-c  Fancy sharp boundary. fl,sh,na,dfl,dsh
-c
-     * -0.05,-0.38,-0.34,-.05, -.15,-1.4,-2.9,-3.0, -1.4, -1.2,   
-c     * -0.75,-0.20,-0.80, 0. , 0. , .96,-1.04,1.6, 0. , 0. ,   
-c           meas value for y, natural is 1.6
-     * -0.75,-0.20,-0.80,-.75,   0. , .96,-1.04,1.48, .96, 1.2,   
-     *  0.00,-0.38, 0.00, 0. ,   0. ,3.15, 1.64,3.0, 3.15, 0. ,   
-     * 0. ,   0.00, 0. ,  0. ,   0. , 0. , 2.90, 0. , 0. , 0. ,
-     * 0. ,   0.  , 0. ,  0. ,   0. , 0. , 0. ,  0. , 0. , 0. ,  
-     * 0. ,   0.  , 0. ,  0. ,   0. , 0. , 0. ,  0. , 0. , 0. /
-      data segal /
-c     *  0.00, 0.00,-1.04, 0. , 0. ,3.15, 2.9,-1.6, 0. , 0. ,
-cc		(meas. value is 3.08)    ^^^^
-cc  Raise top of flat so it interferes with bottom of sharp        
-     * -1.00,-1.02,-0.60,-1.65, -1.2,-1.4,-2.9, -3.0, -1.4, -1.2,   
-     *  0.00,-1.20,-1.04, 0.  ,  0. ,3.15,-1.64,-1.48,3.15, 1.2,
-     *  0.  ,-1.02, 0.00, 0.  ,  0. , 0. , 1.04, 3.0,  0. , 0. ,   
-     *  0. ,  0.00, 0. ,  0.  ,  0. , 0. , 2.9 , 0. ,  0. , 0. ,  
-     *  0. ,  0.  , 0. ,  0.  ,  0. , 0. , 0. ,  0. ,  0. , 0. ,  
-     *  0. ,  0.  , 0. ,  0.  ,  0. , 0. , 0. ,  0. ,  0. , 0. /
-c
-c  iacctbl(i) = internal accid # (1-5) when i=extern accid # (1,2,3,5,6)
-c
-      data iacctbl / 1 , 2 , 3 , 0 , 4 , 5 /
-c
-c  Set up barrier segrb(iseg,ipoint) to define coords of corner points 
-c    on stem+notes
-c
-      do 11 iseg = 1 , nsegrb0
-        segrb(1,iseg) = segrb0(1,iseg)
-        segrb(2,iseg) = segrb0(2,iseg)
-        ksegrb(iseg) = ksegrb0(iseg)
-11    continue
-      nsegrb = nsegrb0
-      rmsshift = 0.
-      shiftmin = 1000.
-	do 1 iwa = 1 , naccid
-c
-c  Initialize shift for this note
-c
-        shift = 0.
-        mainnote = micrd(iwa).eq.0
-        isetshft(iwa) = -1
-c
-c Get note level and accidental type
-c
-        if (mainnote) then
-          nolev = nolevm
-          iacctype = iacctbl(igetbits(nacc,3,0))
-        else
-          nolev = igetbits(icrdat(micrd(iwa)),7,12)
-          iacctype = iacctbl(igetbits(icrdat(micrd(iwa)),3,20))
-        end if
-c
-c  Cycle thru segments on right edge of this accidental
-c
-        do 2 isega = 1 , nsegar(iacctype)-1
-          ybotaseg = nolev+segar(iacctype,2,isega)
-          ytopaseg = nolev+segar(iacctype,2,isega+1)
-c
-c  Cycle thru segments of right-hand barrier
-c
-	    do 3 isegrb = 1 , nsegrb-1
-c
-c  Must find all barrier segments that start below ytopseg & end above ybotseg 
-c
-            if (segrb(2,isegrb) .lt. ytopaseg) then
-c
-c  Barrier seg starts below top of accid
-c  Check if barrier seg ends above bottom of accid
-c
-              if (segrb(2,isegrb+1) .gt. ybotaseg) then
-                if (shift .gt. 
-     *                segrb(1,isegrb)-segar(iacctype,1,isega)) then
-                  shift = segrb(1,isegrb)-segar(iacctype,1,isega)
-c
-c  Record the cause of the shift
-c
-                  isetshft(iwa) = ksegrb(isegrb)
-                end if
-              end if
-c
-c  Does barrier segment end above top of accid seg?
-c
-              if (segrb(2,isegrb+1) .gt. ytopaseg) go to 4
-            end if
-3         continue
-4         continue
-2       continue
-        if (.not.btest(nacc,28) .and. abs(shift).gt.0.0001
-     *       .and. .not.lasttime) then
-c          if (nolev .eq. levmaxacc) then
-          if (nolev.eq.levmaxacc .and. isetshft(iwa).eq.-1) then
-            rmsshift = 1000.
-            return
-          end if
-c
-c  Does the following properly account for left-shifted noteheads?
-c
-c  Top-down rank of this note we just shifted
-c
-          if (mainnote) then 
-            irank = icrdot0
-          else 
-            irank = igetbits(icrdot(micrd(iwa)),3,27)
-          end if
-c
-c  Compare level-rank of this note vs. that of note that caused the shift. 
-c    This has effect of checking for basic interferences from top down.
-c
-c       ksegrb(.) internal use; tells what defined this segment
-c           -2: Left-shifted notehead
-c           -1: Original right boundary
-c            0: Main note accidental
-c         icrd: Chord-note accidental        
-c       isetshft(i),i=1,naccid: what set shift for this accid, same codes
-c
-          if (isetshft(iwa) .lt. 0) then
-            iranksetter = 0
-          else if (isetshft(iwa) .eq. 0) then
-            iranksetter = icrdot0
-          else
-            iranksetter = igetbits(icrdot(isetshft(iwa)),3,27)
-          end if
-          if (iranksetter.ne.0 .and. irank.ne.iranksetter+1) then
-            rmsshift = 1000.
-            return
-          end if
-        end if
-        rmsshift = rmsshift+shift**2        
-        if (lasttime .and. abs(shift).gt..0001) then
-          if (mainnote) then
-            if (.not.btest(nacc,29)) go to 10
-          else
-            if (.not.btest(icrdat(micrd(iwa)),29)) go to 10
-          end if
-c
-c  If here, "A" was set on a manual shift, so must cumulate the shift.  Note that if there
-c    was a manual shift but auto-shift was zero, will not come thru here, but shift value
-c    will be left intact.
-c
-          if (mainnote) then
-            shift = shift+.05*(igetbits(nacc,7,10)-107)
-          else
-            shift = shift+.05*(igetbits(icrdot(micrd(iwa)),7,20)-107)
-          end if
-10        continue
-          if (twooftwo) then
-c
-c  Record the shift for this accidental
-c         
-            if (shift .lt. -5.35) then
-              call printl(' ')
-              call printl('WARNING: auto-generated accidental '//
-     *                               'shift too big for PMX, ignoring')
-            else
-              ishift = nint(20*(shift+5.35))
-              if (mainnote) then
-                call setbits(nacc,7,10,ishift)
-              else
-                call setbits(icrdot(micrd(iwa)),7,20,ishift)
-              end if
-            end if
-          else
-c
-c  This is the earlier call to precrd, so need minimum shift
-c
-            shiftmin = min(shiftmin,shift)
-          end if
-        end if
-c
-c  Bail out if this is the last accidental to check
-c
-        if (iwa .eq. naccid) go to 1
-c
-c  Add this accidental to the right barrier! Count down from highest barrier segment,
-c    find 1st one starting below top of accid, and first one starting below bot.
-c  
-        do 5 ibelowtop = nsegrb , 1 , -1
-          if (segrb(2,ibelowtop) .lt. 
-     *          nolev+segal(iacctype,2,nsegal(iacctype))) then
-            do 9 ibelowbot = ibelowtop , 1 , -1
-              if (segrb(2,ibelowbot) .lt. 
-     *            nolev+segal(iacctype,2,1)) go to 6
-9           continue
-            print*,'Oops2!'
-            call stop1()
-          end if
-5       continue
-        print*,'Ugh0! in crdaccs'
-        call stop1()
-6       continue
-        netgain = nsegal(iacctype)-ibelowtop+ibelowbot
-c
-c  Shift high segments up
-c
-        if (netgain .ge. 0) then
-          do 7 isegrb = nsegrb , ibelowtop+1 , -1
-            segrb(1,isegrb+netgain) = segrb(1,isegrb)
-            segrb(2,isegrb+netgain) = segrb(2,isegrb)
-            ksegrb(isegrb+netgain) = ksegrb(isegrb)
-7         continue
-c
-c  Set up 1st segment above accid
-c
-          segrb(1,ibelowtop+netgain) = segrb(1,ibelowtop)
-          segrb(2,ibelowtop+netgain) = 
-     *         nolev+segal(iacctype,2,nsegal(iacctype))
-          ksegrb(ibelowtop+netgain) = ksegrb(ibelowtop)
-        else
-c
-c  netgain<0, must remove segments. Use same coding but reverse order,
-c    work from bottom up
-c
-          segrb(1,ibelowtop+netgain) = segrb(1,ibelowtop)
-          segrb(2,ibelowtop+netgain) = 
-     *         nolev+segal(iacctype,2,nsegal(iacctype))
-          ksegrb(ibelowtop+netgain) = ksegrb(ibelowtop)
-          do 12 isegrb = ibelowtop+1 , nsegrb 
-            segrb(1,isegrb+netgain) = segrb(1,isegrb)
-            segrb(2,isegrb+netgain) = segrb(2,isegrb)
-            ksegrb(isegrb+netgain) = ksegrb(isegrb)
-12        continue
-        end if  
-c
-c  Insert new segments
-c
-        do 8 isega = 1 , nsegal(iacctype)-1
-          segrb(1,ibelowbot+isega) = shift+segal(iacctype,1,isega)
-          segrb(2,ibelowbot+isega) = nolev+segal(iacctype,2,isega)
-          if (mainnote) then 
-            ksegrb(ibelowbot+isega) = 0
-          else
-            ksegrb(ibelowbot+isega) = micrd(iwa)
-          end if
-8       continue
-c
-c  Update number of barrier segments
-c
-        nsegrb = nsegrb+netgain
-cc
-cc  Temporary printout for boundary segments as built up
-cc
-c      write(15,'()')
-c      write(15,'(a/(2f8.2,i5))')'  y       x       kseg',
-c     *    (segrb(2,iseg),segrb(1,iseg),ksegrb(iseg),iseg=1,nsegrb)
-c      write(15,'(a/(2i5))')' micrd isetshft',
-c     *    (micrd(iwa1),isetshft(iwa1),iwa1=1,iwa)
-cc
-1     continue   ! next accidental 
-      if (lasttime .and. .not.twooftwo) then
-c
-c  This is the final call on the pre-ask pass, so compute left-shift rqmt.
-c
-	  icashft = nint(-20*shiftmin)
-      end if
-cc
-cc  Temporary printout for boundary segments
-cc
-c      if (twooftwo) then
-c      write(15,'()')
-c      write(15,'(a/(2f8.2,i5))')'  y       x       kseg',
-c     *    (segrb(2,iseg),segrb(1,iseg),ksegrb(iseg),iseg=1,nsegrb)
-c      write(15,'(a/(2i5))')' micrd isetshft',
-c     *    (micrd(iwa),isetshft(iwa),iwa=1,naccid)
-c      end if
-cc
-      return
-      end
-      subroutine crdaccs(nacc,ipl,irest,naccid,kicrd,nolevm,
-     *                   levmaxacc,levminacc,icrdot0,twooftwo,icashft)
-c
-c       nacc = accidental bitmap for main note
-c       naccid = # of accid's in chord
-c       kicrd = array with icrd #'s for notes w/ acc's, 0=>main note
-c       nolevm = level of main note
-c
-c  This is called once per multi-accidental chord.  In here, loop over all
-c  permutations of the order of accidental as stored in kicrd.  Each time thru
-c  loop, call crdacc once, get rms shift.  Only save permutation and rms value
-c  if it is less than old value.
-c
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-c
-c  Make consistent? 120106
-c      integer*4 kicrd(7),iperm(7),micrd(10),ipermsav(7),ksegrb0(50)
-      integer*4 kicrd(10),iperm(7),micrd(10),ipermsav(7),ksegrb0(50)
-      real*4 segrb0(2,50)
-      logical btest,tagged,manual,lshift,twooftwo
-cc
-cc  Temporary printout of level-rankings
-cc
-c      write(15,'()')
-c      do 98 iacc = 1 , naccid
-c        if (kicrd(iacc) .eq. 0) then
-c          write(15,'(3i5)')nolevm,icrdot0
-c        else
-c          write(15,'(2i5)')igetbits(icrdat(kicrd(iacc)),7,12),
-c     *                     igetbits(icrdot(kicrd(iacc)),3,27)
-c        end if
-c98    continue
-cc
-c
-c  Initialize right-barrier
-c
-      segrb0(1,1) = 0.
-      segrb0(2,1) = -1000.
-      segrb0(1,2) = 0.
-      segrb0(2,2) = 1000.
-      nsegrb0 = 2
-      ksegrb0(1) = -1
-      ksegrb0(2) = -1
-c
-c  Search for left-shifted notes, Make up the initial right-barrier, which
-c     will be good for all permutations.
-c     irest()(27) is set if any notes are left-shifted
-c     Must use ALL chord notes, not just ones w/ accid's.
-c
-      if (btest(irest,27)) then
-        do 15 icrd = icrd1-1, icrd2
-          if (icrd .eq. icrd1-1) then
-c
-c  Main note
-c
-c            lshift = btest(ipl,8) 
-            lshift = btest(ipl,8) .or. btest(nacc,31) 
-            if (lshift) nolev = nolevm
-          else
-c
-c  Chord note
-c
-            lshift = btest(icrdat(icrd),23)
-c            if (lshift) nolev = igetbits(icrdat(icrd),7,12)
-            if (lshift) then
-              nolev = igetbits(icrdat(icrd),7,12)
-              if (btest(nacc,31) .and. nolev.eq.nolevm+1) then
-c
-c  This note is not really shifted, It is the upper of a 2nd with the main
-c    note on an upstem, and Main note must be shifted. 
-c    nacc(31) signals the real truth.
-c
-                lshift = .false.
-              end if
-            end if
-          end if
-          if (lshift) then
-            do 16 isegrb = 1 , nsegrb0-1
-              if (segrb0(2,isegrb+1) .gt. nolev-1) then
-c
-c  Add this notehead to the right boundary here.  Move all higher segs up 2.
-c
-                do 17 iiseg = nsegrb0 , isegrb+1 , -1
-                  segrb0(1,iiseg+2) = segrb0(1,iiseg)   
-                  segrb0(2,iiseg+2) = segrb0(2,iiseg)
-                  ksegrb0(iiseg+2) = ksegrb0(iiseg)
-17              continue
-                go to 18
-              end if
-16          continue
-18          continue
-c
-c  Insert notehead into list. Set kseg=-2 to signal notehead shift.
-c
-            iiseg = isegrb+1
-            segrb0(1,iiseg) = -1.2
-            segrb0(2,iiseg) = nolev-1.
-            ksegrb0(iiseg) = -2
-            segrb0(1,iiseg+1) = 0.
-            segrb0(2,iiseg+1) = nolev+1.
-            ksegrb0(iiseg+1) = -1
-            nsegrb0 = nsegrb0+2
-          end if
-15      continue
-      end if
-c
-c  Done setting right barrier for left-shifted noteheads
-c
-      tagged = .false.
-      manual = .false.
-c
-c  Preprocess to check for manual shifts.
-c   If are manual main [nacc(10-16)] or chord note [icrdot(20-26)]shifts, then
-c      If any manual shift is preceded by "A" [nacc(29), icrdat(29)] then
-c         1. Auto-shifting proceeds
-c         2. "A"-shifts add to autoshifts
-c         3. non-"A" shifts are ignored!
-c      Else (>0 man shifts, none has "A")
-c         No auto-ordering, No autoshifts, Observe all manual shifts.
-c      End if
-c   End if
-c
-	maxmanshft = 0
-      do 13 i = 1 , naccid
-        if (kicrd(i) .eq. 0) then
-c
-c  Main note
-c		
-          manshft = igetbits(nacc,7,10)
-          if (manshft .ne. 0) then
-            manual = .true.
-            if (btest(nacc,29)) then
-              tagged = .true.
-            else
-c              maxmanshft = max(maxmanshft,64-manshft)              
-              maxmanshft = max(maxmanshft,107-manshft)              
-            end if
-          end if
-        else
-c
-c  Chord note
-c
-          manshft = igetbits(icrdot(kicrd(i)),7,20)
-          if (manshft .ne. 0) then
-            manual = .true.
-            if (btest(icrdat(kicrd(i)),29)) then
-              tagged = .true.
-            else
-c              maxmanshft = max(maxmanshft,64-manshft)              
-              maxmanshft = max(maxmanshft,107-manshft)              
-            end if
-          end if
-        end if
-13    continue
-      if (manual) then
-        if (tagged) then
-c
-c  zero out all untagged shifts
-c
-          do 14 i = 1 , naccid
-            if (kicrd(i) .eq. 0) then
-              if (.not.btest(nacc,29)) call setbits (nacc,7,10,0)
-            else
-              if (.not.btest(icrdat(kicrd(i)),29)) 
-     *               call setbits (icrdot(kicrd(i)),7,20,0)
-            end if
-14        continue
-        else
-c
-c  There are manual shifts but none tagged. Only proceed if "Ao" was entered 
-c
-          if (.not.btest(nacc,28)) then
-            icashft = maxmanshft
-            return
-          end if
-        end if
-      end if
-      if (btest(nacc,28)) then
-c
-c  Take the accidentals in order as originally input, then exit.
-c
-        call crdacc(nacc,naccid,kicrd,nolevm,rmsshift,.true.,
-     *           idummy,idummy,segrb0,ksegrb0,nsegrb0,twooftwo,icashft)  
-        return
-c      end if
-      else if (naccid .eq. 3) then
-c
-c  Special treatment if 3 accidentals in chord. If there aren't accids on a 2nd
-c    then place in order top, bottom, middle. 
-c
-        do 20 i = 1 , 3
-          if (kicrd(i) .eq. 0) then
-            irank = icrdot0
-            nolev = nolevm
-		else
-            irank = igetbits(icrdot(kicrd(i)),3,27)
-            nolev = igetbits(icrdat(kicrd(i)),7,12) 
-          end if
-          if (irank .eq. 1 ) then
-            micrd(1) = kicrd(i)
-          else
-            micrd(5-irank) = kicrd(i)
-          end if
-	    if (irank .eq. 2) then
-		  levmidacc = nolev 
-          end if
-20      continue 
-        if (levmaxacc.ne.levmidacc+1 .and. 
-     *              levmidacc.ne.levminacc+1) then
-          call crdacc(nacc,naccid,micrd,nolevm,rmsshift,.true.,
-     *            idummy,idummy,segrb0,ksegrb0,nsegrb0,twooftwo,icashft)  
-          return
-        end if
-      end if
-      rmsmin = 100000.
-c
-c  Initialize permutation array
-c
-      do 7 i = 1 , naccid 
-        iperm(i) = i
-7     continue
-c
-c  Start looping over permutations
-c
-      do 8 ip = 1 , 5041
-        if (ip .ne. 1) then
-c
-c  Work the magic algorithm to get the next permutation
-c
-          do 1 k = naccid-1 , 1 , -1
-            if (iperm(k) .le. iperm(k+1)) go to 2
-1         continue
-c
-c  If here, we just got the last permutation, so exit the loop over permutations
-c
-          go to 10
-2         continue
-          do 3 j = naccid , 1 , -1
-            if (iperm(k) .le. iperm(j)) go to 4
-3         continue
-4         continue
-          it = iperm(j)
-          iperm(j) = iperm(k)
-          iperm(k) = it
-          is = k+1
-          do 5 ir = naccid , 1 , -1
-            if (ir .le. is) go to 6
-            it = iperm(ir)
-            iperm(ir) = iperm(is)
-            iperm(is) = it
-            is = is+1
-5         continue
-6         continue
-        end if
-c
-c  New we have a permutation.  Take icrd values out of kicrd and put them into
-c  micrd in the order of the permutation
-c
-        do 9 i = 1 , naccid
-          micrd(i) = kicrd(iperm(i))
-9       continue
-cc
-cc  Temporary printout
-cc
-c      write(15,'(/a6,10i3)')'perm:',(iperm(i),i=1,naccid)
-cc
-        call crdacc(nacc,naccid,micrd,nolevm,rmsshift,.false.,
-     *       levmaxacc,icrdot0,segrb0,ksegrb0,nsegrb0,twooftwo,icashft)  
-cc
-cc  Temporary printout
-cc
-c      write(15,*)'perm done, rmsshift:',rmsshift
-cc
-        if (rmsshift .lt. rmsmin) then
-c
-c  Save this permutation, reset minrms
-c
-          do 11 i = 1 , naccid
-            ipermsav(i) = iperm(i)
-            rmsmin = rmsshift
-11        continue
-        end if
-8     continue          
-      print*,'Should not BEEEEEE here!'
-      call stop1()
-10    continue          
-c
-c  Done looping, get info for the final choice
-c
-      do 12 i = 1 , naccid
-        micrd(i) = kicrd(ipermsav(i))
-12    continue
-cc
-cc  Temporary printout
-cc
-c      write(15,'(/a6,10i3)')'Final perm:',(ipermsav(i),i=1,naccid)
-cc
-      call crdacc(nacc,naccid,micrd,nolevm,rmsshift,.true.,
-     *            idummy,idummy,segrb0,ksegrb0,nsegrb0,twooftwo,icashft)  
-      return
-      end          
-      subroutine doacc(ihshft,ivshft,notexq,lnote,nacc,nolev,ncm,caut)
-      character*1 sq,chax
-      character*3 acsymq
-      character*8 noteq
-      character*79 notexq
-      logical btest,caut
-      sq = chax(92)
-      if (ihshft .eq. -107) ihshft=0
-cc
-cc  If main note shifted left, so shift accid.  Terminate below, when acc. is done.
-cc
-      if (ihshft .ne. 0) then
-c
-c  Accid must be shifted horizontally
-c
-        if (ihshft .lt. 0) then
-          notexq = sq//'loffset{'
-          ihshft = -ihshft
-        else
-          notexq = sq//'roffset{'
-        end if
-        hshft = .05*ihshft
-        if (hshft .lt. 1.) then
-          write(notexq(10:12),'(f3.2)')hshft
-          lnote = 12
-        else
-          write(notexq(10:13),'(f4.2)')hshft
-          lnote = 13
-        end if
-        notexq = notexq(1:lnote)//'}{'//sq
-        lnote = lnote+3
-      else
-        notexq = sq
-        lnote = 1
-      end if
-      if (btest(nacc,3)) then
-        notexq = notexq(1:lnote)//'big'
-        lnote = lnote+3
-      end if
-      if (caut) then
-c
-c  Cautionary accidental.  Need to define bigcna,... in pmx.tex
-c
-        notexq = notexq(1:lnote)//'c'
-        lnote = lnote+1
-      end if
-      call accsym(nacc,acsymq,lacc)
-      notexq = notexq(1:lnote)//acsymq(1:lacc)
-      lnote = lnote+lacc
-      noleva = nolev
-      if (ivshft .ne. 0) noleva = noleva+ivshft-32
-      call notefq(noteq,lnoten,noleva,ncm)
-      if (lnoten .eq. 1) call addblank(noteq,lnoten)
-      notexq = notexq(1:lnote)//noteq(1:lnoten)
-      lnote = lnote+lnoten
-      if (ihshft .ne. 0) then
-c
-c  Terminate horizontal shift
-c
-        notexq = notexq(1:lnote)//'}'
-        lnote = lnote+1
-      end if
-      return
-      end
-      subroutine docrd(ivx,ip,nodu,ncm,iv,tnow,soutq,lsout,ulq,ibmcnt,
-     *                 islur,nvmx,nv,beamon,nolevm,ihornb,nornb,stemlen,
-     *                 dotxtup,nacc)
-      parameter (nm=24,mv=24576)
-      common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
-     *                xinsnow,lowdot
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
-     *                flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
-     *                rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
-     *                rtshfac
-      integer*2 mmidi,iinsiv
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      logical lowdot,dotxtup
-      integer*4 ihornb(nm,24),nornb(nm)
-      character*1 ulq(nm,9),chax
-      character*7 nosymq
-      character*8 noteq
-      character*79 notexq,outq
-      character*80 soutq
-      logical btest,isleft,isright,beamon
-      character*79 inameq
-      common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
-     *   isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
-     *   lnam(nm),inameq(nm)
-      common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
-     *  instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
-      logical EarlyTransOn,LaterInstTrans
-      common /commidisig/ midisig
-c 130316
-      common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
-     *                ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
-c
-c
-c  This subr. once produced notexq for entire chord.  10/18/97 altered to write
-c    chord notes as we go.  10/22/97 find range of icrd first.
-c    2/25/98 moved rangefinding to precrd so done before slurs, so now
-c    on entry, icrd1, icrd2 define range of icrd for this chord.
-c
-c  Set counter (for this note) for chord notes present.  Set notmain=T.
-c    Will test for notmain=.true. in addmidi to tell whether to save pitch.  
-c
-      nmidcrd = 0
-      notmain = .true.
-      crdacc = .false.
-      do 5 icrd = icrd1 , icrd2
-        lnote = 0
-        nolev = igetbits(icrdat(icrd),7,12)
-c
-c  3/8/03 save original pitch to use in midi, in case 2nds alter things.
-c
-        nolevo = nolev
-c
-c  Check for special situations with 2nds (see precrd).
-c
-        if (btest(nacc,30)) then
-          if (nolev .eq. nolevm-1) nolev = nolevm
-        else if (btest(nacc,31)) then
-          if (nolev .eq. nolevm+1) nolev = nolevm
-        end if
-c
-c  Lower dot for lower-voice notes?.  Conditions are:
-c   1. Dotted time value
-c   2. Lower voice of two
-c   3. Note is on a line
-c   4. Not a rest (cannot be a rest in a chord!)
-c.  5. Flag (lowdot) is set to true
-c
-        if (lowdot .and. nvmx.eq.2 .and. ivx.le.nv) then
-	    if (2**log2(nodu).ne.nodu .and. mod(nolev-ncm,2).eq.0) then
-	      if (btest(icrdat(icrd),26)) then
-c
-c  Note already in movdot list.  Drop by 2.
-c
-	        call setbits(icrdot(icrd),7,0,
-     *                      igetbits(icrdot(icrd),7,0)-20)
-            else
-c
-c  Not in list so just move it right now
-c
-	        call dotmov(-2.,0.,soutq,lsout,igetbits(islur,1,3))
-	      end if
-	    end if
-	  end if
-	  if (btest(icrdat(icrd),26)) then
-c
-c  Move the dot.
-c
-	    updotc = 0.1*(iand(127,icrdot(icrd))-64)
-	    rtdotc = 0.1*(iand(127,ishft(icrdot(icrd),-7))-64)
-	    call dotmov(updotc,rtdotc,soutq,lsout,igetbits(islur,1,3))
-	  end if
-	  isleft = btest(icrdat(icrd),23)
-	  isright = btest(icrdat(icrd),24)
-c
-c  Check for ornament in chord.
-c
-	  if (icrdorn(icrd) .gt. 0) then
-	    call putorn(icrdorn(icrd),nolev,nolevm,nodu,nornb,ulq,
-     *         ibmcnt,ivx,ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout,
-     *         ip,0,beamon,.true.)
-c
-c     subroutin putorn(iornq,nolev,nolevm,nodur,nornb,ulq,ibmcnt,ivx,
-c    *     ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout,ip,islhgt,
-c    *     notcrd,beamon,iscrd)
-c
-          call addstr(outq,lout,soutq,lsout)
-        end if
-c
-c  Chord-note symbol.  First check for breve
-c
-        if (nodu .eq. 128) then
-          nosymq = chax(92)//'zbreve'
-          lsym = 7
-        else
-c
-c  Not a breve chord.  Get first letters in chord-note symbol
-c
-          if (isleft) then
-            nosymq = chax(92)//'l'
-          else if (isright) then
-            nosymq = chax(92)//'r'
-          else
-            nosymq = chax(92)//'z'
-          end if
-          if (nodu .ge. 64) then
-            nosymq = nosymq(1:2)//'w'
-          else if (nodu .ge. 32) then
-            nosymq = nosymq(1:2)//'h'
-          else
-            nosymq = nosymq(1:2)//'q'
-          end if
-          if (2**log2(nodu).eq.nodu .and. .not.dotxtup) then
-            lsym = 3
-          else if (.not.btest(islur,3) .or. dotxtup) then
-c
-c  Single dot
-c
-            nosymq = nosymq(1:3)//'p'
-            lsym = 4
-          else
-c
-c  Double dot
-c
-            nosymq = nosymq(1:3)//'pp'
-            lsym = 5
-          end if
-        end if
-        if (btest(icrdat(icrd),19).and..not.btest(icrdat(icrd),27)) then
-c
-c  Accidental and not MIDI-only.  Build up bits 0-3 of nacc
-c
-          nactmp = igetbits(icrdat(icrd),3,20)
-c
-c  Kluge for bigness.  Only means 'As' has not been issued
-c
-          if (bacfac .ne. 1.e6) nactmp = nactmp+8
-          call doacc(igetbits(icrdot(icrd),7,20)-107,
-     *        igetbits(icrdot(icrd),6,14),
-c     *        notexq,lnote,nactmp,nolev,ncmid(iv,ip))
-c  Get original nolev, not altered to deal with 2nds
-     *        notexq,lnote,nactmp,igetbits(icrdat(icrd),7,12),
-c     *        ncmid(iv,ip))
-     *        ncmid(iv,ip),btest(icrdat(icrd),31))
-          notexq = notexq(1:lnote)//nosymq
-          crdacc = .true.
-        else
-          notexq = nosymq
-        end if
-        lnote = lnote+lsym
-c
-c  Get note name (again if accid, due to possible octave jump)
-c
-        call notefq(noteq,lnoten,nolev,ncm)
-        if (lnoten.eq.1) call addblank(noteq,lnoten)
-c
-c  Put in note name
-c
-        notexq = notexq(1:lnote)//noteq
-        lnote = lnote+lnoten
-        if (btest(icrdat(icrd),25)) then
-c
-c  Arpeggio signal
-c
-          call putarp(tnow,ivx,ip,nolev,ncm,soutq,lsout)
-        end if
-        call addstr(notexq,lnote,soutq,lsout)
-        if (ismidi) then
-c
-c  Here is where we collect MIDI pitch info for the chord note.  By checking
-c    notmain, addmidi(...) knows to just compute the 
-c    pitch number and store it in mcpitch(nmidcrd).  Then on call to addmidi()
-c    for MAIN note, will put in note codes for all chord notes + main note.
-c   
-          kv = 1
-          if (ivx .gt. iv) kv=2
-          nmidcrd = nmidcrd+1
-          if (nmidcrd .gt. 20) then
-            print*
-            print*,'21 chord notes is too many for midi processor'
-            call stop1()
-          end if
-c
-c  Use original saved pitch level, unaltered by 2nds logic.
-c
-c 130316
-c          call addmidi(midchan(iv,kv),nolevo-iTransAmt(instno(iv)),
-          call addmidi(midchan(iv,kv),nolevo+miditran(instno(iv)),
-c     *             igetbits(icrdat(icrd),3,20),isig,1.,.false.,.false.)
-c 130316
-c     *      igetbits(icrdat(icrd),3,20),midisig(instno(iv)),1.,
-     *      igetbits(icrdat(icrd),3,20),midisig,1.,
-
-
-     *      .false.,.false.)
-        end if
-5     continue
-      notmain = .false.
-      return
-      end
-      subroutine dodyn(ivx,ip,nolev,ncm,ipl,islur,irest,nvmx,nv,
-     *                beamon,ihornb,nornb,ulq,ibmcnt,nostem,soutq,lsout) 
-      parameter (nm=24)
-c
-c  Inputs are array *elements* except ihornb,nornb,ulq
-c
-      common /commus/ musize,whead20
-      common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12),
-     *        hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41),
-     *        idynda2(99),levhssav(nm),listcresc,listdecresc
-      character*128 txtdynq
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      logical btest,beamon,upstem,nostem
-      common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
-     *                 ,WrotePsslurDefaults,SlurCurve
-      logical fontslur,upslur,WrotePsslurDefaults
-      character*1 udqq,chax,ulq(nm,9)
-      character*4 dynstrq
-      character*5 numpq
-      character*48 dyntablq,tempq
-      character*79 notexq
-      character*80 soutq
-      integer*4 ihornb(nm,24),nornb(nm),idynn(10)
-      data dyntablq /'ppppppp pp  p   mp  mf  f   fp  sfz ff  fff ffff'/
-      numdyn = 0
-c
-c  Find dynamics for (ivx,ip) in list.  May be as many as 4.  Store idyn values 
-c      in idynn(1...4)
-c
-      do 1 idyn = 1 , ndyn
-c        ivxtent = iand(idyndat(idyn),15)        
-        ivxtent = iand(idyndat(idyn),15)
-     *                 +16*igetbits(idynda2(idyn),1,10)
-	  if (ivxtent .eq. ivx) then
-          iptent = igetbits(idyndat(idyn),8,4)
-          if (iptent .eq. ip) then
-            numdyn = numdyn+1
-            idynn(numdyn) = idyn	  
-          else if (iptent .gt. ip) then
-c
-c  I don't think there are any more possible for this ivx,ip, so exit loop
-c
-            go to 2
-          end if
-c        else if (ivxtent .gt. ivx) then
-c          go to 2
-        end if
-1     continue
-2     continue
-c
-c  At this point there is a list of idyn's in idynn(1...numdyn)
-c  Compute level, and stem-dir'n-based horizontal tweaks
-c
-      hoffsd = 0.
-c
-c  Set upstem to false as default
-c
-      upstem = .false.
-      if (btest(irest,0)) then
-c
-c  It's a rest.  Assume it doesn't go below the staff
-c
-        lbot = ncm-4  
-      else if (.not.beamon) then
-        if (udqq(nolev,ncm,islur,nvmx,ivx,nv).eq.'u' .or. nostem) then
-          upstem = .true.
-          if (.not.btest(ipl,10)) then
-            lbot = min(nolev-1,ncm-4)
-          else
-            lbot = min(minlev-1,ncm-4)
-          end if
-        else
-          hoffsd = -.5
-          if (.not.btest(ipl,10)) then
-            lbot = min(nolev-7,ncm-4)
-          else
-            lbot = min(minlev-7,ncm-4)
-          end if
-        end if
-      else
-        if (ulq(ivx,ibmcnt) .eq. 'u') then
-          upstem = .true.
-          if (.not.btest(ipl,10)) then
-            lbot = min(nolev-1,ncm-4)
-          else
-            lbot = min(minlev-1,ncm-4)
-          end if
-        else
-          hoffsd = -.5
-          lbot = ihornb(ivx,nornb(ivx))+1
-          if (lbot .eq. 1) then
-c
-c Kluge for non-beamed, down xtup, for which ihorb was never set.
-c Assumes stem is shortened.
-c
-            lbot = nolev-5
-          end if
-          nornb(ivx) = nornb(ivx)+1
-        end if
-      end if
-      lbot = lbot-5
-      jtxtdyn1 = 1
-c
-c  Now ready to loop over current dyn's
-c
-      do 3 icntdyn = 1 , numdyn
-        idynd = idyndat(idynn(icntdyn))
-        idynd2 = idynda2(idynn(icntdyn))
-        idno = igetbits(idynd,4,12)
-c        ivx = iand(15,idynd)
-        ivx = iand(15,idynd)+16*igetbits(idynd2,1,10)
-c
-c  Build the command into notex in stages. Insert name & rq'd args in order:
-c
-c    Command name
-c	 hpstrt, hpcend, hpdend, pmxdyn
-c    ivx
-c        X       X       X
-c    level
-c                X       X       X
-c    hoff
-c        X       X       X       X
-c    d-mark
-c                                X
-c
-        if (idno .eq. 0) then
-c
-c  Text-dynamic
-c
-          notexq = chax(92)//'txtdyn'
-          lnote = 7
-        else if (idno .le. 12) then
-c
-c  Letter-group
-c
-          notexq = chax(92)//'pmxdyn'
-          lnote = 7
-        else if (fontslur) then
-          lnote = 7
-          if (idno .eq. 13) then
-c
-c  Start a hairpin
-c
-            notexq = chax(92)//'hpstrt'
-          else if (idno .eq. 14) then
-c
-c  End crescendo
-c
-            notexq = chax(92)//'hpcend'
-          else
-c
-c  End decrescendo
-c
-            notexq = chax(92)//'hpdend'
-          end if
-        else
-c
-c  Postscript hairpins
-c          
-          lnote = 7
-          if (idno .eq. 13) then
-            notexq = chax(92)//'Icresc'
-          else if (idno .eq.14) then
-            notexq = chax(92)//'Idecresc'
-            lnote = 9
-          else		         
-            notexq = chax(92)//'Tcresc'
-          end if
-        end if
-        if (idno .ge. 13) then
-c
-c  Put in voice number
-c
-          if (ivx .le. 9) then
-            notexq = notexq(1:lnote)//char(48+ivx)
-            lnote = lnote+1   
-          else if (ivx .le. 19) then
-            notexq = notexq(1:lnote)//'{1'//char(38+ivx)//'}'
-            lnote = lnote+4
-          else
-            notexq = notexq(1:lnote)//'{2'//char(28+ivx)//'}'
-            lnote = lnote+4
-          end if
-        end if
-c
-c  Begin setting level
-c
-        lbot1 = lbot
-        if (idno.gt.0 .and. idno.le.5) then
-c
-c  All letters are short so raise a bit.
-c
-          lbot1 = lbot1+1
-        else if (idno .ge. 13) then
-          lbot1 = lbot1+2
-        end if
-c
-c  Convert so reference is bottom line
-c
-        lbot1 = lbot1-ncm+4
-        if ((fontslur.and.idno.eq.13) .or. 
-     *      ((.not.fontslur).and.(idno.eq.13.or.idno.eq.14))) then
-c
-c  Hairpin start.  Save level and user-tweak before applying user tweak.
-c
-          levdsav(ivx) = lbot1
-          levhssav(ivx) = 0
-          if (btest(idynd,16)) levhssav(ivx) = -64+igetbits(idynd,7,17) 
-        else if ((fontslur.and.idno.ge.14) .or. idno.eq.15) then
-c
-c  Hairpin end; Compare level with saved start level before user-tweaks
-c
-          lbot1 = min(lbot1,levdsav(ivx))         
-c
-c  Save pre-tweak level
-c
-          lpretweak = lbot1
-        end if
-c
-c  Check for user-defined vertical tweak
-c
-        if (btest(idynd,16)) lbot1 = lbot1-64+igetbits(idynd,7,17)  
-c
-c  Now horizontal stuff
-c
-        hoff = hoffsd
-c
-c  Some special horizontal tweaks
-c
-        if (upstem .and. idno.gt.0 .and. 
-     *      (idno.le.4 .or. idno.eq.8 .or. idno.eq.9)) hoff = hoff+.4
-c
-c  User-defined tweaks
-c
-        if (btest(idynd2,0)) 
-     *          hoff = hoff+(igetbits(idynd2,9,1)-256)*.1
-        if (numdyn .gt. 1) then
-c
-c  Horizontal-interaction-based tweaks.  
-c
-c  Cases:
-c  numdyn  type1   type2    type3    data used
-c     2    wrd-grp hrpnstrt -        ivowg(1...12),hoh1(1...12)
-c     2	 hrpnend wrd-grp  -		   ivowg,hoh2
-c     2    hrpnend hrpnstrt -		   hoh2h1(1...2)
-c     3    hrpnend wrd-grp  hrpnstrt ivowg,hoh2,hoh1
-c
-          if (idno.gt.0 .and. idno.le.12) then
-c
-c  Word-group, may need vertical tweak to line up.
-c
-            lbot1 = lbot1+ivowg(idno)
-c
-c  Protecting against hp start-stop on same note
-c
-          else if (((fontslur.and.idno.ge.14).or.idno.eq.15)
-     *                .and. icntdyn.lt.numdyn) then
-c
-c  Hairpin ending, check next type 
-c
-            if ((fontslur .and. 
-     *             igetbits(idyndat(idynn(icntdyn+1)),4,12).eq.13)
-     *          .or. (.not.fontslur .and.   
-     *             ((igetbits(idyndat(idynn(icntdyn+1)),4,12).eq.13) 
-     *                .or.     
-     *              (igetbits(idyndat(idynn(icntdyn+1)),4,12).eq.14)))) 
-     *                     then
-c
-c  Hairpin end then hairpin start, no words, (remember dealing with end now)
-c
-              hoff = hoff+hoh2h1(1)
-            else	       
-c
-c  Hairpin end then word-group, need idno for w-g to set hp offset
-c
-              hoff = hoff +
-     *                hoh2(igetbits(idyndat(idynn(icntdyn+1)),4,12))
-            end if	       
-c
-c  Protecting against hp start-stop on same note
-c
-          else if (icntdyn.gt.1 .and. idno.gt.0 .and. 
-     *            ((fontslur.and.idno.lt.14).or.
-     *                    (.not.fontslur.and.idno.lt.15))) then
-c
-c  Hairpin start, check prior type
-c
-            if ((fontslur.and.
-     *               igetbits(idyndat(idynn(icntdyn-1)),4,12).ge.14) 
-     *          .or.
-     *          (.not.fontslur.and.
-     *               igetbits(idyndat(idynn(icntdyn-1)),4,12).eq.15))
-     *          then
-c
-c  Hairpin end then hairpin start, (remember dealing with start now)
-c
-              hoff = hoff+hoh2h1(2)
-            else	       
-c
-c  Hairpin start after word-group, need idno for w-g to set hp offset
-c
-              hoff = hoff+
-     *                hoh1(igetbits(idyndat(idynn(icntdyn-1)),4,12))
-            end if
-          end if
-        end if
-c
-c  End of if-block for 2- or 3-way interactions.
-c
-        if ((.not.fontslur) .and. idno.ge.13) 
-c
-c  Slur font and hairpin. Add hoff, and change from \interneote to \qn at width 
-c
-     *          hoff = (hoff+.5)*6./2.5
-c
-c  Position corrections all done now.  Put in the level.
-c
-        if ((fontslur.and.idno.eq.13) .or. 
-     *      ((.not.fontslur).and.(idno.eq.13.or.idno.eq.14))) then
-c
-c  Hairpin start.  
-c
-          if (.not.fontslur) then
-c
-c  Postscript hairpin start...inset placeholder for start level.
-
-            notexq = notexq(1:lnote)//'{   }'
-		  lnote = lnote+5
-          end if
-        else 
-c
-c  Insert actual level in all cases except hairpin start
-c  Create string with level in it
-c
-          if (lbot1 .gt. 9) then
-            numpq = '{'
-            write(numpq(2:3),'(i2)')lbot1
-            numpq = numpq(1:3)//'}'
-            lnumpq = 4
-          else if (lbot1 .gt. -1) then
-            numpq = char(48+lbot1)
-            lnumpq = 1
-          else if (lbot1 .gt. -10) then
-            numpq = '{'
-            write(numpq(2:3),'(i2)')lbot1
-            numpq = numpq(1:3)//'}'
-            lnumpq = 4
-          else
-            numpq = '{'
-            write(numpq(2:4),'(i3)')lbot1
-            numpq = numpq(1:4)//'}'
-            lnumpq = 5
-          end if
-c
-c  Level has now been computed and stored in numpq
-c  Append the level
-c
-          notexq = notexq(1:lnote)//numpq(1:lnumpq)
-          lnote = lnote+lnumpq
-        end if
-        if (abs(hoff) .lt. .001) then
-c
-c  No horiz offset  
-c
-          notexq = notexq(1:lnote)//'0'
-          lnote = lnote+1
-        else
-c
-c  Horizontal tweak
-c
-          lform = lfmt1(hoff)
-          notexq = notexq(1:lnote)//'{'
-          lnote = lnote+1
-          write(notexq(lnote+1:lnote+lform),
-     *             '(f'//chax(48+lform)//'.1)')hoff
-          lnote = lnote+lform
-          notexq = notexq(1:lnote)//'}'
-          lnote = lnote+1
-        end if
-        if (idno .eq. 0) then
-c
-c  text-dynamic.  Find the string and append it
-c
-          do 4 jtxtdyn = jtxtdyn1 , ntxtdyn
-c            ivxip = ivx+16*ip
-            ivxip = ivx+32*ip
-            if (ivxip .eq. ivxiptxt(jtxtdyn)) go to 5
-4         continue
-          call printl('Abnormal stop in putdyn')
-          call stop1()
-5         continue
-          ltxtdyn = lenstr(txtdynq(jtxtdyn),128)
-c
-c  Font size based on musicsize
-c
-          if (musize .eq. 20) then
-            notexq = notexq(1:lnote)//'{'//char(92)//'medtype'
-     *               //char(92)//'it '
-            lnote = lnote+13   
-          else if (musize .eq. 16) then
-            notexq = notexq(1:lnote)//'{'//char(92)//'normtype'
-     *               //char(92)//'it '
-            lnote = lnote+14   
-          else if (musize .eq. 24) then
-            notexq = notexq(1:lnote)//'{'//char(92)//'bigtype'
-     *               //char(92)//'it '
-            lnote = lnote+13   
-          else if (musize .eq. 29) then
-            notexq = notexq(1:lnote)//'{'//char(92)//'Bigtype'
-     *               //char(92)//'it '
-            lnote = lnote+13   
-          end if
-          notexq = notexq(1:lnote)//txtdynq(jtxtdyn)(1:ltxtdyn)
-     *             //'}'
-          lnote = lnote+ltxtdyn+1
-c
-c  Reset jtxtdyn1 just in case >1 txtdyn on same note.
-c
-          jtxtdyn1 = jtxtdyn+1
-        else if (idno .le. 12) then
-c
-c  Letter-group dynamic.  Append the letter-group command
-c
-          id = 4*idno
-          dynstrq = dyntablq(id-3:id)
-          id = lenstr(dynstrq,4)
-          notexq = notexq(1:lnote)//chax(92)//dynstrq(1:id)
-          lnote = lnote+1+id
-        end if 
-        call addstr(notexq(1:lnote),lnote,soutq,lsout)
-        if ((.not.fontslur).and.idno.eq.15) then
-c
-c  PS slurs on, hairpin is ending.  Go back and set height at beginning.
-c  Add user-defined tweak to default level
-c
-          lbot1 = lpretweak+levhssav(ivx)
-          if (lbot1 .gt. 9) then
-            numpq = '{'
-            write(numpq(2:3),'(i2)')lbot1
-            numpq = numpq(1:3)//'}'
-            lnumpq = 4
-          else if (lbot1 .gt. -1) then
-            numpq = char(48+lbot1)
-            lnumpq = 1
-          else if (lbot1 .gt. -10) then
-            numpq = '{'
-            write(numpq(2:3),'(i2)')lbot1
-            numpq = numpq(1:3)//'}'
-            lnumpq = 4
-          else
-            numpq = '{'
-            write(numpq(2:4),'(i3)')lbot1
-            numpq = numpq(1:4)//'}'
-            lnumpq = 5
-          end if
-c
-c  Construct string to search backwards for placeholder
-c
-          if (ivx .le. 9) then
-            tempq = 'cresc'//char(48+ivx)//'{   }'
-            ltemp = 11   
-          else if (ivx .le. 19) then
-            tempq = 'cresc'//'{1'//char(38+ivx)//'}{   }'
-            ltemp = 14   
-          else
-            tempq = 'cresc'//'{2'//char(28+ivx)//'}{   }'
-            ltemp = 14   
-          end if
-          write(11,'(a)')soutq(1:lsout)//'%'
-          lsout = 0
-          call backfill(11,tempq,ltemp,
-     *           tempq(1:ltemp-5)//numpq(1:lnumpq),ltemp-5+lnumpq)
-        end if
-3     continue
-c
-c  Shrink arrays, decrease ndyn 111109
-c
-      do 6 icntdyn = numdyn, 1 , -1
-        do 7 jdyn = idynn(icntdyn) , ndyn-1
-          idyndat(jdyn) = idyndat(jdyn+1) 
-          idynda2(jdyn) = idynda2(jdyn+1)
-7       continue
-        ndyn = ndyn-1
-6     continue
-      end
-      subroutine dograce(ivx,ip,ptgr,soutq,lsout,ncm,nacc,ig,ipl,
-     *  farend,
-     *  beamon,nolev,ncmidx,islur,nvmx,nv,ibmcnt,tnote,ulq,instno)
-c
-c  ip will be one LESS than current note, for way-after's before bar-end,
-c    It is only used to find ig.
-c  ig is returned to makeabar in case there's a slur that needs to be ended
-c
-      parameter (nm=24)
-      logical beamon,stemup
-      common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
-     *                nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
-     *                noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
-     *                graspace(37),
-     *                lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
-     *                naccg(74),voltxtq(6),litq(83)
-      common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
-     *                flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
-     *                rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
-     *                rtshfac
-      common /comask/ bar1syst,fixednew,scaldold,
-     *                wheadpt,fbar,poenom
-      common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
-     *                 ,WrotePsslurDefaults,SlurCurve
-      common /comoct/ noctup
-      logical upg,slurg,slashg,bar1syst,upslur,btest,isgaft,iswaft,
-     *        normsp,farend,fontslur,WrotePsslurDefaults
-      real*4 ptgr(37)
-      character*80 soutq
-      character*128 litq
-      character*79 notexq
-      character*20 voltxtq
-      character*10 figq
-      character*8 noteq,noteqGA
-      character*3 acsymq
-      character*1 sq,chax,udqq,ulq(nm,9)
-      common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
-     *                fullsize(nm),ivxfig2,ivvfig(2,74)
-      sq = chax(92)
-      isgaft = btest(ipl,29)
-      iswaft = btest(ipl,31)
-      normsp = .not. isgaft
-c
-c  Find ig.
-c
-      do 120 ig = 1 , ngrace
-        if (ipg(ig).eq.ip .and. ivg(ig).eq.ivx) go to 121
-120   continue
-      print*,'Problem finding grace index in dograce'
-      stop
-121   continue
-      ngs = ngstrt(ig)
-      mg = multg(ig)
-c	wheadpt1 = wheadpt*fullsize(ivx)
-	wheadpt1 = wheadpt*fullsize(instno)
-c
-c  For way-after-graces at end of bar, must set the octave.
-c
-      if (farend) then
-        noctup = 0
-        if (ncm .eq.23) noctup = -2
-      end if
-      if (slurg(ig) .and. .not.iswaft .and..not.isgaft) then
-         if (listslur .eq. 16777215) then
-          print*
-          print*,'You defined the twentyfifth slur, one too many!'
-          write(15,'(/,a)')
-     *           'You defined the twentyfifth slur, one too many!'
-          call stop1()
-        end if
-c
-c  Slur on fore-grace.  Get index of next slur not in use, from 23 down.
-c
-        ndxslur = log2(16777215-listslur)
-
-      end if
-      if (nng(ig) .eq. 1) then
-c
-c  Single grace.
-c
-        if (normsp) then
-c
-c  Anything but GA
-c
-          call addstr(sq//'shlft',6,soutq,lsout)
-          niptgr = nint(ptgr(ig))
-c
-c  Empirical tweak for postscript.
-c
-C          if (.not.fontslur) niptgr = niptgr+nint(wheadpt*.3)
-c++
-          if (niptgr .lt. 10) then
-            call addstr(chax(48+niptgr)//'{',2,soutq,lsout)
-          else if (niptgr .lt. 100) then
-            write(notexq(1:2),'(i2)')niptgr
-            call addstr('{'//notexq(1:2)//'}{',5,soutq,lsout)
-          else
-            print*,
-     *  'Call Dr. Don if you really want grace note group > 99 pt'
-            stop
-          end if
-        else
-          call addstr(sq//'gaft{1.5}{',11,soutq,lsout)
-c
-c  GA.  Compute aftshft, for later use.
-c
-          aftshft = grafac
-          if (naccg(ngstrt(ig)).gt.0) aftshft = aftshft+agc1fac
-          aftshft = aftshft*wheadpt
-        end if
-        if (slurg(ig) .and. .not.isgaft .and..not.iswaft) then
-c
-c  Start slur on pre-grace.  No accounting needed since will be ended very soon.
-c
-          call notefq(noteq,lnoten,nolevg(ngs),ncm)
-          if (fontslur) then
-            if (upg(ig)) then
-              call addstr(sq//'islurd',7,soutq,lsout)
-            else
-              call addstr(sq//'isluru',7,soutq,lsout)
-            end if
-          else
-c
-c  Start Postscript slur. 
-c
-            if (upg(ig)) then
-              call addstr(sq//'isd',4,soutq,lsout)
-            else
-              call addstr(sq//'isu',4,soutq,lsout)
-            end if
-          end if
-c
-c  Print slur number, 23-ndxslur
-c
-          lnote = 0
-          if (23-ndxslur .lt. 10) then
-c              notexq = notexq(1:lnote)//chax(59-ndxslur)
-            notexq = chax(71-ndxslur)
-            lnote = 1
-          else if (23-ndxslur .lt. 20) then
-c              notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}'
-            notexq = '{1'//chax(61-ndxslur)//'}'
-            lnote = 4
-          else 
-            notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
-            lnote = 4
-          end if
-c          if (11-ndxslur .lt. 10) then
-c            call addstr(chax(59-ndxslur)//noteq(1:lnoten),1+lnoten,
-c     *                 soutq,lsout)
-c          else
-c            call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten),
-c     *            4+lnoten,soutq,lsout)
-c          end if
-          call addstr(notexq(1:lnote)//noteq(1:lnoten),
-     *       lnote+lnoten,soutq,lsout)
-	    if (.not.fontslur) then
-c
-c  Horizontal tweaks for postscript slur on single grace
-c
-            stemup = .true.
-            if (upg(ig)) then
-c
-c  Check for up-grace + down stem. Get stem direction
-c
-              if (.not.beamon) then
-c
-c  Separate note.  Get stem direction.
-c
-                stemup = udqq(nolev,ncmidx,
-     *                     islur,nvmx,ivx,nv) .eq. 'u'
-              else
-c
-c  In a beam
-c
-                stemup = ulq(ivx,ibmcnt) .eq. 'u'
-              end if
-c
-c  Stop the shift if whole note
-c
-              stemup = stemup .or. tnote.gt.63
-            end if
-            if (stemup) then
-              call addstr('{-.3}',5,soutq,lsout)
-            else
-              call addstr('{-.8}',5,soutq,lsout)
-            end if
-          end if
-        end if
-        if (naccg(ngs) .gt. 0) then
-          call notefq(noteq,lnoten,nolevg(ngs),ncm)
-c
-c Save for checking octave shifts in GA
-c
-          if (isgaft) then
-            lnotenGA = lnoten
-            noteqGA = noteq
-          end if
-c
-          if (lnoten .eq. 1) call addblank(noteq,lnoten)
-          call accsym(naccg(ngs),acsymq,lacc)
-          call addstr(sq//'big'//acsymq(1:lacc)//
-     *         noteq(1:lnoten),4+lacc+lnoten,soutq,lsout)
-        end if
-        if (slashg(ig)) then
-          notexq = sq//'grc'
-          lnote = 4
-        else if (mg .eq. 0) then
-          notexq = sq//'zq'
-          lnote = 3
-        else
-          notexq = sq//'zc'
-          do 61 i = 2 , mg
-            notexq = notexq(1:i+1)//'c'
-61        continue
-          lnote = mg+2
-        end if
-        if (upg(ig)) then
-          notexq = notexq(1:lnote)//'u'
-        else
-          notexq = notexq(1:lnote)//'l'
-        end if
-        call addstr(notexq,lnote+1,soutq,lsout)
-        call notefq(noteq,lnoten,nolevg(ngs),ncm)
-c
-        if (isgaft .and. naccg(ngs).eq.0) then
-          lnotenGA = lnoten
-          noteqGA = noteq
-        end if
-c
-        if (lnoten .eq. 1) call addblank(noteq,lnoten)
-        call addstr(noteq,lnoten,soutq,lsout)
-        if (slashg(ig)) call addstr(sq//'off{-'//sq//
-     *      'noteskip}',16,soutq,lsout)
-c
-c  Above code needed since slashg causes spacing
-c
-        if (slurg(ig) .and. (iswaft.or.isgaft)) then
-c
-c  Terminate slur on single after-grace
-c
-c          ndxslur = igetbits(ipl,4,23)
-          ndxslur = igetbits(ipl,5,23)
-          call notefq(noteq,lnoten,nolevg(ngs),ncm)
-          call addstr(sq//'tslur',6,soutq,lsout)
-c
-cc  Print 11-ndxslur
-c  Print 24-ndxslur
-c
-c          if (11-ndxslur .lt. 10) then
-          if (23-ndxslur .lt. 10) then
-c            call addstr(chax(59-ndxslur)//noteq(1:lnoten),
-            call addstr(chax(71-ndxslur)//noteq(1:lnoten),
-     *              1+lnoten,soutq,lsout)
-          else if (23-ndxslur .lt. 20) then
-            call addstr('{2'//chax(61-ndxslur)//'}'//noteq(1:lnoten),
-     *              4+lnoten,soutq,lsout)
-          else
-c            call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten),
-            call addstr('{1'//chax(51-ndxslur)//'}'//noteq(1:lnoten),
-     *              4+lnoten,soutq,lsout)
-          end if
-          slurg(ig) = .false.
-          listslur = ibclr(listslur,ndxslur)
-        end if
-        call addstr('}',1,soutq,lsout)
-c
-c+++  Try to fix loss of octave with single gaft
-c
-c        if (isgaft) call addstr(sq//'zcharnote'//noteq(1:lnoten)//'{~}',
-c     *                          13+lnoten,soutq,lsout)
-        if (isgaft) then
-          itrans = 0
-          do 1 i = 1 , lnotenGA
-            if (noteqGA(i:i) .eq. chax(39)) then
-               itrans = itrans+7
-            else if (noteqGA(i:i) .eq. chax(96)) then
-               itrans = itrans-7
-            end if
-1         continue
-          if (itrans. eq. -14) then
-            call addstr(sq//'advance'//sq//'transpose-14',21,
-     *                  soutq,lsout)                       
-          else if (itrans .eq. -7) then
-            call addstr(sq//'advance'//sq//'transpose-7',20,
-     *                  soutq,lsout)                       
-          else if (itrans .eq. 7) then
-            call addstr(sq//'advance'//sq//'transpose7',19,
-     *                  soutq,lsout)                       
-          else if (itrans .eq. 14) then
-            call addstr(sq//'advance'//sq//'transpose14',20,
-     *                  soutq,lsout)                       
-          end if
-        end if
-      else
-c
-c  Multiple grace.  Put in literally.  Compute beam stuff
-c
-        sumx = 0.
-        sumy = 0.
-        sumxy = 0.
-        sumxx = 0.
-        sumyy = 0.
-        x = 0.
-        do 118 ing = ngs , ngs+nng(ig)-1
-          if (ing.gt.ngs .and. naccg(ing).gt.0) x = x+acgfac
-          y = nolevg(ing)
-          sumx = sumx + x
-          sumy = sumy + y
-          sumxy = sumxy + x*y
-          sumxx = sumxx + x*x
-          sumyy = sumyy + y*y
-          x = x+emgfac
-118     continue
-        delta = nng(ig)*sumxx-sumx*sumx
-        em = (nng(ig)*sumxy-sumx*sumy)/delta
-        islope = nint(0.5*em*gslfac)
-        if (iabs(islope) .gt. 9) islope = isign(9,islope)
-        beta = (sumy-islope/gslfac*sumx)/nng(ig)
-        nolev1 = nint(beta)
-c
-c  Back up
-c
-        notexq = sq//'settiny'//sq//'off{'
-        if (normsp) then
-          write(notexq(14:18),'(a1,f4.1)')'-',ptgr(ig)
-          call addstr(notexq(1:18)//'pt}',21,soutq,lsout)
-          finalshift = ptgr(ig)
-        else
-          aftshft = wheadpt*1.33
-          if (naccg(ngstrt(ig)).gt.0) aftshft = aftshft+wheadpt*0.5
-          write(notexq(14:17),'(f4.1)')aftshft
-          call addstr(notexq(1:17)//'pt}'//sq//'bsk',24,soutq,lsout)
-        end if
-c
-c  Start the beam
-c
-        notexq = sq//'ib'
-        do 119 ing = 2 , mg
-           notexq = notexq(1:ing+1)//'b'
-119     continue
-        if (upg(ig)) then
-          notexq = notexq(1:mg+2)//'u'
-        else
-          notexq = notexq(1:mg+2)//'l'
-        end if
-        notexq = notexq(1:mg+3)//'0'
-c
-c  Get starting note for beam
-c
-        call notefq(noteq,lnoten,nolev1,ncm)
-        call addstr(notexq(1:mg+4)//noteq(1:lnoten),
-     *    mg+4+lnoten,soutq,lsout)
-c
-c  Put in the slope
-c
-        if (islope .ge. 0) then
-          call addstr(chax(48+islope),1,soutq,lsout)
-        else
-          call addstr('{-'//chax(48-islope)//'}',4,soutq,lsout)
-        end if
-c
-c  Start a slur on multiple fore-grace
-c
-        if (slurg(ig) .and. .not.isgaft .and. .not.iswaft) then
-          call notefq(noteq,lnoten,nolevg(ngs),ncm)
-	    if (fontslur) then
-            if (upg(ig)) then
-              call addstr(sq//'islurd',7,soutq,lsout)
-            else
-              call addstr(sq//'isluru',7,soutq,lsout)
-            end if
-          else
-c
-c  Need a tweak for postscript slur
-c
-            if (upg(ig)) then
-              call addstr(sq//'isd',4,soutq,lsout)
-            else
-              call addstr(sq//'isu',4,soutq,lsout)
-            end if
-          end if
-c
-c  Print 11-ndxslur
-c
-          if (23-ndxslur .lt. 10) then
-            call addstr(chax(71-ndxslur)//noteq(1:lnoten),1+lnoten,
-     *                 soutq,lsout)
-          else if (23-ndxslur .lt. 2) then
-            call addstr('{1'//chax(61-ndxslur)//'}'//noteq(1:lnoten),
-     *                  4+lnoten,soutq,lsout)
-          else
-            call addstr('{1'//chax(51-ndxslur)//'}'//noteq(1:lnoten),
-     *                  4+lnoten,soutq,lsout)
-          end if
-c
-c  Put in tweak for postscript slur 
-c
-          if (.not.fontslur) call addstr('{-.3}',5,soutq,lsout)
-        end if
-c
-c  Put in first note.  Call notefq again in case octave changed
-c
-        call notefq(noteq,lnoten,nolevg(ngs),ncm)
-        if (naccg(ngs) .eq. 0) then
-          notexq = sq//'zqb0'//noteq(1:lnoten)
-          lnote = 5+lnoten
-        else
-          if (lnoten .eq. 1) call addblank(noteq,lnoten)
-          call accsym(naccg(ngs),acsymq,lacc)
-          notexq = sq//'big'//acsymq(1:lacc)//noteq(1:lnoten)
-          lnote = 4+lacc+lnoten
-          call notefq(noteq,lnoten,nolevg(ngs),ncm)
-          notexq =notexq(1:lnote)//sq//'zqb0'//noteq(1:lnoten)
-          lnote = lnote+5+lnoten
-        end if
-        call addstr(notexq,lnote,soutq,lsout)
-        do 127 ing = ngs+1 , ngs+nng(ig)-1
-c
-c  Skip
-c
-          ptoff = wheadpt1*emgfac
-          if (naccg(ing).gt.0) ptoff = ptoff+wheadpt1*acgfac
-          if (isgaft .and. .not.iswaft) aftshft = aftshft+ptoff
-          notexq = sq//'off{'
-          write(notexq(6:8),'(f3.1)')ptoff
-          if (normsp) finalshift = finalshift-ptoff
-          call addstr(notexq(1:8)//'pt}',11,soutq,lsout)
-          if (ing .eq. ngs+nng(ig)-1) then
-c
-c  Terminate beam if needed
-c
-            if (upg(ig)) then
-              call addstr(sq//'tbu0',5,soutq,lsout)
-            else
-              call addstr(sq//'tbl0',5,soutq,lsout)
-            end if
-c
-c  Terminate after slur if needed
-c
-            if ((isgaft.or.iswaft) .and. slurg(ig)) then
-c              if (iswaft) ndxslur = igetbits(ipl,4,23)
-              if (iswaft) ndxslur = igetbits(ipl,5,23)
-              call notefq(noteq,lnoten,nolevg(ing),ncm)
-              call addstr(sq//'tslur',6,soutq,lsout)
-c
-c  Print 11-ndxslur
-cc  Print 23-ndxslur
-c
-              if (23-ndxslur .lt. 10) then
-                call addstr(chax(71-ndxslur)//noteq(1:lnoten),
-     *              1+lnoten,soutq,lsout)
-              else if (23-ndxslur .lt. 20) then
-                call addstr('{2'//chax(61-ndxslur)//'}'
-     *                      //noteq(1:lnoten),4+lnoten,soutq,lsout)
-              else
-                call addstr('{1'//chax(51-ndxslur)//'}'
-     *                      //noteq(1:lnoten),4+lnoten,soutq,lsout)
-              end if
-c
-c  Stop slur terminator after exit from this subroutine
-c
-              listslur = ibclr(listslur,ndxslur)
-              slurg(ig) = .false.
-            end if
-          end if
-c
-c  Accidental if needed
-c
-          if (naccg(ing).gt.0) then
-            call notefq(noteq,lnoten,nolevg(ing),ncm)
-            if (lnoten .eq. 1) call addblank(noteq,lnoten)
-            call accsym(naccg(ing),acsymq,lacc)
-            call addstr(sq//'big'//acsymq(1:lacc)
-     *                  //noteq(1:lnoten),4+lacc+lnoten,soutq,lsout)
-          end if
-c
-c  Put in the (beamed) grace note
-c
-          call notefq(noteq,lnoten,nolevg(ing),ncm)
-          call addstr(sq//'zqb0'//noteq(1:lnoten),5+lnoten,
-     *                soutq,lsout)
-127     continue
-c
-c  Terminate the grace
-c
-c        notexq = sq//'normalnotesize'//sq//'off{'
-c        lnote = 20
-c        notexq = '}'//sq//'off{'
-c        lnote = 6
-        notexq = sq//'off{'
-        lnote = 5
-        ptoff = wheadpt*emgfac
-        if (iand(nacc,3).gt.0 .and. .not.btest(nacc,17)) 
-     *       ptoff = ptoff+wheadpt*accfac
-        if (isgaft .and. .not.iswaft) then
-          notexq = notexq(1:5)//'-'
-          lnote = 6
-          ptoff = aftshft
-        end if
-        if (normsp) ptoff = finalshift
-        if (ptoff .lt. 9.95) then
-          write(notexq(lnote+1:lnote+3),'(f3.1)')ptoff
-          lnote = lnote+3
-        else if (ptoff .lt. 99.95) then
-          write(notexq(lnote+1:lnote+4),'(f4.1)')ptoff
-          lnote = lnote+4
-	  else 
-          write(notexq(lnote+1:lnote+5),'(f5.1)')ptoff
-          lnote = lnote+5
-        end if
-        call addstr(notexq(1:lnote)//'pt}',lnote+3,soutq,lsout)
-        if (isgaft.and..not.iswaft) call addstr(sq//'sk',3,soutq,lsout)
-        call addstr(sq//'resetsize',10,soutq,lsout)
-      end if
-      return
-      end
-      subroutine dopsslur(nolev,isdat1,isdat2,isdat3,isdat4,nsdat,ip,
-     *                    iv,kv,nv,beamon,ncm,soutq,lsout,ulq,islur,
-     *                    ipl,iornq,islhgt,tno,nacc)
-c
-c  Called once per main note.  
-c  12 May 2002  Create this subroutine to isolate postscript slurs/ties.
-c    Always set \Nosluradjust\Notieadjust
-c
-      parameter (nm=24,mv=24576)
-      integer*4 isdat1(202),isdat2(202),isdat3(202),isdat4(202)
-      common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
-     *                 ,WrotePsslurDefaults,SlurCurve
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      common /comsln/ is1n1,is2n1,irzbnd,isnx
-      character*1 ulq,slurudq,udfq,udqq,chax
-      character*79 notexq
-      character*8 noteq
-      character*80 soutq
-      logical upslur,beamon,btest,stemup,iscrd,
-     *        settie,fontslur,pstie,WrotePsslurDefaults
-      logical slmon,dbltie
-      common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm),
-     *       naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl,
-     *       slmon(0:nm),dbltie
-      integer*2 mmidi,iinsiv
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
-     *  instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
-      logical EarlyTransOn,LaterInstTrans
-c 130316
-      common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
-     *                ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
-c
-c  Bits in isdat1:
-c  13-17    iv
-c  3-10     ip
-c  11       start/stop switch
-c  12       kv-1
-c  19-25    ichar(code$)
-c  26       force direction?
-c  27       forced dir'n = up if on, set in sslur; also
-c           final direction, set in doslur when beam is started, used on term.
-c  28-31    mod(ndxslur,16), set in doslur when slur is started, used on term.
-c  18       int(ndxslur/16), ditto. So this allows ndxslur>15.
-c  2        stem slur flag
-c
-c  Bits in isdat2
-c  0        Chord switch.  Not set on main note.
-c  1-2      left/right notehead shift.  Set only for chord note.
-c  3        tie positioning
-c  4        dotted flag
-c  6-11     voff1 1-63  =>  -31...+31
-c  12-18    hoff1 1-127 => -6.3...+6.3
-c  19-25    nolev
-c  26       \sluradjust    (p+s)
-c  27       \nosluradjust  (p-s)
-c  28       \tieadjust     (p+t)
-c  29       \notieadjust   (p-t)
-c
-c  Bits in isdat3: Only used for slur endings
-c  0        set if midslur (at least one argument)
-c  1        set if curve (2 more args)
-c  2-7      32+first arg (height correction) (1st arg may be negative)
-c  8-10     second arg (initial slope)
-c  11-13    third arg (closing slope)
-c  14-21    tie level for use in LineBreakTies
-c  22-29    ncm for use in LineBreakTies
-c
-c  Bits in isdat4  Only used for linebreak slurs
-c  0-5      Linebreak seg 1 voff 1-63  =>  -31...+31  
-c  6-12     Linebreak seg 1 hoff 1-127 => -6.3...+6.3
-c  16-21    Linebreak seg 2 voff 1-63  =>  -31...+31
-c  22-28    Linebreak seg 2 hoff 1-127 => -6.3...+6.3
-c
-c  In listslur bit ib is on if slur index ib is in use, ib=0-13.
-c  ndxslur = slur index
-c  Height of slur is nole+ivoff+iupdn.  iupdn is +/-1 if t&s slurs on same note,
-c  s-slur is blank (idcode=32), t-slur is idcode=1.
-c  ivoff is user-defined shift or shift due to . or _ , or chord adjustment.
-c  Ivoff will be set for ./_ only if no user-defined shift is specified.
-c  If highest note has upslur, save slur height in islhgt in case
-c  ornament must be moved.
-c
-      islhgt = 0
-      if (beamon) then
-        stemup = ulq .eq. 'u'
-      else if (nvmx(iv) .eq. 2) then
-        if (.not.btest(islur,30)) then
-c
-c  Single note, 2 lines of music, stem direction not forced
-c
-          stemup = ivx .gt. nv
-        else
-          stemup = btest(islur,17)
-        end if
-      else
-        stemup = udqq(nolev,ncm,islur,nvmx(iv),ivx,nv) .eq. 'u'
-      end if
-      iscrd = btest(ipl,10)
-      if (ismidi) then
-        settie = .false.
-        dbltie = .false.
-      end if
-      do 1 isdat = 1 , nsdat
-        isdata = isdat1(isdat)
-        if (iv .eq. igetbits(isdata,5,13) .and.
-     *      ip .eq. igetbits(isdata,8,3) .and.
-     *            kv .eq. igetbits(isdata,1,12)+1) then
-c
-c  Since iv and kv match, ivx will be correct
-c
-          idcode = igetbits(isdata,7,19)
-          ivoff = igetbits(isdat2(isdat),6,6)-32
-          ihoff = igetbits(isdat2(isdat),7,12)-64
-          iupdn = 0
-          slurudq = 'd'
-          nolevs = igetbits(isdat2(isdat),7,19)
-          pstie = btest(isdat2(isdat),3) .or. idcode.eq.1
-          if (btest(isdata,11)) then
-c
-c  Turnon
-c  Get slur direction
-c
-            if (btest(isdata,26)) then
-c
-c  Force slur direction
-c
-              if (btest(isdata,27)) slurudq = 'u'
-            else if (nvmx(iv) .eq. 1) then
-c
-c  Only one voice per line
-c
-              if (.not.beamon) then
-c
-c  Separate note.
-c
-                slurudq = udfq(nolev,ncm)
-              else
-c
-c  In a beam
-c
-                if (ulq .ne. 'u') slurudq = 'u'
-              end if
-              if (iscrd) then
-                if (nolevs .gt. ncm) then
-                  slurudq = 'u'
-                else
-                  slurudq = 'd'
-                end if
-              end if
-            else
-c
-c  Two voices per line.  Get default
-c
-              if (ivx .gt. nv) slurudq = 'u'
-c
-c  Upper voice of the two, so up slur
-c
-            end if
-            if (btest(isdata,2)) then
-c
-c  ADjust for stem slur. ASSUME this is the ONLY pos'n adjustment.
-c
-              if (stemup) then
-                slurudq = 'u'
-                ivoff = ivoff+4
-              else
-                slurudq = 'd'
-                ivoff = ivoff-4
-              end if
-            end if
-c
-c  Set level for slur starting on rest
-c
-            if (nolevs.eq.0 .or. nolevs.gt.60) then
-              if (slurudq .eq. 'u') then
-                nolevs = ncm+2
-              else
-                nolevs = ncm-2
-              end if
-            end if
-c
-c  Save up/down-ness for use at termination
-c
-            if (slurudq .eq. 'u') isdata = ibset(isdata,27)
-c
-c  End of section for setting slur direction, still in "Turnon" if-block.
-c
-            if (btest(iornq,11).or.btest(iornq,12)) then
-c
-c  Raise or lower slur by one unit provided . or _ is on same side as slur
-c
-              ivoffinc = 0
-              if ((stemup .and. slurudq.eq.'d') .or.
-     *             (.not.stemup .and. slurudq.eq.'u')) then
-c
-c  Must move the slur for _ or .
-c
-                if (stemup) then
-                  ivoffinc = -1
-                else
-                  ivoffinc = 1
-                end if
-                if (((stemup      .and. nolev.ge.ncm-2) .or.
-     *              (.not.stemup .and. nolev.le.ncm+2)) .and.
-     *                mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc
-                ivoff = ivoff+ivoffinc
-              end if
-            end if
-            if (listslur .eq. 16777215) then
-              print*
-              print*,'You1 defined the twentyfifth slur, one too many!'
-              write(15,'(/,a)')
-     *               'You defined the twentyfifth slur, one too many!'
-              call stop1()
-            end if
-c
-c  Get index of next slur not in use, starting from 12 down
-c
-            ndxslur = log2(16777215-listslur)
-c      write(*,'()')
-c      write(*,'(2i4,2x,B24)')ivx,ndxslur,listslur
-c
-c  Record slur index
-c
-            listslur = ibset(listslur,ndxslur)
-c      write(*,'(10x,B24)')listslur
-c
-c  Save for use on termination
-c
-c            call setbits(isdata,4,28,ndxslur)
-c  080531  Allow >16 slurs
-            call setbits(isdata,4,28,mod(ndxslur,16))
-            call setbits(isdata,1,18,ndxslur/16)
-c
-c  Shift for stem?
-c
-            if (stemup .and. slurudq.eq.'u' .and. tno.lt.63.) then
-              if (.not.pstie) then
-                ihoff = ihoff+8
-              else
-                ihoff = ihoff+2
-              end if
-	      end if
-            if (iscrd) then
-c
-c  Additional horiz shifts for h-shifted noteheads?
-c
-              if (btest(isdat2(isdat),1)) then
-c
-c  Slur start on left-shifted chord notehead.  ASSUME downstem.
-c
-                if (nolevs.eq.minlev .and. slurudq.eq.'d') then
-                  ihoff = ihoff-2
-                else
-                  ihoff = ihoff-10
-                end if
-              else if (btest(isdat2(isdat),2)) then
-c
-c  Right shifted chord notehead.  ASSUME upstem.
-c
-                if (nolevs.eq.maxlev .and. slurudq.eq.'u') then
-                  ihoff = ihoff+2
-                else
-                  ihoff = ihoff+10
-                end if
-              end if
-            end if
-            notexq = chax(92)
-            lnote = 1
-c
-c  Check for local adjustment default changes
-c
-            if (btest(isdat2(isdat),26)) then
-              notexq = chax(92)//'sluradjust'//chax(92)
-	        lnote = 12
-            else if (btest(isdat2(isdat),27)) then
-              notexq = chax(92)//'nosluradjust'//chax(92)
-	        lnote = 14
-            else if (btest(isdat2(isdat),28)) then
-              notexq = chax(92)//'tieadjust'//chax(92)
-	        lnote = 11
-            else if (btest(isdat2(isdat),29)) then
-              notexq = chax(92)//'notieadjust'//chax(92)
-	        lnote = 13
-            end if
-            if (ihoff .eq. 0) then
-c
-c  Write stuff for non-shifted start
-c
-              notexq = notexq(1:lnote)//'islur'//slurudq
-              lnote = lnote+6
-            else
-              notexq = notexq(1:lnote)//'is'//slurudq
-              lnote = lnote+3
-            end if
-c
-c  Prepend postscript tie switch
-c
-            if (pstie) then 
-              notexq = chax(92)//'tieforis'//slurudq//notexq(1:lnote)
-              lnote = lnote+10
-            end if
-            if (btest(isdat2(isdat),4)) then
-c
-c  Dotted slur
-c
-c              noteq = notexq
-c              notexq = chax(92)//'dotted'//noteq
-              notexq = chax(92)//'dotted'//notexq(1:lnote)
-              lnote = lnote+7
-            end if
-c
-c  Add slur index to string
-cc  Print 11-ndxslur
-c  Print 23-ndxslur
-c
-c            if (11-ndxslur .lt. 10) then
-            if (23-ndxslur .lt. 10) then
-c
-c  5/25/08 Allow 24 slurs
-c
-c              notexq = notexq(1:lnote)//chax(59-ndxslur)
-              notexq = notexq(1:lnote)//chax(71-ndxslur)
-              lnote = lnote+1
-            else if (23-ndxslur .lt. 20) then
-c              notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}'
-              notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}'
-              lnote = lnote+4
-            else 
-              notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
-              lnote = lnote+4
-            end if
-c
-c  Add note name to string
-c
-c            call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm)
-            islhgt = nolevs+iupdn+ivoff
-            call notefq(noteq,lnoten,islhgt,ncm)
-            notexq = notexq(1:lnote)//noteq(1:lnoten)
-            lnote = lnote+lnoten
-c
-c  Store height and staff mid level for use with LineBreakTies 
-c
-            call setbits(isdat3(isdat),8,14,islhgt)
-            call setbits(isdat3(isdat),8,22,ncm)
-c
-c  Save height (for ornament and barnobox interference) if topmost slur is up
-c
-            if (slurudq.eq.'u' .and.
-     *           (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then
-              islhgt = nolevs+iupdn+ivoff
-c
-c  Save height & idcode if top voice and slur start
-c
-              if (ivx.eq.ivmx(nv,nvmx(nv)) .and. islhgt.gt.is1n1) then
-                is1n1 = islhgt
-                is2n1 = idcode
-              end if
-            end if
-            if (ihoff .ne. 0.) then
-              shift = ihoff*0.1
-              notexq = notexq(1:lnote)//'{'
-              lnote = lnote+1
-              lform = lfmt1(shift)
-              write(notexq(lnote+1:lnote+lform),'(f'//
-     *                  chax(48+lform)//'.1)') shift
-              lnote = lnote+lform
-              notexq = notexq(1:lnote)//'}'
-              lnote = lnote+1
-            end if
-            call addstr(notexq,lnote,soutq,lsout)
-c
-c  Zero out ip1 to avoid problems if slur goes to next input blk.
-c
-            call setbits(isdata,8,3,0)
-c
-c  Set slur-on data for midi.  Only treat null-index slurs and ps ties for now.
-c
-            if (ismidi .and. (idcode.eq.32 .or. idcode.eq.1)) then
-c              levson(midchan(iv,kv)) = nolevs
-c 130316
-c              levson(midchan(iv,kv)) = nolevs-iTransAmt(instno(iv))
-              levson(midchan(iv,kv)) = nolevs+miditran(instno(iv))
-              if (settie) dbltie = .true.
-c
-c  Only way settie=T is if we just set a tie ending.  So there's also a slur
-c   start here, so set a flag telling addmidi not to zero out levson
-c 
-            end if
-          else
-c
-c  Slur is ending.  Back thru list to find starting slur
-c
-            do 3 j = isdat-1 , 1 , -1
-              if (iv.eq.igetbits(isdat1(j),5,13) .and.
-     *            kv.eq.igetbits(isdat1(j),1,12)+1) then
-                if (idcode .eq. igetbits(isdat1(j),7,19)) then
-                  ndxslur = igetbits(isdat1(j),4,28)
-c
-c  080531 Allow >16 slurs
-c
-     *                          +16*igetbits(isdat1(j),1,18)
-                  if (btest(isdat1(j),27)) slurudq = 'u'
-                  go to 4
-                end if
-              end if
-3           continue
-            print*,'Bad place in doslur'
-            call stop1()
-4           continue
-c
-c  Bugfix 070901 for slur ending on rest in 2-voice staff
-c
-c            if (nolevs.eq.0 .or. nolevs.gt.60) then
-            if (nolevs.le.2 .or. nolevs.gt.60) then
-c
-c  Ending is on a rest, reset nolevs to default starting height
-c
-              nolevs = igetbits(isdat2(j),7,19)
-            end if
-            if (btest(isdat3(isdat),0) .or. btest(isdat3(j),0)) then
-c
-c  Deal with \curve or \midslur. isdat is ending, j is start.
-c
-              if (btest(isdat3(isdat),0)) then
-                imid = igetbits(isdat3(isdat),6,2)-32 
-              else
-                imid = igetbits(isdat3(j),6,2)-32 
-              end if
-c
-c  Postscript slurs, and \midslur adjustment is needed.  Invoke macro 
-c   (from pmx.tex) that redefines \tslur as r'qd.  Tentative mapping:
-c       Abs(imid)  Postscript slur type
-c          1          f
-c          2-3        default
-c          4          h
-c          5          H
-c          6+         HH
-c
-              call addstr(chax(92)//'psforts'//
-     *                      chax(48+min(abs(imid),6)),9,soutq,lsout)
-            end if
-            if (btest(isdata,2)) then
-c
-c  ADjust for stem slur. 
-c
-              if (stemup) then
-                slurudq = 'u'
-                ivoff = ivoff+4
-              else
-                slurudq = 'd'
-                ivoff = ivoff-4
-              end if
-            end if
-c
-c  Shift slur ending for stem on any note?
-c
-            if (.not.stemup .and. slurudq.eq.'d' .and. tno.lt.63.) then
-              if (.not.pstie) then
-                ihoff = ihoff-8
-              else
-                ihoff = ihoff-3
-              end if
-            end if
-            if (iscrd) then
-c
-c  Shift termination for shifted notehead?
-c
-              if (btest(isdat2(isdat),1)) then
-c
-c  Left-shifted chord notehead.  ASSUME downstem.
-c
-                if (nolevs.eq.minlev .and. slurudq.eq.'d') then
-                  ihoff = ihoff-2
-                else
-                  ihoff = ihoff-10
-                end if
-              else if (btest(isdat2(isdat),2)) then
-c
-c  Right shifted chord notehead.  ASSUME upstem.
-c
-                if (nolevs.eq.maxlev .and. slurudq.eq.'u') then
-                  ihoff = ihoff+2
-                else
-                  ihoff = ihoff+10
-                end if
-              end if
-            end if
-            if (ihoff .eq. 0) then
-              notexq = chax(92)//'tslur'
-              lnote = 6
-            else
-c
-c  Shift needed
-c
-              notexq = chax(92)//'ts'
-              lnote = 3
-            end if
-c
-c  Switch to postscript tie
-c
-            if (pstie) then
-              notexq = chax(92)//'tieforts'//notexq(1:lnote)
-              lnote = lnote+9
-            end if
-c
-c  Print 13-ndxslur
-c  5/25/08 Allow 14 slurs
-c
-            if (23-ndxslur .lt. 10) then
-              notexq = notexq(1:lnote)//chax(71-ndxslur)
-              lnote = lnote+1
-            else if (23-ndxslur .lt. 20) then
-              notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}'
-              lnote = lnote+4
-            else 
-              notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
-              lnote = lnote+4
-            end if
-            if (btest(iornq,11).or.btest(iornq,12)) then
-c
-c  Raise or lower slur by one unit provided . or _ is on same side as slur
-c
-              ivoffinc = 0
-              if ((stemup .and. slurudq.eq.'d') .or.
-     *                 (.not.stemup .and. slurudq.eq.'u')) then
-                if (stemup) then
-                  ivoffinc = -1
-                else
-                  ivoffinc = 1
-                end if
-                if (((stemup .and. nolev.ge.ncm-2) .or.
-     *              (.not.stemup .and. nolev.le.ncm+2)) .and.
-     *               mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc
-              end if
-              ivoff = ivoff+ivoffinc
-            end if
-            call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm)
-            if (slurudq.eq.'u' .and.
-     *           (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then
-              islhgt = nolevs+iupdn+ivoff
-c
-c  If topvoice, upslur, and idcode checks, no more need to keep hgt for barno.
-c
-              if (ivx.eq.ivmx(nv,nvmx(nv)) .and. is1n1.gt.0) then
-                if (idcode .eq. is2n1) is1n1=0
-              end if
-            end if
-            notexq = notexq(1:lnote)//noteq(1:lnoten)
-            lnote = lnote+lnoten
-            if (ihoff .ne. 0) then
-              shift = ihoff*0.1
-              notexq = notexq(1:lnote)//'{'
-              lnote = lnote+1
-              lform = lfmt1(shift)
-              write(notexq(lnote+1:lnote+lform),
-     *            '(f'//chax(48+lform)//'.1)')shift
-              lnote = lnote+lform
-              notexq = notexq(1:lnote)//'}'
-              lnote = lnote+1
-            end if
-            call addstr(notexq,lnote,soutq,lsout)
-c
-c  Clear the bit from list of slurs in use
-c
-            listslur = ibclr(listslur,ndxslur)
-c
-c  Zero out the entire strings for start and stop
-c
-            isdata = 0
-            isdat2(isdat) = 0
-            isdat3(isdat) = 0
-            isdat4(isdat) = 0
-            isdat1(j) = 0
-            isdat2(j) = 0
-            isdat3(j) = 0
-            isdat4(j) = 0
-c
-c  Set midi info for slur ending
-c
-            if (ismidi .and. (idcode.eq.32 .or. idcode.eq.1)) then  
-              icm = midchan(iv,kv)
-              if (slmon(icm)) then
-c                if (nolevs.eq.levson(icm) .and. iand(7,nacc).eq.0) then
-c 130316
-c                if (nolevs-iTransAmt(instno(iv)).eq.levson(icm) .and.
-                if (nolevs+miditran(instno(iv)).eq.levson(icm) .and.
-     *                iand(7,nacc).eq.0) then
-c
-c  There is a tie here.  NB!!! assumed no accidental on 2nd member of tie.
-c
-c                  levsoff(icm) = nolevs
-c 130316
-c                  levsoff(icm) = nolevs-iTransAmt(instno(iv))
-                  levsoff(icm) = nolevs+miditran(instno(iv))
-                  settie = .true.
-                else
-                  levsoff(icm) = 0
-                  levson(icm) = 0
-                  slmon(icm) = .false.
-                end if
-              end if
-            end if 
-          end if
-          isdat1(isdat) = isdata
-        end if
-1     continue
-c
-c  Clear and collapse the slur data list
-c
-      numdrop = 0
-      do 2 isdat  = 1 , nsdat
-        if (isdat1(isdat) .eq. 0) then
-          numdrop = numdrop+1
-        else if (numdrop .gt. 0) then
-          isdat1(isdat-numdrop) = isdat1(isdat)
-          isdat2(isdat-numdrop) = isdat2(isdat)
-          isdat3(isdat-numdrop) = isdat3(isdat)
-          isdat4(isdat-numdrop) = isdat4(isdat)
-          isdat1(isdat) = 0
-          isdat2(isdat) = 0
-          isdat3(isdat) = 0
-          isdat4(isdat) = 0
-        end if
-2     continue
-      nsdat = nsdat-numdrop
-c      call report(nsdat,isdat1,isdat2)
-      return
-      end
-      subroutine doslur(nolev,isdat1,isdat2,isdat3,nsdat,ip,iv,kv,nv,
-     *     beamon,ncm,soutq,lsout,ulq,islur,ipl,iornq,islhgt,tno,nacc)
-c
-c  Called once per main note.  (5/26/02) for non-ps slurs only
-c
-      parameter (nm=24,mv=24576)
-      integer*4 isdat1(202),isdat2(202),isdat3(202)
-      common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
-     *                 ,WrotePsslurDefaults,SlurCurve
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      common /comsln/ is1n1,is2n1,irzbnd,isnx
-      character*1 ulq,slurudq,udfq,udqq,chax
-      character*79 notexq
-      character*8 noteq
-      character*80 soutq
-      logical upslur,beamon,btest,stemup,iscrd,sfound,tfound,tmove,
-     *        settie,fontslur,WrotePsslurDefaults
-      logical slmon,dbltie
-      common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm),
-     *       naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl,
-     *       slmon(0:nm),dbltie
-      integer*2 mmidi,iinsiv
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
-     *  instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
-      logical EarlyTransOn,LaterInstTrans
-c 130316
-      common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
-     *                ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
-c
-c  Bits in isdat1:
-c  13-17    iv
-c  3-10     ip
-c  11       start/stop switch
-c  12       kv-1
-c  19-25    ichar(code$)
-c  26       force direction?
-c  27       forced dir'n = up if on, set in sslur; also
-c           final direction, set in doslur when beam is started, used on term.
-c  28-31    ndxslur, set in doslur when beam is started, used on term.
-c
-c  Bits in isdat2
-c  0        Chord switch.  Not set on main note.
-c  1-2      left/right notehead shift.  Set only for chord note.
-c  3        tie positioning
-c  4        dotted flag
-c  6-11     voff1 1-63  =>  -31...+31
-c  12-18    hoff1 1-127 => -6.3...+6.3
-c  19-25    nolev
-c
-c  Bits in isdat3: Only used for slur endings
-c  0        set if midslur (at least one argument)
-c  1        set if curve (2 more args)
-c  2-7      32+first arg (height correction) (1st arg may be negative)
-c  8-10     second arg (initial slope)
-c  11-13    third arg (closing slope)
-c
-c  In listslur bit ib is on if slur index ib is in use, ib=0-23.
-c  ndxslur = slur index
-c  Height of slur is nole+ivoff+iupdn.  iupdn is +/-1 if t&s slurs on same note,
-c  s-slur is blank (idcode=32), t-slur is idcode=1.
-c  ivoff is user-defined shift or shift due to . or _ , or chord adjustment.
-c  Ivoff will be set for ./_ only if no user-defined shift is specified.
-c  If highest note has upslur, save slur height in islhgt in case
-c  ornament must be moved.
-c
-      islhgt = 0
-      if (beamon) then
-        stemup = ulq .eq. 'u'
-      else if (nvmx(iv) .eq. 2) then
-        if (.not.btest(islur,30)) then
-c
-c  Single note, 2 lines of music, stem direction not forced
-c
-          stemup = ivx .gt. nv
-        else
-          stemup = btest(islur,17)
-        end if
-      else
-        stemup = udqq(nolev,ncm,islur,nvmx(iv),ivx,nv) .eq. 'u'
-      end if
-      iscrd = btest(ipl,10)
-      if (btest(islur,1)) then
-c
-c  't'-slur (idcode=1) somewhere on this note.  Find it, check height against
-c    's'-slur (idcode=32)
-c
-        sfound = .false.
-        tfound = .false.
-        tmove = .false.
-        do 5 isdat = 1 , nsdat
-          if (iv .eq. igetbits(isdat1(isdat),5,13) .and.
-     *          ip .eq. igetbits(isdat1(isdat),8,3) .and.
-     *              kv .eq. igetbits(isdat1(isdat),1,12)+1) then
-            if (.not.tfound) then
-              tfound = igetbits(isdat1(isdat),7,19).eq.1
-              if (tfound) then
-                nolevt = igetbits(isdat2(isdat),7,19)
-                isdatt = isdat
-                if (sfound) go to 6
-              end if
-            end if
-            if (.not.sfound) then
-              sfound = igetbits(isdat1(isdat),7,19).eq.32
-              if (sfound) then
-                nolevs = igetbits(isdat2(isdat),7,19)
-                isdats = isdat
-                if (tfound) go to 6
-              end if
-            end if
-          end if
-5       continue
-c
-c  Will come thru here if there is a t with no s, so comment out the following
-c        print*,'Did not find s+t-slurs in doslur'
-c
-6       continue
-        if (sfound .and. tfound)
-     *    tmove = nolevs.eq.nolevt .and.
-c
-c  Check if 2 starts or two stops
-c
-     *     ((btest(isdat1(isdats),11).and.btest(isdat1(isdatt),11)) .or.
-     *      (.not.btest(isdat1(isdats),11).and.
-     *                               .not.btest(isdat1(isdatt),11)) )
-c
-c  This is a flag for later changing slur level, after we know slur dir'n.
-c
-      end if
-      if (ismidi) then
-        settie = .false.
-        dbltie = .false.
-      end if
-      do 1 isdat = 1 , nsdat
-        isdata = isdat1(isdat)
-        if (iv .eq. igetbits(isdata,5,13) .and.
-     *      ip .eq. igetbits(isdata,8,3) .and.
-     *            kv .eq. igetbits(isdata,1,12)+1) then
-c
-c  Since iv and kv match, ivx will be correct
-c
-          idcode = igetbits(isdata,7,19)
-          ivoff = igetbits(isdat2(isdat),6,6)-32
-          ihoff = igetbits(isdat2(isdat),7,12)-64
-          iupdn = 0
-          slurudq = 'd'
-          nolevs = igetbits(isdat2(isdat),7,19)
-          if (btest(isdata,11)) then
-c
-c  Turnon, 
-c
-            if (nolevs.eq.0 .or. nolevs.gt.60) then
-c
-c  Note was a rest, cannot start slur on rest.
-c
-              print*
-              call printl('Cannot start slur on a rest')
-              call stop1()
-            end if
-c
-c  Get slur direction
-c
-            if (btest(isdata,26)) then
-c
-c  Force slur direction
-c
-              if (btest(isdata,27)) slurudq = 'u'
-            else if (nvmx(iv) .eq. 1) then
-c
-c  Only one voice per line
-c
-              if (.not.beamon) then
-c
-c  Separate note.
-c
-                slurudq = udfq(nolev,ncm)
-              else
-c
-c  In a beam
-c
-                if (ulq .ne. 'u') slurudq = 'u'
-              end if
-              if (iscrd) then
-                if (nolevs .gt. ncm) then
-                  slurudq = 'u'
-                else
-                  slurudq = 'd'
-                end if
-              end if
-            else
-c
-c  Two voices per line.  Get default
-c
-              if (ivx .gt. nv) slurudq = 'u'
-c
-c  Upper voice of the two, so up slur
-c
-            end if
-c
-c  Save up/down-ness for use at termination
-c
-            if (slurudq .eq. 'u') isdata = ibset(isdata,27)
-c
-c  End of section for setting slur direction, still in "Turnon" if-block.
-c
-            if (idcode.eq.1 .and. tmove) then
-              iupdn = 1
-              if (slurudq .eq. 'd') iupdn = -1
-            end if
-            if (btest(iornq,11).or.btest(iornq,12)) then
-c
-c  Raise or lower slur by one unit provided . or _ is on same side as slur
-c
-              ivoffinc = 0
-              if ((stemup .and. slurudq.eq.'d') .or.
-     *             (.not.stemup .and. slurudq.eq.'u')) then
-c
-c  Must move the slur for _ or .
-c
-                if (stemup) then
-                  ivoffinc = -1
-                else
-                  ivoffinc = 1
-                end if
-                if (((stemup      .and. nolev.ge.ncm-2) .or.
-     *              (.not.stemup .and. nolev.le.ncm+2)) .and.
-     *                mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc
-                ivoff = ivoff+ivoffinc
-              end if
-            end if
-            if (listslur .eq. 16777215) then
-              print*
-              print*,'You1 defined the twenty-fifth slur, one too many!'
-              write(15,'(/,a)')
-     *               'You2 defined the twenty-fifth slur, one too many!'
-              call stop1()
-            end if
-c
-c  Get index of next slur not in use, starting from ? down
-c
-            ndxslur = log2(16777215-listslur)
-c
-c  Record slur index
-c
-            listslur = ibset(listslur,ndxslur)
-c
-c  Save for use on termination
-c
-c            call setbits(isdata,4,28,ndxslur)
-c  080531  Allow >16 slurs
-            call setbits(isdata,4,28,mod(ndxslur,16))
-            call setbits(isdata,1,18,ndxslur/16)
-c
-c  Shift for stem?
-c
-            if (stemup .and. slurudq.eq.'u' .and. tno.lt.63.) 
-     *              ihoff = ihoff+8
-            if (btest(isdat2(isdat),3)) then
-c
-c  Tie spacing, (slur start)
-c
-              if (slurudq.eq.'d') then
-                ivoff = ivoff+1
-                ihoff = ihoff+8
-              else if (slurudq.eq.'u') then
-                ivoff = ivoff-1
-                if (.not.(stemup.and.tno.lt.63.)) ihoff = ihoff+8
-c
-c  (already shifted if (stemup.and.tno.gt.63.) and slurudq='u')
-c
-              end if
-            end if
-            if (iscrd) then
-c
-c  Additional horiz shifts for h-shifted noteheads?
-c
-              if (btest(isdat2(isdat),1)) then
-c
-c  Slur start on left-shifted chord notehead.  ASSUME downstem.
-c
-                if (nolevs.eq.minlev .and. slurudq.eq.'d') then
-                  ihoff = ihoff-2
-                else
-                  ihoff = ihoff-10
-                end if
-              else if (btest(isdat2(isdat),2)) then
-c
-c  Right shifted chord notehead.  ASSUME upstem.
-c
-                if (nolevs.eq.maxlev .and. slurudq.eq.'u') then
-                  ihoff = ihoff+2
-                else
-                  ihoff = ihoff+10
-                end if
-              end if
-            end if
-            if (ihoff .eq. 0) then
-c
-c  Write stuff for non-shifted start
-c
-              notexq = chax(92)//'islur'//slurudq
-              lnote = 7
-            else
-              notexq = chax(92)//'is'//slurudq
-              lnote = 4
-            end if
-            if (btest(isdat2(isdat),4)) then
-c
-c  Dotted slur
-c
-              noteq(1:8) = notexq
-              notexq = chax(92)//'dotted'//noteq
-              lnote = lnote+7
-            end if
-c
-c  Add slur index to string
-cc  Print 11-ndxslur
-c  Print 23-ndxslur
-c
-c            if (11-ndxslur .lt. 10) then
-            if (23-ndxslur .lt. 10) then
-c
-c  5/25/08 Allow 24 slurs
-c
-c              notexq = notexq(1:lnote)//chax(59-ndxslur)
-              notexq = notexq(1:lnote)//chax(71-ndxslur)
-              lnote = lnote+1
-            else if (23-ndxslur .lt. 20) then
-c              notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}'
-              notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}'
-              lnote = lnote+4
-            else 
-              notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
-              lnote = lnote+4
-            end if
-c
-c  Add note name to string
-c
-            call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm)
-            notexq = notexq(1:lnote)//noteq(1:lnoten)
-            lnote = lnote+lnoten
-c
-c  Save height (for ornament and barnobox interference) if topmost slur is up
-c
-            if (slurudq.eq.'u' .and.
-     *           (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then
-              islhgt = nolevs+iupdn+ivoff
-c
-c  Save height & idcode if top voice and slur start
-c
-              if (ivx.eq.ivmx(nv,nvmx(nv)) .and. islhgt.gt.is1n1) then
-                is1n1 = islhgt
-                is2n1 = idcode
-              end if
-            end if
-            if (ihoff .ne. 0.) then
-              shift = ihoff*0.1
-              notexq = notexq(1:lnote)//'{'
-              lnote = lnote+1
-              lform = lfmt1(shift)
-              write(notexq(lnote+1:lnote+lform),'(f'//
-     *                  chax(48+lform)//'.1)') shift
-              lnote = lnote+lform
-              notexq = notexq(1:lnote)//'}'
-              lnote = lnote+1
-            end if
-            call addstr(notexq,lnote,soutq,lsout)
-c
-c  Zero out ip1 to avoid problems if slur goes to next input blk.
-c
-            call setbits(isdata,8,3,0)
-c
-c  Set slur-on data for midi.  Only treat null-index slurs and ps ties for now.
-c
-            if (ismidi .and. idcode.eq.32) then
-c              levson(midchan(iv,kv)) = nolevs
-c 130316
-c              levson(midchan(iv,kv)) = nolevs-iTransAmt(instno(iv))
-              levson(midchan(iv,kv)) = nolevs+miditran(instno(iv))
-              if (settie) dbltie = .true.
-c
-c  Only way settie=T is if we just set a tie ending.  So there's also a slur
-c   start here, so set a flag telling addmidi not to zero out levson
-c 
-            end if
-          else
-c
-c  Slur is ending.  Back thru list to find starting slur
-c
-            do 3 j = isdat-1 , 1 , -1
-              if (iv.eq.igetbits(isdat1(j),5,13) .and.
-     *            kv.eq.igetbits(isdat1(j),1,12)+1) then
-                if (idcode .eq. igetbits(isdat1(j),7,19)) then
-                  ndxslur = igetbits(isdat1(j),4,28)
-c
-c  080531 Allow >16 slurs
-c
-     *                          +16*igetbits(isdat1(j),1,18)
-                  if (btest(isdat1(j),27)) slurudq = 'u'
-                  go to 4
-                end if
-              end if
-3           continue
-            print*,'Bad place in doslur'
-            call stop1()
-4           continue
-            if (nolevs.eq.0 .or. nolevs.gt.60) then
-c
-c  Ending is on a rest, reset nolevs to default starting height
-c
-              nolevs = igetbits(isdat2(j),7,19)
-            end if
-            if (btest(isdat3(isdat),0)) then
-c
-c  Deal with \curve or \midslur
-c
-              imid = igetbits(isdat3(isdat),6,2)-32 
-c
-c  Remember, only dealing with non-ps slurs
-c
-c  Who knows where the following line came from.  Removed it 6/30/02 to 
-c  restore behavior of non-ps slurs to old way
-c              if (slurudq .eq. 'd') imid = -imid
-c  3/8/03 added the following
-c
-              if (slurudq .eq. 'd') imid = -abs(imid)
-c
-              if (btest(isdat3(isdat),1)) then
-                notexq = chax(92)//'curve'
-                lnote = 6
-              else
-                notexq = chax(92)//'midslur'
-                lnote = 8
-              end if
-              if (imid.lt.0 .or. imid.gt.9) then
-c
-c  Need brackets
-c
-                notexq = notexq(1:lnote)//'{'
-                lnote = lnote+1
-                if (imid .lt. -9) then
-                  write(notexq(lnote+1:lnote+3),'(i3)')imid
-                  lnote = lnote+3
-                else if (imid.lt.0 .or. imid.gt.9) then
-                  write(notexq(lnote+1:lnote+2),'(i2)')imid
-                  lnote = lnote+2
-                else
-                  write(notexq(lnote+1:lnote+1),'(i1)')imid
-                  lnote = lnote+1
-                end if
-                notexq = notexq(1:lnote)//'}'
-                lnote = lnote+1
-              else
-c
-c  1=<imid=<9, no brackets
-c
-                notexq = notexq(1:lnote)//char(48+imid)
-                lnote = lnote+1
-              end if
-              if (btest(isdat3(isdat),1)) then
-c
-c  \curve; 3 args
-c
-                notexq = notexq(1:lnote)
-     *                      //char(48+igetbits(isdat3(isdat),3,8))
-                notexq = notexq(1:lnote+1)
-     *                      //char(48+igetbits(isdat3(isdat),3,11))
-                lnote = lnote+2
-              end if 
-              call addstr(notexq,lnote,soutq,lsout)
-            end if
-c
-c  Shift slur ending for stem on any note?
-c
-            if (.not.stemup .and. slurudq.eq.'d' .and. tno.lt.63.) 
-     *                ihoff = ihoff-8
-            if (btest(isdat2(isdat),3)) then
-c
-c  Shift ending for tie spacing
-c
-              if (slurudq .eq. 'u') then
-                ihoff = ihoff-8
-                ivoff = ivoff-1
-              else if (slurudq .eq. 'd') then
-                ivoff = ivoff+1
-                if (stemup.or. tno.gt.63.) ihoff = ihoff-8
-              end if
-            end if
-            if (iscrd) then
-c
-c  Shift termination for shifted notehead?
-c
-              if (btest(isdat2(isdat),1)) then
-c
-c  Left-shifted chord notehead.  ASSUME downstem.
-c
-                if (nolevs.eq.minlev .and. slurudq.eq.'d') then
-                  ihoff = ihoff-2
-                else
-                  ihoff = ihoff-10
-                end if
-              else if (btest(isdat2(isdat),2)) then
-c
-c  Right shifted chord notehead.  ASSUME upstem.
-c
-                if (nolevs.eq.maxlev .and. slurudq.eq.'u') then
-                  ihoff = ihoff+2
-                else
-                  ihoff = ihoff+10
-                end if
-              end if
-            end if
-            if (ihoff .eq. 0) then
-              notexq = chax(92)//'tslur'
-              lnote = 6
-            else
-c
-c  Shift needed
-c
-              notexq = chax(92)//'ts'
-              lnote = 3
-            end if
-c
-c  Print 23-ndxslur
-c  5/25/08 Allow 14 slurs (???????????)
-c
-            if (23-ndxslur .lt. 10) then
-              notexq = notexq(1:lnote)//chax(71-ndxslur)
-              lnote = lnote+1
-            else if (23-ndxslur .lt. 20) then
-              notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}'
-              lnote = lnote+4
-            else 
-              notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
-              lnote = lnote+4
-            end if
-            if (btest(iornq,11).or.btest(iornq,12)) then
-c
-c  Raise or lower slur by one unit provided . or _ is on same side as slur
-c
-              ivoffinc = 0
-              if ((stemup .and. slurudq.eq.'d') .or.
-     *                 (.not.stemup .and. slurudq.eq.'u')) then
-                if (stemup) then
-                  ivoffinc = -1
-                else
-                  ivoffinc = 1
-                end if
-                if (((stemup .and. nolev.ge.ncm-2) .or.
-     *              (.not.stemup .and. nolev.le.ncm+2)) .and.
-     *               mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc
-              end if
-              ivoff = ivoff+ivoffinc
-            end if
-            if (idcode.eq.1 .and. tmove) then
-c
-c  t-slur height adjustment
-c
-              iupdn = 1
-              if (slurudq .eq. 'd') iupdn = -1
-            end if
-            call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm)
-            if (slurudq.eq.'u' .and.
-     *           (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then
-              islhgt = nolevs+iupdn+ivoff
-c
-c  If topvoice, upslur, and idcode checks, no more need to keep hgt for barno.
-c
-              if (ivx.eq.ivmx(nv,nvmx(nv)) .and. is1n1.gt.0) then
-                if (idcode .eq. is2n1) is1n1=0
-              end if
-            end if
-            notexq = notexq(1:lnote)//noteq(1:lnoten)
-            lnote = lnote+lnoten
-            if (ihoff .ne. 0) then
-              shift = ihoff*0.1
-              notexq = notexq(1:lnote)//'{'
-              lnote = lnote+1
-              lform = lfmt1(shift)
-              write(notexq(lnote+1:lnote+lform),
-     *            '(f'//chax(48+lform)//'.1)')shift
-              lnote = lnote+lform
-              notexq = notexq(1:lnote)//'}'
-              lnote = lnote+1
-            end if
-            call addstr(notexq,lnote,soutq,lsout)
-c
-c  Clear the bit from list of slurs in use
-c
-            listslur = ibclr(listslur,ndxslur)
-c
-c  Zero out the entire strings for start and stop
-c
-            isdata = 0
-            isdat2(isdat) = 0
-            isdat1(j) = 0
-            isdat2(j) = 0
-            isdat3(isdat) = 0
-c
-c  Set midi info for slur ending
-c
-            if (ismidi .and. idcode.eq.32) then 
-              icm = midchan(iv,kv)
-              if (slmon(icm)) then
-c                if (nolevs.eq.levson(icm) .and. iand(7,nacc).eq.0) then
-c 130316
-c                if (nolevs-iTransAmt(instno(iv)).eq.levson(icm) .and.
-                if (nolevs+miditran(instno(iv)).eq.levson(icm) .and.
-     *              iand(7,nacc).eq.0) then
-c
-c  There is a tie here.  NB!!! assumed no accidental on 2nd member of tie.
-c
-c                  levsoff(icm) = nolevs
-c 130316
-c                  levsoff(icm) = nolevs-iTransAmt(instno(iv))
-                  levsoff(icm) = nolevs+miditran(instno(iv))
-                  settie = .true.
-                else
-                  levsoff(icm) = 0
-                  levson(icm) = 0
-                  slmon(icm) = .false.
-                end if
-              end if
-            end if 
-          end if
-          isdat1(isdat) = isdata
-        end if
-1     continue
-c
-c  Clear and collapse the slur data list
-c
-      numdrop = 0
-      do 2 isdat  = 1 , nsdat
-        if (isdat1(isdat) .eq. 0) then
-          numdrop = numdrop+1
-        else if (numdrop .gt. 0) then
-          isdat1(isdat-numdrop) = isdat1(isdat)
-          isdat2(isdat-numdrop) = isdat2(isdat)
-          isdat3(isdat-numdrop) = isdat3(isdat)
-          isdat1(isdat) = 0
-          isdat2(isdat) = 0
-          isdat3(isdat) = 0
-        end if
-2     continue
-      nsdat = nsdat-numdrop
-c      call report(nsdat,isdat1,isdat2)
-      return
-      end
-      subroutine dotmov(updot,rtdot,soutq,lsout,iddot)
-c
-c  iddot = 0 for single dot, 1 for double
-c
-      character*80 soutq,notexq
-      character*1 sq,chax
-      sq = chax(92)
-      lfmtup = lfmt1(updot)
-      lfmtrt = lfmt1(rtdot)
-      write(notexq,'(a37,f'//chax(48+lfmtup)//'.1,a2,f'//chax(48+lfmtrt)
-     *    //'.1,a15)')
-     * sq//'makeatletter'//sq//'def'//sq//'C at Point#1#2{'//sq//
-     * 'PMXpt{',updot,'}{',rtdot,'}'//chax(48+iddot)//'}'//sq
-     * //'makeatother'
-c
-c   Example of string just created:
-c   \makeatletter\def\C at Point#1#2{\PMXpt{.5}{.5}}\makeatother\
-c
-      lnote = 54+lfmtup+lfmtrt
-      call addstr(notexq(1:lnote),lnote,soutq,lsout)
-      return
-      end
-      subroutine dotrill(iv,ip,iornq,noteq,lnoten,notexq,lnote)
-      common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
-     *                ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
-     *                kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-      character*1 chax
-      character*8 noteq
-      character*79 notexq
-      logical tronly,btest
-      do 1 itr = 1 , ntrill
-        if (iv.eq.ivtrill(itr) .and. ip.eq.iptrill(itr)) go to 2
-1     continue
-      print*,'Problem in dotrill.  Call Dr. Don'
-      stop
-2     continue
-      tronly = xnsktr(itr) .lt. 0.01
-      if (tronly) then
-        notexq = chax(92)//'zcharnote'
-        lnote = 10
-      else if (btest(iornq,7)) then
-        notexq = chax(92)//'Trille'
-        lnote = 7
-      else
-        notexq = chax(92)//'trille'
-        lnote = 7
-      end if
-      notexq = notexq(1:lnote)//noteq(1:lnoten)//'{'
-      lnote = lnote+lnoten+1
-c
-c  Write trill duration to nearest tenth of a noteskip
-c
-      if (tronly) then
-        notexq = notexq(1:lnote)//chax(92)//'it tr}'
-        lnote = lnote+7
-        return
-      end if
-      if (xnsktr(itr) .lt. .95) then
-        nfmt = 2
-      else if (xnsktr(itr) .lt. 9.95) then
-        nfmt = 3
-      else
-        nfmt = 4
-      end if
-      write(notexq(lnote+1:lnote+nfmt),'(f'//chax(48+nfmt)//'.1)')
-     *   xnsktr(itr)
-      lnote = lnote+nfmt
-      notexq = notexq(1:lnote)//'}'
-      lnote = lnote+1
-      return
-      end
-      subroutine endslur(stemup,upslur,nolev,iupdn,ndxslur,ivoff,ncm,
-     *  soutq,lsout,fontslur)
-c
-c  Only called to end slur started in dograce.
-c
-      logical shift,stemup,upslur,fontslur
-      character*80 soutq
-      character*79 notexq
-      character*8 noteq
-      character*1 chax
-      shift = .not.stemup .and. .not.upslur
-      if (.not.shift) then
-c
-c  No shift needed
-c
-         notexq = chax(92)//'tslur'
-         lnote = 6
-      else
-c
-c  Shift needed
-c
-         notexq = chax(92)//'ts'
-         lnote = 3
-      end if
-c      if (ndxslur .lt. 10) then
-c        notexq = notexq(1:lnote)//chax(48+ndxslur)
-c        lnote = lnote+1
-c      else
-c        notexq = notexq(1:lnote)//'{1'//chax(38+ndxslur)//'}'
-c        lnote = lnote+4
-c      end if
-c
-cc  Print 11-ndxslur
-c  Print 23-ndxslur
-c
-c      if (11-ndxslur .lt. 10) then
-      if (23-ndxslur .lt. 10) then
-c        notexq = notexq(1:lnote)//chax(59-ndxslur)
-        notexq = notexq(1:lnote)//chax(71-ndxslur)
-        lnote = lnote+1
-      else if (23-ndxslur .lt. 20) then
-c              notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}'
-        notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}'
-        lnote = lnote+4
-      else 
-        notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
-        lnote = lnote+4
-      end if
-      call notefq(noteq,lnoten,nolev+iupdn+ivoff,ncm)
-      notexq = notexq(1:lnote)//noteq(1:lnoten)
-      lnote = lnote+lnoten
-      if (shift) then
-        if (fontslur) then 
-          notexq = notexq(1:lnote)//'{-.6}'
-        else
-          notexq = notexq(1:lnote)//'{-.8}'
-        end if
-        lnote = lnote+5
-      end if
-      call addstr(notexq,lnote,soutq,lsout)
-      return
-      end
-      subroutine errmsg(lineq,iccount,ibarno,msgq)
-      parameter(nm=24)
-      common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
-     *     fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
-      logical lastchar,fbon,issegno,isheadr,isvolt
-      character*128 lineq
-      character*78 outq
-      character*(*) msgq
-      character*1 chax
-      common /truelinecount/ linewcom(20000)
-      if (iccount .le. 78) then
-        outq = lineq(1:78)
-        iposn = iccount
-      else
-        outq = '... '//lineq(55:128)
-        iposn = iccount-50
-      end if
-      print*
-      ibarnop = ibarno
-      if (linesinpmxmod.eq.0 .or. 
-     *    nline .gt. line1pmxmod+linesinpmxmod) then
-c
-c  Error is in main .pmx file
-c
-c        nlinep = nline-linesinpmxmod
-c       Correct for comments not copied into buffer
-        nlinep = linewcom(nline)-linesinpmxmod
-      else
-c
-c  Error is in include file
-c
-        ibarnop = 0
-        nlinep = nline-line1pmxmod+1
-        call printl(
-     *    'ERROR in include file named above, description given below')
-      end if
-      open(19,file='pmxaerr.dat')
-      write(19,'(i6)') nlinep
-      close(19)
-      ndigbn = max(1,int(log10(ibarnop+.1)+1))
-      ndignl = int(log10(nlinep+.1)+1)
-      lenmsg = index(msgq,'!')-1
-c
-c  Split off msgq(..) since UNIX compilers don't allow concat substring!!!
-c
-      write(*,'(/,a15,i'//chax(48+ndignl)//',a6,i'//chax(48+ndigbn)//
-     *',$)')' ERROR in line ',nlinep,', bar ',ibarnop
-      write(*,'(1x,a)')msgq(1:lenmsg)
-      write(15,'(/,a15,i'//chax(48+ndignl)//',a6,i'//chax(48+ndigbn)//
-     *',$)')' ERROR in line ',nlinep,', bar ',ibarnop
-      write(15,'(a)')msgq(1:lenmsg)
-      i10 = iposn/10
-      i1 = iposn-10*i10
-      write(*,'('//chax(48+i10)//chax(48+i1)//'x,a)')'v'
-      write(15,'('//chax(48+i10)//chax(48+i1)//'x,a)')'v'
-      print*,outq(1:78)
-      write(15,'(a)')' '//outq(1:78)
-      write(*,'('//chax(48+i10)//chax(48+i1)//'x,a)')'^'
-      write(15,'('//chax(48+i10)//chax(48+i1)//'x,a)')'^'
-      return
-      end
-      subroutine eskb4(ip,ivx,in,ib,space,tstart,fbar,itrpt,esk)
-c
-c  Get elemskips to previous note.  Called only for graces, no xtups involved.
-c
-      parameter (nm=24)
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      character*1 ulq,sepsymq,sq
-      logical beamon,firstgulp,figbass,figchk,isfig
-      real*4 tstart(80),space(80)
-      common /comtol/ tol
-      itnd = nint(to(in))
-      if (ip.eq.1 .or. itnd.eq.itrpt) then
-c
-c  Start of bar or after rpt.
-c
-        esk = fbar
-        return
-      else
-        esk = 0.
-        itprev = itnd-nodur(ivx,ip-1)
-        do 1 iib = ib , 1 , -1
-          if (tstart(iib) .lt. itprev+tol) then
-c
-c  This is the block
-c
-            nnsk = nint(float((itnd-itprev))/space(iib))
-            esk = esk+nnsk*feon(space(iib))
-            return
-          else
-            nnsk = nint((itnd-tstart(iib))/space(iib))
-            esk = esk+nnsk*feon(space(iib))
-            itnd = nint(tstart(iib))
-          end if
-1       continue
-      end if
-      print*,'Problem in eskb4.  Send files to Dr. Don'
-      stop
-      end
-      function f1eon(time)
-        f1eon = sqrt(time/2)
-      return
-      end
-      function feon(time)
-        common /comeon/ eonk,ewmxk
-        feon = sqrt(time/2)**(1.-eonk)*ewmxk
-      return
-      end
-      subroutine findbeam(ibmrep,numbms,mapfb)
-c
-c  Called once per voice per bar, after setting forced beams.
-c
-      parameter (nm=24)
-      dimension mask(49,3),nummask(3),eqonly(49,3)
-c      integer numbms(nm),ipr(48),nip1(0:47),nip2(0:47),mapfb(16),
-c     *       itr(48),nodue(48)
-c      logical short(48),eqonly
-      integer numbms(nm),ipr(248),nip1(0:247),nip2(0:247),mapfb(16),
-     *       itr(248),nodue(248)
-      logical short(248),eqonly
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      common /comipl2/ ipl2(nm,200)
-      common /combeam/ ibmtyp
-      common /commvl/ nvmx(nm),ivmx(nm,2),ivx
-      common /comtol/ tol
-      character*1 ulq,sepsymq,sq
-      logical beamon,firstgulp,figbass,figchk,
-     *        isfig,btest
-      data nip1,nip2 /496*0/
-      data nummask / 29 , 49 , 12 /
-      data mask
-     * /  65535,     4095,    65520,      255,    65280,       63,
-     *      252,    16128,    64512,       15,      240,     3840,
-     *    61440,        7,       14,      112,      224,     1792,
-     *     3584,    28672,    57344,        3,       12,       48,
-     *      192,      768,     3072,    12288,    49152, 20*0 ,
-     * 16777215,    65535, 16776960,     4095,    65520,  1048320,
-     * 16773120,      255,    65280, 16711680,       63,      252,
-     *    16128,    64512,  4128768, 16515072,       15,       60,
-     *      240,     3840,    15360,    61440,   983040,  3932160,
-     * 15728640,        7,       14,      112,      224,     1792,
-     *     3584,    28672,    57344,   458752,   917504,  7340032,
-     * 14680064,        3,       12,       48,      192,      768,
-     *     3072,    12288,    49152,   196608,   786432,  3145728,
-     * 12582912,
-     *     4095,      255,     4080,       15,      240,     3840,
-     *        3,       12,       48,      192,      768,     3072,
-     *  37*0 /
-      data eqonly /3*.true.,46*.false.,7*.true.,91*.false./
-      ip = 0
-      nreal = 0
-      itnow = 0
-1     continue
-        ip = ip+1
-        if (ip .gt. nn(ivx)) go to 9
-11      if (nodur(ivx,ip).eq.0) then
-c
-c  Ignore all xtup notes except the last, the one with nodur > 0 .
-c  Xtups are irrelevant here since they are already all in forced beams.
-c  Will update itnow by nodur at the END of this loop
-c
-          ip = ip+1
-          go to 11
-        end if
-        nreal = nreal+1
-        nodue(nreal) = nodur(ivx,ip)
-        short(nreal) = nodue(nreal).lt.16 .and.
-     *                     .not.btest(irest(ivx,ip),0)
-c
-c  Rule out notes that have 'alone'-flag set
-c
-     *   .and..not.btest(islur(ivx,ip),18)
-        ipr(nreal) = ip
-        itr(nreal) = itnow
-        if (nodue(nreal) .eq. 1) then
-c
-c  64th gap
-c
-          if (mod(itnow,2) .eq. 0) then
-c
-c  Start of 32nd gap, lump with following note
-c
-            ip = ip+1
-		  nodue(nreal) = 1+nodur(ivx,ip)
-            itnow = itnow+nodue(nreal)
-          else
-c
-c  End of 32nd gap, lump with preceeding note
-c
-            nreal = nreal-1
-            nodue(nreal) = 1+nodue(nreal)
-            itnow = itnow+1
-          end if
-        else
-          itnow = itnow+nodur(ivx,ip)
-        end if
-      go to 1
-9     continue
-      ir1 = 1
-      itseg = lenbar/ibmrep
-      do 13 irep = 1 , ibmrep
-c
-c  Set bitmaps for all shorts neighbored by a short. Each bit represents a
-c  span of 32nd note.  maps, mapm, mape record start, full duration, and end
-c  of consecutive span of beamable (<1/4) notes.
-c
-        maps = 0
-        mapm = 0
-        mape = 0
-        itend = itseg*irep
-        itoff = itend-itseg
-        do 2 ir = ir1 , nreal
-          it2 = itr(ir)+nodue(ir)-2
-          if (it2 .ge. itend) then
-            ir1 = ir
-            go to 14
-          end if
-c         if (short(ir).and.((ir.gt.1.and.short(ir-1)).or.(ir.lt.nreal
-          if (short(ir).and.((ir.gt.1.and.short(max(ir-1,1))).or.
-     *          (ir.lt.nreal.and.short(ir+1)))) then
-            ib1 = (itr(ir)-itoff)/2
-            ib2 = (it2-itoff)/2
-            if (max(ib1,ib2).gt.47 .or. ir.gt.48 .or.
-     *                       min(ib1,ib2).lt.0) return
-c
-c  Must have an odd number obe beats in a long bar.  Auto-beam won't work
-c
-            nip1(ib1) = ipr(ir)
-            nip2(ib2) = ipr(ir)
-c
-c  nip1,2(ib) = 0 unless a real note starts,ends on bit ib; then = ip
-c
-            maps = ibset(maps,ib1)
-            mape = ibset(mape,ib2)
-            do 3 ib = ib1 , ib2
-              mapm = ibset(mapm,ib)
-3           continue
-          end if
-2       continue
-14      continue
-        if (mapm .eq. 0) go to 13
-c
-c  Zero out bits from forced beams
-c
-        maps = iand(maps,not(mapfb(irep)))
-        mapm = iand(mapm,not(mapfb(irep)))
-        mape = iand(mape,not(mapfb(irep)))
-c
-c  Compare map with template.
-c
-        do 4 it = 1 , nummask(ibmtyp)
-          masknow = mask(it,ibmtyp)
-          if (iand(masknow,mapm) .eq. masknow) then
-c
-c  Find least significant bit in the mask to check start time
-c
-            mtemp = masknow
-            maskm = masknow
-            do 5 is1 = 0 , 47
-              if (iand(1,mtemp) .eq. 1) go to 6
-              mtemp = ishft(mtemp,-1)
-5           continue
-6           continue
-            if (iand(ishft(1,is1),maps) .eq. 0) go to 4
-c
-c  is1 is the bit where the beam starts.  Continue shifting to
-c  find most significant bit in the mask to check ending time
-c
-            do 7 is2 = is1 , 47
-              mtemp = ishft(mtemp,-1)
-              if (iand(1,not(mtemp)) .eq. 1) go to 8
-7           continue
-8           continue
-c
-c  is2 is now the bit on which the beam ends.
-c
-            if (iand(ishft(1,is2),mape) .eq. 0) go to 4
-c
-c  Did we pick out a single note from the middle of a longer sequence?
-c
-            if (nip1(is1) .eq. nip2(is2)) go to 4
-c
-c  We almost have a beam.  Check equality of notes if needed.
-c
-            if (eqonly(it,ibmtyp)) then
-              do 10 ip = nip1(is1) , nip2(is2)
-                if (nodur(ivx,ip) .ne. 8) then
-c
-c  There is a non-1/8th note in this beam. Exit if not 2 quarters
-c
-                  if (is2-is1 .ne. 15) go to 4
-c
-c  Beam is 2 quarters long.  Check if can split in half.
-c
-                  ithalf = 0
-                  do 20 iip = nip1(is1) , nip2(is2)
-                    ithalf = ithalf+nodur(ivx,iip)
-                    if (ithalf .gt. 16) go to 4
-                    if (ithalf .eq. 16) go to 21
-20                continue
-                  print*,'Problem in findbeam, please call Dr. Don'
-                  go to 4
-21                continue
-c
-c  Otherwise, split in half by keeping only the first half.  Other half will
-c  be picked up later, assuming masks are listed longest first.
-c
-                  is2 = is1+7
-c
-c  Reset maskm (since only used part of mask), used later to zero out
-c  bits that contain beams
-c
-                  maskm = 0
-                  do 15 is = is1 , is2
-                    maskm = ibset(maskm,is)
-15                continue
-                  go to 16
-                end if
-10            continue
-            end if
-16          continue
-c
-c  This is a beam.  If last "effective" ends on odd 64th, add 1 more
-c
-c            if (abs(mod(to(iand(255,ipl(ivx,nip2(is2))))
-c     *           +nodur(ivx,nip2(is2)),2.)) .gt. tol) then
-            if (abs(amod(to(ipl2(ivx,nip2(is2)))
-     *           +nodur(ivx,nip2(is2))+.5*tol,2.)) .gt. tol) then
-              nip2(is2) = nip2(is2)+1
-            end if
-            numbms(ivx) = numbms(ivx)+1
-            numnew = numbms(ivx)
-            call logbeam(numnew,nip1(is1),nip2(is2))
-c
-c  Zero out the appropriate bits so these notes don't get used again
-c
-            mapm = iand(mapm,not(maskm))
-            if (mapm.eq.0) go to 13
-            maps = iand(maps,not(maskm))
-            mape = iand(mape,not(maskm))
-          end if
-4       continue
-13    continue
-      return
-      end
-      subroutine findeonk(nptr1,nptr2,wovera,xelsk,dtmin,dtmax,eonk0)
-      parameter (nkb=3999,maxblks=4000)
-c
-c  Compute an exponent eonk for use in the "flattened" formula for elemskips
-c   vs time.  We must solve the eqution f = 0.  Initial quess is eonk0.
-c
-c      logical gotclef
-      common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks),
-     *     iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr,
-c     *     ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks)
-     *     ibaroff,udsp(nkb),wheadpt,sqzb(maxblks)
-      common /comtol/ tol
-      common /comeon/ eonk,ewmxk
-      eonk = eonk0
-      niter = 0
-1     continue
-      ewmxk = f1eon(dtmax)**eonk
-      niter = niter+1
-      esum = 0.
-      desum = 0.
-      do 2 iptr = nptr1 , nptr2
-        targ = durb(iptr)/sqzb(iptr)
-        esum = esum+nnpd(iptr)*sqzb(iptr)*feon(targ)
-        detarg = sqrt(targ/2*(dtmax/targ)**eonk)*alog(dtmax/targ)
-        desum = desum+nnpd(iptr)*sqzb(iptr)*detarg
-2     continue
-      f = wovera*feon(dtmin)-xelsk-esum
-      fp = wovera*sqrt(dtmin/2*(dtmax/dtmin)**eonk)*alog(dtmax/dtmin)
-     *     -desum 
-      if (abs(fp).lt.tol .or. abs(eonk-.5).gt..5 .or. niter.gt.100) then
-        call printl(
-     *     'Error in findeonk.  Please send source to Dr. Don')
-        eonk = 0.
-        ewmxk = 1.
-        return
-      end if
-      dsoln = -f/fp
-      if (abs(dsoln) .lt. .1*tol) return
-c
-c  Not converged yet, try again
-c
-      eonk = eonk+dsoln
-      go to 1
-      end
-      function fnote(nodur,ivx,ip,nacc)
-c
-c  This return the real duration of a note
-c
-      parameter (nm=24)
-      integer*4 nodur(nm,200),nacc(nm,200)
-      logical btest
-      ipback = ip
-      if (nodur(ivx,ip) .gt. 0) then
-        if (ip .gt. 1) then
-c
-c  Check if this is last note of xtup
-c
-          if (nodur(ivx,ip-1).eq.0) then
-            ipback = ip-1
-            go to 2
-          end if
-        end if
-        fnote = nodur(ivx,ip)
-        return
-      end if
-2     continue
-c
-c  Count back to prior non zero note. Start at ip to avoid neg index if ip=1.
-c  Count how many doubled xtups notes there are from ip-1 to first note. 
-c
-      ndoub = 0
-      do 1 ip1m1 = ipback , 1 , -1
-        if (nodur(ivx,ip1m1) .gt. 0) go to 4
-        if (ip1m1.lt.ip .and. btest(nacc(ivx,ip1m1),18)) ndoub=ndoub+1
-1     continue
-4     continue      
-c
-c  count forward to next non-0 nodur. Start at ip in case last note of xtup. 
-c
-      do 3 iip = ip , 200
-c
-c  Count doubled xtup notes from ip to end.
-c
-        if (btest(nacc(ivx,iip),18)) ndoub = ndoub+1
-        if (nodur(ivx,iip) .gt. 0) then
-c          fnote = nodur(ivx,iip)/float(iip-ip1m1)
-          fnote = nodur(ivx,iip)/float(iip-ip1m1+ndoub)
-          if (btest(nacc(ivx,ip),18)) then
-            fnote = 2*fnote
-          else if (btest(nacc(ivx,ip),27)) then
-            fnote = 1.5*fnote
-          else if (ip .gt. 1) then
-            if (btest(nacc(ivx,ip-1),27)) fnote = .5*fnote
-          end if 
-          return
-        end if
-3     continue
-      print*,' '
-      call printl
-     *   ('Probable misplaced barline or incorrect meter, stopping')
-c      call printl('Program error in fnote, send source to Dr. Don')
-      call stop1()
-      end
-      subroutine g1etchar(lineq,iccount,charq)
-      parameter(nm=24)
-      common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
-     *     fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
-      logical lastchar,issegno,isheadr,isvolt,fbon
-      common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
-      logical mrecord,mplay,endmac
-      character*1 charq
-      character*128 lineq,lnholdq
-c
-c  Gets the next character out of lineq*128.  If pointer iccount=128 on entry,
-c  then reads in a new line.  Resets iccount.  Ends program if no more input.
-c
-      if (iccount .eq. 128) then
-        call read10(lineq,lastchar)
-        if (lastchar) return
-        if (.not.endmac) then
-          iccount = 0
-          if (.not.mplay) nline = nline+1
-        else
-          endmac = .false.
-          iccount = icchold
-          lineq = lnholdq
-        end if
-        if (mrecord) then
-          call m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm)
-        end if
-      end if
-      iccount = iccount+1
-      charq = lineq(iccount:iccount)
-      return
-      end
-      subroutine g1etnote(loop,ifig,optimize,fulltrans)
-      parameter (nm=24,nkb=3999,mv=24576,maxblks=4000)
-      character*1 chax
-      common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm),
-     *   nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount,
-     *   nbars,itsofar(nm),nib(nm,15),nn(nm),
-     *   rest(nm,200),lenbr0,lenbr1,firstline,newmeter
-      common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks),
-     *     iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr,
-c     *     ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks)
-     *     ibaroff,udsp(nkb),wheadpt,sqzb(maxblks)
-      common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
-     *     fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
-      common /compage/ widthpt,ptheight,hoffpt,voffpt,
-     *      nsyst,nflb,ibarflb(0:40),
-     *      isysflb(0:40),npages,nfpb,ipagfpb(0:18),isysfpb(0:18),
-     *      usefig,fintstf,gintstf,fracsys(30),nmovbrk,isysmb(0:30),
-     *      nistaff(0:40)
-      common /c1ommvl/ nvmx(nm),ivmx(nm,2),ivx,fbar,nacc(nm,200)
-      common /comkeys/ nkeys,ibrkch(18),newkey(18),iskchb,idsig,isig1,
-     *      mbrestsav,kchmid(18),ornrpt,shifton,barend,noinst,stickyS
-      logical lastchar,firstline,rest,loop,newmeter,fbon,issegno,barend,
-     *        isheadr,fulbrp,usefig,isvolt,iskchb,kchmid,plusmin,ornrpt,
-     *        stickyS
-      common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
-      common /commus/ musize,whead20
-      logical mrecord,mplay,endmac,shifton,gotclef,optimize
-      character*128 lineq,lnholdq
-      character*1 charq,dotq,dumq,durq,charlq
-      integer*2 mmidi
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc,cdot
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      character*65536 bufq
-      integer*2 lbuf(maxblks)
-      common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
-      logical novshrinktop,upslur,fontslur,ztrans,
-     *        WrotePsslurDefaults,cstuplet
-      common /comnvst/ novshrinktop,cstuplet
-      common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
-     *                 ,WrotePsslurDefaults,SlurCurve
-      character*51 literq(3),lyrerq(5)
-      common /comligfont/ isligfont
-      logical isligfont
-      common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
-     *  instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
-      logical EarlyTransOn,LaterInstTrans
-      logical fulltrans
-      common /comsize/ isize(nm)
-      common /commidisig/ midisig
-      data literq
-     *   /'Literal TeX string cannot start with 4 backslashes!',
-     *    'TeX string must have <129 char, end with backslash!',
-     *    'Type 2 or 3 TeX string can only start in column 1!'/
-      data lyrerq
-     *   /'pmxlyr string must end with " followed by blank!',
-     *    'pmxlyr string cannot extend past position 120!',
-     *    'There must be "a" or "b" here!',
-     *    'There must be "+" or "-" here!',
-     *    'There must be an integer here!'/
-      cdot = .false.
-1     call g1etchar(lineq,iccount,charq)
-      if (charq .ne. ' ') charlq = charq
-      if (lastchar) then
-        if (index('/%',charlq) .eq. 0) then
-          print*
-          print*,'WARNING:'
-          print*,'Last non-blank character is "',charlq,'", not "/,%"'
-          print*,'ASCII code:',ichar(charlq)
-          write(15,'(/a)')'Last non-blank character is "'//charlq//
-     *       '", not "/,%"'
-          write(15,'(a11,2x,i3)')'ASCII code:',ichar(charlq)
-c
-c  Append " /" to last line.  NB lastchar=.true. => ilbuf=nlbuf+1.
-c
-          ilbuf = ilbuf-1
-          lbuf(ilbuf) = lbuf(ilbuf)+2
-          bufq = bufq(1:ipbuf)//' /'
-          write(15,*)'appending <blank>/'
-          print*,'appending <blank>/'
-          lineq = lineq(1:iccount)//' /'
-          lastchar = .false.
-          go to 1 
-        end if
-        return
-      end if
-      if (charq .eq. ' ') then
-        go to 1
-      else if (charq.eq.'%' .and. iccount.eq.1) then
-        iccount = 128
-        go to 1
-c
-c  Replacement 1/22/12 since gfortran 4.7 with -O was choking here!
-c
-c      else if ((ichar(charq).ge.97.and.ichar(charq).le.103) .or.
-      else if (index('abcdefg',charq).gt.0 .or.
-     *       charq.eq.'r') then
-c
-c  This is a note/rest. gotclef is only used for checking for clef before "/"
-c
-        if (cdot) go to 28
-c        if (gotclef) gotclef=.false.
-        idotform = 0
-        numnum = 0
-        plusmin = .false.
-28      nnl(ivx) = nnl(ivx)+1
-        if (nnl(ivx) .gt. 200) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      '>200 notes in line of music. Use smaller blocks!')
-          call stop1()
-        end if
-        dotq = 'x'
-c
-c  Check if this is 'r ' and previous note was full-bar-pause
-c
-        fulbrp = charq.eq.'r' .and. lineq(iccount+1:iccount+1) .eq.' '
-     *    .and. nnl(ivx).gt.1 .and. rest(ivx,max(1,nnl(ivx)-1)) .and.
-     *    nodur(ivx,max(1,nnl(ivx)-1)) .eq. lenbar
-2       call g1etchar(lineq,iccount,durq)
-        ic = ichar(durq)
-        if (ic.le.57 .and. ic.ge.48) then
-c
-c  Digit
-c
-          if (numnum .eq. 0) then
-            nnodur = ic-48
-            numnum = 1
-            go to 2
-          else if (numnum .eq. 1) then
-            if (charq .eq. 'r') then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Only one digit allowed after rest symbol "r"!')
-              call stop1()
-            end if
-            numnum = 2
-            if (plusmin) then
-              print*
-              print*,'*********WARNING*********'
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Before version 1.2, +/- was ignored if octave was!')
-              print*,
-     *           'explicitly specified.  May need to edit old editions'
-            end if
-            go to 2
-          else
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             '>2 digits in note symbol!')
-            call stop1()
-          end if
-        else if (durq.eq.'d') then
-          dotq = durq
-          if (lineq(iccount+1:iccount+1) .eq. 'd') then
-            iddot = 1
-            iccount = iccount+1
-c
-c  Since we flow out, double dots won't work with other dot options
-c
-          end if
-          if (index('+-',lineq(iccount+1:iccount+1)) .gt. 0) then
-c
-c  move a dot, provided a number follows.
-c
-            call g1etchar(lineq,iccount,durq)
-            call g1etchar(lineq,iccount,durq)
-            if (index('0123456789-.',durq) .eq. 0) then
-c
-c  Backup, exit the loop normally
-c
-              iccount = iccount-2
-              go to 2
-            end if
-            call readnum(lineq,iccount,dumq,fnum)
-            if (index('+-',dumq) .gt. 0) then
-c
-c  Vertical shift also
-c
-              call g1etchar(lineq,iccount,durq)
-              if (index('0123456789-.',durq) .eq. 0) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               'Expected number after 2nd +/- (shift dot)!')
-                call stop1()
-              end if
-              call readnum(lineq,iccount,durq,fnum)
-            end if
-            iccount = iccount-1
-          end if
-          go to 2
-        else if (index('<>',durq) .gt. 0) then
-c
-c  Accidental shift
-c
-c          if (index('fsn',lineq(iccount-1:iccount-1)) .eq. 0) then 
-          if (index('fsnA',lineq(iccount-1:iccount-1)) .eq. 0) then 
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-c     *         'Expected "f", "s", or "n" before "<" or ">"!')
-     *         'Expected "f", "s", "n" or "A" before "<" or ">"!')
-            call stop1()
-          end if
-          ipm = 1
-          if (durq .eq. '<') ipm=-1
-          call g1etchar(lineq,iccount,durq)
-          if (index('123456789.0',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'Expected number after </> (accidental shift)!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          fnum = ipm*fnum
-          if (fnum.lt.-5.35 .or. fnum.gt.1.0) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *       'Horizontal accidental shift must be >-5.35 and <1.0!')
-            call stop1()
-          end if
-          iccount = iccount-1
-          go to 2
-        else if (index('+-',durq) .gt. 0) then
-          if (charq .ne. 'r') then
-            if (index('fsnA',lineq(iccount-1:iccount-1)) .gt. 0) then
-              ipm = 1
-              if (durq .eq. '-') ipm=-1
-              if (index('0123456789',lineq(iccount+1:iccount+1))
-     *                                                    .gt.0) then
-c
-c  This may be start of accidental shift, but may be octave jump; then duration
-c
-                icsav = iccount
-                iccount = iccount+1
-                call readnum(lineq,iccount,durq,fnum)
-                if (index('+-',durq) .gt. 0) then
-c
-c  This is an accid shift since there's a 2nd consecutive signed number.
-c  Check size of 1st number.
-c
-                  if (fnum .gt. 30.5) then
-                    call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *                'Vertical accidental shift must be less than 31!')
-                    call stop1()
-                  end if
-                  ipm = 1
-                  if (durq .eq. '-') ipm = -1
-                  call g1etchar(lineq,iccount,durq)
-                  if (index('1234567890.',durq) .eq. 0) then
-                    call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               'Expected 2nd number of accidental shift)!')
-                    call stop1()
-                  end if
-                  call readnum(lineq,iccount,durq,fnum)
-                  fnum = ipm*fnum
-                  if (fnum.lt.-5.35 .or. fnum.gt.1.0) then
-                    call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *             'Horiz. accidental shift must be >-5.35 and <1.0!')
-                    call stop1()
-                  end if
-                  iccount = iccount-1
-                  go to 2
-                else
-c
-c  Not accid shift, reset, then flow out
-c
-                  iccount = icsav
-                end if
-              end if
-            end if
-            plusmin = .true.
-            if (numnum .eq. 2) then
-              print*
-              print*,'*********WARNING*********'
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Before version 1.2, +/- was ignored if octave was!')
-              print*,
-     *           'explicitly specified.  May need to edit old editions'
-            end if
-            go to 2
-c
-c  It's a rest containing +|- .  Must refer to a vertical shift.  Read past.
-c
-          else
-            call g1etchar(lineq,iccount,durq)
-            call readnum(lineq,iccount,durq,dum)
-            iccount = iccount-1
-            go to 2
-          end if
-c        else if (index('ulare',durq) .gt. 0) then
-        else if (index('ularec',durq) .gt. 0) then
-          go to 2
-c        else if (durq .eq. 'S') then
-        else if (index('LS',durq) .gt. 0) then
-c
-c Stemlength change
-c
-          call g1etchar(lineq,iccount,durq)
-          if (index('.0123456789:',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'There must be a number or colon here!')
-            call stop1()
-          end if
-          if (durq .eq. ':') then
-            if (.not.stickyS) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Turned off sticky stemlegth changes without turning on!')
-              call stop1()
-            end if
-            stickyS = .false.
-            go to 2
-          end if
-          call readnum(lineq,iccount,durq,dum)
-c          if (dum.lt..5 .or. dum.gt.4.) then
-          if ((durq.eq.'L'.and.dum.gt.20.).or.
-     *                (durq.eq.'S'.and.dum.gt.4.)) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *         'Stemlength change amount too big!')
-            call stop1()
-          end if
-          if (durq .ne. ':') then
-            iccount = iccount-1
-          else
-            if (stickyS) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'Turned on sticky stemshrinks when already on!')
-              call stop1()
-            end if
-            stickyS = .true.
-          end if
-          go to 2                    
-        else if (index('fsn',durq) .gt. 0) then
-c
-c Check for midi-only accid. CANNOT coesist with accidental position tweaks, so
-c   MUST come right after "f,s,n"
-c
-          if (lineq(iccount+1:iccount+1) .eq. 'i') iccount=iccount+1
-          go to 2
-        else if (durq .eq. 'p') then
-          fulbrp = charq.eq.'r'
-          if (.not. fulbrp) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'The option "p" only works with "r" (rest)!')
-            call stop1()
-          end if
-          go to 2
-        else if (durq .eq. 'b') then
-          if (charq .ne. 'r') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'You entered "b"; I expected "rb"!')
-            call stop1()
-          else if (numnum .eq. 2) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'You entered "r" & "b" with two numbers!')
-          end if
-          go to 2
-        else if (durq .eq. 'x') then
-c
-c  Xtuplet. Count number of doubled notes (for unequal xtups)
-c
-          if (btest(nacc(ivx,nnl(ivx)),18)) then
-            ndoub = 1
-          else
-            ndoub = 0
-          end if
-c
-c  Will set all durations to 0 except last one.
-c
-          call g1etchar(lineq,iccount,durq)
-          if (index('123456789',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'First char after "x" in xtuplet must be "1"-"9"!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          if (fnum .gt. 99) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Xtuplet cannot have more than 99 notes!')
-            call stop1()
-          else if (index(' DFnd',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Only legal characters here are " ","D","F","n"!')
-            call stop1()
-          end if
-c
-c  End of mandatory xtup inputs.  Check for options. Note D,F,d must precede n.
-c
-          if (index('DF',durq) .gt. 0) then
-c
-c  Double xtup note to make an un= xtup. Here, number already set, but may also
-c    have used this before number was set.
-c
-            nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
-            ndoub = 1
-            call g1etchar(lineq,iccount,durq)
-          else if (durq .eq. 'd') then
-            nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27)
-            call g1etchar(lineq,iccount,durq)
-          end if
-		if (durq .eq. 'n') then
-c
-c  Number alteration stuff.  After 'n', require '+-123456789fs ', no more 'DF'.
-c
-            numshft = 0
-30          call g1etchar(lineq,iccount,durq)
-            if (durq .eq. 'f') then
-              go to 30
-            else if (index('+-',durq) .gt. 0) then
-              numshft = numshft+1
-              if (numshft .eq. 3) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Only 2 shifts are allowed after "n" in xtup!')
-                call stop1()
-              end if
-              call g1etchar(lineq,iccount,durq)
-              if (index('0123456789.',durq) .eq. 0) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'This character should be a digit or "."!')
-                call stop1()
-              end if
-              call readnum(lineq,iccount,durq,snum)
-              iccount = iccount-1
-c              if ((numshft.eq.1 .and. snum.gt.15.1) .or. 
-              if ((numshft.eq.1 .and. snum.gt.64.) .or. 
-     *            (numshft.eq.2 .and. snum.gt.1.51)) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *              'Shift number after "n" in xtup is out of range!')
-                call stop1()
-              end if
-              go to 30
-            else if (durq .eq. 's') then
-c
-c  Slope alteration for bracket
-c
-              call getchar(lineq,iccount,durq)
-              if (index('+-',durq) .eq. 0) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'For slope adjustment, this character must be "+" or "-"!')
-                call stop1()
-              end if
-              call g1etchar(lineq,iccount,durq)
-              if (index('123456789',durq) .eq. 0) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'This character should be a digit!')
-                call stop1()
-              end if
-              call readnum(lineq,iccount,durq,snum)
-              iccount = iccount-1
-              if (nint(snum) .gt. 15) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Slope adjustment cannot exceed 15!')
-                call stop1()
-              end if
-              go to 30
-            else if (index('123456789',durq) .gt. 0) then
-c
-c Unsigned integer => alternate printed number
-c
-              call readnum(lineq,iccount,durq,snum)
-              if (snum .gt. 15.1) then
-                call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *              'Alternate xtup number after "n" must be <16!')
-                call stop1()
-              end if
-              iccount = iccount-1
-              go to 30
-            else if (durq .ne. ' ') then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Illegal character after "n" in xtup!')
-              call stop1()
-            end if
-          end if
-          ntup = nint(fnum)
-          do 6 itup = 2 , ntup
-            nodur(ivx,nnl(ivx)) = 0
-            nnl(ivx) = nnl(ivx)+1
-110         call g1etchar(lineq,iccount,durq)
-            if (durq.eq.' ') then
-              go to 110
-            else if (durq .eq. 'o') then
-c
-c  Ornament in xtup.  "o" symbol must come AFTER the affected note
-c
-              call g1etchar(lineq,iccount,dumq)
-              if (index('(stmx+Tup._)e:>^bc',dumq) .eq. 0 ) then
-                if (index('fg',dumq) .gt. 0) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               'Fermata or segno not allowed in xtuplet!')
-                else
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *                 'Illegal ornament!')
-                end if
-                call stop1()
-              end if
-              if (dumq .eq. 'T') then
-c
-c  Trill.  may be followed by 't' and/or number.  read 'til blank
-c
-29              call g1etchar(lineq,iccount,dumq)
-                if (dumq .ne. ' ') go to 29
-              else if (dumq .eq. 'e') then
-                call g1etchar(lineq,iccount,dumq)
-                if (index('sfn?',dumq) .eq. 0) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'Illegal character after "e" in edit. accid. symbol!')
-                  call stop1()
-                end if
-                call g1etchar(lineq,iccount,dumq)
-                if (dumq .eq. '?') call g1etchar(lineq,iccount,dumq)
-              else if (dumq .eq. ':') then
-                if (lineq(iccount+1:iccount+1) .ne. ' ') then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            '":" must be followed by blank in "o: "!')
-                  call stop1()
-                else if (.not.ornrpt) then
-                  call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *            'Turned off repeated ornaments before they were on!')
-                  call stop1()
-                end if
-                ornrpt = .false.
-              else
-                call g1etchar(lineq,iccount,dumq)
-              end if
-              if (index('+- :',dumq) .eq. 0) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'Illegal character in ornament symbol!')
-                call stop1()
-              end if
-              if (dumq .eq. ':') then
-                if (lineq(iccount+1:iccount+1) .ne. ' ') then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            '":" must be followed by blank in "o: "!')
-                  call stop1()
-                else if (ornrpt) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               'Turned on repeated ornaments but already on!')
-                  call stop1()
-                end if
-                ornrpt = .true.
-              end if
-              if (index('+-',dumq) .gt. 0) then
-                if (index('0123456789',lineq(iccount+1:iccount+1))
-     *                                                   .eq. 0) then
-                  call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
-     *             'There should be an integer here!')
-                  call stop1()
-                end if
-                call readnum(lineq,iccount,durq,fnum)
-                if (durq .eq. ':') then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               'Cannot shift AND repeat an ornament!')
-                  call stop1()
-                end if
-c
-c  12/7/03 Allow horizontal shift on any ornament, not just breath and ceas.
-c
-                if (index('+-',durq) .gt. 0) then
-                  if (index('.0123456789',lineq(iccount+1:iccount+1))
-     *                                                   .eq. 0) then
-                    call errmsg(lineq,iccount+1,
-     *                            ibarcnt-ibaroff+nbars+1,
-     *                            'There should be a number here!')
-                    call stop1()
-                  end if
-                  call readnum(lineq,iccount,durq,fnum)
-                end if
-              end if
-              go to 110
-            else if (index('st(){}',durq) .gt. 0) then
-c
-c  Slur in xtup
-c
-              iposn = 0
-              numint = 0
-15            call g1etchar(lineq,iccount,dumq)
-              iposn = iposn+1
-              if (index('udlbfnhtv',dumq) .gt. 0) then
-                if (dumq.eq.'t' .and. durq.eq.'t') then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *              'Cannot use "t" as an option on a tie!')
-                  call stop1()
-                end if
-                go to 15
-              else if (index('+-',dumq) .gt. 0) then
-                numint = numint+1
-                iccount = iccount+1
-                call readnum(lineq,iccount,durq,fnum)
-                if (numint .eq. 1) then
-                  if (nint(fnum) .gt. 30) then
-                    call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *       'Magnitude of slur height adjustment cannot exceed 30!')
-                    call stop1()
-                  end if
-                else if (numint .eq. 2) then
-                  if (abs(fnum).gt.6.3) then
-                    call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *              'Slur horiz shift must be in the range (-6.3,6.3)!')
-                    call stop1()
-                  end if
-                else
-c
-c  Third signed integer, must be a midslur or curve spec.
-c
-                  if (abs(fnum).gt.31) then
-                    call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *                  'Slur midheight must be in the range (-31,31)!')
-                    call stop1()
-                  end if
-                  if (durq .eq. ':') then
-c
-c  Expecting curve parameters.  Get two numbers
-c
-                    do 40 i = 1 , 2
-                      iccount = iccount+1
-                      fnum = ichar(lineq(iccount:iccount))-48
-                      if (abs(fnum-3.5) .gt. 3.6) then
-                        call errmsg(lineq,iccount,
-     *                      ibarcnt-ibaroff+nbars+1,
-     *           'Slur curve parameter must be in range (0,7)!')
-                        call stop1()
-                      end if
-40                  continue
-                    iccount = iccount+1
-                  end if
-                end if
-                iccount = iccount-1
-                go to 15
-
-              else if (dumq .eq. 's') then
-c
-c What follows should be one or two signed numbers for adjustment of line break
-c slur, end of 1st segment or start of second.
-c
-                if (fontslur) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *    'May not use linebreak slur options with font-based slurs!')
-                  call stop1()
-                end if
-                call g1etchar(lineq,iccount,dumq)
-                if (index('+-',dumq) .eq. 0) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *              'This character must be "+" or "-"!')
-                  call stop1()
-                end if
-                iccount = iccount+1
-                call readnum(lineq,iccount,dumq,fnum)
-                if (nint(fnum) .gt. 30) then
-                  call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *     'Magnitude of slur height adjustment cannot exceed 30!')
-                  call stop1()
-                end if
-                if (index('+-',dumq) .gt. 0) then
-                  iccount = iccount+1
-                  call readnum(lineq,iccount,dumq,fnum)
-                  if (abs(fnum) .gt. 6.3) then
-                    call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *         'Slur horiz shift must be in range (-6.3,6.3)!')
-                    call stop1()
-                  end if
-                end if
-                iccount = iccount-1
-                go to 15
-              else if (dumq .eq. 'H' .and. iposn.gt.1) then
-                if (lineq(iccount+1:iccount+1) .eq. 'H') 
-     *                                     iccount=iccount+1
-                go to 15
-              else if (dumq .eq. 'p') then
-c
-c  local change in postscript slur/tie adjustment default
-c
-                if (fontslur) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Must use postscript slurs ("Ap") to use this option!')
-                  call stop1()                   
-                end if
-                call g1etchar(lineq,iccount,dumq)
-                if (index('+-',dumq) .eq. 0) then                
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *              'Expected "+" or "-" here!')
-                  call stop1()                   
-                end if
-                call g1etchar(lineq,iccount,dumq)
-                if (index('st',dumq) .eq. 0) then                
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *              'Expected "s" or "t" here!')
-                  call stop1()                   
-                end if
-	          go to 15
-              else if (dumq .ne. ' ') then
-                ic = ichar(dumq)
-                if ((ic.ge.48.and.ic.le.57) .or.
-     *                    (ic.ge.65.and.ic.le.90)) then
-                  if (iposn .eq. 1) then
-                    if (durq.eq.'t' .and. fontslur) then
-                      call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *                  'Slur ID not allowed on non-postscript tie!')
-                      call stop1()                   
-                    end if 
-                    go to 15
-                  end if
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *              'Slur ID must be 2nd character in slur symbol!')
-                  call stop1()
-                end if
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *                   'Illegal character in slur symbol!')
-                call stop1()
-              end if
-              go to 110
-            else if (index('0123456789#-nx_',durq) .gt. 0) then
-c
-c  We have a figure.  Only allow on 1st note of xtup
-c
-              if (itup .ne. 2) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Figure in xtup only allowed on 1st note!')
-                call stop1()
-              else if (durq.eq.'x') then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'No floating figures in xtuplets!')
-                call stop1()
-              end if
-              if (usefig .and. ivx.eq.1) ifig = 1
-26            call g1etchar(lineq,iccount,durq)
-c              if (index('0123456789#-n_.:',durq) .gt. 0) then
-              if (index('0123456789#-n_.:v',durq) .gt. 0) then
-                go to 26
-              else if (durq .eq. 's') then
-                isligfont = .true.
-                go to 26
-              else if (durq .eq. '+') then
-c
-c vertical offset, must be integer then blank
-c               
-                call g1etchar(lineq,iccount,durq)
-                if (index('123456789',durq) .ne. 0) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Integer for vertical offset expected here!')
-                  call stop1()
-                end if
-                call readnum(lineq,iccount,durq,fnum)
-                if (durq .ne. ' ') then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Vertical offset must terminate figure!')
-                  call stop1()
-                end if
-                iccount = iccount-1
-                go to 26                  
-              else if (durq .ne. ' ') then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'Illegal character in figure in xtuplet!')
-                call stop1()
-              end if
-              go to 110
-            else if (durq .eq. 'G') then
-              ngr = 1
-79            call g1etchar(lineq,iccount,charq)
-              if (index('123456789',charq) .gt. 0) then
-                call readnum(lineq,iccount,durq,fnum)
-                ngr = nint(fnum)
-                iccount = iccount-1
-                go to 79
-              else if (index('AWulxs',charq) .gt. 0) then
-                go to 79
-              else if (charq .eq. 'm') then
-                call g1etchar(lineq,iccount,charq)
-                if (index('01234',charq) .eq. 0) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'A digit less than 5 must follow "m" in a grace note!')
-                  call stop1()
-                end if
-                go to 79
-              else if (charq .eq. 'X') then
-c
-c Space before main note
-c
-                call g1etchar(lineq,iccount,charq)
-                if (index('0123456789.',charq) .gt. 0) then
-                  call readnum(lineq,iccount,durq,fnum)
-                  iccount = iccount-1
-                  go to 79
-                else
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               'A number must follow "X" in a grace note!')
-                  call stop1()
-                end if
-              end if
-c
-c  At this point, charq is first note name in rest (grace?)
-c
-              do 71 igr = 1 , ngr
-                numnum = 0
-                if (igr .gt. 1) then
-75                call g1etchar(lineq,iccount,charq)
-                  if (charq .eq. ' ') go to 75
-                end if
-                if (index('abcdefg',charq) .eq. 0) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               'In grace, expected "a"-"g"!')
-                  call stop1()
-                end if
-78              call g1etchar(lineq,iccount,charq)
-                if (charq .ne. ' ') then
-                 if (index('1234567',charq) .gt. 0) then
-                    if (numnum .eq. 1) then
-                      call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *                 'Only one of "+-1234567" allowed here in grace!')
-                      call stop1()
-                    end if
-                    numnum = 1
-                    go to 78
-                  else if (index('+-nfs',charq) .gt. 0) then
-                    go to 78
-                  end if
-c
-c  Digits are possible octave numbers
-c
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               'Illegal character after note name in grace!')
-                  call stop1()
-                end if
-71            continue
-              go to 110
-            else if (durq .eq. chax(92)) then
-              call chklit(lineq,iccount,literr)
-              if (literr .gt. 0) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               literq(literr))
-                call stop1()
-              end if
-              go to 110
-            else if (durq .eq. '"') then
-c
-c  pmx lyric
-c
-              call chkpmxlyr(lineq,iccount,lyrerr)
-              if (lyrerr .gt. 0) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               lyrerq(lyrerr))
-                call stop1()
-              end if
-              go to 110
-            else if (durq .eq. 'M') then
-c
-c  Temporary trap until I get around putting this in pmxb
-c
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Macros not yet allowed in xtuplets!')
-              call stop1()
-            else if (durq .eq. 'X') then
-              call g1etx(lineq,iccount,shifton,
-     *            ibarcnt-ibaroff+nbars+1,udsp(ibarcnt+nbars+1),wheadpt)
-              go to 110
-            else if (durq .eq. 'z') then
-c
-c  Chord note in xtup.  Read past for now.
-c
-33            call g1etchar(lineq,iccount,durq)
-              if (durq .ne. ' ') go to 33
-              go to 110
-            else if (durq .eq. 'D') then
-c
-c  Dynamic mark
-c
-              call checkdyn(lineq,iccount,ibarcnt-ibaroff+nbars+1)
-              go to 110
-            else if (durq .eq. '%') then
-              if (iccount .ne. 1) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'Comment must have "%" in column 1!')
-                call stop1()
-              end if
-              iccount = 128
-              go to 110
-            else if (durq .eq. '?') then
-              call getchar(lineq,iccount,durq)
-              if (durq .eq. ' ') then
-                iccount = iccount-1
-                go to 110
-              end if
-              if (durq .ne. '-') then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *                'Expecting "-"')
-                call stop1()
-              end if
-              call getchar(lineq,iccount,durq)
-              if (index('0123456789.',durq) .eq. 0) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *                'Expecting number')
-                call stop1()
-              end if
-              call readnum(lineq,iccount,durq,fnum)
-              iccount = iccount-1
-              go to 110
-c
-c  140215 Allow clef change inside xtup
-c
-            else if (durq .eq. 'C') then
-              call g1etchar(lineq,iccount,durq)
-              if (.not.(index('tsmanrbf',durq).gt.0 .or.
-c     *            (ichar(durq).ge.48 .and. ichar(durq).le.55))) then
-     *            (ichar(durq).ge.48 .and. ichar(durq).le.56))) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Must have t,s,m,a,n,r,b,f or 0-8 after C!')
-                call stop1()
-              end if
-c              gotclef = .true.
-              go to 110
-c+++
-            else if (durq.eq.']' .and. lineq(iccount+1:iccount+1).eq.'['
-     *           .and. lineq(iccount+2:iccount+2).eq.' ') then
-              iccount = iccount+2
-              go to 110
-c+++
-            end if
-c
-c  End of xtup options. At this point symbol can only be note or rest
-c
-            if (index('abcdefgr',durq) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'In xtup, this character is not allowed!')
-              call stop1()
-c            else if (durq.eq.'r' .and. itup.eq.ntup) then
-c              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-c     *         'Sorry, PMX cannot end an xtuplet with a rest!')
-c              call stop1()
-            else if (durq.eq.'r' .and. itup.eq.ntup .and.
-     *          index(lineq(iccount+1:iccount+2),'b').eq.0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Sorry, PMX cannot end an xtuplet with a non-blank rest!')
-              call stop1()
-            end if
-7           call g1etchar(lineq,iccount,durq)
-            if (index('2345678ulcb',durq) .gt. 0) then
-              go to 7
-            else if (index('sfn',durq) .gt. 0) then
-c
-c  Check for MIDI-only accidental. Cannot coexist with accid. pos'n shift.
-c
-              if (lineq(iccount+1:iccount+1) .eq. 'i') iccount=iccount+1
-              go to 7
-            else if (index('+-<>',durq) .gt. 0) then
-c
-c  May have either octave jump or shifted accid. on main xtup note
-c
-              if (index('+-',durq).gt.0 .and.
-     *          index('01234567890',lineq(iccount+1:iccount+1)).eq.0)
-     *          go to 7
-              iccount = iccount+1
-              call readnum(lineq,iccount,durq,fnum)
-              iccount = iccount-1
-              go to 7
-            else if (index('DF',durq) .gt. 0) then
-c
-c  Double an xtup note to make an unequal xtup
-c
-              nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
-              ndoub = ndoub+1
-              go to 7
-            else if (durq .eq. 'd') then
-              nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27)
-              go to 7
-            else if (durq .ne. ' ') then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Illegal option on xtuplet note!')
-              call stop1()
-            end if
-            if (itup .eq. ntup-ndoub) go to 3
-6         continue
-3         continue
-c
-c  6==End of loop for xtuplet input
-c
-        else if (durq .eq. 'm') then
-c
-c  Multi-bar rest: next 1 or two digits are # of bars.
-c
-          if (mod(itsofar(iv),lenbar) .ne. 0) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *             'Multibar rest must start at beginning of bar!')
-            call stop1()
-          else if (iv.eq.1.and.ibarmbr.gt.0) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *         'Multibar rest only OK at one time per block!')
-            call stop1()
-          end if
-c
-c  For some purposes, pretend its one bar only
-c
-          nodur(iv,nnl(iv)) = lenbar
-          ibarmbr = nbars+1
-          mbrest = 0
-c20        call g1etchar(lineq,iccount,durq)
-          call g1etchar(lineq,iccount,durq)
-          if (index('123456789',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Expected an integer after "rm"!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          mbrest = nint(fnum)
-          iccount = iccount-1
-c          if (ichar(durq).ge.48.and.ichar(durq).le.57) then
-c            mbrest = 10*mbrest+ichar(durq)-48
-c            go to 20
-c          end if
-          if (nv .gt. 1) then
-            if (iv .eq. 1) then
-              mbrestsav = mbrest
-            else 
-              if (mbrest .ne. mbrestsav) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Must enter same multi-bar rest in every voice!')
-                call stop1()
-              end if
-            end if
-c
-c  Zero out mbrestsav so can check at end of input block whether 
-c    all voices have one
-c
-            if (iv .eq. nv) mbrestsav=0
-          end if
-          if (durq .ne. ' ') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Illegal character after "rm"!')
-            call stop1()
-          end if
-        else if (durq .eq. '.') then
-c
-c  Dotted pattern.  Close out note.  Mult time by 3/4.
-c  Set time for next note to 1/4.  Start the note.
-c
-          idotform = 1
-        else if (durq .eq. ',') then
-          idotform = 3
-c
-c  Now flow to duration setting, as if durq=' '
-c
-        else if (index('oL',durq) .gt. 0) then
-c
-c  Suppress full bar rest, or look left for height
-c
-          if (charq .ne. 'r') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           '"o","L" options only legal for rest, not note!')
-            call stop1()
-          end if
-          go to 2
-        else if (index('DF',durq) .gt. 0) then
-c
-c  Double note for xtup.  Must check here in case "D" or "F" came before "x" or on
-c  last note of xtup.   Need to flag it in pmxa since affects horiz. spacing.
-c
-          nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
-          go to 2
-        else if (durq .eq. 'A') then
-c
-c  Main note accidental option
-c
-          call getchar(lineq,iccount,durq)
-          if (index('o+-<>',durq) .eq. 0) then 
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           '"o",+","-","<",">" are the only legal options here!')
-            call stop1()
-          end if
-c
-c  Need more stuff here
-c
-          if (durq .ne. "o") then
-c
-c  Back up 1, flow out, will get +|-|<|> next loop preceded by "A", and will
-c    proceed to number input checking
-c
-            iccount = iccount-1
-          end if
-          go to 2
-	  else if (durq .ne. ' ') then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Illegal character!')
-          print*,'ASCII code:',ichar(durq)
-          call stop1()
-        end if
-c
-c  End of block for note options.
-c
-c  Set the duration
-c
-        if (idotform .gt. 0) then
-          if (idotform .eq. 1) then
-            nodur(ivx,nnl(ivx)) = i1fnodur(nnodur,dotq)*3/2
-          else if (idotform .eq. 2) then
-            nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/3
-          else if (idotform .eq. 3) then
-            nodur(ivx,nnl(ivx)) = i1fnodur(nnodur,dotq)
-          else if (idotform .eq. 4) then
-            nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/2
-          end if
-        else if (ibarmbr.ne.nbars+1 .and. .not.fulbrp) then
-          nodur(ivx,nnl(ivx)) = i1fnodur(nnodur,dotq)
-c
-c  Check for double dot
-c
-          if (iddot .eq. 1) then
-            nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*7/6
-            iddot = 0
-          end if
-        else if (fulbrp) then
-          nodur(ivx,nnl(ivx)) = lenbar
-c
-c  Use a one-line function to set nnodur.  It gives inverse of ifnodur.
-c
-          nnodur = index('62514x0x37',
-     *                   chax(48+int(log(.1+lenbar)/.69315)))-1
-          fulbrp = .false.
-        end if
-        rest(ivx,nnl(ivx)) = charq.eq.'r'
-c
-c  If inside forced beam, check if note is beamable
-c
-        if (fbon) then
-          if (nodur(ivx,nnl(ivx)) .lt. 16) go to 120
-          if (nnl(ivx) .gt. 1) then
-            if (nodur(ivx,nnl(ivx)-1) .eq. 0) go to 120
-          end if
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Unbeamable thing in forced beam!')
-          call stop1()
-        end if
-120     continue
-c
-c Get number of prior bars for later check on whether note spans bar line
-c
-        nbb4 = itsofar(ivx)/lenbar
-        itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx))
-        if (mod(itsofar(ivx),lenbar) .eq. 0) then
-          nbars = nbars+1
-          if (shifton) barend = .true.
-c
-c  Will check barend when 1st note of next bar is entered.
-c
-          if (nbars .gt. 15) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'Cannot have more than 15 bars in an input block!')
-            call stop1()
-          end if
-          nib(ivx,nbars) = nnl(ivx)
-          if (firstline .and. lenbar.ne.lenbr1) then
-c
-c  Just finished the pickup bar for this voice.
-c
-            if (itsofar(ivx) .ne. lenbr0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               'Pickup bar length disagrees with mtrnum0!')
-              call stop1()
-            end if
-            lenbar = lenbr1
-            itsofar(ivx) = 0
-          end if
-        else if (barend) then
-          if (shifton) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'Bar ended with user-defined shift still on!')
-            call stop1()
-          end if
-          barend = .false.
-        else if (itsofar(ivx)/lenbar .gt. nbb4) then
-          call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *           'This note spans a bar line!')
-          call stop1()
-        end if
-        if (idotform.eq.1 .or. idotform.eq.3) then
-          call g1etchar(lineq,iccount,charq)
-          if (index('abcedfgr',charq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Expected note name or "r" here!')
-            call stop1()
-          end if
-          idotform = idotform+1
-          numnum = 1
-          go to 28
-        end if
-c
-c  End of sub block for note-rest
-c
-      else if (charq .eq. 'z') then
-        call g1etchar(lineq,iccount,charq)
-        if (index('abcdefg',charq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Expected chord note name here!')
-          call stop1()
-        end if
-25      call g1etchar(lineq,iccount,durq)
-c        if (index('dre12345678',durq) .gt. 0) then
-        if (index('dre12345678c',durq) .gt. 0) then
-          go to 25
-        else if (index('fsn',durq) .gt. 0) then
-c
-c Check for midi-only accid. CANNOT coesist with accidental position tweaks, so
-c   MUST come right after "f,s,n"
-c
-          if (lineq(iccount+1:iccount+1) .eq. 'i') iccount=iccount+1
-          go to 25
-        else if (durq .eq. 'A') then
-          if (index('fsn',lineq(iccount-1:iccount-1)) .eq. 0) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *        'Must have "f,s,n" before "A" in chord note!')
-            call stop1()
-          end if
-          go to 25
-        else if (index('<>',durq) .gt. 0) then
-          if (index('fsnA',lineq(iccount-1:iccount-1)) .eq. 0) then
-c          if (index('fsncA',lineq(iccount-1:iccount-1)) .eq. 0) then ! Causes problems
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *        'Must have "f,s,n,A" before "<" or ">"!')
-            call stop1()
-          end if
-          call g1etchar(lineq,iccount,durq)
-          if (index('1234567890.',durq) .eq. 0) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *        'Expected a number to start here for accidental shift!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          iccount = iccount-1
-          go to 25
-        else if (index('+-',durq) .gt. 0) then
-          if (index('1234567890.',lineq(iccount+1:iccount+1)) .eq. 0)
-     *         go to 25
-c
-c  Number or '.' (durq) follows +/- .   Get it.
-c
-          call g1etchar(lineq,iccount,durq)
-          if (durq .eq. '.' .and. index('1234567890',
-     *                  lineq(iccount+1:iccount+1)) .eq. 0) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *        '"." here must be followed by a digit!')
-            call stop1()
-          else if (index('sfndA',lineq(iccount-2:iccount-2)).eq.0) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *        'Number after +/- must follow "d,s,f,n,A"!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          if (index('+-',durq) .eq. 0) then
-            iccount = iccount-1
-            go to 25
-          end if
-c
-c  2nd +/-
-c
-          call g1etchar(lineq,iccount,durq)
-          if (durq .eq. '.') call g1etchar(lineq,iccount,durq)
-          if (index('1234567890',durq) .eq. 0) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *        'Expected a number here!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          iccount = iccount-1
-          go to 25
-        else if (durq .ne. ' ') then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Illegal character in chord note!')
-          call stop1()
-        end if
-      else if (charq .eq. 'G') then
-        ngr = 1
-9       call g1etchar(lineq,iccount,charq)
-        if (index('123456789',charq) .gt. 0) then
-          call readnum(lineq,iccount,durq,fnum)
-          ngr = nint(fnum)
-          iccount = iccount-1
-          go to 9
-        else if (index('AWulxs',charq) .gt. 0) then
-          go to 9
-        else if (charq .eq. 'm') then
-          call g1etchar(lineq,iccount,charq)
-          if (index('01234',charq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'A digit less than 5 must follow "m" in a grace note!')
-            call stop1()
-          end if
-          go to 9
-        else if (charq .eq. 'X') then
-c
-c Space before main note
-c
-          call g1etchar(lineq,iccount,charq)
-          if (index('0123456789.',charq) .gt. 0) then
-            call readnum(lineq,iccount,durq,fnum)
-            iccount = iccount-1
-            go to 9
-          else
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'A number must follow "X" in a grace note!')
-            call stop1()
-          end if
-        end if
-c
-c  At this point, charq is first note name in rest (grace?)
-c
-        do 19 igr = 1 , ngr
-          numnum = 0
-          if (igr .gt. 1) then
-55          call g1etchar(lineq,iccount,charq)
-            if (charq .eq. ' ') go to 55
-          end if
-          if (index('abcdefg',charq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'In grace, expected "a"-"g"!')
-            call stop1()
-          end if
-18        call g1etchar(lineq,iccount,charq)
-          if (charq .ne. ' ') then
-            if (index('1234567',charq) .gt. 0) then
-              if (numnum .eq. 1) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'Only one of "+-1234567" allowed here in grace!')
-                call stop1()
-              end if
-              numnum = 1
-              go to 18
-c            else if (index('nfs',charq) .gt. 0) then
-            else if (index('+-nfs',charq) .gt. 0) then
-              go to 18
-            end if
-c
-c  Digits are possible octave numbers
-c
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'Illegal character after note name in grace!')
-            call stop1()
-          end if
-19      continue
-      else if (charq .eq. chax(92)) then
-        call chklit(lineq,iccount,literr)
-        if (literr .gt. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               literq(literr))
-          call stop1()
-        end if
-      else if (charq .eq. '"') then
-c
-c  pmx lyric
-c
-        call chkpmxlyr(lineq,iccount,lyrerr)
-        if (lyrerr .gt. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         lyrerq(lyrerr))
-          call stop1()
-        end if
-      else if (charq .eq. 'o') then
-c
-c  Ornament on non-xtup note. "o" symbol must come AFTER the affected note
-c
-        if (nnl(ivx) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *     '"o" must be in same input block, after affected note!')
-          call stop1()
-        end if
-        call g1etchar(lineq,iccount,dumq)
-c        if (index('(stmgx+Tupf._)e:>^bc',dumq) .eq. 0 ) then
-        if (index('(stmgx+Tupf._)e:>^bcCG',dumq) .eq. 0 ) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Illegal ornament!')
-          call stop1()
-        end if
-        if (dumq .eq. ':') then
-          call g1etchar(lineq,iccount,dumq)
-          if (dumq .ne. ' ') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Expected blank after "o:"!')
-            call stop1()
-          else if (.not.ornrpt) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *            'Turned off repeated ornaments before they were on!')
-            call stop1()
-          end if
-          ornrpt = .false.
-        else if (dumq .eq. 'g') then
-          if (issegno) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Sorry, only one "segno" per input block!')
-            call stop1()
-          else if (ivx .ne. 1) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'segno can only be in voice 1!')
-            call stop1()
-          end if
-          issegno = .true.
-12        call g1etchar(lineq,iccount,dumq)
-          if (dumq.eq.'-' .or.
-     *        (ichar(dumq).ge.48.and.ichar(dumq).le.58)) go to 12
-          if (dumq .ne. ' ') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Illegal character in segno ornament symbol!')
-            call stop1()
-          end if
-        else if (dumq .eq. 'T') then
-c
-c  Trill.  may be followed by 't' and/or number.  read 'til blank
-c
-22        call g1etchar(lineq,iccount,dumq)
-          if (dumq .eq. ':') then
-            if (lineq(iccount+1:iccount+1) .ne. ' ') then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Expected blank after ":"!')
-              call stop1()
-            end if
-            go to 32
-          else if (dumq .ne. ' ') then
-            go to 22
-          end if
-        else if (dumq .eq. 'f') then
-          call g1etchar(lineq,iccount,dumq)
-          if (index(' d+-:',dumq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Illegal character after "f" in fermata ornament symbol!')
-            call stop1()
-          end if
-          if (dumq .eq. 'd') call g1etchar(lineq,iccount,dumq)
-          if (dumq .eq. ':') go to 32
-        else if (dumq .eq. 'e') then
-          call g1etchar(lineq,iccount,dumq)
-          if (index('sfn?',dumq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Illegal character after "e" in edit. accid. symbol!')
-            call stop1()
-          end if
-          call g1etchar(lineq,iccount,dumq)
-          if (dumq .eq. '?') call g1etchar(lineq,iccount,dumq)
-        else
-          call g1etchar(lineq,iccount,dumq)
-        end if
-        if (index('+- :',dumq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Illegal character in ornament symbol!')
-          call stop1()
-        end if
-        if (index('+-',dumq) .gt. 0) then
-          if (index('0123456789',lineq(iccount+1:iccount+1)).eq.0) then
-            call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
-     *       'There should be an integer here!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          if (durq .eq. ':') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Cannot shift AND repeat an ornament!')
-            call stop1()
-          end if
-c
-c  12/7/03 Allow horizontal shift on any ornament, not just breath and caes.
-c
-          if (index('+-',durq) .gt. 0) then
-            if (index('.0123456789',lineq(iccount+1:iccount+1)) 
-     *                                                   .eq. 0) then
-              call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
-     *           'There should be a number here!')
-              call stop1()
-            end if
-            call readnum(lineq,iccount,durq,fnum)
-          end if
-        end if
-32      continue
-        if (dumq .eq. ':') then
-          if (lineq(iccount+1:iccount+1) .ne. ' ') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      '":" must be followed by blank in "o: "!')
-            call stop1()
-          else if (ornrpt) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               'Turned on repeated ornaments but already on!')
-            call stop1()
-          end if
-          ornrpt = .true.
-        end if
-      else if (index('st(){}',charq) .gt. 0) then
-        numint = 0
-        iposn = 0
-8       call g1etchar(lineq,iccount,dumq)
-        iposn = iposn+1
-        if (charq.eq.'t' .and. dumq.eq.'t') then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Cannot use "t" as an option on a tie!')
-          call stop1()
-        end if
-        if (index('udltb+-fnhHpsv ',dumq) .eq. 0) then
-c
-c  Check for explicit ID code.
-c
-          ic = ichar(dumq)
-          if (ic.lt.48 .or. (ic.gt.57.and.ic.lt.65) .or.
-     *              ic.gt.90) then
-c
-c  Not 0-9 or A-Z, so exit
-c
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *                   'Illegal character in slur symbol!')
-            call stop1()
-          else
-c
-c  It is a possible ID code.  Right place?
-c
-            if (iposn .ne. 1) then
-c
-c  Slur ID is not 2nd!
-c
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'Slur ID must be second character in slur symbol!')
-              call stop1()
-            else if (charq.eq.'t' .and. fontslur) then 
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Slur ID not allowed on non-postscript tie!')
-              call stop1()                   
-            end if
-          end if
-c
-c  Slur ID is OK. Note it cannot be "H" at this point..
-c
-          go to 8
-        else if (dumq .eq. 'H') then
-          if (iposn .eq. 1) go to 8  
-c
-c  "H" is NOT an ID code.
-c
-          if (.not.fontslur .and. charq.eq.'t') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Cannot reshape postscript ties this way!')
-            call stop1()                   
-          end if        
-	    if (lineq(iccount+1:iccount+1) .eq. 'H') then
-            iccount=iccount+1
-            iposn = iposn+1
-          end if
-          go to 8
-        else if (index('fh',dumq).gt.0 .and. .not.fontslur 
-     *                                  .and. charq.eq.'t') then
-c
-c  3/9/03 Can't reshape postscript tie.
-c
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Cannot reshape postscript ties this way!')
-          call stop1()                   
-        else if (dumq .eq. 'p') then
-c
-c  local change in postscript slur/tie adjustment default
-c
-          if (fontslur) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Must use postscript slurs ("Ap") to use this option!')
-            call stop1()                   
-          end if
-          call g1etchar(lineq,iccount,dumq)
-          if (index('+-',dumq) .eq. 0) then                
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *              'Expected "+" or "-" here!')
-            call stop1()                   
-          end if
-          call g1etchar(lineq,iccount,dumq)
-          if (index('st',dumq) .eq. 0) then                
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *              'Expected "s" or "t" here!')
-            call stop1()                   
-          end if
-          iposn = iposn+2
-          go to 8
-        end if
-        if (index('udltbfnh',dumq) .gt. 0) then
-          go to 8
-        else if (index('+-',dumq) .gt. 0) then
-          numint = numint+1
-          if (fontslur .and. charq.eq.'t') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *     '"+|-" for slur height only allowed in "s"-slurs!')
-            call stop1()
-          end if
-          iccount = iccount+1
-          call readnum(lineq,iccount,durq,fnum)
-          if (numint .eq. 1) then
-            if (nint(fnum) .gt. 30) then
-              call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *       'Magnitude of slur height adjustment cannot exceed 30!')
-              call stop1()
-            end if
-          else if (numint .eq. 2) then
-            if (abs(fnum) .gt. 6.3) then
-              call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *       'Slur horiz shift must be in range (-6.3,6.3)!')
-              call stop1()
-            end if
-          else
-c
-c  Third signed integer, must be a midslur or curve spec.
-c
-            if (abs(fnum).gt.31) then
-              call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *                  'Slur midheight must be in the range (-31,31)!')
-              call stop1()
-            end if
-            if (durq .eq. ':') then
-c
-c  Expecting curve parameters.  Get two numbers
-c
-              do 41 i = 1 , 2
-                iccount = iccount+1
-                fnum = ichar(lineq(iccount:iccount))-48
-                if (abs(fnum-3.5) .gt. 3.6) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *                 'Slur curve parameter must be in range (0,7)!')
-                  call stop1()
-                end if
-41            continue
-              iccount = iccount+1
-            end if
-          end if
-          iccount = iccount-1
-          go to 8
-        else if (dumq .eq. 's') then
-c
-c What follows should be one or two signed numbers for adjustment of line break
-c slur, end of 1st segment or start of second.
-c
-          if (fontslur) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *    'May not use linebreak slur options with font-based slurs!')
-            call stop1()
-          end if
-          call g1etchar(lineq,iccount,dumq)
-          if (index('+-',dumq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'This character must be "+" or "-"!')
-            call stop1()
-          end if
-          iccount = iccount+1
-          call readnum(lineq,iccount,dumq,fnum)
-          if (nint(fnum) .gt. 30) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *     'Magnitude of slur height adjustment cannot exceed 30!')
-            call stop1()
-          end if
-          if (index('+-',dumq) .gt. 0) then
-            iccount = iccount+1
-            call readnum(lineq,iccount,dumq,fnum)
-            if (abs(fnum) .gt. 6.3) then
-              call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *         'Slur horiz shift must be in range (-6.3,6.3)!')
-              call stop1()
-            end if
-          end if
-          iccount = iccount-1
-          go to 8
-	  else if (dumq .eq. 'H' .and. iposn.gt.1) then
-          if (lineq(iccount+1:iccount+1) .eq. 'H') iccount=iccount+1
-          go to 8
-        end if
-      else if (charq .eq. '?') then
-        call getchar(lineq,iccount,durq)
-        if (durq .eq. ' ') then
-          iccount = iccount-1
-        else
-          if (durq .ne. '-') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Expecting "-"!')
-            call stop1()
-          end if
-          call getchar(lineq,iccount,durq)
-          if (index('0123456789.',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *                'Expecting number!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          iccount = iccount-1
-        end if
-      else if ((ichar(charq).ge.48.and.ichar(charq).le.57) .or.
-     *    index('#-nx_',charq) .gt. 0) then
-c
-c  We have a figure.  Must come AFTER the note it goes under
-c
-        if (itsofar(ivx).eq.0 .and.
-     *    (.not.firstline.or.lenbr0.eq.0.or.lenbar.eq.lenbr0)) then
-c
-c  Figure before first note in block
-c
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Cannot put figure before first note in block!')
-          call stop1()
-        end if
-        if (charq.eq.'x') then
-          indxb = index(lineq(iccount:128),' ')
-          if (indxb .lt. 5) then
-            call errmsg(lineq,iccount+indxb-1,ibarcnt-ibaroff+nbars+1,
-     *           'Cannot have a blank here in floating figure!')
-            call stop1()
-          end if
-        end if
-        if (usefig) ifig = 1
-5       call g1etchar(lineq,iccount,charq)
-        if (index(' 0123456789#-nx_.:+sv',charq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Illegal character in figure!')
-          call stop1()
-        else if (charq .eq. '+') then
-c
-c vertical offset, must be integer, then blank
-c               
-          call g1etchar(lineq,iccount,charq)
-          if (index('123456789',charq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Integer for vertical offset expected here!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,charq,fnum)
-          if (charq .ne. ' ') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Vertical offset must terminate figure!')
-            call stop1()
-          end if
-          iccount = iccount-1
-          go to 5                  
-        else if (charq .eq. 's') then
-          isligfont = .true.
-        end if
-        if (charq .ne. ' ') go to 5
-      else if (charq .eq. '[') then
-        if (fbon) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Started forced beam while another was open!')
-          call stop1()
-        end if
-        fbon = .true.
-17      call g1etchar(lineq,iccount,charq)
-        if (index('uljhf:',charq) .gt. 0) then
-          go to 17
-        else if (index('+-',charq) .gt. 0) then
-          iccount = iccount+1
-          call readnum(lineq,iccount,durq,fnum)
-          iccount = iccount-1
-          go to 17
-        else if (charq .eq. 'm') then
-c
-c  Forced multiplicity, next char should be 1-4
-c
-          call g1etchar(lineq,iccount,charq)
-          if (index('1234',charq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Forced multiplicity for a beam must be 1, 2, 3, or 4!')
-            call stop1()
-          end if
-          go to 17
-        else if (charq .ne. ' ') then
-          if (index('0123456789',charq) .gt. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'After "[", digits must now be preceeded by "+" or "-"!')
-        print*,'You will have to edit older sources to meet this rqmt,'
-        print*,'but it was needed to allow 2-digit height adjustments.'
-        print*,'Sorry for the inconvenience.  --The Management'
-          else
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Illegal character after [!')
-          end if
-        call stop1()
-        end if
-      else if (charq .eq. ']') then
-        if (.not.fbon) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Forced beam stop with no corresponding start!')
-          call stop1()
-        end if
-        call g1etchar(lineq,iccount,charq)
-	  if (charq .eq. '-') then
-          if (lineq(iccount+1:iccount+2) .ne. '[ ') then
-            call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
-     *        'Only sequence allowed here is "[ "!')
-            call stop1()
-          else 
-            iccount = iccount+2
-          end if            
-        else if (charq .eq. '[') then
-          if (lineq(iccount+1:iccount+1) .ne. ' ') then
-            call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
-     *           'This character must be a blank!')
-            call stop1()
-          end if
-        else
-c
-c  Forced beam is really ending
-c
-          fbon = .false.
-          if (charq .eq. 'j') then
-            if (lineq(iccount+1:iccount+1) .ne. ' ') then
-              call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
-     *           'This character must be a blank!')
-              call stop1()
-            end if
-          else if (charq .ne. ' ') then           
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         '"]" must be followed by blank, "j", "-", or "["!')
-            call stop1()
-          end if
-        end if
-      else if (charq .eq. 'D') then
-c
-c  Dynamic mark
-c
-        if (nnl(ivx) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      '"D" must not come before any notes have been entered!')
-          call stop1()
-        end if
-        call checkdyn(lineq,iccount,ibarcnt-ibaroff+nbars+1)
-      else if (index('lhw',charq) .gt. 0) then
-c
-c  Save position for later check
-c
-        icclhw = iccount
-        call g1etchar(lineq,iccount,durq)
-        if (index('0123456789.+- ',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Illegal character after "l", "w", or "h"!')
-          call stop1()
-        end if
-        isheadr = isheadr .or. charq .eq. 'h'
-        if (index(' +-',durq) .gt. 0) then
-c
-c  There is a header (or lower string?)
-c
-          if (index('+-',durq) .gt. 0) then
-c
-c  User-defined vert offset (\internote).
-c
-            if (charq .ne. 'h') then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *               '"+" or "-" not permitted here!')
-              call stop1()
-            end if
-c
-c  Have "h" followed by +/- .  Check for digit.
-c     Can blow durq since not using fnum for now, but...
-c
-            call g1etchar(lineq,iccount,durq)
-            if (index('123456789',durq) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'There must be a digit here!')
-              call stop1()
-            end if
-c
-c  Have "h" followed by +/- followed by a digit.  No need to get the number.
-c
-c           call readnum(lineq,iccount,durq,fnum)
-          end if
-          if (charq .ne. 'w') then
-c
-c  Header or lower string.
-c
-            if (icclhw .ne. 1) then
-              call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *               '"h" or "l" must be first character in line!')
-              call stop1()
-            end if
-c
-c  Read past the next line, which has the string.
-c
-            call read10(charq,lastchar)
-            nline = nline+1
-            iccount = 128
-          else
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Symbol "w" (width) must be followed by a digit!')
-            call stop1()
-          end if
-        else
-c
-c  Height or width change spec.  Check if at start of piece.
-c
-          if (ibarcnt .gt. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Symbol must go at top of first input block!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,dimen)
-c
-c  Check units.  Convert to points
-c
-          if (durq .eq. ' ' .or. durq .eq. 'p') then
-            dimen = dimen+.5
-          else if (durq .eq. 'i') then
-            dimen = dimen*72+.5
-          else if (durq .eq. 'm') then
-            dimen = dimen/25.4*72+.5
-          else
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Illegal unit; must be "p","i",or"m"!')
-            call stop1()
-          end if
-c
-c 151211 fix. May have extra character. 
-c
-          if (index('pim',durq) .gt. 0) then
-c
-c Get another character, see if it's blank
-c
-            if (lineq(iccount+1:iccount+1) .ne. ' ') then
-              call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
-     *          'This character should be a blank!')
-              call stop1()
-            end if       
-          end if
-          if (charq .eq. 'h') then
-            ptheight = int(dimen)
-          else
-            widthpt = int(dimen)
-          end if
-        end if
-      else if (charq .eq. 'm') then
-c
-c  Time signature change.  Only allow at beginning of block.
-c    mtrnuml, mtrdenl (logical) and p (printable) will be input.
-c    mtrnuml=0 initially. (In common)
-c
-c  Check whether at beginning of a block
-c
-        if (ivx.ne.1 .or. nnl(1).ne.0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *     'Meter change only OK in voice 1, at start of block!')
-          print*,'voice number is',ivx
-          call stop1()
-        end if
-        newmeter = .true.
-        call readmeter(lineq,iccount,mtrnuml,mtrdenl)
-        if (mtrnuml .eq. 0) then
-          call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *     'Digit 0 not allowed here!')
-          call stop1()
-c        else if (mtrdenl .eq. 1) then
-cc
-cc  Kluge!!!
-cc
-c          mtrdenl = 2
-c          mtrnuml = 2*mtrnuml
-        end if
-        call readmeter(lineq,iccount,mtrnmp,mtrdnp)
-c
-c  Read past printed time signature; not used in pmxa.
-c
-        lenbeat = i1fnodur(mtrdenl,'x')
-        lenmult = 1
-        if (mtrdenl .eq. 2) then
-          lenbeat = 16
-          lenmult = 2
-        end if
-        lenbar = lenmult*mtrnuml*lenbeat
-        mtrnuml = 0
-      else if (charq .eq. 'C') then
-        call g1etchar(lineq,iccount,durq)
-        if (.not.(index('tsmanrbf',durq).gt.0 .or.
-c     *      (ichar(durq).ge.48 .and. ichar(durq).le.54))) then
-c     *      (ichar(durq).ge.48 .and. ichar(durq).le.55))) then
-     *      (ichar(durq).ge.48 .and. ichar(durq).le.56))) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-c     *           'Must have t,s,m,a,n,r,b,f or 1-6 after C!')
-     *           'Must have t,s,m,a,n,r,b,f or 0-8 after C!')
-          call stop1()
-        end if
-c        gotclef = .true.
-      else if (charq .eq. 'R') then
-        if (ivx .ne. 1) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Repeats can only go in voice 1!')
-          call stop1()
-        end if
-10      call g1etchar(lineq,iccount,durq)
-        if (index('lrdDbz',durq) .gt. 0) go to 10
-        if (durq .ne. ' ') then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Illegal character after "R" (repeat/double bar)!')
-          call stop1()
-        end if
-      else if (charq .eq. 'V') then
-c
-c  Ending
-c
-        if (iv .ne. 1) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Voltas are only allowed in voice #1!')
-          call stop1()
-        else if (isvolt) then
-          print*
-          print*,'*******WARNING********'
-          write(15,'(/,a)')'*******WARNING********'
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'There is more than one volta in this input block.!')
-          print*,'This may work in a score, but WILL NOT work in parts.'
-          print*,
-     *'Safest to have only 1 volta per block, at the start of the block'
-          write(15,'(a)')
-     *           'This may work in a score, but WILL NOT work in parts.'
-          write(15,'(a)')
-     *'Safest to have only 1 volta per block, at the start of the block'
-        end if
-        isvolt = .true.
-        lvoltxt = 0
-11      call g1etchar(lineq,iccount,durq)
-        if (durq .ne.' ') then
-          go to 11
-        end if
-      else if (charq .eq. 'B') then
-        continue
-      else if (charq .eq. 'P') then
-        if (ivx.ne.1 .or. nnl(1).ne.0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Only allowed at beginning of block!')
-          call stop1()
-        end if
-16      call g1etchar(lineq,iccount,durq)
-        if (durq.eq.'l'.or.durq.eq.'r'.or.(ichar(durq).ge.48 .and.
-     *       ichar(durq).le.57)) go to 16
-        if (durq .eq. 'c') then
-c
-c  Expect a centered name, and it has to be last option
-c
-          call g1etchar(lineq,iccount,durq)
-          if (durq .eq. '"') then
-c
-c  Quoted name, go to next quote mark
-c
-            do 35 iccount = iccount+1 , 127
-              if (lineq(iccount:iccount) .eq. '"') go to 36
-35          continue
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Missing close quote after page number command (P)!')
-            call stop1()
-36          continue
-          else if (durq .ne. ' ') then
-c
-c  Space-delimited name, look for next blank
-c
-            do 37 iccount = iccount+1 , 127
-              if (lineq(iccount:iccount) .eq. ' ') go to 38
-37          continue
-38          continue
-          end if
-        else if (durq .ne. ' ') then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Only "l","r","c" or digit allowed after "P"!')
-          call stop1()
-        end if
-      else if (charq .eq. 'W') then
-        call g1etchar(lineq,iccount,durq)
-        if (index('.0123456789',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Expected a number to start here!')
-          call stop1()
-        end if
-        call readnum(lineq,iccount,durq,wminnh(ibarcnt+nbars+1))
-      else if (charq .eq. 'T') then
-c
-c  Titles
-c
-        call g1etchar(lineq,iccount,durq)
-        if (index('itc',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Must put "i", "t", or "c" after "T"!')
-          call stop1()
-        end if
-        ihead = ihead+2**(index('itc',durq)-1)
-c
-c  Maybe a number after 'Tt', but ignore here.  Read past string on next line.
-c
-        call read10(charq,lastchar)
-        nline = nline+1
-        iccount = 128
-      else if (charq .eq. 'A') then
-27      call g1etchar(lineq,iccount,durq)
-        if (index('rbsdeK',durq) .gt. 0) then
-          go to 27
-        else if (durq .eq. 'v') then
-          if (ibarcnt .eq. 0) novshrinktop = .true.
-          go to 27
-        else if (durq .eq. 'a') then
-          call g1etchar(lineq,iccount,durq)
-          if (index('0123456789.',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'After "Aa", need decimal number!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fbar)
-          iccount = iccount-1
-          go to 27
-        else if (durq .eq. 'i') then
-          call g1etchar(lineq,iccount,durq)
-c
-c  Local interstaff correction.  Set to -1. if not specifiec, or after use,
-c  or anytime except at top, since pmxb handles all times except at top.
-c
-          call readnum(lineq,iccount,durq,tintstf)
-          if (ibarcnt .eq. 0) fintstf = tintstf
-          iccount = iccount-1
-          go to 27
-        else if (durq .eq. 'I') then
-c
-c  Global interstaff correction.  Use in place of fintstf if fintstf<0
-c
-          call g1etchar(lineq,iccount,durq)
-          call readnum(lineq,iccount,durq,gintstf)
-          iccount = iccount-1
-          go to 27
-        else if (durq .eq. 'o') then
-          optimize = .true.
-          go to 27
-        else if (durq .eq. 'S') then
-c 130324
-c          do 50 iiv = 1 , nv
-          do 50 iiv = 1 , noinst
-            call g1etchar(lineq,iccount,durq)
-            if (index('-0st',durq) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'After "AS", need nv instances of "s,t,-,0"!')
-              call stop1()
-            end if
-            if (durq.eq.'-'.or.durq.eq.'s') then
-              isize(iiv) = 1
-            else if (durq.eq.'t') then
-              isize(iiv) = 2
-            end if
-50        continue
-          go to 27
-        else if (durq .eq. 'p') then
-          fontslur = .false.
-42        continue
-          call g1etchar(lineq,iccount,durq)
-          if (index('+-',durq) .gt. 0) then
-c
-c  Characters to change defaults for ps slurs
-c
-            call g1etchar(lineq,iccount,durq)
-            if (index('shtc',durq) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Only letters allowed here are "s","h","t","c"!')
-              call stop1()
-            end if
-c
-c  Now check for another default modifier
-c
-            go to 42
-          else if (index('lh',durq) .gt. 0) then
-c
-c  Flags for optional linebreak ties or header specials
-c
-            go to 42
-          else
-            iccount = iccount-1
-          end if
-          go to 27
-        else if (durq .eq. 'N') then
-c
-c  Override default name for a part file. Must have part number, then
-c    partname in quotes. Must be on line by itself, and start in column 1. 
-c    Will only be passed thru to scor2prt.
-c
-          if (iccount .ne. 2) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        '"AN" must start in column 1!')
-            call stop1()
-          end if
-          ndxquote = index(lineq,'"')
-          if (ndxquote.lt.4 .or. ndxquote.gt.5 .or. 
-     *        index('123456789',lineq(3:3)).eq.0 .or.
-     *        (ndxquote.eq.5.and.index('012',lineq(4:4)).eq.0)) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        '"AN" must be followed by inst. #, then quote!')
-            call stop1()
-          end if
-          ndxquote = index(lineq(ndxquote+1:128),'"')
-          if (ndxquote .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'In "AN", file name must be in quotes!')
-            call stop1()
-          end if
-          iccount = 128
-        else if (durq .eq. 'T') then
-          cstuplet = .true.
-        else if (durq .eq. 'R') then
-c
-c  Get full name of normal include file; must occupy remainder of line
-c
-          call getpmxmod(.false.,lineq(iccount+1:128))
-          iccount = 128
-        else if (durq .eq. 'c') then
-          call g1etchar(lineq,iccount,durq)
-          if (index('l4',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Only "l" or "4" is allowed here!')
-            call stop1()
-          end if
-          if (durq .eq. 'l' ) then
-            hoffpt = -25
-            voffpt = -45
-          else if (durq .eq. '4') then
-            ptheight = 745
-            widthpt = 499
-            hoffpt = -24
-            voffpt = -24
-          end if
-          go to 27
-        else if (durq .ne. ' ') then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-c     *       'After "A" must follow one of the letters abcdeiINprRsST!')
-     *     'After "A" must follow one of the letters abcdeiILNprRsST!')
-          print*,'For AS, since ver. 2.7, must only have noinst args.'
-          write(15,'(a)')
-     *           'For AS, since ver. 2.7, must only have noinst args.'
-          call stop1()
-        end if
-      else if (charq .eq. 'K') then
-c
-c  Rules and function of K command
-c
-c  Only 1 K +/-n +/-m  allowed per block if n.ne.0 (transposition).  isig1 is
-c  initial sig, and must be passed to pmxb because it is needed when topfile
-c  is called, which is before the K+n+m command is read in pmxb.  Also, we
-c  compute and save ibrkch and newkey for each syst, accounting for key changes,
-c  then adjust fbar to make poenom much more accurate.
-c  Jan 02: Now K-0+[n] is used to transpose e.g. from f to f#.
-c
-77      continue
-        call g1etchar(lineq,iccount,durq)
-c        if (index('+-i',durq) .eq. 0) then
-        if (index('+-in',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *   '"K" (transpose or key change) must be followed by "+,-,i,n"!')
-          call stop1()
-        end if
-        if (durq .eq. 'n') go to 77
-        if (durq .ne. 'i') then
-c
-c Normal key change and/or transposition)
-c
-c          iccount = iccount+1
-          num1 = 44-ichar(durq)
-c
-c  num1= +1 or -1
-c
-          ztrans = num1.eq.-1 
-          call g1etchar(lineq,iccount,durq)
-          if (index('0123456789',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      '1st +/- must be followed by a number!')
-            call stop1()
-          end if
-c          iccount = iccount+1
-          call readnum(lineq,iccount,durq,fnum)
-          num1 = nint(fnum)*num1
-          ztrans = ztrans .and. num1.eq.0
-          if (index('+-',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      '1st number after "K" must be followed by "+,-"!')
-            call stop1()
-          end if
-          iccount = iccount+1
-          num2 = 44-ichar(durq)
-          call readnum(lineq,iccount,durq,fnum)
-          num2 = num2*int(fnum+.1)
-          if (num1.eq.0 .and. .not.ztrans) then
-c
-c  Key change, only one per block allowed
-c
-            if (iskchb) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Only one key change allowed per input block!')
-              call stop1()
-            end if
-            iskchb = .true.
-            nkeys = nkeys+1
-            kchmid(nkeys) = mod(itsofar(ivx),lenbar).ne.0
-c
-c  Make ibrkch = barnum-1 if at start of bar, so fsyst advances ok at linebreak.
-c
-            ibrkch(nkeys) = ibarcnt+nbars
-            if (kchmid(nkeys)) ibrkch(nkeys) = ibrkch(nkeys)+1
-            newkey(nkeys) = num2+idsig
-c 130316
-c            do 43 iinst = 1 , noinst
-              midisig = newkey(nkeys)
-c43          continue
-          else
-c
-c  Transposition
-c
-            fulltrans = .true.
-            if (ibarcnt .gt. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'Transposition must be at top of first input block!')
-              call stop1()
-            end if
-            isig1 = num2
-            idsig = isig1-newkey(1)
-c
-c  idsig is the difference between sig after transposition, and sig in setup.
-c  It may alter # of accid's in key changes if there is transposition.
-c
-          end if
-        else   ! durq='i'
-c
-c  110522/110529
-c  Instrument-wise transposition Ki[iInstTrans][+/-][iTransAmt][+/-][iTransKey]
-c    and repeat i[...] for multiple instruments. Store info here if ibarcnt=0
-c    so can pass to topfile (via comInstTrans), which is called before getnote. 
-c    Otherwise, will store info from getnote. Initialize EarlyTransOn and
-c    LaterInstTrans to .false. in blockdata. Set EarlyTransOn from here; 
-c    LaterInstTrans from g1etnote. Zero both out after use. nInstTrans really
-c    only needed for instrument-signatures, not transpositions. iTransAmt is
-c    ALWAYS active per instrument. Set up instno(iv) so can fetch iTransAmt for
-c    each staff.
-c
-c          if (fulltrans) then
-c            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-c     *       'Cannot yet combine full and instrument transposition!')
-c            call stop1()
-c          end if
-          call GetiTransInfo(.true.,ibarcnt,lineq,iccount,
-     *                         ibaroff,nbars,noinst)
-        end if
-      else if (charq .eq. '|') then
-c
-c  Optional bar symbol
-c
-        if (mod(itsofar(ivx),lenbar).ne.0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Bar line marker out of place!')
-          call stop1()
-        else if (shifton) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Bar ended with user-defined shift still on!')
-          call stop1()
-        end if
-      else if (charq .eq. '/') then
-        if (ornrpt) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'WARNING: Block ended with repeated ornament still on!')
-          ornrpt = .false.
-        end if
-        if (stickyS) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'WARNING: Block ended with sticky stemshrink still on!')
-          stickyS = .false.
-        end if
-        if (fbon) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Block ended with forced beam open!')
-          call stop1()
-        else if (shifton) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Bar ended with user-defined shift still on!')
-          call stop1()
-c
-c 140215 Temporary to allow clef change in stup
-c
-c        else if (gotclef) then
-c          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-c     *      'May not enter clef at end of input block!')
-c          call stop1()
-        end if
-        barend = .false.
-c
-c  Perform time checks
-c
-        if (mod(itsofar(ivx),lenbar).ne.0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Block duration not divisible by lenbar!')
-          print*,'lenbar is ',lenbar
-          call stop1()
-        else if (ivx.gt.1 .and. itsofar(ivx).ne.itsofar(1)) then
-          print*
-          print*,'# of bars in voice 1, current voice:',
-     *        itsofar(1)/lenbar,itsofar(ivx)/lenbar
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Block duration not equal to voice 1!')
-          call stop1()
-        end if
-        call g1etchar(lineq,iccount,durq)
-        if (durq .eq. ' ' .and. iv.eq.nv) then
-c
-c  End of input block
-c
-          loop = .false.
-        else
-c
-c  Start a new voice
-c
-          if (lenbr0.ne.0 .and. firstline) lenbar = lenbr0
-          nbars = 0
-          if (durq .eq. ' ') then
-c
-c  New voice is on next staff
-c
-            iv = iv+1
-            ivx = iv
-          else
-c
-c  New voice is on same staff.  Set up for it
-c
-            ivx = nv+1
-            do 23 iiv = 1 , nv
-              if (nvmx(iiv) .eq. 2) ivx = ivx+1
-23          continue
-            if (ivx .gt. nm) then
-              write(*,'(1x,a21,i3,a23)')'Cannot have more than',nm,
-     *          ' lines of music at once'
-              call stop1()
-            end if
-            nvmx(iv) = 2
-            ivmx(iv,2) = ivx
-            itsofar(ivx) = 0
-            nnl(ivx) = 0
-            do 24 j = 1 , 200
-              rest(ivx,j) = .false.
-              nacc(ivx,j) = 0
-24          continue
-c
-c  For midi stuff, record that there is a 2nd line of music in this voice
-c
-            if (ismidi) twoline(iv) = .true.
-          end if
-        end if
-        iccount = 128
-      else if (charq .eq. 'S') then
-c
-c  New nsyst: for use with partmaker scor2prt, for parts w/ diff # of systs.
-c
-        if (ibarcnt .gt. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           '"S" can only be in first input block!')
-          call stop1()
-        end if
-        call g1etchar(lineq,iccount,durq)
-        if (index('123456789 ',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'A digit must follow "S"!')
-          call stop1()
-        end if
-        call readnum(lineq,iccount,durq,fnsyst)
-        nsyst = nint(fnsyst)
-14      continue
-        if (durq .eq. 'P') then
-c
-c  New npages for parts.  
-c
-          call g1etchar(lineq,iccount,durq)
-          if (index('123456789 ',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Must have a number here!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnsyst)
-          npages = nint(fnsyst)
-          go to 14
-        else if (durq .eq. 'm') then
-c
-c  Reset musize (musicsize).
-c
-          call g1etchar(lineq,iccount,durq)
-          if (index('123456789 ',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *             'Must have a number here!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnsyst)
-          musize = nint(fnsyst)
-          wheadpt = whead20*musize
-          go to 14
-        else if (durq .ne. ' ') then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Illegal character in "S" symbol!')
-          call stop1()
-        end if
-      else if (charq .eq. 'L') then
-        nflb = nflb+1
-        ibarflb(nflb) = ibarcnt+nbars+1
-        call g1etchar(lineq,iccount,durq)
-        if (index('123456789',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Need integer to define forced line break!')
-          call stop1()
-        end if
-        call readnum(lineq,iccount,durq,sysflb)
-        isysflb(nflb) = nint(sysflb)
-        if (nflb .gt. 1) then
-c
-c  Check if new number is > prior one
-c
-          if (isysflb(nflb) .le. isysflb(nflb-1)) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *       'You already forced a line break at a later line!')
-            call stop1()
-          end if
-        end if
-        if (npages .eq. 0) then
-          print*
-          print*,'WARNING! You forced a line break at line ',
-     *      isysflb(nflb),' but npage = 0.  Continue?'
-          read(*,'(a)') charq
-          if (index('yY',charq) .eq. 0) call stop1()
-        else if (isysflb(nflb) .gt. nsyst) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *           'Forced line break at line num > nsyst!')
-          call stop1()
-        else if (index(' PM',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Must have " ", "P", or "M" here!')
-          call stop1()
-        end if
-        if (durq .eq. 'P') then
-c
-c  Forced page break here, get page number.
-c
-          call g1etchar(lineq,iccount,durq)
-          if (index('123456789',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Need integer to define forced page break!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          nfpb = nfpb+1
-          ipagfpb(nfpb) = nint(fnum)
-          isysfpb(nfpb) = isysflb(nflb)
-          if (ipagfpb(nfpb) .gt. npages) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *           'Forced page break at page num > npages!')
-            call stop1()
-          else if (nfpb .gt. 1) then
-            if (ipagfpb(nfpb) .le. (ipagfpb(nfpb-1))) then
-              call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *           'Forced page break numbers must increase!')
-              call stop1()
-            end if
-          end if
-        end if
-        if (index(' M',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Illegal character in linebreak symbol!')
-          call stop1()
-        else if (durq .eq. 'M') then
-          nmovbrk = nmovbrk+1
-          isysmb(nmovbrk) = isysflb(nflb)
-          call g1etchar(lineq,iccount,durq)
-31        if (durq .eq. '+') then
-c
-c  Vertical spacing, read past number.
-c
-            call g1etchar(lineq,iccount,durq)
-            if (index('123456789',durq) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Integer required here!')
-              call stop1()
-            end if
-            call readnum(lineq,iccount,durq,fnum)
-            go to 31
-          else if (durq .eq. 'i') then
-c
-c  Change indentation,
-c
-            call g1etchar(lineq,iccount,durq)
-            if (index('.123456789',durq) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Decimal number required here!')
-              call stop1()
-            end if
-c
-c  fracsys was initialized in block data to all 0.'s
-c
-            call readnum(lineq,iccount,durq,fracsys(nmovbrk))
-            go to 31
-          else if (durq .eq. 'c') then
-            call g1etchar(lineq,iccount,durq)
-            go to 31
-          else if (durq .eq. 'r') then
-            call g1etchar(lineq,iccount,durq)
-            if (index('+-',durq) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Must have "+" or "-" after "r" as movement break option!')
-              call stop1()
-            end if
-            call g1etchar(lineq,iccount,durq)
-            go to 31
-          else if (durq .eq. 'n') then
-c
-c  Change # of voices.  Input ninow, iorig(1...ninow).  Will use names,
-c  staves per inst. and clefs  corr. to iorig in original list of instruments.
-c
-            nv = 0
-            call g1etchar(lineq,iccount,durq)
-            if (durq .eq. ':') then
-c
-c  Signals a 2-digit number, get next two characters
-c
-              call g1etchar(lineq,iccount,durq)
-              call g1etchar(lineq,iccount,dumq)
-              if (index('12',durq).eq.0
-     *                   .or.index('0123456789',dumq).eq.0) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'Illegal new number of instruments '//durq//dumq//
-     *               ' at movement break!')
-                call stop1()
-              end if
-              read(lineq(iccount-1:iccount),'(i2)')ninow
-            else
-c
-c  durq is a single digit number for noinow
-c
-              if (index('123456789',durq) .eq. 0) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'Illegal new number of instruments '//durq//
-     *                                  ' at movement break!')
-                call stop1()
-              end if
-              ninow = ichar(durq)-48
-            end if
-            if (ninow.gt.noinst) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'New number of instruments must be <= original!')
-              call stop1()
-            end if
-            do 63 iinow = 1 , ninow
-              call g1etchar(lineq,iccount,durq)
-              if (durq .eq. ':') then
-c
-c  Signals a 2-digit number
-c
-                call g1etchar(lineq,iccount,durq)
-                call g1etchar(lineq,iccount,dumq)
-                if (index('12',durq).eq.0
-     *                   .or.index('0123456789',dumq).eq.0) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *              'Illegal 2-digit instrument number '//durq//dumq//
-     *               ' at movement break!')
-                  call stop1()
-                end if
-                read(lineq(iccount-1:iccount),'(i2)')iorig
-              else
-c
-c  durq is a single digit number for iorig
-c
-                if (index('123456789',durq) .eq. 0) then
-                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *              'Illegal instrument number '//durq//
-     *                                  ' at movement break!')
-                  call stop1()
-                end if
-                iorig = ichar(durq)-48
-              end if
-              if (iorig .gt. noinst) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *            'New instrument number must be <= original noinst!')
-                call stop1()
-              end if
-              nv = nv+nsperi(iorig)
-63          continue
-            do 61 iiv = 1 , nv
-c
-c  Get clef names
-c
-              call g1etchar(lineq,iccount,durq)
-              if (.not.(index('tsmanrbf',durq).gt.0 .or.
-     *             (ichar(durq).ge.48 .and. ichar(durq).le.55))) then
-                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Must have t,s,m,a,n,r,b,f or 1-7 as clef symbol here!')
-                call stop1()
-              end if
-c
-c  Initialize new voices
-c
-              nvmx(iiv) = 1
-              ivmx(iiv,1) = iiv
-              itsofar(iiv) = 0
-              nnl(iiv) = 0
-              do 62 j = 1 , 200
-                rest(iiv,j) = .false.
-62            continue
-61          continue
-c
-c  Loop back up, this might not be last option in M
-c
-            call g1etchar(lineq,iccount,durq)
-            go to 31
-          else if (durq .ne. ' ') then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Illegal character after Movement break symbol!')
-            call stop1()
-          end if
-          if (fracsys(nmovbrk) .lt. 0.001) then
-c
-c  Since fracsys was not explicitly set, set it to prior value.
-c
-            if (nmovbrk .eq. 1) then
-              fracsys(nmovbrk) = fracindent
-            else
-              fracsys(nmovbrk) = fracsys(nmovbrk-1)
-            end if
-          end if
-        end if
-c
-c  Just before exiting if-block for forced line breaks, set counter to use when 
-c  dealing with vertical space calcs
-c
-        nistaff(nflb) = nv-1
-      else if (charq .eq. 'F') then
-        usefig = .false.
-      else if (charq .eq. 'X') then
-        call g1etx(lineq,iccount,shifton,ibarcnt-ibaroff+nbars+1,
-     *             udsp(ibarcnt+nbars+1),wheadpt)
-      else if (charq .eq. 'I') then
-c
-c  MIDI settings.  
-c
-        if (ivx.ne.1 .or. nnl(1).ne.0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *     'MIDI stuff only allowed at start of block!')
-          call stop1()
-        end if
-        if (nv .gt. 15) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *     'Sorry but MIDI does not work with more than 15 voices!')
-          call stop1()
-        end if
-        ismidi = .true.
-c        call getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar,
-        call getmidi(noinst,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar,
-     *               mtrdenl,.true.)
-      else if (charq .eq. 'M') then
-        call setmac(lineq,iccount,ibarcnt,ibaroff,nbars,charq,durq,ivx,
-     *                 nline)
-      else if (index(',.',charq) .gt. 0) then
-c
-c  Continued rhythmic shortcut
-c
-        idotform = index('. ,',charq)
-        if (idotform .eq. 1) then
-c
-c  Change duration of prior note 
-c
-          itsofar(ivx) = itsofar(ivx)-nodur(ivx,nnl(ivx))
-          nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*3/2 
-          itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx))
-        end if
-        idotform = idotform+1
-        numnum = 1
-        cdot = .true.
-        go to 1
-      else
-        print*,'ASCII code:',ichar(charq)
-        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'This character is not allowed here!')
-        print*,'ASCII code:',ichar(charq)
-        call stop1()
-      end if
-      return
-      end
-      subroutine g1etset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp,
-     *    xmtrnum0,newkey,npages,nsyst,musize,bottreb)
-      parameter(nm=24,maxblks=4000)
-      character*65536 bufq
-      character*1 chax
-      integer*2 lbuf(maxblks)
-      common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
-      character*128 lineq
-      logical lastchar,issegno,isheadr,isvolt,fbon,bottreb,
-     *        newway
-      common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
-     *     fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
-      common /commidisig/ midisig
-c
-c  Get the first line
-c
-      iccount = 0
-      nline = 1
-9     call getbuf(lineq)
-      if (lineq(1:1) .eq. '%') then
-        nline = nline+1
-        go to 9
-      end if
-      if (lineq(1:3) .eq. '---') then
-c
-c  Have TeX input until next line that starts with '---'
-c
-3       nline = nline+1
-        call getbuf(lineq)
-        if (ilbuf .gt. nlbuf) go to 1
-        go to 2
-1       print*,'You did not terminate type 0 TeX input with "---"'
-        call stop1()
-2       continue
-        if (lineq(1:3) .ne. '---') go to 3
-c
-c  Force a new line read on first call to readin
-c
-        iccount = 128
-      end if
-c
-c  Here, lineq and nline are first non-TeX lines.
-c
-      nv = nint(readin(lineq,iccount,nline))
-      if (nv .gt. nm) then
-        write(*,'(1x,a46,i3)')
-     *     'In setup data, number of voices cannot exceed',nm
-        call stop1()
-      end if
-      noinst = nint(readin(lineq,iccount,nline))
-      if (noinst .gt. nv) then
-        write(*,'(a)')
-     *    'In setup data, cannot have more instruments than staves'
-        call stop1()
-      end if
-      newway = noinst.le.0
-      if (newway) noinst = -noinst
-      do 10 iinst = 1 , noinst
-c
-c  Seve # of staves per inst in case later drop some inst's.
-c
-        if (newway) then
-          nsperi(iinst) = nint(readin(lineq,iccount,nline))
-        else if (iinst .gt. 1 ) then
-          nsperi(iinst) = 1
-        else
-          nsperi(iinst) = nv-noinst+1
-        end if
-10    continue
-      mtrnuml = nint(readin(lineq,iccount,nline))
-      mtrdenl = nint(readin(lineq,iccount,nline))
-cc
-cc  Kluge!!!
-cc
-c      if (mtrdenl .eq. 1) then
-c        mtrdenl = 2
-c        mtrnuml = mtrnuml*2
-c      end if
-      mtrnmp = nint(readin(lineq,iccount,nline))
-      mtrdnp = nint(readin(lineq,iccount,nline))
-      if (mtrnmp.eq.0 .and. mtrdnp .ge. 8) then
-        write(*,'(a)')'In setup data, with mtrnmp=0, mtrdnp must be <8'
-        call stop1()
-      end if
-      xmtrnum0 = readin(lineq,iccount,nline)
-      newkey = nint(readin(lineq,iccount,nline))
-c 130316
-c      do 11 iinst = 1 , noinst
-        midisig = newkey 
-c11    continue
-      npages = nint(readin(lineq,iccount,nline))
-      nsyst = nint(readin(lineq,iccount,nline))
-      musize = nint(readin(lineq,iccount,nline))
-      fracindent = readin(lineq,iccount,nline)
-      if (fracindent .ge. 1.) then
-        write(*,'(a)')'In setup data, fracindent must be <1'
-        call stop1()
-      end if
-      if (npages .gt. nsyst) then
-        print*,'Error in input file: npages > nsyst'
-        call stop1()
-      else if((musize-16)*(musize-20)*(musize-24)*(musize-29).ne.0) then
-        call printl('Musicsize must be 16, 20, 24, or 29')
-        call stop1() 
-      end if
-c
-c  Next noinst non-comment lines are names of instruments.
-c
-      do 4 i = 1 , abs(noinst)
-5       call getbuf(lineq)
-        nline = nline+1
-        if (lineq(1:1) .eq. '%') go to 5
-4     continue
-c
-c  Mext non-comment line has nv clef names
-c
-6     call getbuf(lineq)
-      nline = nline+1
-      if (lineq(1:1) .eq. '%') go to 6
-      do 7 iv = 1 , nv
-c        if (index('brnamstf01234567',lineq(iv:iv)) .eq. 0) then
-        if (index('brnamstf012345678',lineq(iv:iv)) .eq. 0) then
-          call errmsg(lineq,iv,0,
-     *       'There should be a clef symbol here!')
-          call stop1()
-        end if
-7     continue
-      if (lineq(nv+1:nv+1) .ne. ' ') then
-        call errmsg(lineq,nv+1,0,
-     *    'There should be a blank here!')
-        call stop1()
-      end if
-c
-c Set flag if voice 1 is treble, since it affects vertical spacing
-c
-c      bottreb = lineq(1:1).eq.'t'
-      bottreb = index('t08',lineq(1:1)).gt.0
-c
-c  Next non-comment line has path name
-c
-8     call getbuf(lineq)
-      nline = nline+1
-      if (lineq(1:1) .eq. '%') go to 8
-      lpath = index(lineq,' ')-1
-      if (index('/:'//chax(92),lineq(lpath:lpath)) .eq. 0) then
-        call errmsg(lineq,lpath,0,
-     *       'Last character of pathname is not "/",":", or "'
-     *                                        //chax(92)//'"!')
-        call stop1()
-      end if
-      return
-      end
-      subroutine g1etx(lineq,iccount,shifton,ibar,udsp,wheadpt)
-c
-c  Parse "X" commands.  Ignore all "B"; "P" means to ignore whole symbol.
-c  In scor2prt, must strip out "P", copy only "B" and "P"-type "X"-symbols.
-c
-      logical shifton,number,btest
-      character*128 lineq
-      character*1 charq,dumq
-      number = .false.
-      nPBSc = 0
-1     call g1etchar(lineq,iccount,charq)
-      if (index('PBS:',charq) .gt. 0) then
-c
-c  Continue checking here even if "P".
-c
-        ipbsc = index('PBS:',charq)
-        if (btest(nPBSc,ipbsc)) then
-          call errmsg(lineq,iccount,ibar,'Only one allowed per symbol!')
-          call stop1()
-        end if
-        nPBSc = ibset(nPBSc,ipbsc)
-        go to 1
-      else if (index('+-.0123456789',charq) .gt. 0) then
-        number = .true.
-        if (index('+-',charq) .gt. 0) then
-          call g1etchar(lineq,iccount,dumq)
-          if (index('.0123456789',dumq) .eq. 0) then
-            call errmsg(lineq,iccount,ibar,'Expected a number here!')
-            call stop1()
-          end if
-        end if
-        call readnum(lineq,iccount,dumq,fnum)
-        if (charq.eq.'-') fnum = -fnum
-        if (dumq .ne. 'p') then
-          iccount = iccount-1
-          fnum = fnum*wheadpt
-        end if
-        go to 1
-      else if (charq .ne. ' ') then
-        call errmsg(lineq,iccount,ibar,'Not allowed in "X" symbol!')
-        call stop1()
-      end if
-c
-c  Done with parsing.  Other checks
-c
-      if (iand(6,nPBSc).eq.6 .or. iand(24,nPBSc).eq.24) then
-        call errmsg(lineq,iccount-1,ibar,
-     *     'Cannot have both "P" and "B" or "S" and ":"!')
-        call stop1()
-      end if
-      if (btest(nPBSc,4)) then
-        if (number) then
-          if (shifton) then
-            call errmsg(lineq,iccount-1,ibar,
-     *            'Started a group shift without stopping prior one!')
-            call stop1()
-          else
-            shifton = .true.
-          end if
-        else
-          if (.not. shifton) then
-            call errmsg(lineq,iccount-1,ibar,
-     *            'Ended a group shift without starting one!')
-            call stop1()
-          else
-            shifton = .false.
-          end if
-        end if
-      end if
-c
-c  P off, S off, c off => normal user-defined space.  Add to udsp (later fsyst)
-c
-      if (iand(nPBSc,26).eq.0) udsp = udsp+fnum
-      if (.not.number .and. .not.btest(nPBSc,4)) then
-        call errmsg(lineq,iccount-1,ibar,
-     *      'Must have either a number or a colon in "X" symbol!')
-        call stop1()
-      end if
-      return
-      end
-c      integer*4 function mytime()
-c      CHARACTER(10) tq
-c      CALL DATE_AND_TIME(TIME=tq)
-c      read(tq,'(2i2,f6.3)')ih,im,ts
-c      mytime = 1000*(ts+60*(im+60*ih))
-c      return
-c      end  
-      subroutine getbuf(lineq)
-      parameter (maxblks=4000)
-      character*(*) lineq
-      character*65536 bufq
-      integer*2 lbuf(maxblks)
-      common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
-      lineq = bufq(ipbuf+1:ipbuf+lbuf(ilbuf))
-      ipbuf = ipbuf+lbuf(ilbuf)
-      ilbuf = ilbuf+1
-      return
-      end
-      subroutine getchar(lineq,iccount,charq)
-      parameter (nm=24)
-c
-c  Gets the next character out of lineq*128.  If pointer iccount=128 on entry,
-c  then reads in a new line.  Resets iccount.  Ends program if no more input.
-c
-      common /comget/ lastchar,rptnd1,sluron(nm,2),fbon,ornrpt,stickyS,
-     *       movbrk,movnmp,movdnp,movgap,parmov,fintstf,gintstf,
-     *       rptprev,equalize,rptfq1,rptfq2
-      logical lastchar,rptnd1,sluron,fbon,rptprev,ornrpt
-      common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
-      logical mrecord,mplay,endmac,equalize,stickyS
-      character*1 charq,rptfq1,rptfq2
-      character*128 lineq,lnholdq
-      if (iccount .eq. 128) then
-        call read10(lineq,lastchar)
-        if (lastchar) return
-        if (.not. endmac) then
-          iccount = 0
-        else
-          endmac = .false.
-          iccount = icchold
-          lineq = lnholdq
-        end if
-        if (mrecord) then
-          call mrec1(lineq,iccount,ndxm)
-        end if
-      end if
-      iccount = iccount+1
-      charq = lineq(iccount:iccount)
-      return
-      end
-      subroutine getdyn(ivx,ip,irest,iornq,lineq,iccount)
-      parameter (nm=24)
-      common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12),
-     *        hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41),
-     *        idynda2(99),levhssav(nm),listcresc,listdecresc
-      character*128 txtdynq
-      common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
-     *                 ,WrotePsslurDefaults,SlurCurve
-      logical fontslur,upslur,WrotePsslurDefaults
-      character*1 durq,chax
-      character*4 dynsymq
-      character*128 lineq
-c
-c  Get info for dynamic mark.  Enter after getting "D", iccount sits on "D"
-c  Bits in idyndat are as follows
-c    00-03 ivx
-c    04-11 ip
-c    12-15 code for type of mark
-c      0 => arbitrary text
-c      1-12 => pppp,ppp,pp,p,mp,mf,f,fp,sfz,ff,fff,ffff
-c      If (.not. fontslur)
-c        13 => hairpin start, 14,15 => <,> (ending)
-c      else 
-c         13 < start, 14 > start, 15 ending
-c      end if
-c    16    flag for vertical offset
-c    17-23 vertical offset + 64 , \internote
-c    31    Hairpin start (0), stop (1)
-c
-c  idynda2
-c
-c    00    flag for horizontal offset
-c    01-09 (horizontal offset)/10 + 25.6 notehead widths
-c    10  5th bit for ivx (5/15/10)
-c
-      irest = ibset(irest,26)
-      ndyn = ndyn+1
-      idyn = ivx
-      idynda2(ndyn) = 0
-      if (ivx .ge. 16) call setbits(idynda2(ndyn),1,10,1)
-      call setbits(idyn,8,4,ip)
-      if (lineq(iccount+1:iccount+1) .eq. '"') then
-c
-c  text-dynamic
-c
-        ntxtdyn = ntxtdyn+1
-        iend = iccount+index(lineq(iccount+2:128),'"')+2
-        txtdynq(ntxtdyn) = lineq(iccount+2:iend-2)
-c
-cc  Store ivx, ip in bits 0-11
-c  Store ivx, ip in bits 0-12
-c
-c        ivxiptxt(ntxtdyn) = idyn
-        ivxiptxt(ntxtdyn) = ivx+32*ip
-        ipm = index('- +',lineq(iend:iend))
-        idno = 0
-      else
-c
-c  Word-group or hairpin
-c
-        do 1 iend = iccount+2 , 128
-          ipm = index('- +',lineq(iend:iend))
-c
-c  Exit the loop at first blank, "+", or "-" 
-c
-          if (ipm .gt. 0) go to 2
-1       continue
-2       continue
-        read(lineq(iccount+1:iend-1),'(a'//chax(47+iend-iccount)//')')
-     *     dynsymq
-        idno = (index(
-     *   'ppppppp pp  p   mp  mf  f   fp  sfz ff  fff ffff    <   >   ',
-     *           dynsymq)+3)/4
-c
-c  Save for later down
-c
-        idno1 = idno
-      end if
-c
-c  Set flag to check level later if in beam
-c
-      iornq = ibset(iornq,23) 
-      if (idno.ge.14) then
-c
-c  Hairpin here.  Check if opposite type from one that's already on 
-c
-        if (idno.eq.14.and.btest(listdecresc,ivx) .or. 
-     *      idno.eq.15.and.btest(listcresc,ivx)) then
-	    call printl(' ')
-          call printl('Started one kind of hairpin while other is on')
-          call stop1()
-        end if         
-c
-c  Start or stop?
-c
-        if (btest(listcresc,ivx) .or. btest(listdecresc,ivx)) then
-c
-c  Cresc/decresc is on, this is an ending. If fontslur, leave idno as is.
-c
-          if (.not.fontslur) idno = 15
-        else if (fontslur) then
-c
-c  Start of font slur  
-c
-          idno = 13
-        else
-c
-c  Start of postscript slur
-c
-          idno = idno-1
-        end if
-      end if
-c
-c  Now that we used list[de]cresc, update 
-c
-      if (idno .ge.13) then
-        if (idno.eq.15 .or. (fontslur.and.idno.eq.14)) then
-c
-c  Something's ending
-c
-          if (btest(listcresc,ivx)) then
-c
-c  It's a cresc!
-c
-            listcresc = ibclr(listcresc,ivx)
-          else
-            listdecresc = ibclr(listdecresc,ivx)
-          end if
-        else 
-c
-c  Something's starting
-c
-          if (idno1 .eq. 14) then
-c
-c  It's a cresc!
-c
-            listcresc = ibset(listcresc,ivx)
-          else
-            listdecresc = ibset(listdecresc,ivx)
-          end if
-        end if
-      end if
-      call setbits(idyn,4,12,idno)
-      iccount = iend
-      if (ipm .ne. 2) then
-c
-c  There is a vertical shift
-c
-        idyn = ibset(idyn,16)
-        iccount = iccount+1
-        call readnum(lineq,iccount,durq,fnum)
-        idno = nint(fnum)
-        call setbits(idyn,7,17,(ipm-2)*idno+64)
-        ipm = index('- +',durq)
-        if (ipm .ne. 2) then
-c
-c  There is a horizontal shift
-c
-c          idynda2(ndyn) = ibset(idyn,23)
-          idynda2(ndyn) = ibset(idynda2(ndyn),0)
-          iccount = iccount+1
-          call readnum(lineq,iccount,durq,fnum)
-          idno = nint(10*fnum)
-          call setbits(idynda2(ndyn),9,1,(ipm-2)*idno+256)
-        end if
-c
-c  iccount should be on the blank at the end of the entire symbol
-c
-      end if
-      idyndat(ndyn) = idyn
-      return
-      end
-      subroutine getfig(itoff,charq,lineq,iccount,isfig,itfig,
-c     *   itsofar,nodur,figq,ivupfig,nfigs)
-     *   itsofar,nodur,figq,ivupfig,ivvfig,nfigs)
-      logical isfig
-      character*1 charq
-      character*10 figq
-      character*128 lineq
-      nfigs = nfigs+1
-      ivupfig = 0
-      ivvfig = 0
-      itoff = 0
-      if (charq .eq. 'x') then
-c
-c  Floating figure.
-c
-        call getchar(lineq,iccount,charq)
-        read(charq,'(i1)')noff
-        call getchar(lineq,iccount,charq)
-        read(charq,'(i1)')loff
-        itoff = noff*ifnodur(loff,'x')
-        call getchar(lineq,iccount,charq)
-      else
-c
-c  Figure on a note
-c
-        isfig = .true.
-      end if
-      itfig = itsofar+itoff-nodur
-      lfig = 1
-      figq = charq
-5     call getchar(lineq,iccount,charq)
-c      if (index(' +',charq) .eq. 0) then
-      if (index(' +v',charq) .eq. 0) then
-        figq = figq(1:lfig)//charq
-        lfig = lfig+1
-        go to 5
-      else if (charq .eq. '+') then
-c
-c  Get vertical offset for figure. Next character after number has to be blank.
-c
-        iccount = iccount+1
-        call readnum(lineq,iccount,charq,fnum)
-        ivupfig = nint(fnum)
-      else if (charq .eq. 'v') then
-c
-c  Get vertical change in figdrop. Must be last item in figure word.
-c
-        isign = 1
-        call getchar(lineq,iccount,charq)
-        if (charq .eq. '-') then
-          isign=-1
-          call getchar(lineq,iccount,charq)
-        end if
-        ivvfig = isign*(ichar(charq)-48)
-      end if
-      return
-      end
-      subroutine getgrace(ivx,nnl,lineq,iccount,islur,iornq,ipl,ndlev,
-     *                    lastlev,iv,nv)
-      parameter (nm=24)
-      common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
-     *                nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
-     *                noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
-     *                graspace(37),
-     *                lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
-     *                naccg(74),voltxtq(6),litq(83)
-      logical upg,slurg,slashg
-      character*1 charq,durq
-      character*20 voltxtq
-      character*128 lineq,litq
-      integer*4 islur(nm,200),iornq(nm,0:200),ipl(nm,200),nnl(nm),
-     *          ndlev(nm,2)
-      common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
-     *  instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
-      logical EarlyTransOn,LaterInstTrans
-c
-c Grace, comes *before* main note:
-c UNLESS there's an 'A' or 'W' after the 'G'
-c   ngrace = # of grace note groups so far in block
-c   ivg(ngrace), ipg(ngrace)
-c   nng(ngrace) = # of notes in this group: default = 1
-c   ngstrt(ngrace) = starting position in nolevg of levels for this grace
-c   multg(ngrace) = multiplicity: default = 1;  input as 'm(digit)'
-c   upg(ngrace) = logical for beam or stem dirn: default T, input'u,l'
-c   slurg(ngrace) = logical for slur; default F, input 's'
-c   slashg(ngrace) = T if slash; default is F, input 'x'
-c These data MUST precede note name of first note
-c   nolevg, naccg: lists of levels and accid's, indexed as described above.
-c
-      ngrace = ngrace+1
-      ivg(ngrace) = ivx
-      ipg(ngrace) = nnl(ivx)+1
-      if (ngrace .eq. 1) then
-        ngstrt(ngrace) = 1
-      else
-        ngstrt(ngrace) = ngstrt(ngrace-1)+nng(ngrace-1)
-      end if
-      islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),4)
-      nng(ngrace) = 1
-      multg(ngrace) = 1
-      upg(ngrace) = .true.
-      slurg(ngrace) = .false.
-      slashg(ngrace) = .false.
-18    call getchar(lineq,iccount,charq)
-      if (index('WA',charq) .gt. 0) then
-c
-c  Grace is on note that was already done, so shift flags forward one note.
-c  This puts flag on actual note with grace; later for W will go ahead one more.
-c
-        ipg(ngrace) = nnl(ivx)
-        islur(ivx,nnl(ivx)+1) = ibclr(islur(ivx,nnl(ivx)+1),4)
-        islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),4)
-        if (slurg(ngrace))
-     *      iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),24)
-        if (charq .eq. 'A') then
-c
-c  close After, clear way-after bit, to ensure priority of most recent A/W
-c
-          ipl(ivx,nnl(ivx)) = ibset(ibclr(ipl(ivx,nnl(ivx)),31),29)
-        else
-c
-c  Way after; later assign to following note, and position like normal grace.
-c
-          ipl(ivx,nnl(ivx)) = ibset(ibclr(ipl(ivx,nnl(ivx)),29),31)
-        end if
-      else if (charq .eq. 'm') then
-        call getchar(lineq,iccount,charq)
-        multg(ngrace) = ichar(charq)-48
-      else if (index('123456789',charq) .gt. 0) then
-        call readnum(lineq,iccount,durq,fnum)
-        iccount = iccount-1
-        nng(ngrace) = nint(fnum)
-      else if (charq .eq. 'l') then
-        upg(ngrace) = .false.
-      else if (charq .eq. 's') then
-        slurg(ngrace) = .true.
-        if (nnl(ivx) .gt. 0) then
-c
-c  If A- or W-grace, set signal to start slur on main note.
-c
-          if(btest(ipl(ivx,nnl(ivx)),31) .or.
-     *               btest(ipl(ivx,nnl(ivx)),29))
-     *       iornq(ivx,nnl(ivx))=ibset(iornq(ivx,nnl(ivx)),24)
-        end if
-      else if (charq .eq. 'x') then
-        slashg(ngrace) = .true.
-      else if (charq .eq. 'u') then
-      else if (charq .eq. 'X') then
-c
-c Space before main note of grace. Number will come next.
-c
-        iccount = iccount+1
-        call readnum(lineq,iccount,durq,graspace(ngrace))
-        iccount = iccount-1
-      end if
-      if (index('abcdefg',charq) .eq. 0) go to 18
-c
-c  At this point, charq is first note name in grace
-c
-      do 19 ing = ngstrt(ngrace), ngstrt(ngrace)+nng(ngrace)-1
-        naccg(ing) = 0
-        ioct = 0
-        if (ing .gt. ngstrt(ngrace)) then
-55        call getchar(lineq,iccount,charq)
-          if (charq .eq. ' ') go to 55
-        endif
-        iclastlev = 0
-9       call getchar(lineq,iccount,durq)
-        if (durq .ne. ' ') then
-          if (durq.eq.'+') then
-            lastlev = lastlev+7
-            iclastlev = iclastlev+7
-          else if (durq.eq.'-') then
-            lastlev = lastlev-7
-            iclastlev = iclastlev-7
-          else if (index('fsn',durq) .gt. 0) then
-            if (naccg(ing) .eq. 0) then
-              naccg(ing) = index('fsn',durq)
-            else
-c
-c  Double accidental
-c
-              naccg(ing) = ibset(naccg(ing),2)
-            end if
-          else
-            ioct = ichar(durq)-48
-          end if
-          go to 9
-        end if
-        if (ioct .gt. 0) then
-          lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv)))
-        else
-          if (nnl(ivx).eq.0 .and. ing.eq.ngstrt(ngrace)) then
-            if (ivx .le. nv) then
-              kv = 1
-            else
-              kv = 2
-            end if
-            lastlev = ndlev(iv,kv)+iclastlev
-          end if
-          lastlev = lastlev-3
-     *        +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7)
-        end if
-        nolevg(ing) = lastlev
-19    continue
-c
-c  Grace could come before first note of block, so reset end level.
-c
-      if (nnl(ivx).eq.0) then
-        if (ivx .le. nv) then
-          kv = 1
-        else
-          kv = 2
-        end if
-        ndlev(iv,kv) = lastlev
-      end if
-      return
-      end
-      subroutine GetiTransInfo(From1,ibarcnt,lineq,iccount,
-     *                         ibaroff,nbars,noinst)
-cccccccccccccccccccccccc
-cc
-cc GetiTransInfo.for
-cc
-cccccccccccccccccccccccc
-c
-c  Called from both g1etnote and getnote, after first 'i' in Ki[...]
-c  On entry, iccount points to last char retrieved, which is 'i'
-c  
-c  From1: locgical, true if called from g1etnote
-c  ibarcnt: tells whether to set EarlyTransOn to true. 
-c  EarlyTransOn set false in blkdata, true here, back to false in topfile.  
-c
-c  110522/110529
-c  Instrument-wise transposition Ki[iInstTrans][+/-][iTransAmt][+/-][iTransKey]
-c    and repeat i[...] for multiple instruments. Store info in g1etnot if ibarcnt=0
-c    so can pass to topfile (via comInstTrans), which is called before getnote. 
-c    Otherwise, will store info from getnote. Initialize EarlyTransOn and
-c    LaterInstTrans to .false. in blockdata. Set EarlyTransOn from g1etnote; 
-c    LaterInstTrans from getnote. Zero both out after use. nInstTrans really
-c    only needed for instrument-signatures, not transpositions. iTransAmt is
-c    ALWAYS active per instrument. Set up instno(iv) so can fetch iTransAmt for
-c    each staff.
-c
-c  iTransAmt stored as fn of instrument #, not like iTransKey which is 
-c    fn. of nm, just a counter, where corr. inst num is iInstTrans(nm). This
-c    simplifies use of iTransAmt for all calls to ifnolev. 
-c
-      parameter (nm=24)
-      logical From1
-      common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
-     *  instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
-      logical EarlyTransOn,LaterInstTrans,store
-      character*128 lineq
-      character*1 durq 
-      durq = 'x'  ! Can't initialize in declaration stmt, only works once.
-      if(.not.EarlyTransOn) EarlyTransOn = From1 .and. ibarcnt.eq.0
-      store = (EarlyTransOn.and.ibarcnt.eq.0) .or. 
-     *            (ibarcnt.gt.0.and..not.From1)
-      LaterInstTrans = .not.From1 .and. ibarcnt.gt.0
-      if (store) nInstTrans = 0
-1     continue
-      if (durq .eq. ' ') return
-      call g1etchar(lineq,iccount,durq)
-      if (index('123456789',durq) .eq. 0) then
-        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'There must be an instrument number here!')
-        call stop1()
-      end if
-      if (store) nInstTrans = nInstTrans+1
-      call readnum(lineq,iccount,durq,fnum)
-      instn = nint(fnum)
-      if (instn.gt.noinst) then
-        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Instrument number out of range!')
-        call stop1()
-      end if
-      if (store) iInstTrans(nInstTrans) = instn
-c
-c  durq is +/- following inst # (for iTransAmt), iccount is on it.
-c
-      if (index('+-',durq) .eq. 0) then
-        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      '1st character after instrument number must be "+,-"!')
-        call stop1()
-      end if
-      itramt = 44-ichar(durq) ! +1/-1 for itramt
-      call g1etchar(lineq,iccount,durq)
-      if (index('0123456789',durq) .eq. 0) then
-        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'There must be a transposition amount here!')
-        call stop1()
-      end if
-      call readnum(lineq,iccount,durq,fnum)
-      if (store) iTransAmt(instn) = nint(fnum)*itramt
-c
-c  durq is +/- following iTransAmt (for iTransKey), iccount is on it.
-c
-      if (index('+-',durq) .eq. 0) then
-        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      '1st character after transposition amount must be "+,-"!')
-        call stop1()
-      end if
-      ikey = 44-ichar(durq)  ! +1/-1
-      call g1etchar(lineq,iccount,durq)
-      if (index('0123456789',durq) .eq. 0) then
-        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'There must be a key indicator here!')
-        call stop1()
-      end if
-      call readnum(lineq,iccount,durq,fnum)
-      if (store) iTransKey(nInstTrans) = nint(fnum)*ikey
-c
-c  durq is now 1st character after iTransKey, should be either 'i' or ' '
-c
-      if (durq.ne.'i'.and.durq.ne.' ') then
-        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'There must be blank or "i" here!')
-        call stop1()
-      end if
-      go to 1
-      end
-      subroutine getmidi(noinst,lineq,iccount,ibarcnt,ibaroff,nbars,
-     *                   lenbar,
-c      subroutine getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar,
-     *                    mtrdenl,first)
-c
-c  Use this from both pmxa and pmxb to input and check midi data. "first" tells
-c  whether pmxa or pmxb.  If .not.first, then tempo and pause commands cause
-c  things to be written immediately into the midi storage buffers.
-c
-      parameter (nm=24,mv=24576)
-      common /comevent/ miditime,lasttime
-      logical mmacrec,gottempo
-      common /commmac/ mmacstrt(0:nm,20),mmacend(0:nm,20),immac,
-     *       mmactime(20),nmidsec,msecstrt(0:nm,60),msecend(0:nm,60),
-     *       mmacrec,gottempo
-c
-c  immac(i) is the index of i-th macro, i=1,nmac.  Also make a list containing
-c   nmidsec  section starts and stops based on PLAYING macros (not recording).
-c 
-      integer*2 mmidi,midinum(26)
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
-     *       iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
-     *       nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
-     *       laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
-     *       restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
-     *       debugmidi
-      logical debugmidi
-      common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
-     *                ,miditran(nm),midtc(0:nm),noinstdum,iinsiv(nm)
-      integer*2 iinsiv
-      character*1 durq
-      character*2 instq
-      character*128 lineq
-      logical first
-      common /comdiag/ n69(0:nm),n34(0:nm)
-c
-c      Instrument codes
-c
-      data midinum   
-     *    / 1, 5, 7, 13,20,25,33,41,42,43,44,57,58,59,61,65,66,67,
-c         XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbXtuXfrXsoXalXteX
-c
-     *      68,69,71,72,74,75, 8,55 /
-c           bsXobXbaXclXflXreXctXvo
-c
-1     call getchar(lineq,iccount,durq)
-      if (durq .eq. 't') then
-c
-c  Tempo in beats ber minute
-c
-        call getchar(lineq,iccount,durq)
-        if (index('0123456789',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Expected an integer here for the pause!')
-          call stop1()
-c        else if (mmacrec) then
-c          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-c     *      'Cannot change MIDI tempo while recording a MidiMacro!')
-c          call stop1()
-        end if
-        call readnum(lineq,iccount,durq,qpm)
-        iccount = iccount-1
-        if (.not.first) then
-          call midievent('t',nint(qpm),0)
-          gottempo = .true.
-        end if
-        go to 1
-      else if (durq .eq. 'p') then
-c
-c  Insert a pause.  pausemid = pause in 1/4's
-c
-        call getchar(lineq,iccount,durq)
-        if (index('0123456789.',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Expected a number here for the pause!')
-          call stop1()
-        end if
-        call readnum(lineq,iccount,durq,pausemid)
-        iccount = iccount-1
-        if (.not.first) then
-c
-c  Compute a meter for the pause.  This is only to keep MidiNotate on track.
-c  Round pause to nearest 16th.  Let denominator always be 16.
-c
-          numb16 = nint(pausemid*4)
-          call midievent('m',numb16,16)
-c
-c  Put in pausemid beats of rest 
-c
-          do 3 icm = 0 , numchan-1
-            call addmidi(icm,0,0,0,4.*numb16,.true.,.false.)
-3         continue
-          miditime = miditime+nint(240*pausemid)
-c
-c  Restore meter
-c
-          call midievent('m',mtrdenl*lenbar/64,mtrdenl)
-        end if
-        go to 1
-      else if (durq .eq. 'i') then
-c
-cc  Instrument numbers or letters.  Expect nv of them.
-c  Instrument numbers or letters.  Expect noinst of them.
-c
-c        do 2 ivx = 1 , nv
-        do 2 ivx = 1 , noinst
-          call getchar(lineq,iccount,durq)
-          if (ichar(durq) .gt. 96) then
-c
-c  It's a lowercase letter.  Get another, find corr. instrument #.
-c
-            instq(1:1) = durq
-            call getchar(lineq,iccount,durq)
-            instq = instq(1:1)//durq
-            iname = index('XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbX'//
-     *                'tuXfrXsoXalXteXbsXobXbaXclXflXreXctXvo',instq)/3
-            if (iname .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Unrecognized 2-letter midi instrument name!')
-              call stop1()
-            end if
-            midinst(ivx) = midinum(iname)-1
-          else
-c
-c  Expect a number, followed by ":" if that is followed by another number.
-c  I.e., if after call to readnum, durq is not ":", it must be either blank
-c  or next instrument letter.
-c
-            if (index('123456789',durq) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *                 'Expected a midi instrument number here!')
-              call stop1()
-            end if
-            call readnum(lineq,iccount,durq,fnum)
-            midinst(ivx) = nint(fnum)-1
-            if (midinst(ivx).lt.0 .or. midinst(ivx).gt.255) then
-              call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *           'Midi instrument number must be in range 1-128!')
-              call stop1()
-            end if
-            if (durq .ne. ':') iccount = iccount-1
-          end if
-2       continue
-        go to 1
-      else if (durq .eq. 'v') then 
-c
-c Get volumes for each instrument.  Expect nv of them.  
-c    Follow same pattern as for insttrument numbers above.
-c 	
-c        do 7 ivx = 1 , nv
-        do 7 ivx = 1 , noinst
-          call getchar(lineq,iccount,durq)
-          if (index('123456789',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'Expected a midi velocity number here!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          midivel(ivx) = nint(fnum)-1
-          if (midivel(ivx).lt.0 .or. midivel(ivx).gt.127) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *           'Midi velocity must be in range 1-128!')
-            call stop1()
-          end if
-          if (durq .ne. ':') iccount = iccount-1
-7       continue
-        go to 1
-      else if (durq .eq. 'b') then 
-c
-c Get balance for each instrument.  Expect nv of them.  
-c    Follow same pattern as for instrument numbers above.
-c 	
-c        do 8 ivx = 1 , nv
-        do 8 ivx = 1 , noinst
-          call getchar(lineq,iccount,durq)
-          if (index('123456789',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'Expected a balance number here!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          midibal(ivx) = nint(fnum)-1
-          if (midibal(ivx).lt.0 .or. midibal(ivx).gt.127) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *           'Midi balance must be in range 1-128!')
-            call stop1()
-          end if
-          if (durq .ne. ':') iccount = iccount-1
-8       continue
-        go to 1
-      else if (durq .eq. 'T') then 
-c
-c Get transposition for each instrument.  Expect nv of them.  
-c    Follow similar pattern as above, but separator is +|-.
-c 	
-c        do 9 ivx = 1 , nv
-        do 9 ivx = 1 , noinst
-          call getchar(lineq,iccount,durq)
-          ipm = index('-+',durq)
-          if (ipm .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'Expected "+" or "-" for midi transposition here!')
-            call stop1()
-          end if
-          ipm = 2*ipm-3
-          call getchar(lineq,iccount,durq)
-          if (index('0123456789',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *         'Expected a number here!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          miditran(ivx) = ipm*nint(fnum)
-c          if (mod(miditran(ivx),12).ne. 0) then
-c            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-c     *         'Midi transposition limited to multiples of 12!')
-c            call stop1()
-c          end if
-          iccount = iccount-1
-9       continue
-        go to 1
-      else if (durq .eq. 'g') then
-        call getchar(lineq,iccount,durq)
-        if (index('0123456789',durq) .eq. 0) then
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'Expected an integer here for the midi gap!')
-          call stop1()
-        end if
-        call readnum(lineq,iccount,durq,fnum)
-        mgap = nint(fnum)
-        iccount = iccount-1
-        go to 1
-      else if (durq .eq. 'M') then
-c
-c  MidiMacros
-c
-        call getchar(lineq,iccount,durq)
-        if (durq .eq. 'R') then
-c
-c  Start recording
-c
-          if (mmacrec) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'You tried to record a MidiMacro while already recording!')
-            call stop1()
-          end if
-          mmacrec = .true.
-          call getchar(lineq,iccount,durq)
-          if (index('123456789',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Expected MidiMacro ID number here!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          iccount = iccount-1
-          if (.not.first) then
-            immac = nint(fnum)
-            if (immac .gt. 20) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'MidiMacro ID cannot exceed 20!')
-              call stop1()
-            end if
-c
-c  Save the start time
-c
-            mmactime(immac) = miditime
-            do 4 icm = 0 , numchan
-              if (icm .lt. numchan) then
-                if (restpend(icm)) then
-c
-c  Adjust if there's a rest at end of prior section.  Insert dummy turnoff.
-c    (This causes two turn-offs in a row, which testmidi sees as an error).
-c
-c  Before:    section1  ------rest-------  section2(to be recorded)
-c  After:     section1  rest1  now  rest2  section2(recorded)
-c
-                  call addmidi(icm,30,0,0,trest(icm),.false.,.true.)
-                  trest(icm) = 0
-                  restpend(icm) = .false.
-                end if
-              else
-                if (miditime .gt. lasttime) then
-c
-c  Insert a dummy turnoff in conductor track
-c
-                  call addmidi(icm,30,0,0,(miditime-lasttime)/15.,
-     *                         .false.,.true.)
-                  lasttime = miditime
-                end if
-              end if
-              mmacstrt(icm,immac) = imidi(icm)+1
-4           continue
-          end if
-          go to 1
-        else if (index('123456789P',durq) .eq. 0) then
-c
-c  End recording; close the open macro.  Get immac from common.
-c
-          if (.not.mmacrec) then
-            call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-     *       'You tried to end a MidiMacro before starting one!')
-            call stop1()
-          end if
-          mmacrec = .false.
-          iccount = iccount-1
-          if (.not.first) then
-c
-c  Save the macro duration
-c
-            mmactime(immac) = miditime-mmactime(immac)
-            do 5 icm = 0 , numchan
-              if (icm .lt. numchan) then
-                if (restpend(icm)) then
-                  call addmidi(icm,30,0,0,trest(icm),.false.,.true.)
-                  trest(icm) = 0
-                  restpend(icm) = .false.
-                end if
-              else
-                if (miditime .gt. lasttime) then
-c
-c  Insert a dummy turnoff in conductor track if needed.
-c
-                  call addmidi(icm,30,0,0,(miditime-lasttime)/15.,
-     *                         .false.,.true.)
-                  lasttime = miditime
-                end if
-              end if
-              mmacend(icm,immac) = imidi(icm)
-5           continue
-          end if
-          if (durq .ne. ' ')go to 1
-        else if (durq .eq. 'P') then
-c
-c  Play Back a Macro
-c
-          call getchar(lineq,iccount,durq)
-          if (index('123456789',durq) .eq. 0) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *        'Expected MidiMacro ID number here!')
-            call stop1()
-          end if
-          if (mmacrec) then
-            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *       'You tried to play a MidiMacro before ending recording!')
-            call stop1()
-          end if
-          call readnum(lineq,iccount,durq,fnum)
-          iccount = iccount-1
-          if (.not.first) then
-            immac = nint(fnum)
-            if (mmactime(immac) .eq. 0) then
-              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *          'Cannot play a MIDI macro before recording it!')
-              call stop1()
-            end if
-            do 6 icm = 0 , numchan
-              if (icm .lt. numchan) then
-                if (restpend(icm)) then
-                  call addmidi(icm,30,0,0,trest(icm),.false.,.true.)
-                  trest(icm) = 0.
-                  restpend(icm) = .false.
-                end if
-              else
-                if (miditime .gt. lasttime) then
-c
-c  Insert a dummy turnoff in conductor track
-c
-                  call addmidi(icm,30,0,0,(miditime-lasttime)/15.,
-     *                         .false.,.true.)
-                end if
-              end if
-              msecend(icm,nmidsec) = imidi(icm)
-              msecstrt(icm,nmidsec+1) = mmacstrt(icm,immac)
-              msecend(icm,nmidsec+1) = mmacend(icm,immac)
-              msecstrt(icm,nmidsec+2) = imidi(icm)+1
-6           continue
-            nmidsec = nmidsec+2
-c
-c  Update running time
-c
-            miditime = miditime+mmactime(immac) 
-            lasttime = miditime
-          end if
-          go to 1 
-        else
-          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Illegal character in MidiMacro sub-command!')
-          call stop1()
-        end if
-      else if (durq .eq. 'd') then
-        debugmidi = .true.
-        go to 1
-      else if (durq .ne. ' ') then
-        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-     *      'Illegal character in MIDI input data!')
-        write(*,'(a)')
-     *    'May be too many args to i,v,b, or T. As of Ver. 2.7, '//
-     *    'should be noinst, not nv'   
-        write(15,'(a)')
-     *    'May be too many args to i,v,b, or T. As of Ver. 2.7, '//
-     *    'should be noinst, not nv'   
-        call stop1()
-      end if
-      if (.not.gottempo .and. .not.first) then
-c
-c  If no tempo is set on first call on the pmxb pass, then set it
-c
-        call midievent('t',96,0)
-        gottempo = .true.
-      end if
-      return
-      end
-      subroutine getnote(loop)
-      parameter (nm=24,mv=24576)
-      common /comlast/ islast,usevshrink
-      logical islast,usevshrink,ignorenats
-      common /comignorenats/ ignorenats
-      common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
-     *   ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
-     *   ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
-     *   nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
-     *   nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
-     *   stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
-     *   ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
-     *   iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
-     *   isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
-      character*10 figq
-      character*1 ulq,sepsymq,sq,rptfq1,rptfq2,clefq,chax
-      logical beamon,firstgulp,figbass,figchk,isfig
-      character*60 cheadq
-      character*120 instrq,titleq,compoq
-      integer*2 mmidi
-      logical restpend,relacc,notmain,twoline,ismidi,crdacc,autofbon
-      common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,

@@ Diff output truncated at 1234567 characters. @@


More information about the tex-live-commits mailing list