C----------------------------------------------------------------------------- c c L I N F I L - To filter a .LIN 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 LINFIL.INP C C As many filtering options as necessary are allowed, and are (generally) to be C specified in the form: C C INDFIL, [various parameters as necessary] where: C C NQ,IA,IB pass lines with values of quantum number NQ C from IA to IB (NQ can be from 1 to 12) C 100,NQ1,NQ2 filter out 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 -1,A,B pass lines with frequencies between A and B C -2,A,B pass lines with errors between A and B C -3,A,B modify frequency: frequencies of all lines with error A C changed by frequency increment B C -4,A,B modify error: all lines with error A changed to error B C -5,A,B,C modify error: all lines with frequency between A and B are C to be assigned error C C -6,A,B,C modify frequency: all lines with frequency between A and B are C to be changed by frequency increment C C -7,A do not subject lines from 1 to A to any of the filtering C operations so that a block of legacy lines can be kept unchanged C at the top of the .LIN file C C -8,N1,N2,EOLD,ENEW conditional change of error from EOLD to ENEW, with the line C specified by C 1/ selection rule: N1 = 1000000*NQ1 + 1000*NQ2 + (NQ1-NQ2)+10 C 2/ range of qn values: N2 = 1000000*NQ + 1000*NQMIN + NQMAX C Note that ENEW=0.0 specifies that the line is to be filtered out C C -9,N1,N2,N3,EOLD,ENEW conditional change of error from EOLD to ENEW, with the line C specified by: C 1/ selection rule between specified quantum number pair defined C by: C N1 = 1000000*NQ1 + 1000*NQ2 + (NQ1-NQ2)+10 C 2/ two different selected quantum numbers and their values C defined by: C N2 = 100000000*NQ1 + 100000*NV1 + 1000*NQ2 + NV2 C 3/ range of values of additional selected quantum number defined by: C N3 = 1000000*NQ + 1000*NQMIN + NQMAX C Note that ENEW=0.0 specifies that the line is to be filtered out C Example for an asymmetric rotor with a specified v quantum number C (i.e. four quantum numbers per energy level): C 1005000 Q-branch transitions C 800207010 v"=2 and Kc"=10 C 5010050 J" from 10 to 50 C C 555 write output in the format used by AABS (columnwise unification C of formatting) 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 (except for -7 which blocks all operations on the specified top C block of lines). C C If an excluding error in option -5 of greater or equal to 9. has been declared then error C change operation assigns error of 900+C to this line. C C Passed lines are written to the file declared in LINFIL.INP C C C Version 10.V.2023 ----- 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 24.02.07: hacked out of PISLIN c 2.05.10: configuration file and more universality c 19.05.10: frequency and error modification c 8.06.11: options -5,-6 (-6 later changed to -7) c 6.11.17: option 555 c 30.11.18: more option 555 c 10.05.19: debugging output in rare conditions c 26.10.19: retaining very large errors on option -5 c 10.02.22: option 100: cutting lines with specified values of TWO different qns c 14.07.22: option -6 of incrementing frequency of line in a specified frequency range c 8.03.23: option -8 of dual condition error change c 31.03.23: option -9 of quadruple condition error change c 10.05.23: selection rule specification modified for options -8 and -9 C C=========================================================================== c c implicit real*8 (a-h,o-z) parameter (maxrul=100) c real*8 valmin(maxrul),valmax(maxrul),valerr(maxrul), * eold(maxrul),enew(maxrul) integer indfil(maxrul),nqn(12) integer nqa(maxrul),nva(maxrul),nqb(maxrul),nvb(maxrul) integer nquant1(maxrul),nquant2(maxrul),nqdif(maxrul) integer nquant(maxrul),nqmin(maxrul),nqmax(maxrul) character line*1000,filin*50,filout*50,descr*25,lcoment*1000 chara cter errstr*13 iform=0 c WRITE(*,3344) 3344 FORMAT(1X//' ',76('_')/' |',T79,'|'/ * ' | LINFIL - Filtering of .LIN files for Herb ', * 'Pickett''s ',T79,'|'/ * ' | SPFIT program ',T79,'|'/ * ' |',76('_'),'|'/' version 10.V.2023',T64,'Zbigniew KISIEL'/) c c c...Process the LINFIL.INP configuration file and read in all declared c modification rules c open(2,file='linfil.inp',status='old',err=15) c 33 read(2,'(a)')line ! UNIT=2 .INP file if(line(1:1).eq.'!')goto 33 read(line(42:),'(a)',err=2,end=2)filin open(3,file=filin,err=3,status='old') ! UNIT=3 input m.LIN file 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') ! UNIT=4 output .LIN file ! ncond=0 nskip=0 35 read(2,'(a)',err=6,end=6)line if(line(1:1).eq.'!')goto 35 if(len_trim(line).lt.42)goto 35 read(line(42:),*)nfilt c write(*,*)nfilt c c...process filtering condition c if(nfilt.ne.0)then if(nfilt.eq.555)then ! unify .LIN format iform=1 goto 35 endif c if(nfilt.gt.12.and.nfilt.ne.100)goto 7 ! not a legal condition c ncond=ncond+1 c if(nfilt.lt.0)then c c...-ve nfilt if(nfilt.eq.-7)then read(line(42:),*,err=7)nfilt,n if(n.le.0.or.n.gt.20000)goto 7 nskip=n ncond=ncond-1 goto 35 endif c if(nfilt.eq.-8)then read(line(42:),*,err=7)nf,N1,N2,eold(ncond),enew(ncond) na=n1/1000000 ! first QN nb=n1-1000000*na nb=nb/1000 ! second QN nsel=n1-1000000*na-1000*nb ! selection rule nsel=nsel-10 c nqfil=n2/1000000 ! selected QN nlow=n2-nqfil*1000000 nlow=nlow/1000 ! low cutof limit nhigh=n2-1000000*nqfil-nlow*1000 ! high cutoff limit c c write(*,'(1x/2i10,10x,2f12.3)')n1,n2,eold(ncond),enew(ncond) c write(*,'(3i10,10x,3i10/)')na,nb,nsel,nqfil,nlow,nhigh c nquant1(ncond)=na nquant2(ncond)=nb nqdif(ncond)=nsel nquant(ncond)=nqfil nqmin(ncond)=nlow nqmax(ncond)=nhigh c endif c if(nfilt.eq.-9)then read(line(42:),*,err=7)nf,N1,N2,N3,eold(ncond),enew(ncond) na=n1/1000000 ! first QN nb=n1-1000000*na nb=nb/1000 ! second QN nsel=n1-1000000*na-1000*nb ! selection rule nsel=nsel-10 nquant1(ncond)=na nquant2(ncond)=nb nqdif(ncond)=nsel c nqna=n2 /100000000 ! first QN nqva=(n2-nqna* 100000000)/100000 ! value nqnb=(n2-nqna*100000000-nqva*100000)/1000 ! second QN nqvb= n2-nqna*100000000-nqva*100000-nqnb*1000 ! value nqa(ncond)=nqna nva(ncond)=nqva nqb(ncond)=nqnb nvb(ncond)=nqvb c nqfil=n3/1000000 ! selected QN nlow=n3-nqfil*1000000 nlow=nlow/1000 ! low cutof limit nhigh=n3-1000000*nqfil-nlow*1000 ! high cutoff limit nquant(ncond)=nqfil nqmin(ncond)=nlow nqmax(ncond)=nhigh c c write(*,'(3i10)')nquant1(ncond),nquant2(ncond),nqdif(ncond) c write(*,'(4i10)')nqa(ncond),nva(ncond),nqb(ncond),nvb(ncond) c write(*,'(4i10)')nquant(ncond),nqmin(ncond),nqmax(ncond) c endif c if(nfilt.gt.-5)read(line(42:),*,err=7)nfilt,vmin,vmax if(nfilt.eq.-5)read(line(42:),*,err=7)nfilt,vmin,vmax,verr if(nfilt.eq.-6)read(line(42:),*,err=7)nfilt,fmin,fmax,fincr else c c...+ve nfilt read(line(42:),*,err=7)nfilt,nq1,nq2 if(nfilt.eq.100)then 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 vmin=nq1 vmax=nq2 endif c indfil(ncond)=nfilt valmin(ncond)=vmin valmax(ncond)=vmax if(nfilt.eq.-5)valerr(ncond)=verr goto 35 endif c c...summarise declared filtering conditions c write(*,36) 36 format(1x//' Filtering conditions specified in LINFIL.INP:'/) do 39 n=1,ncond c c___prepare the condition output line if(indfil(n).eq.-1)descr= ' Filter frequency: ' if(indfil(n).eq.-2)descr= ' Filter error: ' if(indfil(n).eq.-3)descr= ' Modify frequency: ' if(indfil(n).eq.-4)descr= ' Swap error: ' if(indfil(n).eq.-5)descr= ' Change error: ' if(indfil(n).eq.-6)descr= ' Modify frequency: ' if(indfil(n).eq.-8)descr= '2 condition error change: ' if(indfil(n).eq.-9)descr= '4 condition error change: ' if(indfil(n).eq.100)descr= 'Reject NA=NVA and NB=NVB: ' c if(indfil(n).ge.1.and.indfil(n).le.12)write(descr,38)indfil(n) 38 format( ' Filter Q.num.',i3,': ') c c___write the condition output line if(indfil(n).eq.-5.or.indfil(n).eq.-6.or. * indfil(n).eq.-8.or.indfil(n).eq.-9)then if(indfil(n).eq.-5)write(*,37)descr,valmin(n),valmax(n) if(indfil(n).eq.-6)write(*,37)descr,fmin,fmax,fincr c if(indfil(n).eq.-8)write(*,137) * descr,nquant1(n),nquant2(n),nqdif(n),nquant(n), * nqmin(n),nqmax(n),eold(n),enew(n) c if(indfil(n).eq.-9)write(*,138) * descr,nquant1(n),nquant2(n),nqdif(n), * nqa(n),nva(n),nqb(n),nvb(n), * nquant(n),nqmin(n),nqmax(n),eold(n),enew(n) else write(*,37)descr,valmin(n),valmax(n),valerr(n) endif 37 format(1x,a,3f15.6) 137 format(1x,a,3i3,2x,3i3,2x,2f10.4) 138 format(1x,a,3i3,2x,4i3,2x,3i3,2f10.4) 39 continue c if(nskip.gt.0)then descr=' Ignore the first: ' write(*,'(1x,a,i8,a)')descr,nskip,' lines' endif close(2) if(iform.eq.1)then descr=' use AABS format' write(*,37)descr endif c c c...Read the .LIN file and process lines on the fly: c c63 13 50 2 63 12 51 2 0 0 0 0 1133556.41299 90.10000 1.00000 c64 13 51 2 64 12 52 2 0 0 0 0 1133689.56149 90.10000 1.00000 c c nlines=0 linout=0 lincut=0 modfre=0 moderr=0 45 read(3,'(a)',end=46,err=8)line if(len_trim(line).le.2)goto 46 if(line(3:3).eq.' ')goto 46 c read(line,'(12i3)',err=9,end=9)nqn read(line(37:),*,err=9,end=9)freq,error c c...insert blanks before initially unknown position of the weight field c n=lnblnk(line(37:)) n=n+1 nn=lnblnk(line(n:)) nn=nn+1 line(nn:)=' '//line(nn:) c nlines=nlines+1 if(nlines.le.nskip)goto 51 c c...go through the filtering conditions c if(ncond.eq.0.and.iform.eq.1)goto 51 do 50 n=1,ncond c c...retain lines with frequencies from A to B c if(indfil(n).eq.-1)then if(freq.lt.valmin(n).or.freq.gt.valmax(n))then lincut=lincut+1 goto 45 endif endif c c...retain lines with errors form A to B c if(indfil(n).eq.-2)then if(error.lt.valmin(n).or.error.gt.valmax(n))then lincut=lincut+1 goto 45 endif endif c c...retain lines with values of quantum number NQ between IA and IB 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 goto 45 endif endif c c...cut lines with values of quantum number NQA with value NVA c AND quantum number NQB with value NVB c if(indfil(n).eq.100)then if(nqn(nqa(n)).eq.nva(n). and. * nqn(nqb(n)).eq.nvb(n))then lincut=lincut+1 goto 45 endif endif c c...increment all frequencies with error A by quantity B c if(indfil(n).eq.-3)then if(error.eq.valmin(n))then if(freq.ne.0.d0)then freq=freq+valmax(n) write(line(37:52),'(f16.6)')freq modfre=modfre+1 endif endif endif c c...modify error A to B c if(indfil(n).eq.-4)then if(error.eq.valmin(n))then error=valmax(n) write(line(53:65),'(f13.6)')error moderr=moderr+1 endif endif c c...modify error to C for lines with frequencies from A to B c if(indfil(n).eq.-5)then if(freq.ge.valmin(n).and.freq.le.valmax(n))then if(error.lt.9.d0)then error=valerr(n) moderr=moderr+1 write(line(53:65),'(f13.6)')error else if(error.lt.1000.d0)then error=900.+valerr(n) moderr=moderr+1 write(line(53:65),'(f13.6)')error endif endif endif endif c c...modify line frequency by FINCR for lines with frequencies from FMIN to FMAX c if(indfil(n).eq.-6)then if(freq.ge.FMIN.and.freq.le.FMAX)then freq=freq+FINCR write(line(37:52),'(f16.6)')freq modfre=modfre+1 endif endif c c...two condition change of error based on c 1/ selection rule = difference in values between two specified quantum numbers c 2/ range of values of a specified quantum number c c arrays with condition parameters: c 1/ nquant1 nquant2 nqdif (=iseline) c 2/ nquant nqmin nqmax c if(indfil(n).eq.-8)then if(error.eq.eold(n))then iseline= nqn(nquant1(n))-nqn(nquant2(n)) if(nqdif(n).eq.iseline)then if(nqn(nquant(n)).ge.nqmin(n).and. * nqn(nquant(n)).le.nqmax(n))then if(enew(n).eq.0.d0)then lincut=lincut+1 goto 45 else write(line(53:65),'(f13.6)')enew(n) moderr=moderr+1 endif ! filter or reject on ENEW endif ! qn range endif ! selection rule endif ! error endif c write(*,*)nquant(n),nqn(nquant(n)),freq,nqmin(n),nqmax(n) c c c...four condition change of error based on c 1/ selection rule = difference in values between two specified quantum numbers c 2/ specified values of two different quantum numbers c 3/ range of values of a specified quantum number c c arrays with condition parameters: c 1/ nquant1 nquant2 nqdif (=iseline) c 2/ nqa nva nqb nvb c 3/ nquant nqmin nqmax c if(indfil(n).eq.-9)then c if(error.eq.eold(n))then c if(nqn(nqa(n)).ne.nva(n))goto 50 if(nqn(nqb(n)).ne.nvb(n))goto 50 c iseline= nqn(nquant1(n))-nqn(nquant2(n)) if(nqdif(n).eq.iseline)then if(nqn(nquant(n)).ge.nqmin(n).and. * nqn(nquant(n)).le.nqmax(n))then if(enew(n).eq.0.d0)then lincut=lincut+1 goto 45 else write(line(53:65),'(f13.6)')enew(n) moderr=moderr+1 endif ! filter or reject on ENEW endif ! qn range endif ! selection rule endif ! error endif c 50 continue ! end of loop over conditions c c...output if filtering passes the line c 51 if(iform.ne.1)then write(4,'(a)')line(1:len_trim(line)) original format else read(line,'(12I3)',err=10)nqn update format read(line(37:),*,err=10)freq,ferr,weight update format do 11 n=1,1000 if(line(n:n).ne.'0'.and.line(n:n).ne.'1'.and. * line(n:n).ne.'2'.and.line(n:n).ne.'3'.and. * line(n:n).ne.'4'.and.line(n:n).ne.'5'.and. * line(n:n).ne.'6'.and.line(n:n).ne.'7'.and. * line(n:n).ne.'8'.and.line(n:n).ne.'9'.and. * line(n:n).ne.'-'.and.line(n:n).ne.'.'.and. * line(n:n).ne.'+'.and.line(n:n).ne.' '.and. * line(n:n).ne.'E')goto 12 11 continue lcoment='' goto 14 12 lcoment=' '//line(n:) c 14 if(ferr.gt.99999.d0.or.ferr.lt.-9999.d0)then write(errstr,'(1pE11.2,'' '')')ferr else write(errstr,'(f13.6)')ferr endif c if(weight.ge.0.01d0.and.weight.lt.10.d0)then write(4,1201)nqn,freq,errstr,weight, * lcoment(1:len_trim(lcoment)) else write(4,1202)nqn,freq,errstr,weight, * lcoment(1:len_trim(lcoment)) endif endif 1201 format(12i3,f16.6,a13,1F10.5,A) 1202 format(12i3,f16.6,a13,1PE11.2,A) c linout=linout+1 goto 45 c c 46 write(*,47)nlines,filin(1:len_trim(filin)) 47 format(1x//1x,i6,' lines read in from: ',a) write(*,49)linout,filout(1:len_trim(filout)) 49 format( 1x,i6,' lines written out to: ',a/) write(*,60)lincut,' transitions rejected' write(*,60)modfre,' frequencies modified' write(*,60)moderr,' errors modified' 60 format( 1x,i6,a) c close(3) close(4) c stop c c...Error conditions c 2 write(*,'(1x//'' ***** ERROR reading name of input file from '', * ''LINFIL.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 '', * ''LINFIL.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'', * ''LINFIL.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 .LIN file''//)') stop c 9 write(*,'(1x//'' ***** ERROR reading from .LIN file line:''/a//)') * line(1:len_trim(line)) stop c 10 write(*,'(1x//'' ***** ERROR reading from .LIN line:''/a//)') * line(1:len_trim(line)) stop c 15 write(*,'(1x// * '' ***** ERROR: cannot open the LINFIT.INP file''//)') stop c c end C_____________________________________________________________________________ c_____________________________________________________________________________