SUBROUTINE GEN_ONE_PROM()
C----------------------------------------------------------------------
C-
C-   Purpose and Methods : Generate a file describing the contents of one PROM.
C-      Prompt for the coordinates of the PROM, and write a binary and/or
C-      intellec format file.
C-
C-   Inputs  : none
C-   Outputs : none
C-   Controls: none
C-
C-   Notes:     As the program stands now, on a system other than VAXVMS, this
C-              routine will prompt for parameters and perform the
C-              calculations, but will not open any files or write out any
C-              data.
C-
C-   Created  12-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  PFNUM
      EXTERNAL PFNUM
      INTEGER  TRULEN
      EXTERNAL TRULEN
C
C       Local variables
C
      INTEGER PROM
      INTEGER SIGN_ETA
      INTEGER ETA
      INTEGER PHI
      CHARACTER*40 PROM_TYPE
      CHARACTER*40 FILE_NAME
      CHARACTER*40 DIRECTORY_NAME
      CHARACTER*120 FULL_NAME
      SAVE DIRECTORY_NAME
      DATA DIRECTORY_NAME / ' ' /
      INTEGER REV_NUMBER
      SAVE REV_NUMBER
      DATA REV_NUMBER / 6 /
      CHARACTER*2 REV_STRING
      LOGICAL MAKE_BINARY
      LOGICAL MAKE_INTELLEC
      SAVE MAKE_BINARY, MAKE_INTELLEC
      DATA MAKE_BINARY / .TRUE. /, MAKE_INTELLEC / .FALSE. /
      INTEGER LENGTH
C
      INTEGER NUM_PARAMS
      PARAMETER (NUM_PARAMS = 5)
      CHARACTER*33 LABELS(NUM_PARAMS)
      DATA LABELS / 'Directory name', 'File name', 'Revision number',
     &  'Create binary file', 'Create Intellec file' /
      CHARACTER*1 TYPARR(NUM_PARAMS)
      DATA TYPARR / 'C', 'C', 'I', 'L', 'L' /
      INTEGER LIMITS(2, NUM_PARAMS)
      DATA LIMITS / 0, 0,  0, 0,  0, 99,  0, 0,  0, 0 /
C
      INTEGER UNIT_NUM
      INTEGER ROUTINE_ID
      PARAMETER (ROUTINE_ID = 487)
      INTEGER PAGE_LENGTH
      PARAMETER (PAGE_LENGTH = 256)
      INTEGER IERR
      INTEGER PROM_TABLE(2048)
C
 1000 CONTINUE
      CALL GETPAR(1, 'PROM type (EM,HD,PX,PY) > ', 'U', PROM_TYPE)
      IF (PFNUM() .NE. 0) GOTO 999
      IF (PROM_TYPE .EQ. 'EM') THEN
        PROM = EM_PROM
      ELSEIF (PROM_TYPE .EQ. 'HD') THEN
        PROM = HD_PROM
      ELSEIF (PROM_TYPE .EQ. 'PX') THEN
        PROM = PX_PROM
      ELSEIF (PROM_TYPE .EQ. 'PY') THEN
        PROM = PY_PROM
      ELSE
        CALL OUTMSG(' Invalid PROM type.')
        GOTO 1000
      ENDIF
C
 2000 CONTINUE
      CALL GETPAR(1, 'ETA coordinate > ', 'I', ETA)
      IF (PFNUM() .NE. 0) GOTO 999
      IF ((ETA .LE. -ETA_RANGE_MIN) .AND. (ETA .GE. -ETA_RANGE_MAX))
     & THEN
        SIGN_ETA = NEG_ETA
        ETA = ABS(ETA)
      ELSEIF ((ETA .GE. ETA_RANGE_MIN) .AND. (ETA .LE. ETA_RANGE_MAX))
     & THEN
        SIGN_ETA = POS_ETA
      ELSE
        CALL OUTMSG(' ETA value out of range.')
        GOTO 2000
      ENDIF
C
 3000 CONTINUE
      CALL GETPAR(1, 'PHI coordinate > ', 'I', PHI)
      IF (PFNUM() .NE. 0) GOTO 999
      IF ((PHI .LT. PHI_MIN) .OR. (PHI .GT. PHI_MAX)) THEN
        CALL OUTMSG(' PHI value out of range.')
        GOTO 3000
      ENDIF
C
C       Get a file name
C
      FILE_NAME = 'C'
      FILE_NAME(2:3) = PROM_TYPE
      IF (SIGN_ETA .EQ. POS_ETA) THEN
        FILE_NAME(4:4) = 'P'
      ELSE
        FILE_NAME(4:4) = 'N'
      ENDIF
      WRITE(FILE_NAME(5:8), 100) ETA, PHI
  100 FORMAT( I2.2, I2.2)
      FILE_NAME(9:18) = '_CTFE_PROM'
C
      CALL GETDIS(NUM_PARAMS, LABELS, TYPARR, LIMITS, DIRECTORY_NAME,
     &  FILE_NAME, REV_NUMBER, MAKE_BINARY, MAKE_INTELLEC )
C
      IF ((.NOT. MAKE_BINARY) .AND. (.NOT. MAKE_INTELLEC)) THEN
        CALL OUTMSG( ' No files to generate.')
        CALL PFWAIT()
        GOTO 999
      ENDIF
C
      IF ( PROM .EQ. EM_PROM) THEN
        CALL GENERATE_PROM_TABLE_EM(SIGN_ETA, ETA, PHI, PROM_TABLE,
     &    PAGE_LENGTH)
      ELSEIF ( PROM .EQ. HD_PROM) THEN
        CALL GENERATE_PROM_TABLE_HD(SIGN_ETA, ETA, PHI, PROM_TABLE,
     &    PAGE_LENGTH)
      ELSEIF ( PROM .EQ. PX_PROM) THEN
        CALL GENERATE_PROM_TABLE_PX(SIGN_ETA, ETA, PHI, PROM_TABLE,
     &    PAGE_LENGTH)
      ELSEIF ( PROM .EQ. PY_PROM) THEN
        CALL GENERATE_PROM_TABLE_PY(SIGN_ETA, ETA, PHI, PROM_TABLE,
     &    PAGE_LENGTH)
      ENDIF
C
C       Get a unit number and open the file
C
      CALL GTUNIT(ROUTINE_ID, UNIT_NUM, IERR)
      IF (IERR .NE. 0) THEN
        CALL ABORT('Error calling GTUNIT() in GEN_ONE_PROM()')
      ENDIF
C
      LENGTH = TRULEN(DIRECTORY_NAME)
      IF ((LENGTH .GT. 0) .AND. (LENGTH .LT. 40) .AND.
     &  (DIRECTORY_NAME(LENGTH:LENGTH) .NE. ':') .AND.
     &  (DIRECTORY_NAME(LENGTH:LENGTH) .NE. ']')) THEN
        DIRECTORY_NAME(LENGTH+1:LENGTH+1) = ':'
      ENDIF
C
      WRITE(REV_STRING, 200) REV_NUMBER
  200 FORMAT( I2.2)
C
      FULL_NAME = DIRECTORY_NAME(1:TRULEN(DIRECTORY_NAME)) //
     &  FILE_NAME(1:TRULEN(FILE_NAME)) // '.BIN' // REV_STRING(1:2)
C
      CALL WRITE_PROM_FILE(UNIT_NUM, FULL_NAME, PROM_TABLE, PROM,
     &  MAKE_BINARY, MAKE_INTELLEC)
C
      CALL RLUNIT( ROUTINE_ID, UNIT_NUM, IERR)
      IF (IERR .NE. 0) CALL ABORT(
     &  'Error calling RLUNIT in GEN_ONE_PROM')
C
      CALL PFWAIT()
C
  999 RETURN
      END
C