C     BAP (Sequence assembly program)
C     AUTHOR and copyright RODGER STADEN
C  23-1-93 new consensus routine
C  23-10-92 tidy up for distribution
C  25-8-92 Added disassembly routine (31)
C    22-7-92 Added busy database checks
C    14-7-92 added delete contig to fix
C    4-6-92 Added padshifting under auto edit function
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    3-12-90 Add invocation of contig editor
C    25-02-91 tag and comment files
C    28-2-91 changed maxsav from 1000 to maxglm
C    30-4-91 changes help references to DAP*
C    28-7-91 added extra parameter for quality calc: maxgood, only the parts
C    of reads upto this length are used
C    21-8-91 Added an option to find internal joins: AUTOJ
C    27-8-91 Added buffer flushing for database files
C    13-6-92 Upped MAXSEQ to 400000
C    2-9-91  BIG CHANGE: reading names increased to 16 chars and
C            max readings can now be set at compile up to 999999 and
C            database organisation changed (record 1 of relationships
C            now used for file info, last record of names not used
C            for file size info and database start does not waste
C            space in working version and names files: they are
C            increased as we go along
C    12-11-91 Changed autoedit so that it takes strands into account: needs
C             a new consensus type calculation sumss and a call from main.
C    17-3-92 Changed maxcon from 500 to maxdb/2
      SUBROUTINE FMAIN()
      INTEGER CHRSIZ,ECHRSZ
      PARAMETER (
     +           NAMLEN = 40,
     +           MAXDEV = 12,
     +           MAXSEQ=500000,
     +           MAXGLM=4096,
     +           MAXGL2=MAXGLM*2,
     +           CHRSIZ=4,
     +           ECHRSZ = 6,
     +           IDT1=ECHRSZ*MAXGL2,
     +           IDT2=2*CHRSIZ*MAXGL2,
     +           IDT3=2*MAXGL2,
     +           IDT4=2*ECHRSZ*MAXGL2,
     +           MAXDB=8000)
      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=39)
      PARAMETER (MINMEN=-3)
      PARAMETER (HELPF='BAPHELP')
      PARAMETER (POINTF='BAPHPNT')
      PARAMETER (FILMAR='BAPMARG')
      INTEGER HELPS(BOTOPT:TOPOPT),HELPE(BOTOPT:TOPOPT)
      INTEGER MARGB(TOPOPT),MARGT(TOPOPT)
      CHARACTER SEQ1(MAXSEQ), SEQ2(MAXSEQ)
C     DBAUTO TEMP3A = TEMP1, SEQ3A = GEL3, SEQ2A = GEL2
C     MATCHA = GEL, SEQ4A = GEL4
      PARAMETER (LENGTH = 7,
     +           MAXCON = MAXDB/2,
     +           MAXSAV = MAXGLM,
     +           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,ACTF,CONOK
      INTEGER OLILEN,OLIBAK,TEMNUM,OLINUM
      EXTERNAL ACTF,CONOK
      PARAMETER (LENRNM = 16)
      CHARACTER*(LENRNM) RNAMES(MAXDB)
      EQUIVALENCE (SEQ2,RNAMES)
C     DBAUTO
      EQUIVALENCE (TEMP2,TEMP1)
      EQUIVALENCE (TEMP1,TEMP3)
      COMMON /DEVILS/ IDEVT,IDEVC,IDBSIZ,RELPG
      IDM = 5
      CALL INITS
      CALL INITLU(IDM)
      CALL INTHLP('bap', TOPOPT)
      CALL UNITNO(KBIN,KBOUT,DEVNOS,MAXDEV)
      CALL OPENGR(DEVNOS(10))
      WRITE(KBOUT,1000)
1000  FORMAT(
     +' BAP (Development assembly program) V12.1 May 1993',/,
     +' Copyright: MRC Laboratory of Molecular Biology')
      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,DEVNOS(5))
      IOPEN=1
      LINLEN=50
      PERCD=0.75
      WINDOW = 25
      MXGOOD = MAXGLM
      IGWIND = 1000
      FILE = ' '
      FILNAM = ' '
      MAXGEL = MAXGLM
      IDEVR = DEVNOS(1)
      IDEVW = DEVNOS(2)
      IDEVN = DEVNOS(3)
      IDEVT  = DEVNOS(11)
      IDEVC  = DEVNOS(12)
      IDEVH = DEVNOS(5)
      IDBSIZ=MAXDB
      IDBSIS=IDBSIZ
      LREG = 0
      RREG = 0
      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(ANS.EQ.1)THEN
C          CALL SHOWFU(KBOUT,'Start new database')
          CALL DBSTAR(NAMPRO,GEL,IDBSIS,IDBSIZ,KBIN,KBOUT,DEVNOS(1),
     +    DEVNOS(2),DEVNOS(3),IDEVT,IDEVC,
     +    IERR,HELPS(NOPT),HELPE(NOPT),
     +    DEVNOS(5),HELPF,MAXGEL,MAXGLM,IDM)
          NGELS=0
          NCONTS=0
          LLINO = 0
          IF(IERR.EQ.0) THEN
            IOPEN=0
            SHONAM = NAMPRO(1:MAX(1,INDEX(NAMPRO,'.'))+1)
            CALL SHOWFI(KBOUT,SHONAM)
          END IF
          CALL INITLU(IDM)
          GO TO 10
        END IF
        IF(ANS.EQ.0)THEN
C        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),
     +    IDEVT,IDEVC,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
      MENUN = 0
      KOPT = 0
10    CONTINUE
C
C Flush the database buffers, just in case!
C
      IF (IOPEN.EQ.0) THEN
        CALL FLUSHL(DEVNOS(1))
        CALL FLUSHL(DEVNOS(2))
        CALL FLUSHL(DEVNOS(3))
        CALL FLUSHL(IDEVT)
        CALL FLUSHL(IDEVC)
      END IF
      CALL BPAUSE(KBIN,KBOUT,IOK)
C      CALL SHOWFU(KBOUT,' ')
C      IF(IOK.NE.0) GO TO 9999
C      CALL DBMENT(MENU,NOPT,KOPT,
C     +TOPOPT,HELPS(0),HELPE(0),HELPF,DEVNOS(5),
C     +KBIN,KBOUT)
      CALL MENU(NOPT, KOPT, MENUN, TOPOPT, MINMEN, KBIN, KBOUT,
     +     HELPS(0), HELPE(0), HELPF, DEVNOS(5))
      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))
          CLOSE(UNIT=IDEVC)
          CLOSE(UNIT=IDEVT)
          IOPEN=1
          IOK = ACTF(2,NAMPRO,0,' ',KBOUT)
        END IF
        IDBSIZ=MAXDB
        IDBSIS=IDBSIZ
        IF(ANS.EQ.1)THEN
C          CALL SHOWFU(KBOUT,'Start a database')
          CALL DBSTAR(NAMPRO,GEL,IDBSIS,IDBSIZ,KBIN,KBOUT,DEVNOS(1),
     +    DEVNOS(2),DEVNOS(3),IDEVT,IDEVC,
     +    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
C          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),
     +    IDEVT,IDEVC,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
C        CALL SHOWFU(KBOUT,'Clear graphics')
        CALL CLEARG
        GO TO 10
      END IF
C   clear VT100
C
      IF(NOPT.EQ.11)THEN
C        CALL SHOWFU(KBOUT,'Clear text')
        CALL CLEARV
        GO TO 10
      END IF
C
C   xhairs
C
      IF((NOPT.EQ.13).AND.(IOPEN.EQ.0)) THEN
C          CALL SHOWFU(KBOUT,'Use xhair')
          CALL XHGAP(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,39,
     +    HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),MXGOOD,RNAMES,
     +    SAV1,SAV2,SAV3)
        GO TO 10
      END IF
C
C   CHANGE MARGINS
C
      IF(NOPT.EQ.14)THEN
C        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.1) THEN
C          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
C        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
C        CALL SHOWFU(KBOUT,'Plot map')
C  map
        LENCON = RREG - LREG + 1
        IF(LENCON.GT.1) 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.25).AND.(IOPEN.EQ.0))THEN
C        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
C        CALL SHOWFU(KBOUT,'Display contig')
C       DISPLAY
        CALL GETLN3(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,LINCON,
     +  LLINO,NULGEL,IERR,IDBSIZ,KBIN,KBOUT,DEVNOS(3),
     +  'Contig identifier',
     +  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.23).AND.(IOPEN.EQ.0))THEN
C        CALL SHOWFU(KBOUT,'Complement contig')
C       COMPLEMENT
        CALL GETLN3(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
     +  LINCON,LLINO,NULGEL,IERR,IDBSIZ,KBIN,KBOUT,DEVNOS(3),
     +  'Contig identifier',
     +  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  PLOT SINGLE CONTIG
      IF((NOPT.EQ.33).AND.(IOPEN.EQ.0))THEN
        CALL GETLN3(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,LINCON,
     +  LLINO,NULGEL,IERR,IDBSIZ,KBIN,KBOUT,DEVNOS(3),
     +  'Contig identifier',
     +  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
C        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,MAXGLM,IDEVT,IDEVC,
     +  TEMP1)
        GO TO 10
      END IF
      IF((NOPT.EQ.24).AND.(IOPEN.EQ.0))THEN
C        CALL SHOWFU(KBOUT,'Copy database')
C       COPY
        CALL DBCOPY(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,GEL,
     +  NAMPRO,DEVNOS(4),IDBSIZ,JERR,KBIN,KBOUT,DEVNOS(1),
     +  DEVNOS(2),DEVNOS(3),IDEVT,IDEVC,
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),MAXGEL,MAXDB,IDM)
        GO TO 10
      END IF
      IF((NOPT.EQ.19).AND.(IOPEN.EQ.0))THEN
C        CALL SHOWFU(KBOUT,'Check database for consistency')
C       CHECK
        ANS = 0
        IF (KOPT.EQ.1) THEN
          CALL YESNO(ANS,'Only check relationships',
     +    HELPS(3),HELPE(3),HELPF,DEVNOS(5),KBIN,KBOUT)
          IF(ANS.LT.0)GO TO 10
        END IF
        CALL DBCHEK(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDBSIZ,
     +  TEMP1,IERR,KBOUT)
        IF (ANS.EQ.1) THEN
          ICOCK =  CONOK(
     +    RELPG,LNGTHG,LNBR,RNBR,NAMPRO,NGELS,NCONTS,
     +    SEQ1,MAXSEQ,GEL,IDBSIZ,TEMP1,
     +    ECHRSZ,MAXGL2,KBOUT,IDEVW,IDEV,
     +    MAXGEL,IDM,PERCD,CENDS,NENDS,MAXCON)
        END IF
        GO TO 10
      END IF
      IF((NOPT.EQ.29).AND.(IOPEN.EQ.0))THEN
C        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,MXGOOD)
        GO TO 10
      END IF
      IF((NOPT.EQ.8).AND.(IOPEN.EQ.0))THEN
C        CALL SHOWFU(KBOUT,'Make consensus')
C       CONSENSUS
        CALL NEWCON(RELPG,LNGTHG,LNBR,RNBR,MAXDB,IDBSIZ,
     +  NGELS,NCONTS,MAXGEL,LLINO,LINCON,KOPT,
     +  TEMP1,SEQ1,MAXSEQ,GEL2,GEL3,
     +  MAXGLM,MAXGL2,CHRSIZ,ECHRSZ,
     +  CENDS,NENDS,MAXCON,
     +  KBIN,KBOUT,DEVNOS(1),DEVNOS(2),DEVNOS(3),
     +  DEVNOS(4),
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),NAMARC,NAMPRO,FILE,
     +  PERCD,IDM,IDEVC,IDEVT)
        GO TO 10
      END IF
      IF(NOPT.EQ.7)THEN
C        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 Double stranding
      IF((NOPT.EQ.36).AND.(IOPEN.EQ.0)) THEN
        IDIM1=MAXSEQ
        CALL DBLSTR(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,SEQ1,
     +       IDIM1,GEL,IDBSIZ,TEMP3,2,ECHRSZ,MAXGL2,
     +       KBIN,KBOUT,DEVNOS(2),DEVNOS(1),IDEV,LINLEN,PERCD,
     +       HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),MAXGEL,DEVNOS(3),
     +       LLINO,LINCON,LREG,RREG,MXGOOD,SEQ2,IDM,0,IERR,LSTRT,LEND)
        IF (IERR.NE.0) GO TO 10
        LLINO = LNBR(LINCON)
        CALL DBLINT(IERR,MAXMIS,MISSC,MTCHSC,PADSC,KOPT)
        IF (IERR.EQ.-1) GO TO 10
        LSTRT = LREG - MAXGEL
        IF (LSTRT.LT.1) LSTRT = 1
        LEND = RREG + MAXGEL
        CALL BUSY()
        CALL DBLSTR(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,SEQ1,
     +       IDIM1,GEL,IDBSIZ,TEMP3,2,ECHRSZ,MAXGL2,
     +       KBIN,KBOUT,DEVNOS(2),DEVNOS(1),IDEV,LINLEN,PERCD,
     +       HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),MAXGEL,DEVNOS(3),
     +       LLINO,LINCON,LREG,RREG,MXGOOD,SEQ2,IDM,1,IERR,LSTRT,LEND)
        IF (IERR.NE.0) GO TO 10
        CALL DSTRND(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,SEQ1,
     +       SEQ2,IDIM1,LREG,RREG, LLINO, LINCON, MAXGEL, KBOUT,
     +       IDBSIZ, GEL, IDEVR, IDEVW, IDEVN, 0, MAXMIS,MISSC,MTCHSC,
     +       PADSC)
        IDIM1=MAXSEQ
        CALL DBLSTR(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,SEQ1,
     +       IDIM1,GEL,IDBSIZ,TEMP3,2,ECHRSZ,MAXGL2,
     +       KBIN,KBOUT,DEVNOS(2),DEVNOS(1),IDEV,LINLEN,PERCD,
     +       HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),MAXGEL,DEVNOS(3),
     +       LLINO,LINCON,LREG,RREG,MXGOOD,SEQ2,IDM,2,IERR,LSTRT,LEND)
        CALL DSTRND(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,SEQ1,
     +       SEQ2,IDIM1,LREG,RREG, LLINO, LINCON, MAXGEL, KBOUT,
     +       IDBSIZ, GEL, IDEVR, IDEVW, IDEVN, 1, MAXMIS,MISSC,MTCHSC,
     +       PADSC)
        IDIM1=MAXSEQ
        CALL DBLSTR(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,SEQ1,
     +       IDIM1,GEL,IDBSIZ,TEMP3,2,ECHRSZ,MAXGL2,
     +       KBIN,KBOUT,DEVNOS(2),DEVNOS(1),IDEV,LINLEN,PERCD,
     +       HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),MAXGEL,DEVNOS(3),
     +       LLINO,LINCON,LREG,RREG,MXGOOD,SEQ2,IDM,2,IERR,LSTRT,LEND)
        GO TO 10
      END IF
C Auto-create oligos
      IF((NOPT.EQ.37).AND.(IOPEN.EQ.0)) THEN
         LL = INDEX(NAMPRO,'.')-1
         IDIM1=MAXSEQ
         CALL DBLSTR(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,SEQ1,
     +        IDIM1,GEL,IDBSIZ,TEMP3,2,ECHRSZ,MAXGL2,
     +        KBIN,KBOUT,DEVNOS(2),DEVNOS(1),IDEV,LINLEN,PERCD,
     +        HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),MAXGEL,DEVNOS(3),
     +        LLINO,LINCON,LREG,RREG,MXGOOD,SEQ2,IDM,0,IERR,LSTRT,LEND)
C     LLINO returned from DBLSTR is the left most gel in the region.
C     We need the left most one covering the region which is often not
C     the same. So for simplicity we just use the left most of this
C     contig.
         IF (IERR.NE.0) GO TO 10
         LLINO = LNBR(LINCON)
         CALL OLINIT(IERR, OLILEN,OLIBAK,KOPT,MAXGEL,TEMNUM,OLINUM)
         IF (IERR.EQ.-1) GO TO 10
         LSTRT = LREG - (OLILEN+OLIBAK)
         IF (LSTRT.LT.1) LSTRT = 1
         LEND = RREG
         CALL BUSY()
         CALL DBLSTR(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,SEQ1,
     +        IDIM1,GEL,IDBSIZ,TEMP3,2,ECHRSZ,MAXGL2,
     +        KBIN,KBOUT,DEVNOS(2),DEVNOS(1),IDEV,LINLEN,PERCD,
     +        HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),MAXGEL,DEVNOS(3),
     +        LLINO,LINCON,LREG,RREG,MXGOOD,SEQ2,IDM,1,IERR,LSTRT,LEND)
         IF (IERR.NE.0) GO TO 10
         CALL OLISEL(RELPG,LNGTHG,LNBR,RNBR,SEQ1,SEQ2,LLINO,
     +        LINCON,LREG,RREG,IDEVN, '+',OLILEN,OLIBAK,LSTRT,TEMNUM,
     +        NAMPRO,OLINUM,LL)
         IDIM1=MAXSEQ
         CALL DBLSTR(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,SEQ1,
     +        IDIM1,GEL,IDBSIZ,TEMP3,2,ECHRSZ,MAXGL2,
     +        KBIN,KBOUT,DEVNOS(2),DEVNOS(1),IDEV,LINLEN,PERCD,
     +        HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),MAXGEL,DEVNOS(3),
     +        LLINO,LINCON,LREG,RREG,MXGOOD,SEQ2,IDM,2,IERR,LSTRT,LEND)
         CALL OLISEL(RELPG,LNGTHG,LNBR,RNBR,SEQ1,SEQ2,LLINO,
     +        LINCON,LREG,RREG,IDEVN, '-',OLILEN,OLIBAK,LSTRT,TEMNUM,
     +        NAMPRO,OLINUM,LL)
         IDIM1=MAXSEQ
         CALL DBLSTR(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,SEQ1,
     +        IDIM1,GEL,IDBSIZ,TEMP3,2,ECHRSZ,MAXGL2,
     +        KBIN,KBOUT,DEVNOS(2),DEVNOS(1),IDEV,LINLEN,PERCD,
     +        HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),MAXGEL,DEVNOS(3),
     +        LLINO,LINCON,LREG,RREG,MXGOOD,SEQ2,IDM,2,IERR,LSTRT,LEND)
         GO TO 10
      END IF
C  HELP
      IF(NOPT.EQ.1)THEN
C        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
C        CALL SHOWFU(KBOUT,'Set parameters')
C  SET DISPLAY PARAMETERS
        MN = 10
        MX = 100
        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 = INT(PERCD*100.)
        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 = MAXGLM
        CALL GETINT(MN,MX,MXGOOD,
     +  'Maximum read length for quality analysis',
     +  IVAL,KBIN,KBOUT,HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),IOK)
        IF(IOK.EQ.0) MXGOOD = IVAL
        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
C        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
C        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
C        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
CC  AUTO EDIT
      IF((NOPT.EQ.30).AND.(IOPEN.EQ.0))THEN
C        CALL SHOWFU(KBOUT,'Shuffle pads')
C        WRITE(KBOUT,*)'Make a copy first!'
        CALL GETLN3(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,LINCON,
     +  LLINO,NULGEL,IERR,IDBSIZ,KBIN,KBOUT,DEVNOS(3),
     +  'Contig identifier',
     +  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
C
C  note pinching a few arrays and dimensions here so beware of changes
C
        CALL PADSHF(RELPG,LNGTHG,LNBR,RNBR,SEQ1,
     +  IDIM1,LREG,RREG,LLINO,IDBSIZ,TEMP1,ECHRSZ,MAXGL2,
     +  DEVNOS(2),MAXGEL,WORDP,WORDN,GELN,SAV1,MAXGLM,POSNS,MAXSEQ,
     +  KBOUT)
C        IDIM1=MAXSEQ
C        CALL SUMSS(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,SEQ1,IDIM1,
C     +  GEL,LREG,RREG,LLINO,PERCD,IDBSIZ,TEMP3,2,ECHRSZ,MAXGL2,
C     +  DEVNOS(2),MAXGEL,GEL3,GEL4)
C        CALL AEDIT(RELPG,LNGTHG,LNBR,RNBR,IDBSIZ,LLINO,LINCON,
C     +  GEL,MAXGEL,SEQ1,IDIM1,DEVNOS(2),DEVNOS(1),LREG,RREG,
C     +  KBOUT)
      END IF
      END IF
      GO TO 10
      END IF
      IF((NOPT.EQ.4).AND.(IOPEN.EQ.0))THEN
C       CALL UP CONTIG EDITOR
        CALL CONEDT(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(9),HELPE(9),HELPF,DEVNOS(5),DEVNOS(4),
     +  DEVNOS(1),DEVNOS(2),DEVNOS(3),IDEVT,IDEVC,
     +  LINLEN,FILNAM,LLINO,IOK,
     +  IERR,TEMP1)
        GO TO 10
      END IF
      IF((NOPT.EQ.22).AND.(IOPEN.EQ.0))THEN
C       CALL UP JOIN EDITOR
        CALL JOINED(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(9),HELPE(9),HELPF,DEVNOS(5),DEVNOS(4),
     +  DEVNOS(1),DEVNOS(2),DEVNOS(3),IDEVT,IDEVC,
     +  LINLEN,FILNAM,LLINO,IOK,
     +  IERR,TEMP1)
        GO TO 10
      END IF
      IF(NOPT.EQ.17) THEN
C        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
C        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
C        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,IDEVC,IDEVT,
     +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.35).AND.(IOPEN.EQ.0).AND.(IDM.EQ.5)) THEN
C        CALL SHOWFU(KBOUT,'Find internal joins')
      CALL AUTOJ(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,IDEVC,IDEVT)
        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
C        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
C        CALL SHOWFU(KBOUT,'Disassemble readings')
        CALL REMGBD(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDBSIZ,
     +  KBIN,KBOUT,GEL,MAXGEL,IDEVR,IDEVW,IDEVN,DEVNOS(7),FILNAM,
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),IOK)
      END IF
      IF((NOPT.EQ.38).AND.(IOPEN.EQ.0).AND.(IDM.EQ.5)) THEN
        CALL AUTOM(RELPG,LNGTHG,LNBR,RNBR,MAXDB,IDBSIZ,
     +  NGELS,NCONTS,LLINO,LINCON,MAXGEL,
     +  TEMP1,SEQ1,MAXSEQ,GEL2,SEQ5,SEQC2,SEQG2,
     +  MAXGLM,MAXGL2,ECHRSZ,SAV1,SAV2,SAV3,MAXSAV,
     +  KBIN,KBOUT,IDEVR,IDEVW,IDEVN,DEVNOS(8),IDEV,
     +  HELPS(NOPT),HELPE(NOPT),HELPF,DEVNOS(5),NAMARC,NAMPRO,FILE,
     +  PERCD,IOPEN,IDM,SEQG3,SEQC3,IOK,IDEVC,IDEVT)
        GO TO 10
      END IF
      IF((NOPT.EQ.39).AND.(IOPEN.EQ.0))THEN
        CALL YESNO(ISEL,'Select contigs',
     +  HELPS(NOPT),HELPE(NOPT),HELPF,IDEVH,KBIN,KBOUT)
        IF (ISEL.LT.0) GO TO 10
        IF (ISEL.EQ.0) THEN
          CALL GETLN3(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,LINCON,
     +    LLINO,NULGEL,IERR,IDBSIZ,KBIN,KBOUT,DEVNOS(3),
     +    'Contig identifier',
     +    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 CHKREW(RELPG,LNGTHG,LNBR,RNBR,IDBSIZ,NGELS,
     +        IDEVN,SAV1,SAV2,SAV3,RNAMES,LLINO,NMATES)
              CALL YESNO(IP,'Plot results',
     +        HELPS(NOPT),HELPE(NOPT),HELPF,IDEVH,KBIN,KBOUT)
              IF(IP.LT.0) GO TO 10
              IF(IP.EQ.0) THEN
                CALL GDEPTH(RELPG,LNGTHG,
     +          IDBSIZ,LREG,RREG,SAV1,SAV2,SAV3,NMATES,
     +          MARGL,MARGR,MARGB(NOPT),MARGT(NOPT),ISXMAX,ISYMAX)
              ELSE
                CALL LMATES(RELPG,LNGTHG,LNBR,RNBR,IDBSIZ,NGELS,
     +          IDEV,SAV1,SAV2,SAV3,RNAMES,NMATES)
              END IF
            END IF
          END IF
        ELSE
          CALL CHKREV(RELPG,LNGTHG,LNBR,RNBR,IDBSIZ,NGELS,NCONTS,
     +    IDEVN,IDEV,KBIN,KBOUT,TEMP1,SAV1,SAV2,SAV3,RNAMES)
        END IF
        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
      IF (IOPEN.EQ.0) THEN
        IOK = ACTF(2,NAMPRO,0,' ',KBOUT)
      END IF
      CALL SHUTD
      END
