C------------------------------------------------------------------------------ C C A T B A N D - Program to convert .CAT type output from SPCAT into C a marked BAND sequence for use by gle C------------------------------------------------------------------------------ C C Reads an excerpt from the .CAT file produced by program CATFIL and converts C the encountered transition frequencies into connected sticks C C 1/ the .CAT file is to be filtered down to contain only the lines in the C band (CATFIL contains all options required for this purpose) C C 2/ blank lines or lines producing input errors will be ignored C C 3/ the first line of the data set should contain six numbers: C C FLEVEL,SHIFT,FLEN,FMULT,NMULT,NQN C C such that: C FLEVEL - position in units of Y-axis (usually 0 to 1) of the band C line C SHIFT - difference between top and bottom band lines for C backfolded bands (suggested value = 0.01) C FLEN - marker length in Y-axis units (suggested value = 0.01, C change the sign to change direction relative to the C band line) C FMULT - multiplier for the length of selected markers C (suggested value = 1. or 2.) C NMULT - the divisor for which markers should be made longer C (suggested value 5 or 10) C NQN - number of quantum number (1-6) to be subject to C the marker multiplier C C 4/ Three types of special lines are allowed defining actions depending C on the character placed in the 17th column (underneath the decimal C point in the intensity column) C C 307884.3048 0.0076 -3.0392 3 352.0183278 0 30369 169 68 068 <-standard .CAT line C 307884.3048 T FREQB C 307884.3048 * C 307884.3048 D 10. 5. C C The 'T' line defines the frequency of the turning point for the band, when C the band line is shifted by SHIFT and markers for successive lines are C drawn in reverse direction, as -FLEN long C - an optional second frequency FREQB can be given so that band line C can be drawn in a zig-zag from first frequency to FREQB C - more than one occurrence of the T line is possible, each time the C values of SHIFT and FLEN change sign C C The '*' line defines an extension of the band line to the frequency C specified by the first number C C The 'D' line defines three dashes terminating the band line with C the two values following the 'D' defining empty run length, and C dash length, respectively. If 'D' is used with '*' then it is best C to give the same frequency for both. C C 5/ Unwanted .CAT lines can be blanked out with a non-numeric character C in the first column. Blank or any othe non .CAT lines are allowed C but will be ignored. C C C ver. 6.06.2022 ----- 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 Modification history: C c 10.04.07: modified from ASRBAND C 14.11.11: more general T lines c 21.12.17: dealing with qn values >=100 c 6.06.22: header with reminder of input + small mods C_____________________________________________________________________________ c C implicit real*8 (a-h,o-z) character filnam*25,line*80,linfor*40 integer nqns(12) c c WRITE(*,5500) 5500 FORMAT(1X//' ',76(1H_)/' |',T79,'|'/ * ' | CATBAND - Conversion of .CAT output into marked BAND ', * 'sequence for use',T79,'|'/ * ' | in gle drawings',T79,'|'/ * ' |',76(1H_),'|'/' version 6.VI.2022',T64,'Zbigniew KISIEL'/) c c Write(*,5501) 5501 format(1x/// * ' Insert at the top of the .CAT file a line of six control ', * 'parameters'/ * ' as in the example below:'// * ' 1.05 0.02 -0.03 2.0 5 1 '/ * ' | | | | | | '/ * ' | |_backfolded shift | '/ * ' | |_marker length (+ve or -ve) '/ * ' Y-level |_marker multiplier (+ve or -ve) '/ * ' |_divisor for multiplier '/ * ' |_quantum number for multiplier'// * ' Additional lines possible among the .CAT lines:'// * ' xxxxxx.xxxx T ! definition of band turning point'/ * ' xxxxxx.xxxx * ! definition of band extension'/ * ' xxxxxx.xxxx D 10. 5. ! definition of band terminating ', * 'dots'/) c c 1 write(*,'(1x//'' Name of .CAT type data file: '',$)') read(*,'(a)',err=1)filnam open(2,file=filnam,status='old',err=1) do 7 n=1,len(filnam) if(filnam(n:n).eq.'.'.or.filnam(n:n).eq.' ')then ncars=n-1 goto 8 endif 7 continue ncars=len(filnam) 8 open(3,file=filnam(1:ncars)//'.dat',status='unknown') c C parameters line C read(2,'(a)',err=22,end=22)line read(line,*,err=22)flevel,shift,flen,fmult,nmult,nqn write(*,10)fmult,nmult,nqn 10 format(1x/10x,'Fmult = ',f5.2/ * 10x,'nmult = ',i5/ * 10x,' nqn = ',i5/) C C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C MAIN LOOP - control returns to statement 2 C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c C SPCAT line C C 307884.3048 0.0076 -3.0392 3 352.0183278 0 30369 169 68 068 C nread=0 2 read(2,'(a)',err=2,end=3)line c read(line(1:13),'(f13.0)',err=2)freq if(freq.eq.0.0d0)goto 2 c c...echo the transition if the line read is not a control line c if(line(17:17).ne.'*'.and. * line(17:17).ne.'D'.and.line(17:17).ne.'d'.and. * line(17:17).ne.'T'.and.line(17:17).ne.'t')then c write(3,'(12a)')'! transition: ', * line(56:57),' ',line(58:59),' ',line(60:61),' <-- ', * line(68:69),' ',line(70:71),' ',line(72:73) endif c c...elongation of band line (with *) c if(line(17:17).eq.'*')then write(3,'(a/''!'')')'! elongation of the band line' write(3,4)freq,' ',flevel write(3,'(''!'')') goto 2 endif c c...turning point (with T) c if(line(17:17).eq.'T'.or.line(17:17).eq.'t')then write(3,'(a/''!'')')'! BAND TURNING POINT' c freqa=freq if(len_trim(line).gt.17)then read(line(18:),*,err=5)ftemp if(ftemp.ne.0.d0)freqa=ftemp endif c 5 write(3,4)freq,' ',flevel flevel=flevel-shift write(3,4)freqa,' ',flevel c write(3,'(''!'')') shift=-shift flen=-flen goto 2 endif c C...dots (with D) C if(line(17:17).eq.'D'.or.line(17:17).eq.'d')then read(line(18:),*,err=2,end=2)fblank,fdash write(3,'(a/''!'')')'! three dashes terminating the band line' freq=freq+fblank write(3,4)freq,' * ' write(3,4)freq,' ',flevel write(3,4)freq+fdash,' ',flevel write(3,'(1x)') freq=freq+fblank+fdash write(3,4)freq,' * ' write(3,4)freq,' ',flevel write(3,4)freq+fdash,' ',flevel write(3,'(1x)') freq=freq+fblank+fdash write(3,4)freq,' * ' write(3,4)freq,' ',flevel write(3,4)freq+fdash,' ',flevel write(3,'(''!'')') goto 2 endif c c...decode quantum numbers to 12I3 format c call check(line,linfor,nmaxq) read(linfor,'(12i3)')nqns n100=0 do 20 i=1,12 if(nqns(i).ge.100)n100=1 20 continue if(n100.eq.1)then write(3,21)'! as decoded: ',nqns else write(3,'(''!'')') endif 21 format(a,6i4,' <-',6i4/'!') c c...apply marker length multiplication on desired qn and its multiple c rmult=1. m=nqns(nqn+6) if((m/nmult)*nmult.eq.m)then rmult=fmult endif c c...calculate and draw marker c fmark=flevel+rmult*flen write(3,4)freq,' ',flevel write(3,4)freq,' ',fmark write(3,4)freq,' ',flevel 4 format(5x,f16.6,a,f14.6) write(3,'(''!'')') c goto 2 c C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c 3 close(2) close(3) write(*,'(1x/'' Output written to: '',a//)') * filnam(1:ncars)//'.dat' c stop c 22 write(*,23)line(1:len_trim(line)) 23 format(1x//' ***** ERROR: Bad line with CATBAND parameters:'// * 1x,a//) c stop 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_____________________________________________________________________________