implicitnone int eger*4i_di git,t em p_fac, re st ,iv a r,try _string,ireadfil2 parameter (i_di git = 100 0 0, $t emp_fac=10 00, $res t=6 , $i var =1 0000 , $try_string= 10000, $i readfil 2=100 0 ) real*4buff (try_string ) real*4tuni ng(re st) real*4in ext real*4i_ch ar,t_ s_den,date rea l *4de l_fret _scale ,m ax _b a r,m ax_fr et real *4quot es,cost_sam e _st r ing real*4 recor d,ine xt p,o ff set,e xtr a_link real*4mz in te ger *4buff e r (rest) integer *4fou nd (iv ar ),char(iv ar) in teger*4m ax_n ote_sep(rest) integer*4n _ po s(re st,ivar) inte ger*4 cl ength(i v ar) integ er*4new(r est) integer*4rreadfil2 (iv ar ) i ntege r*4k(i var) in teger* 4position (ivar ) inte ge r *4i_try(try_st ring ) in tege r*4t au_s ust(i readfil2) i ntege r* 4ran_no te,fret_ note int eger * 4temp , o ct ave int e g er* 4len,hard in te g er *4length,ul t_cost int ege r*4v ar,t_s _num integer*4 i,n_lin k inte ger*4 i_ se mi to ne_o pen inte ger*4i_ note integer*4de l_time,outp ut_file integer*4n _no te ,debu g _fi l e i n te g e r *4i_ sem itone int eger* 4i os i nteger*4 cost_ f r e t_st ring i nteger*4 n_l o o p,are ad fil2,i ff,start_hard integer*4err or_point,d _c_f,ma x_ st rin g,fil ter i nte ger *4n_valid_strin g, d e bug integ er*4s emi2 fret log i ca ld _ c_f_to t( iva r ) l ogicali_ octave,music _not e,n_step,valid_string,i_fret,max_link logicalii,tau_hand,versio n logica le rro r_han dler lo gi calichar_1 ch aracter*3ha rd _ link(rest) ch ara cter*120n_no_ re d,c,rep eat c har acter*120c _f cha ra c t er* 2le nchar ch ara cter*5comme nt ch aracter* 8 note_m ask da tacomment/'1.0 '/ da t an ote_mask/'06/03/97' / wr ite (6,7 )comment,no te_mask 7 f o rmat(/' MusicTab Version ',a5 , ' Creation date: ' ,a 8 / ) open(uni t=9,file='.filter',s tatus = 'old', $i o stat= temp) ichar_ 1=(t emp .e q.0) if(.not.icha r_ 1 )wr i te ( 6,12) 12 format(' Input name of parameter file:' /) re ad (5,1,iost a t=te mp)n_no _r ed 1 format(a 120) cal l try_ c_f(t emp, 001) writ e(6,13) 13 format (/' MusicTab computations started', $' ..... this may take some time'/) open(u nit=7,file=n_ no _red,status='old' , $io sta t=t emp) ca lltry_c_ f(t e mp,002) c al llin ke d _ note(7, 'OUTPUT_FILE',11,c,oc tave) calltry_c _f (o c t ave , 003) o pen(u nit =8, file=c ,status= 'unknown', $ios tat=tem p ) c allt ry_c_ f( temp,00 4) c al lmax_n ote(7,'N_STRING' , 8,ran_note,octav e) calltry _c_f(o ctave,0 05) callm ax_n ote (7,'MAX_FRET',8, fret_no te,oc t av e ) calltr y_c_ f(octave ,006) ca l l l inked_note(7,'TIME_SIGNATURE', 14,c_f,octave ) call tr y_c_f(o ctave,007) ul t _c ost= index (c_f,'/') c_f(ult _cost:ult_cos t)=' ' read(c_f,*,iosta t= tem p)var,t_s_num call try _c_f( temp,008) c alll inked_note (7,'TUNING' , 6,c_ f, octa ve ) calltry_ c_f( octa ve,009) read(c_f,*,iost at=temp) $(h ard _li nk(i), i=1,ran_ n ote ) calltry_c_f(temp,0 10 ) doi =1,ran_n o te calli _pos(ha rd _ lin k(i), ma x_ not e_sep(i) ,oc ta ve) enddo ca lltry_c_f(octa v e ,011) cal llinked_not e ( 7,'OFFSET',6 ,c _ f ,oct av e) callt ry_c _f(oct a ve,012) read(c_ f , *,iostat=temp) $(buf fer(i),i=1, ra n_ note) calltry_c _f ( tem p,013) callli nked_ no t e(7,'DEBUG' ,5 ,c_f,octave) calltry _c_f( o ct ave,014) if (c _f(1:1).ne.'T'.and. c_ f(1:1).ne.'t'.and . $c_f (1: 1) .ne.'F'.and.c_f(1:1).ne.'f') $calltry_c _f(1 ,0 1 5) err or_handle r=(c _f(1:1).e q.'T'.or.c_ f( 1 :1 ).eq.'t') i f(error_han dler )t hen cal llink ed_note(7 ,'DEBUG_FILE',10 ,rep e at, octa v e) ca l lt ry_ c _f(o ctave ,016) op e n(un it=10,file=repea t ,status='unknown' , $iostat= t emp) c alltry_c_f(temp,0 17) endif calllinked_note (7,'COST_FRET_STRING',16 , c_f , $octav e) calltr y_c_f (o ctave,0 1 8) read(c _f,*, iostat=tem p) $(tunin g(i),i=1,ran_not e) ca lltr y_c _f(te m p,019 ) callnchar(7 ,'DEL_FRET_SCALE' ,1 4 ,quotes,octave) ca lltry_c_f(octave,020) call nchar(7,'MAX_NOTE_SEP', 12,cos t _sam e_string,o ct a ve ) callt ry_c_ f(octave , 021) c allnc har( 7,'ULT_COST',8,record,octave) c al ltry_c_ f (octave,022 ) callnc h ar ( 7 , 'COST_SAME_STRING', 1 6 ,in extp,oc ta ve) ca lltry_ c_f( octave,023) callnc har( 7 ,'TAU_SUST' ,8,offse t,octave) ca lltr y_c_f(octave, 024 ) c al lnchar(7,'TAU_HAND' ,8,extra_l ink,octav e) callt ry _c_ f(octave,025) cal lnchar(7,'TEMP_FAC',8 ,ma x_ ba r,oc tave) calltry_ c _f ( octave,02 6) callnch ar(7 ,'TEMP_START',10,max_fret, octa ve) c a lltry_ c _f ( oc tave,027 ) callmax_no te(7 ,'N_STEP',6,areadfil2,octav e) cal lt r y_c_ f ( o ctave,028) callmax _note (7,'N_LOOP',6, s ta rt_hard, octave) calltr y_c_f(oct a ve ,029 ) callma x _n ote(7,'N_RED',5 ,error_poi nt,octav e) calltry_ c_f (o ctave,0 30) c al lm ax_n o te (7,'N_NO_RED' ,8,m a x_str ing,o c tave) c a l l try_c_f(oc tave ,031) call linked_note (7 ,'MUSIC',5, c_f ,octave) c alltry _c_f(oc tave, 032) dodel_ t im e=1,i var k(del_time)=0 enddo don _ not e=1 , t ry_ string i_ try(n_n ot e) =0 endd o temp=0 i_ octave =.f alse. n_step=.f al s e. va l id_str i n g =.false . de l_ t im e=0 i _ n ote=0 n_ no te =1 inext=0. dowhile (temp . eq.0) r e a d (7 ,6,iostat=te mp)c_f 6 for mat(a120 ) if (temp.gt.0)callt ry_c_ f(temp,033) if (temp. e q.0) th en l e n=har d (c_f ) mus ic _no t e=.f alse . length=1 i _ note= i_note+1 dow hi le(l ength. le. l en) if( music_note ) t h en le n g th=l en gth+1 elseif(i_o ctave )the n if (c_ f( l en gth: length) .e q.'"') i_octave=.fa lse. le ngth= length+ 1 e lsei f (c_f ( l e ngt h:l ength ).e q.'!'.and . $.not.i_o c t ave)then mu sic _ n ote =.tr u e. le n gth=len gth+1 elseif( c_f (len gth :le ng th). eq. '_'.o r. $c_f( length:le ngt h).eq .'^' )th en le ngth =length+1 dow hile (c_f(l e n gth:len gth). e q .'_'.or . $c_f (length: len gth ). eq .'^') l ength= leng th +1 enddo if (c _f (length :l engt h ).eq.'"') i _o ctave=.true. le ngth=length+1 elseif(c_f (len gth:lengt h ).eq.':')then if (.no t. n_st ep)th en i _ se m ito ne=n_n ote n_ step=. true. else i_t r y( n_note-1)=i_semitone i_try(i_sem iton e) =n_note-1 n_step=.fal se . endi f l engt h =length+1 el seif( c_f (len gth:length).eq . '(')t hen if( val i d_stri n g )calltry_c_f( 1, 0 34) va lid_st ri ng =.true . i_fret=.true. le n g th=length+ 1 e ls eif(c_f(length:length).eq .')' ) t h en if (. no t.vali d_s tring )ca lltry_ c_f( 1, 035) valid_string=.f alse. k ( del_ tim e)= cos t_fr et_str ing k(cost _fr et_s tring)=del _time len gt h=le ngth +1 elseif(c _ f(len gth:le ng th ).e q.'/') then l e n gth=leng th +1 i_s emito ne_open= 0 dow hil e(i_ s em itone_op en.lt. 2) i f( i c har( c_f(l ength:length)). ge.48.and . $ichar ( c _f(length:lengt h)). le .5 7) then i_semitone_ope n = i_ sem itone_ope n+1 l enchar(i_s emit one_open: i_ semitone_o pen)=c _f(len gth : $length) en dif length=l e ng th+ 1 e nd do r ea d (lenc h ar, 2,iosta t=t emp)i os 2 f ormat (i2) calltr y_c_ f(temp,036) if(.n ot .max_link)t hen if (n_ n ote.e q .1)the n b uff(n_note)=in ext e lse buf f(n_ n ote) =bu ff(n_no te - 1)+inext end i f n_ note =n_note+1 i next =0. endif in ext=in e xt+ 1./float(ios) elseif(c _f(le n gth :lengt h).e q.'r'.o r. $c_f( length:len gth).eq.'R') t h e n max _link= . tr u e . del_ t ime=de l_time+1 found (del_time)=i _note char(del_time)= l ength rread fil2(d el_time)= 0 doi=1 ,ra n_note n_po s(i ,del_ time)=0 en d do cle ngt h ( del_time)=0 posit ion(del_tim e )=0 len gt h= l en gt h+3 el s eif((ic har (c_f (length:le n gth)). ge .6 5.a nd. $ichar(c_ f(leng th:le ngth)) .le.7 1).or. $(i char(c_ f(le ng th :length)).ge.97.a nd. $ich a r(c_f(len gth : len gth ) ).l e.103))then max_link=.false. del_ti me =del _ ti m e+1 foun d( del_time)= i_n ote cha r(del_ ti me ) =le n g th ca llne w_ st rin g(c _f( l eng th:length+ 2), $new,ran_no te,hard_lin k,b u ffer , $res t, f re t_note, $octa v e) ca lltry_c _f(oc tave,03 7) n_link= fret _ note r re adfil2(del_tim e)= 0 clen gth(del_ time)=0 doi=1, ran_no t e n_pos(i ,del_time)=ne w( i) if( ne w (i) .ge. 0 )the n clen gth(de l_ time) =clength(del_time )+ 1 if(n_link .gt.new(i))t h en n_ li nk= new (i) rr ead f il2 (de l_ t ime )=i end if endif e nddo pos itio n( del_ time)=n _note i f (i _f re t)th e n cost_fret_string=del _ti me i _ fret=.false. e ndif len g th=length +3 else l eng th = length+1 e nd i f enddo end if end do outpu t_fil e=del_time de bug_file=n_ no te- 1 buff(de bug_file+1)=buff( deb ug_fi l e) +inext dodel_ti me=1,output_fi le if( k(d el_tim e). ne.0 )t hen if (rr eadfil2(d el _time).ne.r re adfi l2 ( k( del_ ti m e)))then if(max_note _ s ep( rre adfil 2(d el_time)). lt . $m ax_ note_s ep (rr eadfi l2(k(de l_time ) )))t h en rr eadfil2(k(del_time))=rrea dfi l2(de l_time) else rreadfil 2 (del_time ) =rrea dfil2( k(del_ time)) endi f en dif endif e nddo start _ h a rd =start_ h ard* o utput _ fi le er ror_poi nt= e rror_poin t*output_ file max_stri ng=max_string *ou t p ut_file da te=0 . filter=0 don_ loop=1,a rea dfi l 2 del_f ret _ scale =max _f re t*(max_bar** (n_lo op-1)) d_c _f=0 doiff=1,st ar t_hard vers ion=.true. d o whil e(versi on ) n_ va lid_string= int (mz(semi2fre t ) *flo a t(outpu t_ file))+1 if(n_valid_stri ng.lt.1) n_ valid_strin g=1 if(n_val id_ s tr i ng.gt. o utput_file)n_valid_string=output_file version=(clengt h(n _val id_str ing).eq.0 .or. $clength(n_ valid_ string).eq . 1 ) enddo ii=.false. dow h ile (.not. ii) debug=int(mz(s emi2fr e t)*float ( r an_note))+1 if(debug.lt.1)debug=1 if( debug.g t.ra n_ not e)deb u g=ran_note i i=.not.(debug.eq.rr e adfil 2(n_valid_strin g)) if (ii )the n c alli_ step(n_valid_string,output_f ile , $n_pos,r read fil2,posit i on,k, $bu ff , i_try , $tau_sust, $d_c_ f_to t, $rest,iva r,t r y_string,ir eadfil2, $debu g , $t _s_de n, $ii, $tuning, $qu otes,cost_sam e_ s tring, $record, $in ext p,o ffset,e x tra_ link , $octave) callt ry_ c_f(oc tave,038) if( ii.a nd.k( n_ v alid_st ri ng).ne.0) then calli_st e p(k (n _ va lid_s t ring),o utput_f i l e, $n_pos,rreadfil 2,po sition,k, $buff, i _ t r y, $tau_ sust , $d_ c_f_tot, $re st, ivar,try_st rin g,ireadfil2, $d ebug, $i _c har, $ii, $tu ni ng, $quo tes ,cos t_same_strin g , $record, $inextp,o ffset, extra _l ink , $octa ve) ca lltry_c_f( oct a ve,039) t_s_den=t _s_ den+i_ch ar e n dif i f(ii)then if( t _ s_ den.l t. 0.)then tau _hand= .tr ue. el seif( mz(semi2fret) .lt.exp(- t_ s_den/de l_ fret_scale $))t hen tau_hand= . t rue. el se tau_ha nd=.false. en dif if (tau _h and)then rr eadf il2(n_ valid _st ring)=debug if(k ( n _ val id_ str ing).ne. 0) $r rea dfil2 (k( n _valid_ s tring))=debu g da te=date+t _ s _den d_ c_f =d_c_ f + 1 f i lter =0 else d_c_f=0 filter=filte r+1 endif end i f end i f en ddo if( error_ h an dler)then if((iff/1 0) *10.eq . iff)then write( 10 ,11)n _ loop,iff ,date 11 format ('Step ',i 5 ,' loop ' ,i5,' cost function ',f1 0. 1) en di f endif if (d _c_ f.eq.er r or_ poi nt)goto 9 if(fil t er.eq.max_string)goto10 enddo 9 continue e nddo 10 continu e rewin d(u n it=7 ) c_f(1:1)=' ' dowhi le( c_f(1:6 ).n e.'MUSIC ') read (7 ,4,iostat=t emp)c_ f 4 fo r mat(a12 0) cal lt r y_c_f(tem p, 040) if(c_f( 1:17).e q.'# The music: ' )then write(8 ,5 )'# The tablature:' el s eif(c_ f (1: 6) .e q.'MUSIC ')the n write(8, 5)'TABLATURE' else le n=ha rd(c _f) write( 8,5 )c_f(1 :l e n) 5 form a t( a) en dif end do temp= 0 i_n ote=0 de l _ti me=1 dowhi le(t emp. eq. 0 ) r ead (7,4 ,io stat=tem p)c_f i f ( temp.gt.0)calltry_c _f(t em p,041 ) if (temp .eq.0)th en i_ n ote=i_ not e+1 do while(found(d el_t ime) .eq.i_not e) if( rreadf il2 (del_ti me).ne.0) t hen wri t e (c_ f(char(de l_tim e):char(del _t im e) +2),3) $rre adfil2(del_ time ),n_ po s(r readfil 2(del _time ),del_time ) 3 for mat(i1,i2.2) else wr i t e(c_f(cha r(del_time):ch ar(del_time)+ 2),3) $0, 0 endif d el _time=del _time+ 1 enddo len=ha rd(c _f ) write(8,5)c_f( 1: le n) e n dif e nddo writ e(6 ,8) 8 for m at(/' MusicTab terminated successfully'/) stop end subroutinenew_ s tring(de l_fr et, new ,ran_note,hard_link,buffer, $res t,fr et _not e,octave) i mp licitnone integer*4res t i n t e ger*4 new( rest),buf fer( res t) in teger*4ra n _note,f re t _note inte ge r*4o cta ve character* 3h a rd _ l ink(rest) char acter*3del_fr et integer *4mk if( r a n_note.gt.re st)th en oc t av e=1 r etu r n endif c alli_pos(del_ fre t,mk,oc ta ve) if(o ctave.ne .0 )the n octav e=10+oc tave endif calli_ n o_red(mk ,new,ran_n ote ,hard_lin k,b uffe r, $r est,fret _ n ote ,octave) if(o ctave .ne.0) then o ct ave=20+o ctave e ndif ret urn end sub rou ti nei_pos(d el_ f r et,mk,octa ve) implicitnone intege r*4mk in te ger* 4o ctav e c haract er*3d el _f re t integ er*4strin g (7) inte ger* 4de l_ time,n_red,lo o p intege r *4tem p datastring /9, 11,0,2,4,5,7/ del _time=icha r(del_ f ret(1:1 ))-64 if(del_tim e.gt.7)del_ ti me=del_t i m e-32 if(d el_t ime.lt.1.or.del _ time .gt .7)t hen oct a ve=1 retur n endi f read(del_fr et(2 :2 ),2,iost a t =temp) n_red 2 f orm at(i1 ) i f( te m p .ne.0) the n octa ve =2 return endif if( del_fret(3:3). eq. 'n'.or.de l_fret(3:3 ).eq.'N')t he n l o op=0 els eif(del _ fret( 3:3).e q.'f' .or.del_fret(3 :3).eq.'F')then lo o p=-1 e ls eif(de l_f re t ( 3: 3).eq.'s'.or.del_fret(3:3). eq .'S')then loop= 1 el se octa ve=3 ret u rn end if mk=s tri n g (d el_ t ime )+n _ red*1 2+lo o p octave=0 retur n end su brou tinei_ no_red(m k,n ew,ran _n ot e,har d_l ink, buf fer, $rest, f r et_note ,oct ave) im p licitnon e integer*4 rest intege r*4 new(r est),buffer(rest) i nt eg er* 4mk,ran_n ote,fret_note i nteg er*4 o ct ave c harac te r* 3h a rd_link(rest) integer *4i, d el_cost_fn if(mk.lt.0)then octave =1 return endif doi=1,ra n_note calli_pos( ha rd_ l ink(i),del_c ost_f n,octave) if (o cta ve.ne.0)then o ctav e=10 +octave ret urn endif n ew( i)= mk-del _co st _fn+buffer( i) i f(ne w( i).eq .buffer (i) )t hen new(i ) =0 else if(new(i).l t. buff er (i))then n ew( i)=- 1 else if(ne w ( i).gt .fr et_ note)then new(i)=- 2 endif enddo o ct ave=0 return end s ub routinei_step(del_ time,output_file, $n_ po s,rre adfil2 ,position, k, $buff, i _try, $tau _sus t, $d _c _f_tot, $rest,ivar , try_string,iread fil2, $repeat_pos ition, $i_char, $ii , $tu ni ng , $quotes,cos t_ same_string, $re cord, $i n extp,of fset ,e xtr a _link, $octave) imp li citnone in teger* 4res t,ivar,try_ s t r ing,irea d fil2 r eal*4buf f( try_ string),tuning(re st) real *4i_char real *4quo tes,cost_sa me_ s tring real* 4 reco rd,ine xtp,offset,extra_ link in te ger*4n_po s(rest,ivar ),rreadf il2(iv ar ) intege r* 4p osition(iva r),k(ivar) i nt e ger*4i _ try(try_str in g) int eg er * 4 tau_su st (ir ea dfil2) inte ger*4del_time,output_fi l e i n tege r*4repeat _ po sitio n i nte ge r* 4 o ct ave lo gical d_ c_ f_to t( iva r ) logi ca li i real*4i_note _dum(2) real*4n_ s tring real* 4max _pos int ege r*4 i _lo op(2 ),anot ( 2) integer* 4inpu t_file,try_ fret,z zzz,a var logica lversi on if(pos iti on( d el_ time).eq . 0 )then o c tave=1 re turn endif i_l oop(1)=rreadfil2(del_time ) ano t( 1)=n_p os(rrea df il2(de l_t i m e) ,del _tim e) if(anot(1). lt.0) t hen octave=2 r eturn en dif i _loop (2)=repe a t_posi ti o n an ot(2)=n_pos(re p eat_posi tion,de l_time ) if( a n ot(2). lt.0)then ii=.fal se. octa ve=0 retu rn el se i i= .true. endif dozz zz=1,ou t put_f i l e d_c_f_tot(zz z z)=.false. enddo d_c_f_ tot(del _ti me) =.true. input_fil e=0 z z zz=del_ tim e v ersion= .true. do wh i l e (version ) if(position(z zzz).n e.0.and. $.not .d_c_f_to t(zz zz)) t hen input_file=input_f ile+1 tau_sus t(i n p ut _ fil e)=zzzz d_c_f_t ot( zzzz)=.true . e ndif zzz z=zzzz-1 versi on =zzz z .ge.1. and. $(pos it ion( zzz z).eq.0.or . $position(zzzz).ge.p osit i on(d el_ time)-1). and. $(k(zzzz) .eq.0.or. $k ( zzzz).le. zz zz) enddo zzzz =del_t ime version =.t rue . dowhile (ve rsi on) if(p o si ti o n (zzzz). ne.0.a nd . $.not.d_c_ f _tot(zzzz))then inpu t_f ile=i nput _ fil e+1 tau_sust (i n put_file)=z zzz d_c _f_tot(zzzz) =.true. endif zzzz=zzzz+ 1 ve rsion=z z zz.le.ou tput _file.a nd . $(po si t io n( zzzz).e q.0 .or. $posit io n(zzz z).l e.positi o n(del_time)+1).and. $(k(z zzz) . eq .0. or. $k( zzzz) .ge.z z z z) enddo i f (i _try( po sition (del _time )) . ne.0)the n zzzz=1 dowhile(posi ti on(zzzz) $.ne.i_tr y( posit ion(d el_time)) ) zzzz=z zzz+1 enddo d o while(posi tio n (zzzz) $.e q . i_try(positio n(d e l_time))) if (.no t . d_c _f_tot(zz zz))t hen in put_file=input_f ile+1 ta u _s ust ( i nput_file)= zzzz d_c _f_to t( z zzz)=.tru e . zzzz =zzzz+ 1 en dif end do endif try_fret=input_fi le d o ava r= 1,2 i _note_dum(avar) = 0. i_n ote_d u m( avar ) =tuni ng(i_ l oo p(av ar)) $*float( anot ( av a r)) doin put_file=1 ,try_fret n_string= buff (p os i t i on(tau_sust(in put_fi le))) $-buff(p osition(del_t ime) ) if( abs(n_strin g).gt. cos t _same _string)then i f(n_st ring.gt .0.) then n_string =b uff(p o sit ion(tau _ s us t (in put_f il e))) $- bu ff(pos ition(tau_s us t(i nput_fi l e))+1 ) else n_stri ng=buff(p osition (del_time)+1) $- buff(p osition(de l_time) ) endi f endi f n _string=abs(n_ s trin g) if(i_ loo p(avar).eq.rr e ad f il2( tau _sust(inp ut_file ) ))then if(pos itio n(t au_s u st (input_f ile) ).eq.position (del_ time)) $then i_no te_d um(avar)=i_note_ dum (avar )+re co r d el se i_not e_ dum (ava r)= $i_ note_d um(a var) $+in e xtp *ex p(-n_str in g /of f s et) endif endif if(n_pos(rr e ad fi l2(ta u_s ust(in p ut _fi l e)), $ta u _s ust(input_ file)).ne.0)then max_ p os= 2* *(-n_pos( rre ad fil2 ( tau_ sust ( input_f ile)) , $tau _su st(input_fil e) ) /1 2 . ) $-2**(-anot(ava r)/12 .) max _pos=a bs(max_ pos) *qu ote s i_note_ d um(ava r)=i _note_d um(avar) $+ (max _ p os**2)*ex p(-n_ stri ng/e xtr a_ lin k ) el se max_p os=999 en d if en d do enddo i _char=i_no te_dum(2)- i_n ote_dum( 1) oc t ave=0 retur n end su brou tineli n ked _n ote(mj,i_s_or _f, music2fret, nin,octav e) implicit n one i nteger*4 mj,mu sic2fret ,oct ave c h ara cter*(*)i_s_o r_ f character*120nin inte ger*4temp log icalfret chara ct er*1 60mu sic2 semi r ewi nd (mj) te mp=0 fre t=.false . dowh i le(t e mp.e q.0. a nd ..not.fret) rea d(mj ,1 ,iostat =temp)music 2 se m i 1 for mat(a1 60) if(mus ic2se mi(1:music2 fret ).eq.i _s _ or _f.and. $music2semi(m usic2 fret+1:music2fret +1).eq.' ' )then nin(1:120)=music2 s emi( music2 fret +2:mus i c2 f ret+121) f ret= .true. en dif enddo if(tem p .eq.0)then octave =0 els e octave= 1 en dif end su brou ti ne tr y _c_f (oct ave, i_ re d) impl i citnon e integer*4oc tave ,i_re d if(octave.ne . 0) then write(6,1 ) o ct ave,i _red 1 format (/' ifail returned as ',i5, ' at error point ',i5, $' ..... program terminated' /) s top endif ret urn end subrouti n em ax_ note(mj,i_s_o r_f ,musi c2f r et,mbig,octave) impl icitnone inte ge r *4 mj, musi c 2fre t, mbig, octave ch aracter* (* ) i _ s_or_f i n tege r*4t em p log icalfre t chara c ter*80music2 sem i rewind (mj) temp=0 fret=.fal s e. do while(temp.eq.0.and..not. fr et) read( mj,1,iostat=temp )music2semi 1 f orm a t(a80) if(m u s ic2se mi(1: m usic 2fret ).eq.i_s_or _f. an d. $music2 se m i(mus ic2fret + 1:music2fr et+1). eq.' ' ) then re ad(music2s e mi ( music2fret+2:80), * ,iostat=t e mp)mbig fret =.t r u e. e ndif enddo i f( te mp.eq.0)the n octave =0 el se oct ave= 1 endif end integerfunc tion hard(i_rec) im plicitn one c ha r acte r*( *) i _rec integer*4fac,if ail fac=len( i_rec) doi f ai l= fac ,1,-1 if(i_r ec(ifai l:ifa il). ne.' ') g oto1 e nddo h ar d=0 r eturn 1 har d= ifai l r eturn end rea l*4 functio nmz (s emi2fre t ) im plic it no ne inte ger*4semi2f re t real* 4i_hard _note integer * 4i_l i nk,semi_t uni ng, mseed parameter(i_link=10000000 00, semi_tuning= 161 803398,mseed= 0 , $i_har d_not e=1. e-9) int eger*4idum (55) integer *4ma,i_strin g,time_prev,itot,temp_start,ifail,ran_string, $max_ ch ar datama/0/ s avei_s t ring,time_ prev,idum,ma if( s emi2 fre t .lt.0.or. m a.eq.0)t hen ma=1 ito t=se mi_t u ni ng -iabs(s e mi2f ret) itot=mod( i tot,i_l ink ) idum (55)=i tot temp_sta rt=1 do11ifai l=1,54 ran_st ring=mod (2 1*ifail ,55 ) i dum(ra n_s t r in g)= temp_star t temp _ s ta rt =itot-temp_sta rt if(temp_st art. l t. msee d)t em p_start= temp_start+i_link i tot=idu m(ran_s tring ) 11 conti nu e do13max_char=1, 4 d o 1 2ifail=1,55 idum(ifa i l) =idum (ifail)-i dum(1+mo d(i fail+30 ,55)) if(idum(if ai l ).lt.mseed)idum(ifail ) = idum(ifai l)+ i_link 12 co nt inue 13 c ontinue i_s tring = 0 t im e_prev= 31 s e mi2fret=1 endif i_ string= i_s tr ing+1 if (i _str ing.eq.56)i_stri ng= 1 time_ pr ev=tim e_prev + 1 if(t i m e_pr ev. eq.56)time_ prev=1 i tot =id um(i _ s t ring)- id um (ti m e_prev) if(itot.lt.ms ee d) i to t = itot+i_ l ink idum(i_stri ng)=itot mz=it o t*i_h ar d_n ote return end su b rout inenchar ( m j,i_ s_o r_f,m usic2fret,t ime,octave ) imp lici t n o ne rea l*4time in teger*4mj ,m usi c2fre t,o c tave character*( *) i_s_or _f i n teger*4temp l o gical fret ch ar acter*80mu sic2 semi re wind(mj) te mp=0 fret= . fal se. do while(temp.eq .0. and..n ot.fret ) read( mj, 1 ,iosta t=t e mp)mus ic2s em i 1 fo rmat(a80) if(mu sic2s e mi(1:music2f r et).eq. i_s_or_f .and. $music2semi(music2fre t+1:music2f ret+1).e q.' ')then r ea d(music2se mi(music2fret+ 2:80) ,* , ios t at= tem p)t ime fret=.t rue. en dif e nddo if(temp .eq .0)then octave= 0 else oc ta v e=1 endif end