cccccccccccccccccccccccccccccccccccccccccccccccc
cc                                            cc
cc pmxa.for 5/9/98                            cc
cc                                            cc
cc A production of Dr. Don's PC and           cc
cc Harpsichord Emporium (dsimons@logicon.com) cc
cc                                            cc
cc This is noware: No fee, no guarantee.      cc
cc                                            cc
cccccccccccccccccccccccccccccccccccccccccccccccc
cc
cc  Need to consider X spaces in xtuplets when getting poenom, and 
cc      maybe fbar?
cc
cc  Known changes since pmxa. Version 1.1b (see pmxb for longer list)
cc
cc  Check ID codes for slurs.
cc  Redefine iemin to include ALL notes groups as bitmap.
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=7,nkb=500,nks=125,nbz=200)
      logical loop,usefig
      integer nn(nm),list(4,nbz),ipl(nm,nbz),nodur(nm,nbz),
     *        nnl(nm),itsofar(nm),nib(nm,15),lastbar(0:nks),nbarss(nks)
      common /comnotes/ nnodur,wminnh(nkb),nnpd(2000),durb(2000),
     *     nptr(nkb),ibarcnt,ieminb(nkb),iemaxb(nkb),mbrest,ibarmbr,
     *     ibaroff,udsp(nkb),wheadpt
      common /compage/ widthpt,ptheight,nsyst,nflb,ibarflb(0:40),
     *      isysflb(0:40),npages,nfpb,ipagfpb(0:10),isysfpb(0:10),
     *      usefig,fintstf,gintstf
      common /comkeys/ nkeys,ibrkch(14),newkey(14),iskchb,idsig,isig1,
     *       kchmid(14),ornrpt,shifton,barend
      real*4 elsk(nkb),celsk(0:nkb),elss(nks)
      character*128 lnholdq
      character*24 basenameq
      logical rest(nm,nbz),firstline,fbon,isvolt,iskchb,kchmid,ornrpt
      common /comget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
     *     inchord
      logical lastchar,newmeter,newmb(nkb),issegno,bottreb,isheadr,
     *     inchord,shifton,barend
      common /all/ iv,list,nnl,nv,ibar,ipl,mtrnuml,
     *   nodur,jn,lenbar,iccount,nbars,itsofar,nib,nn,
     *   rest,lenbr0,lenbr1,firstline,newmeter
      common /linecom/ elskb
      common /cblock/ 
     *      etatop,etabot,etait,etatc,etacs1,hgtin,hgtti,hgtco,
     *      xilbn,xilbtc,xilhdr,xilfig,a,b,inbothd,inhnoh  
      common /commvl/ nvmx(nm),ivmx(nm,2),ivx,fbar
      common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
      logical mrecord,mplay,endmac
      jprntb = 81
      macuse = 0
      ornrpt = .false.
      mrecord = .false.
      mplay = .false.
      lastchar = .false.
      do 42 ibarcnt = 1 , nkb
        udsp(ibarcnt) = 0.
        wminnh(ibarcnt) = -1.
42    continue
      print*,'Please type a basename (<9 characters, no dots): '
      read(*,'(a)')basenameq  
      idot = index(basenameq,'.')
      if (idot .ne. 0) then
        basenameq = basenameq(1:idot-1)
      end if
      lbase = index(basenameq,' ')-1
      data wtimesig,wclef,wkeysig, a20,whead20 , abig20
     *   / 0.72  , 0.8 ,  0.28, 0.3 , 0.3 ,     0.38  /
      open(10,file=basenameq(1:lbase)//'.pmx')
      call getset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp,
     *    xmtrnum0,newkey(1),npages,nsyst,musicsize,fracindent,bottreb)
c
c  isig1 will be changed in getnote if there is a transposition
c
      isig1 = newkey(1)
      if (npages .gt. nsyst) then
        print*,'npages > nsyst in input.  Please fix the input.'
        stop 1
      end if 
c
c  fbar = afterruleskip/elemskip
c  apt = width of small accidental + space in points (= 6 at 20pt)
c  abigpt = width of big accidental + space in points (= 7.6 at 20pt)
c
      fbar = 1.
      apt = a20*musicsize
      abigpt = abig20*musicsize
      wheadpt = whead20*musicsize
      ifig = 0
      usefig = .true.
      lenbeat = ifnodur(mtrdenl,'x')
      lenmult = 1
      if (mtrdenl .eq. 2) then
        lenbeat = 16
        lenmult = 2
      end if
      lenbr1 = lenmult*mtrnuml*lenbeat
      lenbr0 = lenmult*xmtrnum0*lenbeat+.1
      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
      nflb = 0
      nfpb = 0
      ipagfpb(0) = 1
      isysfpb(0) = 1
      ibarflb(0) = 1
      isysflb(0) = 1
c
c  Initialize for loop over lines
c
      nkeys = 1
      ibrkch(1) = 1
      shifton = .false.
      firstline = .true.
      newmeter = .false.
      inchord = .false.
      ihead = 0 
      isheadr = .false.
      idsig = 0
      fintstf = -1.
      gintstf = 1.0
30    loop = .true.
      iskchb = .false.
      issegno = .false.
      nbars = 0
      ibarmbr = 0
3     do 4 iv = 1 , nv
        nvmx(iv) = 1
        ivmx(iv,1) = iv
        itsofar(iv) = 0
        nnl(iv) = 0
        do 5 j = 1 , nbz
          rest(iv,j) = .false.
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 getnote(loop,ifig) 
        if (lastchar) go to 20
        go to 2
      end if
      do 10 ibar = 1 , nbars
        ibarcnt = ibarcnt+1
        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
c         print*,'Now processing bar #',ibarcnt-ibaroff
          call outbar(ibarcnt-ibaroff,jprntb)
        else
c         write(*,'(a19,i4,a1,i4)')' Multibar rest, bars',
          write(*,'(/,a19,i4,a1,i4)')' Multibar rest, bars',
     *       ibarcnt-ibaroff,'-',ibarcnt-ibaroff+mbrest-1
          ibaroff = ibaroff-mbrest+1
c
          jprntb = 0
c
        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)
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
10    continue
      firstline = .false.
      newmeter = .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'
          stop 1
        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 
          nsystpp = 2
        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.'
        stop 1
      end if
      nflb = nflb+1
      ibarflb(nflb) = ibarcnt+1
      isysflb(nflb) = nsyst+1
      heightil = ptheight*4./musicsize
c
c  Set up dummy forced page after last real one 
c
      nfpb = nfpb+1
      ipagfpb(nfpb) = npages+1
      isysfpb(nfpb) = nsyst+1 
      open(12,file='pmxtex.dat')
      write(12,'(a)')basenameq(1:lbase)
      write(12,*)lbase
c
c Pass to pmxb the initial signature, including effect of transposition.
c
      write(12,'(8f10.5/f10.5,3i5)')fbar,apt,abigpt,wheadpt,etait,
     *     etatc,etacs1,etatop,etabot,inbothd,inhnoh,isig1
      write(12,*)npages,widthpt,ptheight,nsyst
      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
          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/musicsize
              xilfrac = xilfrac+etait
            end if
            if (iand(ihead,2) .eq. 2) then
              xiltxt = xiltxt+hgtti*4/musicsize
              xilfrac = xilfrac+etatc
            end if
            if (iand(ihead,4) .eq. 4) then
              xiltxt = xiltxt+hgtco*4/musicsize
              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 = nsystp*(nv-1)
          xN = heightil - xiltxt - 4*nsystp*nv - (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 = N/(D + omega * C) = glueil,   (1)
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  D = omega-indep factors for scalable height = nsy-1 (intersystem glue)
c      + etatop + etabot + etatxt + 
c  C*omega = nsy*(nv-1)*omega (\interstaff part)
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.
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
      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
        ibarb4 = lastbar(isyst-1)
        if (isyst .eq. 1) then
c         elsstarg = celsk(ibarcnt)/(nsyst-fracindent)*(1-fracindent)
          elssold = celsk(ibarcnt)/(nsyst-fracindent)*(1-fracindent)
          elsstarg = celsk(ibarflb(1)-1)/(isysflb(1)-1-fracindent)
     *                 *(1-fracindent)
          celskb4 = 0.
        else
          celskb4 = celsk(ibarb4)
c         elsstarg = (celsk(ibarcnt)-celskb4)/(nsyst-isyst+1)
          elssold = (celsk(ibarcnt)-celskb4)/(nsyst-isyst+1)
          elsstarg = (celsk(ibarflb(iflb)-1)-celskb4)
     *                           /(isysflb(iflb)-isyst)
        end if
        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
c
c  elss is # of elemskip in the syst. from notes, not ruleskips, ask's, afterrs
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./musicsize
        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)
            nacc = max(abs(key2-key1),max(abs(key1),abs(key2)))
            fsyst = fsyst+nacc*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/musicsize
        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)/musicsize
26      continue
        wdpt = widthpt
        if (isyst .eq. 1) wdpt = widthpt*(1-fracindent)
        wsyspt = wdpt-fsyst*musicsize-0.4*nbarss(isyst)
c
c  Checks for min spacing
c  Get range of NOtes def'ns required, also min allowable space
c
c        iemin = 1000
        iemin = 0
c        iemax = 0
        do 45 ibar = ibar1 , ibar1+nbarss(isyst)-1
c          iemin = min(iemin,ieminb(ibar))
          iemin = ior(iemin,ieminb(ibar))
c          iemax = max(iemax,iemaxb(ibar))
          if (wminnh(ibar).ge.0.) wmins = wminnh(ibar)
45      continue
        if (wmins .lt. 0) wmins = 0.3 
        wminpt = (1+wmins)*0.3*musicsize
c
c  Find min,max actual duration for this system & # of notes
c
        dtmin = 1000.
        dtmax = 0.
        nns = 0
        do 43 iptr = nptr(ibar1) , nptr(ibar1+nbarss(isyst))-1
          dtmin = min(dtmin,durb(iptr))
          dtmax = max(dtmax,durb(iptr))
          nns = nns + nnpd(iptr)
43      continue
c       elmin0 = wsyspt*feon(dtmin)/(elss(isyst)+fbar*nbarss(isyst))
        elmin0 = wsyspt*feon(dtmin)/
     *            (elss(isyst)+fbar*nbarss(isyst)+xelsk)
        if (elmin0 .ge. wminpt) then
          sumelsk = elss(isyst)
          eonk = 0.
          ewmxk = 1.
        else
c         elmin1 = wsyspt/(fbar*nbarss(isyst)/feon(dtmax)+nns)
          elmin1 = wsyspt/((fbar*nbarss(isyst)+xelsk)/feon(dtmax)+nns)
          if (elmin1 .le. wminpt) then
            print*
            print*,'In system #',isyst,' cannot meet min. space rqmt'
            eonk = 0.9
          else
            eonk = min(.9,(wminpt-elmin0)/(elmin1-elmin0))
          end if
          ewmxk = feon(dtmax)**eonk
c
c  Recompute poenom!
c
          sumelsk = 0
          do 44 iptr = nptr(ibar1) , nptr(ibar1+nbarss(isyst))-1
            sumelsk = sumelsk
     *       + nnpd(iptr)*feon(durb(iptr))**(1-eonk)*ewmxk
44        continue
        end if
        poenom = wsyspt/(sumelsk+fbar*nbarss(isyst)+xelsk)
c        write(12,'(1pe12.5/i5,4e12.3,2i5)') poenom,nbarss(isyst),
c     *       sumelsk,fsyst,eonk,ewmxk,iemin,iemax
        write(12,'(1pe12.5/i5,4e12.3,i9)') poenom,nbarss(isyst),
     *       sumelsk,fsyst,eonk,ewmxk,iemin
        ibar1 = ibar1+nbarss(isyst)
22    continue
      close(12)
      open(13,file='pmxtex.fig')
      write(13,'(i5)')ifig
      close(13)
c     print*,'Done with first pass.  Now run pmxb.'
      write(*,'(/,a)')' Done with first pass.  Now run pmxb.'
      end
      subroutine getnote(loop,ifig)
      parameter (nm=7,nkb=500,nbz=200)
      common /all/ iv,list(4,nbz),nnl(nm),nv,ibar,
     *   ipl(nm,nbz),mtrnuml,
     *   nodur(nm,nbz),jn,lenbar,iccount,nbars,itsofar(nm),
     *   nib(nm,15),nn(nm),
     *   rest(nm,nbz),lenbr0,lenbr1,firstline,newmeter
      common /comnotes/ nnodur,wminnh(nkb),nnpd(2000),durb(2000),
     *     nptr(nkb),ibarcnt,ieminb(nkb),iemaxb(nkb),mbrest,ibarmbr,
     *     ibaroff,udsp(nkb),wheadpt
      common /comget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
     *     inchord
      common /compage/ widthpt,ptheight,nsyst,nflb,ibarflb(0:40),
     *      isysflb(0:40),npages,nfpb,ipagfpb(0:10),isysfpb(0:10),
     *      usefig,fintstf,gintstf
      common /commvl/ nvmx(nm),ivmx(nm,2),ivx,fbar
      common /comkeys/ nkeys,ibrkch(14),newkey(14),iskchb,idsig,isig1,
     *       kchmid(14),ornrpt,shifton,barend
      logical lastchar,firstline,rest,loop,newmeter,fbon,issegno,barend,
     *        isheadr,fulbrp,usefig,isvolt,iskchb,kchmid,plusmin,ornrpt
      common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
      logical mrecord,mplay,endmac,inchord,isvshft,shifton
      character*128 lineq,lnholdq
      character*1 charq,dotq,dumq,durq,charlq
      character*51 literq(2)
      data literq 
     *   /'Literal TeX string cannot start with 4 backslashes!',
     *    'TeX string must have <129 char, end with backslash!'/
1     call getchar(lineq,iccount,charq)
      if (charq .ne. ' ') charlq = charq
      if (lastchar) then
        if (charlq .ne. '/') then
          print*,'Last non-blank character is "',charlq,'", not "/"'
          stop 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
      else if ((ichar(charq).ge.97.and.ichar(charq).le.103) .or.
     *       charq.eq.'r') then
c
c  This is a note/rest.  Setup, increase note count, then loop 'til blank
c
        idotform = 0
        numnum = 0
        plusmin = .false.
        inchord = .false.
28      nnl(ivx) = nnl(ivx)+1
        if (nnl(ivx) .gt. nbz) then
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *      '>200 notes in line of music. Use smaller blocks!')
          stop 1
        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,nnl(ivx)-1) .and.
     *    nodur(ivx,nnl(ivx)-1) .eq. lenbar
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
            if (charq .eq. 'r') then
              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *           'Only one digit allowed after rest symbol "r"!')
              stop 1
            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!')
            stop 1
          end if
        else if (durq.eq.'d') then
          dotq = durq
          if (index('+-',lineq(iccount+1:iccount+1)) .gt. 0) then
c
c  move a dot, provided a number follows.
c
            call getchar(lineq,iccount,durq)
            call getchar(lineq,iccount,durq)
            if (index('0123456789-.',durq) .eq. 0) then
c
c  Backup, exit the loop normally
c
              iccount = iccount-2
              go to 2
c             call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
c    *         'Expected a number after +/- after "d" (raise dot)!')
c             stop 1
            end if
            call readnum(lineq,iccount,dumq,fnum)
            if (index('+-',dumq) .gt. 0) then
c
c  Vertical shift also
c
              call getchar(lineq,iccount,durq)
              if (index('0123456789-.',durq) .eq. 0) then
                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *               'Expected number after 2nd +/- (shift dot)!')
                stop 1
              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
          if (charq .ne. 'r') then
            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         end if
c
c  It's a rest containing +|- .  Must refer to a vertical shift.  Read past.  
c
          else
            call getchar(lineq,iccount,durq)
            call readnum(lineq,iccount,durq,dum)
            iccount = iccount-1
            go to 2
          end if
        else if (index('fsnulare',durq) .gt. 0) then
          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,
     *             'You entered "p"; I expected "rp"!')
            stop 1
          else if (lineq(iccount+1:iccount+1).ne.' ') then
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *             'You entered "rp" followed by non-blank!')
            stop 1
          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"!')
            stop 1
          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: Set all durations to 0 except last one.
c
          if (charq .eq. 'r') then
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *          'Xtuplets currently may not start with a rest!')
            stop 1
          end if
          call getchar(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"!')
            stop 1
          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!')
            stop 1
          else if (index(' n',durq) .eq. 0) then
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *             'Only legal characters here are " " or "n"!')
            stop 1
          end if
          if (durq .eq. 'n') then
c
c  Number alteration stuff
c
            numshft = 0
30          call getchar(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 numbers are allowed after "n" in xtup!')
                stop 1
              end if
              call getchar(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 "."!')
                stop 1
              end if
              call readnum(lineq,iccount,durq,snum)
              iccount = iccount-1
              if ((numshft.eq.1 .and. snum.gt.15.1) .or.
     *             (numshft.eq.2 .and. snum.gt.1.51)) then
                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *              'Number after "n" in xtup is out of range!')
                stop 1
              end if 
              go to 30
            else if (durq .ne. ' ') then
              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *             'Illegal character after "n" in xtup!')
              stop 1
            end if
          end if
          ntup = int(fnum+.1)
          do 6 itup = 2 , ntup
            nodur(ivx,nnl(ivx)) = 0
            nnl(ivx) = nnl(ivx)+1
110         call getchar(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 getchar(lineq,iccount,dumq) 
              if (index('(stmx+Tup._)e:>^',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
                stop 1
              end if
              if (dumq .eq. 'T') then
c
c  Trill.  may be followed by 't' and/or number.  read 'til blank
c
29              call getchar(lineq,iccount,dumq) 
                if (dumq .ne. ' ') go to 29
              else if (dumq .eq. 'e') then
                call getchar(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!')
                  stop 1
                end if
                call getchar(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: "!')
                  stop 1
                else if (.not.ornrpt) then
                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *            'Turned off repeated ornaments before they were on!')
                  stop 1
                end if
                ornrpt = .false.
              else
                call getchar(lineq,iccount,dumq) 
              end if
              if (index('+- :',dumq) .eq. 0) then
                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *            'Illegal character in ornament symbol!')
                stop 1
              end if
              if (dumq .eq. ':') then
                if (ornrpt) then
                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *               'Turned on repeated ornaments but already on!')
                  stop 1
                end if
                ornrpt = .true.
              end if
              if (index('+-',dumq) .gt. 0) 
     *                       call readnum(lineq,iccount,durq,fnum)
              go to 110
            else if (index('st()',durq) .gt. 0) then
              iposn = 0
              isvshft = .false.
15            call getchar(lineq,iccount,dumq) 
              iposn = iposn+1
              if (index('udlt',dumq) .gt. 0) then
                go to 15
              else if (index('+-',dumq) .gt. 0) then
                iccount = iccount+1
                call readnum(lineq,iccount,durq,fnum)
                if (.not.isvshft) then
                  isvshft = .true.
                  if (int(fnum+.5) .gt. 15) then
                    call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *       'Magnitude of slur height adjustment cannot exceed 15!')
                    stop 1
                  end if
                else
                  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)!')
                    stop 1
                  end if
                end if
                iccount = iccount-1
                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) go to 15
                  call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *              'Slur ID must be 2nd character in slur symbol!')
                  stop 1
                end if
                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *                   'Illegal character in slur symbol!')
                stop 1
              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!')
                stop 1
              else if (durq.eq.'x') then 
                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *            'No floating figures in xtuplets!')
                stop 1
              end if
              if (usefig .and. ivx.eq.1) ifig = 1
26            call getchar(lineq,iccount,durq)
              if (index('0123456789#-n_',durq) .gt. 0) then
                go to 26
              else if (durq .ne. ' ') then
                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *            'Illegal character in figure in xtuplet!')
                stop 1
              end if
              go to 110
            else if (durq .eq. char(92)) then
              call chklit(lineq,iccount,literr)
              if (literr .gt. 0) then
                call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *               literq(literr))
                stop 1
              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!')
              stop 1
            else if (durq .eq. 'X') then
c
c  Assume hardspace, not shift, for now
c
              call getchar(lineq,iccount,durq)
              if (index('+-',durq) .gt. 0) iccount = iccount+1
              call readnum(lineq,iccount,durq,fnum)
              iccount = iccount-1
              go to 110
            else if (durq .eq. 'z') then
c
c  Chord note in xtup.  Read past for now.
c
33            call getchar(lineq,iccount,durq)
              if (durq .ne. ' ') go to 33                        
              go to 110
            end if
            if (index('abcdefg',durq) .eq. 0) then
              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *         'In xtup, this character is not allowed!')
              stop 1
            end if
7           call getchar(lineq,iccount,durq)
            if (index('+-sfn',durq) .gt. 0) go to 7 
6         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 (iv .gt. 1) then
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *             'Cannot have multibar rest if nv>1!')
            stop 1
          else if (mod(itsofar(iv),lenbar) .ne. 0) then
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *             'Multibar rest must start at beginning of bar!')
            stop 1
          else if (ibarmbr .gt. 0) then
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *             'Only one multibar rest allowed per block!')
            stop 1
          end if
c
c  For some purposes, pretend its one bar only
c
          nodur(iv,nnl(iv)) = lenbar
          ibarmbr = nbars+1
          mbrest = 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
          if (durq .ne. ' ') then
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *             'Illegal character after "rm"!')
            stop 1
          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, is if durq=' '
c
        else if (durq .ne. ' ') then
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *           'Illegal character!')
          stop 1
        end if
c
c  Set the duration
c
        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 (ibarmbr.ne.nbars+1 .and. .not.fulbrp) then
          nodur(ivx,nnl(ivx)) = ifnodur(nnodur,dotq)
        else if (fulbrp) then
          nodur(ivx,nnl(ivx)) = lenbar
          fulbrp = .false.
        end if
c     print*,'ivx,nnl(ivx),nodur:',ivx,nnl(ivx),nodur(ivx,nnl(ivx))
        if (charq .eq. 'r') then
          rest(ivx,nnl(ivx)) = .true.
        end if
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!')
          stop 1
        end if
120     continue
        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!')
            stop 1
          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!')
              stop 1
            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!')
            stop 1
          end if
          barend = .false.
        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
        inchord = .true.
        call getchar(lineq,iccount,charq)
25      call getchar(lineq,iccount,durq)
        if (index('nfs+-.0123456789dre',durq) .gt. 0) go to 25
        if (durq .ne. ' ' .or. index('abcdefg',charq).eq.0) then
          call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
     *      'Illegal character in chord note!')
          stop 1
        end if
      else if (charq .eq. 'G') then
        ngr = 1
9       call getchar(lineq,iccount,charq)
        if (index('123456789',charq) .gt. 0) then
          call readnum(lineq,iccount,durq,fnum)
          ngr = int(fnum+.1)
          iccount = iccount-1
          go to 9
        else if (index('AWulxs',charq) .gt. 0) then
          go to 9
        else if (charq .eq. 'm') then
          call getchar(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!')
            stop 1
          end if
          go to 9
        end if
c
c  At this point, charq is first note name in rest (grace?)
c
        do 19 igr = 1 , ngr
          numnum = 0
c          if (igr .gt. 1) call getchar(lineq,iccount,charq)
c++
          if (igr .gt. 1) then
c            if (charq .ne. ' ') then
c              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
c     *             'In multiple grace, expected blank!')
c              stop 1
c            end if
55          call getchar(lineq,iccount,charq)
            if (charq .eq. ' ') go to 55
          end if
c++
          if (index('abcdefg',charq) .eq. 0) then
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *         'In grace, expected "a"-"g"!') 
            stop 1
          end if
18        call getchar(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!')
                stop 1
              end if
              numnum = 1
              go to 18
            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!')
            stop 1
          end if
19      continue
      else if (charq .eq. char(92)) then
        call chklit(lineq,iccount,literr)
        if (literr .gt. 0) then
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *               literq(literr))
          stop 1
        end if
      else if (charq .eq. 'o') then
c
c  "o" symbol must come AFTER the affected note
c
        call getchar(lineq,iccount,dumq) 
        if (index('(stmgx+Tupf._)e:>^',dumq) .eq. 0 ) then 
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *           'Illegal ornament!')
          stop 1
        end if
        if (dumq .eq. ':') then
          call getchar(lineq,iccount,dumq) 
          if (dumq .ne. ' ') then
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *      'Expected blank after "o:"!')
            stop 1
          else if (.not.ornrpt) then
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *            'Turned off repeated ornaments before they were on!')
            stop 1
          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!')
            stop 1
          else if (ivx .ne. 1) then
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *             'segno can only be in voice 1!')
            stop 1
          end if
          issegno = .true.
12        call getchar(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!')
            stop 1
          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 getchar(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 ":"!')
              stop 1
            end if
            go to 32
          else if (dumq .ne. ' ') then
            go to 22
          end if
        else if (dumq .eq. 'f') then
          call getchar(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!')
            stop 1
          end if
          if (dumq .eq. 'd') call getchar(lineq,iccount,dumq) 
          if (dumq .eq. ':') go to 32
        else if (dumq .eq. 'e') then
          call getchar(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!')
            stop 1
          end if
          call getchar(lineq,iccount,dumq) 
        else
          call getchar(lineq,iccount,dumq) 
        end if
        if (index('+- :',dumq) .eq. 0) then
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *      'Illegal character in ornament symbol!')
          stop 1
        end if
        if (index('+-',dumq) .gt. 0) 
     *                 call readnum(lineq,iccount,durq,fnum)
32      continue
        if (dumq .eq. ':') then
          if (ornrpt) then
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *               'Turned on repeated ornaments but already on!')
            stop 1
          end if
          ornrpt = .true.
        end if
c      else if (charq .eq. 's' .or. charq .eq. 't') then 
      else if (index('st()',charq) .gt. 0) then 
        isvshft = .false.
        iposn = 0
8       call getchar(lineq,iccount,dumq) 
        iposn = iposn+1
        if (index('udlt+- ',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!')
            stop 1
          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!')
              stop 1
            end if
          end if
c
c  Slur ID is OK.  
c
          go to 8
        end if  
        if (index('udlt',dumq) .gt. 0) then
          go to 8
        else if (index('+-',dumq) .gt. 0) then
          if (charq .eq. 't') then
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *     '"+|-" for slur height only allowed in "s"-slurs!') 
            stop 1
          end if
          iccount = iccount+1
          call readnum(lineq,iccount,durq,fnum)
          if (.not.isvshft) then
            isvshft = .true.
            if (int(fnum+.5) .gt. 15) then
              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *       'Magnitude of slur height adjustment cannot exceed 15!')
              stop 1
            end if
          else
            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)!')
              stop 1
            end if
          end if
          iccount = iccount-1
          go to 8
        end if
      else if (charq .eq. '?') then
        continue
      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!')
          stop 1
        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!')
            stop 1
          end if 
        end if
        if (usefig) ifig = 1
5       call getchar(lineq,iccount,charq)
        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!')
          stop 1
        end if
        fbon = .true.
17      call getchar(lineq,iccount,charq)
        if (index('uljh',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 getchar(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!')
            stop 1
          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
        stop 1
        end if
      else if (charq .eq. ']') then
        call getchar(lineq,iccount,charq)
c       if (charq .eq. ' ') then
        if (index('j ',charq) .gt. 0) then
          if (fbon) then
            fbon = .false.
          else
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *           'Forced beam stop with no corresponding start!')
            stop 1
          end if
        else if (charq .eq. '[') then
          if (.not.fbon) then
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *           '"][" can only go in forced beam!')
            stop 1
          end if
c       else
        else if (charq .ne. 'j') then
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *         '"]" must be followed by blank, "j", or "["!')
          stop 1
        end if
      else if (index('lhw',charq) .gt. 0) then 
c
c  Save position for later check
c
        icclhw = iccount 
        call getchar(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"!')
          stop 1
        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!')
              stop 1
            end if
c
c  Have "h" followed by +/- .  Check for digit.
c     Can blow durq since not using fnum for now, but...
c
            call getchar(lineq,iccount,durq)
            if (index('123456789',durq) .eq. 0) then
              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *           'There must be a digit here!')
              stop 1
            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
c           if (iccount .ne. 2) then
            if (icclhw .ne. 1) then
              call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
     *               '"h" or "l" must be first character in line!')
              stop 1
            end if
c
c  Read past the next line, which has the string.
c
c           read(10,'(a)')charq
            call read10(charq,1,lastchar)
            nline = nline+1
            iccount = 128
          else
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *             'Symbol "w" (width) must be followed by a digit!')
            stop 1
          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!')
            stop 1
          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"!')
            stop 1
          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!')
          stop 1
        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!')
          stop 1
        end if
        call readmeter(lineq,iccount,mtrnmp,mtrdnp)
c
c  Read past printed time signature; not used in pmxa.
c
        lenbeat = ifnodur(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 getchar(lineq,iccount,durq)
        if (.not.(index('tsmanrb',durq).gt.0 .or. 
     *      (ichar(durq).ge.48 .and. ichar(durq).le.54))) then
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *           'Must have t,s,m,a,n,r,b or 1-6 after C!')
          stop 1
        end if
      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!')
          stop 1
        end if
10      call getchar(lineq,iccount,durq)
        if (index('lrdD',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)!')
          stop 1
        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!')
          stop 1
        else if (isvolt) then
          print*
          print*,'*******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'
        end if
        isvolt = .true.
11      call getchar(lineq,iccount,durq)
        if (durq .ne.' ') go to 11
      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!')
          stop 1
        end if
16      call getchar(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 .ne. ' ') then
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *           'Only "l", "r", or digit allowed after "P"!')
          stop 1
        end if
      else if (charq .eq. 'W') then
        call getchar(lineq,iccount,durq)
        if (durq .ne. '.') then
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *           'Next char after " W" must be "."!')
          stop 1
        end if
        call getchar(lineq,iccount,durq)
        if (ichar(durq).ge.48 .or. ichar(durq).le.57) then
          wminnh(ibarcnt+nbars+1) = .1*(ichar(durq)-48)
        else
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *           'Next char after " W." must be 0-9!')
          stop 1
        end if
      else if (charq .eq. 'T') then
c
c  Titles
c
        call getchar(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"!')
          stop 1
        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
c       read(10,'(a)')charq
        call read10(charq,1,lastchar)
        nline = nline+1
        iccount = 128
      else if (charq .eq. 'A') then
27      call getchar(lineq,iccount,durq)
        if (index('rbsd',durq) .gt. 0) then
          go to 27
        else if (durq .eq. 'a') then
          call getchar(lineq,iccount,durq)
          call readnum(lineq,iccount,durq,fbar)
          iccount = iccount-1
          go to 27
        else if (durq .eq. 'i') then
          call getchar(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 getchar(lineq,iccount,durq)
          call readnum(lineq,iccount,durq,gintstf)
          iccount = iccount-1
          go to 27
        else if (durq .ne. ' ') then
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *      'The only legal entries after "A" are "r,s,b,a,i,I,d"!')
          stop 1
        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
        call getchar(lineq,iccount,durq)
        if (index('+-',durq) .eq. 0) then
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *      '"K" (transpose or key change) must be followed by "+,-"!')
          stop 1
        end if
        iccount = iccount+1
        num1 = 44-ichar(durq)
c
c  num1= +1 or -1
c
        call readnum(lineq,iccount,durq,fnum)
        num1 = int(fnum+.1)*num1
        if (index('+-',durq) .eq. 0) then
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *      '1st number after "K" must be followed by "+,-"!')
          stop 1 
        end if
        iccount = iccount+1
        num2 = 44-ichar(durq)
        call readnum(lineq,iccount,durq,fnum)
        num2 = num2*int(fnum+.1)
        if (num1 .eq. 0) 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!')
            stop 1
          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
        else
c
c  Transposition
c
          if (ibarcnt .gt. 0) then
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *         'Transposition must be at top of first input block!')
            stop 1
          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 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!')
          stop 1
        else if (shifton) then
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *      'Bar ended with user-defined shift still on!')
          stop 1
        end if
      else if (charq .eq. '/') then
        if (fbon) then
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *      'Block ended with forced beam open!')
          stop 1
        else if (shifton) then
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *       'Bar ended with user-defined shift still on!')
          stop 1
        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
          stop 1
        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!')
          stop 1
        end if
        call getchar(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
            nvmx(iv) = 2
            ivmx(iv,2) = ivx
            itsofar(ivx) = 0
            nnl(ivx) = 0
            do 24 j = 1 , nbz
              rest(ivx,j) = .false.
24          continue
          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!')
          stop 1
        end if
        call getchar(lineq,iccount,durq)
        call readnum(lineq,iccount,durq,fnsyst)
        nsyst = int(fnsyst+.1)
        if (durq .eq. 'P') then
c
c  New npages for parts.  Assuming <10.
c
          call getchar(lineq,iccount,durq)
          if (index('123456789',durq) .eq. 0) then
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *           'Symbol after "P" must be a digit!')
            stop 1
          end if
          npages = ichar(durq)-48
        end if
      else if (charq .eq. 'L') then
        nflb = nflb+1
        ibarflb(nflb) = ibarcnt+nbars+1
        call getchar(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!')
          stop 1
        end if
        call readnum(lineq,iccount,durq,sysflb)
        isysflb(nflb) = int(sysflb+.1)
        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!')
            stop 1
          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) stop 1
        else if (isysflb(nflb) .gt. nsyst) then
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *           'Forced line break at line num > nsyst!')
          stop 1
        else if (index(' PM',durq) .eq. 0) then
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *      'Must have " ", "P", or "M" here!')
          stop 1
        end if
        if (durq .eq. 'P') then
c
c  Forced page break here, get page number.
c
          call getchar(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!')
            stop 1
          end if
          call readnum(lineq,iccount,durq,fnum)
          nfpb = nfpb+1
          ipagfpb(nfpb) = fnum+.1
          isysfpb(nfpb) = isysflb(nflb)
        end if
        if (index(' M',durq) .eq. 0) then
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *        'Illegal character in linebreak symbol!')
          stop 1
        else if (durq .eq. 'M') then
          call getchar(lineq,iccount,durq)
31        if (durq .eq. '+') then
c
c  Vertical spacing, read past number.  
c
            call getchar(lineq,iccount,durq)
            if (index('123456789',durq) .eq. 0) then
              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *          'Integer required here!')
              stop 1
            end if
            call readnum(lineq,iccount,durq,fnum)
            go to 31
          else if (durq .eq. 'i') then
c
c  Change indentation, read past number
c
            call getchar(lineq,iccount,durq)
            if (index('.123456789',durq) .eq. 0) then
              call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *          'Decimal number required here!')
              stop 1
            end if
            call readnum(lineq,iccount,durq,fnum)
            go to 31
          else if (durq .ne. ' ') then
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *        'Illegal character after Movement break symbol!')
            stop1
          end if
        end if
      else if (charq .eq. 'F') then
        usefig = .false.
      else if (charq .eq. 'X') then
        call getchar(lineq,iccount,charq)
        if (charq .eq. ':') then
          if (.not.shifton) then
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *         'You ended a 1-voice shift without starting one!')
            stop 1
          else if (lineq(iccount+1:iccount+1) .ne. ' ') then
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *         '":" (end shift) must be followed by a blank here!')
            stop 1
          end if
          shifton = .false.
        else if (index('0123456789.-',charq) .eq. 0) then
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *     'This character must be "." , "-" , or a digit!')
          stop 1
        else
          if (charq.eq.'-') iccount = iccount+1
          call readnum(lineq,iccount,durq,fnum)
          if (charq.eq.'-') fnum = -fnum
          if (index(':Sp ',durq) .eq. 0) then
            call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *       'This must be ":" , "S" , "p" , or blank!')
            stop 1
          else if (index(':Sp',durq).gt.0 .and. 
     *             lineq(iccount+1:iccount+1).ne.' ') then
            call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
     *       'There must be a blank here!')
            stop 1
          end if
          if (durq .eq. ':') then
            shifton = .true.
          else 
            if (durq .ne. 'p') fnum = fnum*wheadpt 
            udsp(ibarcnt+nbars+1) = udsp(ibarcnt+nbars+1)+fnum
          end if
        end if
      else if (charq .eq. 'M') then
        call setmac(lineq,iccount,ibarcnt,ibaroff,nbars,charq,durq) 
      else
        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *         'Illegal character!')
        stop 1
      end if
      return
      end
      subroutine getchar(lineq,iccount,charq)
      common /comget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
     *     inchord
      logical lastchar,issegno,isheadr,isvolt,fbon,inchord
      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,128,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 mrec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm)
        end if
      end if
      iccount = iccount+1
      charq = lineq(iccount:iccount)
      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. 16) then
c
c  Only used for denominator of time signatures, not for notes
c
          ifnodur=4
        else if (idur .eq. 9) then
          ifnodur = 128
        else 
          print*
          print*,'You entered an invalid note-length value:',idur
          stop 1
        end if
        if (dotq .eq. 'd') ifnodur = ifnodur*3/2
      return
      end
      subroutine makeabar()
      parameter (nm=7,nkb=500,nbz=200)
      common /all/ iv,list(4,nbz),nnl(nm),nv,ibar,
     *   ipl(nm,nbz),mtrnuml,
     *   nodur(nm,nbz),jn,lenbar,iccount,nbars,itsofar(nm),
     *   nib(nm,15),nn(nm),
     *   rest(nm,nbz),lenbr0,lenbr1,firstline,newmeter
      common /linecom/ elskb
      common /comnotes/ nnodur,wminnh(nkb),nnpd(2000),durb(2000),
     *     nptr(nkb),ibarcnt,ieminb(nkb),iemaxb(nkb),mbrest,ibarmbr,
     *     ibaroff,udsp(nkb),wheadpt
      common /commvl/ nvmx(nm),ivmx(nm,2),ivx,fbar
      logical rest,firstline,newmeter,intup,herext
      integer it(nm),cnn(nm),istart(20),istop(20),itstart(20),
     *   nspace(20),nindex(20)
      elskb = 0.
c      ieminb(ibarcnt) = 1000
      ieminb(ibarcnt) = 0
c      iemaxb(ibarcnt) = 0
      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
2       list(1,ilnc) = ivx
        list(2,ilnc) = cnn(ivx)
        list(3,ilnc) = 0
        it(ivx) = nodur(ivx,cnn(ivx))
        if (nodur(ivx,cnn(ivx)).eq.0) then
c
c  To keep all notes of xtup together, get another note from this voice 
c
          ilnc = ilnc+1
          cnn(ivx) = cnn(ivx)+1
          go to 2
        end if
        if (it(ivx) .eq. lenbar) it(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  itmin is the earliest ending time of notes done so far
c
      itmin = 1000
      do 6 iv = 1 , nv
      do 6 kv = 1 , nvmx(iv)
        ivx = ivmx(iv,kv)
        itminn = min(itmin,it(ivx))
        if(itminn .lt. itmin) then
          itmin = itminn
          ivnext = ivx
        end if
6     continue
      if (itmin .eq. 1000) go to 7
      list(1,ilnc) = ivnext
      cnn(ivnext) = cnn(ivnext)+1
      list(2,ilnc) = cnn(ivnext) 
      list(3,ilnc) = itmin
c
c  Check if this voice is done
c           
      if (cnn(ivnext) .eq. nn(ivnext)) then
        it(ivnext) = 1000
      else
        it(ivnext) = it(ivnext)+nodur(ivnext,cnn(ivnext)) 
      end if
      ilnc = ilnc+1
      go to 5
7     continue
      ntot = ilnc-1
      do 8 in = 1 , ntot-1
        list(4,in) = list(3,in+1)-list(3,in)
8     continue
      list(4,ntot) = nodur(list(1,ntot),list(2,ntot))
c
c  Debug writes
c
c     write(*,'(26i3)')(list(1,in),in=1,ntot)
c     write(*,'(26i3)')(list(2,in),in=1,ntot)
c     write(*,'(26i3)')(list(3,in),in=1,ntot)
c     write(*,'(26i3)')(list(4,in),in=1,ntot)
c     write(*,'(26i3)')(nodur(list(1,in),list(2,in)),in=1,ntot)
c
c  Done w/ list.  A kluged up loop for building note blocks:
c
      ib = 1 
      istart(1) = 1
      nspace(1) = 0
      in = 1 
9     continue
        if (in .eq. ntot) then
          if (nspace(ib) .eq. 0) nspace(ib)=list(4,in)
          istop(ib) = ntot
c
c Now we flow out of this if and into block-building      
c
        else if (nspace(ib) .eq. 0) then
c
c nspace hasn't been set yet, so tentatively set:
c
          nspace(ib) = list(4,in)
          if (nspace(ib) .eq. 0) then
            in=in+1
          else
            istop(ib) = in
          end if
          go to 9
        else if (list(4,in+1) .eq. 0) then
c
c This is not the last note in the group, so
c
          in = in+1
          go to 9 
        else if (list(4,in+1) .eq. nspace(ib)) then
c
c Keep spacing the same, update tentative stop point
c
          in = in+1
          istop(ib) = in
          go to 9
        end if
c
c At this point istart and istop are good, so close out block 
c
        itstart(ib) = list(3,istart(ib))
        nindex(ib) = kindxf(nspace(ib))
        ieminb(ibarcnt) = ior(ieminb(ibarcnt),2**nindex(ib))
c        iemaxb(ibarcnt) = max(iemaxb(ibarcnt),nindex(ib))
        elsperns = feon(float(nspace(ib)))
        if (istop(ib) .eq. ntot) then
          nnsk = (lenbar-itstart(ib))/nspace(ib)
        else
          nnsk = (list(3,istop(ib)+1)-itstart(ib))/nspace(ib)
        end if
        elskb = elskb+elsperns*nnsk
        if (nptr(ibarcnt+1) .gt. nptr(ibarcnt)) then
          call catspace(float(nspace(ib)),nnsk)
        else
c
c  This is the first entry for this bar
c
          nnpd(nptr(ibarcnt)) = nnsk
          durb(nptr(ibarcnt)) = nspace(ib)
          nptr(ibarcnt+1) = nptr(ibarcnt+1)+1
        end if
        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
        nspace(ib) = list(4,in)
        istop(ib) = in
      go to 9          
15    continue
      nb = ib
c     write(*,'(24i3)')(istart(ib),istop(ib),ib=1,nb)
c
c  Run through blocks, correcting elskb as needed for xtuplets 
c
      do 100 ib = 1 , nb
        herext = .false.
        intup = .false.
        do 101 in = istart(ib) , istop(ib)
          if (nodur(list(1,in),list(2,in)) .eq. 0) then
            if (.not.herext) then
c
c  New window with some number of xtups starts here.
c
              ntupm = 0
              herext = .true.
              itxstart = list(3,in)
            end if
            if (.not.intup) then
c
c  New xtup starts here
c
              ntup = 0
              intup = .true.
            end if
            ntup = ntup+1
            go to 101
          else if (intup) then
c
c  xtup ends here
c
            ntup = ntup+1
            lxtup = nodur(list(1,in),list(2,in))
            if (ntup .ge. ntupm) ntupm=ntup
            intup = .false.
          end if
          if (herext .and. 
     *        (in.eq.istop(ib).or.list(3,in+1).ne.itxstart)) then
c
c  Finished with all notes starting where xtup starts, so close out.
c
            ixtend = itxstart+lxtup
c
c  Compute "natural" length (in *elemskips) of xtuplet
c
            elxtup = ntupm*feon(lxtup/1./ntupm)
c
c  Compute natural lengths of other stuff spanning same time interval
c
            if (ixtend .le. list(3,istop(ib))+list(4,istop(ib))) then
c
c  xtup is contained in a single block
c
              nsk = lxtup/nspace(ib)
              elother = nsk*feon(lxtup/1./nsk)
            else
c
c  xtup spills over to next block
c
              ltime = itstart(ib+1)-itxstart
              nsk = ltime/nspace(ib)
              elother = nsk*feon(float(nspace(ib)))
              do 103 iib = ib+1 , nb
                if (ixtend .le. 
     *              list(3,istop(iib))+list(4,istop(iib))) then
                  ltime = ixtend-itstart(iib)
                  nsk = ltime/nspace(iib)
                  elother = elother+nsk*feon(float(nspace(iib)))
                  go to 104
                else
                  ltime = list(3,istop(iib))+list(4,istop(iib))
     *                                   -itstart(iib)
                  nsk = ltime/nspace(iib)
                  elother = elother+nsk*feon(float(nspace(iib)))
                end if
103           continue
            end if
104         continue
            elskb = elskb+dim(elxtup,elother)
            if (elxtup .gt. elother) then
c
c  Need to adjust catalog of tspaces
c
              call catspace(float(lxtup)/ntupm,ntupm)
              call catspace(float(lxtup),-1)
            end if
            herext = .false.
            ntupm = 0
          end if
101     continue
100   continue
c
c  Eliminate any zeroes in nnpd.  Manual loop since upper limit may change.
c
      iptr = nptr(ibarcnt)
105   continue
      if (iptr .gt. nptr(ibarcnt+1)-1) go to 106
      if (nnpd(iptr) .eq. 0) then
        nptr(ibarcnt+1) = nptr(ibarcnt+1)-1
        do 107 iiptr = iptr , nptr(ibarcnt+1)-1
          nnpd(iiptr) = nnpd(iiptr+1)
          durb(iiptr) = durb(iiptr+1)
107     continue
      else
        iptr = iptr+1
      end if
      go to 105
106   continue
      return
      end
      function feon(time)
c       feon = max(1.8,1.+alog(time/2)/.69315)
        feon = sqrt(time/2)
      return
      end
      function kindxf(nspace)
        kindxf = 2*alog(nspace*1.)/0.69315 + 1.3
      return
      end 
      function tspace(ie)
        if (mod(ie,2).eq.0) then
          tspace = .75*2.**(ie/2)
        else
          tspace = sqrt(2.**(ie-1))
        end if
      return
      end
      subroutine catspace(tspace,nnsk)
      parameter (nkb=500)
      common /comnotes/ nnodur,wminnh(nkb),nnpd(2000),durb(2000),
     *     nptr(nkb),ibarcnt,ieminb(nkb),iemaxb(nkb),mbrest,ibarmbr,
     *     ibaroff,udsp(nkb),wheadpt
      do 16 iptr = nptr(ibarcnt) , nptr(ibarcnt+1)-1
        if (abs(tspace-durb(iptr)) .lt. 0.001) then
c
c  Must increment old entry
c
          nnpd(iptr) = nnpd(iptr)+nnsk
          return
        end if
16    continue
c
c  Didn't find current duration, must add a new entry
c
      do 18 iptr = nptr(ibarcnt) , nptr(ibarcnt+1)-1
        if (tspace .lt. durb(iptr)) then
c
c  New entry will go at this iptr.  Bump up the rest
c
          do 19 jptr = nptr(ibarcnt+1)-1 , iptr , -1
            nnpd(jptr+1) = nnpd(jptr)
            durb(jptr+1) = durb(jptr)
19        continue
          nnpd(iptr) = nnsk
          durb(iptr) = tspace
          nptr(ibarcnt+1) = nptr(ibarcnt+1)+1
          return
        end if
18    continue
c
c  New entry goes at the end
c
      nnpd(nptr(ibarcnt+1)) = nnsk
      durb(nptr(ibarcnt+1)) = tspace
      nptr(ibarcnt+1) = nptr(ibarcnt+1)+1
      return
      end
      subroutine chklit(lineq,iccount,literr)
      character*128 lineq
      character*1 charq
      literr = 0
      itype = 1
17    call getchar(lineq,iccount,charq)
      if (charq .eq. char(92)) then
        itype = itype+1
        if (itype .gt. 3) then
          literr = 1
          return
        end if
        go to 17
      end if
      lenlit = itype
18    call getchar(lineq,iccount,charq)
      if (charq.eq.char(92)) then
        call getchar(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
c           print*,'TeX string must have <80 char, end w/ " '
c    *         //char(92)//'"'
c           stop
          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 readnum(lineq,iccount,durq,fnum)
      character*128 lineq
      character*1 durq
      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'
        stop 1
      end if
      icf = i2-i1+49
      read(lineq(i1:i2),'(f'//char(icf)//'.0)')fnum
      return
      end
      subroutine readmeter(lineq,iccount,mtrnum,mtrden)
      character*128 lineq
      character*1 durq
      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'//char(48+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'//char(48+ns)//')')mtrden
c
c  Set iccount to last character used
c
        iccount = iccount+ns-1
      end if
      return
      end
      subroutine errmsg(lineq,iccount,ibarno,msgq)
      common /comget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
     *     inchord
      logical lastchar,fbon,issegno,isheadr,isvolt,inchord
      character*128 lineq
      character*78 outq
      character*128 msgq
      if (iccount .le. 78) then
        outq = lineq(1:78)
        iposn = iccount
      else
        outq = '... '//lineq(55:128)
        iposn = iccount-50 
      end if
      print*
      ndigbn = max(1,int(log10(ibarno+.1)+1))
      ndignl = int(log10(nline+.1)+1)
      lenmsg = index(msgq,'!')-1
c     write(*,'(a15,i'//char(48+ndignl)//',a6,i'//char(48+ndigbn)//
      write(*,'(/,a15,i'//char(48+ndignl)//',a6,i'//char(48+ndigbn)//
     *',a)')' ERROR in line ',nline,', bar ',ibarno,': '//msgq(1:lenmsg)
      i10 = iposn/10
      i1 = iposn-10*i10
c     write(*,'('//char(48+i10)//char(48+i1)//'x,a)')char(25)
      write(*,'('//char(48+i10)//char(48+i1)//'x,a)')'v'
      print*,outq(1:78)
c     write(*,'('//char(48+i10)//char(48+i1)//'x,a)')char(24)
      write(*,'('//char(48+i10)//char(48+i1)//'x,a)')'^'
      return
      end
      block data
      common /compage/ widthpt,ptheight,nsyst,nflb,ibarflb(0:40),
     *      isysflb(0:40),npages,nfpb,ipagfpb(0:10),isysfpb(0:10),
     *      usefig,fintstf,gintstf
      common /cblock/ 
     *      etatop,etabot,etait,etatc,etacs1,hgtin,hgtti,hgtco,
     *      xilbn,xilbtc,xilhdr,xilfig,a,b,inbothd,inhnoh  
      logical usefig
      data ptheight,widthpt,
     *      etatop,etabot,etait,etatc,etacs1,hgtin,hgtti,hgtco,
     *      xilbn,xilbtc,xilhdr,xilfig,a,b,inbothd,inhnoh  
     *   / 740. , 524. ,  
     *   .50  ,  .25  , 0.4 , 0.4  , 0.2 , 12. ,21. , 12.,
     *    4   ,   1.6 ,5.,5.7,1.071,2.714,16 ,16 /
      end
      subroutine mrec1(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
      character*128 lineq,lnholdq
      common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
      logical mrecord,mplay,endmac
      if (.not.mrecord) then
c
c  Starting the macro
c
        open(20+macnum,status='SCRATCH')
        mrecord = .true.
      end if
      if (iccount .lt. 128) then
        ndxm = index(lineq(iccount+1:128),'M')
        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!')
            stop 1
          end if
c         if (iccount.gt.0) then
c
c  Check that M is not the only character in the line
c
c         if (iccount.ne.1) then
          if (ndxm .gt. 1) then
            write(20+macnum,'(a)')
     *              lineq(iccount+1:iccount+ndxm-1)
          end if
          mrecord = .false.
        else
c
c  This line just continues the macro
c
          write(20+macnum,'(a)')lineq(iccount+1:128)
        end if
      end if
      return
      end
      subroutine read10(string,lenstr,lastchar)
      character*(*) string
      character*128 lnholdq
      logical lastchar
      common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
      logical mrecord,mplay,endmac
      if (.not.mplay) then
        read(10,'(a)',end=999)string(1:lenstr)
        return
999     lastchar = .true.
        return
      else
        read(20+macnum,'(a)',end=998)string
        return
998     mplay = .false.
        endmac = .true.
        return
      end if
      end
      subroutine setmac(lineq,iccount,ibarcnt,ibaroff,nbars,charq,durq)
      character*1 charq,durq
      common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
      logical mrecord,mplay,endmac,btest
      character*128 lnholdq,lineq
c
c  Macro action
c
      call getchar(lineq,iccount,charq)
      if (index('RSP ',charq) .eq. 0) then
        call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *           'Illegal character after "M" (macro)!')
        stop 1
      else if (charq .ne. ' ') then
c
c  Record or playback a macro.  Get the number of the macro.
c
        call getchar(lineq,iccount,durq)
        if (index('123456789',durq) .eq. 0) then
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *           'Must input number after "MR" or "MP"')
          stop 1
        end if
        call readnum(lineq,iccount,durq,fnum)
        macnum = fnum+.1 
        if (durq .ne. ' ') then
          call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
     *           'Macro number must be followed by a blank!')
          stop 1
        end if
c       if (charq .eq. 'R') then
        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!')
            stop 1
          else if (btest(macuse,macnum)) then
            print*
            print*,'WARNING: Redefined macro # ',macnum
            close(20+macnum)
          end if
          macuse = ibset(macuse,macnum)
          if (charq .eq. 'R') then
            call mrec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm)
          else if (charq .eq. 'S') then
c
c  Save (Record but don't activate)
c
1           call mrec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm)
            if (mrecord) then
              read(10,'(a)')lineq
              iccount = 0
              go to 1
            end if
c           iccount = ndxm
            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!')
            stop 1
          end if
          rewind(20+macnum)
          icchold = iccount
          lnholdq = lineq
          iccount = 128
          mplay = .true.
        end if
      end if
      return
      end
      subroutine getset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp,
     *    xmtrnum0,newkey,npages,nsyst,musicsize,fracindent,bottreb)
      character*128 lineq
      logical lastchar,issegno,isheadr,isvolt,inchord,fbon,bottreb
      common /comget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
     *     inchord
c
c  Get the first line
c
      iccount = 0
      nline = 1
9     read(10,'(a)')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
        read(10,'(a)',end=1)lineq
        go to 2
1       print*,'You did not terminate type 0 TeX input with "---"'
        stop 1
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 = readin(lineq,iccount,nline)+.1
      noinst = readin(lineq,iccount,nline)+.1
      if (noinst .le. 0) then
        noinst = noinst-1
        do 10 iinst = 1 , -noinst
          xdum = readin(lineq,iccount,nline)   
10      continue
      end if
      mtrnuml = readin(lineq,iccount,nline)+.1
      mtrdenl = readin(lineq,iccount,nline)+.1
      mtrnmp = readin(lineq,iccount,nline)+.1
      mtrdnp = readin(lineq,iccount,nline)+.1
      xmtrnum0 = readin(lineq,iccount,nline)
      newkey = ni(readin(lineq,iccount,nline))
      npages = readin(lineq,iccount,nline)+.1
      nsyst = readin(lineq,iccount,nline)+.1
      musicsize = readin(lineq,iccount,nline)+.1
      fracindent = readin(lineq,iccount,nline)
      if (npages .gt. nsyst) then
        print*,'Error in input file: npages > nsyst'
        stop 1
      end if 
c
c  Next noinst non-comment lines are names of instruments.  
c
      do 4 i = 1 , abs(noinst)
5       read(10,'(a)')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     read(10,'(a)')lineq
      nline = nline+1
      if (lineq(1:1) .eq. '%') go to 6
      do 7 iv = 1 , nv
        if (index('brnamst0123456',lineq(iv:iv)) .eq. 0) then
          call errmsg(lineq,iv,0,
     *       'There should be a clef symbol here!')
          stop 1
        end if
7     continue
      if (lineq(nv+1:nv+1) .ne. ' ') then
        call errmsg(lineq,nv+1,0,
     *    'There should be a blank here!')
        stop 1
      end if
c
c Set flag if voice 1 is treble, since it affects vertical spacing
c
      bottreb = lineq(1:1).eq.'t'
c
c  Mext non-comment line has path name
c
8     read(10,'(a128)')lineq
      nline = nline+1
      if (lineq(1:1) .eq. '%') go to 8
      lpath = index(lineq,' ')-1
      if (lineq(lpath:lpath).ne.'/'.and.
     *    lineq(lpath:lpath).ne.char(92)) then
        call errmsg(lineq,lpath,0,
     *'Last character of pathname is not / or '//char(92)//'!')
        stop 1
      end if
      return
      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
4     if (iccount .eq. 128) then
1       read(10,'(a)')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'
        stop 1
      end if
      icf = i2-i1+49
      read(lineq(i1:i2),'(f'//char(icf)//'.0)')readin
      return
      end
      function ni(x)
        if (x .ge. 0.) then
          ni = x+0.5001
        else
          ni = x-0.5001
        end if
      return
      end
      subroutine outbar(i,jlast)
      nfmt = log10(i+.5)+2
      if (jlast+5+nfmt .lt. 80) then
        write(*,'(a5,i'//char(48+nfmt)//',$)')'  Bar',i
        jlast = jlast+5+nfmt
      else
        write(*,'(/,a5,i'//char(48+nfmt)//',$)')'  Bar',i
        jlast = 5+nfmt
      end if
      return
      end