      SUBROUTINE FOPEN
C   
C   
C     THIS SUBROUTINE READS AND OPENS THE DEFINITION PROGRAM
C     INPUT SOURCE AND OUTPUT DEFINITION FILES.
C     ASSEMBLY OPTIONS ARE ALSO READ.
C   
C   
C
C**************************************************************
C
C	MODIFIED BY STEP ENGINEERING FOR OPERATION ON A
C	FUTUREDATA AMDS DEVELOPMENT SYSTEM USING CMDOS.
C
C	MODIFIED:
C
C		MARCH 19, 1981 --  TERRILL  --  ADDED ABILITY
C	TO ENTER THE DRIVE NAME TO THE FILES.
C
C**************************************************************
C
      INTEGER*1 SOURCE
      INTEGER*1 LIST
      INTEGER*1 OBJECT
      INTEGER*1 NDEV(2,4)
      INTEGER*1 JCHRB,JCHRJ,JCHRL,JCHRO,JCHRS,JCHRT
      INTEGER*1 JCHRD,JCHRE,JCHRF,JCHRA
      INTEGER*1 JBLNK,JCOMM,JLPAR,JRPAR,JPERD,JEQUL,JCOLN
      INTEGER*1 JCHAR,JNAME(15),INBUF(80),JNUMS(10)
      INTEGER*1 ISNAM(15),ILNAM(15),IONAM(15)
C   
C	INTEGER VALUES ADDED FOR THE DRIVE DETERMINATION CODE.
C
      INTEGER FROM,ENDING,INDEX,DSKDRV
C
C
      REAL IVAL,IVAL1,IVAL2,NOFF,NTDEP(64),NINST,INSCT
      COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMREC,IMFLE,IPFLE,IPREC,ITERM
      COMMON IMBUF(128),IPBUF(80),IN(128),ILBUF(80),IWBUF(128),IFREC
      COMMON ISBIT,ICHBT,ICHWD,NBIT,NINST,NDONT,NCOL,NROW,NOFF,IBAT
      COMMON LODLC,IEND,NBITT,IPS,IPE,IPLEN,IPASS,IROW,LCTL,MXREC
      COMMON NPLIN,IWSEC,MSEC,IPROM,INDEX,IBITS,IBITE,LCOLS,LCOLE
      COMMON INSCT,IVAL,IVAL1,IVAL2,MCOL,NPCNT,ICHAR,MSIZE,NWORD,ILLEN
      COMMON LMAP,LLIST,LPCH,INVRT,LHEX,LFILE,NAMEF(4),IERR,ICOL,ICNT
      COMMON NPWID(32),NTWID(32),NPDEP(64),NTDEP,NVAL,MESSN,NESSF
      COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRF,ICHRN,ICHRR,ICHR0,ICHR1
      COMMON ICHRX,IBLNK,ICOMM,IAST,IDOLR,IEQUL,IMIN,IADDR(4),NUMS(16)
C INCLUDE(METAP.COM)
      EQUIVALENCE(SOURCE,ISNAM(1)), (LIST,ILNAM(1)),(OBJECT,IONAM(1))
      DATA JCHRB,JCHRJ,JCHRL,JCHRO,JCHRS,JCHRT
     1  /1HB,1HJ,1HL,1HO,1HS,1HT/
      DATA JCHRD,JCHRE,JCHRF,JCHRA
     1  /1HD,1HE,1HF,1HA/
      DATA JBLNK,JCOMM,JLPAR,JRPAR,JPERD,JEQUL,JCOLN
     1  /1H ,1H,,1H(,1H),1H.,1H=,1H:/
      DATA JNUMS /1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA NDEV(1,1),NDEV(1,2),NDEV(1,3),NDEV(1,4) /1HC,1HO,1HN,1H:/
      DATA NDEV(2,1),NDEV(2,2),NDEV(2,3),NDEV(2,4) /1HL,1HS,1HT,1H:/
C   
C     SET INDICATOR THAT INDICATES WHICH FILES ARE OPEN
      IERRZ = 0
      ITRMO=ITERM
      ITRMI=5
100   WRITE(ITRMO,2000)
2000  FORMAT(' ENTER INPUT OBJECT FILE NAME   ')
C     READ SOURCE FILE NAME
      READ (ITRMI,3000) INBUF
3000  FORMAT(80A1)
C     CLEAR FILE NAME BUFFERS
      DO 150 I=1,15
      ISNAM(I) = JBLNK
      ILNAM(I) = JBLNK
      IONAM(I) = JBLNK
150   CONTINUE
C   
C
C	STEP ENGINEERING ADDITION: MAR. 18, 1981
C
C	CHECK FOR THE DRIVE NAME AT BEGINNING OF THE 
C	FILE NAME.
C
      DSKDRV=0
      FROM = 1
      INDEX = 1
      JCHAR = INBUF(2)
      IF (JCHAR .NE. JCOLN)  GO TO 195
      JCHAR = INBUF(1)
      DSKDRV = JCHAR - JCHRA + 1
      IF (DSKDRV .LE. 0 .OR. DSKDRV .GT. 2) GO TO 910
      FROM = 3
195   CONTINUE
C     MOVE SOURCE FILE TO SOURCE FILE NAME BUFFER
C
C	MODIFIED BY STEP ENGINEERING:  MAR. 18,1981
C
C	USE FROM AND INDEX FROM ABOVE.
C
      ENDING = FROM + 8
      DO 200 ICOL=FROM,ENDING
        JCHAR = INBUF(ICOL)
        IF(JCHAR .EQ. JPERD) GO TO 210
        IF(JCHAR .EQ. JBLNK) GO TO 250
        IF(JCHAR .EQ. JCOMM) GO TO 250
        IF(JCHAR .EQ. JLPAR) GO TO 250
        ISNAM(INDEX) = JCHAR
        ILNAM(INDEX) = JCHAR
        IONAM(INDEX) = JCHAR
        INDEX = INDEX + 1
200   CONTINUE
      GO TO 910
210   ICOL=ICOL+1
      DO 220 I=9,12
        JCHAR=INBUF(ICOL)
        IF(JCHAR .EQ. JBLNK) GO TO 250
        IF(JCHAR .EQ. JCOMM) GO TO 250
        IF(JCHAR .EQ. JLPAR) GO TO 250
        ISNAM(I)=JCHAR
        ICOL=ICOL+1
220   CONTINUE
      GO TO 910
C     OPEN SOURCE FILE
250   DO 260 I=1,11
      JNAME(I) = ISNAM(I)
260   CONTINUE
C     CHECK FOR INVALID FILE NAME CHARACTERS
      DO 265 I=1,11
        JCHAR = ISNAM(I)
        IF (JCHAR .EQ. 32) GO TO 265
        IF (JCHAR .GT. 90) GO TO 910
        IF (JCHAR .LT. 48) GO TO 910
        IF (JCHAR .LE. 57) GO TO 265
        IF (JCHAR .LT. 65) GO TO 910
265   CONTINUE
270   CONTINUE
C
C	USE DSKDRV INSTEAD OF 0.
C
      CALL OPEN(IRDR,SOURCE,DSKDRV)
      IERRZ = 1
C
C     DETERMINE LIST FILE NAME
C
      IF(INBUF(ICOL) .NE. JCOMM) GO TO 320
      ICOL = ICOL+1
C
C	STEP ENGINEERING ADDITION: MAR. 19, 1981
C
C	CHECK FOR THE DRIVE NAME AT BEGINNING OF THE 
C	FILE NAME.
C
      DSKDRV=0
      JCHAR = INBUF(ICOL+1)
      IF (JCHAR .NE. JCOLN)  GO TO 295
C
C	DRIVE IS GIVEN AS PREFIX TO FILE NAME.
C
      JCHAR = INBUF(ICOL)
      DSKDRV = JCHAR - JCHRA + 1
      IF (DSKDRV .LE. 0 .OR. DSKDRV .GT. 2) GO TO 910
      ICOL = ICOL + 2
295   CONTINUE
C
C     COPY LIST FILE NAME TO LIST FILE BUFFER
C
      DO 300 I=1,12
        JCHAR = INBUF(ICOL)
        IF(JCHAR .EQ. JPERD) GO TO 310
        IF(JCHAR .EQ. JBLNK) GO TO 310
        IF(JCHAR .EQ. JCOMM) GO TO 310
        IF(JCHAR .EQ. JLPAR) GO TO 310
        ILNAM(I) = JCHAR
        ICOL = ICOL+1
300   CONTINUE
      GO TO 910
C     PAD NAME WITH BLANKS
310   DO 315 J=I,15
      ILNAM(J) = JBLNK
315   CONTINUE
      IF(JCHAR .NE. JPERD) GO TO 350
      ICOL=ICOL+1
      DO 318 I=9,12
        JCHAR=INBUF(ICOL)
        IF(JCHAR .EQ. JBLNK) GO TO 350
        IF(JCHAR .EQ. JCOMM) GO TO 350
        IF(JCHAR .EQ. JLPAR) GO TO 350
        ILNAM(I)=JCHAR
        ICOL=ICOL+1
318   CONTINUE
      GO TO 910
C     USE LIST FILE DEFAULT NAME, ADD EXTENSION
320   DO 330 I=1,11
      IF(ILNAM(I) .EQ. JPERD) GO TO 340
      IF(ILNAM(I) .EQ. JBLNK) GO TO 340
330   CONTINUE
      GO TO 910
C     ADD OR CHANGE SOURCE FILE EXTENSION FOR LIST FILE
340   ILNAM(9) = JCHRL
      ILNAM(10) = JCHRS
      ILNAM(11) = JCHRT
C     OPEN LIST FILE
350   DO 360 I=1,11
        JNAME(I) = ILNAM(I)
360   CONTINUE
C     CHECK IF TTY: HAS BEEN SPECIFIED
      DO 370 I=1,4
        IF(JNAME(I) .NE. NDEV(1,I)) GO TO 375
370   CONTINUE
      IPRT = ITRMO
      GO TO 390
C     CHECK FOR PRN:
375   DO 378 I=1,4
        IF(JNAME(I) .NE. NDEV(2,I)) GO TO 380
378   CONTINUE
      IPRT = 2
      GO TO 390
380   IPRT = 2
C
C	USE DSKDRV RATHER THAN 0.
C
      CALL OPEN(IPRT,LIST,DSKDRV)
390   IERRZ = 2
C     DETERMINE OBJECT MODULE FILE NAME
      IF(INBUF(ICOL) .NE. JCOMM) GO TO 420
      ICOL = ICOL+1
C
C	STEP ENGINEERING ADDITION: MAR. 19, 1981
C
C	CHECK FOR THE DRIVE NAME AT BEGINNING OF THE 
C	FILE NAME.
C
      DSKDRV=0
      JCHAR = INBUF(ICOL+1)
      IF (JCHAR .NE. JCOLN)  GO TO 395
C
C	FOUND DRIVE NUMBER PREFIXING FILE NAME.
C
      JCHAR = INBUF(ICOL)
      DSKDRV = JCHAR - JCHRA + 1
      IF (DSKDRV .LE. 0 .OR. DSKDRV .GT. 2) GO TO 910
      ICOL = ICOL + 2
395   CONTINUE
C
C     COPY OBJECT MODULE FILE NAME TO FILE NAME BUFFER
C
      DO 400 I=1,11
        JCHAR = INBUF(ICOL)
        IF(JCHAR .EQ. JPERD) GO TO 410
        IF(JCHAR .EQ. JBLNK) GO TO 410
        IF(JCHAR .EQ. JLPAR) GO TO 410
        IONAM(I) = JCHAR
        ICOL = ICOL+1
400   CONTINUE
      GO TO 910
C     PAD NAME WITH BLANKS
410   DO 415 J=I,15
      IONAM(J) = JBLNK
415   CONTINUE
      IF(JCHAR .NE. JPERD) GO TO 450
      ICOL=ICOL+1
      DO 418 I=9,12
      JCHAR=INBUF(ICOL)
      IF(JCHAR .EQ. JBLNK) GO TO 450
      IF(JCHAR .EQ. JCOMM) GO TO 450
      IF(JCHAR .EQ. JLPAR) GO TO 450
      ILNAM(I)=JCHAR
      ICOL=ICOL+1
418   CONTINUE
      GO TO 910
C     USE OBJECT FILE DEFAULT NAME, ADD EXTENSION
420   DO 430 I=1,11
      IF(ISNAM(I) .EQ. JPERD) GO TO 440
      IF(ISNAM(I) .EQ. JBLNK) GO TO 440
430   CONTINUE
C     ADD OR CHANGE SOURCE FILE EXTENSION OF OBJECT MODULE FILE
440   IONAM(9) = JCHRO
      IONAM(10) = JCHRB
      IONAM(11) = JCHRJ
C     OPEN OBJECT MODULE FILE
450   DO 460 I=1,15
      JNAME(I) = IONAM(I)
460   CONTINUE
C     CHECK IF PRN: SPECIFIED FOR OBJECT OUTPUT
      DO 470 I=1,4
      IF(JNAME(I) .NE. NDEV(2,I)) GO TO 475
470   CONTINUE
      IPCH = 2
      GO TO 990
475   IPCH = 6
C
C	USE DSKDRV RATHER THAN 0
C
      CALL OPEN(IPCH,OBJECT,DSKDRV)
C
      GO TO 990
C
C
C     ERRORS
C   
C     ILLEGAL FILE NAME
910   WRITE(ITRMO,9100)
9100  FORMAT(' ILLEGAL FILE NAME')
      GO TO 960
C     FILE NOT FOUND
C920   WRITE(ITRMO,9200) JNAME
C9200  FORMAT(' FILE NOT FOUND - ',15A1)
C      GO TO 960
C     FILE ERROR ON ATTEMPT TO OPEN
C930   WRITE(ITRMO,9300) JNAME
C9300  FORMAT(' FILE OPEN ERROR - ',15A1)
C      GO TO 960
C     PARAMETER ERROR
940   WRITE(ITRMO,9400)
9400  FORMAT(' PARAMETER ERROR')
C     CLOSE FILES
960   IF(IERRZ .EQ. 0) GO TO 100
      IF(IERRZ .EQ. 1) GO TO 965
965   CONTINUE
      GO TO 100
990   RETURN
      END
1) GO TO 965
965   CONTINUE
      GO TO 100
990   RETURN
      END
