C   SETHELP
C   AUTHOR RODGER STADEN
C   CREATES A HELP FILE FROM A FILE OF DOCUMENTATION THAT HAS THE
C   FOLLOWING CHARACTERISTICS
C   1) EACH OPTION HAS A NUMBER BETWEEN BOTOPT AND TOPOPT
C   2) THE OPTION DESCRIPTIONS ARE HEADED BY THEIR OPTION NUMBER
C   3) OPTION HEADERS ARE FORMATTED IN THE FOLLOWING WAY
C       A) ^@IJ. WHERE ^=SPACE, IJ=A 1 OR 2 DIGIT NUMBER, .=THE RIGHT
C          DELIMITER OF THE NUMBER. THE NUMBER STARTS IN COLUMN 3.
C   4) EACH LINE <81 CHARACTERS IN LENGTH
C   5) THE BEST WAY TO FORMAT THE ORIGINAL TEXT FILE IS BY USING RUNOFF
C   UNITS:         KEYBOARD INPUT       KBIN=5,
C                  KEYBOARD OUTPUT      KBOUT=6,
C                  TEXT FILE INPUT      DEVNOS(1)=1,
C                  HELP FILE OUTPUT     DEVNOS(2)=2,
C                  HELP POINTERS        DEVNOS(3)=3
      SUBROUTINE FMAIN()
      INTEGER BOTOPT,TOPOPT,BOT,TOP,DEVNOS(3)
      PARAMETER (BOTOPT=-100,TOPOPT=300)
      INTEGER HELPS(BOTOPT:TOPOPT),HELPE(BOTOPT:TOPOPT)
      CHARACTER LINE*80
      CHARACTER FILNAM*40
        EXTERNAL IFROMC
      CALL UNITNO(KBIN,KBOUT,DEVNOS,3)
      WRITE(KBOUT,*)'  SETHELP V2.1  AUTHOR: RODGER STADEN'
        WRITE(KBOUT,2000)BOTOPT,TOPOPT
2000    FORMAT(' MINIMUM AND MAXIMUM ALLOWED OPTION NUMBERS ARE',2I6)
        WRITE(KBOUT,1000)
1000  FORMAT(' ORIGINAL TEXT FILE NAME=',$)
      CALL OPENF(DEVNOS(1),FILNAM,0,IOK,KBIN,KBOUT)
      IF(IOK.NE.0)STOP
      WRITE(KBOUT,1001)
1001  FORMAT(' RANDOM ACCESS TEXT FILE NAME=',$)
      READ(KBIN,1002)FILNAM
1002  FORMAT(A)
      FILNAM(30:30)=' '
      CALL OPENRS(DEVNOS(2),FILNAM,IOK,20,3)
      IF(IOK.NE.0)GO TO 100
      WRITE(KBOUT,1003)
1003  FORMAT(' RECORD POINTER FILE=',$)
      CALL OPENF(DEVNOS(3),FILNAM,1,IOK,KBIN,KBOUT)
      IF(IOK.NE.0)STOP
C   SET SILLY RANGES
      BOT=99999
      TOP=-9999
      DO 10 I=BOTOPT,TOPOPT
      HELPS(I)=1
      HELPE(I)=1
10    CONTINUE
C   SET NOPT, THE CURRENT OPTION NUMBER TO A FLAG VALUE TO MARK FIRST OPTION
      NOPT=-9999
C   IREC1 IS THE CURRENT LINE NUMBER
C   IREC2 IS THE LINE NUMBER THAT THE LAST OPTION STARTS ON
      IREC1=0
      IREC2=1
30    CONTINUE
      IREC1=IREC1+1
      READ(DEVNOS(1),1002,END=40)LINE
      WRITE(DEVNOS(2),REC=IREC1)LINE
C   IS THIS THE FIRST LINE OF A NEW OPTION?
      IF(LINE(2:2).EQ.'@')THEN
      NCHAR=2
      IF(LINE(4:4).EQ.'.')NCHAR=1
C   LAST OPTION (NOPT) STARTS ON LINE IREC2 AND FINISHIES ON IREC1-1
C   IF FIRST OPTION SKIP
      IF(NOPT.EQ.-9999)GO TO 35
      HELPS(NOPT)=IREC2
      HELPE(NOPT)=IREC1-1
35    CONTINUE
C   POINT TO START OF NEXT OPTION
      IREC2=IREC1
C  GET NEXT OPTION NUMBER
C       NOPT=IFROMC(LINE(3:3),NCHAR,KBOUT)+ABS(BOT)
      NOPT=IFROMC(LINE(3:3),NCHAR,KBOUT)
      BOT=MIN(BOT,NOPT)
      TOP=MAX(TOP,NOPT)
        WRITE(KBOUT,2001)NOPT
2001    FORMAT(' OPTION NUMBER=',I6)
      END IF
      GO TO 30
40    CONTINUE
C   DO LAST OPTION
      HELPS(NOPT)=IREC2
      HELPE(NOPT)=IREC1-1
      DO 50 I=BOT,TOP
        WRITE(KBOUT,2002)I,HELPS(I),HELPE(I)
2002    FORMAT(' OPTION',I6,' STARTS AT RECORD',I6,' AND ENDS AT',I6)
50    WRITE(DEVNOS(3),1004)I,HELPS(I),HELPE(I)
1004  FORMAT(3I6)
      CLOSE(UNIT=DEVNOS(1))
      CLOSE(UNIT=DEVNOS(3))
      CLOSE(UNIT=DEVNOS(2))
      STOP
100   CONTINUE
      WRITE(KBOUT,9999)
9999  FORMAT(' ERROR WHEN TRYING TO OPEN DIRECT ACCESS FILE')
      STOP
      END