C____________________________________________________________________________ C C CIS - Converter of an Igor Pro wave to an SVIEW spectrum C____________________________________________________________________________ C C C The wave is to be saved in IGOR PRO using the IGOR TEXT output format. C C The program converts it to a spectrum readable with SVIEW C by using the information contained in the last line of the file, which C comes after the END line concluding the data point values, C C When the wave contains uniformly spaced points for which the spacing C has been defined using the SetScale operation then this line reads like C C X SetScale/P x 110127.990661473,0.0880637911,"", .... C C For a wave from an XY pair this line will be in the form C C X SetScale/P x 0,1,"", dn_abs; SetScale y 0,0,"", dn_abs C C C Ver 5.VIII.2004 ----- Zbigniew Kisiel ----- 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 USE DFLIB C PARAMETER (MAXPTS=15000000) C character filnam*50,line*100,linex*100 CHARACTER*72 COMENT CHARACTER*6 LAMP,SCANSP CHARACTER*20 SAMPLE real*8 fstart,fincr,fend COMMON /FLIMIT/FSTART,FEND,FINCR COMMON /YSPEC/Y(MAXPTS),YMIN,YMAX,NPTS COMMON /INFOC/COMENT,SAMPLE,LAMP,SCANSP c WRITE(*,3344) 3344 FORMAT(1X//' ',76(1H_)/' |',T79,'|'/ * ' | C I S - Converter of an Igor Pro wave to an SVIEW', * T79,'|'/ * ' | spectrum', * T79,'|'/ * ' |',76(1H_),'|'/' version 5.VIII.2004',T64,'Zbigniew KISIEL'/) write(*,1910)maxpts 1910 format(' For up to',i10,' points'/) C C...Open the wave file and locate beginning of wave C 503 WRITE(*,'(1X//5x, * ''Name of the IGOR wave file (saved as IGOR text): ''\)') READ(*,'(A)',ERR=503)FILNAM OPEN(3,FILE=FILNAM,err=503) c c read(3,1,err=530,end=530)LINE 1 format(a) if(line(1:4).ne.'IGOR')then write(*,2)LINE 2 format(1x//' The first line of the file is:'/1x,a// * ' thus the file does not appear to be IGOR TEXT output, which'/ * ' should begin with the word IGOR'//) stop endif C 3 read(3,1,err=530,end=530)LINE if(line(1:5).eq.'WAVES')then sample=line(7:) lamp='FASSST' coment='Converted from '//line(7:) endif if(line(1:5).ne.'BEGIN')goto 3 C C...Main input loop for the wave C npts=0 ymax=1.E-20 ymin=1.E+20 C write(*,'(1x//'' Currently on point:''/)') 4 read(3,1,err=530,end=530)LINE if(line(1:3).ne.'END')then npts=npts+1 read(line,*,err=532)yy y(npts)=yy if(yy.lt.ymin)ymin=yy if(yy.gt.ymax)ymax=yy nn=npts/200000 if(nn*200000.eq.npts)write(*,'(1H+,i10,$)')npts goto 4 endif C write(*,5)npts 5 format(//1x,i8,' points have been read'//) C C...read incrementation information for the X axis C read(3,1,err=533,end=533)LINE close(3) c if(line(11:12).ne.'/P')then call BEEPQQ(4000,500) write(*,7) 7 format(' SORRY - the converter will only recognise X scaling ', * 'using the P flag,'/ * ' that is the final line in the data file should read: ', * 'X SetScale/P ...'//) stop endif c linex=line(16:) read(linex,*,err=533)fstart,fincr fend=fstart+(npts-1)*fincr write(*,6)fstart,fend,fincr 6 format(' First point = ',f20.10/ * ' Last point = ',f20.10/ * ' Point spacing = ',f20.10/) c write(*,8)ymin,ymax 8 format(' minimum Y = ',f20.10/ * ' maximum Y = ',f20.10/) C C...output C call savesp goto 530 C C C...Miscellaneous error conditions C 532 write(*,10)npts,line(1:72) 10 format(1x//' ERROR - failure to read the value of point',I10, * ' from:'//1x,a//) stop C 533 write(11) 11 format(1x// *' ERROR - failure to read the X scaling line for the wave'//) stop C C 530 stop end C C_____________________________________________________________________________ C SUBROUTINE SAVESP C C This routine saves the recorded data into a file in FREQLIN type binary C format which consists of header, INTEGER*2 intensities, and frequency C limits and increment. C C File format byte by byte: C C COMENT character*72 C IDAY,IMON,IYEAR 3 * integer*2 C IHOUR,IMIN,ISEC 3 * integer*2 C LAMP character*6 C VKMST,VKMEND 2 * real*4 C GRID real*4 C SAMPLE character*20 C SAMPRE real*4 C GAIN,TIMEC,PHASE 3 * real*4 C SCANSP character*6 not used in FREQLIN standard C PPS real*4 =PPS+500 in FREQLIN standard C FRMOD,FRAMPL 2 * real*4 C then either: C NPTS integer*2 C ISMALL,ILARGE 2 * integer*2 these are I*4 internally C or C -1 integer*2 C NPTS integer*4 C ISPEC NPTS * integer*2 this is I*4 internally C FSTART,FEND,FINCR 3 * real*8 point f's determined by FSTART and FINCR C NCALPT integer*2 =0 ensuring backwards compatibility C C USE DFLIB C IMPLICIT INTEGER*2 (I-N) IMPLICIT REAL*4 (A-H,O-Z) INTEGER*4 MAXPTS,NPTS,N integer*2 ISPEC PARAMETER (MAXPTS=15000000) C COMMON /FLIMIT/FSTART,FEND,FINCR COMMON /FNAM/FILOLD COMMON /YSPEC/Y(MAXPTS),YMIN,YMAX,NPTS COMMON /INFOC/COMENT,SAMPLE,LAMP,SCANSP COMMON /INFO/IDAY,IMON,IYEAR,IHOUR,IMIN,ISEC, 1 VKMST,VKMEND,GRID,SAMPRE,GAIN,TIMEC,PHASE, 1 PPS,FRMOD,FRAMPL c REAL*8 FSTART,FEND,FINCR CHARACTER FILOLD*50,CHARFL,STAT*7,filgen*50,filout*60,outstr*20 CHARACTER*72 COMENT CHARACTER*6 LAMP,SCANSP CHARACTER*20 SAMPLE CHARACTER dates*8,times*10 C C...preliminaries C c ISMALL=-10000 ILARGE=10000 PPS=51. SCANSP=' ' c 51 write(*,50) 50 format(1x/' Specify file name for output'/ * ' (without the path) .... ',$) read(*,'(a)',err=51)filout C call date_and_time(dates,times) read(dates(1:4),'(i4)')iyear read(dates(5:6),'(i2)')imon read(dates(7:8),'(i2)')iday read(times(1:2),'(i2)')ihour read(times(3:4),'(i2)')imin read(times(5:6),'(i2)')isec C 22 stat='NEW' 26 OPEN(3,FILE=FILOUT,STATUS=STAT,FORM='BINARY',ERR=21) WRITE(3)COMENT,IDAY,IMON,IYEAR,IHOUR,IMIN,ISEC, 1 LAMP,VKMST,VKMEND,GRID,SAMPLE,SAMPRE,GAIN,TIMEC,PHASE, 1 SCANSP,PPS,FRMOD,FRAMPL C C...Intensities of spectral data points - centre intensity on zero C ymean=(ymax+ymin)/2.0 scale=60000./(ymax-ymin) c if(npts.le.32000)then WRITE(3)int2(NPTS),int2(scale*(ymin-ymean)), * int2(scale*(ymax-ymean)) else WRITE(3)int2(-1),npts endif write(*,'(1x/)') DO 20 N=1,NPTS if((n/100000)*100000.eq.n)then write(*,'(1h+,''.'',$)') endif ISPEC=int2(scale*(y(n)-ymean)) WRITE(3)ISPEC 20 CONTINUE C C...Frequency limits and increment (MHz) C ncalpt=0 WRITE(3)FSTART,FEND,FINCR,ncalpt C CLOSE(3) write(*,'(1x//5x,''Output has been written to '',a)') * filout(1:len_trim(filout)) GOTO 23 c 21 WRITE(*,'(1X/'' THIS FILE ALREADY EXISTS, OVERWRITE (Y/N)? '' * ,$)') READ(*,1300,ERR=21)CHARFL IF(CHARFL.EQ.'Y'.OR.CHARFL.EQ.'y')THEN STAT='UNKNOWN' GOTO 26 ENDIF IF(CHARFL.EQ.'N'.OR.CHARFL.EQ.'n')THEN 27 WRITE(*,'('' New file name: '',$)') READ(*,1300,ERR=27)filout 1300 FORMAT(A) GOTO 22 ENDIF C 23 RETURN END C C_____________________________________________________________________________ C_____________________________________________________________________________