Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0141/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