C------------------------------------------------------------------------------- C C VADCAT - Converter from Vadim Ilyushin's PREDICT standard to C CAT type file(s) C C C input is from VADCAT.INP C output is to VADCAT.CAT and M0.cat to M9.cat (when appropriate) C C Selection of whether prediction is from RAM36 or RAM36HF is automatic C on the basis of the encountered line format C C C C ver. 19.X.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.2020: Modified from VADASR for dealing with RAM36hf predictions C 28.02.2020: Coding of quantum number values >99 and <-10 C 2.03.2020: Dealing also with RAM36 predictions C 19.10.2023: Allowing lines with starred errors to be also read in C C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ c c c conversion from RAM36: c c Upper level Lower level Intensity Calculated(Unc.) Elow Strength c c1 0 2 0 2 A2 0 1 0 1 0.110E+00 8410.4988( 0.0004) 2.5464 1.395 c1 0 2 1 2 B2 0 1 1 1 0.424E-01 7764.0451( 0.0004) 2.6535 0.633 C c first character is A or E but is replaced by C to preserve column count and display the line as a comment c C------------------------------------------------------------------------------- c conversion from RAM36HF: c c Upper level Lower level Intensity Calculated (Unc.) Elow Strength c c2 0 0.0 1 0 1 A1 0 1.0 0 0 0 0.188E+01 16420.6173( 0.0018) 0.0000 0.625E+01 c1 -6 0.0 1 1 0 A2 -6 1.0 0 0 0 0.717E+00 16407.4543( 0.0018) 199.9680 0.625E+01 C c first character is A or E but is replaced by C to preserve column count and display the line as a comment c C------------------------------------------------------------------------------- c output is to .CAT in format: [F13.4,2F8.4,I2,F10.4,I3,I7,I4,12I2] c c FREQ ERR LGINT ELO TAG QNUPPER QNLOWER c DR GUP QNFMT c /MHz /MHz /cm-1 c c ,....1....,....2....,....3....,....4....,....5....,....6....,....7....,....8 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 18947.0906 0.0153-10.9032 3 3.3731 15 02305 8 7 1 2 7 7 7 0 1 7 c 18947.2878 0.0153 -9.3688 3 3.3732 21 02305 8 7 1 310 7 7 0 310 c C___:____|____:____|____:____|____:____|____:____|____:____|____:____|____:____|____:____|____:____| C C C C implicit real*8 (a-h,o-z) character line*200,linout*100,lineqn*60 c WRITE(*,5500) 5500 FORMAT(1X//' ',76(1H_)/' |',T79,'|'/ * ' | VADCAT - Converter of predictions from Vadim Ilyushin''s', * T79,'|'/ * ' | RAM36 and RAM36HF programs to .CAT files read ', * 'by ASCP_L', * T79,'|'/ * ' |',76(1H_),'|'/' version 19.X.2023',T64,'Zbigniew KISIEL'/) c write(*,5501) 5501 format(/5x, *'This program requires predictive output from RAM36 or RAM36HF,'/ * 5x,'obtained by setting the first switch in the seventh line'/ * 5x,'after the &&&END line to +1 or -1'//5x, *'The predictions PREDICTVT0.TXT file has to be copied to file'/5x, *'VADCAT.INP. If file PREDICTVT1.TXT was also generated then'/5x, *'this can be appended to VADCAT.INP.'//) c c nlines=0 c open(4,file='vadcat.inp',status='old',err=8) open(3,file='vadcat.cat',status='unknown') write(*,'(1x,2a)')'Reading from: ','vadcat.inp' write(*,'(1x,2a)')' Writing to: ','vadcat.out' c open(10,file='m0.cat',status='unknown') open(11,file='m1.cat',status='unknown') open(12,file='m2.cat',status='unknown') open(13,file='m3.cat',status='unknown') open(14,file='m-3.cat',status='unknown') open( 9,file='m-2.cat',status='unknown') open(15,file='m-4.cat',status='unknown') open( 8,file='m4.cat',status='unknown') open(16,file='m-5.cat',status='unknown') open( 7,file='m5.cat',status='unknown') open(17,file='m-6.cat',status='unknown') open(18,file='m6.cat',status='unknown') open(19,file='m7.cat',status='unknown') open(20,file='m8.cat',status='unknown') open(21,file='m9.cat',status='unknown') c read(4,*)line read(4,*)line read(4,*)line c write(*,'(1x/'' Number of processed lines:''//1x,$)') write(*,'(1H+,i8,$)')0 c c c...Loop dealing with each predicted line in turn c 5 read(4,'(a)',err=6,end=6)line c c...use the decimal point in frequency and the E in intensity to detect c program version c iflow=0 ifupp=0 c iram36=0 if(line(61:61).eq.'.'.and.line(48:48).eq.'E')iram36=1 ram36 if(line(73:73).eq.'.'.and.line(60:60).eq.'E')iram36=2 ram36hf if(iram36.eq.0)goto 5 c c c...RAM36 c if(iram36.eq.1)then read(line(25:26),'(i2)',err=5)mtest if(iabs(mtest).gt.9)goto 5 mlow=mtest c read(line( 3: 5),'(i3)',err=5)mupp c read(line( 7: 9),'(i3)',err=5)jupp read(line(28:30),'(i3)',err=5)jlow read(line(11:13),'(i3)',err=5)kaupp read(line(32:34),'(i3)',err=5)kalow read(line(15:17),'(i3)',err=5)kcupp read(line(36:38),'(i3)',err=5)kclow c read(line(52:65),'(f14.4)',err=5)freq c if(line(67:74).eq.'********')then ferr=999.d0 else read(line(67:74),'( f8.4)',err=5)ferr endif c read(line(77:87),'(f11.4)',err=5)elow c read(line(40:51),'(E12.3)',err=5)sint slogint=dlog10(sint) c iqnfmt=14 endif c c c...RAM36hf c if(iram36.eq.2)then read(line(31:32),'(i2)',err=5)mtest if(iabs(mtest).gt.9)goto 5 mlow=mtest c read(line(7:11), '(f5.1)',err=5)fupp read(line(34:38),'(f5.1)',err=5)flow c if(flow.lt.0)iflow=flow if(fupp.lt.0)ifupp=fupp c if(flow.gt.0.d0)iflow=int(flow+0.5d0) if(fupp.gt.0.d0)ifupp=int(fupp+0.5d0) c read(line( 3: 5),'(i3)',err=5)mupp c read(line(13:15),'(i3)',err=5)jupp read(line(40:42),'(i3)',err=5)jlow read(line(17:19),'(i3)',err=5)kaupp read(line(44:46),'(i3)',err=5)kalow read(line(21:23),'(i3)',err=5)kcupp read(line(48:50),'(i3)',err=5)kclow c read(line(64:77),'(f14.4)',err=5)freq c if(line(79:86).eq.'********')then ferr=999.d0 else read(line(79:86),'( f8.4)',err=5)ferr endif c read(line(89:99),'(f11.4)',err=5)elow c read(line(52:63),'(E12.3)',err=5)sint slogint=dlog10(sint) c iqnfmt=43 endif c itag=0 idr=3 igup=1 c c 10 write(linout,11) 11 format(80(' ')) write(linout,12) freq,ferr,slogint,idr,elow,igup,itag,iqnfmt, * jupp,kaupp,kcupp,mupp,ifupp,0, * jlow,kalow,kclow,mlow,iflow,0 12 format(F13.4,2F8.4,I2,F10.4,I3,I7,I4,12I2) linout(67:67)=' ' linout(79:79)=' ' if(iram36.eq.1)then linout(65:65)=' ' linout(77:77)=' ' endif c write(lineqn,'(12i5)')jupp,kaupp,kcupp,mupp,ifupp,0, * jlow,kalow,kclow,mlow,iflow,0 c call checkout(linout,lineqn) <----- if(linout(14:14).ne.' ')linout(14:14)=' ' c write(3,'(a)')linout if(mlow.eq. 0)then nm0=nm0+1 write(10,'(a)')linout endif c if(mlow.eq. 1)then nm1=nm1+1 write(11,'(a)')linout endif c if(mlow.eq. 2)then nm2=nm2+1 write(12,'(a)')linout endif c if(mlow.eq.-2)then nmm2=nmm2+1 write( 9,'(a)')linout endif c if(mlow.eq. 3)then nm3=nm3+1 write(13,'(a)')linout endif c if(mlow.eq.-3)then nmm3=nmm3+1 write(14,'(a)')linout endif c if(mlow.eq.-4)then nmm4=nmm4+1 write(15,'(a)')linout endif c if(mlow.eq. 4)then nm4=nm4+1 write( 8,'(a)')linout endif c if(mlow.eq.-5)then nmm5=nmm5+1 write(16,'(a)')linout endif c if(mlow.eq. 5)then nm5=nm5+1 write( 7,'(a)')linout endif c if(mlow.eq.-6)then nmm6=nmm6+1 write(17,'(a)')linout endif c if(mlow.eq. 6)then nm6=nm6+1 write(18,'(a)')linout endif c if(mlow.eq. 7)then nm7=nm7+1 write(19,'(a)')linout endif c if(mlow.eq. 8)then nm8=nm8+1 write(20,'(a)')linout endif c if(mlow.eq. 9)then nm9=nm9+1 write(21,'(a)')linout endif c nlines=nlines+1 if((nlines/1000)*1000.eq.nlines)then write(*,'(1H+,i8,$)')nlines endif c goto 5 c 6 close(3) close(4) c close(10) close(11) close(12) close(13) close(14) close(15) close(16) close(17) close(18) close( 9) close( 8) close( 7) close(19) close(20) close(21) c write(*,'(1x//'' Total = '',I12//)')nlines c if(nm0.gt.0)write(*, '(I12,'' lines written to M0.cat'')')nm0 if(nm1.gt.0)write(*, '(I12,'' lines written to M1.cat'')')nm1 if(nm2.gt.0)write(*, '(I12,'' lines written to M2.cat'')')nm2 if(nmm2.gt.0)write(*,'(I12,'' lines written to M-2.cat'')')nmm2 if(nm3.gt.0)write(*, '(I12,'' lines written to M3.cat'')')nm3 if(nmm3.gt.0)write(*,'(I12,'' lines written to M-3.cat'')')nmm3 if(nmm4.gt.0)write(*,'(I12,'' lines written to M-4.cat'')')nmm4 if(nm4.gt.0)write(*, '(I12,'' lines written to M4.cat'')')nm4 if(nmm5.gt.0)write(*,'(I12,'' lines written to M-5.cat'')')nmm5 if(nm5.gt.0)write(*, '(I12,'' lines written to M5.cat'')')nm5 if(nmm6.gt.0)write(*,'(I12,'' lines written to M-6.cat'')')nmm6 if(nm6.gt.0)write(*, '(I12,'' lines written to M6.cat'')')nm6 if(nm7.gt.0)write(*, '(I12,'' lines written to M7.cat'')')nm7 if(nm8.gt.0)write(*, '(I12,'' lines written to M8.cat'')')nm8 if(nm9.gt.0)write(*, '(I12,'' lines written to M9.cat'')')nm9 stop c 8 write(*,9) 9 format(1x///' ***** ERROR: the file for conversion should ', * 'first be copied to VADCAT.INP '//) c stop end C C_____________________________________________________________________________ C------------------------------------------------------------------------------- C C------------------------------------------------------------------------------- subroutine checkout(linout,lineqn) c c...Routine to, if necessary, encode two digit coding of quantum numbers used by SPCAT c from I5 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 This routine: C c 1/ identifies overflowed quntum number fields in LINEOUT C 2/ if ** is encountered then the value of the quantum number is C taken from LINEQN, coded, and placed into LINOUT C c C LINEQN - quantum numbers in 12I5 format (six qns of upper state, C followed by six qns of the lower state) C LINOUT - standard .CAT line containing 12I2 quantum numbers c character linout*100,lineqn*60,cpos(25)*1,cneg(25)*1,cdig(10)*1 c DATA cpos/'A','B','C','D','E','F','G','H','I','J', * 'K','L','M','N','O','P','Q','R','S','T', * 'U','V','X','Y','Z'/ DATA cneg/'a','b','c','d','e','f','g','h','i','j', * 'k','l','m','n','o','p','q','r','s','t', * 'u','v','x','y','z'/ DATA cdig/'0','1','2','3','4','5','6','7','8','9'/ c c c...Go through each of the twelve quantum numbers in turn, check, and if c necessary convert c NOTE: only the >99 conversion is supported in this version since RAM36hf c does not generate large negative numbers (there is only F=-1 for c hyperfine unresolved measurements) c ichang=0 nnn=56 nq=1 do 1159 n=1,12 if(linout(nnn:nnn).ne.'*')goto 1158 c ichang=1 read(lineqn(nq:nq+4),'(i5)')iqval c i=iabs(iqval) i1=i/10 i2=i-10*i1+1 i1=i1-9 linout(nnn:nnn+1)=cpos(i1)//cdig(i2) c 1158 nnn=nnn+2 nq=nq+5 c 1159 continue c if(ichang.eq.1)then c write(*,*)(linout(56:56+11)),iqval c pause c endif c return end C_____________________________________________________________________________ c