C------------------------------------------------------------------------------- C V I C O N T R - To extract parameter contributions to measured lines C as printed in the EXPECTVT0 file (and if necessary also C in EXPECTVT1) C------------------------------------------------------------------------------- C C RAM36HF version only, default input is from expectvt0.txt with C additional input/output as defined in VICONTR.INP C C Information on transitions to use for contributions comes from the C .OUT file produced by RAM36HF C C Complete end of line commenting comes from the .LIN file associated with C the .OUT file. This file is generated from the .OUT file by VIFORM, or C is the file that forms the basis of the transitions block in the .INP C file prior to conversion with LINVAD. C C C NOTE: It is crucial to ensure that the .OUT and .LIN files correspond C to the same fit C C C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C For RAM36HF the file VICONTR.INP should consist of four active lines : C c name of the .log file for output: highJ.log c name of the input .out file: highJ.out c name of the input .lin file: highJ.lin c spin of hyperfine nucleus (real): 1.0 C_______________________________________ C d e s c r i p t o r |_____ d a t a (starting on column 41) C C C C ver. 17.V.2021 ----- 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 15.12.20: VICONTR from LINVADM c 17.12.20: improvements and testing c 28.12.20: exclusion identification c 11.01.21: transfer of commenting c 13.01.21: complete commenting from the .LIN file c 19.01.21: correction for counting the number of parameters of fit c 22.02.21: Kc remediation + tweaks c 18.05.21: using also EXPECTVT1 if |dm|=1 transitions C_____________________________________________________________________________ C C IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*4 (I-N) parameter (maxlin=1500000, maxlin1=500000, c maxcon=70, maxexp=15000) c character line*200,filelog*30,fileout*30,coment*300,fileexp*30, * linpred*1000,linexpt*1000,descr(maxcon)*11,cflag*2, * lincom(maxexp)*200,linout*300,filelin*30,inftext*100, * fileexp1*30 integer linq(12),parind(10) real*4 contrib(maxlin,maxcon),fpred(maxlin,2), * fexpt(maxexp,2),parcontr(maxexp,10) real*4 contrib1(maxlin1,maxcon),fpred1(maxlin1,2) real*8 freqexpt(maxexp) integer jstart(200),predqn(maxlin,6),mpred(maxlin,2), * jstart1(200),predqn1(maxlin1,6),mpred1(maxlin1,2), * exptqn(maxexp,6),mexpt(maxexp,2), * ifit(maxexp),ieofline(maxexp) c fileexp ='expectvt0.txt' fileexp1='expectvt1.txt' c c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . c Deal with the control file (unit 4) c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . c WRITE(*,5500) 5500 FORMAT(1X//' ',76(1H_)/' |',T79,'|'/ * ' | VICONTR - Contribution extractor from EXPECTVT.TXT ', * 'file(s)', * T79,'|'/ * ' | written by Vadim Ilyushin''s RAM36HF ', * 'program',T79,'|'/ * ' |',76(1H_),'|'/' version 18.V.2021',T64,'Zbigniew KISIEL'/) c open(4,file='vicontr.inp',status='old',err=27) read(4,'(40x,a)',err=27)filelog read(4,'(40x,a)',err=27)fileout read(4,'(40x,a)',err=27)filelin c read(4,'(40x,(f15.5))',err=12,end=12)spin if(spin.lt.0.d0)then write(*,'(1x//1x,a,f10.5//)')'Problem with the spin = ',spin write(*,*)dble(int(spin*2.d0))*0.5d0 stop endif spin=nint(2.d0*spin)*0.5d0 goto 13 12 write(*,'(1x//1x,a,f10.5//)')'Problem with the spin = ',spin stop c 13 write(*,'(1x//1x,a,f10.5/)')'Input from VICONTR.INP, spin = ',spin close(4) c open(3,file=fileout,status='old',err=1030) .out file from ram36hf = unit 3 write(*,'(1x,2a)')'Reading from: ',fileout(1:len_trim(fileout)) open(2,file=filelog,status='unknown') .log output = unit 2 write(*,'(1x,2a)')'Writing to: ',filelog(1:len_trim(filelog)) open(1,file=filelin,status='old',err=1029) .lin file consistent with .out = unit 1 write(*,'(1x,2a)')'Reading from: ',filelin(1:len_trim(filelin)) c write(2,56)fileout(1:len_trim(fileout)), * filelin(1:len_trim(filelin)),spin 56 format(1x/1x,94('-')/ * ' Parameter contributions to transition frequencies ', * 'extracted from EXPECTVT.TXT file(s)'// * ' using information from RAM36HF output file: ',a/ * ' lines file (from VIFORM): ',a/ * ' and spin: ',f6.3/ * 1x,94('-')/ ) c c c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . c Read the .out file and fish out from the first iteration block the names and c the number of fitted parameters c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . c 16 read(3,'(a)',end=17,err=17)line if(line( 1:29).ne.' iteration number 1')goto 16 c 18 read(3,'(a)')line if(len_trim(line).ne.111)goto 18 npars=0 goto 118 c 19 read(3,'(a)',end=17,err=17)line if(len_trim(line).le.1)goto 20 118 npars=npars+1 read(line(2:12),'(a)')descr(npars) goto 19 c c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . c Read the expectvt0.txt file, noting the indices of new J values to be c used for quick access (unit 4 reused) c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . c c predqn(1) =J fpred(1) = F mpred(1) = m c predqn(2) =Ka fpred(2) = F" mpred(2) = m" c predqn(3) =Kc c predqn(4) =J" c predqn(5) =Ka" c predqn(6) =Kc" c c...skip two header lines 20 open(4,file=fileexp,status='old',err=1027) expectvt0.txt from ram36hf = unit 4 write(*,'(/1x,2a)')'Reading from: ',fileexp(1:len_trim(fileexp)) read(4,'(a)',end=15,err=15)linpred read(4,'(a)',end=15,err=15)linpred npred=0 lastj=-1 c 14 read(4,'(a)',end=15,err=15)linpred if(linpred(70:72).eq.'NaN')goto 14 c npred=npred+1 inftext= * 'Reading upper state J,Ka,Kc from EXPECTVT0.TXT line' read(linpred(12:),*,err=21,end=21) * predqn(npred,1),predqn(npred,2),predqn(npred,3) inftext= * 'Reading lower state J,Ka,Kc from EXPECTVT0.TXT line' read(linpred(39:),*,err=21,end=21) * predqn(npred,4),predqn(npred,5),predqn(npred,6) c inftext= * 'Reading upper state m from EXPECTVT0.TXT line' read(linpred(3:), '(i3)',err=21,end=21)mpred(npred,1) inftext= * 'Reading lower state m from EXPECTVT0.TXT line' read(linpred(30:),'(i3)',err=21,end=21)mpred(npred,2) c inftext= * 'Reading upper state F from EXPECTVT0.TXT line' read(linpred(6:), '(f6.1)',err=21,end=21)fpred(npred,1) inftext= * 'Reading lower state F from EXPECTVT0.TXT line' read(linpred(33:),'(f6.1)',err=21,end=21)fpred(npred,2) c j=predqn(npred,4) if(j.gt.lastj)then jstart(j)=npred lastj=j write(*,'(2i12)')j,npred endif c inftext= * 'Reading parameter contributions from EXPECTVT0.TXT line' read(linpred(68:),*,err=21,end=21) * (contrib(npred,nn),nn=1,npars) goto 14 15 close(4) c c c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . c Read the measured transitions from the .OUT file c and read the full end of line comments from the associated .LIN file c c Quantum numbers are placed in a way mirroring the predictions: c c exptqn(1) =J frxpt(1) = F mexpt(1) = m c exptqn(2) =Ka frxpt(2) = F" mexpt(2) = m" c exptqn(3) =Kc c exptqn(4) =J" c exptqn(5) =Ka" c exptqn(6) =Kc" c c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . c ndeltam1=0 nexpt=0 22 read(3,'(a)',end=26,err=26)linexpt if(linexpt(16:23).ne.'original')goto 22 read(3,'(a)',end=26,err=26)linexpt c 23 read(3,'(a)',end=26,err=26)linexpt if(linexpt(1:2).eq.' ')goto 24 c nexpt=nexpt+1 read(linexpt(12:),*,err=26,end=26) * exptqn(nexpt,1),exptqn(nexpt,2),exptqn(nexpt,3) read(linexpt(39:),*,err=26,end=26) * exptqn(nexpt,4),exptqn(nexpt,5),exptqn(nexpt,6) c read(linexpt(3:), '(i3)',err=26,end=26)mexpt(nexpt,1) read(linexpt(30:),'(i3)',err=26,end=26)mexpt(nexpt,2) if(mexpt(nexpt,1).ne.mexpt(nexpt,2))ndeltam1=ndeltam1+1 c read(linexpt(6:), '(f6.1)',err=26,end=26)fexpt(nexpt,1) read(linexpt(33:),'(f6.1)',err=26,end=26)fexpt(nexpt,2) c read(linexpt(64:77),'(F14.4)',err=26,end=26)freqexpt(nexpt) read(linexpt(143:143),'(i1)',err=26,end=26)ifit(nexpt) c if(linexpt(145:145).eq.'!'.or.linexpt(145:145).eq.'#')then read(1,'(a)')coment ieofline(nexpt)=1 lincom(nexpt)=coment(77:len_trim(coment)) else read(1,'(a)')coment lincom(nexpt)=' ' ieofline(nexpt)=0 endif c c...deal with F=-1 setting F=J+1 c if(fexpt(nexpt,1).eq.-1.0)then fexpt(nexpt,1)=exptqn(nexpt,1)+spin endif c if(fexpt(nexpt,2).eq.-1.0)then fexpt(nexpt,2)=exptqn(nexpt,4)+spin endif c goto 23 c 24 close(3) c c c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . c If necessary then read the expectvt1.txt file: this is expected to be c much smaller than expectvt1.txt (unit 4 reused again) c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . c c predqn1(1) =J fpred1(1) = F mpred1(1) = m c predqn1(2) =Ka fpred1(2) = F" mpred1(2) = m" c predqn1(3) =Kc c predqn1(4) =J" c predqn1(5) =Ka" c predqn1(6) =Kc" c if(ndeltam1.le.0)goto 115 c open(4,file=fileexp1,status='old',err=1028) expectvt1.txt from ram36hf = unit 4 write(*,'(/1x,2a)') * 'Reading from: ',fileexp1(1:len_trim(fileexp1)) c c...skip two header lines read(4,'(a)',end=115,err=115)linpred read(4,'(a)',end=115,err=115)linpred npred1=0 lastj1=-1 c 114 read(4,'(a)',end=115,err=115)linpred if(linpred(70:72).eq.'NaN')goto 114 c npred1=npred1+1 inftext= * 'Reading upper state J,Ka,Kc from EXPECTVT1.TXT line' read(linpred(12:),*,err=21,end=21) * predqn1(npred1,1),predqn1(npred1,2),predqn1(npred1,3) inftext= * 'Reading lower state J,Ka,Kc from EXPECTVT1.TXT line' read(linpred(39:),*,err=21,end=21) * predqn1(npred1,4),predqn1(npred1,5),predqn1(npred1,6) c inftext= * 'Reading upper state m from EXPECTVT1.TXT line' read(linpred(3:), '(i3)',err=21,end=21)mpred1(npred1,1) inftext= * 'Reading lower state m from EXPECTVT1.TXT line' read(linpred(30:),'(i3)',err=21,end=21)mpred1(npred1,2) c inftext= * 'Reading upper state F from EXPECTVT1.TXT line' read(linpred(6:), '(f6.1)',err=21,end=21)fpred1(npred1,1) inftext= * 'Reading lower state F from EXPECTVT1.TXT line' read(linpred(33:),'(f6.1)',err=21,end=21)fpred1(npred1,2) c j=predqn1(npred1,4) if(j.gt.lastj1)then jstart1(j)=npred1 lastj1=j write(*,'(2i12)')j,npred1 endif c inftext= * 'Reading parameter contributions from EXPECTVT1.TXT line' read(linpred(68:),*,err=21,end=21) * (contrib1(npred1,nn),nn=1,npars) goto 114 c c...Summary of input c 115 write(*,'(1x/i8,'' parameters of fit''/)')npars write(2,'(1x/i8,'' parameters of fit'')')npars c write(*,'(i8,'' prediction lines read from EXPECTVT0.TXT''/)') * npred write(2,'(i8,'' prediction lines read from EXPECTVT0.TXT''/)') * npred c write(*,'(i8,'' measured lines read from '',a)')nexpt, * fileout(1:len_trim(fileout)) write(2,'(i8,'' measured lines read from '',a)')nexpt, * fileout(1:len_trim(fileout)) if(ndeltam1.gt.0)then write(*,'(i8,'' of these are deltam.ne.0 lines'')')ndeltam1 write(2,'(i8,'' of these are deltam.ne.0 lines'')')ndeltam1 endif c if(npred1.gt.0)then write(*,'(1x/i8,'' deltam.ne.0 prediction lines read from'', * '' EXPECTVT1.TXT''/)')npred1 write(2,'(1x/i8,'' deltam.ne.0 prediction lines read from'', * '' EXPECTVT1.TXT''/)')npred1 close(4) endif c c c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . c Extract contributions for up to 10 parameters of fit c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C c Contributions are extracted directly after declaring the parameter. c c NCONTR - the number of parameters for which contributions are being listed c NDELM - the number of experimental lines with delta_M.ne.0 c ncontr=0 ndelm=0 30 write(*,45) 45 format(1x/ * ' List of parameters of fit (frequency contributions for up to'/ * ' ten of these can be selected, ', * '0 or just ENTER ends selection):'/) nn=npars/2 do 31 n=1,nn write(*,32)n,descr(n),n+nn,descr(n+nn) 31 continue 32 format(i15,2x,a,10x,i5,2x,a) if(2*nn.ne.npars)write(*,33)npars,descr(npars) 33 format(38x,i5,2x,a) c 34 if(ncontr.ge.1)then write(*,70)(parind(iii),iii=1,ncontr) 70 format(1x/' Parameters declared so far: ',11i3) endif write(*,35) 35 format(1x/' The number of parameter for contributions .... ',$) read(*,'(i5)',err=30)ipar if(ipar.lt.0.or.ipar.gt.npars)goto 30 if(ipar.eq.0)goto 17 exit write(*,'(1x)') c c . . . . . . . . . . . . . . . . . . . . . c c...Iterate over the observed lines, and in the inner loop iterate over c the prediction lines. c The first inner loop scans dm=0 predictions, and the (optionally run) c second inner loop scans dm.ne.0 predictions c JFIRST is used to limit scanning over the predictions, which are c in general of the order of J, but with some backtracking in J by 1 c JSTART(j) contains the line number in EXPECTVT0.TXT with the first occurrence c of J=j c nproblem=0 ncontr=ncontr+1 parind(ncontr)=ipar c do 36 n=1,nexpt iterate over experimental lines j=exptqn(n,4) iexpkc=exptqn(n,3)-exptqn(n,6) exptal Kc'-Kc" c if(mexpt(n,1).eq.mexpt(n,2))then jfirst=jstart(j) else jfirst=jstart1(j) goto 237 endif c c c...match experimental lines against dm=0 predictions c do 37 nn=jfirst,npred iterate over dm=0 predictions jpred=predqn(nn,4) c c...output for unidentified lines if prediction table was scanned for c more than four j values above the starting one c if(jpred.gt.j+4)then if(nproblem.eq.0.and.ncontr.eq.1)write(2,57) nproblem=nproblem+1 write(*,53)n,freqexpt(n), * mexpt(n,1),exptqn(n,1),exptqn(n,2),exptqn(n,3),int(fexpt(n,1)), * mexpt(n,2),exptqn(n,4),exptqn(n,5),exptqn(n,6),int(fexpt(n,2)), * ': not located' if(ncontr.eq.1) & write(2,53)n,freqexpt(n), * mexpt(n,1),exptqn(n,1),exptqn(n,2),exptqn(n,3),int(fexpt(n,1)), * mexpt(n,2),exptqn(n,4),exptqn(n,5),exptqn(n,6),int(fexpt(n,2)), * ': not located' c goto 36 endif 53 format(i6,f14.4,1x,5i4,' <-',i3,4i4,a) 57 format(1x/'Problematic lines (not located or requiring ', * 'corrected indices):'/) c c..check whether the predicted line (index nn) matches c the experimental line (index n) c jump to end of loop if not c do 38 nnn=1,2 match J,Ka if(predqn(nn,nnn).ne.exptqn(n,nnn))goto 37 38 continue c do 52 nnn=4,5 match J",Ka" if(predqn(nn,nnn).ne.exptqn(n,nnn))goto 37 52 continue c do 39 nnn=1,2 match m if(mpred(nn,nnn).ne.mexpt(n,nnn))goto 37 39 continue do 40 nnn=1,2 if(fpred(nn,nnn).ne.fexpt(n,nnn))goto 37 match f 40 continue c c...Cludge to compensate for Kc switch for high-Ka doublets c ipredkc=predqn(nn,3)-predqn(nn,6) calc Kc'-Kc" if(ipredkc.eq.iexpkc)goto 51 match c if(exptqn(n,2).eq.exptqn(n,5).and.exptqn(n,2).gt.4)then idelpkc=iabs(predqn(nn,3)-predqn(nn,6)) if(idelkc.eq.0.or.idelkc.eq.2)then if(nproblem.eq.0.and.ncontr.eq.1)write(2,57) nproblem=nproblem+1 write(*,54)freqexpt(n), * mexpt(n,1),exptqn(n,1),exptqn(n,2),exptqn(n,3),int(fexpt(n,1)), * mexpt(n,2),exptqn(n,4),exptqn(n,5),exptqn(n,6),int(fexpt(n,2)), * predqn(nn,3),predqn(nn,6) if(ncontr.eq.1)write(2,54)freqexpt(n), * mexpt(n,1),exptqn(n,1),exptqn(n,2),exptqn(n,3),int(fexpt(n,1)), * mexpt(n,2),exptqn(n,4),exptqn(n,5),exptqn(n,6),int(fexpt(n,2)), * predqn(nn,3),predqn(nn,6) goto 51 endif else if(predqn(nn,3).ne.exptqn(n,3))goto 37 match Kc' if(predqn(nn,6).ne.exptqn(n,6))goto 37 match Kc" endif 54 format(f13.4,1x,5i3,' <-',i3,4i3,' Kc correction: calc=', * i3,' <-',i3) c c...add contribution to the identified experimental line c 51 parcontr(n,ncontr)=contrib(nn,ipar) goto 36 c 37 continue goto 36 c c c...match experimental lines against dm.ne.0 predictions c 237 iexpkc=exptqn(n,3)-exptqn(n,6) c do 137 nn=jfirst,npred iterate over dm.ne.0 predictions jpred=predqn1(nn,4) c c...output for unidentified lines if prediction table was scanned for c more than four j values above the starting one c if(jpred.gt.j+4)then if(nproblem.eq.0.and.ncontr.eq.1)write(2,57) nproblem=nproblem+1 write(*,53)n,freqexpt(n), * mexpt(n,1),exptqn(n,1),exptqn(n,2),exptqn(n,3),int(fexpt(n,1)), * mexpt(n,2),exptqn(n,4),exptqn(n,5),exptqn(n,6),int(fexpt(n,2)), * ': not located' if(ncontr.eq.1) & write(2,53)n,freqexpt(n), * mexpt(n,1),exptqn(n,1),exptqn(n,2),exptqn(n,3),int(fexpt(n,1)), * mexpt(n,2),exptqn(n,4),exptqn(n,5),exptqn(n,6),int(fexpt(n,2)), * ': not located' c goto 36 endif c c..check whether the predicted line (index nn) matches c the experimental line (index n) c jump to end of loop if not c do 138 nnn=1,2 match J,Ka if(predqn1(nn,nnn).ne.exptqn(n,nnn))goto 137 138 continue c do 152 nnn=5,5 match J",Ka" if(predqn1(nn,nnn).ne.exptqn(n,nnn))goto 137 152 continue c do 139 nnn=1,2 match m if(mpred1(nn,nnn).ne.mexpt(n,nnn))goto 137 139 continue do 140 nnn=1,2 if(fpred1(nn,nnn).ne.fexpt(n,nnn))goto 137 match f 140 continue c c...Cludge to compensate for Kc switch for high-Ka doublets (not really tested) c ipredkc=predqn1(nn,3)-predqn1(nn,6) if(ipredkc.eq.iexpkc)goto 151 if(exptqn(n,2).eq.exptqn(n,5).and.exptqn(n,2).gt.4)then idelpkc=iabs(predqn(nn,3)-predqn(nn,6)) if(idelkc.eq.0.or.idelkc.eq.2)then if(nproblem.eq.0.and.ncontr.eq.1)write(2,57) nproblem=nproblem+1 write(*,54)freqexpt(n), * mexpt(n,1),exptqn(n,1),exptqn(n,2),exptqn(n,3),int(fexpt(n,1)), * mexpt(n,2),exptqn(n,4),exptqn(n,5),exptqn(n,6),int(fexpt(n,2)), * predqn1(nn,3),predqn1(nn,6) if(ncontr.eq.1)write(2,54)freqexpt(n), * mexpt(n,1),exptqn(n,1),exptqn(n,2),exptqn(n,3),int(fexpt(n,1)), * mexpt(n,2),exptqn(n,4),exptqn(n,5),exptqn(n,6),int(fexpt(n,2)), * predqn1(nn,3),predqn1(nn,6) goto 151 endif else if(predqn1(nn,3).ne.exptqn(n,3))goto 137 if(predqn1(nn,6).ne.exptqn(n,6))goto 137 endif c c...add contribution to the identified experimental line c 151 parcontr(n,ncontr)=contrib1(nn,ipar) goto 36 c 137 continue c 36 continue end sweep over exptal lines c c...return to parameter selection c if(ncontr.lt.10)goto 30 c c c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . c Output of contributions c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 17 if(ndelm.gt.0)then write(*,'(1x)') write(*,44)ndelm write(2,44)ndelm endif 44 format(i8, * ' unmatched lines with differing upper and lower state m') c write(2,42)(descr(parind(n)),n=1,ncontr) 42 format(1x/ * 'Parameter contributions to measured transition frequencies:'// * 71x,10(2x,a11)) write(2,'(1x)') c do 43 n=1,nexpt if(n.eq.(n/40)*40)then write(2,60)(descr(parind(nc)),nc=1,ncontr) write(2,'(1x)') endif 60 format(1x/1x,34(' .'),2x,10(2x,a11)) c cflag=' ' if(ifit(n).eq.0)cflag=' E' c c...extract end of line comment c coment=' ' if(ieofline(n).eq.1)then lencom=len_trim(lincom(n)) if(lincom(n)(1:1).eq.'#')then if(lencom.eq.1)then coment=' ' goto 1002 endif do 1000 nn=2,lencom if(lincom(n)(nn:nn).eq.'!')then lenc=nn-1 goto 1001 endif 1000 continue lenc=nn 1001 coment=lincom(n)(2:lenc) else lenc=0 coment=' ' endif c c...extract and write comment line(s) preceding the current line c lstart=lenc+1 lfinal=lencom if(lstart.lt.1)goto 1002 1006 if(lincom(n)(lstart:lstart).eq.'!')then do 1004 nn=lstart+1,lencom if(lincom(n)(nn:nn).eq.'!')then lfinal=nn-1 goto 1005 endif 1004 continue lfinal=lencom 1005 write(2,'(1x,a)')lincom(n)(lstart:lfinal) LOG output if(lfinal.eq.lencom)then goto 1002 else lstart=lfinal+1 goto 1006 endif endif c endif c c...transition output c 1002 write(linout,41)n,cflag,freqexpt(n), * mexpt(n,1),exptqn(n,1),exptqn(n,2),exptqn(n,3),fexpt(n,1), * mexpt(n,2),exptqn(n,4),exptqn(n,5),exptqn(n,6),fexpt(n,2), * (parcontr(n,nn),nn=1,ncontr) write(2,'(a)')linout(1:len_trim(linout))//' '// LOG output * coment(1:len_trim(coment)) 43 continue 41 format(i5,a,f13.4,4i4,f6.1,' <-',4i4,f6.1,10f13.4) c write(2,55) 55 format(1x/1x,94('-')/) close(2) stop c C_____________________________________________________________________________ c c...Error conditions c 21 write(*,'(1x//'' PROBLEMATIC PREDICTION LINE:''//1x,a// * '' ***** Problem '',a//)') * (linpred(1:len_trim(linpred))), * (inftext(1:len_trim(inftext))) stop c 26 write(*,'(1x//'' PROBLEMATIC TRANSITION LINE:''//1x,a/)') * (linexpt(1:len_trim(linexpt))) stop c 27 write(*,'(1x//'' Missing or unreadable VICONTR.INP file''//1x)') stop 1027 write(*,'(1x//'' Missing or unreadable EXPECTVT0.TXT file''//1x)') stop 1028 write(*,'(1x//'' Missing or unreadable EXPECTVT1.TXT file''//1x)') stop 1029 write(*,'(1x//'' Missing or unreadable .LIN file: ''a//1x)') * filelin(1:len_trim(filelin)) 1030 write(*,'(1x//'' Missing or unreadable .OUT file: ''a//1x)') * fileout(1:len_trim(fileout)) stop c end c C_____________________________________________________________________________ C_____________________________________________________________________________