Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-08 - 43,50476/opnfil.for
There are 2 other files named opnfil.for in the archive. Click here to see a list.
      SUBROUTINE OPNFIL(  ITTY,  JTTY,KMDNUM,KMDDVC,KMDNAM,
     1    KMDEXT,ID1NUM,ID1DVC,ID1EXT,ID2NUM,ID2DVC,ID2EXT,
     2    ID3NUM,ID3DVC,ID3EXT,MAXTTL,MAXBFR,  KIND,KNDFLG,
     3    NUMFLG,LTRTTL,ID1OPN,ID2OPN,IBUFFR)
C     RENBR(/OPEN FILES FOR FILE,FILE=FILE,FILE COMMAND)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THIS ROUTINE OPENS THE FILES SPECIFIED BY THE USER IN
C     A  COMMAND  IN  WHICH  UP  TO 2 OUTPUT FILE NAMES ARE
C     FOLLOWED BY AN EQUAL SIGN AND THEN BY ANY  NUMBER  OF
C     INPUT  FILE  NAMES.   THE  FIRST CALL TO THIS ROUTINE
C     OPENS THE FIRST INPUT FILE AND ALL THE OUTPUT  FILES.
C     SUBSEQUENT  CALLS  TO  THIS  ROUTINE  OPEN SUBSEQUENT
C     INPUT FILES.  OUTPUT FILES ARE IDENTIFIED AS BEING OF
C     EITHER  TYPE  ONE  OR  TYPE TWO BY THE SWITCHES WHICH
C     APPEAR WITH THE FILE SPECIFICATIONS.  IF NO MORE THAN
C     A  SINGLE  OUTPUT  FILE  IS  SUPPLIED AND NO SWITCHES
C     IMPLY ITS TYPE, THEN IT IS ASSUMED TO BE OF TYPE ONE.
C
C     OPNFIL ARGUMENTS NAMED ITTY,  JTTY,  KMDNUM,  KMDDVC,
C     KMDNAM,  KMDEXT,  MAXBFR  AND IBUFFR ARE IDENTICAL TO
C     GETFIL ARGUMENTS HAVING SAME NAMES AND  HAVE  ALREADY
C     BEEN  DESCRIBED.   FOLLOWING ARGUMENTS, TOGETHER WITH
C     ITTY,  JTTY,  KMDNUM,  KMDDVC,  KMDNAM,  KMDEXT   AND
C     MAXBFR,  ARE  USED  ONLY  FOR  INPUT AND ARE RETURNED
C     UNCHANGED.
C
C     ID1NUM = NUMBER OF UNIT UPON WHICH THIS ROUTINE IS TO
C              OPEN OUTPUT FILE WHICH IS TO BE OF TYPE ONE.
C              OUTPUT FILE WILL BE OF TYPE ONE IF ITS  FILE
C              SPECIFICATION  IS ASSOCIATED WITH SWITCH FOR
C              WHICH CORRESPONDING VALUE IN KNDFLG ARRAY IS
C              1.
C     ID1DVC = NAME IN 5H FORM OF DEVICE  UPON  WHICH  TYPE
C              ONE  OUTPUT  FILE  IS  TO BE WRITTEN IF USER
C              DOES NOT  SUPPLY  DEVICE  NAME  FOLLOWED  BY
C              COLON  AT START OF SPECIFICATION OF TYPE ONE
C              OUTPUT FILE.
C     ID1EXT = NAME IN 3H FORM  WHICH  IS  TO  BE  USED  AS
C              SECOND  COMPONENT  (FILE  NAME EXTENSION) OF
C              NAME OF TYPE ONE OUTPUT FILE  IF  NO  SECOND
C              COMPONENT OF NAME OF TYPE ONE OUTPUT FILE IS
C              SUPPLIED BY USER.  IF USER DOES NOT  SPECIFY
C              FIRST COMPONENT OF NAME OF OUTPUT FILE, THEN
C              FIRST COMPONENT OF NAME OF FIRST INPUT  FILE
C              IS  USED  AS FIRST COMPONENT OF NAME OF THIS
C              OUTPUT FILE.
C     ID2NUM, ID2DVC AND ID2EXT = SIMILAR TO ID1NUM, ID1DVC
C              AND ID1EXT RESPECTIVELY, EXCEPT THAT ID2NUM,
C              ID2DVC AND ID2EXT REFER TO OUTPUT FILE WHICH
C              IS  TO  BE OF TYPE TWO.  OUTPUT FILE WILL BE
C              OF TYPE TWO IF  ITS  FILE  SPECIFICATION  IS
C              ASSOCIATED    WITH    SWITCH    FOR    WHICH
C              CORRESPONDING VALUE IN KNDFLG ARRAY IS 2.
C     ID3NUM = NUMBER OF UNIT UPON WHICH THIS ROUTINE IS TO
C              OPEN NEXT INPUT FILE SPECIFIED BY USER.
C     ID3DVC = NAME IN 5H FORM OF DEVICE  UPON  WHICH  NEXT
C              INPUT FILE IS TO BE OPENED IF NO DEVICE NAME
C              HAS BEEN SPECIFIED BY USER FOR ANY  PREVIOUS
C              INPUT   FILE   AND  IF  NO  DEVICE  NAME  IS
C              SPECIFIED BY USER FOR THIS NEW INPUT FILE.
C     ID3EXT = NAME IN 3H FORM  WHICH  IS  TO  BE  USED  AS
C              SECOND  COMPONENT  (FILE  NAME EXTENSION) OF
C              NAME OF EACH INPUT FILE FOR WHICH NO  SECOND
C              COMPONENT OF FILE NAME IS SUPPLIED BY USER.
C     MAXTTL = DIMENSION OF LTRTTL ARRAY AND MAXIMUM NUMBER
C              OF  CHARACTERS  WHICH  CAN  BE  RETURNED  IN
C              LTRTTL ARRAY.
C
C     FOLLOWING ARGUMENT MUST BE ZEROED BY CALLING  PROGRAM
C     BEFORE  THIS  ROUTINE IS FIRST CALLED, BUT THEN VALUE
C     RETURNED BY THIS ROUTINE SHOULD BE SENT TO  FOLLOWING
C     CALL OF THIS ROUTINE UNCHANGED.
C
C     KIND   = DEFINED SIMILARLY TO ARGUMENT OF  SAME  NAME
C              IN  ARGUMENT  LIST OF GETFIL ROUTINE, EXCEPT
C              THAT OPNFIL ROUTINE DOES NOT RETURN  KIND=5.
C              KIND  SHOULD BE SET TO ZERO (OR TO 1) BEFORE
C              THIS ROUTINE IS FIRST  CALLED,  OR  WHENEVER
C              INTERPRETATION   OF   CURRENT  SET  OF  FILE
C              SPECIFICATIONS IS TO BE ABANDONED.
C            = 1, RETURNED IF PREVIOUS CALL TO THIS ROUTINE
C              OPENED FINAL INPUT FILE SPECIFIED BY USER.
C            = 2, RETURNED IF PREVIOUS CALL TO THIS ROUTINE
C              OPENED FINAL INPUT FILE SPECIFIED TO LEFT OF
C              SEMICOLON.  IF THIS ROUTINE IS CALLED  AGAIN
C              WITHOUT  KIND HAVING FIRST BEEN ZEROED, THEN
C              EVALUATION OF NEW SET OF FILE SPECIFICATIONS
C              WILL  BE BEGUN IN TEXT APPEARING TO RIGHT OF
C              SEMICOLON.
C            = 3, CURRENT CALL TO THIS ROUTINE  HAS  OPENED
C              OUTPUT  FILE  OR  FILES AND HAS OPENED FIRST
C              INPUT FILE.
C            = 4, CURRENT CALL TO THIS ROUTINE  HAS  OPENED
C              SECOND OR SUBSEQUENT INPUT FILE.
C
C     FOLLOWING  ARGUMENT  IS   USED   BOTH   FOR   SENDING
C     INFORMATION   TO  THIS  ROUTINE,  AND  FOR  RETURNING
C     INFORMATION TO CALLING PROGRAM.  CALLING PROGRAM MUST
C     DEFINE  CONTENTS OF THIS ARRAY BEFORE THIS ROUTINE IS
C     FIRST CALLED.
C
C     KNDFLG = ARRAY DIMENSIONED AT 27 WHICH MUST INITIALLY
C              INDICATE  OUTPUT FILE TYPES TO BE ASSOCIATED
C              WITH  EACH  OF  SINGLE  LETTER  SWITCHES  /A
C              THROUGH  /Z AND /' (OR LONE ') RESPECTIVELY.
C              IF THIS ROUTINE IS CALLED WITH KIND SET TO 2
C              OR  LESS, THEN THIS ROUTINE REDEFINES KNDFLG
C              ARRAY TO  CONTAIN  ABSOLUTE  VALUES  OF  ITS
C              ORIGINAL  CONTENTS.  IF CURRENT CALL TO THIS
C              ROUTINE BEGINS  PROCESSING  OF  NEW  COMMAND
C              SUCH  THAT KIND IS RETURNED CONTAINING VALUE
C              3, THEN THOSE LOCATIONS WITHIN KNDFLG  ARRAY
C              HAVING  AS THEIR SUBSCRIPTS SERIAL LOCATIONS
C              WITHIN ALPHABET OF LETTERS WHICH  ARE  FOUND
C              AS  SWITCHES (ASSUMING APOSTROPHE TO BE 27TH
C              LETTER  OF  ALPHABET)  ARE   THEN   RETURNED
C              CONTAINING   NEGATIVES   OF  THEIR  ABSOLUTE
C              VALUES.   CONTENTS  OF  KNDFLG   ARRAY   ARE
C              RETURNED  UNCHANGED  IF KIND IS RETURNED SET
C              TO 4.
C
C              IF VALUE IN KNDFLG  ARRAY  CORRESPONDING  TO
C              SWITCH  IS  EITHER  -1  OR 1, THEN FILE WITH
C              WHICH SWITCH IS ASSOCIATED WILL BE  OF  TYPE
C              ONE.  IF VALUE IN KNDFLG ARRAY CORRESPONDING
C              TO SWITCH IS EITHER -2 OR 2, THEN FILE  WITH
C              WHICH  SWITCH  IS ASSOCIATED WILL BE OF TYPE
C              TWO.  IF VALUE IN KNDFLG ARRAY CORRESPONDING
C              TO SWITCH IS ZERO, THEN ROUTINE NAMED HLPFIL
C              IS CALLED TO DISPLAY HELP  MESSAGE  TO  USER
C              AND  USER IS THEN ASKED TO SUPPLY NEW SET OF
C              FILE  SPECIFICATIONS.   SWITCHES  FOR  WHICH
C              CORRESPONDING  LOCATIONS  IN KNDFLG ARRAY DO
C              NOT CONTAIN ONE OF VALUES -2 THROUGH  2  CAN
C              APPEAR WITH EITHER OUTPUT FILE SPECIFICATION
C              OR WITH LEFTMOST  INPUT  FILE  SPECIFICATION
C              BUT DO NOT IDENTIFY TYPE OF OUTPUT FILES.
C
C     FOLLOWING  ARGUMENTS  ARE  USED  ONLY  FOR  RETURNING
C     INFORMATION  TO CALLING PROGRAM WHEN KIND IS RETURNED
C     SET TO 3.  THESE ARGUMENTS ARE RETURNED UNCHANGED  IF
C     KIND IS RETURNED SET TO VALUE OTHER THAN 3.
C
C     NUMFLG = ARRAY DIMENSIONED AT 27 WHICH  IS  USED  FOR
C              RETURNING   VALUES   WHICH   APPEARED   WITH
C              SEPARATING COLONS  AFTER  SWITCHES  IN  FILE
C              SPECIFICATIONS.   NUMFLG  ARRAY LOCATIONS IN
C              WHICH THESE  VALUES  ARE  RETURNED  HAVE  AS
C              THEIR  SUBSCRIPTS  SERIAL  LOCATIONS  WITHIN
C              ALPHABET  OF  LETTERS  WHICH  ARE  USED   AS
C              SWITCHES.  SUCH NUMBERS MUST BE SPECIFIED AS
C              DECIMAL   INTEGERS,   BUT   CANNOT   CONTAIN
C              EXPONENTS.      NUMFLG(27)    IS    RETURNED
C              CONTAINING NUMBER OF CHARACTERS RETURNED  IN
C              LTRTTL  ARRAY  WHICH  WERE FOUND TO RIGHT OF
C              LEADING APOSTROPHE.
C     LTRTTL = ARRAY IN WHICH  AT  MOST  MAXTTL  CHARACTERS
C              APPEARING  TO  RIGHT  OF  APOSTROPHE  CAN BE
C              RETURNED.  NUMFLG(27) IS RETURNED CONTAINING
C              NUMBER  OF  CHARACTERS  RETURNED  IN  LTRTTL
C              ARRAY.
C     ID1OPN = 0, RETURNED IF TYPE ONE OUTPUT FILE WAS  NOT
C              OPENED.
C            = 1, RETURNED IF  TYPE  ONE  OUTPUT  FILE  WAS
C              OPENED.
C     ID2OPN = 0, RETURNED IF TYPE TWO OUTPUT FILE WAS  NOT
C              OPENED.
C            = 1, RETURNED IF  TYPE  TWO  OUTPUT  FILE  WAS
C              OPENED.
C
      COMMON/FASPY/NEWNUL(3),NEWDSK(3),NEWNAM(3),
     1NEWPTH(3,3),LCNRIT
      DIMENSION KNDFLG(27),NUMFLG(27),LTRTTL(MAXTTL),
     1IBUFFR(MAXBFR),LTRABC(27),LWRABC(27),LTRDGT(10),
     2INILTR(6),KNTLTR(6)
      DOUBLE PRECISION KMDNAM,NEWNAM,NEWPTH,PTHONE(3),
     1PTHTWO(3),PTHTHR(3),FILONE,FILTWO,FILTHR,FILNAM
      DATA LTRABC/1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     1            1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,
     2            1HU,1HV,1HW,1HX,1HY,1HZ,1H'/
      DATA LWRABC/1Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
     1            1Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,
     2            1Hu,1Hv,1Hw,1Hx,1Hy,1Hz,1H'/
      DATA LTRDGT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA LTRPLS,LTRMNS,IBLANK/1H+,1H-,5H     /
C
C     INITIALIZE STORAGE OF COMMAND
      INITAL=KIND-2
      IF(INITAL.GT.0)GO TO 4
      GO TO 2
    1 KIND=0
    2 ID1OPN=0
      ID2OPN=0
      DO 3 I=1,27
      IF(KNDFLG(I).LT.0)KNDFLG(I)=-KNDFLG(I)
    3 NUMFLG(I)=0
      KNDONE=0
      KNDTWO=0
      KNDTHR=0
C
C     GET NEXT COMPONENT OF COMMAND TYPED BY USER
    4 CALL GETFIL(3,ITTY,JTTY,KMDNUM,KMDDVC,
     1KMDNAM,KMDEXT,6,MAXBFR,KIND,NEWNUL,NEWDSK,
     2NEWNAM,NEWPTH,LCNRIT,IBUFFR,MAXFLG,INILTR,KNTLTR,
     3LCNOWN)
      GO TO(45,45,23,31,5),KIND
C
C     DECIDE WHICH SWITCH WAS GIVEN
    5 IF(MAXFLG.LE.0)GO TO 4
      IF(KNTLTR(1).LE.0)GO TO 4
      IF(INITAL.GT.0)GO TO 4
      LOCLTR=INILTR(1)
      LTRNOW=IBUFFR(LOCLTR)
      NEWFLG=0
    6 NEWFLG=NEWFLG+1
      IF(NEWFLG.GT.27)GO TO 4
      IF(LTRABC(NEWFLG).EQ.LTRNOW)GO TO 7
      IF(LWRABC(NEWFLG).NE.LTRNOW)GO TO 6
    7 IF(KNDFLG(NEWFLG).EQ.0)GO TO 35
      IF(KNDFLG(NEWFLG).GT.0)KNDFLG(NEWFLG)=-KNDFLG(NEWFLG)
      IF(KNDFLG(NEWFLG).EQ.-2)GO TO 11
      IF(KNDFLG(NEWFLG).NE.-1)GO TO 15
C
C     MARK THAT FILE BEARS TYPE ONE SWITCH
      ID1OPN=1
      GO TO(8,9,10),LCNOWN
    8 IF(KNDONE.EQ.1)GO TO 15
      IF(KNDONE.NE.3)KNDONE=KNDONE+1
      GO TO 15
    9 IF(KNDTWO.EQ.1)GO TO 15
      IF(KNDTWO.NE.3)KNDTWO=KNDTWO+1
      GO TO 15
   10 IF(KNDTHR.EQ.1)GO TO 15
      IF(KNDTHR.NE.3)KNDTHR=KNDTHR+1
      GO TO 15
C
C     MARK THAT FILE BEARS TYPE TWO SWITCH
   11 ID2OPN=1
      GO TO(12,13,14),LCNOWN
   12 IF(KNDONE.LE.1)KNDONE=KNDONE+2
      GO TO 15
   13 IF(KNDTWO.LE.1)KNDTWO=KNDTWO+2
      GO TO 15
   14 IF(KNDTHR.LE.1)KNDTHR=KNDTHR+2
C
C     STORE QUOTED TEXT STRING
   15 IVALUE=0
      IF(NEWFLG.LT.27)GO TO 17
      LMTLTR=LOCLTR+KNTLTR(1)
   16 IF(IVALUE.GE.MAXTTL)GO TO 22
      LOCLTR=LOCLTR+1
      IF(LOCLTR.GE.LMTLTR)GO TO 22
      IVALUE=IVALUE+1
      LTRTTL(IVALUE)=IBUFFR(LOCLTR)
      GO TO 16
C
C     EVALUATE NUMBERS IN RANGE OF SWITCH
   17 IF(MAXFLG.LE.1)GO TO 22
      IF(KNTLTR(2).LE.0)GO TO 22
      LOCLTR=INILTR(2)
      LMTLTR=LOCLTR+KNTLTR(2)
      I=0
      IF(IBUFFR(LOCLTR).EQ.LTRPLS)GO TO 18
      IF(IBUFFR(LOCLTR).NE.LTRMNS)GO TO 19
      I=1
   18 LOCLTR=LOCLTR+1
   19 IF(LOCLTR.GE.LMTLTR)GO TO 21
      LTRNOW=IBUFFR(LOCLTR)
      DO 20 L=1,10
      IF(LTRDGT(L).NE.LTRNOW)GO TO 20
      IVALUE=(10*IVALUE)+L-1
      GO TO 18
   20 CONTINUE
   21 IF(I.NE.0)IVALUE=-IVALUE
   22 NUMFLG(NEWFLG)=IVALUE
      GO TO 4
C
C     SET DEFAULT OUPUT DEVICE NAMES AND PATHS
   23 IF(NEWNUL(LCNRIT).LE.1)GO TO 38
      IF(NEWNUL(LCNRIT).EQ.4)GO TO 38
      IF(ID1OPN.EQ.ID2OPN)ID1OPN=1
      FILONE=NEWNAM(LCNRIT)
      FILTWO=FILONE
      MORONE=ID1EXT
      MORTWO=ID2EXT
      PTHONE(1)=0
      PTHTWO(1)=0
      LOCONE=ID1DVC
      LOCTWO=ID2DVC
      GO TO(31,24,25),LCNRIT
C
C     SINGLE FILE LEFT OF EQUAL SIGN
   24 IF(NEWNUL(1).EQ.0)GO TO 31
      IF(ID1OPN.EQ.ID2OPN)GO TO 36
      KNDONE=1
      KNDTWO=1
      GO TO 26
C
C     TWO FILES LEFT OF EQUAL SIGN
   25 IF(KNDONE.GE.3)GO TO 36
      IF(KNDTWO.GE.3)GO TO 36
      IF(KNDONE.EQ.KNDTWO)GO TO 36
      ID1OPN=1
      ID2OPN=1
      IF(KNDONE.EQ.0)KNDONE=3-KNDTWO
      IF(KNDTWO.EQ.0)KNDTWO=3-KNDONE
   26 IF(NEWNUL(KNDONE).EQ.0)GO TO 29
      IF(NEWDSK(KNDONE).NE.IBLANK)LOCONE=NEWDSK(KNDONE)
      DO 27 I=1,3
   27 PTHONE(I)=NEWPTH(I,KNDONE)
      IF(NEWNUL(KNDONE).LE.1)GO TO 29
      FILNAM=NEWNAM(KNDONE)
      IF(NEWNUL(KNDONE).LE.3)FILONE=FILNAM
      IF(NEWNUL(KNDONE).GE.3)DECODE(10,28,FILNAM)MORONE
   28 FORMAT(7X,1A3)
   29 IF(NEWNUL(KNDTWO).EQ.0)GO TO 31
      IF(NEWDSK(KNDTWO).NE.IBLANK)LOCTWO=NEWDSK(KNDTWO)
      DO 30 I=1,3
   30 PTHTWO(I)=NEWPTH(I,KNDTWO)
      IF(NEWNUL(KNDTWO).LE.1)GO TO 31
      FILNAM=NEWNAM(KNDTWO)
      IF(NEWNUL(KNDTWO).LE.3)FILTWO=FILNAM
      IF(NEWNUL(KNDTWO).GE.3)DECODE(10,28,FILNAM)MORTWO
C
C     OPEN INPUT FILE
   31 IF(NEWNUL(LCNRIT).EQ.0)GO TO 4
      FILTHR=NEWNAM(LCNRIT)
      MORTHR=ID3EXT
      IF(NEWNUL(LCNRIT).GE.3)DECODE(10,28,FILTHR)MORTHR
      LOCTHR=NEWDSK(LCNRIT)
      IF(LOCTHR.EQ.IBLANK)LOCTHR=ID3DVC
      DO 32 I=1,3
   32 PTHTHR(I)=NEWPTH(I,LCNRIT)
      ENCODE(10,33,FILNAM)FILTHR,MORTHR
   33 FORMAT(1A6,1H.,1A3)
      OPEN(UNIT=ID3NUM,FILE=FILNAM,DIRECTORY=PTHTHR,
     1DEVICE=LOCTHR,ACCESS='SEQIN',ERR=43)
      IF(INITAL.GT.0)GO TO 47
C
C     OPEN OUTPUT FILES
      IF(ID1OPN.EQ.0)GO TO 34
      ENCODE(10,33,FILNAM)FILONE,MORONE
      OPEN(UNIT=ID1NUM,FILE=FILNAM,DIRECTORY=PTHONE,
     1DEVICE=LOCONE,ACCESS='SEQOUT',ERR=40)
      IF(ID2OPN.EQ.0)GO TO 46
   34 ENCODE(10,33,FILNAM)FILTWO,MORTWO
      OPEN(UNIT=ID2NUM,FILE=FILNAM,DIRECTORY=PTHTWO,
     1DEVICE=LOCTWO,ACCESS='SEQOUT',ERR=42)
      GO TO 46
C
C     ISSUE HELP MESSAGE AND THEN CLEAR COMMAND IF ANY
   35 CALL HLPFIL(JTTY)
      GO TO 1
C
C     ERROR IN COMMAND TYPED BY USER
   36 WRITE(JTTY,37)
   37 FORMAT(31H AMBIGUOUS OUTPUT SPECIFICATION)
      GO TO 1
   38 WRITE(JTTY,39)
   39 FORMAT(34H 1ST SOURCE FILE MUST BE SPECIFIED)
      GO TO 1
   40 WRITE(JTTY,41)LOCONE,FILNAM
   41 FORMAT(26H CANNOT WRITE OUTPUT FILE ,1A5,1H:,1A10)
      GO TO 1
   42 WRITE(JTTY,41),LOCTWO,FILNAM
      GO TO 1
   43 WRITE(JTTY,44)LOCTHR,FILNAM
   44 FORMAT(25H CANNOT READ SOURCE FILE ,1A5,1H:,1A10)
      GO TO 4
C
C     RETURN TO CALLING PROGRAM
   45 IF(INITAL.LE.0)GO TO 2
      GO TO 47
   46 KIND=3
   47 RETURN
C024147266970'abcdefghijklmnopqrstuvwxyz:
      END