program nsconn c c used in accounting system v7 to construct the non-standard c connect rate table. this program produces the file NSCONNECT.CMD c which is included in HELV7.TSK by a @ reference in the task c builder command file, the file NCCONNECT.CMD which is c similarly included in CHG.TSK, and the file NONCONN.CMD which c is included in NONSTAN.TSK c c s.m. thompson april 1981 c school of chemical engineering c olin hall c cornell university c ithaca c ny 14853 c c revision history c ---------------- c c SMT770 12-Oct-81 Added NONSTAN.TSK as a supported task, so c "NSCONN" is now required to create the file c NONCONN.CMD c parameter ilim=100 dimension iconwd(ilim),iusrwd(ilim),iterm(ilim) c open(unit=1,name='nsconnect.cmd',type='new',form='formatted') open(unit=2,name='ncconnect.cmd',type='new',form='formatted') open(unit=3,name='nonconn.cmd',type='new',form='formatted') ient = 0 go to 10 9 write(5,400) 400 format(' *** Illegal entry - please try again ***') 10 write(5,500) 500 format(' Enter TTn,grp,mem,fact: ',$) read(5,*,err=9,end=999) itt,igrp,imem,fact c501 format(3o3,f12.6) ibest = 0 if(itt.eq.0.or.itt.lt.-1)go to 9 if(fact.lt.0.0)go to 9 if(igrp.lt.0.or.igrp.gt."377)go to 9 if(imem.lt.0.or.imem.gt."377)go to 9 if(igrp.eq.0)imem = 0 if(fact.eq.0.0)go to 11 call userwd(fact,ibest,jbest,fact1) 11 if(ibest.eq.0)jbest = 0 15 if(ibest.lt.255.and.jbest.lt.255)go to 16 ibest = ibest/2 jbest = jbest/2 go to 15 16 ient = ient+1 if(ient.le.ilim)go to 17 write(5,460) 460 format(' *** Error - too many entries ***') go to 999 17 iterm(ient) = itt iusrwd(ient) = ishft(igrp,8)+imem iconwd(ient) = ishft(ibest,8)+jbest go to 10 999 if(ient.eq.0)go to 998 ioff = 0 iext = 6*ient write(1,554) iext write(2,554) iext write(3,554) iext 554 format(' EXTSCT=NSCONN:',O) do 600 i = 1,ient write(1,550) ioff,iterm(i) write(2,650) ioff,iterm(i) write(3,750) ioff,iterm(i) 550 format(' GBLPAT=HELV7:NSCTAB+',O,':', 1 O) 650 format(' GBLPAT=CHG:NSCTAB+',O,':', 1 O) 750 format(' GBLPAT=NONSTAN:NSCTAB+',O,':', 1 O) ioff = ioff+2 write(1,551) ioff,iusrwd(i) write(2,651) ioff,iusrwd(i) write(3,751) ioff,iusrwd(i) 551 format(' GBLPAT=HELV7:NSCTAB+',O,':', 1 O) 651 format(' GBLPAT=CHG:NSCTAB+',O,':', 1 O) 751 format(' GBLPAT=NONSTAN:NSCTAB+',O,':', 1 O) ioff = ioff+2 write(1,552) ioff,iconwd(i) write(2,652) ioff,iconwd(i) write(3,752) ioff,iconwd(i) 552 format(' GBLPAT=HELV7:NSCTAB+',O,':', 1 O) 652 format(' GBLPAT=CHG:NSCTAB+',O,':', 1 O) 752 format(' GBLPAT=NONSTAN:NSCTAB+',O,':', 1 O) ioff = ioff+2 600 continue write(1,553) ioff write(2,653) ioff write(3,753) ioff 553 format(' GBLPAT=HELV7:NSCTAB+',O,':0') 653 format(' GBLPAT=CHG:NSCTAB+',O,':0') 753 format(' GBLPAT=NONSTAN:NSCTAB+',O,':0') 998 close(unit=1) close(unit=2) close(unit=3) call exit end function ndig(i) alog8(x) = alog(x)/alog(8.0) ndig = 1 if(i.eq.0)return ndig = 6 if(i.lt.0)return ndig = int(alog8(float(i))+1.001) return end subroutine userwd(ratio,ibest,jbest,best) ratb = 1.0e6 do 10 i = 100,0,-1 j = float(i)/ratio+0.5 if(j.eq.0)go to 10 rat = float(i)/float(j) if(abs(rat-ratio).gt.abs(ratb-ratio))go to 10 ratb = rat ibest = i jbest = j 10 continue best = float(ibest)/float(jbest) return end