SUBROUTINE WRITE_PROM_FILE(UNIT_NUM, FILE_NAME, PROM_TABLE, PROM,
     &  MAKE_BINARY, MAKE_INTELLEC)
C----------------------------------------------------------------------
C-
C-   Purpose and Methods : Open and write the PROM burner files.
C-
C-   Inputs  : UNIT_NUM         The IO unit number
C-             FILE_NAME (*MODIFIED*) The file name for the binary file
C-             PROM_TABLE       An array holding the data for the file
C-
C-   Outputs : none
C-
C-   Controls: PROM             The type of prom being made
C-             MAKE_BINARY      Whether to make a binary file
C-             MAKE_INTELLEC    Whether to make an Intellec-format file
C-
C-   Notes:     Parts of this routine are VAX-specific. This was necessary to
C-              obtain the proper format for the output files. To port to
C-              another system, code needs to be written to open the files,
C-              transform the data from integers into bytes, write the data,
C-              and close the file.
C-
C-   Created  14-SEP-1990   MICHIGAN STATE UNIVERSITY, TRIGGER CONTROL SOFTWARE
C-
C----------------------------------------------------------------------
      IMPLICIT NONE
C----------------------------------------------------------------------
C
C       Global declarations
C
      INCLUDE 'D0$PARAMS:LEVEL1_LOOKUP.PARAMS'
      INCLUDE 'D0$INC:LEVEL1_LOOKUP.INC'
      INCLUDE 'LSMP$SOURCE:LEVEL1_LOOKUP_EXPANSION.INC'
      INTEGER  TRULEN
      EXTERNAL TRULEN
      CHARACTER*2 TO_HEX
      EXTERNAL    TO_HEX
C
C       Argument declarations
C
      INTEGER UNIT_NUM
      CHARACTER*(*) FILE_NAME
      INTEGER PROM_TABLE(*)
      INTEGER PROM
      LOGICAL MAKE_BINARY
      LOGICAL MAKE_INTELLEC
C
C       Local variables
C
      INTEGER COUNT
      INTEGER LENGTH
      INTEGER SUM
      INTEGER BASE
C&IF VAXVMS
      BYTE PROM_BYTES(2048)
      BYTE ZERO_BYTE
      PARAMETER (ZERO_BYTE = 0)
C&ENDIF
C
      IF (MAKE_BINARY) THEN
C       Open the file
C&IF VAXVMS
        IF ((PROM .EQ. EM_PROM) .OR. (PROM .EQ. HD_PROM)) THEN
          OPEN ( UNIT= UNIT_NUM, FILE = FILE_NAME, RECL = 513, FORM =
     &      'UNFORMATTED', ERR = 4500, STATUS = 'NEW', RECORDTYPE =
     &      'FIXED')
          GOTO 5000
        ELSE
          OPEN ( UNIT = UNIT_NUM, FILE = FILE_NAME, RECL = 512, FORM =
     &      'UNFORMATTED', ERR = 4500, STATUS = 'NEW', RECORDTYPE =
     &      'FIXED')
        ENDIF
        GOTO 5000
 4500   CONTINUE
        CALL OUTMSG(' Could not create binary file:')
        CALL OUTMSG( ' '// FILE_NAME(1:TRULEN(FILE_NAME)))
        GOTO 4000
C
 5000   CONTINUE
C&ENDIF
C
C       Copy the numbers into an array of bytes
C
C&IF VAXVMS
        DO COUNT = 1, 2048
          IF (PROM_TABLE(COUNT) .LE. 127) THEN
            IF (PROM_TABLE(COUNT) .GE. 0) THEN
              PROM_BYTES(COUNT) = PROM_TABLE(COUNT)
            ELSE
              PROM_BYTES(COUNT) = 0
            ENDIF
          ELSE
            IF (PROM_TABLE(COUNT) .LE. 255) THEN
              PROM_BYTES(COUNT) = PROM_TABLE(COUNT) - 256
            ELSE
              PROM_BYTES(COUNT) = 255 - 256
            ENDIF
          ENDIF
        END DO
C&ENDIF
C
C       Write the bytes out
C
C&IF VAXVMS
        CALL OUTMSG(' Writing binary file: '
     &    // FILE_NAME(1:TRULEN(FILE_NAME)))
        IF ((PROM .NE. EM_PROM) .AND. (PROM .NE. HD_PROM)) THEN
          WRITE (UNIT_NUM) (PROM_BYTES(COUNT), COUNT = 1, 2048)
        ELSE
          WRITE (UNIT_NUM) (PROM_BYTES(COUNT), COUNT = 1, 2048),
     &      ZERO_BYTE, ZERO_BYTE
        ENDIF
C&ENDIF
C
C&IF VAXVMS
        CLOSE(UNIT_NUM)
C&ENDIF
      ENDIF
 4000 CONTINUE
C
C       Create Intellec-format file
C
      IF (MAKE_INTELLEC) THEN
        LENGTH = TRULEN(FILE_NAME)
        FILE_NAME(LENGTH-4:LENGTH-2) = 'INT'
C&IF VAXVMS
        OPEN ( UNIT= UNIT_NUM, FILE = FILE_NAME, FORM =
     &    'FORMATTED', ERR = 6000, STATUS = 'NEW', CARRIAGECONTROL =
     &    'NONE')
        GOTO 6500
 6000   CONTINUE
        CALL OUTMSG(' Could not create Intellec file:')
        CALL OUTMSG( ' '// FILE_NAME(1:TRULEN(FILE_NAME)))
        GOTO 7000
C
 6500   CONTINUE
C&ENDIF
        CALL OUTMSG(' Writing Intellec file: '
     &    // FILE_NAME(1:TRULEN(FILE_NAME)))
        LENGTH = 16                    ! This could be changed
        SUM = 0
        DO BASE = 0, 2047 / LENGTH
          DO COUNT = 1, LENGTH
            SUM = SUM + PROM_TABLE(BASE * LENGTH + COUNT)
          END DO
C&IF VAXVMS
          WRITE(UNIT_NUM, 400) ':' // TO_HEX(LENGTH) // '00'
     &      // TO_HEX(BASE * LENGTH / 256)
     &      // TO_HEX(MOD( BASE * LENGTH, 256)),
     &      (TO_HEX(PROM_TABLE(BASE * LENGTH + COUNT)),
     &      COUNT = 1, LENGTH)
  400     FORMAT(A9, <LENGTH>A2)
C&ENDIF
        END DO
C
        IF ((PROM .EQ. EM_PROM) .OR. (PROM .EQ. HD_PROM)) THEN
C&IF VAXVMS
          WRITE(UNIT_NUM, 410) ':0200' // TO_HEX(2048 / 256)
     &      // TO_HEX(MOD(2048, 256)) // '0000'
  410     FORMAT(A13)
C&ENDIF
        ENDIF
C
C&IF VAXVMS
        SUM = MOD(65536 - MOD(SUM, 256), 65536)
        WRITE(UNIT_NUM, 420) ':00010000' // TO_HEX(SUM / 256)
     &    // TO_HEX(MOD(SUM, 256))
  420   FORMAT(A13)
C&ENDIF
C
C&IF VAXVMS
        CLOSE(UNIT_NUM)
C&ENDIF
      ENDIF
C
 7000 CONTINUE
  999 RETURN
      END
C