implicitnone int eger*4i_se mi_du m p aramet er (i _se m i_dum =6) intege r*4mu sic _ not e (i_ semi_dum) i nteger *4m ax _st ri ng,l enchar intege r*4tun i ng,date integ e r*4len,i_di git integer* 4 i_s_or_f,f ilter logicalanot ,i logicalmusi c2sem i character*3c ( i_se mi_dum ) chara ct er *1 2 0oc tave, buffer charac ter*120offs e t ch a racter*3i _octa ve cha ra cte r* 5avar cha racter*8nchar dat aa var /'1.0 '/ dat a n char/'06/03/97'/ write( 6,5)a va r,n ch ar 5 format( /' TabMusic Version ',a5 ,' Creation date: ',a8/) o pen( unit=9,file='.filter',status='old', $i os tat= i_s_or_f ) mus ic2se mi =(i_s_o r _f.eq.0) if(.not.m usic2semi)write(6,8) 8 fo rma t( ' Input name of parameter file:'/ ) read (5,1,i osta t= i_s_or _f)octave 1 forma t(a12 0) c allnin(i_s_or_ f,00 1 ) o pen( unit =7,f ile=o ctave,stat us='old', $io stat=i_ s_or_f) c allnin( i_s_ o r_f,0 0 2 ) c alli_s e m ito ne(7,'OUTPUT_FILE',11,b uf f er ,filter) cal lnin(f ilt er, 003) open(u nit= 8,file=bu ffer,st a tus= 'unknown', $ios ta t= i_ s_ or_f ) callni n(i_s_o r_f,004) callout put_file(7, 'N_STRING',8,max_string,fi lte r) calln i n(f i lt e r, 0 0 5 ) cal li_ semitone (7,'TUNING', 6, off set,filt er) ca l l n in(f ilter ,006) rea d(o f f set,* ,i ostat= i_s_or_f) $(c(lenchar),lenc har=1,max_ string) ca ll nin (i_s_ or_f ,00 7) c alli_semitone(7 ,'OFFSET' , 6 ,offset, filte r) ca llnin(f i lt er , 008) re ad (of f s e t,*,iost at=i_s_or_f) $(mus ic_note(lenchar),lenchar= 1,max_s tr ing ) call nin(i_ s_ or_f,009) rew ind(unit=7) of f set(1:1)=' ' do whi le(offset(1:1 0) .ne.'TABLATURE ') r ead( 7,2 ,iostat=i_ s_or_ f) o f fse t 2 fo rmat(a1 20) callnin(i_s _or_ f,010) if ( offset (1:17 ).eq.'# The tablature: ')then wri t e( 8,3)'# The music:' elsei f(o ffs et(1 :10).eq.'TABLATURE ')t hen write ( 8,3)'MUSIC' else l e n =i _ d igit(offs et) write(8,3 )offs e t(1 : len) 3 f ormat(a) end if en ddo i_ s_or_f=0 anot=.fa ls e . do w hi l e(i_s _or_f.eq .0) r ea d(7,6,ios t at=i _s_or_f )o ffset 6 forma t(a1 20) i f(i_ s_or_ f.gt .0)c alln in(i_s_or_f,0 11) if(i_s_or_ f.eq.0)then le n= i_digit(offse t) i =.f als e. tuni ng=1 dowh ile ( tuning.l e. len) if ( i )then tu ning=tuni ng+1 elseif(ano t) th e n if( o ffset (tuni ng: tun ing).e q.'"')anot =.fal se. tuni n g = tuni ng+1 e ls eif(off set (t uning: tuning) . eq.'!'.and. $.not.an ot)then i= .true. tuning= tuning+1 else if( offset( tuning: tunin g ). e q.'_'.or. $offs et(tunin g:tun in g ) . eq.'^')then tuning =tuning+1 dowh ile(o ff set(tun ing:tuning). e q. '_'.or . $offs et(tuning:tuni ng).eq.'^') tuni ng=tuning+1 enddo if(o ff set (tuning:tuning).e q.'"' )anot =.true. tun ing= tuning+1 el seif ( offs et (tun in g:tuning) .eq. '/')th en tuning=tuning+1 date= 0 dowhile(d ate .lt .2) if( ichar(of f set (tuning:tuning)).ge .4 8.an d. $ichar( o ffset(t uning:t un i ng) ).le. 57 ) $d ate =date+1 t uni ng =tuning+1 e nddo elseif(ich a r (offset( tuning:tuni n g )).ge .4 8 . and. $ic har(off set( tuning : tuning)).le.57 ) t hen callivar(of fset (tuning:tun in g+ 2),i_octave, $ma x_ s tri ng,c,music_n ote,i _s e mi_du m, filter) callnin(filt er,01 2 ) o ffset(tuni ng :tuning+2)=i_octa ve tuning=tuning+3 e lse tun in g=tuning+1 endif enddo write(8,7)off set( 1: l en ) 7 fo rmat(a) en dif e nddo write (6,4) 4 form at ( /' TabMusic terminated successfully' /) stop en d subroutine ivar (e rror_h andle r,i_octav e,max _str i ng, $c,mu s ic _n o te ,i_ s emi_ dum,f ilter) i m plic itnone integer*4i _ semi_dum i nteger*4 m usic_ note(i_semi_dum) i nteger*4max_string integ er*4fil t er c haract er *3c(i_ semi_ du m) chara c ter*3err or_ha ndler,i_oc tave inte ger*4lenchar,com ment inte ger *4asc _ octav e ,buff intege r* 4i _ s_or_f if(max_stri ng.gt.i_semi_dum)then filt er=1 return endif r e ad(e rror_handl er , 1, iostat =i_s_ or_f)len c har,c ommen t 1 for mat(i1,i2) if(i_s_or_f .n e.0)the n filter=2 ret urn endi f if ( l e nc h a r.e q.0)the n i _octa ve='RST' el se ca lltab_note(c(lenc har) , as c_octave ,filter) if( filt er.ne.0)then f ilt e r =3 0+filter re turn endif i f(comment .eq.0)t he n bu ff=0 elseif(comme nt.lt.music_ not e( le ncha r))then filter = 3 r e turn else b uff=comme nt-m usic_note(lench ar) e ndif a sc_oct a ve = as c_octave +buff calli_ note (asc_octave,i_octave ,filt er ) if(f i l t er.ne.0)then filte r=40+ filter r e tu rn endif e ndif filter=0 r eturn end s u br outi n etab_n o te (i_octave ,asc_octav e,filter ) i mplicitn one in teger*4 asc _ oc ta ve in t eg er*4 filt e r char acter * 3i_oc t a v e integer*4i tot( 7) integer *4version,a re adfil 2,e rror_poin t integ er*4i_s _or_f dataitot/9 , 11 ,0,2, 4,5,7/ version=ichar(i_oc t ave (1: 1 ) )-6 4 if(vers ion.gt. 7) ve rs ion= version-3 2 if(ve rsi on.lt .1.or.ver si o n.gt . 7)then f i l ter=1 re tur n e n di f re a d ( i_octav e( 2: 2),2,iostat=i_s_o r_f)a r eadfil 2 2 f o rm at(i1) if(i_s _or_f. ne. 0)then fi lte r=2 return endif if (i_oc tave(3:3).eq. 'n'.or.i _ octa ve (3: 3 ).eq. 'N' )the n err or _po i nt=0 else if(i_octa v e (3:3) .eq.'f'.or.i_ oc tave (3:3). eq. 'F')then e rror_p oint=-1 els e i f (i_o c t ave( 3: 3).eq.'s'.or.i_oc tave(3:3).eq.'S')then error _poi nt= 1 el se f il ter= 3 return en dif a sc_octave=it ot(ver sion) +areadf i l 2*12 + erro r _ p oin t fi lter= 0 re turn end subroutin e i _note(as c_ oct a v e,i _oct a ve,f i lter) im plicitnone in teg er*4 asc _oc ta ve in teg er* 4filte r characte r*3 i_oct av e ch arac ter* 2n_string(12 ) int eger*4 a r eadfil2 ,tab2 m u sic da tan_ string/'CN' ,'CS', 'DN','DS' ,'EN' ,'FN' , $'FS', 'GN' ,'GS','AN','AS' ,'BN'/ i f( asc_octav e. lt .0)then fi lter = 1 return e nd if areadfil2=as c_octave/12 if(areadfil2 .gt. 9)then fil t er=2 return end if ta b2 musi c=asc _oc t av e -ar eadfil 2*1 2+ 1 write (i_octave ,1) n _s tring(tab2music)(1:1 ), $areadfil2 , $n_s tr ing(tab2m usic)(2:2) 1 f or mat(a 1, i1,a 1 ) filter=0 re turn e nd s ubro utinei_semiton e (i_ fre t,i os, f ound,s emi2music,filter) i m plicitnone int eg e r*4i_ fret,f ou nd ,filte r character*(*)io s c haracter*1 20 se mi2music integer*4i_s_or_f lo g i c ali_ de l c haract er* 160i_ str ing rew ind( i_ fret) i_s_or_f=0 i_de l=.fa l s e. do whi le( i_s _or_ f.eq.0 .and..not .i_ del) read(i_fre t,1,i ost at =i_s _or_ f)i_string 1 f ormat (a160) if (i _st ring (1:fo u n d).eq.io s. and. $i _stri ng(found + 1:f oun d+1) . eq .' ')then s emi2mu sic (1 : 1 20)= i_str ing(found+2:fou nd+121) i_ del=.t r u e. endif enddo if( i_s_ or _f .e q.0)then filter=0 el s e fi lte r=1 endif e nd su broutineni n(fi lter,inpu t_ file) impli citnon e integ er* 4 filter,in put_file if( f il ter .n e. 0)t he n write ( 6,1 )filter ,in put_f ile 1 forma t(/' ifail returned as ',i5,' at error point ', i5, $' ..... program terminated' /) stop endif retur n e nd subroutin eoutp ut_ f ile(i _ fret,i os ,found,quotes, filt er) imp lici t none int eger*4i _f r et,found,qu o tes ,fil ter charact er*( *)ios integ er*4i_ s _or _f logicali_del charact er*80 i _st ring re wind (i_fr et ) i_s _or_f=0 i_d el=.false. d o w hile (i_s_o r _f . e q.0.a n d..not .i_del) r ead(i _fret,1,iost at=i_s_or_f)i_string 1 f ormat(a80) if(i_s tring(1:f o und). eq. ios.an d. $i_ str ing(f ound+1: fo u nd+1) .eq . ' ' )then read(i_stri ng(found+2: 8 0), *,i os ta t =i _s _or_f ) quotes i _de l=.t rue. endif e n ddo if( i_ s_ or_ f.eq.0)then filter =0 els e filte r=1 en dif end in tegerfu ncti on i_ digit(i_char) impl ici tno n e characte r*( * )i_ cha r int eger*4ireadfil2,ifail ireadfil2=le n( i_ch a r) d oifail= ir eadfil2,1, -1 i f(i_ch ar(ifa il :i f ail ) . ne.' ' )got o1 en ddo i_d igi t =0 r eturn 1 i_dig it=ifail retur n end