Trailing-Edge
-
PDP-10 Archives
-
decus_20tap2_198111
-
decus/20-0050/tblnmb.for
There is 1 other file named tblnmb.for in the archive. Click here to see a list.
SUBROUTINE TBLNMB
C
C ROUTINE TO DEFINE TBLTRN INPUT/OUTPUT UNITS
C
C DONALD BARTH, CHEM DEPT., HARVARD UNIVERSIY
C
C ITTY = TELETYPE UNIT (USED FOR ERROR MESSAGES
C BY TBLTRN AFTER CONVERSATION HERE)
C IREAD = UNIT CONTAINING TABLE TO BE READ
C IWRITE = UNIT ON WHICH DATA STATEMENT IS WRITTEN
C ILPT = UNIT ON WHICH DEBUG LISTINGS ARE WRITTEN
C IOUT = UNIT ON WHICH COPY OF INPUT TABLE IS TO
C BE WRITTEN AS BACKUP IF TABLE IS INPUT
C FROM TELETYPE. NO COPY IS MADE IF IOUT
C IS EQUAL TO ITTY.
C
C TBLNMB IS CALLED BOTH BEFORE THE FIRST TABLE IS READ
C AND AFTER AN END-OF-FILE IS READ FROM THE INPUT DEVICE.
C THE END-OF-FILE CALL IS RECOGNIZED BY THE LINE COUNT
C ILINE BEING NON-ZERO. IN THE CASE OF THE END-OF-FILE
C CALL, THE LINE COUNT IS ZEROED IF ADDITIONAL INPUT
C IS INDICATED BY THE USER.
C
COMMON/TBLTRN/I,IADDRS,IADJST,IBASE,IBLANK,IDGT(16),
1IERR,IFILL,IFKNT,IKODE,ILEFT,ILINE,ILPT,ILTR,IBYTE,
2IMASK,LMAX,NMORE,IMOST,INSERT,IOCT(13),IOPRTR,IOUT,
3IPAREN,IPNCTN(11),IPRCN,IRADIX,IREAD,IREPT,IRIGHT,
4ISHIFT,ISIGN,ISTAR,ISTORE(478),ITEN,ITEST,ITITLE(6),
5ITTY,IWIDE,IWRITE,J,JADJST,JBASE,JBLANK,JERR,KPAREN,
6JFKNT,JKODE(37),JLEFT,JMASK,JMORE,JPAREN,JRADIX,LOOP,
7JRIGHT,JSHIFT,JSIGN,K,KADJST,KBASE,KERR,KIND,KLINE,
8KLM,KLTR,KMASK,KNT,KNTLTR,KNTWRD,KODE,KRADIX,IDBG,
9KREAD,KSHIFT,L,LEAST,LETTER(160),LMASK,LOCK,LSTNEW,
1LTTR(160),M,MASK,MASTER(5000),MAX,MLEFT,MORE,MOST,
2MRIGHT,MULT,N,NEW,NEXT,NSIGN,NTITLE(6),NUMBER,LRADIX,
3KMAX,INLINE,JPNCTN(50),KPNCTN(50),LPNCTN,JOPRTR,NLTR,
4JBYTE,ILOOP,ISKIP,IVALUE,INSN(6),JNSN,IMAX,JMAX,
5KNSN,MLTR,JLTR,JLOOP,IPFX,JPFX,LSIGN,IIARG,JJARG,
6KKARG,LLARG,JVALUE,MIN,IAC,IARG,JARG,KARG,LARG,JSTFY,
7LENGTH(20),LNGMIN,IORDER,IRMV,KSIGN
C
C
C DEFINE DEFAULT UNITS
DATA JREAD, JWRITE, JLPT, JOUT/
1 1, 20, 21, 22/
DATA NAMEI, NAMEO, NAMEL, NAMEB, NULL/
1 5HINPUT,5HOUTPU,5HLIST ,5HBACKU,5H /
C
C ASK USER FOR EXTRA INFO AFTER END-OF-FILE
IF(ILINE.EQ.0)GO TO 7
WRITE(ITTY,1)
1 FORMAT(30H IS THERE MORE INPUT (Y OR N) ,$)
READ(ITTY,2)(IOCT(I),I=1,10)
2 FORMAT(10A1)
DO 3 I=1,10
IF(IOCT(I).EQ.1HY)GO TO 4
IF(IOCT(I).EQ.1HN)GO TO 28
3 CONTINUE
4 ILINE=0
WRITE(ITTY,9)
READ(ITTY,10)IREAD
IF(IREAD.LT.0)GO TO 5
IF(IREAD.EQ.ITTY)GO TO 18
WRITE(ITTY,11)
READ(ITTY,12)NAME
IF(NAME.NE.NULL)GO TO 6
5 NAME=NAMEI
6 IF(IREAD.LE.0)IREAD=JREAD
CALL IFILE(IREAD,NAME)
GO TO 28
C
C DEFINE TELETYPE UNIT NUMBER
7 ITTY=5
IOUT=ITTY
C
C DETERMINE INPUT UNIT AND FILE
WRITE(ITTY,8)
8 FORMAT(15H TBLTRN (01/73)/1X)
WRITE(ITTY,9)
9 FORMAT(21H INPUT UNIT NUMBER = ,$)
READ(ITTY,10)IREAD
10 FORMAT(I)
IF(IREAD.LT.0)GO TO 25
IF(IREAD.EQ.ITTY)GO TO 17
IF(IREAD.EQ.0)IREAD=JREAD
WRITE(ITTY,11)
11 FORMAT(19H INPUT FILE NAME = ,$)
READ(ITTY,12)NAME
12 FORMAT(1A5)
IF(NAME.EQ.NULL)NAME=NAMEI
CALL IFILE(IREAD,NAME)
C
C DETERMINE OUTPUT UNIT
WRITE(ITTY,13)
13 FORMAT(22H OUTPUT UNIT NUMBER = ,$)
READ(ITTY,10)IWRITE
IF(IWRITE.LT.0)GO TO 26
IF(IWRITE.EQ.ITTY)GO TO 24
IF(IWRITE.EQ.0)IWRITE=JWRITE
WRITE(ITTY,14)
14 FORMAT(20H OUTPUT FILE NAME = ,$)
READ(ITTY,12)NAME
IF(NAME.EQ.NULL)NAME=NAMEO
CALL OFILE(IWRITE,NAME)
C
C DETERMINE LISTER UNIT (FOR DEBUGGING)
WRITE(ITTY,15)
15 FORMAT(22H LISTER UNIT NUMBER = ,$)
READ(ITTY,10)ILPT
IF(ILPT.LT.0)GO TO 27
IF(ILPT.EQ.ITTY)GO TO 28
IF(ILPT.EQ.0)ILPT=JLPT
WRITE(ITTY,16)
16 FORMAT(20H LISTER FILE NAME = ,$)
READ(ITTY,12)NAME
IF(NAME.EQ.NULL)NAME=NAMEL
CALL OFILE(ILPT,NAME)
GO TO 28
C
C ASSIGN TELETYPE AS DEFAULT FOR REMAINING UNITS
C IF SELECTED FOR A SINGLE UNIT.
C REQUEST BACKUP FILE IF INPUT IS ON TELETYPE.
17 IWRITE=ITTY
ILPT=ITTY
18 IF(IOUT.NE.ITTY)GO TO 28
WRITE(ITTY,19)
19 FORMAT(42H BACKUP UNIT NUMBER (NO BACKUP IF ZERO) = ,
1$)
READ(ITTY,10)I
IF(I.EQ.0)GO TO 28
IF(I.LT.0)GO TO 21
IOUT=I
WRITE(ITTY,20)
20 FORMAT(20H BACKUP FILE NAME = ,$)
READ(ITTY,12)NAME
IF(NAME.NE.NULL)GO TO 23
GO TO 22
21 IOUT=JOUT
22 NAME=NAMEB
23 CALL OFILE(IOUT,NAME)
GO TO 28
24 ILPT=ITTY
GO TO 28
C
C ASSIGN DEFAULT UNITS AND FILES
25 IREAD=JREAD
CALL IFILE(IREAD,NAMEI)
26 IWRITE=JWRITE
CALL OFILE(IWRITE,NAMEO)
27 ILPT=JLPT
CALL OFILE(ILPT,NAMEL)
C
C RETURN TO CALLING PROGRAM
28 RETURN
END