C     SAPF (Sequence assembly program)
C     AUTHOR RODGER STADEN
C     9-1-90  sent idev instead of kbout to join and enter
C     16-3-90 removed escape after bpause
C     2-5-90 Many changes related to introducing graphics
C     4-5-90 Allowed escape from getreg
C     9-5-90 Introduced a default gel reading
C    23-8-90 Added calls to SHOWFU
C    28-11-90 See dbsys89
C    22-1-91 Changed use of showfi to include version number
      SUBROUTINE FMAIN()
      INTEGER CHRSIZ,ECHRSZ
      PARAMETER (
     +           NAMLEN = 40,
     +           MAXDEV = 10,
     +           MAXSEQ=50000,
     +           MAXGLM=4096,
     +           MAXGL2=MAXGLM*2,
     +           CHRSIZ=4,
     +           ECHRSZ = 6,
     +           IDT1=ECHRSZ*MAXGL2,
     +           IDT2=2*CHRSIZ*MAXGL2,
     +           IDT3=2*MAXGL2,
     +           IDT4=2*ECHRSZ*MAXGL2,
     +           MAXDB=1000)
      INTEGER BOTOPT,TOPOPT,DEVNOS(MAXDEV)
      INTEGER RELPG(MAXDB),LREG,RREG,ANS
      INTEGER TEMP1(IDT1),TEMP2(IDT2),TEMP3(IDT4)
      INTEGER LNGTHG(MAXDB),LNBR(MAXDB),RNBR(MAXDB)
      CHARACTER*(NAMLEN) HELPF,POINTF,FILNAM,NAMPRO,FILE,NAMARC,FILMAR
      CHARACTER*(NAMLEN) SHONAM
      CHARACTER GEL(MAXGLM)
      CHARACTER GEL2(MAXGLM),GEL3(MAXGLM),GEL4(MAXGLM)
      PARAMETER (BOTOPT=0,TOPOPT=34)
      PARAMETER (HELPF='SAPHELP')
      PARAMETER (POINTF='SAPHPNT')
      PARAMETER (FILMAR='SAPMARG')
      INTEGER HELPS(BOTOPT:TOPOPT),HELPE(BOTOPT:TOPOPT)
      INTEGER MARGB(TOPOPT),MARGT(TOPOPT)
      CHARACTER SEQ1(MAXSEQ)
C     DBAUTO TEMP3A = TEMP1, SEQ3A = GEL3, SEQ2A = GEL2
C     MATCHA = GEL, SEQ4A = GEL4
      PARAMETER (LENGTH = 6,
     +           MAXCON = 500,
     +           MAXSAV = 1000,
     +           LPOWRC = CHRSIZ**LENGTH)
      INTEGER CONST(LENGTH)
      INTEGER POSNS(MAXSEQ),WORDP(LPOWRC),WORDN(LPOWRC),GELN(MAXGLM)
      INTEGER CENDS(MAXCON),NENDS(MAXCON)
      CHARACTER SEQC2(MAXGLM,2),SEQG2(MAXGLM,2)
      CHARACTER SEQ5(MAXGLM),SEQG3(MAXGLM),SEQC3(MAXGLM)
      INTEGER SAV1(MAXSAV),SAV2(MAXSAV),SAV3(MAXSAV)
      INTEGER WINDOW
C     DBAUTO
      EQUIVALENCE (TEMP2,TEMP1)
      EQUIVALENCE (TEMP1,TEMP3)
      IDM = 5
      CALL INITS
      CALL INITLU(IDM)
      CALL UNITNO(KBIN,KBOUT,DEVNOS,MAXDEV)
      CALL OPENGR(DEVNOS(10))
      CALL CLEARV
      WRITE(KBOUT,1000)
1000  FORMAT(/,
     +' SAPF (Sequence assembly program (flat files) V3.1 Jan 1991',/,
     +' Author: Rodger Staden')
      IGORT = 0
      IDEV = KBOUT
C   GET SCREEN AND MARGIN SIZES
      CALL GETMRG(ISXMAX,ISYMAX,MARGL,MARGR,MARGB,MARGT,
     +TOPOPT,DEVNOS(5),FILMAR)
      CALL SETHLP(HELPS,HELPE,BOTOPT,TOPOPT,POINTF,DEVNOS(5),KBOUT)
      CALL INITGR(KBIN,KBOUT,HELPS(0),HELPE(0),HELPF,IDEVH)
      IOPEN=1
      LINLEN=50
      PERCD=0.75
      WINDOW = 25
      IGWIND = 1000
      FILE = ' '
      MAXGEL = MAXGLM
      SHONAM = ' '
      CALL SHOWFI(KBOUT,SHONAM)
        ANS = 0
        CALL YESONO(ANS,'Open existing database','Start new database',
     +  HELPS(3),HELPE(3),HELPF,DEVNOS(5),KBIN,KBOUT)
        IF(ANS.LT.0)GO TO 10
        IF(ANS.GT.1)GO TO 10
        MAXGEL = MAXGLM
        IF(IOPEN.EQ.0)THEN
          CLOSE(UNIT=DEVNOS(1))
          CLOSE(UNIT=DEVNOS(2))
          CLOSE(UNIT=DEVNOS(3))
          IOPEN=1
        END IF
        IDBSIZ=MAXDB
        IDBSIS=IDBSIZ
        IF(ANS.EQ.1)THEN
        CALL SHOWFU(KBOUT,'Start new database from flat file')
          CALL DBSTAF(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,NAMPRO,GEL,
     +    IDBSIS,IDBSIZ,JERR,KBIN,KBOUT,DEVNOS(1),DEVNOS(2),DEVNOS(3),
     +    MAXGEL,MAXGLM,LLINO,IDM,
     +    HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5))
          IF(JERR.EQ.0)IOPEN=0
          IF(NGELS.GT.0)CALL DBSTAT(RELPG,LNGTHG,LNBR,RNBR,NGELS,
     +    NCONTS,IDBSIZ,KBOUT)
          CALL INITLU(IDM)
          SHONAM = NAMPRO(1:MAX(1,INDEX(NAMPRO,'.'))+1)
          CALL SHOWFI(KBOUT,SHONAM)
          GO TO 10
        END IF
        IF(ANS.EQ.0)THEN
        CALL SHOWFU(KBOUT,'Open database')
          NGELS=0
          NCONTS=0
          CALL DBOPEN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,NAMPRO,GEL,
     +    IDBSIS,IDBSIZ,JERR,KBIN,KBOUT,DEVNOS(1),DEVNOS(2),DEVNOS(3),
     +    MAXGEL,MAXGLM,LLINO,IDM,
     +    HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5))
          IF(JERR.EQ.0)IOPEN=0
          IF(NGELS.GT.0)CALL DBSTAT(RELPG,LNGTHG,LNBR,RNBR,NGELS,
     +    NCONTS,IDBSIZ,KBOUT)
          CALL INITLU(IDM)
          SHONAM = NAMPRO(1:MAX(1,INDEX(NAMPRO,'.'))+1)
          CALL SHOWFI(KBOUT,SHONAM)
          GO TO 10
        END IF
      MENU = 0
10    CONTINUE
      CALL BPAUSE(KBIN,KBOUT,IOK)
      CALL SHOWFU(KBOUT,' ')
C      IF(IOK.NE.0) GO TO 9999
      CALL DBMENT(MENU,NOPT,TOPOPT,HELPS(0),HELPE(0),HELPF,DEVNOS(5),
     +KBIN,KBOUT)
      IF(NOPT.EQ.3)THEN
        ANS = 0
        CALL YESONO(ANS,'Open existing database','Start new database',
     +  HELPS(3),HELPE(3),HELPF,DEVNOS(5),KBIN,KBOUT)
        IF(ANS.LT.0)GO TO 10
        IF(ANS.GT.1)GO TO 10
        MAXGEL = MAXGLM
        IF(IOPEN.EQ.0)THEN
          CLOSE(UNIT=DEVNOS(1))
          CLOSE(UNIT=DEVNOS(2))
          CLOSE(UNIT=DEVNOS(3))
          IOPEN=1
        END IF
        IDBSIZ=MAXDB
        IDBSIS=IDBSIZ
        IF(ANS.EQ.1)THEN
          CALL SHOWFU(KBOUT,'Start a database')
          CALL DBSTAR(NAMPRO,GEL,IDBSIS,IDBSIZ,KBIN,KBOUT,DEVNOS(1),
     +    DEVNOS(2),DEVNOS(3),IERR,HELPS(NOPT),HELPE(NOPT),
     +    DEVNOS(5),HELPF,MAXGEL,MAXGLM,IDM)
          NGELS=0
          NCONTS=0
          IF(IERR.EQ.0)IOPEN=0
          CALL INITLU(IDM)
          SHONAM = NAMPRO(1:MAX(1,INDEX(NAMPRO,'.'))+1)
          CALL SHOWFI(KBOUT,SHONAM)
          GO TO 10
        END IF
        IF(ANS.EQ.0)THEN
          CALL SHOWFU(KBOUT,'Open database')
          NGELS=0
          NCONTS=0
          CALL DBOPEN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,NAMPRO,GEL,
     +    IDBSIS,IDBSIZ,JERR,KBIN,KBOUT,DEVNOS(1),DEVNOS(2),DEVNOS(3),
     +    MAXGEL,MAXGLM,LLINO,IDM,
     +    HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5))
          IF(JERR.EQ.0)IOPEN=0
          IF(NGELS.GT.0)CALL DBSTAT(RELPG,LNGTHG,LNBR,RNBR,NGELS,
     +    NCONTS,IDBSIZ,KBOUT)
          CALL INITLU(IDM)
          SHONAM = NAMPRO(1:MAX(1,INDEX(NAMPRO,'.'))+1)
          CALL SHOWFI(KBOUT,SHONAM)
          GO TO 10
        END IF
      END IF
C  STOP
      IF(NOPT.EQ.2)THEN
        IF(NGELS.GT.0)CALL DBSTAT(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
     +  IDBSIZ,KBOUT)
        GO TO 9999
      END IF
C   clear all
C
      IF(NOPT.EQ.10)THEN
        CALL SHOWFU(KBOUT,'Clear graphics')
        CALL CLEARG
        GO TO 10
      END IF
C   clear VT100
C
      IF(NOPT.EQ.11)THEN
        CALL SHOWFU(KBOUT,'Clear text')
        CALL CLEARV
        GO TO 10
      END IF
C
C   xhairs
C
      IF(NOPT.EQ.13) THEN
          CALL SHOWFU(KBOUT,'Use xhair')
          CALL XHSAP(RELPG,LNGTHG,LNBR,RNBR,
     +    IDBSIZ,NCONTS,LLINO,LINCON,LREG,RREG,
     +    WINDOW,IGWIND,LENCON,IDEPTH,JDEPTH,
     +    MARGL,MARGR,MARGB,MARGT,TOPOPT,ISXMAX,ISYMAX,KBIN,IDEV,
     +    KBOUT,GEL,GEL2,DEVNOS(2),DEVNOS(3),LINLEN,PERCD,MAXGEL,IDM,
     +    SEQ1,MAXSEQ,NGELS,TEMP3,ECHRSZ,MAXGL2,GEL3,GEL4,33,34,29,
     +    HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5))
        GO TO 10
      END IF
C
C   CHANGE MARGINS
C
      IF(NOPT.EQ.14)THEN
        CALL SHOWFU(KBOUT,'Change margins')
        CALL MARGC(ISXMAX,ISYMAX,MARGL,MARGR,MARGB,MARGT,
     +  HELPS(NOPT),HELPE(NOPT),TOPOPT,HELPF,DEVNOS(5),KBIN,KBOUT)
        GO TO 10
      END IF
C  ruler
C
      IF(NOPT.EQ.12) THEN
        LENCON = RREG - LREG + 1
        IF(LENCON.GT.0) THEN
          CALL SHOWFU(KBOUT,'Show ruler')
          CALL RULER(LREG,RREG,MARGL,MARGR,
     +    MARGB(NOPT),MARGT(NOPT),ISXMAX,ISYMAX,KBIN,KBOUT,1,
     +    HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5))
          GO TO 10
        END IF
      END IF
C  labler
      IF(NOPT.EQ.15)THEN
        CALL SHOWFU(KBOUT,'Label diagram')
        CALL LABLER(KBIN,KBOUT,ISXMAX,ISYMAX,
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5))
        GO TO 10
      END IF
      IF(NOPT.EQ.16) THEN
        CALL SHOWFU(KBOUT,'Plot map')
C  map
        LENCON = RREG - LREG + 1
        IF(LENCON.GT.0) THEN
          CALL PLTMAP(DEVNOS(4),FILNAM,LENCON,MARGL,MARGR,MARGB(NOPT),
     +    MARGT(NOPT),ISXMAX,ISYMAX,LREG,RREG,KBIN,KBOUT,
     +    HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5))
        END IF
      GO TO 10
      END IF
      IF((NOPT.EQ.21).AND.(IOPEN.EQ.0))THEN
        CALL SHOWFU(KBOUT,'Enter new gel reading')
C       ENTER
        CALL ENTER(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
     +  GEL,GEL2,IDBSIZ,IDEV,KBIN,KBOUT,DEVNOS(1),DEVNOS(2),
     +  DEVNOS(3),DEVNOS(4),LINLEN,PERCD,FILNAM,
     +  HELPS(NOPT),HELPE(NOPT),HELPS(4),HELPE(4),HELPF,DEVNOS(5),
     +  MAXGEL,IDM,LLINO)
        GO TO 10
      END IF
      IF((NOPT.EQ.25).AND.(IOPEN.EQ.0))THEN
        CALL SHOWFU(KBOUT,'Show relationships')
C       PRINT DB
        CALL DBPRNT(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDBSIZ,IDEV,
     +  KBIN,KBOUT,DEVNOS(3),LLINO,
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5))
        GO TO 10
      END IF
      IF((NOPT.EQ.5).AND.(IOPEN.EQ.0))THEN
        CALL SHOWFU(KBOUT,'Display contig')
C       DISPLAY
        CALL GETLN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,LINCON,
     +  LLINO,IERR,IDBSIZ,KBIN,KBOUT,DEVNOS(3),
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5))
        IF(IERR.EQ.0)THEN
          CALL GETREG(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
     +    1,RELPG(LINCON),LREG,RREG,LINCON,LLINO,IDBSIZ,KBIN,KBOUT,
     +    HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),IERR)
          IF(IERR.EQ.0)THEN
          CALL DSPLAY(RELPG,LNGTHG,LNBR,RNBR,
     +    GEL,LLINO,LINCON,LREG,RREG,GEL2,I1,I2,0,I,IDBSIZ,IDEV,KBOUT,
     +    DEVNOS(2),DEVNOS(3),LINLEN,PERCD,MAXGEL,IDM)
          END IF
        END IF
        GO TO 10
      END IF
200   CONTINUE
      IF((NOPT.EQ.22).AND.(IOPEN.EQ.0))THEN
        CALL SHOWFU(KBOUT,'Join contigs')
C       JOIN
        WRITE(KBOUT,1006)
1006    FORMAT(' Which contigs do you want to join ?')
        WRITE(KBOUT,1017)
1017    FORMAT( ' Left contig')
        LLINOL = 0
        LLINOR = 0
        CALL GETLN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,LNCONL,LLINOL,
     +  IERR,IDBSIZ,KBIN,KBOUT,DEVNOS(3),
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5))
        IF(IERR.EQ.0)THEN
          WRITE(KBOUT,1018)
1018      FORMAT( ' Right contig')
          CALL GETLN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
     +    LNCONR,LLINOR,IERR,IDBSIZ,KBIN,KBOUT,DEVNOS(3),
     +    HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5))
          IF(IERR.EQ.0)THEN
C           CHECK TO SEE IF MAKING A CIRCLE!
            IF(LLINOL.EQ.LLINOR)THEN
              WRITE(KBOUT,*)' Making circles is not allowed!'
              GO TO 200
            END IF
            CALL JOIN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
     +      LNCONL,LLINOL,LNCONR,LLINOR,GEL,GEL2,
     +      IDBSIZ,IDEV,KBIN,KBOUT,DEVNOS(1),DEVNOS(2),
     +      DEVNOS(3),LINLEN,PERCD,
     +      HELPS(NOPT),HELPE(NOPT),HELPS(4),HELPE(4),HELPF,DEVNOS(5),
     +      MAXGEL,IDM)
          END IF
        END IF
        GO TO 10
      END IF
      IF((NOPT.EQ.23).AND.(IOPEN.EQ.0))THEN
        CALL SHOWFU(KBOUT,'Complement contig')
C       COMPLEMENT
        CALL GETLN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
     +  LINCON,LLINO,IERR,IDBSIZ,KBIN,KBOUT,DEVNOS(3),
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5))
        IF(IERR.EQ.0)THEN
          CALL CMPLMT(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
     +    LINCON,LLINO,GEL,IDBSIZ,KBOUT,DEVNOS(1),DEVNOS(2),
     +    MAXGEL)
        END IF
        GO TO 10
      END IF
C  EDIT
      IF((NOPT.EQ.4).AND.(IOPEN.EQ.0))THEN
C       EDIT DB
        CALL GETLN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,LINCON,
     +  LLINO,IERR,IDBSIZ,KBIN,KBOUT,DEVNOS(3),
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5))
        IF(IERR.EQ.0)THEN
          CALL DBEDIT(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
     +    GEL,LINCON,0,0,IDBSIZ,KBIN,KBOUT,DEVNOS(1),DEVNOS(2),
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),MAXGEL)
        END IF
        GO TO 10
      END IF
C  PLOT SINGLE CONTIG
      IF((NOPT.EQ.33).AND.(IOPEN.EQ.0))THEN
        CALL GETLN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,LINCON,
     +  LLINO,IERR,IDBSIZ,KBIN,KBOUT,DEVNOS(3),
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5))
        IF(IERR.EQ.0)THEN
          CALL GETREG(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
     +    1,RELPG(LINCON),LREG,RREG,LINCON,LLINO,IDBSIZ,KBIN,KBOUT,
     +    HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),IERR)
        IF(IERR.EQ.0)THEN
          LENCON = RREG - LREG + 1
          CALL FDEPTH(RELPG,LNGTHG,LNBR,RNBR,
     +    IDBSIZ,LLINO,LREG,RREG,LENCON,
     +    MARGL,MARGR,MARGB(NOPT),MARGT(NOPT),ISXMAX,ISYMAX)
        END IF
        END IF
        GO TO 10
      END IF
      IF((NOPT.EQ.26).AND.(IOPEN.EQ.0))THEN
        CALL SHOWFU(KBOUT,'Alter relationships')
C       FIX
        CALL DBFIX(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
     +  GEL,GEL2,IDBSIZ,KBIN,KBOUT,DEVNOS(1),DEVNOS(2),DEVNOS(3),
     +  HELPS(NOPT),HELPE(NOPT),
     +  HELPS(4),HELPE(4),HELPF,DEVNOS(5),MAXGEL)
        GO TO 10
      END IF
      IF((NOPT.EQ.24).AND.(IOPEN.EQ.0))THEN
        CALL SHOWFU(KBOUT,'Copy database to flat format')
C       COPY
        CALL DBCOPF(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,GEL,
     +  NAMPRO,DEVNOS(4),IDBSIZ,JERR,KBIN,KBOUT,DEVNOS(1),
     +  DEVNOS(2),DEVNOS(3),
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),MAXGEL,MAXDB,IDM)
        GO TO 10
      END IF
      IF((NOPT.EQ.19).AND.(IOPEN.EQ.0))THEN
        CALL SHOWFU(KBOUT,'Check database for consistency')
C       CHECK
        CALL DBCHEK(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDBSIZ,
     +  TEMP1,IERR,KBOUT)
        GO TO 10
      END IF
      IF((NOPT.EQ.29).AND.(IOPEN.EQ.0))THEN
        CALL SHOWFU(KBOUT,'Examine quality')
C       SCAN
        IDIM1=MAXSEQ
        CALL DBSCAN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,SEQ1,
     +  IDIM1,GEL,IDBSIZ,TEMP3,2,ECHRSZ,MAXGL2,
     +  KBIN,KBOUT,DEVNOS(2),IDEV,LINLEN,PERCD,
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),MAXGEL,GEL3,GEL4,
     +  MARGL,MARGR,MARGB(NOPT),MARGT(NOPT),ISXMAX,ISYMAX,DEVNOS(3),
     +  LLINO,LINCON,LREG,RREG)
        GO TO 10
      END IF
      IF((NOPT.EQ.8).AND.(IOPEN.EQ.0))THEN
        CALL SHOWFU(KBOUT,'Make consensus')
C       CONSENSUS
        IDIM1=MAXSEQ
        CALL CONSEN(RELPG,LNGTHG,LNBR,RNBR,NAMPRO,NGELS,NCONTS,SEQ1,
     +  IDIM1,GEL,IDBSIZ,TEMP1,ECHRSZ,MAXGL2,
     +  KBIN,KBOUT,DEVNOS(2),DEVNOS(4),FILNAM,
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),MAXGEL,IDM,PERCD,
     +  DEVNOS(3),LLINO)
        CLOSE(UNIT=DEVNOS(4))
        GO TO 10
      END IF
      IF(NOPT.EQ.7)THEN
        CALL SHOWFU(KBOUT,'Redirect output')
        CALL REDIR(IDEV,DEVNOS(6),DEVNOS(10),IGORT,FILNAM,KBIN,KBOUT,
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),KOPT)
        GO TO 10
      END IF
C  HELP
      IF(NOPT.EQ.1)THEN
        CALL SHOWFU(KBOUT,'Help')
C       HELP
        CALL HELP(HELPS,HELPE,BOTOPT,TOPOPT,
     +  HELPF,DEVNOS(5),KBIN,KBOUT)
        GO TO 10
      END IF
      IF(NOPT.EQ.27)THEN
        CALL SHOWFU(KBOUT,'Set parameters')
C  SET DISPLAY PARAMETERS
        MN = 10
        MX = 100
        LINLEN = 50
        CALL GETINT(MN,MX,LINLEN,'Display line length',
     +  IVAL,KBIN,KBOUT,HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),IOK)
        IF(IOK.EQ.0) LINLEN = IVAL
        IPCMIN = 51
        IPCMAX = 100
        IPCD = 75
        CALL GETINT(IPCMIN,IPCMAX,IPCD,
     +  'Percentage score for consensus',
     +  IPVAL,KBIN,KBOUT,HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),IOK)
        IF(IOK.EQ.0) THEN
          PERCD = REAL(IPVAL)/100.
        END IF
        MN = 1
        MX = MAXSEQ
        CALL GETINT(MN,MX,WINDOW,'Text window length',
     +  IVAL,KBIN,KBOUT,HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),IOK)
        IF(IOK.EQ.0) WINDOW = IVAL
        MN = 1
        MX = MAXSEQ
        CALL GETINT(MN,MX,IGWIND,'Graphics window length',
     +  IVAL,KBIN,KBOUT,HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),IOK)
        IF(IOK.EQ.0) IGWIND = IVAL
        GO TO 10
      END IF
      IF(NOPT.EQ.6)THEN
        CALL SHOWFU(KBOUT,'Display text file')
       CALL TTEXT(DEVNOS(4),FILNAM,KBIN,KBOUT,
     + HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5))
        CLOSE(UNIT=DEVNOS(4))
       GO TO 10
      END IF
      IF(NOPT.EQ.28) THEN
        CALL SHOWFU(KBOUT,'Highlight disagreements')
        CALL HIGHLT(SEQ1,SEQ1(6001),SEQ1(10001),KBIN,KBOUT,
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),DEVNOS(7),
     +  DEVNOS(8),FILE,IOK)
        CLOSE(UNIT=DEVNOS(7))
        CLOSE(UNIT=DEVNOS(8))
        GO TO 10
      END IF
      IF((NOPT.EQ.34).AND.(IOPEN.EQ.0))THEN
        CALL SHOWFU(KBOUT,'Plot contigs')
C  PLOT ALL CONTIGS
        CALL PLC(RELPG,LNGTHG,LNBR,RNBR,IDBSIZ,0,0,
     +  NCONTS,MARGL,MARGR,MARGB(NOPT),MARGT(NOPT),ISXMAX,ISYMAX)
        GO TO 10
      END IF
C  AUTO EDIT
      IF((NOPT.EQ.30).AND.(IOPEN.EQ.0))THEN
        CALL SHOWFU(KBOUT,'AutoEdit a contig')
        WRITE(KBOUT,*)'Make a copy first!'
        CALL GETLN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,LINCON,
     +  LLINO,IERR,IDBSIZ,KBIN,KBOUT,DEVNOS(3),
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5))
        IF(IERR.EQ.0)THEN
          CALL GETREG(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
     +    1,RELPG(LINCON),LREG,RREG,LINCON,LLINO,IDBSIZ,KBIN,KBOUT,
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),IERR)
        IF(IERR.EQ.0) THEN
        IDIM1=MAXSEQ
        CALL SUMMER(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,SEQ1,IDIM1,
     +  GEL,LREG,RREG,LLINO,IDBSIZ,TEMP1,ECHRSZ,MAXGL2,
     +  DEVNOS(2),MAXGEL,IDM,PERCD)
        CALL AEDIT(RELPG,LNGTHG,LNBR,RNBR,IDBSIZ,LLINO,LINCON,
     +  GEL,MAXGEL,SEQ1,IDIM1,DEVNOS(2),DEVNOS(1),LREG,RREG,
     +  KBOUT)
      END IF
      END IF
      GO TO 10
      END IF
      IF((NOPT.EQ.9).AND.(IOPEN.EQ.0)) THEN
        CALL SHOWFU(KBOUT,'Screen Edit a contig')
        CALL CEDT(KBIN,KBOUT,
     +  POSNS(1),POSNS(1001),POSNS(2001),
     +  MAXDB,POSNS(3001),POSNS(3101),50,
     +  RELPG,LNGTHG,LNBR,RNBR,
     +  IDBSIZ,NGELS,NCONTS,GEL,GEL2,MAXGEL,LINCON,PERCD,IDM,
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),DEVNOS(4),
     +  DEVNOS(1),DEVNOS(2),DEVNOS(3),LINLEN,FILNAM,LLINO,IOK)
        GO TO 10
      END IF
      IF(NOPT.EQ.17) THEN
        CALL SHOWFU(KBOUT,'Screen for restriction sites')
        CALL SCRENR(GEL2,MAXGEL,GEL3,NAMARC,FILE,
     +  DEVNOS(4),DEVNOS(7),DEVNOS(8),DEVNOS(9),IDEV,KBIN,KBOUT,
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5))
        CLOSE(UNIT=DEVNOS(4))
        CLOSE(UNIT=DEVNOS(7))
        CLOSE(UNIT=DEVNOS(8))
        CLOSE(UNIT=DEVNOS(9))
        GO TO 10
      END IF
      IF(NOPT.EQ.18) THEN
        CALL SHOWFU(KBOUT,'Screen against vector')
        CALL SCRENV(MAXGEL,WORDP,WORDN,LPOWRC,POSNS,GELN,
     +  SEQ1,MAXSEQ,GEL2,GEL3,GEL4,LENGTH,
     +  SAV1,SAV2,SAV3,MAXSAV,CENDS,NENDS,MAXCON,CONST,
     +  KBIN,KBOUT,DEVNOS(4),DEVNOS(7),DEVNOS(8),DEVNOS(9),IDEV,
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),NAMARC,FILE,IOK)
        CLOSE(UNIT=DEVNOS(4))
        CLOSE(UNIT=DEVNOS(7))
        CLOSE(UNIT=DEVNOS(8))
        CLOSE(UNIT=DEVNOS(9))
        GO TO 10
      END IF
      IF((NOPT.EQ.20).AND.(IOPEN.EQ.0).AND.(IDM.EQ.5)) THEN
        CALL SHOWFU(KBOUT,'Auto assemble sequences')
      CALL DBAUTO(RELPG,LNGTHG,LNBR,RNBR,MAXDB,IDBSIZ,
     +NGELS,NCONTS,MAXGEL,
     +TEMP1,WORDP,WORDN,LPOWRC,POSNS,GELN,
     +SEQ1,MAXSEQ,GEL2,GEL3,GEL4,SEQ5,SEQC2,SEQG2,GEL,
     +MAXGLM,MAXGL2,CHRSIZ,ECHRSZ,LENGTH,
     +SAV1,SAV2,SAV3,MAXSAV,CENDS,NENDS,MAXCON,CONST,
     +KBIN,KBOUT,DEVNOS(1),DEVNOS(2),DEVNOS(3),
     +DEVNOS(4),DEVNOS(7),DEVNOS(8),IDEV,
     +HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),NAMARC,NAMPRO,FILE,
     +PERCD,IOPEN,IDM,SEQG3,SEQC3,IOK)
        CLOSE(UNIT=DEVNOS(4))
        CLOSE(UNIT=DEVNOS(7))
        CLOSE(UNIT=DEVNOS(8))
        GO TO 10
      END IF
      IF((NOPT.EQ.32).AND.(IOPEN.EQ.0)) THEN
        CALL SHOWFU(KBOUT,'Extract gel readings')
        CALL GELOUT(RELPG,LNGTHG,LNBR,RNBR,MAXDB,IDBSIZ,NGELS,
     +  NCONTS,GEL,MAXGEL,DEVNOS(2),DEVNOS(3),DEVNOS(4),DEVNOS(7),
     +  KBIN,KBOUT,
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),FILE)
        CLOSE(UNIT=DEVNOS(4))
        GO TO 10
      END IF
      IF(NOPT.EQ.31) THEN
        CALL SHOWFU(KBOUT,'Type in gel readings')
        CALL BATIN(SEQ1,MAXSEQ,KBIN,KBOUT,
     +  DEVNOS(4),DEVNOS(7),IDEV,
     +  FILNAM,HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5))
        GO TO 10
      END IF
      IF((NOPT.GT.3).AND.(IOPEN.NE.0))THEN
        WRITE(KBOUT,1012)
1012    FORMAT(' You have not opened a database!')
        GO TO 10
      END IF
      GO TO 10
9999  CONTINUE
      CALL SHUTD
      END
      SUBROUTINE DBCOPF(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,GEL,
     +NAMPRO,IDEV,IDBSIZ,IERR,KBIN,KBOUT,IDEVR,IDEVW,IDEVN,
     +IHELPS,IHELPE,FILEH,IDEVH,MAXGEL,MAXDB,IDM)
      CHARACTER FILEH*(*)
C   AUTHOR: RODGER STADEN
      INTEGER RELPG(IDBSIZ)
      INTEGER LNGTHG(IDBSIZ),LNBR(IDBSIZ),RNBR(IDBSIZ)
      CHARACTER NAMPRO*(*),NAMARC*10,GEL(MAXGEL)
C      CHARACTER NAMFIL*12,MTYPE*4
      INTEGER IWORD
      PARAMETER (IWORD=4)
      IERR=1
1     CONTINUE
      L = 1
      CALL BUSY(KBOUT)
      NEWSIZ = IVAL
      LLL = INDEX(NAMPRO,'.') + 1
      NAMPRO(LLL:)='FLAT'
       CALL OPENRS(IDEV,NAMPRO,IOK,LRECL,1)
      IF(IOK.NE.0)GO TO 100
      IRAW = 0
      IF(IDEVRD.LT.0) IRAW = 1
      WRITE(IDEV,1000,ERR=999)IDBSIZ,MAXGEL,IDM,NGELS,NCONTS,IRAW
 1000 FORMAT(6I6)
      DO 10 I=1,NGELS
        WRITE(IDEV,1000,ERR=999)RELPG(I),LNGTHG(I),LNBR(I),RNBR(I)
10    CONTINUE
      N=IDBSIZ-NCONTS
      DO 15 I=N,IDBSIZ-1
        WRITE(IDEV,1000,ERR=999)RELPG(I),LNGTHG(I),LNBR(I),RNBR(I)
15    CONTINUE
C
      DO 20 I=1,NGELS
        CALL READN(IDEVN,I,NAMARC)
        CALL READW(IDEVW,I,GEL,MAXGEL)
        WRITE(IDEV,1001,ERR=999)NAMARC
        WRITE(IDEV,1002,ERR=999)(GEL(K),K=1,ABS(LNGTHG(I)))
        WRITE(IDEV,1004)
20    CONTINUE
 1001 FORMAT(A)
 1002 FORMAT(64A1)
 1004 FORMAT('/')
C      IF(IDEVRD.GT.0) THEN
C        DO 30 I=1,NGELS
C        CALL READRD(IDEVRD,I,LENR,LCUT,LENW,MTYPE,NAMFIL)
C        WRITE(IDEV,1003,ERR=999)LENR,LCUT,LENW,MTYPE,NAMFIL
C 30     CONTINUE
C 1003   FORMAT(3I6,' ',A,' ',A)
C      END IF
      IERR=0
      RETURN
100   CONTINUE
      WRITE(KBOUT,9998)
 9998 FORMAT(' Error opening file, copy aborted')
      RETURN
 999  CONTINUE
      WRITE(KBOUT,9999)
9999  FORMAT(' Error writing data, copy aborted')
      RETURN
      END
      SUBROUTINE DBSTAF(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,NAMPRO,GEL,
     +IDBSIS,IDBSIZ,IERR,KBIN,KBOUT,IDEVR,IDEVW,IDEVN,MAXGEL,
     +MAXGLM,LLINO,
     +IDM,IHELPS,IHELPE,HELPF,IDEVH)
C   AUTHOR: RODGER STADEN
      CHARACTER GEL(MAXGLM)
      INTEGER RELPG(IDBSIS)
      INTEGER LNGTHG(IDBSIS),LNBR(IDBSIS),RNBR(IDBSIS)
      CHARACTER NAMPRO*(*),MTYPE*4,NAMFIL*12
      INTEGER IWORD
      PARAMETER (IWORD=4)
C  SETTING DEVICE NO HERE !!!!!!!!!!!!!
      IDEV = 33
      NAMPRO(1:)=' '
      IERR=1
1     CONTINUE
      L = 0
      CALL GTSTR('Project name of flat database',
     +' ',NAMPRO,L,KBOUT,KBIN,INFLAG)
      IF(L.LT.1) RETURN
      LL = L
      CALL CCASE(NAMPRO,1)
      IF(INFLAG.EQ.2) RETURN
      IF(INFLAG.EQ.1) THEN
        CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
        GO TO 1
      END IF
      LL = INDEX(NAMPRO,' ')
      NAMPRO(LL:)='.FLAT'
      CALL OPENRS(IDEV,NAMPRO,IOK,LRECL,2)
      IF(IOK.NE.0) RETURN
      LL = LL - 1
      NAMPRO(LL+1:LL+5)='.RL0 '
      CALL OPENRS(IDEVR,NAMPRO,IOK,4,3)
      IF(IOK.NE.0)GO TO 100
      READ(IDEV,1000,ERR=999)IDBSIZ,MAXGEL,IDM,NGELS,NCONTS,IRAW
 1000 FORMAT(6I6)
      DO 10 I=1,NGELS
        READ(IDEV,1000,ERR=999)RELPG(I),LNGTHG(I),LNBR(I),RNBR(I)
        CALL WRITER(IDEVR,I,RELPG(I),LNGTHG(I),LNBR(I),RNBR(I))
 10     CONTINUE
      MXT = 0
      DO 20 I=IDBSIZ-NCONTS,IDBSIZ-1
        READ(IDEV,1000,ERR=999)RELPG(I),LNGTHG(I),LNBR(I),RNBR(I)
        CALL WRITER(IDEVR,I,RELPG(I),LNGTHG(I),LNBR(I),RNBR(I))
        IF(RELPG(I).GT.MXT) THEN
          MXT = RELPG(I)
          LLINO = LNBR(I)
        END IF
 20     CONTINUE
      IR = 0
      IL = 0
      DO 30 I=NGELS+1,IDBSIZ-NCONTS-1
        RELPG(I) = 0
        LNGTHG(I) = 0
        LNBR(I) = 0
        RNBR(I) = 0
        CALL WRITER(IDEVR,I,RELPG(I),LNGTHG(I),LNBR(I),RNBR(I))
 30     CONTINUE
      CALL WRITER(IDEVR,IDBSIZ,NGELS,NCONTS,IR,IL)
5     CONTINUE
      MN = 512
      MX = MAXGLM
      CALL GETINT(MN,MX,MAXGEL,
     +'Maximum gel reading length',
     +IVAL,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
      MAXGEL = IVAL
      IF(MOD(IVAL,MN).NE.0) THEN
        MAXGEL = 512 + (IVAL/512)*512
        WRITE(KBOUT,*)'Maximum set to',MAXGEL
      END IF
      IREC=MAXGEL/IWORD
      IF(MOD(MAXGEL,IWORD).NE.0)IREC=IREC+1
      NAMPRO(LL+2:LL+3) = 'SQ'
      CALL OPENRS(IDEVW,NAMPRO,IOK,IREC,3)
      IF(IOK.NE.0)GO TO 100
      CALL FILLC(GEL,MAXGEL,' ')
      CALL WRITEW(IDEVW,IDBSIZ,GEL,MAXGEL)
      NAMPRO(LL+2:LL+3)='AR'
      CALL OPENRS(IDEVN,NAMPRO,IOK,3,3)
      IF(IOK.NE.0)GO TO 100
C  NOTE HERE IS A WRITE TO NAMES FILE NOT USING A SUBROUTINE CALL
      WRITE(IDEVN,REC=IDBSIS)IDBSIZ,MAXGEL,IDM
      DO 40 I = 1,NGELS
        READ(IDEV,1001,ERR=999)NAMFIL
        CALL WRITEN(IDEVN,I,NAMFIL)
        K1 = -63
        CALL FILLC(GEL,MAXGEL,' ')
 35     CONTINUE
        K1 = K1 + 64
        K1 = MIN(K1,MAXGEL)
        K2 = K1 + 63
        K2 = MIN(K2,MAXGEL)
        READ(IDEV,1002,ERR=999)(GEL(K),K=K1,K2)
        IF(GEL(K1).NE.'/') GO TO 35
        CALL WRITEW(IDEVW,I,GEL,MAXGEL)
 40     CONTINUE
 1001   FORMAT(A)
 1002   FORMAT(64A1)
      IRAW = 1
      IF(IRAW.EQ.0) THEN
        NAMPRO(LL+2:LL+3)='RD'
        CALL OPENRS(IDEVRD,NAMPRO,IOK,7,3)
      ELSE
        IDEVRD = -1
      END IF
      IF(IDEVRD.GT.0) THEN
        DO 50 I=1,NGELS
        READ(IDEV,1003,ERR=999)II,J,K,MTYPE,NAMFIL
C        CALL WRITRD(IDEVRD,I,II,J,K,MTYPE,NAMFIL)
 50     CONTINUE
 1003   FORMAT(3I6,1X,A,1X,A)
      END IF
      WRITE(KBOUT,1004)NAMPRO(1:LL),IDBSIZ
 1004 FORMAT(' Database ',A,' version 0, size',I5,
     +' successfully started')
      IERR=0
      NAMPRO(LL+2:LL+2) = '0'
      CLOSE(UNIT=IDEV)
      RETURN
 999  CONTINUE
      WRITE(KBOUT,*)'Error reading flat file'
      CLOSE(UNIT=IDEV)
      RETURN
100   CONTINUE
      WRITE(KBOUT,9999)
9999  FORMAT(' Error when trying to open database,',
     +' database not started')
      CLOSE(UNIT=IDEV)
      RETURN
      END
