C   SUBROUTINES FOR ANALYSEP
C   AUTHOR: RODGER STADEN
C   8-2-90 back translation: zeroed righthand end of workr
C   9-7-90 removed menu routine
C   24-7-90 edited helixw to use getint for compatibility with x versions
C   5-11-90 signlp call to rdwmt added zero as last parameter
C   4-12-90 Changed name of compc to compcp for the stupid sun linker
C  21-12-90 Changed signlp so that text output gives position as 
C           I+MIDDLE (was I)
      SUBROUTINE SETPAR(IOK)
      PARAMETER (MINOPT = 17,
     +           MAXOPT = 28,
     +           NUMBER = 9)
      INTEGER VALUES(NUMBER,MINOPT:MAXOPT)
C      INTEGER TEMP(NUMBER)
      SAVE /PAMDEF/
      COMMON /PAMDEF/VALUES
      IOK = 0
C  SEARCH
C      WRITE(KBOUT,*)' Search for short sequences'
C      CALL GETPAR(17,7,IOK,IFILE,OPTION,OPTOUT,NOPOUT,
C     +MININC,MAXINC,INC)
      VALUES(1,17) = 1
      VALUES(2,17) = 0
      VALUES(3,17) = 0
      VALUES(4,17) = 0
      VALUES(5,17) = 1
      VALUES(6,17) = 12
      VALUES(7,17) = 1
C  PERCENT MATCH
      VALUES(1,18) = 0
      VALUES(2,18) = 70
C  SCORE MATRIX MATCH
      VALUES(1,19) = 0
C  WEIGHT MATRIX
C      WRITE(KBOUT,*)' MOTIF SEARCH USING WEIGHT MATRIX'
C      CALL GETPAR(20,2,IOK,IOPT,IGON)
      VALUES(1,20) = 0
      VALUES(2,20) = 0
C  HYDROPHOBICITY
      VALUES(1,22) = 1
      VALUES(2,22) = 101
      VALUES(3,22) = 11
      VALUES(4,22) = 1
      VALUES(5,22) = 101
      VALUES(6,22) = 3
C  CHARGE
      VALUES(1,23) = 1
      VALUES(2,23) = 101
      VALUES(3,23) = 11
      VALUES(4,23) = 1
      VALUES(5,23) = 101
      VALUES(6,23) = 3
C  ROBSON
C      CALL GETPAR(24,4,IOK,MINIW,MAXIW,IWRIT,IGON)
      VALUES(1,24) = 1
      VALUES(2,24) = 101
      VALUES(3,24) = 1
      VALUES(4,24) = 0
C  HYDROPHOBIC MOMENT
      VALUES(1,25) = 1
      VALUES(2,25) = 130
      VALUES(3,25) = 100
      VALUES(4,25) = 1
      VALUES(5,25) = 60
      VALUES(6,25) = 18
      VALUES(7,25) = 1
      VALUES(8,25) = 101
      VALUES(9,25) = 3
C  HELIX WHEEL
      VALUES(1,26) = 1
      VALUES(2,26) = 130
      VALUES(3,26) = 100
      VALUES(4,26) = 1
      VALUES(5,26) = 60
      VALUES(6,26) = 18
C  BACK TRANSLATE
      VALUES(1,27) = 0
      VALUES(2,27) = 0
      VALUES(3,27) = 1
      VALUES(4,27) = 11
      VALUES(5,27) = 11
      VALUES(6,27) = 1
      VALUES(7,27) = 11
      VALUES(8,27) = 3
C  PATTERNS TO DO
C      OPEN(UNIT=99,FILE='ANALYSEP.PAR',STATUS ='OLD')
C10    CONTINUE
C      READ(99,*,ERR=100,END=200)TEMP
C      IF((TEMP(1).GE.MINOPT).AND.(TEMP(1).LE.MAXOPT)) THEN
C        DO 20 I = 1,NUMBER-1
C          VALUES(I,TEMP(1)) = TEMP(I+1)
C          WRITE(*,*)TEMP(1),TEMP(I+1)
C20      CONTINUE
C      END IF
C      GO TO 10
C100   CONTINUE
C      WRITE(*,*)'ERROR IN PARMS FILE'
C      GO TO 10
C200   CONTINUE
C      CLOSE(UNIT = 99)
      IOK = 0
      END
      SUBROUTINE GETPAR(IOPT,NPAM,IOK,I1,I2,I3,I4,I5,I6,I7,I8,I9)
      PARAMETER (MINOPT = 17,
     +           MAXOPT = 28,
     +           NUMBER = 9)
      INTEGER VALUES(NUMBER,MINOPT:MAXOPT)
      COMMON /PAMDEF/VALUES
      IOK = 0
      IF((IOPT.GE.MINOPT).AND.(IOPT.LE.MAXOPT)) THEN
        I = 1
        I1 = VALUES(I,IOPT)
        IF(I.EQ.NPAM) RETURN
        I = I + 1
        I2 = VALUES(I,IOPT)
        IF(I.EQ.NPAM) RETURN
        I = I + 1
        I3 = VALUES(I,IOPT)
        IF(I.EQ.NPAM) RETURN
        I = I + 1
        I4 = VALUES(I,IOPT)
        IF(I.EQ.NPAM) RETURN
        I = I + 1
        I5 = VALUES(I,IOPT)
        IF(I.EQ.NPAM) RETURN
        I = I + 1
        I6 = VALUES(I,IOPT)
        IF(I.EQ.NPAM) RETURN
        I = I + 1
        I7 = VALUES(I,IOPT)
        IF(I.EQ.NPAM) RETURN
        I = I + 1
        I8 = VALUES(I,IOPT)
        IF(I.EQ.NPAM) RETURN
        I = I + 1
        I9 = VALUES(I,IOPT)
        IF(I.EQ.NPAM) RETURN
      END IF
      IOK = 1
      END
C    COMPH
      SUBROUTINE COMPH(SEQ,IDIM1P,MXSPAN,
     1MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,KBIN,KBOUT,
     +SCORES,IDSCOR,
     +IHELPS,IHELPE,HELPF,IDEVH,DIALOG)
C   AUTHOR: RODGER STADEN
      CHARACTER HELPF*(*)
      CHARACTER SEQ(IDIM1P)
      INTEGER DIALOG
      INTEGER SPAN
      REAL SCORES(IDSCOR)
      CALL SHOWFU(KBOUT,'Plot hydrophobicity')
      CALL GETPAR(22,6,IOK,MINSP,MAXSP,SPAN,MINIW,MAXIW,IWRIT,
     +IPAR7,IPAR8,IPAR9)
      IF(IOK.NE.0) RETURN
      IF(DIALOG.EQ.1) THEN
        CALL GSPIN(MINSP,MAXSP,SPAN,MINIW,MAXIW,IWRIT,KBIN,KBOUT,
     +  IHELPS,IHELPE,HELPF,IDEVH,IOK)
        IF(IOK.NE.0) RETURN
      END IF
      CALL PHYDRO(SEQ,IDIM1P,MXSPAN,
     1MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,
     +SCORES,IDSCOR,SPAN,IWRIT)
      END
      SUBROUTINE PHYDRO(SEQ,IDIM1P,MXSPAN,
     1MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,
     +SCORES,IDSCOR,SPAN,IWRIT)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDIM1P)
      INTEGER SPAN,CTONUM
      REAL SCORES(IDSCOR)
      EXTERNAL CTONUM
C   max score
      SCRMAX=-9999.
      SCRMIN=99999.
      DO 1 I=1,IDSCOR
        IF(SCORES(I).GT.SCRMAX)SCRMAX=SCORES(I)
        IF(SCORES(I).LT.SCRMIN)SCRMIN=SCORES(I)
1     CONTINUE
      I1INM1=1+MXSPAN/2
      J1P=J1+I1INM1
      J2P=J2+I1INM1
      XMIN=J1
      XMAX=J2
C   length forward and back
      LF=SPAN/2
      LB=1+SPAN/2
C   set ymax
      RANGE=SPAN*(SCRMAX-SCRMIN)
      RANGEP=RANGE/100.
      YMIN=SPAN*SCRMIN
      YMAX=SPAN*SCRMAX
      XBIT=XMIN+(XMAX-XMIN)*0.01
      YMID=YMIN+RANGE*0.5
      YMID45=YMID-RANGEP*5.0
C   do edge
      CALL STARTR(SEQ(J1P-LB),IDIM1P,SCORES,IDSCOR,SPAN,SUM)
      CALL CLEARV
      CALL VECTOM
      CALL FRAME(MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
      DO 40 K=-40,40,10
        YPLOT=YMID+RANGEP*K
        CALL LINE(XMIN,XBIT,YPLOT,YPLOT,XMAX,XMIN,YMAX,YMIN,
     +  MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
40    CONTINUE
C   PLOT MID LINE
      CALL LINE(XMIN,XMAX,YMID45,YMID45,XMAX,XMIN,YMAX,YMIN,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
C   do rest
      IDONE=0
      XF=J1
      YF=SUM
      DO 100 I=J1P,J2P
        IDONE=IDONE+1
        SUM=SUM+SCORES(CTONUM(SEQ(I+LF)))
     +  -SCORES(CTONUM(SEQ(I-LB)))
        IF(MOD(I,IWRIT).EQ.0)THEN
          XT=I-I1INM1
          CALL LINE(XF,XT,YF,SUM,XMAX,XMIN,YMAX,YMIN,
     +    MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
          XF=XT
          YF=SUM
        END IF
100   CONTINUE
      CALL VT100M
      END
C    COMPCP
      SUBROUTINE COMPCP(SEQ,IDIM1P,MXSPAN,
     1MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,KBIN,KBOUT,
     +SCORES,IDSCOR,
     +IHELPS,IHELPE,HELPF,IDEVH,DIALOG)
C   AUTHOR: RODGER STADEN
      CHARACTER HELPF*(*)
      CHARACTER SEQ(IDIM1P)
      INTEGER DIALOG
      INTEGER SPAN
      REAL SCORES(IDSCOR)
      CALL SHOWFU(KBOUT,'Plot charge')
      CALL GETPAR(23,6,IOK,MINSP,MAXSP,SPAN,MINIW,MAXIW,IWRIT,
     +IPAR7,IPAR8,IPAR9)
      IF(IOK.NE.0) RETURN
      IF(DIALOG.EQ.1) THEN
        CALL GSPIN(MINSP,MAXSP,SPAN,MINIW,MAXIW,IWRIT,KBIN,KBOUT,
     +  IHELPS,IHELPE,HELPF,IDEVH,IOK)
        IF(IOK.NE.0) RETURN
      END IF
      CALL PCOMPC(SEQ,IDIM1P,MXSPAN,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,
     +SCORES,IDSCOR,SPAN,IWRIT)
      END
      SUBROUTINE PCOMPC(SEQ,IDIM1P,MXSPAN,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,
     +SCORES,IDSCOR,SPAN,IWRIT)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDIM1P)
      INTEGER SPAN,CTONUM
      REAL SCORES(IDSCOR)
      EXTERNAL CTONUM
      SCRMAX=-9999.
      SCRMIN=9999.
      DO 1 I=1,IDSCOR
        IF(SCORES(I).GT.SCRMAX)SCRMAX=SCORES(I)
        IF(SCORES(I).LT.SCRMIN)SCRMIN=SCORES(I)
1     CONTINUE
C   length forward and back
      LF=SPAN/2
      LB=1+SPAN/2
      I1INM1=1+MXSPAN/2
      J1P=J1+I1INM1
      J2P=J2+I1INM1
      XMIN=J1
      XMAX=J2
C   set ymax
      RANGE=SPAN*(SCRMAX-SCRMIN)
      RANGEP=RANGE/100.
      YMIN=SPAN*SCRMIN
      YMAX=SPAN*SCRMAX
      XBIT=XMIN+(XMAX-XMIN)*0.01
      YMID=YMIN+RANGE*0.5
C   do edge
      CALL STARTR(SEQ(J1P-LB),IDIM1P,SCORES,IDSCOR,SPAN,SUM)
      CALL CLEARV
      CALL VECTOM
      CALL FRAME(MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
      DO 40 K=-40,40,10
        YPLOT=YMID+RANGEP*K
        CALL LINE(XMIN,XBIT,YPLOT,YPLOT,XMAX,XMIN,YMAX,YMIN,
     +  MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
40    CONTINUE
C   PLOT MID LINE
      CALL LINE(XMIN,XMAX,YMID,YMID,XMAX,XMIN,YMAX,YMIN,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
C   do rest
      IDONE=0
      XF=J1
      YF=SUM
      DO 100 I=J1P,J2P
        IDONE=IDONE+1
        SUM=SUM+SCORES(CTONUM(SEQ(I+LF)))
     +  -SCORES(CTONUM(SEQ(I-LB)))
        IF(MOD(I,IWRIT).EQ.0)THEN
          XT=I-I1INM1
          CALL LINE(XF,XT,YF,SUM,XMAX,XMIN,YMAX,YMIN,
     +    MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
          XF=XT
          YF=SUM
        END IF
100   CONTINUE
      CALL VT100M
      END
      SUBROUTINE STARTR(SEQ,IDIM,SCORES,IDIMS,LENW,SUM)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDIM)
      REAL  SCORES(IDIMS)
      INTEGER CTONUM
      EXTERNAL CTONUM
      SUM=0.
      DO 10 I=1,LENW
        SUM = SUM + SCORES(CTONUM(SEQ(I)))
10    CONTINUE
      END
C   this routine uses the following arrays and variables:
C   a concatenated array of recognition sequences recseq maxrec idrseq prec
C   a concatenated array of enzyme names names maxnam idnaml pnam
C   a list of pointers to enzyme names in names namep maxnam itoten
C   a list of enzyme name lengths namlen maxen itoten
C   a list of numbers of recognition sequences per enzyme numrec maxen
C   a list of lenghts of recognition sequences per enzyme (all expected
C    to be the same) lenen maxen itoten
C   a list of pointers to the first character of the first recognition
C   sequence per enzyme recstr maxen itoten
C   it also needs temporary storage of matches in psave and nsave of
C   size maxmat and temporary storage of lengths of fragments in length
C   output of results is on unit idev
      SUBROUTINE SERCHP(SEQ,IDSEQ,J1,J2,KSTART,
     +RENZYM,MAXREN,RECSEQ,MAXREC,
     +NAMES,MAXNAM,LENGTH,PSAVE,NSAVE,MAXMAT,
     +NAMEP,NAMLEN,NUMREC,LENEN,RECSTR,NAMLST,MAXENZ,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,IDEV,
     +IDEVEN,FILNAM,FILEA,FILEAA,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,DIALOG)
C   AUTHOR: RODGER STADEN
      CHARACTER FILNAM*(*),FILEA*(*),FILEAA*(*),HELPF*(*)
      CHARACTER SEQ(IDSEQ),RENZYM(MAXREN),RECSEQ(MAXREC),NAMES(MAXNAM)
      INTEGER OPTION,OPTOUT
      INTEGER LENGTH(MAXMAT),PSAVE(MAXMAT),NSAVE(MAXMAT)
      INTEGER NAMEP(MAXENZ),NAMLEN(MAXENZ),NUMREC(MAXENZ)
      INTEGER LENEN(MAXENZ)
      INTEGER RECSTR(MAXENZ),NAMLST(MAXENZ),DIALOG
      PARAMETER (IBH=256)
      CALL SHOWFU(KBOUT,'Search for short sequences')
      CALL GETPAR(17,7,IOK,IFILE,OPTION,OPTOUT,NOPOUT,
     +MININC,MAXINC,INC,
     +IPAR8,IPAR9)
      IF(IOK.NE.0) RETURN
10    CONTINUE
      IDREN  = MAXREN
      IDRSEQ = MAXREC
      IDNAML = MAXNAM
      IDNLST = MAXENZ
      MAXEN  = MAXENZ
      IDMAT  = MAXMAT
      LEVEL = 0
      CALL SERCHD(RENZYM,IDREN,RECSEQ,IDRSEQ,
     +NAMES,IDNAML,MARGT,
     +NAMEP,NAMLEN,NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,
     +IDEVEN,FILNAM,FILEA,FILEAA,KBIN,KBOUT,
     +OPTION,OPTOUT,NOPOUT,IFILE,MININC,MAXINC,INC,DIALOG,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
      CALL BUSY(KBOUT)
      IF(OPTOUT.EQ.2) THEN
C        CALL FINDL1(SEQ,IDSEQ,J1,J2,KSTART,RECSEQ,IDRSEQ,NAMES,IDNAML,
C     +  NAMEP,NAMLEN,
C     +  NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,OPTION,OPTOUT,
C     +  PSAVE,NSAVE,LENGTH,IDMAT,NOPOUT,IBH,LEVEL,
C     +  MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,INC,KBIN,KBOUT,IDEV,
C     +  IHELPS,IHELPE,HELPF,IDEVH)
      ELSE IF((OPTOUT.EQ.0).AND.(NOPOUT.EQ.1)) THEN
        CALL FINDL2(SEQ,IDSEQ,J1,J2,KSTART,RECSEQ,IDRSEQ,NAMES,IDNAML,
     +  NAMEP,NAMLEN,
     +  NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,OPTION,OPTOUT,
     +  PSAVE,NSAVE,LENGTH,IDMAT,NOPOUT,IBH,LEVEL,
     +  MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,INC,KBIN,KBOUT,IDEV,
     +  IHELPS,IHELPE,HELPF,IDEVH)
      ELSE IF((OPTOUT.EQ.1).AND.(NOPOUT.EQ.1)) THEN
        CALL FINDL3(SEQ,IDSEQ,J1,J2,KSTART,RECSEQ,IDRSEQ,NAMES,IDNAML,
     +  NAMEP,NAMLEN,
     +  NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,OPTION,OPTOUT,
     +  PSAVE,NSAVE,LENGTH,IDMAT,NOPOUT,IBH,LEVEL,
     +  MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,INC,KBIN,KBOUT,IDEV,
     +  IHELPS,IHELPE,HELPF,IDEVH)
      ELSE IF((OPTOUT.EQ.0).AND.(NOPOUT.EQ.0)) THEN
        CALL FINDL4(SEQ,IDSEQ,J1,J2,KSTART,RECSEQ,IDRSEQ,NAMES,IDNAML,
     +  NAMEP,NAMLEN,
     +  NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,OPTION,OPTOUT,
     +  PSAVE,NSAVE,LENGTH,IDMAT,NOPOUT,IBH,LEVEL,
     +  MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,INC,KBIN,KBOUT,IDEV,
     +  IHELPS,IHELPE,HELPF,IDEVH)
      ELSE IF((OPTOUT.EQ.1).AND.(NOPOUT.EQ.0)) THEN
        CALL FINDL5(SEQ,IDSEQ,J1,J2,KSTART,RECSEQ,IDRSEQ,NAMES,IDNAML,
     +  NAMEP,NAMLEN,
     +  NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,OPTION,OPTOUT,
     +  PSAVE,NSAVE,LENGTH,IDMAT,NOPOUT,IBH,LEVEL,
     +  MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,INC,KBIN,KBOUT,IDEV,
     +  IHELPS,IHELPE,HELPF,IDEVH)
      END IF
      CALL BPAUSE(KBIN,KBOUT,IOK)
      IF(IOK.NE.0) RETURN
      DIALOG = 1
      GO TO 10
      END
      SUBROUTINE GETRNP(RENZYM,IDREN,IDEV,FILNAM,FILEA,FILEAA,
     + IOK,KBIN,KBOUT,IFILE,DIALOG,
     +IHELPS,IHELPE,HELPF,IDEVH)
      CHARACTER HELPF*(*)
C   AUTHOR: RODGER STADEN
      CHARACTER FILNAM*(*),FILEA*(*),FILEAA*(*),RENZYM(IDREN)
      INTEGER DIALOG
      PARAMETER (MAXPRM = 16)
      CHARACTER PROMPT(4)*(MAXPRM)
      IOK = 1
      IF(DIALOG.EQ.0) NOPT = IFILE
      IOP = 1
1     CONTINUE
      IF(DIALOG.EQ.1) THEN
        PROMPT(1) = 'Search'
        PROMPT(2) = 'List enzyme file'
        PROMPT(3) = 'Clear text'
        PROMPT(4) = 'Clear graphics'
        IOP = 1
        CALL RADION('Select option',PROMPT,4,IOP,
     +  IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
        IF(IOP.LT.1) THEN
          IOK = 1
          RETURN
        END IF
        IF(IOP.EQ.3) THEN
          CALL CLEARV
          CALL BPAUSE(KBIN,KBOUT,IOK)
          IF(IOK.NE.0) RETURN
          GO TO 1
        END IF
        IF(IOP.EQ.4) THEN
          CALL CLEARG
          CALL BPAUSE(KBIN,KBOUT,IOK)
          IF(IOK.NE.0) RETURN
          GO TO 1
        END IF
        IF((IOP.EQ.1).OR.(IOP.EQ.2)) THEN
          NOPT = IFILE
          PROMPT(1) = 'All acids'
          PROMPT(2) = 'Named groups'
          PROMPT(3) = 'Personal file'
          PROMPT(4) = 'Keyboard'
          CALL RADION('Select string definition mode',PROMPT,4,NOPT,
     +    IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
          IF(NOPT.LT.1) THEN
              IOK = 1
            RETURN
          END IF
        END IF
      END IF
      IF(NOPT.EQ.1)THEN
        CALL OPENRS(IDEV,FILEAA,IOK,LRECL,2)
        IF(IOK.NE.0)GO TO 100
        IF(IOP.EQ.2)THEN
          CALL TTEXT1(IDEV,KBIN,KBOUT,
     +    IHELPS,IHELPE,HELPF,IDEVH,IQUIT)
          GO TO 1
        END IF
        CALL ARRFIL(IDEV,RENZYM,IDREN,KBOUT)
        CLOSE(UNIT=IDEV)
        RETURN
      END IF
      IF(NOPT.EQ.2)THEN
        CALL OPENRS(IDEV,FILEA,IOK,LRECL,2)
        IF(IOK.NE.0)GO TO 100
        IF(IOP.EQ.2)THEN
          CALL TTEXT1(IDEV,KBIN,KBOUT,
     +    IHELPS,IHELPE,HELPF,IDEVH,IQUIT)
          GO TO 1
        END IF
        CALL ARRFIL(IDEV,RENZYM,IDREN,KBOUT)
        CLOSE(UNIT=IDEV)
        RETURN
      END IF
      IF(NOPT.EQ.3)THEN
        FILNAM = ' '
        CALL OPENF1(IDEV,FILNAM,0,IOK,KBIN,KBOUT,
     +  'Named sequences file',
     +  IHELPS,IHELPE,HELPF,IDEVH)
        IF(IOK.EQ.2) GO TO 1
        IF(IOK.NE.0)GO TO 100
        IF(IOP.EQ.2)THEN
          CALL TTEXT1(IDEV,KBIN,KBOUT,
     +    IHELPS,IHELPE,HELPF,IDEVH,IQUIT)
          GO TO 1
        END IF
        CALL ARRFIL(IDEV,RENZYM,IDREN,KBOUT)
        CLOSE(UNIT=IDEV)
        RETURN
      END IF
      IF(NOPT.EQ.4)THEN
        CALL GETRKB(RENZYM,IDREN,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,
     +  IOK)
        RETURN
      END IF
      GO TO 1
100   CONTINUE
      CALL ERROM(KBOUT,'Error opening file')
      IOK=1
      GO TO 1
      END
      SUBROUTINE DECREN(RENZYM,IDREN,RECSEQ,IDRSEQ,NAMES,IDNAML,
     +NAMEP,NAMLEN,NUMREC,LENEN,RECSTR,MAXEN,KBOUT)
C   routine to decode a restriction enzyme file array renzym idren
C   into the following:
C   a concatenated array of recognition sequences recseq idrseq prec
C   a concatenated array of enzyme names names idnaml,pnam
C   a list of pointers to enzyme names in names namep maxen itoten
C   a list of enzyme name lengths namlen maxen itoten
C   a list of numbers of recognition sequences per enzyme numrec maxen
C   a list of lenghts of recognition sequences per enzyme (all expected
C    to be the same) lenen maxen itoten
C   a list of pointers to the first character of the first recognition
C   sequence per enzyme recstr maxen itoten
C   AUTHOR: RODGER STADEN
      CHARACTER RENZYM(IDREN),RECSEQ(IDRSEQ),NAMES(IDNAML)
      INTEGER NAMEP(MAXEN),NAMLEN(MAXEN),NUMREC(MAXEN),LENEN(MAXEN)
      INTEGER RECSTR(MAXEN),TOTEN,PREC,PREN,PNAM
      TOTEN=0
      PREC=1
      PREN=0
      PNAM=1
10    CONTINUE
      PREN=PREN+1
      IF(PREN.LT.IDREN)THEN
      CALL CHARCT(RENZYM,IDREN,PREN,NCHAR)
      IF(NCHAR.GT.0)THEN
      TOTEN=TOTEN+1
      IF(TOTEN.LT.MAXEN)THEN
      IF((PNAM+NCHAR-1).GT.IDNAML)THEN
      WRITE(KBOUT,1006)
1006  FORMAT(' Names array full')
      GO TO 101
      END IF
      NAMEP(TOTEN)=PNAM
      NAMLEN(TOTEN)=NCHAR
      CALL SQCOPY(RENZYM(PREN),NAMES(PNAM),NCHAR)
      PNAM=PNAM+NCHAR
      NREC=0
      LMAX=0
20    CONTINUE
      PREN=PREN+NCHAR+1
      NCHAR=0
      IF(PREN.LT.IDREN)CALL CHARCT(RENZYM,IDREN,PREN,NCHAR)
      IF(NCHAR.EQ.0)THEN
      IF(NREC.EQ.0)THEN
      WRITE(KBOUT,1002)
1002  FORMAT(' Name with no strings!')
      TOTEN=TOTEN-1
      GO TO 100
      END IF
      NUMREC(TOTEN)=NREC
      LENEN(TOTEN)=LMAX
      GO TO 10
      END IF
      NREC=NREC+1
      IF(NCHAR.GT.LMAX)LMAX=NCHAR
      CALL SQCOPY(RENZYM(PREN),RECSEQ(PREC),NCHAR)
      IF(NREC.EQ.1)RECSTR(TOTEN)=PREC
      PREC=PREC+NCHAR
      GO TO 20
      END IF
      CALL ERROM(KBOUT,'Too many names')
      GO TO 100
      END IF
      CALL ERROM(KBOUT,'Error in names and strings file')
      END IF
100   CONTINUE
101   CONTINUE
C      WRITE(KBOUT,1001)TOTEN
C1001  FORMAT(' number of names=',I6)
      IDNAML=PNAM-1
      MAXEN=TOTEN
      IDRSEQ=PREC
      END
      SUBROUTINE FIND4(SEQ,IDIM1,STRING,IDIM2,INC,IMATCH)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDIM1),STRING(IDIM2),DASH
      INTEGER PSEQ,PSTR
      SAVE DASH
      DATA DASH/'-'/
      PSEQ=1-1*INC
      PSTR=1
      IMATCH=0
100   CONTINUE
      PSEQ=PSEQ+1-PSTR
      PSEQ=PSEQ+INC-1
400   CONTINUE
      PSTR=0
500   CONTINUE
      PSEQ=PSEQ+1
      IF(PSEQ.GT.IDIM1)GO TO 300
      PSTR=PSTR+1
      IF(STRING(PSTR).EQ.DASH)GO TO 450
      IF(SEQ(PSEQ).NE.STRING(PSTR))GO TO 100
450   CONTINUE
      IF(PSTR.LT.IDIM2)GO TO 500
      IMATCH=PSEQ-IDIM2+1
300   CONTINUE
      END
      SUBROUTINE S1(SEQ,IDSEQ,NREC,LREC,JEN,IREC,J1,J2,INC,KSTART,
     +RECSTR,MAXEN,PSAVE,NSAVE,MAXMAT,RECSEQ,IDRSEQ,IFOUND,KBOUT,IOK)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDSEQ),RECSEQ(IDRSEQ)
      INTEGER RECSTR(MAXEN),PSAVE(MAXMAT),NSAVE(MAXMAT)
      IOK = 1
      DO 50 IREC=1,NREC
        ISTR=RECSTR(JEN)+(IREC-1)*(LREC)
C         NOTE WE NEED TO POINT TO THE CORRECT ARRAY ELEMENT BUT
C         TO REMEMBER THE SEQUENCE ELEMENT FOR OUTPUT
C         IAT IS THE ARRAY ELEMENT
        IAT=J1-INC-KSTART+1
10      CONTINUE
          IAT=IAT+INC
          ILEFT=J2-IAT+1-KSTART+1
          IF(ILEFT.GT.0)THEN
            CALL FIND8(SEQ(IAT),ILEFT,
     +      RECSEQ(ISTR),LREC,INC,IMATCH)
            IF(IMATCH.GT.0)THEN
              IFOUND=IFOUND+1
              IF(IFOUND.GT.MAXMAT)THEN
                  CALL ERROM(KBOUT,'Too many matches')
                  RETURN
              END IF
              IAT=IAT+IMATCH-1
C             SAVE POSITION RELATIVE TO ARRAY
              PSAVE(IFOUND)=IAT
              NSAVE(IFOUND)=JEN
              GO TO 10
           END IF
         END IF
50    CONTINUE
      IOK = 0
      END
      SUBROUTINE S2(SEQ,IDSEQ,IFOUND,NAMEP,NAMLEN,LENEN,MAXEN,
     +NSAVE,PSAVE,LENGTH,MAXMAT,NAMES,IDNAML,
     +LENN,IDEV,J2,KSTART,JOB)
      PARAMETER (IDT = 20)
      CHARACTER SEQ(IDSEQ),TEMP1(IDT),TEMP2(IDT),NAMES(IDNAML)
      INTEGER NAMEP(MAXEN),NAMLEN(MAXEN),LENEN(MAXEN)
      INTEGER NSAVE(MAXMAT),PSAVE(MAXMAT),LENGTH(MAXMAT)
      DO 60 KOUT=1,IFOUND
        KR1=NAMEP(NSAVE(KOUT))
        KS1=PSAVE(KOUT)
        CALL FILLC(TEMP1,IDT,' ')
        CALL FILLC(TEMP2,IDT,' ')
        KR2 = NAMLEN(NSAVE(KOUT))
        CALL SQCOPY(NAMES(KR1),TEMP1,KR2)
        KR2 = LENEN(NSAVE(KOUT))
        CALL SQCOPY(SEQ(KS1),TEMP2,KR2)
        LENN=PSAVE(KOUT)-LENN
        IF(JOB.EQ.0) THEN
          WRITE(IDEV,1008)
     +    TEMP1,TEMP2,PSAVE(KOUT)+KSTART-1,LENN,LENGTH(KOUT)
        ELSE IF(JOB.EQ.1) THEN
          WRITE(IDEV,1008)
     +    TEMP1,TEMP2,PSAVE(KOUT)+KSTART-1,LENGTH(KOUT)
        END IF
        LENN=PSAVE(KOUT)
1008    FORMAT(' ',20A1,2X,20A1,2X,I6,2X,I6,2X,I6)
60    CONTINUE
      IF(JOB.EQ.0) THEN
        LEND=J2-PSAVE(IFOUND)+1-KSTART+1
        WRITE(IDEV,1020)LEND,LENGTH(IFOUND+1)
1020    FORMAT(' ',52X,I6,2X,I6)
      ELSE IF (JOB.EQ.1) THEN
        LEND=J2-PSAVE(IFOUND)+1-KSTART+1
        WRITE(IDEV,1020)LEND
      END IF
      END
      SUBROUTINE FINDL2(SEQ,IDSEQ,J1,J2,KSTART,RECSEQ,IDRSEQ,
     1NAMES,IDNAML,NAMEP,NAMLEN,
     1NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,OPTION,OPTOUT,
     1PSAVE,NSAVE,LENGTH,MAXMAT,NOPOUT,IBH,LEVEL,
     1MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,INC,KBIN,KBOUT,IDEV,
     +IHELPS,IHELPE,HELPF,IDEVH)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDSEQ),NAMES(IDNAML),RECSEQ(IDRSEQ)
      INTEGER NAMEP(MAXEN),NAMLEN(MAXEN),NUMREC(MAXEN),LENEN(MAXEN)
      INTEGER RECSTR(MAXEN),NAMLST(IDNLST),PSAVE(MAXMAT)
      INTEGER LENGTH(MAXMAT)
      INTEGER NSAVE(MAXMAT),OPTION,OPTOUT
      CHARACTER HELPF*(*)
      CHARACTER*20 ATOS
      EXTERNAL ATOS
C   OPTOUT=0 ENZYME BY ENZYME
C   NOPOUT=1 GRAPHICAL OUTPUT
C   FOR GRAPHICS NEED TO CHECK FOR END OF SCREEN
      CALL CLEARV
      CALL VECTOM
      LEVEL1=LEVEL
      LEVELM=MARGT-IBH
C   names max length 20 chars, strings 20 chars
      LAST=MAXEN
      IF(OPTION.EQ.1)LAST=IDNLST
      DO 100 IEN=1,LAST
        IFOUND=0
        JEN=IEN
        IF(OPTION.EQ.1)JEN=NAMLST(IEN)
        NREC=NUMREC(JEN)
        LREC=LENEN(JEN)
        CALL S1(SEQ,IDSEQ,NREC,LREC,JEN,IREC,J1,J2,INC,KSTART,
     +  RECSTR,MAXEN,PSAVE,NSAVE,MAXMAT,RECSEQ,IDRSEQ,IFOUND,KBOUT,
     +  IOK)
        IF(IOK.NE.0) THEN
          CALL VT100M
          RETURN
        END IF
        IF(IFOUND.GT.0) THEN
          IF(LEVEL.GE.LEVELM)THEN
            CALL PSRCHX(LEVEL1,LEVEL,KBIN,KBOUT,IQUIT,
     +      IHELPS,IHELPE,HELPF,IDEVH)
            IF(IQUIT.EQ.1) THEN
              CALL VT100M
              RETURN
            END IF
          END IF
          CALL PLSRCH(J1-KSTART+1,J2-KSTART+1,
     +    PSAVE,IFOUND,IBH,LEVEL,
     +    ATOS(NAMES(NAMEP(JEN)),NAMLEN(JEN)),
     +    NAMLEN(JEN),
     +    MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
        END IF
100   CONTINUE
      CALL VT100M
      END
      SUBROUTINE FINDL3(SEQ,IDSEQ,J1,J2,KSTART,RECSEQ,IDRSEQ,
     +NAMES,IDNAML,NAMEP,NAMLEN,
     +NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,OPTION,OPTOUT,
     +PSAVE,NSAVE,LENGTH,MAXMAT,NOPOUT,IBH,LEVEL,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,INC,KBIN,KBOUT,IDEV,
     +IHELPS,IHELPE,HELPF,IDEVH)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDSEQ),NAMES(IDNAML),RECSEQ(IDRSEQ)
      INTEGER NAMEP(MAXEN),NAMLEN(MAXEN),NUMREC(MAXEN),LENEN(MAXEN)
      INTEGER RECSTR(MAXEN),NAMLST(IDNLST),PSAVE(MAXMAT)
      INTEGER LENGTH(MAXMAT)
      INTEGER NSAVE(MAXMAT),OPTION,OPTOUT
      CHARACTER HELPF*(*)
C   OPTOUT=1 ALL ENZYMES TOGETHER
C   NOPOUT=1 GRAPHICAL OUTPUT
C   FOR GRAPHICS NEED TO CHECK FOR END OF SCREEN
      CALL CLEARV
      CALL VECTOM
      LEVEL1=LEVEL
      LEVELM=MARGT-IBH
C   names max length 20 chars, strings 20 chars
      LAST=MAXEN
      IF(OPTION.EQ.1)LAST=IDNLST
      IFOUND=0
      DO 100 IEN=1,LAST
        JEN=IEN
        IF(OPTION.EQ.1)JEN=NAMLST(IEN)
        NREC=NUMREC(JEN)
        LREC=LENEN(JEN)
        CALL S1(SEQ,IDSEQ,NREC,LREC,JEN,IREC,J1,J2,INC,KSTART,
     +  RECSTR,MAXEN,PSAVE,NSAVE,MAXMAT,RECSEQ,IDRSEQ,IFOUND,KBOUT,
     +  IOK)
        IF(IOK.NE.0) THEN
          CALL VT100M
          RETURN
        END IF
100   CONTINUE
      IF(IFOUND.GT.0)THEN
        CALL PLSRCH(J1-KSTART+1,J2-KSTART+1,
     +  PSAVE,IFOUND,IBH,LEVEL,'ALL',3,
     +  MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
      END IF
      CALL VT100M
      IF(IFOUND.EQ.0)WRITE(IDEV,3000)
3000  FORMAT(' no matches')
      END
      SUBROUTINE FINDL4(SEQ,IDSEQ,J1,J2,KSTART,RECSEQ,IDRSEQ,
     +NAMES,IDNAML,NAMEP,NAMLEN,
     +NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,OPTION,OPTOUT,
     +PSAVE,NSAVE,LENGTH,MAXMAT,NOPOUT,IBH,LEVEL,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,INC,KBIN,KBOUT,IDEV,
     +IHELPS,IHELPE,HELPF,IDEVH)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDSEQ),NAMES(IDNAML),RECSEQ(IDRSEQ)
      INTEGER NAMEP(MAXEN),NAMLEN(MAXEN),NUMREC(MAXEN),LENEN(MAXEN)
      INTEGER RECSTR(MAXEN),NAMLST(IDNLST),PSAVE(MAXMAT)
      INTEGER LENGTH(MAXMAT)
      INTEGER NSAVE(MAXMAT),OPTION,OPTOUT
      CHARACTER HELPF*(*)
C   OPTOUT=0 ENZYME BY ENZYME
C   names max length 20 chars, strings 20 chars
      LAST=MAXEN
      IF(OPTION.EQ.1)LAST=IDNLST
      DO 100 IEN=1,LAST
        IFOUND=0
        JEN=IEN
        IF(OPTION.EQ.1)JEN=NAMLST(IEN)
        NREC=NUMREC(JEN)
        LREC=LENEN(JEN)
        CALL S1(SEQ,IDSEQ,NREC,LREC,JEN,IREC,J1,J2,INC,KSTART,
     +  RECSTR,MAXEN,PSAVE,NSAVE,MAXMAT,RECSEQ,IDRSEQ,IFOUND,KBOUT,
     +  IOK)
        IF(IOK.NE.0) RETURN
        IF(IFOUND.GT.0) THEN
          WRITE(IDEV,1010)IFOUND
1010      FORMAT('  matches=',I6)
          CALL BUB2AS(PSAVE,NSAVE,IFOUND)
C         calc lengths
          LENGTH(1)=PSAVE(1)-(J1-KSTART+1)
          DO 45 KOUT=2,IFOUND
            LENGTH(KOUT)=PSAVE(KOUT)-PSAVE(KOUT-1)
45        CONTINUE
C         do length to end
          LENGTH(IFOUND+1)=J2-KSTART+1-PSAVE(IFOUND)+1
          IFP1=IFOUND+1
          CALL BUBBLE(LENGTH,IFP1)
          LENN=J1-KSTART
          WRITE(IDEV,1011)
1011     FORMAT(' NAME                  SEQUENCE            POSITION',
     +    '  FRAGMENT LENGTHS')
          CALL S2(SEQ,IDSEQ,IFOUND,NAMEP,NAMLEN,LENEN,MAXEN,
     +    NSAVE,PSAVE,LENGTH,MAXMAT,NAMES,IDNAML,
     +    LENN,IDEV,J2,KSTART,0)
        END IF
100   CONTINUE
      END
      SUBROUTINE FINDL5(SEQ,IDSEQ,J1,J2,KSTART,RECSEQ,IDRSEQ,
     +NAMES,IDNAML,NAMEP,NAMLEN,
     +NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,OPTION,OPTOUT,
     +PSAVE,NSAVE,LENGTH,MAXMAT,NOPOUT,IBH,LEVEL,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,INC,KBIN,KBOUT,IDEV,
     +IHELPS,IHELPE,HELPF,IDEVH)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDSEQ),NAMES(IDNAML),RECSEQ(IDRSEQ)
      INTEGER NAMEP(MAXEN),NAMLEN(MAXEN),NUMREC(MAXEN),LENEN(MAXEN)
      INTEGER RECSTR(MAXEN),NAMLST(IDNLST),PSAVE(MAXMAT)
      INTEGER LENGTH(MAXMAT)
      INTEGER NSAVE(MAXMAT),OPTION,OPTOUT
      CHARACTER HELPF*(*)
C   OPTOUT=1 ALL ENZYMES TOGETHER
C   NOPOUT = 0 (LISTED)
C   names max length 20 chars, strings 20 chars
      LAST=MAXEN
      IF(OPTION.EQ.1)LAST=IDNLST
      IFOUND=0
      DO 100 IEN=1,LAST
        JEN=IEN
        IF(OPTION.EQ.1)JEN=NAMLST(IEN)
        NREC=NUMREC(JEN)
        LREC=LENEN(JEN)
        CALL S1(SEQ,IDSEQ,NREC,LREC,JEN,IREC,J1,J2,INC,KSTART,
     +  RECSTR,MAXEN,PSAVE,NSAVE,MAXMAT,RECSEQ,IDRSEQ,IFOUND,KBOUT,
     +  IOK)
        IF(IOK.NE.0) RETURN
100   CONTINUE
      IF(IFOUND.GT.0) THEN
        CALL BUB2AS(PSAVE,NSAVE,IFOUND)
        LENN=J1-KSTART
        WRITE(IDEV,1011)
1011    FORMAT(' NAME                  SEQUENCE            POSITION',
     +  '  FRAGMENT LENGTHS')
        LENGTH(1)=PSAVE(1)-(J1-KSTART+1)
        DO 59 KOUT=2,IFOUND
          LENGTH(KOUT)=PSAVE(KOUT)-PSAVE(KOUT-1)
59      CONTINUE
        CALL S2(SEQ,IDSEQ,IFOUND,NAMEP,NAMLEN,LENEN,MAXEN,
     +  NSAVE,PSAVE,LENGTH,MAXMAT,NAMES,IDNAML,
     +  LENN,IDEV,J2,KSTART,1)
      ELSE
        WRITE(IDEV,3000)
3000    FORMAT(' no matches')
      END IF
      END
      SUBROUTINE SERCHD(RENZYM,IDREN,RECSEQ,IDRSEQ,
     +NAMES,IDNAML,MARGT,
     +NAMEP,NAMLEN,NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,
     +IDEVEN,FILNAM,FILEA,FILEAA,KBIN,KBOUT,
     +OPTION,OPTOUT,NOPOUT,IFILE,MININC,MAXINC,INC,DIALOG,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
C   AUTHOR: RODGER STADEN
      CHARACTER FILNAM*(*),FILEA*(*),FILEAA*(*),HELPF*(*)
      CHARACTER RENZYM(IDREN),RECSEQ(IDRSEQ),NAMES(IDNAML)
      INTEGER OPTION,OPTOUT
      INTEGER NAMEP(MAXEN),NAMLEN(MAXEN),NUMREC(MAXEN)
      INTEGER LENEN(MAXEN)
      INTEGER RECSTR(MAXEN),NAMLST(IDNLST),DIALOG
      IOK = 0
      CALL GETRNP(RENZYM,IDREN,IDEVEN,FILNAM,FILEA,FILEAA,
     +IOK,KBIN,KBOUT,IFILE,DIALOG,
     +IHELPS,IHELPE,HELPF,IDEVH)
      IF(IOK.NE.0)RETURN
      IF(IDREN.LT.5) THEN
        IOK = 1
        RETURN
      END IF
      CALL DECREN(RENZYM,IDREN,RECSEQ,IDRSEQ,NAMES,IDNAML,
     +NAMEP,NAMLEN,NUMREC,LENEN,RECSTR,MAXEN,KBOUT)
      IF(MAXEN.LT.1) THEN
        IOK = 1
        RETURN
      END IF
      IF(DIALOG.EQ.0) RETURN
      IOP = OPTION
      CALL YESONO(IOP,'All names','Selected names',
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      IF(IOP.LT.0) THEN
        IOK = 1
        RETURN
      END IF
      OPTION = IOP
      IF(OPTION.EQ.1)THEN
        CALL GETNAM(NAMLST,IDNLST,NAMES,IDNAML,NAMEP,NAMLEN,
     +  MAXEN,KBIN,KBOUT,
     +  IHELPS,IHELPE,HELPF,IDEVH)
        IF(IDNLST.LT.1) THEN
          IOK = 1
          RETURN
        END IF
      END IF
      IOP = OPTOUT
      CALL YESONO(IOP,'Show results name by name',
     +'Show results all names together',
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      IF(IOP.LT.0) THEN
        IOK = 1
        RETURN
      END IF
      OPTOUT = IOP
      IOP = NOPOUT
      CALL YESONO(IOP,'List matches','Plot matches',
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      IF(IOP.LT.0) THEN
        IOK = 1
        RETURN
      END IF
      NOPOUT = IOP
C      IF(NOPOUT.EQ.1)THEN
C        LEVEL = LEVELI
C        CALL SD2(IBLIPH,IBH,LEVEL,MARGT,
C     +  IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
C        LEVELI = LEVEL
C        IF(IOK.NE.0) RETURN
C      END IF
C      CALL GETINT(MININC,MAXINC,INC,'Step',
C     +IVAL,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
C      IF(IOK.NE.0) RETURN
C      INC = IVAL
      INC = 1
      END
      SUBROUTINE SIGNLP(SEQ,IDIM,MARGL,MARGR,MARGB,MARGT,
     +ISXMAX,ISYMAX,J1,J2,IDEV,FILNAM,
     +KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IDEVOT,
     +SUM,WT,TOT,IDM,MAXLEN,LINE,CHRSET,DIALOG)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDIM),FILNAM*(*),HELPF*(*),CHRSET(IDM)
      CHARACTER LINE(MAXLEN)
      INTEGER SUM(IDM,MAXLEN),TOT(MAXLEN)
      INTEGER DIALOG
      REAL WT(IDM,MAXLEN)
      CALL SHOWFU(KBOUT,'Motif search using weight matrix')
      CALL GETPAR(20,2,IOK,IOPT,IGON,
     +IPAR3,IPAR4,
     +IPAR5,IPAR6,IPAR7,IPAR8,IPAR9)
      IF(IOK.NE.0) RETURN
      CALL SIGNLD(IDEV,FILNAM,
     +KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,
     +SUM,IDM,MAXLEN,TOT,WT,LENGTH,MIDDLE,YMIN,YMIN1,YMAX,
     +IGON,IOPT,IDEVOT,LINE,CHRSET,DIALOG,IOK)
      IF(IOK.NE.0) RETURN
      CALL PSIGNL(SEQ,IDIM,MARGL,MARGR,MARGB,MARGT,
     +ISXMAX,ISYMAX,J1,J2,IDEVOT,WT,IDM,MAXLEN,LENGTH,
     +YMIN,YMIN1,YMAX,IGON,MIDDLE)
      END
      SUBROUTINE SIGNLD(IDEV,FILNAM,
     +KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,
     +SUM,IDM,MAXLEN,TOT,WT,LENGTH,MIDDLE,YMIN,YMIN1,YMAX,
     +IGON,IOPT,IDEVOT,LINE,CHRSET,DIALOG,IOK)
C   AUTHOR: RODGER STADEN
      CHARACTER FILNAM*(*),HELPF*(*),CHRSET(IDM),LINE(MAXLEN)
      INTEGER SUM(IDM,MAXLEN),TOT(MAXLEN),DIALOG
      REAL WT(IDM,MAXLEN)
      INTEGER VALUE
      PARAMETER (MAXPRM = 21)
      CHARACTER PROMPT(3)*(MAXPRM)
      IOK = 1
      IDO = 1
      PROMPT(1) = 'Use weight matrix'
      PROMPT(2) = 'Make weight matrix'
      PROMPT(3) = 'Rescale weight matrix'
      CALL RADION('Select operation',PROMPT,3,IDO,
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      IF(IDO.LT.1) RETURN
      IF(IDO.GT.1) THEN
        CALL MKWT(WT,SUM,TOT,CHRSET,IDM,MAXLEN,
     +  IDEV,IDEVOT,KBIN,KBOUT,LINE,
     +  FILNAM,IDO,IHELPS,IHELPE,HELPF,IDEVH,IOK)
        IOK = 1
        RETURN
      END IF
      FILNAM = ' '
      CALL OPENF1(IDEV,FILNAM,0,IOK,KBIN,KBOUT,
     +'Motif weight matrix file',
     +IHELPS,IHELPE,HELPF,IDEVH)
      IF(IOK.NE.0) RETURN
      LENGTH=MAXLEN
      CALL RDWMT(TOT,SUM,MIDDLE,LENGTH,MAXLEN,YMIN,YMAX,IDEV,
     +  IOK,IDM,KBOUT,0)
      IF(IOK.NE.0)THEN
        CALL ERROM(KBOUT,'Error in weight matrix')
        RETURN
      END IF
      CALL YESONO(IOPT,'Use frequencies as weights',
     +'Membership of set',IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      IF(IOPT.LT.0) THEN
        IOK = 1
        RETURN
      END IF
      IF(IOPT.EQ.1)THEN
        CALL GETW1(SUM,WT,LENGTH,IDM,MAXLEN)
        MININ = 1
        MAXIN = LENGTH
        CALL GETINT(MININ,MAXIN,LENGTH,'Cutoff score',
     +  VALUE,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
        IF(IOK.NE.0) RETURN
        YMIN = 0.
        YMAX = LENGTH
        YMIN1 = VALUE
      ELSE
        IF(DIALOG.EQ.1) THEN
          AMN = -9999.
          AMX = 9999.
          CALL GETRL(AMN,AMX,YMIN,'Cutoff score',VAL,KBIN,KBOUT,
     +    IHELPS,IHELPE,HELPF,IDEVH,IOK)
          IF(IOK.NE.0) RETURN
          YMIN = VAL
        END IF
        IF(YMIN.LT.0.0)CALL GETW(TOT,SUM,WT,LENGTH,IDM,MAXLEN)
        IF(YMIN.GE.0.0)CALL GETW2(SUM,WT,LENGTH,IDM,MAXLEN)
        YMIN1 = YMIN
      END IF  
      CALL YESONO(IGON,'Plot results','List results',
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      IF(IGON.LT.0) RETURN
      IOK = 0
      END
      SUBROUTINE PSIGNL(SEQ,IDIM,MARGL,MARGR,MARGB,MARGT,
     +ISXMAX,ISYMAX,J1,J2,IDEVOT,WT,IDM,MAXLEN,LENGTH,
     +YMIN,YMIN1,YMAX,IGON,MIDDLE)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDIM)
      REAL WT(IDM,MAXLEN)
      INTEGER CTONUM
      EXTERNAL CTONUM
      XMAX=J2
      XMIN=J1
      IF(IGON.EQ.0)THEN
        CALL CLEARV
        CALL VECTOM
        CALL FRAME(MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
      END IF
      DO 10 I=J1,J2-LENGTH+1
        SUM1=0.
        K=0
        DO 5 J=I,I+LENGTH-1
          K=K+1
          SUM1=SUM1+WT(CTONUM(SEQ(J)),K)
5       CONTINUE
        IF(SUM1.GE.YMIN1)THEN
          IF(IGON.EQ.0)THEN
            X=I+MIDDLE
            CALL LINE(X,X,YMIN,SUM1,XMAX,XMIN,YMAX,YMIN,
     +      MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
          END IF
          IF(IGON.EQ.1)THEN
            CALL VT100M
            WRITE(IDEVOT,1010)I+MIDDLE,SUM1,(SEQ(K),K=I,I+LENGTH-1)
1010        FORMAT(' ',I7,F10.2,' ',120A1)
          END IF
        END IF
10    CONTINUE
      CALL VT100M
      END
      SUBROUTINE LSTSEP(SEQ,IDIM,IDEV,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,DIALOG)
      CHARACTER HELPF*(*)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDIM)
      INTEGER DIALOG
      CALL SHOWFU(KBOUT,'List the sequence')
      I1 = 1
      I2 = IDIM
      LENGTH = 60
      IF(DIALOG.EQ.1) THEN
        CALL LSTSPD(IDIM,KBIN,KBOUT,
     +  IHELPS,IHELPE,HELPF,IDEVH,I1,I2,LENGTH,IOK)
        IF(IOK.NE.0) RETURN
      END IF
      CALL LSTSP(SEQ,IDIM,I1,I2,LENGTH,IDEV)
      END
      SUBROUTINE LSTSPD(IDIM,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,I1,I2,LENGTH,IOK)
C   AUTHOR: RODGER STADEN
      CHARACTER HELPF*(*)
      INTEGER VALUE
      IOK = 1
1     CONTINUE
      VALUE = I1
      CALL GETINT(I1,I2,VALUE,
     +'List from ',
     +VALUE,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0)RETURN
      I1 = VALUE
      VALUE = I2
      CALL GETINT(I1,I2,VALUE,
     +'List to ',
     +VALUE,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0)RETURN
      I2 = VALUE
      MININ = 10
      MAXIN = 120
      LENGTH = 60
      CALL GETINT(MININ,MAXIN,LENGTH,
     +'Line length ',
     +VALUE,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0)RETURN
      IF(MOD(VALUE,10).NE.0)VALUE = LENGTH
      LENGTH = VALUE
      END
      SUBROUTINE LSTSP(SEQ,IDIM,I1,I2,LENGTH,IDEV)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDIM)
      CALL FMTSEP(SEQ,IDIM,I1,I2,LENGTH,IDEV)
      END
      SUBROUTINE FMTSEP(SEQ1,IDIM,ISW,ISE,LINLEN,IDEV)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ1(IDIM)
      INTEGER KL(12)
      ISWW=ISW-1
      IE=ISW-1
1     CONTINUE
      WRITE(IDEV,1003)
1003  FORMAT( )
C   SET UP DECIMAL COUNTERS
      DO 50 J=1,LINLEN/10
        ISWW=ISWW+10
        KL(J)=ISWW
50    CONTINUE
      IS=IE+1
      IE=IE+LINLEN
      IF(IE.GT.ISE)IE=ISE
      WRITE(IDEV,1001)(KL(KKK),KKK=1,MIN(IE-IS+1,LINLEN)/10)
      WRITE(IDEV,1002)(SEQ1(K),K=IS,IE)
1002  FORMAT( '  ',12(10A1,1X))
1001  FORMAT( ' ',12(5X,I6))
      IF(IE.EQ.ISE)RETURN
      GO TO 1
      END
C   ROUTINE TO PERFORM ROBSON SECONDARY STRUCTURE PREDICTION FOR PROTEINS
      SUBROUTINE ROBSON(SEQ,IDIM1,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,KBIN,KBOUT,
     +IDEV,FILNAM,
     +IHELPS,IHELPE,HELPF,IDEVH,IDEVOT,DIALOG)
C   AUTHOR: RODGER STADEN
      INTEGER DIALOG
      CHARACTER HELPF*(*),FILNAM*(*)
      CHARACTER SEQ(IDIM1)
      INTEGER HELIX(-8:8,26),EXTEND(-8:8,26),TURN(-8:8,26),COIL(-8:8,26)
      CALL SHOWFU(KBOUT,'Plot Robson secondary structure predictions')
      CALL OPENRS(IDEV,FILNAM,IOK,LRECL,2)
      IF(IOK.NE.0)THEN
        CALL ERROM(KBOUT,'Error opening Robson weights file')
        RETURN
      END IF
      CALL REDROB(HELIX,IDEV,IFAIL)
      CALL REDROB(EXTEND,IDEV,IFAIL)
      CALL REDROB(TURN,IDEV,IFAIL)
      CALL REDROB(COIL,IDEV,IFAIL)
      CLOSE(UNIT=IDEV)
      IF(IFAIL.NE.0)THEN
        CALL ERROM(KBOUT,'Error in Robson score matrix')
        RETURN
      END IF
      CALL GETPAR(24,4,IOK,MINIW,MAXIW,IWRIT,IGON,
     +IPAR5,IPAR6,IPAR7,IPAR8,IPAR9)
      IF(IOK.NE.0) RETURN
      IF(DIALOG.EQ.1) THEN
        CALL ROBSND(MINIW,MAXIW,IWRIT,
     +  IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IGON,IOK)
        IF(IOK.NE.0) RETURN
      END IF
      CALL ROBSNP(SEQ,IDIM1,
     +HELIX,EXTEND,TURN,COIL,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,
     +IDEVOT,IWRIT,IGON)
      END
      SUBROUTINE ROBSNP(SEQ,IDIM1,
     +HELIX,EXTEND,TURN,COIL,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,
     +IDEVOT,IWRIT,IGON)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDIM1)
      INTEGER CTONUM
      INTEGER HELIX(-8:8,26),EXTEND(-8:8,26),TURN(-8:8,26),COIL(-8:8,26)
      EXTERNAL CTONUM
      YMINH=-400.
      YMAXH=400.
      YMINE=-400.
      YMAXE=400.
      YMINT=-400.
      YMAXT=400.
      YMINC=-400.
      YMAXC=400.
      YMEAN = 0.
      YMIND=0.0
      YMAXD=100.0
      YHD=20.
      YED=40.
      YTD=60.
      YCD=80.
      XMIN=J1
      XMAX=J2
      YMID=YMINH+(YMAXH-YMINH)*0.75
      XMARG=REAL(MARGT)/5.0
      IMARG=NINT(XMARG)
      MARGBH=MARGB+XMARG
      MARGTH=IMARG
      MARGBE=MARGB+2*XMARG
      MARGTE=IMARG
      MARGBT=MARGB+3*XMARG
      MARGTT=IMARG
      MARGBC=MARGB+4*XMARG
      MARGTC=IMARG
      MARGBD=MARGB
      MARGTD=IMARG
      NH = 0
      NE = 0
      NT = 0
      NC = 0
      IF(IGON.EQ.0)THEN
      CALL CLEARV
      CALL VECTOM
      CALL FRAME(MARGL,MARGR,MARGBH,MARGTH,ISXMAX,ISYMAX)
      CALL FRAME(MARGL,MARGR,MARGBE,MARGTE,ISXMAX,ISYMAX)
      CALL FRAME(MARGL,MARGR,MARGBT,MARGTT,ISXMAX,ISYMAX)
      CALL FRAME(MARGL,MARGR,MARGBC,MARGTC,ISXMAX,ISYMAX)
      CALL FRAME(MARGL,MARGR,MARGBD,MARGTD,ISXMAX,ISYMAX)
      CALL TEXT(XMIN,YMID,' H',2,0,XMAX,XMIN,YMAXH,YMINH,
     1MARGL,MARGR,MARGBH,MARGTH,ISXMAX,ISYMAX)
      CALL TEXT(XMIN,YMID,' E',2,0,XMAX,XMIN,YMAXE,YMINE,
     1MARGL,MARGR,MARGBE,MARGTE,ISXMAX,ISYMAX)
      CALL TEXT(XMIN,YMID,' T',2,0,XMAX,XMIN,YMAXT,YMINT,
     1MARGL,MARGR,MARGBT,MARGTT,ISXMAX,ISYMAX)
      CALL TEXT(XMIN,YMID,' C',2,0,XMAX,XMIN,YMAXC,YMINC,
     1MARGL,MARGR,MARGBC,MARGTC,ISXMAX,ISYMAX)
      CALL TEXT(XMIN,YCD,' D',2,0,XMAX,XMIN,YMAXD,YMIND,
     1MARGL,MARGR,MARGBD,MARGTD,ISXMAX,ISYMAX)
      END IF
      IDONE=0
      XP=MAX(J1,9)
      X=XP
      YPH=0.
      YPE=0.
      YPC=0.
      YPT=0.
      IOPT = 1
      DO 10 I=MAX(J1,9),MIN(J2,IDIM1-8)
        IDONE=IDONE+1
        SUMH=0.
        SUME=0.
        SUMC=0.
        SUMT=0.
        K=I-9
        DO 5 J=8,-8,-1
          K=K+1
          ISEQ=CTONUM(SEQ(K))
          SUMH=SUMH+HELIX(J,ISEQ)
          SUME=SUME+EXTEND(J,ISEQ)
          SUMC=SUMC+COIL(J,ISEQ)
          SUMT=SUMT+TURN(J,ISEQ)
5       CONTINUE
        IF(MOD(IDONE,IWRIT).EQ.0)THEN
          YMAX=MAX(SUMH,SUME,SUMC,SUMT)
          X=I
          IF(IGON.EQ.0)THEN
            CALL LINE(XP,X,YPH,SUMH,XMAX,XMIN,YMAXH,YMINH,
     +      MARGL,MARGR,MARGBH,MARGTH,ISXMAX,ISYMAX)
            IF(YMAX.EQ.SUMH)THEN
              CALL POINT(X,YHD,XMAX,XMIN,YMAXD,YMIND,
     +        MARGL,MARGR,MARGBD,MARGTD,ISXMAX,ISYMAX)
              CALL POINT(X,YMEAN,XMAX,XMIN,YMAXH,YMINH,
     +        MARGL,MARGR,MARGBH,MARGTH,ISXMAX,ISYMAX)
              NH = NH + 1
            END IF
            YPH=SUMH
            CALL LINE(XP,X,YPE,SUME,XMAX,XMIN,YMAXE,YMINE,
     +      MARGL,MARGR,MARGBE,MARGTE,ISXMAX,ISYMAX)
            IF(YMAX.EQ.SUME)THEN
              CALL POINT(X,YED,XMAX,XMIN,YMAXD,YMIND,
     +        MARGL,MARGR,MARGBD,MARGTD,ISXMAX,ISYMAX)
              CALL POINT(X,YMEAN,XMAX,XMIN,YMAXE,YMINE,
     +        MARGL,MARGR,MARGBE,MARGTE,ISXMAX,ISYMAX)
              NE = NE + 1
            END IF
            YPE=SUME
            CALL LINE(XP,X,YPT,SUMT,XMAX,XMIN,YMAXT,YMINT,
     +      MARGL,MARGR,MARGBT,MARGTT,ISXMAX,ISYMAX)
            IF(YMAX.EQ.SUMT)THEN
              CALL POINT(X,YTD,XMAX,XMIN,YMAXD,YMIND,
     +        MARGL,MARGR,MARGBD,MARGTD,ISXMAX,ISYMAX)
              CALL POINT(X,YMEAN,XMAX,XMIN,YMAXT,YMINT,
     +        MARGL,MARGR,MARGBT,MARGTT,ISXMAX,ISYMAX)
              NT = NT + 1
            END IF
            YPT=SUMT
            CALL LINE(XP,X,YPC,SUMC,XMAX,XMIN,YMAXC,YMINC,
     +      MARGL,MARGR,MARGBC,MARGTC,ISXMAX,ISYMAX)
            IF(YMAX.EQ.SUMC)THEN
              CALL POINT(X,YCD,XMAX,XMIN,YMAXD,YMIND,
     +        MARGL,MARGR,MARGBD,MARGTD,ISXMAX,ISYMAX)
              CALL POINT(X,YMEAN,XMAX,XMIN,YMAXC,YMINC,
     +        MARGL,MARGR,MARGBC,MARGTC,ISXMAX,ISYMAX)
              NC = NC + 1
            END IF
            YPC=SUMC
            XP=I
          END IF
          IF(IGON.EQ.1)THEN
            CALL VT100M
            WRITE(IDEVOT,1005)
     +      I,SEQ(I),INT(SUMH),INT(SUME),INT(SUMT),INT(SUMC)
1005        FORMAT(' ',I6,' ',A1,' ',4I5)
            IF(IGON.EQ.0)CALL VECTOM
          END IF
        END IF
10    CONTINUE
      CALL VT100M
      WRITE(IDEVOT,1006)NH,NE,NT,NC
1006  FORMAT(
     +'     Helix =',I6,', Extended =',I6,', Turn =',I6,', Coil =',I6)
      END
      SUBROUTINE ROBSND(MINIW,MAXIW,IWRIT,
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IGON,IOK)
      CHARACTER HELPF*(*)
      IOK = 1
      CALL YESONO(IGON,'Plot results','List results',
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      IF(IGON.LT.0) RETURN
      IF(IGON.EQ.0) THEN
        CALL GETINT(MINIW,MAXIW,IWRIT,'Plot interval',IVAL,KBIN,KBOUT,
     +  IHELPS,IHELPE,HELPF,IDEVH,IOK)
        IF(IOK.NE.0) RETURN
        IWRIT = IVAL
      END IF
      IOK = 0
      END
      SUBROUTINE REDROB(TABLE,IDEV,IFAIL)
C   AUTHOR: RODGER STADEN
      INTEGER TABLE(-8:8,26)
C   SET FAIL FLAG
      IFAIL=1
1000  FORMAT( )
1001  FORMAT(3X,17I4)
C   READ TITLE
      READ(IDEV,1000,END=100,ERR=100)
C   READ POSITIONS
      READ(IDEV,1000,END=100,ERR=100)
C   READ VALUES
      DO 10 I=1,26
        READ(IDEV,1001,ERR=100,END=100)(TABLE(K,I),K=-8,8)
10    CONTINUE
C   SET FAIL FLAG TO GOOD
      IFAIL=0
      RETURN
100   CONTINUE
      RETURN
      END
C   SUBROUTINE TO DRAW HELIX WHEELS
      SUBROUTINE HELIXW(SEQ,IDSEQ,KSTART,J1,J2,IX0,IXLEN,IY0,IYLEN,
     +ISXMAX,ISYMAX,KBIN,KBOUT,HYDRO,IDSCOR,
     +IHELPS,IHELPE,HELPF,IDEVH,DIALOG)
C  AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDSEQ),HELPF*(*)
      INTEGER DIALOG
      INTEGER WINDOW
      REAL HYDRO(IDSCOR)
      PARAMETER (DEGTOR = 0.017453)
      CALL SHOWFU(KBOUT,'Draw helix wheel')
      CALL GETPAR(26,6,IOK,MINANG,MAXANG,IANGLE,MINIW,MAXIW,WINDOW,
     +IPAR7,IPAR8,IPAR9)
      IF(IOK.NE.0) RETURN
      IF(DIALOG.EQ.1) THEN
        CALL HELIXD(MINANG,MAXANG,IANGLE,MINIW,MAXIW,WINDOW,
     +  IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
        IF(IOK.NE.0) RETURN
      END IF
      ANGLE = REAL(IANGLE)*DEGTOR
      CALL HELIXP(SEQ,IDSEQ,KSTART,J1,J2,IX0,IXLEN,IY0,IYLEN,
     +ISXMAX,ISYMAX,KBIN,KBOUT,HYDRO,IDSCOR,
     +IHELPS,IHELPE,HELPF,IDEVH,WINDOW,ANGLE)
      END
      SUBROUTINE HELIXP(SEQ,IDSEQ,KSTART,J1,J2,IX0,IXLEN,IY0,IYLEN,
     +ISXMAX,ISYMAX,KBIN,KBOUT,HYDRO,IDSCOR,
     +IHELPS,IHELPE,HELPF,IDEVH,WINDOW,ANGLE)
C  AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDSEQ),HELPF*(*)
      CHARACTER SYMBOL*26,ATOS*60,SYMT*2,POSN*6,POSNHP*8
      CHARACTER*2 NUMBER(1:60)
      INTEGER CTONUM,WINDOW
      REAL HYDRO(IDSCOR)
      EXTERNAL CTONUM,ATOS
      PARAMETER (
     +           RAD1   = 0.78,
     +           RAD2   = 1.25,
     +           RAD3   = 1.50,
     +           RAD4   = 1.0,
     +           XMIN   = -1.75,
     +           XMAX   = 1.75,
     +           YMIN   = -1.75,
     +           YMAX   = 1.75,
     +           CENTRX = 0.0,
     +           CENTRY = 0.0,
     +           TXMIN  = XMIN + (XMAX-XMIN)*0.05,
     +           TYMIN  = YMAX - (YMAX-YMIN)*0.04,
     +           PXMIN  = XMIN + (XMAX-XMIN)*0.05,
     +           PYMIN  = YMAX - (YMAX-YMIN)*0.16,
     +           HMXMIN  = XMIN + (XMAX-XMIN)*0.05,
     +           HMYMIN  = YMAX - (YMAX-YMIN)*0.08,
     +           HXMIN  = XMIN + (XMAX-XMIN)*0.05,
     +           HYMIN  = YMAX - (YMAX-YMIN)*0.12)
C     +           TXMIN  = XMIN + (XMAX-XMIN)*0.05,
C     +           TYMIN  = YMAX - (YMAX-YMIN)*0.03,
C     +           PXMIN  = XMIN + (XMAX-XMIN)*0.05,
C     +           PYMIN  = YMAX - (YMAX-YMIN)*0.14,
C     +           HMXMIN  = XMIN + (XMAX-XMIN)*0.05,
C     +           HMYMIN  = YMAX - (YMAX-YMIN)*0.06,
C     +           HXMIN  = XMIN + (XMAX-XMIN)*0.05,
C     +           HYMIN  = YMAX - (YMAX-YMIN)*0.1)
      PARAMETER (DELTA = 0.001)
C
      SYMBOL ='       --   +++ ......    '
      DO 1 I = 1,60
        WRITE(NUMBER(I),1005)I
1     CONTINUE
1005  FORMAT(I2)
      POSNHP=' '
C
C  SEQUENCE CHARACTER IN ELEMENT 1 OF SEQ ARRAY IS KSTART
C  FIRST SEQUENCE CHARACTER IN ACTIVE REGION IS J1, LAST J2
C  DIMENSION OF SEQ ARRAY IS IDSEQ
C  ELEMENT NUMBER FOR J1 IS J1-KSTART+1
C  ELEMENT NUMBER FOR J2 IS J2-KSTART+1
C  NUMBER OF ELEMENTS TO PROCESS IS J2-J1+1
C  WORK IN ELEMENT NUMBERS AND SET TO SEQUENCE NUMBERS FOR OUTPUT
C  SET FIRST ELEMENT NUMBER
       I1 = J1-KSTART+1
C
C
10     CONTINUE
C
C
       CALL CLEARV
       CALL VECTOM
       CALL CLEARG
       CALL VECTOM
       CALL FRAME(IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
       XF = 0.0
       YF = RAD1
       ICLOCK = 0
       I2 = MIN(I1+WINDOW-1,J2-KSTART+1)
       IWIN = I2-I1+1
       DO 20 I = I1,I2
         ICLOCK = ICLOCK + 1
         TX = COS(1.5708-((I-I1)*ANGLE))
         TY = SIN(1.5708-((I-I1)*ANGLE))
         X = RAD2*TX
         Y = RAD2*TY
         SYMT = SEQ(I)
         CALL TEXT(X,Y,SYMT,1,ISIZE,XMAX,XMIN,YMAX,YMIN,
     +   IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
         X = RAD4*TX
         Y = RAD4*TY
         SYMT = NUMBER(ICLOCK)
         CALL TEXT(X,Y,SYMT,2,ISIZE,XMAX,XMIN,YMAX,YMIN,
     +   IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
         X = RAD3*TX
         Y = RAD3*TY
         K = CTONUM(SEQ(I))
         SYMT = SYMBOL(K:K)
         CALL TEXT(X,Y,SYMT,1,ISIZE,XMAX,XMIN,YMAX,YMIN,
     +   IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
         X = RAD1*TX
         Y = RAD1*TY
         CALL LINE(XF,X,YF,Y,XMAX,XMIN,YMAX,YMIN,
     +   IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
         XF = X
         YF = Y
         I3 = I
20     CONTINUE
       CALL EISEN(SEQ(I1),IWIN,HYDRO,IDSCOR,ANGLE,HM,H)
       CALL TEXT(TXMIN,TYMIN,ATOS(SEQ(I1),IWIN),IWIN,ISIZE,
     +   XMAX,XMIN,YMAX,YMIN,
     +   IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
       WRITE(POSN,1000)I1+KSTART-1
1000   FORMAT(I6)
       CALL TEXT(PXMIN,PYMIN,POSN,6,ISIZE,
     +   XMAX,XMIN,YMAX,YMIN,
     +   IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
       WRITE(POSN,1001)HM*WINDOW
1001   FORMAT(F6.2)
       POSNHP(2:) = POSN
       POSNHP(1:1) = 'M'
       CALL TEXT(HMXMIN,HMYMIN,POSNHP,8,ISIZE,
     +   XMAX,XMIN,YMAX,YMIN,
     +   IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
       WRITE(POSN,1001)H*WINDOW
       POSNHP(2:) = POSN
       POSNHP(1:1) = 'H'
       CALL TEXT(HXMIN,HYMIN,POSNHP,8,ISIZE,
     +   XMAX,XMIN,YMAX,YMIN,
     +   IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
         ICLOCK = ICLOCK + 1
         TX = COS(1.5708-((I3+1-I1)*ANGLE))
         TY = SIN(1.5708-((I3+1-I1)*ANGLE))
         X = RAD1*TX
         Y = RAD1*TY
        IF((ABS(X).LT.DELTA).AND.(ABS(Y-RAD1).LT.DELTA))
     +  CALL LINE(XF,0.0,YF,RAD1,XMAX,XMIN,YMAX,YMIN,
     +  IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
        CALL FLUSHG
30     CONTINUE
       CALL VT100M
       MINSTP = -1000
       MAXSTP = 1000
       NEXT = 1
       CALL GETINT(MINSTP,MAXSTP,NEXT,'Step',
     +  IVAL,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
        IF(IOK.NE.0) GO TO 40
       NEXT = IVAL
       I1 = I1 + NEXT
       IF(I1.LT.0)GO TO 40
       IF(I1.GT.J2-KSTART+1)GO TO 40
       IF(I1.LT.J1-KSTART+1)GO TO 40
       GO TO 10
40     CONTINUE
       CALL VT100M
       END
      SUBROUTINE HELIXD(MINANG,MAXANG,IANGLE,MINIW,MAXIW,WINDOW,
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
C  AUTHOR: RODGER STADEN
      CHARACTER HELPF*(*)
      INTEGER WINDOW
      IOK = 1
      CALL GETINT(MINANG,MAXANG,IANGLE,'Angle',IVAL,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
      IANGLE = IVAL
      CALL GETINT(MINIW,MAXIW,WINDOW,'Window',IVAL,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
      WINDOW = IVAL
      END
C   SUBROUTINE TO PLOT HYDROPHOBIC MOMENTS
      SUBROUTINE HYDMOM(SEQ,IDSEQ,HYDRO,IDSCOR,
     +IX0,IXLEN,IY0,IYLEN,
     +ISXMAX,ISYMAX,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,DIALOG)
C  AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDSEQ),HELPF*(*)
      INTEGER DIALOG
      INTEGER WINDOW
      REAL HYDRO(IDSCOR)
      PARAMETER (DEGTOR = 0.017453)
      EXTERNAL CTONUM
      CALL SHOWFU(KBOUT,'Plot hydrophobic moment')
      CALL GETPAR(25,9,IOK,MINANG,MAXANG,IANGLE,MINWIN,MAXWIN,WINDOW,
     +MINIW,MAXIW,IWRIT)
      IF(IOK.NE.0) RETURN
      IF(DIALOG.EQ.1) THEN
        CALL HYDMD(MINANG,MAXANG,IANGLE,MINWIN,MAXWIN,WINDOW,
     +  MINIW,MAXIW,IWRIT,
     +  IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
        IF(IOK.NE.0) RETURN
      END IF
      ANGLE = REAL(IANGLE)*DEGTOR
      CALL HYDMP(SEQ,IDSEQ,HYDRO,IDSCOR,
     +IX0,IXLEN,IY0,IYLEN,
     +ISXMAX,ISYMAX,WINDOW,ANGLE,IWRIT)
      END
      SUBROUTINE HYDMP(SEQ,IDSEQ,HYDRO,IDSCOR,
     +IX0,IXLEN,IY0,IYLEN,
     +ISXMAX,ISYMAX,WINDOW,ANGLE,IWRIT)
C  AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDSEQ)
      INTEGER CTONUM,WINDOW
      REAL HYDRO(IDSCOR)
      EXTERNAL CTONUM
      XMIN = 1
      XMAX = IDSEQ
      CALL CLEARV
      CALL VECTOM
       Y = REAL(IYLEN)/2.
       IYLEN1 = NINT(Y)
       IY1 = IY0 + IYLEN1
       CALL FRAME(IX0,IXLEN,IY0,IYLEN1,ISXMAX,ISYMAX)
       CALL FRAME(IX0,IXLEN,IY1,IYLEN1,ISXMAX,ISYMAX)
       IBH = 150
       CALL SCALES(XMAX,XMIN,1.5,-1.0,
     1          IX0,IXLEN,IY1,IYLEN1,ISXMAX,ISYMAX,
     1          0.5,IBH,-1.0,2)
       CALL SCALES(XMAX,XMIN,1.5,0.0,
     1          IX0,IXLEN,IY0,IYLEN1,ISXMAX,ISYMAX,
     1          0.5,IBH,0.0,2)
       IBH = 50
       CALL SCALES(XMAX,XMIN,1.5,-1.0,
     1          IX0,IXLEN,IY1,IYLEN1,ISXMAX,ISYMAX,
     1          0.1,IBH,-1.0,2)
       CALL SCALES(XMAX,XMIN,1.5,0.0,
     1          IX0,IXLEN,IY0,IYLEN1,ISXMAX,ISYMAX,
     1          0.1,IBH,0.0,2)
C       CALL TEXT(2.,1.4,'HYDROPHOBIC MOMENT',18,ISIZE,
C     +   100.0,1.0,1.5,0.0,
C     +   IX0,IXLEN,IY0,IYLEN1,ISXMAX,ISYMAX)
C       CALL TEXT(2.0,1.3,'HYDROPHOBICITY',14,ISIZE,
C     +   100.,1.0,1.5,-1.0,
C     +   IX0,IXLEN,IY1,IYLEN1,ISXMAX,ISYMAX)
C         CALL LINE(1.,XMAX,0.55,0.55,XMAX,XMIN,1.5,-1.0,
C     +   IX0,IXLEN,IY1,IYLEN1,ISXMAX,ISYMAX)
C         CALL LINE(1.,XMAX,0.68,0.68,XMAX,XMIN,1.5,-1.0,
C     +   IX0,IXLEN,IY1,IYLEN1,ISXMAX,ISYMAX)
C         CALL LINE(1.,XMAX,0.42,0.42,XMAX,XMIN,1.5,-1.0,
C     +   IX0,IXLEN,IY1,IYLEN1,ISXMAX,ISYMAX)
      IDONE = 0
      XF = 0.
      HMF = 0.
      HF = 0.
      DO 40 J = 1,IDSEQ-WINDOW+1
       I1 = J
       CALL EISEN(SEQ(I1),WINDOW,HYDRO,IDSCOR,ANGLE,HM,H)
       IDONE = IDONE + 1
       IF(MOD(IDONE,IWRIT).EQ.0)THEN
         X = I1
         CALL LINE(XF,X,HMF,HM,XMAX,XMIN,1.5,0.0,
     +   IX0,IXLEN,IY0,IYLEN1,ISXMAX,ISYMAX)
         CALL LINE(XF,X,HF,H,XMAX,XMIN,1.5,-1.0,
     +   IX0,IXLEN,IY1,IYLEN1,ISXMAX,ISYMAX)
         XF = X
         HMF = HM
         HF = H
       END IF
C
40    CONTINUE
       CALL VT100M
       END
      SUBROUTINE HYDMD(MINANG,MAXANG,IANGLE,MINWIN,MAXWIN,WINDOW,
     +MINIW,MAXIW,IWRIT,
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
C  AUTHOR: RODGER STADEN
      CHARACTER HELPF*(*)
      INTEGER WINDOW
      IOK = 1
      CALL GETINT(MINANG,MAXANG,IANGLE,'Angle',IVAL,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
      IANGLE = IVAL
      CALL GETINT(MINWIN,MAXWIN,WINDOW,'Window',IVAL,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
      WINDOW = IVAL
      CALL GETINT(MINIW,MAXIW,IWRIT,'Plot interval',IVAL,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
      IWRIT = IVAL
      IOK = 0
      END
       SUBROUTINE EISEN(SEQ,WINDOW,HYDRO,IDHYD,DELTA,HM,H)
       INTEGER WINDOW
       CHARACTER SEQ(WINDOW)
       REAL HYDRO(IDHYD)
       INTEGER CTONUM
       EXTERNAL CTONUM
C  AUTHOR RODGER STADEN
C  CALCULATES THE MEAN HYDROPHOBICITY AND MEAN HYDROPHOBIC MOMENT
C  AFTER EISENBERG, FOR A WINDOW OF SIZE WINDOW, AND ANGLE DELTA
       T1 = 0.
       T2 = 0.
       H = 0.
       DO 20 I = 1, WINDOW
C
         IT =CTONUM(SEQ(I))
         T = HYDRO(IT)
         T3 = DELTA * I - 1
         T1 = T1 + T * SIN(T3)
         T2 = T2 + T * COS(T3)
         H = H + T
C
20    CONTINUE
      T1 = T1 * T1
      T2 = T2 * T2
      HM = T1 + T2
      IF(HM.GT.0.0)HM = SQRT(HM)
      H = H / WINDOW
      HM = HM / WINDOW
      END
C   BACK
      SUBROUTINE BACK(SEQ,IDSEQ,CODIN,KBIN,KBOUT,FILNAM,IDEV,
     +DNA,MAXSEQ,PCOD,IDIM1P,MXSPAN,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,
     +IHELPS,IHELPE,HELPF,IDEVH,DIALOG)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDSEQ),DNA(MAXSEQ),FILNAM*(*),PAA(5,5,5)
      CHARACTER*3 CODON(26),CODIN(26)
      REAL CODS(4,4,4),PROB(26),PCOD(IDIM1P)
      CHARACTER HELPF*(*)
      INTEGER DIALOG
      INTEGER SPAN
      SAVE PAA
      DATA PAA/'F','F','L','L','-','S','S','S','S','S',
     1'Y','Y','*','*','-','C','C','*','W','-',
     1'-','-','-','-','-','L','L','L','L','L',
     1'P','P','P','P','P','H','H','Q','Q','-',
     1'R','R','R','R','R','-','-','-','-','-','I','I','I','M','-',
     1'T','T','T','T','T',
     1'N','N','K','K','-','S','S','R','R','-','-','-','-','-','-',
     1'V','V','V','V','V','A','A','A','A','A','D','D','E','E','-',
     1'G','G','G','G','G',
     1'-','-','-','-','-','-','-','-','-','-',
     1'-','-','-','-','-','-','-','-','-','-',
     1'-','-','-','-','-','-','-','-','-','-'/
      CALL GETPAR(27,8,IOK,IOP,IPLOT,MINWIN,MAXWIN,SPAN,
     +MINIW,MAXIW,IWRIT,IPAR9)
      IF(IOK.NE.0) RETURN
      CALL SHOWFU(KBOUT,'Back translate')
      DO 10 I = 1,26
        CODON(I) = CODIN(I)
10    CONTINUE
      CALL FILLR(PROB,26,0.)
      CALL FILLR(CODS,64,0.)
C   GET CODON TABLE FROM FILE IF REQUIRED
      IF(DIALOG.EQ.1) THEN
        CALL BACKD1(IOP,IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,
     +  FILNAM,IDEV,CODS,PAA,IOK)
        IF(IOK.NE.0) RETURN
      END IF
C   BACK TRANSLATE
      CALL BACKA(CODS,PAA,CODON,PROB,PCOD,IDIM1P,MXSPAN,
     +SEQ,IDSEQ,DNA,MAXSEQ)
C   SET UP PLOTTING
      IF(DIALOG.EQ.1) THEN
        CALL BACKD2(IPLOT,MINWIN,MAXWIN,SPAN,MINIW,MAXIW,IWRIT,
     +  IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
        IF(IOK.NE.0) RETURN
        IF(IPLOT.LT.0) RETURN
      END IF
      IF(IPLOT.EQ.0)THEN
C   PLOT REDUNDANCY
        CALL PLOTRD(PCOD,IDIM1P,MXSPAN,1,IDSEQ,
     +  MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,SPAN,IWRIT)
        CALL BPAUSE(KBIN,KBOUT,IOK)
        IF(IOK.NE.0) RETURN
      END IF
      IDIM = 3*IDSEQ
C   SAVE TO DISK
      CALL BACKO(DNA,IDIM,FILNAM,IDEV,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH)
      END
      SUBROUTINE BACKD2(IPLOT,MINWIN,MAXWIN,SPAN,MINIW,MAXIW,IWRIT,
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
C   AUTHOR: RODGER STADEN
      CHARACTER HELPF*(*)
      INTEGER SPAN
      CALL YESNO(IPLOT,'Plot redundancy',
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      IF(IPLOT.LT.0)RETURN
      IF(IPLOT.EQ.0) THEN
        CALL GSPIN(MINWIN,MAXWIN,SPAN,MINIW,MAXIW,IWRIT,KBIN,KBOUT,
     +  IHELPS,IHELPE,HELPF,IDEVH,IOK)
        IF(IOK.NE.0) RETURN
      END IF
      END
      SUBROUTINE BACKO(DNA,IDIM,FILNAM,IDEV,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH)
C   AUTHOR: RODGER STADEN
      CHARACTER DNA(IDIM)
      CHARACTER FILNAM*(*),HELPF*(*)
      CALL YESNO(IN,'Save DNA to disk',
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      IF(IN.LT.0)RETURN
      IF(IN.EQ.0)THEN
        FILNAM = ' '
        CALL OPENF1(IDEV,FILNAM,1,IOK,KBIN,KBOUT,
     +  'File name for DNA sequence',
     +  IHELPS,IHELPE,HELPF,IDEVH)
        IF(IOK.EQ.0)THEN
          CALL FMTDK(IDEV,DNA,IDIM)
          CLOSE(UNIT=IDEV)
        END IF
      END IF
      END
      SUBROUTINE BACKD1(IOP,IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,
     +FILNAM,IDEV,CODS,PAA,IOK)
C   AUTHOR: RODGER STADEN
      CHARACTER FILNAM*(*),HELPF*(*),PAA(5,5,5)
      REAL CODS(4,4,4)
      IOK = 1
      CALL YESONO(IOP,'No codon preference',
     +'Use file of codon preferences',
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      IF(IOP.LT.0) RETURN
      IF(IOP.EQ.0) THEN
        IOK = 0
        RETURN
      END IF
      IF(IOP.EQ.1)THEN
        FILNAM = ' '
        CALL OPENF1(IDEV,FILNAM,0,IOK,KBIN,KBOUT,
     +  'Codon table file name',
     +  IHELPS,IHELPE,HELPF,IDEVH)
        IF(IOK.EQ.0)THEN
          CALL REDCOD(CODS,IDEV)
          CLOSE(UNIT=IDEV)
          CALL WRTCOD(CODS,KBOUT,PAA)
        END IF
      END IF
      END
      SUBROUTINE BACKA(CODS,PAA,CODON,PROB,PCOD,IDIM1P,MXSPAN,
     +SEQ,IDSEQ,DNA,MAXSEQ)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDSEQ),DNA(MAXSEQ),PAA(5,5,5)
      CHARACTER*3 CODON(26)
      REAL CODS(4,4,4),PROB(26),PCOD(IDIM1P)
      INTEGER CTONUM
      EXTERNAL CTONUM
C   USE TOP CODONS
      CALL TOPCOD(CODS,PAA,CODON,PROB)
C   BACK TRANSLATE
      I1 = 1+MXSPAN/2
      CALL FILLR(PCOD,I1,0.)
      DO 100 I = 1,IDSEQ
        K = CTONUM(SEQ(I))
        DNA(1+3*(I-1)) = CODON(K)(1:1)
        DNA(2+3*(I-1)) = CODON(K)(2:2)
        DNA(3+3*(I-1)) = CODON(K)(3:3)
        PCOD(I+I1) = PROB(K)
100   CONTINUE
      CALL FILLR(PCOD(IDSEQ+I1+1),I1,0.)
      END
C   CHECK EACH AMINO ACID IN TURN FOR EVEN CODON USE
      SUBROUTINE TOPCOD(CODUSE,PAA,CODON,PROB)
C   AUTHOR: RODGER STADEN
      CHARACTER PAA(5,5,5),AA(22),BASE(4)
      CHARACTER*3 CODON(26)
      REAL CODUSE(4,4,4),PROB(26)
      SAVE AA,BASE
      DATA AA/'C','S','T','P','A','G','N','D','E','Q','B',
     +'Z','H','R','K','M','I','L','V','F','Y','W'/
      DATA BASE/'T','C','A','G'/
C   IF CODONS FOR AN ACID ARE EVENLY USED EMPLOY ALL CODONS
C   OTHERWISE EMPLOY THE TOP SCORER. CHECK THE USAGE
C   LOOP FOR EACH ACID
      DO 300 L=1,22
        IMAX = 0
        JMAX = 0
        KMAX = 0
        AMAX=0.0
        NCOD = 0
        TCOD = 0.0
        IEVEN = 1
C   LOOP FOR EACH CODON
        DO 200 I=1,4
          DO 200 J=1,4
            DO 200 K=1,4
C   EXAMINE CODONS FOR ACID L
              IF(PAA(K,J,I).EQ.AA(L))THEN
                NCOD = NCOD + 1
                TCOD = TCOD + CODUSE(I,J,K)
                IF(CODUSE(I,J,K).GT.AMAX)THEN
                  AMAX = CODUSE(I,J,K)
                  IMAX = I
                  JMAX = J
                  KMAX = K
                  IEVEN = 0
                ELSE IF(CODUSE(I,J,K).EQ.AMAX)THEN
                  IEVEN = 1
                END IF
              END IF
200     CONTINUE
C  IF THERE IS A PREFERENCE, USE IT
        IF((AMAX.GT.0.0).AND.(IEVEN.EQ.0))THEN
          CODON(L) = BASE(IMAX)//BASE(JMAX)//BASE(KMAX)
          PROB(L) = AMAX/TCOD
        ELSE
          PROB(L) = 1.0/(MAX(1,NCOD))
        END IF
300   CONTINUE
      END
      SUBROUTINE PLOTRD(SEQ,IDIM1P,MXSPAN,J1,J2,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,SPAN,IWRIT)
C   AUTHOR: RODGER STADEN
      REAL SEQ(IDIM1P)
      INTEGER SPAN
C   length forward and back
      LF=SPAN/2
      LB=1+SPAN/2
C   max score
      SCRMAX=1.
      SCRMIN=0.16
      I1INM1=1+MXSPAN/2
      J1P=J1+I1INM1
      J2P=J2+I1INM1
      XMIN=J1
      XMAX=J2
C   set ymax
      YMIN=SPAN*SCRMIN
      YMAX=SPAN*SCRMAX
C   do edge
      SUM=0.
      DO 90 I=J1P-LB,J1P-LB+SPAN
        SUM=SUM+SEQ(I)
90    CONTINUE
      CALL CLEARV
      CALL VECTOM
      CALL FRAME(MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
C   do rest
      IDONE=0
      XF=J1
      YF=SUM
      DO 100 I=J1P,J2P
        IDONE=IDONE+1
        SUM=SUM+SEQ(I+LF)-SEQ(I-LB)
        IF(MOD(I,IWRIT).EQ.0)THEN
          XT=I-I1INM1
          CALL LINE(XF,XT,YF,SUM,XMAX,XMIN,YMAX,YMIN,
     +    MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
          XF=XT
          YF=SUM
        END IF
100   CONTINUE
      CALL VT100M
      END
      SUBROUTINE FIND8(SEQ,IDIM1,STRING,IDIM2,INC,IMATCH)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDIM1),STRING(IDIM2)
      INTEGER PSEQ,PSTR
      INTEGER CTONUM
      EXTERNAL CTONUM
      PSEQ=1-1*INC
      PSTR=1
      IMATCH=0
100   CONTINUE
        PSEQ=PSEQ+1-PSTR
        PSEQ=PSEQ+INC-1
        PSTR=0
500     CONTINUE
          PSEQ=PSEQ+1
          IF(PSEQ.GT.IDIM1)RETURN
          PSTR=PSTR+1
          KSTRNG = CTONUM(STRING(PSTR))
          KSEQ = CTONUM(SEQ(PSEQ))
          IF((KSTRNG.NE.KSEQ).AND.(KSTRNG.NE.23)) GO TO 100
      IF(PSTR.LT.IDIM2)GO TO 500
      IMATCH=PSEQ-IDIM2+1
      END
      SUBROUTINE SQPFIT(SEQNCE,IDIM1,SEQ2,IDIM3I,ITOT,ITOTEL,ITOTID,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,KSTART,
     +IDEV,IDEVIN,FILE2,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,DIALOG)
C   AUTHOR: RODGER STADEN
      INTEGER DIALOG
      PARAMETER (MAXSTR = 50)
      CHARACTER HELPF*(*)
      CHARACTER SEQNCE(IDIM1),STRING(MAXSTR)
      CHARACTER SEQ2(IDIM3I),FILE2*(*)
      CHARACTER MATCH(MAXSTR)
      INTEGER ITOT(ITOTID),ITOTEL(ITOTID)
      INTEGER ANSTY
      CALL SHOWFU(KBOUT,'Find percentage matches')
      IDIM2 = 0
      IDIM2I = MAXSTR
      IDIM3 = IDIM3I
      IS = J1
      IE = J2
      ISS = 1
      ISE = 10
      CALL GETPAR(18,2,IOK,ANSTY,IPR,
     +IPAR3,IPAR4,
     +IPAR5,IPAR6,IPAR7,IPAR8,IPAR9)
      IF(IOK.NE.0) RETURN
      PR = REAL(IPR)
5     CONTINUE
      IF(DIALOG.EQ.1) THEN
        CALL SQPFD1(SEQ2,IDIM3I,IDIM3,ANSTY,IDEVIN,FILE2,
     +  KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
        IF(IOK.NE.0) RETURN
      END IF
10    CONTINUE
      CALL SQPFD2(SEQ2,IDIM3,MATCH,STRING,
     +J1,J2,KSTART,ISS,ISE,IS,IE,IDIM2I,IDIM2,MAXSTR,PR,ANSTY,MINP,
     +KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
      CALL SQPF6(SEQNCE,IDIM1,STRING,IDIM2,ITOT,ITOTEL,ITOTID,
     +IS,IE,MINP,ITOTP,KSTART,J1,J2,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,IOK)
      IF(IOK.EQ.2)THEN
        WRITE(KBOUT,1017)ITOTID
1017    FORMAT(/,' more than',I6,' matches.',
     +  ' try changing percentage or region'/)
        GO TO 10
      END IF
      IF(IOK.NE.0) RETURN
      CALL SQPF7(SEQNCE,IDIM1,STRING,IDIM2,MATCH,ITOT,ITOTEL,ITOTID,
     +ITOTP,KSTART,J1,J2,ISS,PR,IDEV,
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
      IF(IOK.NE.0) RETURN
      GO TO 10
      END
      SUBROUTINE SQPFD2(SEQ2,IDIM3,MATCH,STRING,
     +J1,J2,KSTART,ISS,ISE,IS,IE,IDIM2I,IDIM2,MAXSTR,PR,ANSTY,MINP,
     +KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
C   AUTHOR: RODGER STADEN
      CHARACTER HELPF*(*)
      CHARACTER STRING(MAXSTR)
      CHARACTER SEQ2(IDIM3)
      CHARACTER MATCH(MAXSTR)
      INTEGER ANSC,ANSTY
      IOK = 1
      CALL YESNO(ANSC,'Keep picture',
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      IF(ANSC.LT.0)RETURN
      IF(ANSC.EQ.1)CALL CLEARG
      IF(ANSTY.EQ.1) THEN
        CALL SQPF2(SEQ2,IDIM3,STRING,IDIM2I,IDIM2,ISS,ISE,
     +  KBIN,KBOUT,
     +  IHELPS,IHELPE,HELPF,IDEVH,IOK)
        IF(IOK.NE.0) RETURN
      END IF
      IF(ANSTY.EQ.0) THEN
        CALL SQPF3(STRING,MATCH,IDIM2I,IDIM2,
     +  KBIN,KBOUT,
     +  IHELPS,IHELPE,HELPF,IDEVH,IOK)
        IF(IOK.NE.0) RETURN
      END IF
C      CALL SQPF4(KBIN,KBOUT,J1,J2,IS,IE,
C     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
C      IF(IOK.NE.0) RETURN
      CALL SQPF5(IDIM2,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,PR,MINP,IOK)
C      IF(IOK.NE.0) RETURN
      RETURN
      END
      SUBROUTINE SQPF6(SEQNCE,IDIM1,STRING,IDIM2,ITOT,ITOTEL,ITOTID,
     +IS,IE,MINP,ITOTP,KSTART,J1,J2,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,IOK)
      CHARACTER SEQNCE(IDIM1),STRING(IDIM2)
      INTEGER ITOT(ITOTID),ITOTEL(ITOTID)
      IOK = 1
      CALL FILLI(ITOT,ITOTID,0)
      CALL FILLI(ITOTEL,ITOTID,0)
      CALL SQFIT7(SEQNCE,IDIM1,STRING,IDIM2,ITOT,ITOTEL,ITOTID,
     +IS,IE,MINP,ITOTP,KSTART)
      IF(ITOTP.GT.ITOTID)THEN
        IOK = 2
        RETURN
      END IF
      IF(ITOTP.GT.0)THEN
        XMIN=J1
        XMAX=J2
        YMIN=0.
        YMAX=IDIM2
        CALL CLEARV
        CALL VECTOM
        CALL FRAME(MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
        DO 203 I=1,ITOTP
          X=ITOTEL(I)
          Y=ITOT(I)
          CALL LINE(X,X,YMIN,Y,XMAX,XMIN,YMAX,YMIN,
     +    MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
203     CONTINUE
      END IF
      CALL VT100M
      IOK = 0
      END
      SUBROUTINE SEPFIT(SEQNCE,IDIM1,SEQ2,IDIM3I,ITOT,ITOTEL,ITOTID,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,KSTART,
     +IDEV,IDEVIN,FILE2,KBIN,KBOUT,MATRIX,IDM,
     +IHELPS,IHELPE,HELPF,IDEVH,DIALOG)
C   AUTHOR: RODGER STADEN
      INTEGER DIALOG
      PARAMETER (MAXSTR = 50)
      CHARACTER HELPF*(*)
      CHARACTER SEQNCE(IDIM1),STRING(MAXSTR)
      CHARACTER SEQ2(IDIM3I),FILE2*(*)
      CHARACTER MATCH(MAXSTR)
      INTEGER ITOT(ITOTID),ITOTEL(ITOTID),MATRIX(IDM,IDM)
      INTEGER ANSTY,SMIN,SMAX
      CALL SHOWFU(KBOUT,'Find matches using a score matrix')
      MINP = 0
      IDIM2 = 0
      IDIM2I = MAXSTR
      IDIM3 = IDIM3I
      IS = J1
      IE = J2
      ISS = 1
      ISE = 10
      CALL GETPAR(19,1,IOK,ANSTY,
     +IPAR2,IPAR3,IPAR4,
     +IPAR5,IPAR6,IPAR7,IPAR8,IPAR9)
      IF(IOK.NE.0) RETURN
5     CONTINUE
      IF(DIALOG.EQ.1) THEN
        CALL SQPFD1(SEQ2,IDIM3I,IDIM3,ANSTY,IDEVIN,FILE2,
     +  KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
        IF(IOK.NE.0) RETURN
      END IF
10    CONTINUE
      CALL SEPFD2(SEQ2,IDIM3,MATCH,STRING,
     +J1,J2,KSTART,ISS,ISE,IS,IE,IDIM2I,IDIM2,MAXSTR,ANSTY,MINP,
     +KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,MATRIX,IDM,
     +SMIN,SMAX,IOK)
      IF(IOK.NE.0) RETURN
      CALL SEPF6(SEQNCE,IDIM1,STRING,IDIM2,ITOT,ITOTEL,ITOTID,
     +IS,IE,MINP,ITOTP,KSTART,J1,J2,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,MATRIX,IDM,
     +SMIN,SMAX,IOK)
      IF(IOK.EQ.2)THEN
        WRITE(KBOUT,1017)ITOTID
1017    FORMAT(/,' more than',I6,' matches.',
     +  ' try changing score or region'/)
        GO TO 10
      END IF
      IF(IOK.NE.0) RETURN
      CALL SEPF7(SEQNCE,IDIM1,STRING,IDIM2,MATCH,ITOT,ITOTEL,ITOTID,
     +ITOTP,MINP,KSTART,J1,J2,ISS,IDEV,
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
      IF(IOK.NE.0) RETURN
      GO TO 10
      END
      SUBROUTINE SEPFD2(SEQ2,IDIM3,MATCH,STRING,
     +J1,J2,KSTART,ISS,ISE,IS,IE,IDIM2I,IDIM2,MAXSTR,ANSTY,MINP,
     +KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,MATRIX,IDM,
     +SMIN,SMAX,IOK)
C   AUTHOR: RODGER STADEN
      CHARACTER HELPF*(*)
      CHARACTER STRING(MAXSTR)
      CHARACTER SEQ2(IDIM3)
      CHARACTER MATCH(MAXSTR)
      INTEGER ANSC,ANSTY,MATRIX(IDM,IDM),SMIN,SMAX
      IOK = 1
      CALL YESNO(ANSC,'Keep picture',
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      IF(ANSC.LT.0)RETURN
      IF(ANSC.EQ.1)CALL CLEARG
      IF(ANSTY.EQ.1) THEN
        CALL SEPF2(SEQ2,IDIM3,STRING,IDIM2I,IDIM2,ISS,ISE,
     +  KBIN,KBOUT,
     +  IHELPS,IHELPE,HELPF,IDEVH,IOK)
        IF(IOK.NE.0) RETURN
      END IF
      IF(ANSTY.EQ.0) THEN
        CALL SQPF3(STRING,MATCH,IDIM2I,IDIM2,
     +  KBIN,KBOUT,
     +  IHELPS,IHELPE,HELPF,IDEVH,IOK)
        IF(IOK.NE.0) RETURN
      END IF
C      CALL SEPF4(KBIN,KBOUT,J1,J2,IS,IE,
C     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
C      IF(IOK.NE.0) RETURN
      CALL SEPF5(IDIM2,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,MINP,MATRIX,IDM,
     +SMIN,SMAX,STRING,IOK)
C      IF(IOK.NE.0) RETURN
      RETURN
      END
      SUBROUTINE SEPF2(SEQ2,IDIM3,STRING,IDIM2I,IDIM2,I1,I2,
     +KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      CHARACTER HELPF*(*)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ2(IDIM3),STRING(IDIM2I)
      IOK = 1
      MININ = 1
      MAXIN = IDIM3
      WRITE(KBOUT,1000)
1000  FORMAT(' Define string ends')
      CALL GETINT(MININ,MAXIN,I1,'Start',IVAL,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
      IF(IVAL.NE.I1) THEN
        I2 = IVAL + 10
      END IF
      I1 = IVAL
      MININ = I1 + 1
      MAXIN = I1 + IDIM2I - 1
      CALL GETINT(MININ,MAXIN,I2,'End',IVAL,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
      I2 = IVAL
      IDIM2 =I2 - I1 + 1
      CALL SQCOPY(SEQ2(I1),STRING,IDIM2)
      WRITE(KBOUT,1001)(STRING(K),K=1,IDIM2)
1001  FORMAT(' string=',50A1)
      IOK = 0
      END
      SUBROUTINE SEPF5(IDIM2,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,MINP,MATRIX,IDM,
     +SMIN,SMAX,STRING,IOK)
      CHARACTER HELPF*(*)
      CHARACTER STRING(IDIM2)
      INTEGER MATRIX(IDM,IDM),SMIN,SMAX,VALUE
      IOK = 1
      CALL GTSCR(STRING,IDIM2,MATRIX,IDM,SMIN,SMAX)
      WRITE(KBOUT,1000)SMIN,SMAX
1000  FORMAT(' Minimum score=',I6,' Maximum score=',I6)
      MININ = SMIN
      MAXIN = SMAX
      IF(MINP.EQ.0) MINP = SMAX
      CALL GETINT(MININ,MAXIN,MINP,'Score',VALUE,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
      MINP = VALUE
      IOK = 0
      END
      SUBROUTINE SEPF6(SEQNCE,IDIM1,STRING,IDIM2,ITOT,ITOTEL,ITOTID,
     +IS,IE,MINP,ITOTP,KSTART,J1,J2,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,MATRIX,IDM,
     +SMIN,SMAX,IOK)
      CHARACTER SEQNCE(IDIM1),STRING(IDIM2)
      INTEGER ITOT(ITOTID),ITOTEL(ITOTID),MATRIX(IDM,IDM)
      INTEGER SMIN,SMAX
      IOK = 1
      CALL FILLI(ITOT,ITOTID,0)
      CALL FILLI(ITOTEL,ITOTID,0)
      CALL SPFIT(SEQNCE,IDIM1,STRING,IDIM2,ITOT,ITOTEL,ITOTID,
     +IS,IE,MINP,ITOTP,MATRIX,IDM,KSTART)
      IF(ITOTP.GT.ITOTID)THEN
        IOK = 2
        RETURN
      END IF
      IF(ITOTP.GT.0)THEN
        XMIN = J1
        XMAX = J2
        YMIN = SMIN
        YMAX = SMAX
        CALL CLEARV
        CALL VECTOM
        CALL FRAME(MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
        DO 203 I=1,ITOTP
          X=ITOTEL(I)
          Y=ITOT(I)
          CALL LINE(X,X,YMIN,Y,XMAX,XMIN,YMAX,YMIN,
     +    MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
203     CONTINUE
      END IF
      CALL VT100M
      IOK = 0
      END
C      SQFITP
      SUBROUTINE SQFITP(SEQ,IDIM1,STRING,IDIM2,ITOT,ITOTEL,ITOTID,
     +IS,IE,MINP,ITOTP,KSTART)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDIM1),STRING(IDIM2)
      INTEGER ITOT(ITOTID),ITOTEL(ITOTID)
      IDIF=(IE-IS+2)-IDIM2
      IPSEQ=IS-KSTART+1
      ITOTP=0
      DO 200 I=1,IDIF
        NTOT=0
        IP=IPSEQ
        DO 100 J=1,IDIM2
          IF(SEQ(IP).EQ.STRING(J))THEN
            NTOT=NTOT+1
          ELSE IF (STRING(J).EQ.'-')THEN
            NTOT=NTOT+1
          END IF
          IP=IP+1
100     CONTINUE
        IF(NTOT.GE.MINP)THEN
          ITOTP=ITOTP+1
          IF(ITOTP.GT.ITOTID)RETURN
          ITOT(ITOTP)=NTOT
          ITOTEL(ITOTP)=IP-IDIM2+KSTART-1
        END IF
        IPSEQ=IPSEQ+1
200   CONTINUE
      END
C      SQFIT7
      SUBROUTINE SQFIT7(SEQ,IDIM1,STRING,IDIM2,ITOT,ITOTEL,ITOTID
     1,IS,IE,MINS,ITOTP,KSTART)
C   AUTHOR: RODGER STADEN
C   COMPARE POINTERS, NOT ACTUAL CHARACTERS
      CHARACTER SEQ(IDIM1),STRING(IDIM2)
      INTEGER ITOT(ITOTID),ITOTEL(ITOTID)
      INTEGER CTONUM
      EXTERNAL CTONUM
      IDIF=(IE-IS+2)-IDIM2
      IPSEQ=IS-KSTART+1
      ITOTP=0
      DO 200 I=1,IDIF
        NTOT = 0
        IP=IPSEQ
        DO 100 J=1,IDIM2
          IF(STRING(J).EQ.'-')THEN
            NTOT = NTOT + 1
          ELSE
            K = CTONUM(STRING(J))
            IF(K.EQ.CTONUM(SEQ(IP)))NTOT = NTOT + 1
          END IF
          IP=IP+1
100     CONTINUE
        IF(NTOT.GE.MINS)THEN
          ITOTP=ITOTP+1
          IF(ITOTP.GT.ITOTID)RETURN
          ITOT(ITOTP)=NTOT
          ITOTEL(ITOTP)=IP-IDIM2+KSTART-1
        END IF
        IPSEQ=IPSEQ+1
200   CONTINUE
      END
