c------------------------------------------------------------------------------ c c SPLICE - Splicing of traces extracted with TRACE from bitmaps c of scanned spectra c c C Version 17b.I.2009 ----- Zbigniew KISIEL ----- C C __________________________________________________ C | Institute of Physics, Polish Academy of Sciences | C | Al.Lotnikow 32/46, Warszawa, POLAND | C | kisiel@ifpan.edu.pl | C | http://info.ifpan.edu.pl/~kisiel/prospe.htm | C_________________________/-------------------------------------------------- C c USAGE: c c 1. Fill out SPLICE.INP for splicing together two partially overlapped c spectra obtained with TRACE c c 2. Run SPLICE c c 3. Open with QGLE the file SPLICE.GLE c c 4. Adjust splicing parameters as necessary and the results of each step c will be visible in QGLE c c c------------------------------------------------------------------------------ C C Modification history: C c 21.11.08: adapted from TRACE c 17.01.09: one or two traces, updating of the .INP file c c------------------------------------------------------------------------------ c USE DFLIB c implicit real*8 (a-h,o-z) implicit integer*4 (i-n) parameter (maxpt=50000) character*100 fil1,fil2,fil1a,fil1b,fil2a,fil2b,line,filcur,fout real*8 x1a(maxpt),y1a(maxpt),x1b(maxpt),y1b(maxpt),yadd real*8 x2a(maxpt),y2a(maxpt),x2b(maxpt),y2b(maxpt) c common /plot/xcent,xwid,ycent,ywid,yshift,xcut c WRITE(*,3344) 3344 FORMAT(1X//' ',76(1H_)/' |',T79,'|'/ * ' | S P L I C E - Splicing of traces extracted with TRACE', * T79,'|'/ * ' | from bitmpas of scanned spectra', * T79,'|'/ * ' |',76(1H_),'|'/' version 17b.I.2009',T64,'Zbigniew KISIEL'/) c c c...read the steering file SPLICE.INP c filcur='splice.inp' open(1,file='splice.inp',err=50,status='OLD') 27 read(1,'(a)')line if(line(1:1).eq.'!')goto 27 read(line,26)ntracs read(1,'(a)')line read(line,25)fil1 read(1,'(a)')line read(line,25)fil2 read(1,'(a)')line read(line,25)fout 25 format(43x,a) 26 format(43x,3i4) c c...check if display parameteras are available, and if so then read them in c setting INPPAR to 1 c inppar=0 read(1,'(a)')line if(line(1:1).ne.'!')goto 28 read(1,'(a)')line if(line(1:20).ne.'! Splicing options')goto 28 read(1,'(a)')line if(line(1:1).ne.'!')goto 28 c read(1,'(a)')line read(line,26,err=28)ival xcent=ival c read(1,'(a)')line read(line,26,err=28)ival xwid=ival c read(1,'(a)')line read(line,26,err=28)ival ycent=ival c read(1,'(a)')line read(line,26,err=28)ival ywid=ival c read(1,'(a)')line read(line,26,err=28)ival yshift=ival c read(1,'(a)')line if(line(1:1).ne.'!')goto 28 c read(1,'(a)')line read(line,26,err=28)ival ioverl=ival c read(1,'(a)')line read(line,26,err=28)ival xcut=ival c read(1,'(a)')line read(line,26,err=28)ival yadd=ival c inppar=1 28 close(1) c c c...Data input C if(ntracs.eq.1)then fil1a=fil1(1:len_trim(fil1))//'.xy' fil2a=fil2(1:len_trim(fil2))//'.xy' else fil1a=fil1(1:len_trim(fil1))//'_A.xy' fil1b=fil1(1:len_trim(fil1))//'_B.xy' fil2a=fil2(1:len_trim(fil2))//'_A.xy' fil2b=fil2(1:len_trim(fil2))//'_B.xy' endif c c...first spectrum for splicing c filcur=fil1a npts1a=0 open(1,file=fil1a(1:len_trim(fil1a)),status='old',err=50) 1 read(1,'(a)',err=50,end=2)line if(line(1:1).eq.'!')goto 1 read(line,*,err=50)i,r npts1a=npts1a+1 x1a(npts1a)=i y1a(npts1a)=r goto 1 2 close(1) write(*,3)npts1a,fil1a(1:len_trim(fil1a)) 3 format(i6,' points read from ',a) c if(ntracs.eq.2)then filcur=fil1b npts1b=0 open(1,file=fil1b(1:len_trim(fil1b)),status='old',err=50) 4 read(1,'(a)',err=50,end=5)line if(line(1:1).eq.'!')goto 4 read(line,*,err=50)i,r npts1b=npts1b+1 x1b(npts1b)=i y1b(npts1b)=r goto 4 5 close(1) write(*,3)npts1b,fil1b(1:len_trim(fil1b)) endif c c...second spectrum for splicing c filcur=fil2a npts2a=0 open(1,file=fil2a(1:len_trim(fil2a)),status='old',err=50) 6 read(1,'(a)',err=50,end=7)line if(line(1:1).eq.'!')goto 6 read(line,*,err=50)i,r npts2a=npts2a+1 x2a(npts2a)=i y2a(npts2a)=r goto 6 7 close(1) write(*,3)npts2a,fil2a(1:len_trim(fil2a)) c if(ntracs.eq.2)then filcur=fil2b npts2b=0 open(1,file=fil2b(1:len_trim(fil2b)),status='old',err=50) 8 read(1,'(a)',err=50,end=9)line if(line(1:1).eq.'!')goto 8 read(line,*,err=50)i,r npts2b=npts2b+1 x2b(npts2b)=i y2b(npts2b)=r goto 8 9 close(1) write(*,3)npts2b,fil2b(1:len_trim(fil2b)) endif c c c...write menu with current splicing parameters c if(inppar.ne.1)then ioverl=100 xcent=x1a(npts1a)-0.5d0*real(ioverl) xwid=600.d0 ycent=0.3d0*ywid ywid=1000.0 yshift=100.d0 xshift=x1a(npts1a)-real(ioverl) xcut=x1a(npts1a)-0.5d0*real(ioverl) yadd=0.d0 else xshift=x1a(npts1a)-real(ioverl) endif c icontr=-1 goto 23 c 20 fsys=systemqq('cls') write(*,21)int(xcent),int(xwid),int(ycent),int(ywid), * int(yshift),ioverl,int(xcut),int(yadd) 21 format(1x/5x,'O P T I O N S (to be selected by option,value):'/// * 15x,'0 = exit+output'// * 15x,'1 = x-axis centre for plot', t57,i6/ * 15x,'2 = x-axis width for plot', t57,i6/ * 15x,'3 = y-axis centre for plot', t57,i6/ * 15x,'4 = y-axis width for plot', t57,i6/ * 15x,'5 = y-axis shift for second trace',t57,i6// * 15x,'6 = x-axis overlap width', t57,i6/ * 15x,'7 = splicing point', t57,i6/ * 15x,'8 = y-axis shift for red trace', t57,i6// * 11x,' .... ',$) read(*,'(2i7)',err=20)icontr,ival if(icontr.lt.0.or.icontr.gt.8)goto 20 if(icontr.eq.0)goto 23 if(icontr.eq.1.or.icontr.eq.2.or.icontr.eq.4.or.icontr.eq.6. * or.icontr.eq.7)then if(ival.le.0)goto 20 endif c if(icontr.eq.1)then xcent=ival goto 23 endif c if(icontr.eq.2)then xwid=ival goto 23 endif c if(icontr.eq.3)then ycent=ival goto 23 endif c if(icontr.eq.4)then ywid=ival goto 23 endif c if(icontr.eq.5)then yshift=ival goto 23 endif c if(icontr.eq.6)then ioverl=ival xshift=x1a(npts1a)-real(ioverl) goto 23 endif c if(icontr.eq.7)then xcut=ival goto 23 endif c if(icontr.eq.8)then yadd=ival goto 23 endif c c...write the gle plotting data: c c only new data files for the second (xshifted) segment are generated, c those of the first are reused c c 23 open(2,file='splice_2a.xy') do 10 n=1,npts2a ixx=x2a(n)+xshift write(2,12)ixx,y2a(n)+yadd 10 continue close(2) 12 format(i6,f12.3) c if(ntracs.eq.2)then open(2,file='splice_2b.xy') do 11 n=1,npts2b ixx=x2b(n)+xshift write(2,12)ixx,y2b(n)+yshift+yadd 11 continue close(2) endif c c...preview current splicing c call wrigle(fil1a,fil1b,ntracs) <----- if(icontr.ne.0)goto 20 c c...output spliced spectrum c if(ntracs.eq.1)then open(3,file=fout(1:len_trim(fout))//'.xy',status='unknown') else open(3,file=fout(1:len_trim(fout))//'_a.xy',status='unknown') endif c write(*,'(1x/ * '' Output written to: '',a)')fout(1:len_trim(fout))//'_a.xy' write(3,37)fil1a(1:len_trim(fil1a)), * fil2a(1:len_trim(fil2a)),ioverl,int(xcut) 37 format('! Spliced from ',a,' and ',a/'!'/ * '! overlap length =',i6/ * '! cutoff point =',i6/'!') c do 31 n=1,npts1a if(x1a(n).ge.xcut)goto 32 write(3,12)int(x1a(n)),y1a(n) 31 continue 32 do 33 n=1,npts2a xx=x2a(n)+xshift if(xx.lt.xcut)goto 33 write(3,12)int(xx),y2a(n)+yadd 33 continue close(3) c if(ntracs.eq.2)then open(3,file=fout(1:len_trim(fout))//'_b.xy',status='unknown') write(*,'( * '' Output written to: '',a)')fout(1:len_trim(fout))//'_b.xy' write(3,37)fil1b(1:len_trim(fil1b)), * fil2b(1:len_trim(fil2b)),ioverl,int(xcut) do 34 n=1,npts1b if(x1b(n).ge.xcut)goto 35 write(3,12)int(x1b(n)),y1b(n) 34 continue 35 do 36 n=1,npts2b xx=x2b(n)+xshift if(xx.lt.xcut)goto 36 write(3,12)int(xx),y2b(n)+yadd 36 continue close(3) endif write(*,'(1x//)') c c...Update splicing parameters in SPLICE.INP c fsys=systemqq('copy splice.inp splice_tmp.inp') open(2,file='splice.inp',status='unknown') open(3,file='splice_tmp.inp',status='old') c 60 read(3,'(a)')line write(2,'(a)')line(1:len_trim(line)) if(line(1:2).ne.'!_')goto 60 do 61 n=1,4 read(3,'(a)')line write(2,'(a)')line(1:len_trim(line)) 61 continue read(3,'(a)')line c if(line(1:2).eq.'!_')then write(2,66) 66 format('!'/'! Splicing options'/'!') write(2,62)int(xcent),int(xwid),int(ycent),int(ywid), * int(yshift),ioverl,int(xcut),int(yadd) write(2,'(a)')line(1:len_trim(line)) goto 63 endif c write(2,'(a)')line(1:len_trim(line)) read(3,'(a)')line write(2,'(a)')line(1:len_trim(line)) read(3,'(a)')line write(2,'(a)')line(1:len_trim(line)) do 65 n=1,9 read(3,'(a)')line 65 continue c write(2,62)int(xcent),int(xwid),int(ycent),int(ywid), * int(yshift),ioverl,int(xcut),int(yadd) 62 format( * ' x-axis centre for plot', t42,i6/ * ' x-axis width for plot', t42,i6/ * ' y-axis centre for plot', t42,i6/ * ' y-axis width for plot', t42,i6/ * ' y-axis shift for second trace',t42,i6/'!'/ * ' x-axis overlap width', t42,i6/ * ' splicing point', t42,i6/ * ' y-axis shift for red trace', t42,i6) c 63 read(3,'(a)',end=64)line write(2,'(a)')line(1:len_trim(line)) goto 63 c 64 close(2) close(3) fsys=systemqq('del splice_tmp.inp') c stop c 50 write(*,'(1x//'' ***** ERROR: problem reading '',a//)') * filcur(1:len_trim(filcur)) stop end c c c----------------------------------------------------------------------------- c subroutine wrigle(fila,filb,ntracs) c implicit integer*4 (i-n) implicit real*8 (a-h,o-z) c character*100 fila,filb character ysh*12,xct*12 c common /plot/xcent,xwid,ycent,ywid,yshift,xcut c write(ysh,'(f12.1)')yshift 1 if(ysh(1:1).eq.' ')then ysh=ysh(2:len_trim(ysh)) goto 1 endif c write(xct,'(f12.1)')xcut 2 if(xct(1:1).eq.' ')then xct=xct(2:len_trim(xct)) goto 2 endif c open(1,file='splice.gle',status='unknown') c write(1,'(a)')'size 29.5 21.0' write(1,'(a)')' ' write(1,'(a)')'lwd=0.04' write(1,'(a)')'set lwidth lwd' write(1,'(a)')'set join round' write(1,'(2a)')'yshift=',ysh write(1,'(2a)')'xcut=',xct write(1,'(a)')' ' write(1,'(a)')'amove -1.5 1.5' write(1,'(a)')'begin graph' write(1,'(a)')' nobox' write(1,'(a)')' size 35 21' write(1,'(2a)')' xtitle "\it x\rm\ pixel" hei 0.8 dist 0.4 ', * 'font texcmr' xmin=xcent-0.5d0*xwid xmax=xcent+0.5d0*xwid write(1,'(a,f12.2,a,f12.2,a)')' xaxis min ',xmin, * ' max ',xmax,' dticks 100 dsubticks 10' write(1,'(a)')' xticks length 0.3' write(1,'(a)')' xsubticks length 0.1' write(1,'(a)')' xlabels hei 0.6 ' write(1,'(a)')'! ' ymin=ycent-0.5d0*ywid ymax=ycent+0.5d0*ywid write(1,'(a,f14.2,a,f14.2)')' yaxis min ',ymin, * ' max ',ymax write(1,'(a)')' yticks length 0.3' write(1,'(a)')' ysubticks length 0.1' write(1,'(a)')' ylabels hei 0.6' write(1,'(2a)')' ytitle "\it y\rm\ pixel" hei 0.8 ', * 'dist .4 font texcmr' write(1,'(a)')'! ' write(1,'(3a)')' data ',fila(1:len_trim(fila)),' d1=c1,c2' write(1,'(a)')' d1 lstyle 1 lwidth lwd color black' write(1,'(a)')' ' c if(ntracs.eq.2)then write(1,'(3a)')' data ',filb(1:len_trim(filb)),' d2=c1,c2' c write(1,'(a)')' let d3=d2+yshift' write(1,'(a)')' d3 lstyle 1 lwidth lwd color black' write(1,'(a)')' ' endif c write(1,'(a)')' data splice_2A.xy d5=c1,c2' write(1,'(a)')' d5 lstyle 1 lwidth lwd color red' write(1,'(a)')' ' c if(ntracs.eq.2)then write(1,'(a)')' data splice_2B.xy d7=c1,c2' write(1,'(a)')' d7 lstyle 1 lwidth lwd color red' write(1,'(a)')' ' endif c write(1,'(2a)')' let d10=(-1000+200000*(x-xcut)) from ', * 'xcut to xcut+0.01 step 0.001' write(1,'(a)')' d10 lstyle 1 color blue' c write(1,'(a)')' ' write(1,'(a)')'end graph' c close(1) c return end c c----------------------------------------------------------------------------- c-----------------------------------------------------------------------------