c------------------------------------------------------------------------------ c c FZERO - Zero order frequency scale for traced and spliced spectra c from scanned bitmaps c c Simple linear transformation of the x axis is made on the basis c of two points supplied in file .FPT c c C Version 20a.XI.2008 ----- 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 PRELIMINARIES: c c 1/ extract traces from bitmap(s) with TRACE c 2/ for multipage spectra splice traces from successive pages with SPLICE c 3/ measure two selected, widely spaced known lines in either of the traced c spectra c 4/ Place the two position,frequency points in file GENERIC.FPT c c c------------------------------------------------------------------------------ C C Modification history: C c 20.11.08: creation c c------------------------------------------------------------------------------ c Files in use: c c C 2-channel mode: 1-channel mode: C c INPUT: c c generic_a.xy trace A with x axis in pixels | generic.xy c generic_b.xy trace B with x axis in pixels | c generic.fpt | generic.fpt c | c OUTPUT: | c | c generic_a.spe trace A with frequency x axis | generic.spe c generic_b.spe trace B with frequency x axis | c c C Program tries to read in 1-chanel mode and if that is not successful C will change to two channel mode. c C c------------------------------------------------------------------------------ c USE DFLIB c implicit real*8 (a-h,o-z) implicit integer*4 (i-n) parameter (maxpt=50000) character*100 fgen,line,fila,filb,fouta,foutb,filfpt,filcur, * fil,fout real*8 xa(maxpt),ya(maxpt) real*8 xb(maxpt),yb(maxpt) real*8 xsa(maxpt),ysa(maxpt),xsb(maxpt),ysb(maxpt) c common /plot/xcent,xwid,ycent,ywid,yshift,xcut c WRITE(*,3344) 3344 FORMAT(1X//' ',76(1H_)/' |',T79,'|'/ * ' | F Z E R O - Zero order frequency scale for spectra', * ' extracted',T79,'|'/ * ' | with TRACE+SPLICE from bitmaps', * T79,'|'/ * ' |',76(1H_),'|'/' version 20a.XI.2008',T64,'Zbigniew KISIEL'/) c c c...generic name for files c 100 write(*,101) 101 format(1x//' Generic name to be used for input/output files: ',$) read(*,'(a)')fgen c c...Data input C fil=fgen(1:len_trim(fgen))//'.xy' fout=fgen(1:len_trim(fgen))//'.spe' fila=fgen(1:len_trim(fgen))//'_A.xy' filb=fgen(1:len_trim(fgen))//'_B.xy' filfpt=fgen(1:len_trim(fgen))//'.fpt' fouta=fgen(1:len_trim(fgen))//'_A.spe' foutb=fgen(1:len_trim(fgen))//'_B.spe' c c...read the two points from the .FPT file c filcur=filfpt open(1,file=filfpt,err=50,status='OLD') 27 read(1,'(a)')line if(line(1:1).eq.'!')goto 27 read(line,*)x1,f1 read(1,'(a)')line read(line,*)x2,f2 25 format(2f20.5) close(1) c c...read the traces c write(*,'(1x)') filcur=fila na=0 nptsa=0 c c...one or two channel input c nchan=1 open(1,file=fil(1:len_trim(fil)),status='old',err=55) fila=fil fouta=fout nptsb=0 goto 1 c 55 open(1,file=fila(1:len_trim(fila)),status='old',err=50) nchan=2 c 1 read(1,'(a)',err=50,end=2)line if(line(1:1).eq.'!')goto 1 read(line,*,err=50)i,r nptsa=nptsa+1 xa(nptsa)=i ya(nptsa)=r goto 1 2 close(1) write(*,3)nptsa,fila(1:len_trim(fila)) 3 format(i6,' points read from ',a) if(nchan.eq.1)goto 56 c filcur=filb nb=0 nptsb=0 open(1,file=filb(1:len_trim(filb)),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 nptsb=nptsb+1 xb(nptsb)=i yb(nptsb)=r goto 4 5 close(1) write(*,3)nptsb,filb(1:len_trim(filb)) c c...output rescaled traces (reversing the frequency axis if found to increase c from right to left) c 56 write(*,12)x1,f1,x2,f2 12 format(1x/' Frequency axis assignment points:',T35,f10.1,f12.3/ * ,T35,f10.1,f12.3) grad=(f2-f1)/(x2-x1) write(*,10)grad 10 format(1x/' X-axis dispersion (MHz/pixel) = ',f12.5) c write(*,'(1x)') filcur=fouta open(1,file=fouta(1:len_trim(fouta)),status='unknown',err=50) write(1,11)fila(1:len_trim(fila)),grad 11 format('! Approximate frequency axis added to ',a/'!'/ * '! X-axis dispersion (MHz/pixel) = ',f12.5/'!') c if(grad.gt.0.d0)then do 7 n=1,nptsa freq=f1+(xa(n)-x1)*grad write(1,9)freq,ya(n) 7 continue else do 17 n=nptsa,1,-1 freq=f1+(xa(n)-x1)*grad write(1,9)freq,ya(n) 17 continue endif 9 format(f15.5,f12.3) close(1) write(*,6)nptsa,fouta(1:len_trim(fouta)) 6 format(i6,' points written to ',a) if(nchan.eq.1)stop c filcur=foutb open(1,file=foutb(1:len_trim(foutb)),status='unknown',err=50) write(1,11)filb(1:len_trim(filb)) if(grad.gt.0.d0)then do 8 n=1,nptsb freq=f1+(xb(n)-x1)*grad write(1,9)freq,yb(n) 8 continue else do 18 n=nptsb,1,-1 freq=f1+(xb(n)-x1)*grad write(1,9)freq,yb(n) 18 continue endif close(1) write(*,6)nptsb,foutb(1:len_trim(foutb)) c c stop c 50 write(*,'(1x//'' ***** ERROR: problem reading '',a//)') * filcur(1:len_trim(filcur)) stop end c c----------------------------------------------------------------------------- c-----------------------------------------------------------------------------