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