C----------------------------------------------------------------------------- c c C A T F I L - To filter a .CAT file according to a combination of user c specified options c C----------------------------------------------------------------------------- c C Input and output file names as well as filtering options are to be C declared in the input file. Originally this had the compulsory C name LINFIL.INP, but it is now possible to use a user chosen name, but C maintaining the .INP extension is recommended. C C You can use the CATFIL.INP file from the website as a template and note C that all text in the first 41 columns is arbitraty and is only C used for commenting. C C As many filtering options as necessary are allowed, and are to be C specified in the form: C C INDFIL, VALMIN, VALMAX where: C C INDFIL = filtering index, with legal values of: C C NQ,IA,IB only retain lines with values of quantum number NQ C from IA to IB (NQ can be from 1 to 12) C NQ+100,IA only retain lines with change IA for quantum C numbers NQ-6 <- NQ (thus NQ has to be greater than 6) C 200,IA only retain lines with Ka+Kc=J (IA=0) C Ka+Kc=J+1 (IA=1) C using only lower level quantum numbers (NQ=7,8,9) C 300,NQ,IA change the value of quantum number NQ to IA C 400,NQ1,NQ2 reject lines with value IA of quantum number NQA C AND value IB of quantum number NQB C specified by NQ1=1000*IA+NQA C NQ2=1000*IB+NQB C 999,STR Append the string STR to the end of the first line C in the output file C C -1,A,B only retain lines with frequencies between A and B C -2,A,B only retain lines with errors between A and B C -3,A,B only retain lines with intensity between A and B C -4,A,B convert frequencies from MHz to cm-1 and limit to those C between A and B (both in cm-1) C C 0 termination of filtering declarations C C Filtering operations are carried out on the fly on each line in turn and C are in the order of increasing absolute value of the filtering parameter. C C Output files: C C 1. Lines satisfying the filtering criteria are written to the file C declared in the input file c 2. Lines do not satisfying the filtering criteria are written to CATFIL_CUT.OUT C 3. Lines producing an input error are written to CATFIL_REJECTED.OUT C C C Version 6.VI.2022 ----- 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 C Modification history: C C 11.01.13: hacked out of LINFIL C 20.01.15: more filtering options C 12.08.15: 200 filtering option C 6.11.16: debugging and commenting C 10.02.22: option 400 C 6.06.22: debugging + clarified instructions C C=========================================================================== c c implicit real*8 (a-h,o-z) parameter (maxrul=100,clight=29979.2458d0) c real*8 valmin(maxrul),valmax(maxrul) integer indfil(maxrul),nqn(12) integer nqa(maxrul),nva(maxrul),nqb(maxrul),nvb(maxrul) character L(80),line*80,filin*50,filout*50,descr*25,filinp*30 character linqns*40,coment*100,descr1*100 EQUIVALENCE (L(1),LINE) c WRITE(*,3344) 3344 FORMAT(1X//' ',76('_')/' |',T79,'|'/ * ' | CATFIL - Filtering of .CAT files from Herb ', * 'Pickett''s ',T79,'|'/ * ' | SPFIT program ',T79,'|'/ * ' |',76('_'),'|'/' version 6.VI.2022',T64,'Zbigniew KISIEL'/) c c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c write(*,3345) 3345 format(1x// * ' In .INT file use entries INDFIL, VALMIN, VALMAX', * ' starting'/ * ' from 42nd column, such that:'// * ' NQ,IA,IB only retain lines with values of quantum number', * ' NQ '/ * ' from IA to IB (NQ can be from 1 to 12)'/ * ' NQ+100,IA only retain lines with change IA for quantum'/ * ' numbers NQ-6 <- NQ (thus NQ has to be greater ', * 'than 6)'/ * ' 200,IA only retain lines with Ka+Kc=J (IA=0)'/ * ' Ka+Kc=J+1 (IA=1)'/ * ' using only lower level quantum numbers ', * '(NQ=7,8,9)'/ * ' 300,NQ,IA change the value of quantum number NQ to IA'/ * ' 400,NQ1,NQ2 reject lines with value IA of quantum number NQA'/ * ' AND value IB of quantum number NQB'/ * ' with NQ1=1000*IA+NQA and NQ2=1000*IB+NQB'/ * ' 999,STR Append the string STR to the end of the first ', * 'line'/ * ' in the output file'// * ' -1,A,B only retain lines with freqs between A and B'/ * ' -2,A,B only retain lines with errors between A and B'/ * ' -3,A,B only retain lines with logint between A and B'/ * ' -4,A,B convert frequencies from MHz to cm-1 and limit ', * 'to those'/ * ' between A and B (both in cm-1)'// * ' 0,,, termination of filtering declarations') c c...Process the CATFIL.INP configuration file and read in all declared c modification rules c write(*,'(1x//'' Name of the .INP file: '',$)') read(*,'(a)')filinp open(2,file=filinp(1:len_trim(filinp)),status='old',err=100) c 33 read(2,'(a)')line if(line(1:1).eq.'!')goto 33 read(line(42:),'(a)',err=2,end=2)filin open(3,file=filin,err=3,status='old') c 34 read(2,'(a)')line if(line(1:1).eq.'!')goto 34 read(line(42:),'(a)',err=4,end=4)filout open(4,file=filout,err=5,status='unknown') open(7,file='catfil_cut.out',status='unknown') open(8,file='catfil_rejected.out',status='unknown') c c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c c...Process specifications of filtering conditions c ncond=0 icoment=0 35 read(2,'(a)',err=6,end=6)line if(line(1:1).eq.'!')goto 35 read(line(42:),*)nfilt c if(nfilt.ne.0)then c c...error trapping c if(nfilt.gt.12)then if((nfilt-100.ge.7.and.nfilt-100.le.12) * .or.nfilt.eq.200 * .or.nfilt.eq.300 * .or.nfilt.eq.400 * .or.nfilt.eq.999)goto 700 goto 7 endif if(nfilt.lt.-4)goto 7 c 700 ncond=ncond+1 indfil(ncond)=nfilt c c...-ve nfilt c if(nfilt.lt.0)then ! filter f,df,logint read(line(42:),*,err=7)nfilt,vmin,vmax ! convert+filter MHz to cm-1 valmin(ncond)=vmin valmax(ncond)=vmax endif c c...+ve nfilt c if(nfilt.gt.0.and.nfilt.lt.999)then if(nfilt.ge.1.and.nfilt.le.12)then ! filter QN read(line(42:),*,err=7)nfilt,imin,imax endif c if(nfilt.gt.100.and.nfilt.lt.300)then ! change value of QN read(line(42:),*,err=7)nfilt,imin valmin(ncond)=imin else if(nfilt.eq.300)read(line(42:),*,err=7)nfilt,imin,imax ! change NQ c if(nfilt.eq.400)then ! filter NQ1 AND NQ2 read(line(42:),*,err=7)nfilt,nq1,nq2 na=nq1/1000 nvala=nq1-na*1000 nb=nq2/1000 nvalb=nq2-nb*1000 nqa(ncond)=na nva(ncond)=nvala nqb(ncond)=nb nvb(ncond)=nvalb endif endif c vmin=imin vmax=imax indfil(ncond)=nfilt valmin(ncond)=imin valmax(ncond)=imax endif c c...nfilt=999 c if(nfilt.eq.999)then icoment=1 read(line(46:),'(a)')coment endif goto 35 endif c c c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c c...summarise the declared filtering conditions c write(*,36) 36 format(1x//' Filtering conditions as specified on input:'/) do 39 n=1,ncond if(indfil(n).eq.-1)descr='Retain '//' Frequency: ' if(indfil(n).eq.-2)descr='Retain '//' Error: ' if(indfil(n).eq.-3)descr='Retain '//' Intensity: ' if(indfil(n).eq.-4)descr='Convert'//' MHz->cm-1+limit: ' c if(indfil(n).ge.1.and.indfil(n).le.12)write(descr,38)indfil(n) 38 format( 'Retain ', ' Q.num.',i3,': ') c if(indfil(n).ge.107.and.indfil(n).le.112)then write(descr,138)indfil(n)-100 write(*,37)descr,valmin(n) 138 format( 'Retain ', ' Delta Q.num.',i3,': ') goto 39 endif c if(indfil(n).eq.200)then if(valmin(n).eq.0)write(*,'(a)')' Retain '// * ' Sum condition: 0 ------> Ka" + Kc" = J" ' if(valmin(n).eq.1)write(*,'(a)')' Retain '// * ' Sum condition: 1 ------> Ka" + Kc" = J+1"' goto 39 endif c if(indfil(n).eq.300)then write(descr,139)nint(valmin(n)) 139 format( 'Change ','value Q.num. ',i3,': ') write(*,37)descr,valmax(n) goto 39 endif c if(indfil(n).eq.400)then write(descr1,140)nqa(n),nva(n),nqb(n),nvb(n) 140 format( 'Filter out QN',i5,'=',i3,' AND ', * i5,'=',i3) endif C if(indfil(n).eq.999)then write(*,'(1x,a)')'Append 1st line with: '// * coment(1:len_trim(coment)) endif c if(indfil(n).lt.400)then write(*,37)descr,valmin(n),valmax(n) else write(*,'(1x,a)')descr1(1:len_trim(descr1)) endif 37 format(1x,a,3f15.6) 39 continue c close(2) write(*,'(1x)') c c c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c Main loop over the .CAT file c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c c...Read the .CAT file and process lines on the fly: c column alignment as below c c For MHz: c c ,....1....,....2....,....3....,....4....,....5....,....6....,....7....,....8 c 36796.3472999.9999 -5.7855 3 5.5803 3 410011304 2 1 0 1 . . 1 1 0 0 . . c 5295.7066 .0020 -9.4551 3 .2300 2 0 314 2 1 2 1 1 1 1 1 c 173704.3589 0.0107 -4.4768 2 95.6330 69 0 10134 33 c c For cm-1: C c 625.1499170.000006 -7.9118 3 50.9678 33 114041615 1 1 16 9 8 0 c c also test for and reject dud .CAT lines of the type: c c 57333.7433 0.0000 8.0158 3-5443.2581259 01404C9A624 0 C8A623 0 c 260873.6684 0.0000 19.8112 3-10514.3347255 01404C7A918 0 C8A919 0 c 0.0001 0.0000733.5315 3-361938.4449402 01404A06932 1 A06931 1 c 0.0001 0.00002376.1171 3-1150379.1691386 014049690 7 0 9690 6 0 c7948295.3988999.9999 21.9024 3-9827.1872398 01404992376 1 A02377 1 c c nlines=0 linout=0 lincut=0 nrej=0 c 45 read(3,'(a)',end=46,err=8)line c if(L(9).eq.'.'.and.L(17).eq.'.'.and.L(26).eq.'.'.and. * nclin.ge.69)then nrej=nrej+1 write(8,'(a)')line(1:len_trim(line)) goto 45 endif c if( (L(9).eq.'.'.and.L(17).eq.'.'.and.L(25).eq.'.') .or. /MHz * (L(7).eq.'.'.and.L(15).eq.'.'.and.L(25).eq.'.') )then /cm-1 c call check(line,linqns,nmaxq) read(linqns,'(12i3)',err=80)nqn read(line(1:13),'(f13.4)',err=81)freq read(line(14:21),'(f8.4)',err=82)error read(line(22:29),'(f8.4)',err=82)sint nlines=nlines+1 c c c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c Subsidiary loop for each .CAT line: test it against all of the declared c filtering conditions c Each condition is tested in the form that rejects incompatible lines c The line that survives these tests is only written out after this loop c do 50 n=1,ncond c c...reject according to frequency range c if(indfil(n).eq.-1)then if(freq.lt.valmin(n).or.freq.gt.valmax(n))then lincut=lincut+1 write(7,'(a)')line(1:len_trim(line)) ! echo rejected) goto 45 endif endif c c...reject according to error c if(indfil(n).eq.-2)then if(error.lt.valmin(n).or.error.gt.valmax(n))then lincut=lincut+1 write(7,'(a)')line(1:len_trim(line)) ! echo rejected goto 45 endif endif c c...reject according to intensity c if(indfil(n).eq.-3)then if(sint.lt.valmin(n).or.sint.gt.valmax(n))then lincut=lincut+1 write(7,'(a)')line(1:len_trim(line)) ! echo rejected goto 45 endif endif c c...reject according to value of selected quantum number c if(indfil(n).ge.1.and.indfil(n).le.12)then if(nqn(indfil(n)).lt.int(valmin(n)).or. * nqn(indfil(n)).gt.int(valmax(n)))then lincut=lincut+1 write(7,'(a)')line(1:len_trim(line)) ! echo rejected goto 45 endif endif c c...reject according to selection rule on selected quantum number c if(indfil(n).ge.106.and.indfil(n).le.112)then numqnl=indfil(n)-100 numqnu=numqnl-6 if(nqn(numqnu)-nqn(numqnl).ne.valmin(n))then lincut=lincut+1 write(7,'(a)')line(1:len_trim(line)) ! echo rejected goto 45 endif endif c...reject according to sum condition of Ka+Kc for the lower state c if(indfil(n).eq.200)then ia=valmin(n) nqcond=nqn(8)+nqn(9)-nqn(7) if(nqcond.ne.ia)then lincut=lincut+1 write(7,'(a)')line(1:len_trim(line)) ! echo rejected goto 45 endif endif c c...convert MHz to cm-1 and filter c if(indfil(n).eq.-4)then freq=freq/clight error=error/clight write(line(1:21),'(f13.6,f8.6)')freq,error if(freq.lt.valmin(n).or.freq.gt.valmax(n))then lincut=lincut+1 write(7,'(a)')line(1:len_trim(line)) ! echo rejected goto 45 endif endif c c...modify quantum number value to a specified fixed value (no filtering) c if(indfil(n).eq.300)then numqn=valmin(n) newval=valmax(n) indxlin=55+2*numqn write(line(indxlin-1:indxlin),'(i2)')newval endif c c...exclude lines with specified values of two different quantum numbers c if(indfil(n).eq.400)then if( nqn(nqa(n)).eq.nva(n) .and. * nqn(nqb(n)).eq.nvb(n) )then lincut=lincut+1 write(7,'(a)')line(1:len_trim(line)) ! echo rejected goto 45 endif endif c 50 continue c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c c..write out the line if it wasn't cut out by the various filtering conditions c linout=linout+1 if(linout.eq.1.and.icoment.eq.1)then write(4,'(a)') * line//coment(1:len_trim(coment)) else write(4,'(a)')line endif c goto 45 endif c nrej=nrej+1 write(8,'(a)')line(1:len_trim(line)) goto 45 c c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c 46 write(*,47)nlines,filin(1:len_trim(filin)) 47 format(1x//1x,i8,' lines read from: ',a/) c write(*,49)linout,filout(1:len_trim(filout)) 49 format( 1x,i8,' retained lines written to: ',a ) c write(*,60)lincut,'catfil_cut.out' 60 format( 1x,i8,' cut lines written to: ',a) c write(*,70)nrej ,'catfil_rejected.out' 70 format( 1x,i8,' rejected lines written to: ',a/) c close(3) close(4) close(7) c stop c c...Error conditions c 80 write(*,'(1x,'' ERROR reading decoded quantum numbers: '',a/ * 1x,a)')linqns,line(1:len_trim(line)) nrej=nrej+1 write(8,'(a)')line(1:len_trim(line)) goto 45 c 81 write(*,'(1x,'' ERROR reading frequency: '',a)')line(1:30) nrej=nrej+1 write(8,'(a)')line(1:len_trim(line)) goto 45 c 82 write(*,'(1x,'' ERROR reading error: '',a)')line(1:30) nrej=nrej+1 write(8,'(a)')line(1:len_trim(line)) goto 45 c 83 write(*,'(1x,'' ERROR reading intensity: '',a)')line(1:30) nrej=nrej+1 write(8,'(a)')line(1:len_trim(line)) goto 45 c 2 write(*,'(1x//''***** ERROR reading name of input file from '', * ''CATFIL.inp''//)') stop c 3 write(*,'(1x//''***** ERROR opening input file: ''a//)') * filin(1:len_trim(filin)) stop c 4 write(*,'(1x//''***** ERROR reading name of output file from '', * ''CATFIL.inp''//)') stop c 5 write(*,'(1x//''***** ERROR opening input file: ''a//)') * filout(1:len_trim(filout)) stop c 6 write(*,'(1x//''***** ERROR reading the filtering definition'', * ''CATFIL.inp''//)') stop c 7 write(*,'(1x//''***** ERROR in filtering definition:''/a//)') * line(1:len_trim(line)) stop c 8 write(*,'(1x//''***** ERROR reading from the .CAT file''//)') stop c 100 write(*,'(1x//'' ERROR: Cannot open the .INP file''//)') stop c end C_____________________________________________________________________________ C_____________________________________________________________________________ C subroutine check(linein,line,nmaxq) c c...Routine to decode two digit coding of quantum numbers used by SPCAT c into standard I3 notation: c c -- two digit negative coded a1 for -11, c b1 for -21 etc., through c i1 for -91 to c z9 for -259, c -- three digit positive coded A0 for 100, c B0 for 110 etc., through c N0 for 240 to c Z9 for 359 c c WARNING: values of K smaller than -99 are decoded as positive c c C LINEIN - .CAT line for checking C LINE - decoded quantum numbers in 12I3 format (six qns of upper state, C followed by six qns of the lower state) C nmaxq - the index of the largest non-zero quantum number (established C on the basis of the upper state) c character linein*80,line*40,cdig c c...transfer two digit quantum numbers from columns 56:79 of LINEIN c to three digit fields in columns 1:36 of LINE c nnn=56 do 1158 n=1,12 nn=(n-1)*3+1 line(nn:nn)=' ' line(nn+1:nn+2)=linein(nnn:nnn+1) nnn=nnn+2 1158 continue c c...Go through each of the twelve quantum numbers in turn, check, and if c necessary convert c nmaxq=0 do 1159 n=1,12 i=(n-1)*3+1 j=i+2 read(line(i:j),'(i3)',err=1)k goto 1160 c 1 read(line(i+1:i+1),'(a)')cdig c if( .not.(cdig.ge.'a'.and.cdig.le.'z') .and. * .not.(cdig.ge.'A'.and.cdig.le.'Z') )then write(*,111)'Quantum number checks failed on:', * i,j,line(i:j),line,linein(1:60),linein(61:79) 111 format(1x//' **** ERROR: ',a// * ' Columns ',I2,':',I3,'-->',a// * ' in buffer line-->',a// * 18x,6(10H....,....I)// * ' original .CAT line:'// * ' Columns 1: 60-->',a/ * ' Columns 61: 79-->',a// * 18x,6(10H....,....I)//) pause stop endif c read(line(j:j),'(i1)')k if(cdig.ge.'a'.and.cdig.le.'z')then ntens=ichar(cdig)-ichar('a')+1 k=-(k+10*ntens) endif if(cdig.ge.'A'.and.cdig.le.'Z')then ntens=ichar(cdig)-ichar('A')+1 k=(k+(9+ntens)*10) endif c if(k.gt.-100)then write(line(i:j),'(i3)')k else write(line(i:j),'(i3)')-k endif c 1160 if(n.le.6.and.k.ne.0)nmaxq=n c 1159 continue c return end C_____________________________________________________________________________ c_____________________________________________________________________________