Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-02 - 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