C----------------------------------------------------------------------------- C C ACIR - Auto Conversion of a .RES data file from ASFIT, PIFORM or C ERHRES into a data file plottable with gle C C----------------------------------------------------------------------------- C C NOTE: this is a modification of AC to ACIR, based only on C PIFORM(SPFIT) outputs with four quantum numbers. C Many decisions depend on position of decimal points in f,o-c,err C fields and may fail for different output types. C C C C This program generates data files for the gle program, C which can contain: c c 1/ either all transitions from the results file c c 2/ subsets of transitions sorted along the criteria specified c in the dialogue with the program (typical task is to fish out c all transitions for a given vibrational state in a multistate fit) C C The GLE file for plotting these data files is at the moment external C to this program - recommended one is PQR.GLE C C C SORTING OPTIONS: C C - Absolute line sorting: splits data into seven bins of width FGRID in o-c, C o-c>7*FGRID is truncated to 7*FGRID C (standard setting of FGRID is 0.1) C C - o-c/sigma: splits data into seven bins of width 1 in (o-c).sigma, C values of (o-c)/sigma greater than 7 are truncated to 7 C C C ver. 11.II.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 Modification history: C C 8.03.2005: stable version C 16.01.2006: correction for omitted worst deviations C 30.10.2006: ERHRES compatibility C 24.11.2006: automatic detection of the number of SPFIT quantum numbers C 30.03.2007: more general filtering C 21.10.2010: misc. improvements c 4.11.2013: generation of ACIR from AC c 17.12.2014: eliminating bugs on ir operation c 14.04.2020: separation of fitted and unfitted data sets c 11.02.2022: general update/debugging C C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C implicit real*8 (a-h,o-z) parameter (maxlin=50000) c character line*150,filnam*50,descr*17,descr1*50,filstr*8 character lines(maxlin)*95 integer ifit(maxlin),iup(6),jlow(6) real*8 fminunf,fmaxunf,fminfit,fmaxfit,fminomcunf,fmaxomcunf c c NBINS = number of bins c c DEFERR = measurement error as specified for lines in the .LIN file c (equally weighted data) C ERRTST = SPFIT cutoff to reject lines from fit, in units of C (o-c)/ferror C CUTOM = cutoff and saturation level in absolute (o-c) c CUTOMSIG = cutoff and saturation level in (o-c)/error c FGRID = bin size resulting from ERRTST, DEFERR and NBINS c FGRIDM = FGRID multiplier for UNFITTD lines c FGRIDU = bin grid for UNFITTD lines c c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c The fitted lines go into standard bins: c c o-c .le. NBINS*FGRID or (o-c)/deferr .le. NBINS c in steps of FGRID or 1 c c The UNFITTD lines go into the UNF bins: c c o-c .gt. NBINS*FGRID or (o-c)/deferr .gt. NBINS c in steps of FGRIDM*FGRID or FGRIDM c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c nbins=7 c errtst=10. deferr=0.0002d0 fgrid=(errtst*deferr)/dble(nbins) cutom=7.d0*fgrid cutomsig=nbins fgridm=15.d0 fgridu=fgrid*fgridm C c eunf=0.0D0 unfitted line error fminunf= 1.d10 fmaxunf=-1.d10 fminomcunf= 1.d10 fmaxomcunf=-1.d10 fminfit= 1.d10 fmaxfit=-1.d10 c isigma=1 (o-c)/error binning c c WRITE(*,3344) 3344 FORMAT(1X//' ',76(1H_)/' |',T79,'|'/ * ' | A C I R - Auto Conversion of a results file from', * ' PIFORM', * T79,'|'/ * ' | to a data file plottable with gle', * T79,'|'/ * ' |',76(1H_),'|'/' version 11.II.2022', * T64,'Zbigniew KISIEL'/) c write(*,'(1x//1x,a,f15.10)')' FGRID = ',fgrid c 5 write(*,6) 6 format(1x//' Name of results file in the .RES standard: ',$) ! specify the .RES file with data read(*,'(a)',err=5)filnam c open(2,file=filnam,status='old',err=5) open(3,file='acir.out',status='unknown') write(3,100)filnam(1:len_trim(filnam)) 100 format('!'/ * '! Echo of all lines satisfying the quantum number filtering ', * 'criteria read from:'/'! ',a/'!'/'!'/ * '! obs', * ' obs-calc (o-c)/error'/'!') c C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C C...Main loop for reading transitions, which are processed and placed into C the CHARACTER array LINES C nl=0 ! counter of transitions written to standard bins nlunf=0 ! counter of transitions written to unfitted bins c ivset=0 nfilt=-1 2 read(2,'(a)',end=3,err=1)line c if(len_trim(line).lt.71)goto 2 if(line(1:1).eq.'!')goto 2 if(line(1:1).eq.'-')goto 2 c if(line(5:5).eq.'.'.or.line(5:5).eq.':'.or.line(5:5).eq.'/'.or. * line(5:5).eq.' '.or.line(5:5).eq.'*'.or.line(5:5).eq.'B')then c do nothing else goto 2 endif c if(line(5:5).eq.'.'.and.len_trim(line).lt.71)goto 2 if(line(5:5).eq.':'.and.len_trim(line).lt.71)goto 2 if(line(5:5).eq.'/'.and.len_trim(line).lt.71)goto 2 if(line(5:5).eq.' '.and.len_trim(line).lt.71)goto 2 if(line(5:5).eq.'*'.and.len_trim(line).lt.71)goto 2 if(line(5:5).eq.'B'.and.len_trim(line).lt.71)goto 2 c write(3,'(a)')line(1:len_trim(line)) c c c...Results file from SPFIT->PIFORM and V6->VIFORM c c The first encountered legal line is used to establish the number of quantum numbers c being in use and whether filtering according to a value of a given quantum number C is to be applied (NFILT is changed from -1 to 0 or higher) c c161: 59 19 41 59 17 42 161786.9415 -0.0036 0.050 0.0008 0.50 c162: 59 18 41 59 18 42 161786.9415 0.0051 0.050 0.0008 0.50 c c 22: 31 3 29 0 30 3 28 0 199384.8015 0.1859 0.050 0.0531 0.50 c 23: 31 2 29 0 30 2 28 0 199384.8015 -0.0797 0.050 0.0531 0.50 c c 26: 33 1 33 1 33 32 1 32 1 32 150724.6687 0.0585 0.100 -0.0198 0.50 c 27: 33 0 33 1 33 32 0 32 1 32 150724.6687 -0.0980 0.100 -0.0198 0.50 c c 16: 1 0 0 2 1 2 0 0 0 2 1 2 6617.9736 0.0000 0.003 -0.0001 0.61 c 17: 1 0 0 2 1 2 0 0 0 2 1 3 6617.9736 0.0000 0.003 -0.0001 0.39 c c Special characters allowed in column 5: c c : = normal line c / = o-c>3sigma c B = blend component c = space character for UNFITTD c * = UNFITTD on the basis of an additional rule c if(line(5:5).eq.':'.or.line(5:5).eq.'/'.or.line(5:5).eq.'B'.or. * line(5:5).eq.'*'.or.line(5:5).eq.' ')then c c c...Reject non-IR lines on the basis of different format in PIFORM output: C C IR: c830: 26 0 26 2 26 1 26 0 588.12600 0.00303 .00300 c930: 45 0 45 1 44 0 44 0 572.77600 -1.1166 UNFITTD 573.89264 C MMW: c832: 11 0 11 0 10 0 10 0 261928.6283 -0.0003 0.050 c380: 10 4 6 2 9 4 5 2 238005.7960 -2.301 UNFITTD 238008.0976 c Unwanted: cKJ 0.1364 0.2397 -0.1812 0.0942 -0.3684 0.1212 1.0000 c if( line(50:50).ne.'.'.or.line(59:59).ne.'.')goto 2 if(line(14:14).eq.'.'.and.line(41:41).eq.'.')goto 2 c c...Deal with an UNFITTD line c ift=1 if(line(65:71).eq.'UNFITTD')then ! specify UNFITTD line error if(eunf.eq.0.0d0)then ! (on reading first such line) 115 write(*,116) 116 format(1x/' Error for UNFITTD lines = ',$) read(*,'(f20.10)',err=115)eunf if(eunf.le.0.d0)goto 115 if(eunf.ge.1000.d0)goto 115 endif c read(line(72:84),'(f13.5)')fpred read(line(42:55),'(f14.5)')fobs omc=fobs-fpred c if(fobs.lt.fminunf)fminunf=fobs if(fobs.gt.fmaxunf)fmaxunf=fobs if(omc.lt.fminomcunf)fminomcunf=omc if(omc.gt.fmaxomcunf)fmaxomcunf=omc c write(line(64:71),'(f8.5)')eunf trick to remove line(65:65)=' ' leading zero in error write(line(56:64),'(f9.5)')omc ift=0 nunf=nunf+1 endif c if(ift.eq.1)then read(line(56:64),'(f9.5)',err=2)omc if(omc.lt.fminfit)fminfit=omc if(omc.gt.fmaxfit)fmaxfit=omc nfit=nfit+1 endif c c...establish the number of quantum numbers per energy level (if not yet c done so) c if(nfilt.lt.0)then nquant=2 if(line(15:17).eq.' ')nquant=3 if(line(18:20).eq.' ')nquant=4 if(line(21:23).eq.' ')nquant=5 if(line(24:26).eq.' ')nquant=6 122 write(*,121) nquant,nquant 121 format(1x/3x,i1,' quantum numbers per energy level'// * ' Type a number from 1 to ',i1,' if you want to filter ', * 'according to'/ * ' the corresponding quantum number ', * '{zero or ENTER for no filtering)' * //40x,'.... ',$) read(*,'(i5)',err=122)nfilt ! specify quantum number for filtering if(nfilt.lt.0.or.nfilt.gt.nquant)goto 122 endif c c...read line content c line(5:5)='.' read(line(1:5),*,err=2000)r ! transition number lstart=6 lfin=lstart+3*nquant-1 read(line(lstart:lfin),'(6i3)',err=2),(iup(i),i=1,nquant) lstart=lfin+3 lfin=lstart+3*nquant-1 read(line(lstart:lfin),'(6i3)',err=2)(jlow(j),j=1,nquant) lstart=lfin+1 read(line(lstart:),*,err=2)f,df,er c c...read average obs-calc for a blend c if( (line(76:76).eq.'.'.and.line(83:83).eq.'.') .or. * (line(75:75).eq.'.'.and.line(83:83).eq.'.') ) * read(line(72:80),'(F9.4)',err=2)df c c...reject line if zero frequency or zero error c if(f.eq.0.d0)goto 2 if(er.eq.0.d0)goto 2 c c...if o-c greater than preset limit then set it to the limit c DF=ABS(DF) dfs=df/er c if(df.gt.cutlim)df=cutlim c if(dfs.gt.cutomsig)dfs=cutomsig c c...Specify filtering if not yet done so c if(ivset.eq.0.and.nfilt.gt.0)then 32 write(*,31) 31 format(1x/' Specify comma separated (upper,lower) values ', ! specify q.n. values for filtering * 'of the selected quantum number'/ * ' to filter out a subset of lines ', * '(or -1,, for no filtering)'//40x,'.... ',$) read(*,*,err=32)ifilt,jfilt write(filstr,'(2i4)')ifilt,jfilt c c...Compress the index selection string FILSTR so that there are no spaces c nfstr=len_trim(filstr) do 101 i=nfstr-1,1,-1 if(filstr(i:i).eq.' ')then do 102 ii=i,nfstr-1 filstr(ii:ii)=filstr(ii+1:ii+1) 102 continue filstr(nfstr:nfstr)=' ' endif 101 continue c ivset=1 endif c c...carry out quantum number filtering (if specified) c if(nfilt.gt.0)then if(iup(nfilt).ne.ifilt)goto 2 if(jlow(nfilt).ne.jfilt)goto 2 endif c c...Store acceptable transitions in LINES + IFT and echo to ACIR.OUT c if(ift.eq.1)nl=nl+1 if(ift.eq.0)nlunf=nlunf+1 c write(line,33)nint(r),(iup(i),i=1,3),(jlow(j),j=1,3),f,df,dfs 33 format(i4,'.',i6,2i4,i6,2i4,f16.5,f14.5,f14.4) lines(nl)=line(1:len_trim(line)) write(3,'(a)')line(1:len_trim(line)) ifit(nl)=ift goto 2 endif C C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c 3 close(2) close(3) c c c Write lines out in reverse order c 9 write(*,8) 8 format(1x//' Should P,Q,R lines be separated (1/0) ? ',$) read(*,'(i5)',err=9)irqsel if(irqsel.ne.1)irqsel=0 c 109 write(*,108) 108 format(1x/ ' Absolute o-c (=0) or o-c/sigma (=1) sorting ? ',$) read(*,'(i5)',err=109)isigma ! specify (o-c) or (o-c)/s binning if(isigma.ne.1)isigma=0 c 40 write(*,41) 41 format(1x/ ' Exclusions ? = 0 None'/ * ' = 1 >3*sigma lines'/ * ' = 2 unfitted lines'/ * ' = 3 >3*sigma and unfitted'/ * ' = 4 unfitted and >900 errors'// * ' .... ',$) read(*,'(i5)',err=9)i3excl if(i3excl.lt.1.or.i3excl.gt.4)i3excl=0 c c if(isigma.eq.1)then ! for (o-c)/error descr=' (obs-calc)/error' write(descr1,119)deferr,errtst else write(descr,'(f12.8)')fgrid ! for absolute (o-c) write(descr1,119)deferr,errtst,fgridm endif 119 format(' [ (obs-calc)/',f12.8,' -',f5.2,' ] /',f6.2) c c...Open output data files c nfstr=len_trim(filstr) nbinout=0 nbinunfout=0 c c------------------------------------------------------------------------------- c Write out the tables for R-types, if specified by IRQSEL=1 c or all lines if IRQSEL=0 c------------------------------------------------------------------------------- c c...set up data files with names containing c 1/ either the filtering index c 2/ or just the bin index c if(nfstr.ge.2)then ! bin names with open(11, ! filtering index * file='acir_1_'//filstr(1:nfstr)//'.out',status='unknown') open(12, * file='acir_2_'//filstr(1:nfstr)//'.out',status='unknown') open(13, * file='acir_3_'//filstr(1:nfstr)//'.out',status='unknown') open(14, * file='acir_4_'//filstr(1:nfstr)//'.out',status='unknown') open(15, * file='acir_5_'//filstr(1:nfstr)//'.out',status='unknown') open(16, * file='acir_6_'//filstr(1:nfstr)//'.out',status='unknown') open(17, * file='acir_7_'//filstr(1:nfstr)//'.out',status='unknown') c open(21, * file='acir_1_'//filstr(1:nfstr)//'unf.out',status='unknown') open(22, * file='acir_2_'//filstr(1:nfstr)//'unf.out',status='unknown') open(23, * file='acir_3_'//filstr(1:nfstr)//'unf.out',status='unknown') open(24, * file='acir_4_'//filstr(1:nfstr)//'unf.out',status='unknown') open(25, * file='acir_5_'//filstr(1:nfstr)//'unf.out',status='unknown') open(26, * file='acir_6_'//filstr(1:nfstr)//'unf.out',status='unknown') open(27, * file='acir_7_'//filstr(1:nfstr)//'unf.out',status='unknown') c else ! simple bin names open(11,file='acir_1.out',status='unknown') open(12,file='acir_2.out',status='unknown') open(13,file='acir_3.out',status='unknown') open(14,file='acir_4.out',status='unknown') open(15,file='acir_5.out',status='unknown') open(16,file='acir_6.out',status='unknown') open(17,file='acir_7.out',status='unknown') c open(21,file='acir_1unf.out',status='unknown') open(22,file='acir_2unf.out',status='unknown') open(23,file='acir_3unf.out',status='unknown') open(24,file='acir_4unf.out',status='unknown') open(25,file='acir_5unf.out',status='unknown') open(26,file='acir_6unf.out',status='unknown') open(27,file='acir_7unf.out',status='unknown') c endif c c...write data file headers including a dummy entry to keep gle happy c write(11,15)filnam(1:len_trim(filnam)),'(0 to 1) *',descr * ,deferr,fgrid,fgridu,fgridm write(12,15)filnam(1:len_trim(filnam)),'(1 to 2) *',descr * ,deferr,fgrid,fgridu,fgridm write(13,15)filnam(1:len_trim(filnam)),'(2 to 3) *',descr * ,deferr,fgrid,fgridu,fgridm write(14,15)filnam(1:len_trim(filnam)),'(3 to 4) *',descr * ,deferr,fgrid,fgridu,fgridm write(15,15)filnam(1:len_trim(filnam)),'(4 to 5) *',descr * ,deferr,fgrid,fgridu,fgridm write(16,15)filnam(1:len_trim(filnam)),'(5 to 6) *',descr * ,deferr,fgrid,fgridu,fgridm write(17,15)filnam(1:len_trim(filnam)),'(6 to 7) *',descr * ,deferr,fgrid,fgridu,fgridm c write(21,15)filnam(1:len_trim(filnam)),'(0 to 1) *',descr1 * ,deferr,fgrid,fgridu,fgridm write(22,15)filnam(1:len_trim(filnam)),'(1 to 2) *',descr1 * ,deferr,fgrid,fgridu,fgridm write(23,15)filnam(1:len_trim(filnam)),'(2 to 3) *',descr1 * ,deferr,fgrid,fgridu,fgridm write(24,15)filnam(1:len_trim(filnam)),'(3 to 4) *',descr1 * ,deferr,fgrid,fgridu,fgridm write(25,15)filnam(1:len_trim(filnam)),'(4 to 5) *',descr1 * ,deferr,fgrid,fgridu,fgridm write(26,15)filnam(1:len_trim(filnam)),'(5 to 6) *',descr1 * ,deferr,fgrid,fgridu,fgridm write(27,15)filnam(1:len_trim(filnam)),'(6 to 7) *',descr1 * ,deferr,fgrid,fgridu,fgridm c 15 format('! Lines from file: ',a/ * '! satisfying the bin condition: ',2a,/'!'/ * '! Measurement error: ',f12.6/ * '! Bin size: ',f12.6/ * '! UNFITTD bin size: ',f12.6,5x, * 'multiplier =',F6.2/ * '!'/ * '! obs', * ' obs-calc (o-c)/error'/'!'/ * ' * * * * * * * *', * ' * *') c do 10 n=nl,1,-1 c line=lines(n) read(line,*,err=10)r,i,ii,iii,j,jj,jjj,f,df,dfs if(irqsel.eq.1.and.(i.le.j))goto 10 c if(isigma.eq.1)then df=dfs else df=df/fgrid if(ifit(n).eq.0)df=(dfs-errtst)/fgridm endif c if((i3excl.eq.1.or.i3excl.eq.3).and.dfs.gt.3.d0)goto 10 if(i3excl.ge.2.and.ifit(n).eq.0)goto 10 c if(df.le.1.d0)then if(ifit(n).eq.1)then write(11,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(21,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif goto 10 endif c if(df.le.2.d0)then if(ifit(n).eq.1)then write(12,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(22,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif goto 10 endif c if(df.le.3.d0)then if(ifit(n).eq.1)then write(13,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(23,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif goto 10 endif c if(df.le.4.d0)then if(ifit(n).eq.1)then write(14,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(24,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif goto 10 endif c if(df.le.5.d0)then if(ifit(n).eq.1)then write(15,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(25,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif goto 10 endif c if(df.le.6.d0)then if(ifit(n).eq.1)then write(16,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(26,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif goto 10 endif c if(ifit(n).eq.1)then write(17,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(27,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif c 10 continue c close(11) close(12) close(13) close(14) close(15) close(16) close(17) if(irqsel.eq.0)goto 77 c c------------------------------------------------------------------------------- c Write out the tables for Q-types, if specified by IRQSEL=1 c------------------------------------------------------------------------------- c if(nfstr.ge.2)then open(11, * file='acir_1q_'//filstr(1:nfstr)//'.out',status='unknown') open(12, * file='acir_2q_'//filstr(1:nfstr)//'.out',status='unknown') open(13, * file='acir_3q_'//filstr(1:nfstr)//'.out',status='unknown') open(14, * file='acir_4q_'//filstr(1:nfstr)//'.out',status='unknown') open(15, * file='acir_5q_'//filstr(1:nfstr)//'.out',status='unknown') open(16, * file='acir_6q_'//filstr(1:nfstr)//'.out',status='unknown') open(17, * file='acir_7q_'//filstr(1:nfstr)//'.out',status='unknown') c open(21, * file='acir_1q_'//filstr(1:nfstr)//'unf.out',status='unknown') open(22, * file='acir_2q_'//filstr(1:nfstr)//'unf.out',status='unknown') open(23, * file='acir_3q_'//filstr(1:nfstr)//'unf.out',status='unknown') open(24, * file='acir_4q_'//filstr(1:nfstr)//'unf.out',status='unknown') open(25, * file='acir_5q_'//filstr(1:nfstr)//'unf.out',status='unknown') open(26, * file='acir_6q_'//filstr(1:nfstr)//'unf.out',status='unknown') open(27, * file='acir_7q_'//filstr(1:nfstr)//'unf.out',status='unknown') c else open(11,file='acir_1q.out',status='unknown') open(12,file='acir_2q.out',status='unknown') open(13,file='acir_3q.out',status='unknown') open(14,file='acir_4q.out',status='unknown') open(15,file='acir_5q.out',status='unknown') open(16,file='acir_6q.out',status='unknown') open(17,file='acir_7q.out',status='unknown') open(21,file='acir_1qunf.out',status='unknown') open(22,file='acir_2qunf.out',status='unknown') open(23,file='acir_3qunf.out',status='unknown') open(24,file='acir_4qunf.out',status='unknown') open(25,file='acir_5qunf.out',status='unknown') open(26,file='acir_6qunf.out',status='unknown') open(27,file='acir_7qunf.out',status='unknown') endif c write(11,15)filnam(1:len_trim(filnam)),'(0 to 1) *',descr * ,deferr,fgrid,fgridu,fgridm write(12,15)filnam(1:len_trim(filnam)),'(1 to 2) *',descr * ,deferr,fgrid,fgridu,fgridm write(13,15)filnam(1:len_trim(filnam)),'(2 to 3) *',descr * ,deferr,fgrid,fgridu,fgridm write(14,15)filnam(1:len_trim(filnam)),'(3 to 4) *',descr * ,deferr,fgrid,fgridu,fgridm write(15,15)filnam(1:len_trim(filnam)),'(4 to 5) *',descr * ,deferr,fgrid,fgridu,fgridm write(16,15)filnam(1:len_trim(filnam)),'(5 to 6) *',descr * ,deferr,fgrid,fgridu,fgridm write(17,15)filnam(1:len_trim(filnam)),'(6 to 7) *',descr * ,deferr,fgrid,fgridu,fgridm c write(21,15)filnam(1:len_trim(filnam)),'(0 to 1) *',descr1 * ,deferr,fgrid,fgridu,fgridm write(22,15)filnam(1:len_trim(filnam)),'(1 to 2) *',descr1 * ,deferr,fgrid,fgridu,fgridm write(23,15)filnam(1:len_trim(filnam)),'(2 to 3) *',descr1 * ,deferr,fgrid,fgridu,fgridm write(24,15)filnam(1:len_trim(filnam)),'(3 to 4) *',descr1 * ,deferr,fgrid,fgridu,fgridm write(25,15)filnam(1:len_trim(filnam)),'(4 to 5) *',descr1 * ,deferr,fgrid,fgridu,fgridm write(26,15)filnam(1:len_trim(filnam)),'(5 to 6) *',descr1 * ,deferr,fgrid,fgridu,fgridm write(27,15)filnam(1:len_trim(filnam)),'(6 to 7) *',descr1 * ,deferr,fgrid,fgridu,fgridm c do 20 n=nl,1,-1 c line=lines(n) read(line,*,err=20)r,i,ii,iii,j,jj,jjj,f,df,dfs if(irqsel.eq.1.and.(i.ne.j))goto 20 c if(isigma.eq.1)then df=dfs else df=df/fgrid if(ifit(n).eq.0)df=(dfs-errtst)/fgridm endif c if((i3excl.eq.1.or.i3excl.eq.3).and.dfs.gt.3.d0)goto 20 if(i3excl.ge.2.and.ifit(n).eq.0)goto 20 c if(df.le.1.0d0)then if(ifit(n).eq.1)then write(11,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(21,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif goto 20 endif c if(df.le.2.0d0)then if(ifit(n).eq.1)then write(12,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(22,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif goto 20 endif c if(df.le.3.0d0)then if(ifit(n).eq.1)then write(13,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(23,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif goto 20 endif c if(df.le.4.0d0)then if(ifit(n).eq.1)then write(14,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(24,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif goto 20 endif c if(df.le.5.0d0)then if(ifit(n).eq.1)then write(15,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(25,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif goto 20 endif c if(df.le.6.0d0)then if(ifit(n).eq.1)then write(16,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(26,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif goto 20 endif c if(ifit(n).eq.1)then write(17,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(27,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif c 20 continue c close(11) close(12) close(13) close(14) close(15) close(16) close(17) close(21) close(22) close(23) close(24) close(25) close(26) close(27) c c------------------------------------------------------------------------------- c Write out the tables for P-types, if specified by IRQSEL=1 c------------------------------------------------------------------------------- c 77 if(irqsel.eq.0)goto 7 c if(nfstr.ge.2)then open(11, * file='acir_1p_'//filstr(1:nfstr)//'.out',status='unknown') open(12, * file='acir_2p_'//filstr(1:nfstr)//'.out',status='unknown') open(13, * file='acir_3p_'//filstr(1:nfstr)//'.out',status='unknown') open(14, * file='acir_4p_'//filstr(1:nfstr)//'.out',status='unknown') open(15, * file='acir_5p_'//filstr(1:nfstr)//'.out',status='unknown') open(16, * file='acir_6p_'//filstr(1:nfstr)//'.out',status='unknown') open(17, * file='acir_7p_'//filstr(1:nfstr)//'.out',status='unknown') c open(21, * file='acir_1p_'//filstr(1:nfstr)//'unf.out',status='unknown') open(22, * file='acir_2p_'//filstr(1:nfstr)//'unf.out',status='unknown') open(23, * file='acir_3p_'//filstr(1:nfstr)//'unf.out',status='unknown') open(24, * file='acir_4p_'//filstr(1:nfstr)//'unf.out',status='unknown') open(25, * file='acir_5p_'//filstr(1:nfstr)//'unf.out',status='unknown') open(26, * file='acir_6p_'//filstr(1:nfstr)//'unf.out',status='unknown') open(27, * file='acir_7p_'//filstr(1:nfstr)//'unf.out',status='unknown') else open(11,file='acir_1p.out',status='unknown') open(12,file='acir_2p.out',status='unknown') open(13,file='acir_3p.out',status='unknown') open(14,file='acir_4p.out',status='unknown') open(15,file='acir_5p.out',status='unknown') open(16,file='acir_6p.out',status='unknown') open(17,file='acir_7p.out',status='unknown') c open(21,file='acir_1punf.out',status='unknown') open(22,file='acir_2punf.out',status='unknown') open(23,file='acir_3punf.out',status='unknown') open(24,file='acir_4punf.out',status='unknown') open(25,file='acir_5punf.out',status='unknown') open(26,file='acir_6punf.out',status='unknown') open(27,file='acir_7punf.out',status='unknown') endif c write(11,15)filnam(1:len_trim(filnam)),'(0 to 1) *',descr * ,deferr,fgrid,fgridu,fgridm write(12,15)filnam(1:len_trim(filnam)),'(1 to 2) *',descr * ,deferr,fgrid,fgridu,fgridm write(13,15)filnam(1:len_trim(filnam)),'(2 to 3) *',descr * ,deferr,fgrid,fgridu,fgridm write(14,15)filnam(1:len_trim(filnam)),'(3 to 4) *',descr * ,deferr,fgrid,fgridu,fgridm write(15,15)filnam(1:len_trim(filnam)),'(4 to 5) *',descr * ,deferr,fgrid,fgridu,fgridm write(16,15)filnam(1:len_trim(filnam)),'(5 to 6) *',descr * ,deferr,fgrid,fgridu,fgridm write(17,15)filnam(1:len_trim(filnam)),'(6 to 7) *',descr * ,deferr,fgrid,fgridu,fgridm c write(21,15)filnam(1:len_trim(filnam)),'(0 to 1) *',descr1 * ,deferr,fgrid,fgridu,fgridm write(22,15)filnam(1:len_trim(filnam)),'(1 to 2) *',descr1 * ,deferr,fgrid,fgridu,fgridm write(23,15)filnam(1:len_trim(filnam)),'(2 to 3) *',descr1 * ,deferr,fgrid,fgridu,fgridm write(24,15)filnam(1:len_trim(filnam)),'(3 to 4) *',descr1 * ,deferr,fgrid,fgridu,fgridm write(25,15)filnam(1:len_trim(filnam)),'(4 to 5) *',descr1 * ,deferr,fgrid,fgridu,fgridm write(26,15)filnam(1:len_trim(filnam)),'(5 to 6) *',descr1 * ,deferr,fgrid,fgridu,fgridm write(27,15)filnam(1:len_trim(filnam)),'(6 to 7) *',descr1 * ,deferr,fgrid,fgridu,fgridm c if(irqsel.eq.0)then close(11) close(12) close(13) close(14) close(15) close(16) close(17) close(21) close(22) close(23) close(24) close(25) close(26) close(27) goto 7 endif c do 30 n=nl,1,-1 c line=lines(n) read(line,*,err=30)r,i,ii,iii,j,jj,jjj,f,df,dfs if(irqsel.eq.1.and.(i.ge.j))goto 30 c if(isigma.eq.1)then df=dfs else df=df/fgrid if(ifit(n).eq.0)df=(dfs-errtst)/fgridm endif c if((i3excl.eq.1.or.i3excl.eq.3).and.dfs.gt.3.d0)goto 30 if(i3excl.ge.2.and.ifit(n).eq.0)goto 30 c if(df.le.1.0d0)then if(ifit(n).eq.1)then write(11,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(21,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif goto 30 endif c if(df.le.2.0d0)then if(ifit(n).eq.1)then write(12,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(22,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif goto 30 endif c if(df.le.3.0d0)then if(ifit(n).eq.1)then write(13,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(23,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif goto 30 endif c if(df.le.4.0d0)then if(ifit(n).eq.1)then write(14,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(24,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif goto 30 endif c if(df.le.5.0d0)then if(ifit(n).eq.1)then write(15,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(25,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif goto 30 endif c if(df.le.6.0d0)then if(ifit(n).eq.1)then write(16,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(26,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif goto 30 endif c if(ifit(n).eq.1)then write(17,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) else write(27,'(a)')line(1:77)//' ! '//line(78:len_trim(line)) endif c 30 continue c close(11) close(12) close(13) close(14) close(15) close(16) close(17) close(21) close(22) close(23) close(24) close(25) close(26) close(27) c c 7 Write(*,'(1x/)') write(*,107)nfit,' total fitted IR lines read in', * ' (o-c) range:',fminfit,fmaxfit, * '(o-c)/sigma range:',fminfit/deferr, * fmaxfit/deferr if(nunf.eq.0)then fminomcunf=0.d0 fmaxomcunf=0.d0 fminunf=0.d0 fmaxunf=0.d0 endif write(*,107)nunf,' total unfitted IR lines read in', * ' (o-c) range:',fminomcunf,fmaxomcunf, * 'wavenumbers cm-1:',fminunf,fmaxunf 107 format(1x/i7,a/20x,a,2f11.4/20x,a,2f11.4) c write(*,2002)nl,' lines written to standard bin output files ', * nlunf,' lines written to unfitted bin output files ' 2002 format(1x/i7,' filtered',a/i7,' filtered',a//) c 1 stop c c...error conditions c 2000 write(*,2001)'line number',line(1:len_trim(line)) 2001 format(1x/' **** ERROR reading ',a,' from line:'/1x,a/) c stop end c C----------------------------------------------------------------------------- C-----------------------------------------------------------------------------