C   9-11-90 Large number of changes relating to use of file of
C           file names and removal of radio
C  3-7-91 Removed annotation "filename" from pattern files
C 18-7-91 Added titles to pattern files
C 2-3-92 set filnam = ' ' for calls to  openf1
      SUBROUTINE GETMF(KBIN,KBOUT,STRING,MAXSTR,ISTRNG,
     +LENGTH,MAXMOT,CLASS,RELMOT,RANGES,RANGEL,RANGET,RANGEM,
     +STRNGS,NMOT,WEIGHT,MAXWTS,CUTOFF,IDEV,WTSTR,JDEV,IOK,
     +RELEND,IDSEQ,IDEVSV,IDM,COMBIN,MAXCLS,MATRIX,MAT1,
     +PMINT,PMAXT,PROBT,EXPTT,CHRSET,
     +IHELPS,IHELPE,HELPF,IDEVH,KEYNS,NAMSAV,FILNAM,IPROB,TITLE)
      INTEGER LENGTH(MAXMOT),CLASS(MAXMOT),RELMOT(MAXMOT)
      INTEGER RANGES(MAXMOT),RANGEL(MAXMOT),STRNGS(MAXMOT)
      INTEGER WTSTR(MAXMOT),RANGET(MAXMOT),RANGEM(MAXMOT)
      INTEGER RELEND(MAXMOT),MATRIX(IDM,IDM),MAT1(IDM,IDM)
      CHARACTER STRING(MAXSTR),FILNAM*(*),HELPF*(*)
      REAL WEIGHT(MAXWTS),CUTOFF(MAXMOT)
      CHARACTER COMBIN(MAXMOT),TCLASS,CHRSET(IDM)
      CHARACTER*(*) NAMSAV(MAXMOT),KEYNS(MAXMOT),TITLE
      EXTERNAL PSCORE
C   GETS PATTERN DEFINITIONS IN TERMS OF MOTIFS
      PMINT = 1.0
      PMAXT = 1.0
      PROBT = 1.0
      EXPTS = 0.0
      PROBS = 0.0
      PMINS = 0.0
      PMAXS = 0.0
      EXPTT = 1.0
      IOK = 1
      DO 10 I=1,MAXMOT
        RELEND(I) = 5
        COMBIN(I) = 'A'
10    CONTINUE
      RANGES(1) = 0
      RANGEL(1) = IDSEQ
      IREL = 0
C   COUNT MOTIFS
      NMOT = 0
      MOTIF = 0
C   SET POINTER TO SEARCH STRINGS ARRAY
      ISTRNG = 1
C   SET POINTER TO WEIGHT ARRAY
      IWT = 1
C get title
      READ(JDEV,1000,ERR=901,END=901)TITLE
 1000 FORMAT(A)
100   CONTINUE
      CALL GETCLS(JDEV,KBOUT,ICLASS,TCLASS,KEYNS(MOTIF+1))
1001  FORMAT(I7)
      IF(ICLASS.LT.0) GO TO 901
      IF(ICLASS.GT.MAXCLS)GO TO 901
      IF(ICLASS.EQ.0)GO TO 900
      IF((TCLASS.EQ.'O').AND.(NMOT.LT.1))THEN
        WRITE(KBOUT,*)'CANNOT OR FIRST MOTIF'
        GO TO 901
      END IF
      IF((TCLASS.EQ.'N').AND.(NMOT.LT.1))THEN
        WRITE(KBOUT,*)'CANNOT NOT FIRST MOTIF'
        GO TO 901
      END IF
      IF((TCLASS.EQ.'O').AND.(COMBIN(MOTIF).EQ.'N'))THEN
        WRITE(KBOUT,*)'CANNOT OR WITH NOTTED MOTIF'
        GO TO 901
      END IF
      NMOT = NMOT + 1
      MOTIF = MOTIF + 1
      IF(NMOT.GT.MAXMOT)THEN
        WRITE(KBOUT,*)'MAXIMUM NUMBER OF MOTIFS EXCEEDED'
        GO TO 901
      END IF
      CLASS(MOTIF) = ICLASS
      COMBIN(MOTIF) = TCLASS
C  IF NOT THE FIRST MOTIF, AND AN ANDED MOTIF OR THE FIRST IN A LIST OF ORS
C  GET ITS RANGE ETC
      IF((MOTIF.GT.1).AND.(COMBIN(MOTIF).NE.'O'))THEN
        READ(JDEV,1001,ERR=901)IREL
        IF(IREL.LT.0)GO TO 901
        IF(IREL.LT.1)GO TO 901
        IF(IREL.GT.MOTIF-1)THEN
          WRITE(KBOUT,*)'CAN ONLY REFER BACK'
          GO TO 901
        END IF
        IF(COMBIN(IREL).NE.'A')THEN
          WRITE(KBOUT,*)'CAN ONLY REFER TO AN ANDED MOTIF'
          GO TO 901
        END IF
        RELMOT(MOTIF) = IREL
        READ(JDEV,1001,ERR=901)ID
        READ(JDEV,1001,ERR=901)IR
        IF(IR.LT.0)GO TO 901
        RANGES(MOTIF) = ID - 1
        RANGEL(MOTIF) = IR
      ELSE IF(COMBIN(MOTIF).EQ.'O')THEN
C  NEED TO SET RANGES TO THOSE OF THE FIRST IN A SET OF ORED MOTIFS
C  SET TO THOSE OF THE PREVIOUS MOTIF BECAUSE IT MUST BE THE SAME
        RANGES(MOTIF) = RANGES(MOTIF-1)
        RANGEL(MOTIF) = RANGEL(MOTIF-1)
        RELEND(MOTIF) = RELEND(MOTIF-1)
        RELMOT(MOTIF) = IREL
      END IF
      XRAN = 1.0
C  NOW GET DETAILS SPECIFIC TO EACH CLASS OF MOTIF
      CALL GETMC(KBIN,KBOUT,STRING,MAXSTR,ISTRNG,
     +LENGTH,MAXMOT,CLASS,RELMOT,RANGES,RANGEL,RANGET,RANGEM,
     +STRNGS,NMOT,WEIGHT,MAXWTS,CUTOFF,IDEV,WTSTR,JDEV,IOK,
     +RELEND,IDSEQ,IDEVSV,IDM,COMBIN,MAXCLS,MATRIX,MAT1,
     +PMINT,PMAXT,PROBT,EXPTT,EXPTS,PROBS,PMINS,PMAXS,CHRSET,
     +IHELPS,IHELPE,HELPF,IDEVH,MOTIF,IWT,NAMSAV,FILNAM,IPROB)
      IF(IOK.EQ.0) GO TO 100
901   CONTINUE
      WRITE(KBOUT,*)' Error in pattern definition'
      IOK = 1
      CLOSE(UNIT=JDEV)
      RETURN
900   CONTINUE
      EXPTT = EXPTT * EXPTS
      PROBT = PROBT * PROBS
      PMINT = PMINT * PMINS
      PMAXT = PMAXT * PMAXS
      CLOSE(UNIT=JDEV)
      DO 899 I = 2,NMOT
        IF(CLASS(I).EQ.5) THEN
          RANGEL(I) = RANGEL(I) + 1
        ELSE
          RANGEL(I) = RANGEL(I) + LENGTH(I)
        END IF
899   CONTINUE
C  RETURN STRING LENGTH
      MAXSTR = ISTRNG - 1
      IOK = 0
      END
      SUBROUTINE GETMC(KBIN,KBOUT,STRING,MAXSTR,ISTRNG,
     +LENGTH,MAXMOT,CLASS,RELMOT,RANGES,RANGEL,RANGET,RANGEM,
     +STRNGS,NMOT,WEIGHT,MAXWTS,CUTOFF,IDEV,WTSTR,JDEV,IOK,
     +RELEND,IDSEQ,IDEVSV,IDM,COMBIN,MAXCLS,MATRIX,MAT1,
     +PMINT,PMAXT,PROBT,EXPTT,EXPTS,PROBS,PMINS,PMAXS,CHRSET,
     +IHELPS,IHELPE,HELPF,IDEVH,MOTIF,IWT,NAMSAV,FILNAM,IPROB)
      INTEGER LENGTH(MAXMOT),CLASS(MAXMOT),RELMOT(MAXMOT)
      INTEGER RANGES(MAXMOT),RANGEL(MAXMOT),STRNGS(MAXMOT)
      INTEGER WTSTR(MAXMOT),RANGET(MAXMOT),RANGEM(MAXMOT)
      INTEGER RELEND(MAXMOT),MATRIX(IDM,IDM),MAT1(IDM,IDM)
      CHARACTER STRING(MAXSTR),FILNAM*(*),HELPF*(*)
      REAL WEIGHT(MAXWTS),CUTOFF(MAXMOT)
      CHARACTER COMBIN(MAXMOT),CHRSET(IDM)
      CHARACTER*(*) NAMSAV(MAXMOT)
      EXTERNAL PSCORE
      XRAN = 1.0
      PMIN = 1.
      PMAX = 1.
      PROB = 1.
C  NOW GET DETAILS SPECIFIC TO EACH CLASS OF MOTIF
      IF(CLASS(MOTIF).EQ.1)THEN
        MXSTR = MAXSTR - ISTRNG + 1
        CALL GETMT1(STRING(ISTRNG),MXSTR,LENGTH(MOTIF),KBIN,KBOUT,
     +  IOK,JDEV,
     +  IHELPS,IHELPE,HELPF,IDEVH)
        IF(IOK.NE.0)GO TO 901
        IF(IPROB.EQ.0) THEN
          CALL GETP(CLASS(MOTIF),STRING(ISTRNG),
     +    LENGTH(MOTIF),IDM,MATRIX,MAT1,WEIGHT(IWT))
          SCMIN  = LENGTH(MOTIF)
          PROB = PSCORE(SCMIN)
          PMIN = PROB
          PMAX = PROB
        END IF
        STRNGS(MOTIF) = ISTRNG
        ISTRNG = ISTRNG + LENGTH(MOTIF)
        CUTOFF(MOTIF) = LENGTH(MOTIF)
      ELSE IF(CLASS(MOTIF).EQ.2)THEN
        MXSTR = MAXSTR - ISTRNG + 1
        CALL GETMT2(STRING(ISTRNG),MXSTR,LENGTH(MOTIF),
     +  CUTOFF(MOTIF),KBIN,KBOUT,IOK,JDEV,
     +  IHELPS,IHELPE,HELPF,IDEVH)
        IF(IOK.NE.0)GO TO 901
        IF(IPROB.EQ.0) THEN
          CALL GETP(CLASS(MOTIF),STRING(ISTRNG),
     +    LENGTH(MOTIF),IDM,MATRIX,MAT1,WEIGHT(IWT))
          SCMIN = CUTOFF(MOTIF)
          SCMAX = LENGTH(MOTIF)
          PROB = PSCORE(SCMIN)
          PMIN = PROB
          PMAX = PSCORE(SCMAX)
        END IF
        STRNGS(MOTIF) = ISTRNG
        ISTRNG = ISTRNG + LENGTH(MOTIF)
      ELSE IF(CLASS(MOTIF).EQ.3)THEN
        MXSTR = MAXSTR - ISTRNG + 1
        CALL GETMT3(STRING(ISTRNG),MXSTR,LENGTH(MOTIF),
     +  CUTOFF(MOTIF),MATRIX,IDM,KBIN,KBOUT,IOK,JDEV,
     +  IHELPS,IHELPE,HELPF,IDEVH)
        IF(IOK.NE.0)GO TO 901
        IF(IPROB.EQ.0) THEN
          CALL GETP(CLASS(MOTIF),STRING(ISTRNG),
     +    LENGTH(MOTIF),IDM,MATRIX,MAT1,WEIGHT(IWT))
          SCMIN = CUTOFF(MOTIF)
          SCMAX = LENGTH(MOTIF) * 15.7
          PROB = PSCORE(SCMIN)
          PMAX = PSCORE(SCMAX)
          PMIN = PROB
        END IF
        STRNGS(MOTIF) = ISTRNG
        ISTRNG = ISTRNG + LENGTH(MOTIF)
      ELSE IF(CLASS(MOTIF).EQ.4)THEN
        MXWT = MAXWTS - IWT + 1
        CALL GETMT4(WEIGHT(IWT),MXWT,LENGTH(MOTIF),CUTOFF(MOTIF),
     +  SCMAX,IDEV,KBIN,KBOUT,IOK,JDEV,FILNAM,IDM,
     +  IHELPS,IHELPE,HELPF,IDEVH,IPROB)
        IF(IOK.NE.0)GO TO 901
        IF(IPROB.EQ.0) THEN
          CALL GETP(CLASS(MOTIF),STRING(ISTRNG),
     +    LENGTH(MOTIF),IDM,MATRIX,MAT1,WEIGHT(IWT))
          SCMIN = CUTOFF(MOTIF)
          PROB = PSCORE(SCMIN)
          PMAX = PSCORE(SCMAX)
          PMIN = PROB
        END IF
        WTSTR(MOTIF) = IWT
        IWT = IWT + LENGTH(MOTIF)*IDM
        NAMSAV(MOTIF) = FILNAM
      ELSE IF(CLASS(MOTIF).EQ.5)THEN
        CALL GETMT8(RANGET(MOTIF),RANGEM(MOTIF),LENGTH(MOTIF),
     +  CUTOFF(MOTIF),KBIN,KBOUT,JDEV,IOK,
     +  IHELPS,IHELPE,HELPF,IDEVH)
        IF(IOK.NE.0)GO TO 901
        IF(IPROB.EQ.0) THEN
          CALL GETP(CLASS(MOTIF),STRING(ISTRNG),
     +    LENGTH(MOTIF),IDM,MATRIX,MAT1,WEIGHT(IWT))
          SCMIN = CUTOFF(MOTIF)
          SCMAX = LENGTH(MOTIF) * 15.7
          PROB = PSCORE(SCMIN)
          PMAX = PSCORE(SCMAX)
          PMIN = PROB
        END IF
        XRAN = ABS(RANGEM(MOTIF))-ABS(RANGET(MOTIF))+1
      ELSE IF(CLASS(MOTIF).EQ.6)THEN
        MXSTR = MAXSTR - ISTRNG + 1
        MXWT = MAXWTS - IWT + 1
        FILNAM = ' '
        CALL GETMT6(STRING(ISTRNG),MXSTR,LENGTH(MOTIF),WEIGHT(IWT),
     +  MXWT,CUTOFF(MOTIF),KBIN,KBOUT,JDEV,IDEV,IDM,
     +  FILNAM,IOK,
     +  IHELPS,IHELPE,HELPF,IDEVH,IPROB)
        IF(IOK.NE.0)GO TO 901
        IF(IPROB.EQ.0) THEN
          CALL GETP(CLASS(MOTIF),STRING(ISTRNG),
     +    LENGTH(MOTIF),IDM,MATRIX,MAT1,WEIGHT(IWT))
          SCMIN = CUTOFF(MOTIF)
          SCMAX = SCMIN
          PROB = PSCORE(SCMIN)
          PMAX = PSCORE(SCMAX)
          PMIN = PROB
        END IF
        WTSTR(MOTIF) = IWT
        IWT = IWT + LENGTH(MOTIF)*IDM
        IF(FILNAM.NE.' ') NAMSAV(MOTIF) = FILNAM
      END IF
C  GET RANGE OF POSITIONS FOR PROBABILITY CALC
      LRANGE = RANGEL(MOTIF) + 1
      IF(COMBIN(MOTIF).EQ.'A')THEN
        IF(EXPTS.GT.0.0)THEN
          EXPTT = EXPTT * EXPTS
          PROBT = PROBT * PROBS
          PMINT = PMINT * PMINS
          PMAXT = PMAXT * PMAXS
        END IF
        EXPTS = LRANGE * XRAN * PROB
        PROBS = PROB
        PMINS = PMIN
        PMAXS = PMAX
      ELSE IF(COMBIN(MOTIF).EQ.'N')THEN
        IF(EXPTS.GT.0.0)THEN
          EXPTT = EXPTT * EXPTS
          PROBT = PROBT * PROBS
          PMINT = PMINT * PMINS
          PMAXT = PMAXT * PMAXS
        END IF
        PMIN = 1.0 - PMIN
        PMAX = 1.0 - PMAX
        PROB = 1.0 - PROB
        EXPTS = PROB ** (LRANGE * XRAN)
        PROBS = PROB
        PMINS = PMIN
        PMAXS = PMAX
      ELSE IF(COMBIN(MOTIF).EQ.'O')THEN
        EXPTS = EXPTS + LRANGE * XRAN * PROB
        PROBS = PROBS + PROB
        PMINS = PMINS + PMIN
        PMAXS = PMAXS + PMAX
      END IF
      IF(IPROB.EQ.0) CALL WRTSCR(SCMIN,PROB,KBOUT)
      IOK = 0
      RETURN
901   CONTINUE
      IOK = 1
      END
C*********************************************************************
      SUBROUTINE DESSIG(
     +            KBOUT,STRING,MAXSTR,
     +            LENGTH,CLASS,RELMOT,RANGES,RANGEL,
     +            RANGET,RANGEM,
     +            STRNGS,NMOT,WEIGHT,MAXWTS,CUTOFF,
     +            WTSTR,RELEND,COMBIN,KEYNS,TITLE)
      CHARACTER STRING(MAXSTR)
      INTEGER LENGTH(NMOT),CLASS(NMOT),RELMOT(NMOT),RELEND(NMOT)
      INTEGER RANGES(NMOT),RANGEL(NMOT),RANGET(NMOT),RANGEM(NMOT)
      INTEGER WTSTR(NMOT),STRNGS(NMOT)
      REAL WEIGHT(MAXWTS),CUTOFF(NMOT)
      CHARACTER COMBIN(NMOT)
      CHARACTER*(*) KEYNS(NMOT),TITLE
C
C
C  DESCRIBE THE SIGNAL
C
      WRITE(KBOUT,1000)
1000  FORMAT(/' Pattern description',/)
      WRITE(KBOUT,1006)TITLE
 1006 FORMAT(' ',A)
      DO 100 I = 1,NMOT
        WRITE(KBOUT,1001)I,KEYNS(I),CLASS(I)
1001    FORMAT(' Motif ',I2,' named ',A8,' is of class ',I4)
C
        IF(CLASS(I).EQ.1)THEN
          WRITE(KBOUT,1002)
     +    (STRING(K),K=STRNGS(I),STRNGS(I)+LENGTH(I)-1)
1002      FORMAT(' Which is an exact match to the string',
     +    /,(' ',50A1))
          IF(I.NE.1)
     +    WRITE(KBOUT,1008)RANGES(I)+1,
     +    RANGES(I)+RANGEL(I)-LENGTH(I)+1,RELMOT(I)
1008      FORMAT(' and the N-terminal residue can take positions',
     +            I7,' to ',I7,/,
     +           ' relative to the N-terminal end of motif',I4)
        ELSE IF(CLASS(I).EQ.2)THEN
          WRITE(KBOUT,1003)CUTOFF(I),
     +    (STRING(K),K=STRNGS(I),STRNGS(I)+LENGTH(I)-1)
1003      FORMAT(' which is a match of score ',F6.0,
     +            ' to the string',/,(' ',50A1))
          IF(I.NE.1)
     +    WRITE(KBOUT,1008)RANGES(I)+1,
     +    RANGES(I)+RANGEL(I)-LENGTH(I)+1,RELMOT(I)
        ELSE IF(CLASS(I).EQ.3)THEN
          WRITE(KBOUT,1003)CUTOFF(I),
     +    (STRING(K),K=STRNGS(I),STRNGS(I)+LENGTH(I)-1)
          IF(I.NE.1)
     +    WRITE(KBOUT,1008)RANGES(I)+1,
     +    RANGES(I)+RANGEL(I)-LENGTH(I)+1,RELMOT(I)
        ELSE IF(CLASS(I).EQ.4)THEN
          WRITE(KBOUT,1004)CUTOFF(I)
1004      FORMAT(' Which is a match to a weight matrix with score',
     +             F8.3)
          IF(I.NE.1)
     +    WRITE(KBOUT,1008)RANGES(I)+1,
     +    RANGES(I)+RANGEL(I)-LENGTH(I)+1,RELMOT(I)
        ELSE IF(CLASS(I).EQ.5)THEN
          WRITE(KBOUT,1014)LENGTH(I),CUTOFF(I)
1014      FORMAT(' Which is a repeat with repeat length',I5,
     +           ' and score ',F6.0)
          WRITE(KBOUT,1015)RANGET(I)-LENGTH(I)-1,RANGEM(I)-LENGTH(I)-1
1015      FORMAT(' The loop-out can have sizes ',I6,' to ',I6)
          IF(I.NE.1)
     +    WRITE(KBOUT,1008)RANGES(I)+1,
     +    RANGES(I)+RANGEL(I),RELMOT(I)
        ELSE IF(CLASS(I).EQ.6)THEN
          WRITE(KBOUT,1005)CUTOFF(I)
1005      FORMAT(' Which is membership of a set with score',F8.3)
        END IF
        IF(COMBIN(I).EQ.'O')WRITE(KBOUT,1010)
1010    FORMAT(' It is orred with the previous motif.')
        IF(COMBIN(I).EQ.'N')WRITE(KBOUT,1012)
1012    FORMAT(' It is notted with the previous motif.')
        IF((COMBIN(I).EQ.'A').AND.(I.GT.1))WRITE(KBOUT,1009)
1009    FORMAT(' It is anded with the previous motif.')
100   CONTINUE
      END
C*********************************************************************
      SUBROUTINE SAVSIG(
     +            IDEV,STRING,MAXSTR,
     +            LENGTH,CLASS,RELMOT,RANGES,RANGEL,
     +            RANGET,RANGEM,
     +            STRNGS,NMOT,WEIGHT,MAXWTS,CUTOFF,
     +            WTSTR,RELEND,NAMSAV,COMBIN,KEYNS,IDEVW,FILET,
     +KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,CHRSET,IDM,TITLEP)
C 18-7-91 Added pattern title
      CHARACTER STRING(MAXSTR),FILET*(*)
      INTEGER LENGTH(NMOT),CLASS(NMOT),RELMOT(NMOT),RELEND(NMOT)
      INTEGER RANGES(NMOT),RANGEL(NMOT),RANGET(NMOT),RANGEM(NMOT)
      INTEGER WTSTR(NMOT),STRNGS(NMOT)
      REAL WEIGHT(MAXWTS),CUTOFF(NMOT)
      CHARACTER COMBIN(NMOT),SCLASS*10,TITLE(60),NEWT(60)
      CHARACTER HELPF*(*),CHRSET(IDM)
      CHARACTER*(*) KEYNS(NMOT)
      CHARACTER*(*) NAMSAV(NMOT),TITLEP
      EXTERNAL NOTIRL
C
C
C  SAVE THE SIGNAL
C
 1    CONTINUE
      LIN = 0
      CALL GTSTR('Pattern title',' ',TITLEP,LIN,KBOUT,KBIN,INFLAG)
      IF(INFLAG.EQ.1) THEN
        CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
        GO TO 1
      END IF
      IF(INFLAG.EQ.2) RETURN
      WRITE(IDEV,1000)TITLEP
 1000 FORMAT(' ',A)
      DO 100 I = 1,NMOT
        WRITE(SCLASS,1014)CLASS(I)
1014    FORMAT(I10)
        DO 10 K = 1,10
          IF(SCLASS(K:K).NE.' ')THEN
            J = 0
            DO 5 K1 = K,10
              J = J+1
              SCLASS(J:J) = SCLASS(K:K)
              SCLASS(K:K) = ' '
5           CONTINUE
          END IF
10      CONTINUE
        WRITE(IDEV,1001)COMBIN(I),SCLASS,KEYNS(I)
1001        FORMAT(' ',A,A,' ',A8,' Class ')
          IF((I.NE.1).AND.(COMBIN(I).NE.'O'))THEN
            WRITE(IDEV,1008)RELMOT(I)
1008        FORMAT(I7,'      Relative motif')
1003        FORMAT(I7,'      Relative start position')
1004        FORMAT(I7,'      Number of extra positions')
            WRITE(IDEV,1003)RANGES(I)+1
            WRITE(IDEV,1004)RANGEL(I)
          END IF
        IF(CLASS(I).EQ.1)THEN
          WRITE(IDEV,1002)
     +    (STRING(K),K=STRNGS(I),STRNGS(I)+LENGTH(I)-1)
1002      FORMAT((' ',50A1))
          WRITE(IDEV,1006)
1006      FORMAT(' @ End of string')
        ELSE IF(CLASS(I).EQ.2)THEN
          WRITE(IDEV,1002)
     +    (STRING(K),K=STRNGS(I),STRNGS(I)+LENGTH(I)-1)
          WRITE(IDEV,1006)
          WRITE(IDEV,1009)CUTOFF(I)
        ELSE IF(CLASS(I).EQ.3)THEN
          WRITE(IDEV,1002)
     +    (STRING(K),K=STRNGS(I),STRNGS(I)+LENGTH(I)-1)
          WRITE(IDEV,1006)
          WRITE(IDEV,1009)CUTOFF(I)
        ELSE IF(CLASS(I).EQ.4)THEN
          WRITE(IDEV,1005)NAMSAV(I)
1005      FORMAT(A)
1010      FORMAT(I7,'      Length')
1012      FORMAT(I7,'      Minimum loop')
1013      FORMAT(I7,'      Maximum loop')
1009      FORMAT(F10.5,'   Cutoff')
        ELSE IF(CLASS(I).EQ.5)THEN
          WRITE(IDEV,1010)LENGTH(I)
          WRITE(IDEV,1012)RANGET(I)-LENGTH(I)-1
          WRITE(IDEV,1013)RANGEM(I)-LENGTH(I)-1
          WRITE(IDEV,1009)CUTOFF(I)
        ELSE IF(CLASS(I).EQ.6)THEN
C          WRITE(*,*)NAMSAV(I)
          IF(NAMSAV(I)(1:11).EQ.'FILENOTUSED') THEN
            WRITE(KBOUT,1023)I
1023        FORMAT(' Motif',I3,
     +      ' needs a file name to store set as a weight matrix')
            FILET = ' '
            CALL OPENF1(IDEVW,FILET,1,IOK,KBIN,KBOUT,
     +      'Weight matrix file name',
     +      IHELPS,IHELPE,HELPF,IDEVH)
            IF(IOK.NE.0)RETURN
            NAMSAV(I) = FILET
            CALL FILLC(TITLE,60,' ')
20          CONTINUE
            WRITE(KBOUT,1026)
1026        FORMAT(' Weight matrix needs a title')
            L = 0
            CALL GETSTR('Title',TITLE,NEWT,60,L,KBOUT,KBIN,INFLAG)
            IF(L.LT.0) RETURN
            IF(INFLAG.EQ.1) THEN
              CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
            GO TO 20
            END IF
            IF(INFLAG.EQ.2) RETURN
            IF(L.GT.0)CALL SQCOPY(NEWT,TITLE,L)
            MIDDLE = 0
            TOP = LENGTH(I)
            CALL WRTSCN(TITLE,LENGTH(I),MIDDLE,CUTOFF(I),TOP,
     +      IDM,WEIGHT(WTSTR(I)),CHRSET,
     +      IDEVW)
          END IF
          WRITE(IDEV,1005)NAMSAV(I)
        END IF
100   CONTINUE
      END
      SUBROUTINE GETMT1(STRING,MAXSTR,LENGTH,KBIN,KBOUT,IOK,JDEV,
     +  IHELPS,IHELPE,HELPF,IDEVH)
      CHARACTER HELPF*(*)
      CHARACTER NEW(50),STRING(MAXSTR)
C  GETS DETAILS FOR MOTIF CLASS 1
      IOK = 1
      IF(KBIN.EQ.JDEV)THEN
10      CONTINUE
        LENGTH = 0
        CALL GETSTR('String',STRING,NEW,50,LENGTH,KBOUT,KBIN,INFLAG)
        IF(LENGTH.LT.1) RETURN
        IF(INFLAG.EQ.1) THEN
          CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
          GO TO 10
        END IF
        IF(INFLAG.EQ.2) RETURN
        CALL SQCOPY(NEW,STRING,LENGTH)
      ELSE
        LENGTH = MAXSTR
        CALL ARRFIL(JDEV,STRING,LENGTH,KBOUT)
        IF(LENGTH.LT.1)THEN
          WRITE(KBOUT,*)'ZERO LENGTH STRING'
          RETURN
        END IF
      END IF
      IOK = 0
      RETURN
      END
C*********************************************************************
      SUBROUTINE GETMT2(STRING,MAXSTR,LENGTH,CUTOFF,KBIN,KBOUT,IOK,JDEV,
     +  IHELPS,IHELPE,HELPF,IDEVH)
      CHARACTER HELPF*(*)
      CHARACTER NEW(50),STRING(MAXSTR)
      REAL MININ,MAXIN
C  GETS DETAILS FOR MOTIF CLASS 2
      IOK = 1
      IF(KBIN.EQ.JDEV)THEN
10      CONTINUE
        LENGTH = 0
        CALL GETSTR('String',STRING,NEW,50,LENGTH,KBOUT,KBIN,INFLAG)
        IF(LENGTH.LT.1) RETURN
        IF(INFLAG.EQ.1) THEN
          CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
          GO TO 10
        END IF
        IF(INFLAG.EQ.2) RETURN
        CALL SQCOPY(NEW,STRING,LENGTH)
        MININ = 1.
        MAXIN = LENGTH
        CUTOFF = LENGTH
        CALL GETRL(MININ,MAXIN,CUTOFF,'Minimum matches',
     +  VALUE,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
        IF(IOK.NE.0) RETURN
        CUTOFF = VALUE
      ELSE
        LENGTH = MAXSTR
        CALL ARRFIL(JDEV,STRING,LENGTH,KBOUT)
        IF(LENGTH.LT.1)THEN
          WRITE(KBOUT,*)'ZERO LENGTH STRING'
          RETURN
        END IF
        READ(JDEV,1002,ERR=901)CUTOFF
1002    FORMAT(F10.0)
      END IF
      IOK = 0
      RETURN
901   CONTINUE
      IOK = 1
      END
C*********************************************************************
      SUBROUTINE GETMT3(STRING,MAXSTR,LENGTH,CUTOFF,MAT3,IDMAT3,
     +KBIN,KBOUT,IOK,JDEV,
     +  IHELPS,IHELPE,HELPF,IDEVH)
      CHARACTER HELPF*(*)
      CHARACTER NEW(50),STRING(MAXSTR)
      INTEGER MAT3(IDMAT3,IDMAT3)
      REAL MININ,MAXIN
C  GETS DETAILS FOR MOTIF CLASS 3
      IOK = 1
      IF(KBIN.EQ.JDEV)THEN
10      CONTINUE
        LENGTH = 0
        CALL GETSTR('String',STRING,NEW,50,LENGTH,KBOUT,KBIN,INFLAG)
        IF(LENGTH.LT.1) RETURN
        IF(INFLAG.EQ.1) THEN
          CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
          GO TO 10
        END IF
        IF(INFLAG.EQ.2) RETURN
        CALL SQCOPY(NEW,STRING,LENGTH)
        CALL GTSCR(STRING,LENGTH,MAT3,IDMAT3,ISMIN,ISMAX)
        MININ = ISMIN
        MAXIN = ISMAX
        CUTOFF = MAXIN
        CALL GETRL(MININ,MAXIN,CUTOFF,'Minimum score',
     +  VALUE,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
        IF(IOK.NE.0) RETURN
        CUTOFF = VALUE
      ELSE
        LENGTH = MAXSTR
        CALL ARRFIL(JDEV,STRING,LENGTH,KBOUT)
        IF(LENGTH.LT.1)THEN
          WRITE(KBOUT,*)'ZERO LENGTH STRING'
          RETURN
        END IF
        READ(JDEV,1002,ERR=901)CUTOFF
1002    FORMAT(F10.0)
      END IF
      IOK = 0
      RETURN
901   CONTINUE
      IOK = 1
      END
      SUBROUTINE GETMT6(STRING,MAXSTR,LENGTH,
     +WEIGHT,MAXWTS,CUTOFF,KBIN,KBOUT,JDEV,IDEV,IDM,
     +FILNAM,IOK,
     +  IHELPS,IHELPE,HELPF,IDEVH,IPROB)
      CHARACTER HELPF*(*)
      PARAMETER (MAXS = 75)
      CHARACTER STRING(MAXSTR),FILNAM*(*),NEW(MAXS)
      REAL WEIGHT(MAXWTS),MININ,MAXIN
      PARAMETER (MAXCHR = 26,MAXLEN = 120)
      INTEGER SUM(MAXCHR,MAXLEN),TOT(MAXLEN)
      PARAMETER (MAXPRM = 8)
      CHARACTER PROMPT(2)*(MAXPRM)
C  GETS DETAILS FOR MOTIF CLASS 6
      IOK = 1
      IOPT = 0
      DO 10 I = 1,MAXLEN
        TOT(I) = 0
10    CONTINUE
100   CONTINUE
      IF(KBIN.EQ.JDEV)THEN
        IOPT = 1
        PROMPT(1) = 'Keyboard'
        PROMPT(2) = 'File'
        CALL RADION('Select input mode',PROMPT,2,IOPT,
     +  IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
        IF(IOPT.LT.1) RETURN
        IF(IOPT.EQ.1)THEN
20      CONTINUE
        WRITE(KBOUT,1000)
1000    FORMAT(' Separate sets with commas')
        LENGTH = 0
        CALL GETSTR('String',STRING,NEW,MAXS,LENGTH,KBOUT,KBIN,INFLAG)
        IF(LENGTH.LT.1) RETURN
        IF(INFLAG.EQ.1) THEN
          CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
          GO TO 20
        END IF
        IF(INFLAG.EQ.2) RETURN
        CALL SQCOPY(NEW,STRING,LENGTH)
          L = LENGTH
          CALL INTRP6(STRING,L,LENGTH,SUM,MAXCHR,MAXLEN,CUTOFF,IOK)
          IF(IOK.NE.0)RETURN
          MININ = 1.
          MAXIN = LENGTH
C          CUTOFF = LENGTH
          CALL GETRL(MININ,MAXIN,CUTOFF,'Minimum matches',
     +    VALUE,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
          IF(IOK.NE.0) RETURN
          CUTOFF = VALUE
        ELSE
          FILNAM = ' '
          CALL OPENF1(IDEV,FILNAM,0,IOK,KBIN,KBOUT,
     +    'Weight matrix file name',
     +    IHELPS,IHELPE,HELPF,IDEVH)
          IF(IOK.NE.0)RETURN
          LENGTH=MAXLEN
          CALL RDWMT(TOT,SUM,MIDDLE,LENGTH,MAXLEN,CUTOFF,YMAX,IDEV,
     +    IOK,IDM,KBOUT,IPROB)
          IF(IOK.NE.0)THEN
            WRITE(KBOUT,1006)
1006        FORMAT(' Error in weight matrix')
            RETURN
          END IF
        END IF
      ELSE
        CALL OPENF(IDEV,FILNAM,0,IOK,JDEV,KBOUT)
        IF(IOK.NE.0)RETURN
        LENGTH=MAXLEN
        CALL RDWMT(TOT,SUM,MIDDLE,LENGTH,MAXLEN,CUTOFF,YMAX,IDEV,
     +    IOK,IDM,KBOUT,IPROB)
        IF(IOK.NE.0)THEN
          WRITE(KBOUT,1006)
          RETURN
        END IF
      END IF
      CALL GETW1(SUM,WEIGHT,LENGTH,MAXCHR,MAXLEN)
      END
      SUBROUTINE GETMT4(WEIGHT,MAXWTS,LENGTH,CUTOFF,YMAX,IDEV,
     +KBIN,KBOUT,IOK,JDEV,FILNAM,IDM,
     +  IHELPS,IHELPE,HELPF,IDEVH,IPROB)
      CHARACTER HELPF*(*)
      PARAMETER (MAXLEN = 120, MAXCHR = 26)
      REAL WEIGHT(MAXWTS)
      CHARACTER FILNAM*(*)
      INTEGER TOT(MAXLEN),SUM(MAXCHR,MAXLEN)
      IF(JDEV.EQ.KBIN) THEN
        FILNAM = ' '
        CALL OPENF1(IDEV,FILNAM,0,IOK,JDEV,KBOUT,
     +  'Weight matrix file name',
     +  IHELPS,IHELPE,HELPF,IDEVH)
      ELSE
        CALL OPENF(IDEV,FILNAM,0,IOK,JDEV,KBOUT)
      END IF
      IF(IOK.NE.0)RETURN
      LENGTH=MAXLEN
      CALL RDWMT(TOT,SUM,MIDDLE,LENGTH,MAXLEN,CUTOFF,YMAX,IDEV,
     +  IOK,IDM,KBOUT,IPROB)
      IF(IOK.NE.0)THEN
        WRITE(KBOUT,*)' Error in weight matrix, option left'
        RETURN
      END IF
      IF(CUTOFF.LT.0.0)CALL GETW(TOT,SUM,WEIGHT,LENGTH,IDM,MAXLEN)
      IF(CUTOFF.GE.0.0)CALL GETW2(SUM,WEIGHT,LENGTH,IDM,MAXLEN)
      END
C*********************************************************************
      SUBROUTINE INTRP6(STRING,ISEND,LENGTH,WT,MAXCHR,MAXLEN,
     +CUTOFF,IOK)
      CHARACTER STRING(ISEND),TERM
      INTEGER WT(MAXCHR,MAXLEN)
      INTEGER CTONUM
      EXTERNAL CTONUM
      PARAMETER (TERM = ',')
      IOK = 0
C  POINT TO STRING
      IS = 1
      ICOL = 1
C  COUNT FILLED COLUMNS
      CUTOFF = 0.
10    CONTINUE
      CALL FILLI(WT(1,ICOL),MAXCHR,0)
      CUTOFF = CUTOFF + 1.
20    CONTINUE
      IF(IS.LE.ISEND)THEN
        IF(STRING(IS).NE.TERM)THEN
          IROW = CTONUM(STRING(IS))
          WT(IROW,ICOL) = 1
          IS = IS + 1
          GO TO 20
        END IF
        NC = 1
30      CONTINUE
        IF(IS.LE.ISEND)THEN
          IF(STRING(IS).EQ.TERM)THEN
            ICOL = ICOL + 1
            CALL FILLI(WT(1,ICOL),MAXCHR,0)
            NC = NC + 1
            IS = IS + 1
            GO TO 30
          END IF
C
C  END OF TERMINATORS
C
          IF(ICOL.GT.1) GO TO 10
C  ERROR TERMINATOR BEFORE ANY GOOD COLUMNS
          IOK = 1
          RETURN
        END IF
C  STRING ENDED WITH TERMINATOR
        LENGTH = ICOL - NC + 1
        RETURN
      END IF
C
C  END REACHED WITH NO TERMINATOR (NORMAL)
      IF(ICOL.GT.0)THEN
        LENGTH = ICOL
        IOK = 0
        RETURN
      END IF
      IOK = 1
      END
      SUBROUTINE GETMT8(RANGES,RANGEL,LENGTH,CUTOFF,
     +KBIN,KBOUT,JDEV,IOK,
     +  IHELPS,IHELPE,HELPF,IDEVH)
      CHARACTER HELPF*(*)
      INTEGER RANGES,RANGEL
C  GETS DETAILS FOR MOTIF CLASS 8
      IF(JDEV.EQ.KBIN)THEN
      IOK = 1
      MININ = 1
      MAXIN = 60
      LENGTH = 6
      CALL GETINT(MININ,MAXIN,LENGTH,'Repeat length',IVAL,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
      LENGTH = IVAL
      MININ = 0
      MAXIN = 60
      ID = MININ
      CALL GETINT(MININ,MAXIN,ID,'Minimum gap',
     +IVAL,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
      ID = IVAL
      MININ = ID
      MAXIN = MININ + 60
      IR = ID
      CALL GETINT(MININ,MAXIN,IR,'Maximum gap',
     +IVAL,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
      IR = IVAL
C       FUDGE HERE: SHOULD REALLY LOOK AT SEQUENCE COMPOSITION
C       AND SCORE MATRIX VALUES. ASSUMING MDM78
        SMININ = 11.0
        SMAXIN = LENGTH*20.
        CUTOFF = LENGTH * 12.
        CALL GETRL(SMININ,SMAXIN,CUTOFF,'Minimum score',
     +  VALUE,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
        IF(IOK.NE.0) RETURN
        CUTOFF = VALUE
      ELSE
      READ(JDEV,1001,ERR=901)LENGTH
      IF(LENGTH.LT.1)RETURN
      READ(JDEV,1001,ERR=901)ID
1001  FORMAT(I7)
C      IF(ID.LT.0)GO TO 220
      READ(JDEV,1001,ERR=901)IR
      READ(JDEV,1006,ERR=901)CUTOFF
1006  FORMAT(F10.0)
      END IF
      RANGES = ID + LENGTH + 1
      RANGEL = IR + LENGTH + 1
      IOK = 0
      RETURN
901   CONTINUE
      IOK = 1
      END
      SUBROUTINE WRTSCN(TITLE,LENGTH,MIDDLE,BOT,TOP,IDM,
     +SUM,CHRSET,IDEV)
      INTEGER TOT(120)
      REAL SUM(IDM,LENGTH)
      CHARACTER CHRSET(IDM),TITLE(60)
C   PROTEIN MATRICES DONT WRITE ROWS FOR -X? AND SPACE SO SET DIMENSION
C   TO IDM-4
      CALL FILLI(TOT,120,0)
      WRITE(IDEV,1018)TITLE
1018  FORMAT(' ',60A1)
1019  FORMAT(' P',20I4)
1020  FORMAT(' N',20I4)
1021  FORMAT(' ',A,20I4)
1022  FORMAT(' ',2I6,2F10.3)
      WRITE(IDEV,1022)LENGTH,MIDDLE,BOT,TOP
      NLINES=1+(LENGTH-1)/20
      K1=1
      DO 400 J=1,NLINES
        K2=MIN((K1+19),LENGTH)
        WRITE(IDEV,1019)(K,K=K1-MIDDLE,K2-MIDDLE)
        WRITE(IDEV,1020)(TOT(K),K=K1,K2)
        DO 390 I=1,IDM-4
          WRITE(IDEV,1021)CHRSET(I),(INT(SUM(I,K)),K=K1,K2)
390     CONTINUE
        K1=K1+20
        IF(K1.GT.LENGTH)K1=LENGTH
400   CONTINUE
      CLOSE(UNIT=IDEV)
      END
      SUBROUTINE GETCLS(JDEV,KBOUT,ICLASS,TCLASS,KEYNAM)
      CHARACTER TCLASS,STRING*21,NUMBER*10,STRNG2*10,KEYNAM*(*)
      SAVE NUMBER
      DATA NUMBER/'0987654321'/
      ICLASS = 0
10    CONTINUE
      STRING = ' '
      READ(JDEV,1000,ERR=10,END=70)STRING
1000  FORMAT(A)
      KEYNAM = STRING(14:21)
      DO 20 I = 10,1,-1
        K = I
        IF(STRING(I:I).NE.' ')GO TO 21
20    CONTINUE
      RETURN
21    CONTINUE
      L = 1
      DO 30 I = 1,K
        L = I
        IF(STRING(I:I).NE.' ')GO TO 31
30    CONTINUE
31    CONTINUE
      TCLASS = STRING(L:L)
      DO 40 I = 1,10
        IF(TCLASS.EQ.NUMBER(I:I))THEN
          TCLASS = 'A'
          GO TO 41
        END IF
40    CONTINUE
      IF((TCLASS.NE.'O').AND.(TCLASS.NE.'N').AND.(TCLASS.NE.'A')
     +.AND.(TCLASS.NE.'-'))THEN
        ICLASS = 99999
        RETURN
      END IF
      L = L + 1
41    CONTINUE
      J = 11
      STRNG2 = ' '
      DO 50 I = K,L,-1
        J = J-1
        STRNG2(J:J) = STRING(I:I)
50    CONTINUE
        READ(STRNG2,1001,ERR=60)ICLASS
1001    FORMAT(I10)
        IF(TCLASS.EQ.'-')ICLASS=-1*ICLASS
      RETURN
60    CONTINUE
      ICLASS = 99999
      RETURN
70    CONTINUE
      END
      SUBROUTINE GETP(ICLASS,STRING,LENGTH,IDM,
     +MATRIX,MAT1,WEIGHT)
C  MAT1 SIMPLE IDENTITY
C  MATRIX MDM78
      PARAMETER (
     +           MAXCHR=26,
     +           MAXSIG=120)
      INTEGER MAT1(IDM,IDM),MATRIX(IDM,IDM)
      INTEGER IWT(MAXCHR,MAXSIG)
      REAL WEIGHT(IDM,LENGTH),FB(MAXCHR),F(MAXCHR)
      CHARACTER STRING(LENGTH)
      COMMON /COMPC/COMP(MAXCHR)
      DO 10 I = 1,IDM
        F(I) = COMP(I)
10    CONTINUE
      IF(ICLASS.EQ.1)THEN
        CALL GETP1(STRING,LENGTH,IDM,MAT1,IDM,IWT,F)
        RETURN
      END IF
      IF(ICLASS.EQ.2)THEN
        CALL GETP1(STRING,LENGTH,IDM,MAT1,IDM,IWT,F)
        RETURN
      END IF
      IF(ICLASS.EQ.3)THEN
        CALL GETP3(STRING,LENGTH,IDM,MATRIX,IWT,IDM,F)
        RETURN
      END IF
      IF(ICLASS.EQ.4)THEN
        CALL GETP4(WEIGHT,IWT,IDM,LENGTH,F)
        RETURN
      END IF
      IF(ICLASS.EQ.5)THEN
        CALL GETP8(MATRIX,IDM,IWT,IDM,LENGTH,F,FB)
        RETURN
      END IF
      IF(ICLASS.EQ.6)THEN
        CALL GETP4(WEIGHT,IWT,IDM,LENGTH,F)
        RETURN
      END IF
      END
      SUBROUTINE WTGEN(IWT,MAXCHR,LENGTH,F,MAXS,SMIN,SCALE,JOB)
      PARAMETER (MAXPOL = 4000)
      INTEGER IWT(MAXCHR,LENGTH)
      REAL F(MAXCHR)
      COMMON /POLY/POLYA(0:MAXPOL),POLYB(0:MAXPOL),POLYC(0:MAXPOL),
     +CMIN,CSCALE,LENTHC
      SAVE /POLY/
      CMIN = SMIN
      CSCALE = SCALE
      LENTHC = LENGTH
      DO 10 I = 0, MAXPOL
        POLYA(I) = 0.0
10    CONTINUE
      DO 400 I = 1,MAXCHR
        K = IWT(I,1)
        POLYA(K) = POLYA(K) + F(I)
400   CONTINUE
      MAXS1 = MAXS
      DO 600 J = 2,LENGTH
        DO 490 I = 0, MAXPOL
          POLYB(I) = 0.0
490     CONTINUE
        DO 500 I = 1,MAXCHR
          K = IWT(I,J)
          POLYB(K) = POLYB(K) + F(I)
500     CONTINUE
        CALL POLMUL(MAXS1,MAXS,MAXSP1)
        MAXS1 = MAXSP1
600   CONTINUE
C  IF JOB = 1 WANT DISTRIBUTION ONLY
C     JOB = 2 WANT CUMMULATIVE VALUES
C     JOB = 3 WANT DISTRIBUTION AND UNSCALED SCORES
C     JOB = 4 WANT CUMMULATIVE VALUES AND UNSCALED SCORES
      IF((JOB.EQ.2).OR.(JOB.EQ.4))THEN
        DO 610 I = 1,MAXS1
          J = MAXS1 - I
          POLYA(J) = POLYA(J) + POLYA(J+1)
610     CONTINUE
      END IF
      IF((JOB.EQ.3).OR.(JOB.EQ.4))THEN
        T = SMIN * LENGTH
        DO 620 I = 0,MAXS1
          POLYB(I) = (REAL(I)/SCALE) + T
620     CONTINUE
      END IF
      END
      SUBROUTINE SCGEN(IWT,MAXCHR,LENGTH,FA,FB,MAXS,
     +SCALE,SMIN,JOB)
      PARAMETER (MAXPOL = 4000)
      INTEGER IWT(MAXCHR,MAXCHR)
      REAL FA(MAXCHR),FB(MAXCHR)
      COMMON /POLY/POLYA(0:MAXPOL),POLYB(0:MAXPOL),POLYC(0:MAXPOL),
     +CMIN,CSCALE,LENTHC
      SAVE /POLY/
      CMIN = SMIN
      CSCALE = SCALE
      LENTHC = LENGTH
      DO 10 I = 0, MAXPOL
        POLYA(I) = 0.0
        POLYB(I) = 0.0
10    CONTINUE
      DO 400 I = 1,MAXCHR
        DO 300 J = 1,MAXCHR
          K = IWT(I,J)
          POLYA(K) = POLYA(K) + FA(I) * FB(J)
          POLYB(K) = POLYA(K)
300     CONTINUE
400   CONTINUE
      MAXS1 = MAXS
      DO 600 J = 2,LENGTH
        CALL POLMUL(MAXS1,MAXS,MAXSP1)
        MAXS1 = MAXSP1
600   CONTINUE
C  IF JOB = 1 WANT DISTRIBUTION ONLY
C     JOB = 2 WANT CUMMULATIVE VALUES
C     JOB = 3 WANT DISTRIBUTION AND UNSCALED SCORES
C     JOB = 4 WANT CUMMULATIVE VALUES AND UNSCALED SCORES
      IF((JOB.EQ.2).OR.(JOB.EQ.4))THEN
        DO 610 I = 1,MAXS1
          J = MAXS1 - I
          POLYA(J) = POLYA(J) + POLYA(J+1)
610     CONTINUE
      END IF
      IF((JOB.EQ.3).OR.(JOB.EQ.4))THEN
        T = SMIN * LENGTH
        DO 620 I = 0,MAXS1
          POLYB(I) = (REAL(I)/SCALE) + T
620     CONTINUE
      END IF
      END
      SUBROUTINE SCGEN1(IWT,MAXCHR,LENGTH,FA,MAXS,
     +SCALE,SMIN,JOB,STRING)
C  AUTHOR RODGER STADEN
C  PROBABILITY FOR STRINGS
      CHARACTER STRING(LENGTH)
      INTEGER DTONUM
      PARAMETER (MAXPOL = 4000)
      INTEGER IWT(MAXCHR,MAXCHR)
      REAL FA(MAXCHR)
      COMMON /POLY/POLYA(0:MAXPOL),POLYB(0:MAXPOL),POLYC(0:MAXPOL),
     +CMIN,CSCALE,LENTHC
      EXTERNAL DTONUM
      SAVE /POLY/
      CMIN = SMIN
      CSCALE = SCALE
      LENTHC = LENGTH
      DO 10 I = 0, MAXPOL
        POLYA(I) = 0.0
10    CONTINUE
      K1 = DTONUM(STRING(1))
      DO 400 I = 1,MAXCHR
        K = IWT(I,K1)
        POLYA(K) = POLYA(K) + FA(I)
400   CONTINUE
      MAXS1 = MAXS
      DO 600 J = 2,LENGTH
        DO 490 I = 0,MAXPOL
           POLYB(I) = 0.
490     CONTINUE
        K1 = DTONUM(STRING(J))
        DO 500 I = 1,MAXCHR
          K = IWT(I,K1)
          POLYB(K) = POLYB(K) + FA(I)
500     CONTINUE
        CALL POLMUL(MAXS1,MAXS,MAXSP1)
        MAXS1 = MAXSP1
600   CONTINUE
C  IF JOB = 1 WANT DISTRIBUTION ONLY
C     JOB = 2 WANT CUMMULATIVE VALUES
C     JOB = 3 WANT DISTRIBUTION AND UNSCALED SCORES
C     JOB = 4 WANT CUMMULATIVE VALUES AND UNSCALED SCORES
      IF((JOB.EQ.2).OR.(JOB.EQ.4))THEN
        DO 610 I = 1,MAXS1
          J = MAXS1 - I
          POLYA(J) = POLYA(J) + POLYA(J+1)
610     CONTINUE
      END IF
      IF((JOB.EQ.3).OR.(JOB.EQ.4))THEN
        T = SMIN * LENGTH
        DO 620 I = 0,MAXS1
          POLYB(I) = (REAL(I)/SCALE) + T
620     CONTINUE
      END IF
      END
      SUBROUTINE POLMUL(NA,NB,NC)
      PARAMETER (MAXPOL = 4000)
      COMMON /POLY/POLYA(0:MAXPOL),POLYB(0:MAXPOL),POLYC(0:MAXPOL),
     +CMIN,CSCALE,LENTHC
      PARAMETER (ZERO=0.0,SMALL=1E-10)
      SAVE /POLY/
C  POLYA, POLYB ARE INPUT POLYNOMIAL COEEFICIENTS
C  POLYC  IS OUTPUT POLYNOMIAL COEEFICIENTS
C
      NC = NA + NB
      DO 210 I = 0,MAXPOL
        POLYC(I) = ZERO
210   CONTINUE
      IF(NC.GT.MAXPOL)RETURN
      DO 230 I = 0,NA
        DO 220 J = 0,NB
          POLYC(I+J) = POLYC(I+J) + POLYA(I) * POLYB(J)
220     CONTINUE
230   CONTINUE
      DO 240 I = 0,NC
        T = POLYC(I)
        IF(T.LT.SMALL) T = ZERO
        POLYA(I) = T
240   CONTINUE
      END
      SUBROUTINE WRTWMT(WEIGHT,IWT,MAXCHR,LENGTH,IDEV,IFLAG)
      REAL WEIGHT(MAXCHR,LENGTH)
      INTEGER IWT(MAXCHR,LENGTH)
      DO 10 I = 1,MAXCHR
        IF(IFLAG.EQ.0)
     +  WRITE(IDEV,1000,ERR=100)(WEIGHT(I,J),J=1,LENGTH)
        IF(IFLAG.EQ.1)
     +  WRITE(IDEV,1001,ERR=100)(IWT(I,J),J=1,LENGTH)
10    CONTINUE
1000  FORMAT(' ',20F5.2)
1001  FORMAT(' ',20I4)
100   CONTINUE
      END
      SUBROUTINE WTSC(WEIGHT,IWT,MAXCHR,LENGTH,MAXS,SCALE,SMIN)
      INTEGER IWT(MAXCHR,LENGTH)
      REAL WEIGHT(MAXCHR,LENGTH)
      PARAMETER (SMALL=1E-10)
      PARAMETER (MAXPOL = 4000)
      SMIN = 9999999.9
      SMAX = -99999999.9
      DO 100 J = 1,LENGTH
        DO 90 I = 1,MAXCHR
          T = WEIGHT(I,J)
          IF(T.LT.SMIN)SMIN = T
          IF(T.GT.SMAX)SMAX = T
90      CONTINUE
100   CONTINUE
      SMAX = SMAX - SMIN
      IF(SMAX.EQ.0.0)SMAX = SMALL
C  USE LENGTH+1 TO DIVIDE MAXPOL. THIS IS AN ATTEMPT TO AVOID
C  THE USE OF NINT GIVING A SET OF SCORES THAT SUM TO TOO
C  HIGH A VALUE (IE GT MAXPOL)
      MAXS = MAXPOL/(LENGTH+1)
      MAXS = MIN(MAXS,40)
      SCALE = REAL(MAXS)/SMAX
      DO 200 J = 1,LENGTH
        DO 190 I = 1,MAXCHR
          K = NINT((WEIGHT(I,J)-SMIN)*SCALE)
          IWT(I,J) = K
190     CONTINUE
200   CONTINUE
      END
      SUBROUTINE GETCMP(SEQ,IDIM,COMP,IDM)
      CHARACTER SEQ(IDIM)
      REAL COMP(IDM)
      INTEGER DTONUM
      EXTERNAL DTONUM
      DO 10 I = 1,IDM
        COMP(I) = 0.0
10    CONTINUE
      T = 0.
      DO 20 I = 1,IDIM
        J = DTONUM(SEQ(I))
        IF(J.LT.23)THEN
          COMP(J) = COMP(J) + 1.
          T = T + 1.
        END IF
20    CONTINUE
      IF(T.GT.0.0)THEN
        DO 30 I = 1,IDM
          COMP(I) = COMP(I) / T
30      CONTINUE
      END IF
      END
      SUBROUTINE MATSC(WEIGHT,IDMAT,IWT,MAXCHR,LENGTH,MAXS,
     +SMIN,SCALE)
      INTEGER IWT(IDMAT,IDMAT)
      INTEGER WEIGHT(IDMAT,IDMAT)
      PARAMETER (SMALL=1E-10)
      PARAMETER (MAXPOL = 4000)
      ISMIN = 99999999
      ISMAX = -99999999
      DO 100 J = 1,IDMAT
        DO 90 I = 1,IDMAT
          K = WEIGHT(I,J)
          IF(K.LT.ISMIN) ISMIN = K
          IF(K.GT.ISMAX) ISMAX = K
90      CONTINUE
100   CONTINUE
C      SMAX = ISMAX - ISMIN
C      IF(SMAX.EQ.0.0)SMAX = SMALL
C  DO NOTHING HERE - ASSUME VALUES ARE IN RANGE AND JUST COPY
C  USE LENGTH+1 TO DIVIDE MAXPOL. THIS IS AN ATTEMPT TO AVOID
C  THE USE OF NINT GIVING A SET OF SCORES THAT SUM TO TOO
C  HIGH A VALUE (IE GT MAXPOL)
C      MAXS = MAXPOL/(LENGTH+1)
C      SCALE = REAL(MAXS)/SMAX
      DO 200 J = 1,IDMAT
        DO 190 I = 1,IDMAT
C          K = NINT((REAL(WEIGHT(I,J))-ISMIN)*SCALE)
          IWT(I,J) = WEIGHT(I,J) - ISMIN
190     CONTINUE
200   CONTINUE
      SCALE = 1.0
      SMIN = ISMIN
      MAXS = ISMAX
      END
      REAL FUNCTION PSCORE(SCORE)
      PARAMETER (MAXPOL = 4000)
      COMMON /POLY/POLYA(0:MAXPOL),POLYB(0:MAXPOL),POLYC(0:MAXPOL),
     +SMIN,SCALE,LENGTH
      SAVE /POLY/
C WANT PROBABILITY OF SCORING AT LEAST SCORE
C CUMMULATIVE PROBABILITIES IN CUMP
C SCALE FACTORS SMIN AND SCALE AND MOTIF LENGTH IS LENGTH
      I = NINT((SCORE - SMIN * LENGTH) * SCALE)
      PSCORE = -1.
      IF((I.GE.0).AND.(I.LE.MAXPOL)) PSCORE = POLYA(I)
      END
      SUBROUTINE GETP1(STRING,LENGTH,IDMAT3,MAT2,IDMAT2,IWT,F)
      INTEGER MAT2(IDMAT2,IDMAT2)
      INTEGER IWT(IDMAT2,IDMAT2)
      REAL F(IDMAT3)
      CHARACTER STRING(LENGTH)
      JOB = 2
        CALL MATSC(MAT2,IDMAT2,IWT,IDMAT3,LENGTH,MAXS,SMIN,SCALE)
        CALL SCGEN1(IWT,IDMAT2,LENGTH,F,MAXS,SCALE,SMIN,JOB,STRING)
      END
      SUBROUTINE GETP3(STRING,LENGTH,IDMAT3,MAT3,IWT,IDM,F)
      INTEGER MAT3(IDMAT3,IDMAT3)
      INTEGER IWT(IDMAT3,IDMAT3)
      REAL F(IDMAT3)
      CHARACTER STRING(LENGTH)
      JOB = 2
        CALL MATSC(MAT3,IDMAT3,IWT,IDM,LENGTH,MAXS,SMIN,SCALE)
        CALL SCGEN1(IWT,IDMAT3,LENGTH,F,MAXS,SCALE,SMIN,JOB,
     +  STRING)
      END
      SUBROUTINE GETP4(WEIGHT,IWT,IDM,LENGTH,F)
      REAL F(IDM)
      REAL WEIGHT(IDM,LENGTH)
      INTEGER IWT(IDM,LENGTH)
      JOB = 2
        CALL WTSC(WEIGHT,IWT,IDM,LENGTH,MAXS,SCALE,SMIN)
        CALL WTGEN(IWT,IDM,LENGTH,F,MAXS,SMIN,SCALE,JOB)
      END
      SUBROUTINE GETP8(MAT1,IDMAT1,IWT,IDM,LENGTH,F,FB)
      REAL F(IDM),FB(IDM)
      INTEGER MAT1(IDMAT1,IDMAT1)
      INTEGER IWT(IDM,LENGTH)
        DO 30 I = 1,IDM
          FB(I) = F(I)
30      CONTINUE
      JOB = 2
        CALL MATSC(MAT1,IDMAT1,IWT,IDM,LENGTH,MAXS,SMIN,SCALE)
        CALL SCGEN(IWT,IDMAT1,LENGTH,F,FB,MAXS,SCALE,SMIN,JOB)
      END
      SUBROUTINE WRTSCR(SCMIN,PROB,KBOUT)
      WRITE(KBOUT,1000)SCMIN,PROB
1000  FORMAT(' Probability of score ',F10.4,' =',E10.3)
      END
      SUBROUTINE GIDMAT(MAT,IDM,IDMX)
      INTEGER MAT(IDM,IDM)
C  AUTHOR RODGER STADEN
C  ALLOW ONLY - AS WILD CARD FOR PROTEINS
      DO 10 I = 1,IDM
        DO 5 J = 1,IDM
          MAT(I,J) = 0
5       CONTINUE
10    CONTINUE
      DO 20 I = 1,IDMX+1
        DO 15 J = 1,IDMX+1
          IF(I.EQ.J)MAT(I,J) = 1
15      CONTINUE
20    CONTINUE
      DO 30 I = 1,IDMX
        MAT(I,IDMX+1) = 1
        MAT(IDMX+1,I) = 1
30    CONTINUE
      END
      SUBROUTINE FORWAD(CLASS,LENGTH,CUTOFF,NMOT,
     +MOTIF,ICLASS,ILEN,CUT,IWT,RELMOT,START,IEND,
     +RANGES,RANGEL,STRNGS,ISTRST,WTSTR,IDSEQ,IENTRY,
     +RANGET,RANGEM,START2,IEND2,MATCHQ,RELEND,MATCHP,IDSPLY,
     +COMBIN,COMB)
      INTEGER CLASS(NMOT),LENGTH(NMOT),WTSTR(NMOT)
      INTEGER STRNGS(NMOT),START(NMOT),IEND(NMOT),IENTRY(NMOT)
      INTEGER RELMOT(NMOT),RANGES(NMOT),RANGEL(NMOT)
      INTEGER RANGET(NMOT),RANGEM(NMOT),START2(NMOT),IEND2(NMOT)
      INTEGER MATCHQ(NMOT),RELEND(NMOT),MATCHP(NMOT)
      REAL CUTOFF(NMOT)
      CHARACTER COMBIN(NMOT),COMB
C      WRITE(*,*)'IN FORWAD FOR MOTIF',MOTIF
C  ROUTINE TO MOVE FORWARDS ONE MOTIF
C  FIRST IT UPDATES THE RANGES FOR ALL THE MOTIFS THAT DEPEND
C  ON THE CURRENT MOTIF
C  IT POINTS TO THE NEXT MOTIF AND GETS ALL THE REQUIRED VARIABLES
C  WE MUST FIRST LOOK BACK THRU THE LIST UNTIL WE FIND THE FIRST
C  NON ORED MOTIF. THEN WE MUST SET THE RELATIVE POSITIONS FOR ALL
C  THOSE MOTIFS THAT DEPEND ON THIS SET OF ORED MOTIFS. THE RELATIVE
C  POSITIONS MUST BE SET RELATIVE TO THE POSITION OF THE MATCH FOUND
C  FOR THE CURRENT MOTIF EVEN IF IT IS NOT THE FIRST IN THE LIST OF ORS
C  THIS IS BECAUSE RELATIVE POSITIONS CAN ONLY BE DEFINED RELATIVE TO
C  THE FIRST OF A SET OF ORS, BUT IF A MATCH IS FOUND FOR ANY OF THE OTHERS
C  IN THE SET THEN ITS POSITION DEFINES THE RANGE.
C
C
C
C  IF THIS IS THE LAST MOTIF RETURN TO DISPLAY THE MATCH
      IF(MOTIF.EQ.NMOT)THEN
        IDSPLY = 1
        RETURN
      END IF
C
C  NOT THE LAST
C
      IDSPLY = 0
C
C  IF THIS IS A NOTTED MOTIF THEN IT WILL NOT BE ORED OR HAVE ANY
C  OTHER MOTIFS RELATIVE TO IT, SO DEAL WITH IT HERE
C
      IF(COMB.EQ.'N')THEN
        MOTIF  = MOTIF + 1
        ICLASS = CLASS(MOTIF)
        ILEN   = LENGTH(MOTIF)
        CUT    = CUTOFF(MOTIF)
        IWT    = WTSTR(MOTIF)
        ISTRST = STRNGS(MOTIF)
        COMB   = COMBIN(MOTIF)
        RETURN
      END IF
C
C
C   NOW LOOK FOR THE FIRST NON ORRED CLASS FROM HERE BACK
C
      NOTIF = MOTIF
10    CONTINUE
C
      IF(COMBIN(NOTIF).EQ.'O')THEN
        NOTIF = NOTIF - 1
        GO TO 10
      END IF
C
C  NOTIF IS A NON-ORED MOTIF, OR THE FIRST OF A LIST OF ORS 
C  SO SET RELATIVE POSITIONS FOR ALL THOSE THAT DEPEND ON IT
C
        DO 20 I = MOTIF+1,NMOT
          JMOT = I
            IF(RELMOT(JMOT).EQ.NOTIF)THEN
              START(JMOT) = START(MOTIF) + RANGES(JMOT) - 1
C             NEXT LINE IS FOR RAH BUG
              START(JMOT) = MAX(START(JMOT),1)
              IEND(JMOT) = START(JMOT) + RANGEL(JMOT) - 1
              IF(IEND(JMOT).GT.IDSEQ)IEND(JMOT)=IDSEQ
C   SET FLAG TO SAY THAT FOR STEMS WE DO NOT HAVE TO CONTINUE A PREVIOUS
C   5' STEM START POSITION (IE TRY ALL ITS REMAINING LOOPS)
              IENTRY(JMOT) = 0
            END IF
C
20      CONTINUE
C
C
C   OK WEVE FOUND THE FIRST NON-ORRED CLASS AND RESET RANGES
C   RANGES ACCORDINGLY. NOW WE HAVE TO GO FORARDS THRU THE LIST UNTIL
C   WE FIND THE NEXT NON-ORRED CLASS. IF WE SET THIS TO BE THE 
C   CURRENT MOTIF WE WILL HAVE MOVED FORWARDS. WE MUST BE CAREFUL THAT
C   WE DONT FALL OFF THE END OF THE LIST!
C
          JMOT = MOTIF
30        CONTINUE
          JMOT   = JMOT + 1
          IF(JMOT.GT.NMOT)THEN
            IDSPLY = 1
            RETURN
          END IF
          IF(COMBIN(JMOT).EQ.'O')GO TO 30
          MOTIF  = JMOT
          ICLASS = CLASS(MOTIF)
          ILEN   = LENGTH(MOTIF)
          CUT    = CUTOFF(MOTIF)
          IWT    = WTSTR(MOTIF)
          ISTRST = STRNGS(MOTIF)
          COMB   = COMBIN(MOTIF)
        END
C*********************************************************************
      SUBROUTINE BAKSID(CLASS,LENGTH,CUTOFF,STRNGS,NMOT,
     +MOTIF,ICLASS,ILEN,CUT,IWT,ISTRST,WTSTR,
     +RELMOT,START,IEND,MATCHQ,RANGES,RANGEL,RELEND,IRET,MATCHP,
     +COMBIN,COMB)
      INTEGER CLASS(NMOT),LENGTH(NMOT),WTSTR(NMOT)
      INTEGER STRNGS(NMOT),RELMOT(NMOT),START(NMOT),IEND(NMOT)
      INTEGER MATCHQ(NMOT),RANGES(NMOT),RANGEL(NMOT),RELEND(NMOT)
      INTEGER MATCHP(NMOT)
      REAL CUTOFF(NMOT)
      CHARACTER COMBIN(NMOT),COMB
C      WRITE(*,*)'IN BAKSID FOR MOTIF',MOTIF
C   ROUTINE TO MOVE BAKWARDS OR SIDEWAYS
C   IE WE COME HERE AFTER FAILING TO FIND A MATCH FOR THE PREVIOUS MOTIF
C   WE CHECK IF WE CAN MOVE SIDEWAYS BY LOOKING TO SEE IF THE NEXT MOTIF
C   IN THE LIST IS ORRED.
C   IF IT IS WE LEAVE THE CURRENT MOTIFS POSITION UNCHANGED SO THAT IT
C   IS READY TO SIGNIFIY TO A SUBSEQUENT MOVE BACKWARDS THAT ALL ITS
C   POSITIONS HAVE BEEN TRIED FOR THE MATCHES FOUND FURTHER UP THE LIST.
C
C   IF THE NEXT MOTIF IN THE LIST IS NOT ORED THEN WE MUST MOVE BACKWARDS.
C   BEFORE DOING SO WE MUST RESET THE RANGES FOR ALL THE MOTIFS IN THE 
C   CURRENT SET OF ORS. THEY MUST BE RESET TO THEIR ORIGINAL FULL RANGE
C   BECAUSE WE ARE TRYING TO FIND ALL POSSIBLE COMBINATIONS OF MATCH AND
C   WHEN WE GO BACK WE MIGHT NOT GO BACK AS FAR AS THE MOTIF THE CURRENT 
C   SET DEPEND ON, AND SO THEY WILL NOT BE RESET COMING FORWARDS. SO IF WE 
C   FIND ANOTHER MATCH TO A MOTIF IN A PREVIOUS SET WE MUST ALLOW THE SAME
C   MATCHES TO BE REFOUND IN THE CURRENT SET BECAUSE IT GIVES A DIFFERENT 
C   COMBINATION TO THOSE ALREADY FOUND. TO FIND THE ONES TO RESET WE MUST
C   MOVE BACK THRU THE LIST UNTIL A NON-ORRED CLASS IS FOUND: THIS 
C   IS THE LAST ONE TO RESET.
C   HAVING DONE THIS, TO MOVE BACK WE MUST LOOK BACK FROM THE LAST ONE 
C   RESET, UNTIL WE FIND THE FIRST NON-ORRED CLASS. THIS WILL
C   BE AN ANDED OR NOTTED MOTIF OR THE FIRST IN A LIST OF ORS. 
C   WE MUST ALWAYS GO BACK
C   TO THE BEGINNING OF A LIST OF ORS. IF THEY HAVE NO FURTHER POSITIONS TO
C   TRY WE CAN THEN GO SIDEWAYS UNTIL EITHER ONE WITH SOME PLACES TO TRY
C   IS FOUND, OR WE HAVE TO GIVE UP AND GO BACKWARDS.
C   MOTIF 1 AND ANY MOTIFS ORED WITH IT ARE SPECIAL CASES FOR THE ROUTINES
C   BECAUSE THEIR RANGES MUST NOT BE RESET. THEIR SPECIALNESS IS SIGNIFIED
C   BY THEIR HAVING A ZERO RELATIVE MOTIF NUMBER. ALSO IF WE TRY TO GO BACK
C   FOR MOTIF 1, WE MUST HAVE FINISHED TRYING ALL POSSIBLE COMBINATIONS,
C   SO WE ESCAPE.
C   
C
C
C   RESET ITS MATCH POSITION TO ZERO AS A FLAG TO THE DISPLAY ROUTINES
C
C
      MATCHP(MOTIF) = 0
C
C
      IF(MOTIF.LT.NMOT)THEN
        IF(COMBIN(MOTIF+1).EQ.'O')THEN
C
C  MOVE SIDEWAYS
C
          MOTIF = MOTIF + 1
          ICLASS = CLASS(MOTIF)
          ILEN   = LENGTH(MOTIF)
          CUT    = CUTOFF(MOTIF)
          IWT    = WTSTR(MOTIF)
          ISTRST = STRNGS(MOTIF)
          MATCHP(MOTIF) = 0
          COMB   = COMBIN(MOTIF)
          RETURN
        END IF
      END IF
C
C
C
C   WE MUST MOVE BACKWARDS.   RESET RANGE FOR CURRENT MOTIF IF IT IS NOT 
C   NOTTED
C
C
      IF(COMB.NE.'N')THEN
C
C
      IREL = RELMOT(MOTIF)
      IF(IREL.NE.0)THEN
        START(MOTIF) = START(IREL) + RANGES(MOTIF)
C       NEXT LINE FOR RAH BUG
        START(MOTIF) = MAX(START(MOTIF),1)
        IEND(MOTIF)  = START(MOTIF) + RANGEL(MOTIF) - 1 
      END IF
C
C
C
10    CONTINUE
C
C
      IF(MOTIF.EQ.1)THEN
        IRET = 1
        RETURN
      END IF
      IF(COMBIN(MOTIF).EQ.'O')THEN
        MOTIF = MOTIF - 1
        MATCHP(MOTIF) = 0
        IREL = RELMOT(MOTIF)
        IF(IREL.NE.0)THEN
          START(MOTIF) = START(IREL) + RANGES(MOTIF)
C         NEXT LINE FOR RAH BUG
          START(MOTIF) = MAX(START(MOTIF),1)
          IEND(MOTIF)  = START(MOTIF) + RANGEL(MOTIF) - 1 
        END IF
        GO TO 10
      END IF
C
      END IF
C
C   IF WE GET HERE WE HAVE FOUND A NON-ORRED CLASS AND IF THE MOTIF WE CAME 
C   IN WITH WAS NOT NOTTED
C   WE HAVE RESET ITS RANGE AND
C   ALL THOSE UP THE LIST THAT ARE ORRED, AND THE CURRENT ONE
C   NOW WE MUST FIND THE TOP OF THE NEXT LIST SIGNIFIED BY AN ANDED
C   CLASS
C
20    CONTINUE
      MOTIF = MOTIF - 1
      IF(COMBIN(MOTIF).NE.'A')GO TO 20
C      IF(COMBIN(MOTIF).EQ.'O')GO TO 20
      ICLASS = CLASS(MOTIF)
      ILEN   = LENGTH(MOTIF)
      CUT    = CUTOFF(MOTIF)
      IWT    = WTSTR(MOTIF)
      ISTRST = STRNGS(MOTIF)
      COMB   = COMBIN(MOTIF)
      END
C*********************************************************************
      SUBROUTINE MOTIF1(SEQ,IDIM1,STRING,IDIM2,ISTART,IEND,
     +MATCHP,MATCHS,IFOUND,CUT,JOB)
      CHARACTER SEQ(IDIM1),STRING(IDIM2)
      REAL MATCHS
      IFOUND = 0
      ISTEP = 1
      IF(JOB.EQ.1)ISTEP = CUT
      IF(ISTART.LT.1)ISTART=1
      L1 = IEND-ISTART+1
      IF(ISTART.GT.IDIM1)RETURN
      IF(L1.LT.IDIM2)RETURN
      CALL FIND8(SEQ(ISTART),L1,STRING,IDIM2,ISTEP,IFOUND)
      IF(IFOUND.EQ.0)RETURN
C  SAVE MATCH POSITION
      MATCHP = ISTART+IFOUND-1
      MATCHS = IDIM2
      END
C*********************************************************************
      SUBROUTINE MOTIF2(SEQ,IDIM1,STRING,IDIM2,ISTART,IEND,CUTOFF,
     +MATCHP,MATCHS,IFOUND)
      CHARACTER SEQ(IDIM1),STRING(IDIM2)
      REAL MATCHS
      IFOUND = 0
      IF(ISTART.LT.1)ISTART=1
      IF(ISTART.GT.IDIM1)RETURN
      CALL SQFIT4(SEQ,IDIM1,STRING,IDIM2,ISTART,IEND,CUTOFF,MATCHS,
     +IFOUND)
      IF(IFOUND.EQ.0)RETURN
C  SAVE MATCH POSITION
      MATCHP = IFOUND
      END
C*********************************************************************
      SUBROUTINE SQFIT4(SEQ,IDIM1,STRING,IDIM2,
     1IS,IE,MINSC,MATCHS,IFOUND)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDIM1),STRING(IDIM2)
      REAL MATCHS,MINSC
      INTEGER CTONUM
      EXTERNAL CTONUM
      MINSCR = MINSC
C
      IDIF=(IE-IS+2)-IDIM2
C   IDIF IS THE NUMBER OF POSNS TO TRY
C   IPSTR GOES FROM 1 TO IDIM2 IDIF TIMES
C   TRY ALL POSSIBLE POSITIONS FOR MATCHING AND SCORE FOR EACH
C   POINT TO ARRAY ELEMENT CORRESPONDING TO FIRST BASE
      IPSEQ=IS
      DO 200 I=1,IDIF
        NTOT=0
        IP=IPSEQ
        DO 100 J=1,IDIM2
          IF(CTONUM(SEQ(IP)).EQ.CTONUM(STRING(J)))THEN
            NTOT = NTOT + 1
          ELSE
            IF(STRING(J).EQ.'-')NTOT = NTOT + 1
          END IF
          IP=IP+1
100     CONTINUE
C   END OF COUNTING FOR THIS POSITION.IS TOTAL HIGH ENOUGH?
        IF(NTOT.GE.MINSCR)THEN
          MATCHS = NTOT
          IFOUND = IP-IDIM2
          RETURN
        END IF
        IPSEQ=IPSEQ+1
200   CONTINUE
      IFOUND = 0
      END
      SUBROUTINE EMBOUT(KEYNAM,FROM,TO,STRAND,DESCRP,IDEV)
      CHARACTER KEYNAM*(*),STRAND,DESCRP*(*)
      INTEGER FROM,TO
C     note keynam*8, strand*1 descrp*38
      WRITE(IDEV,1000,ERR=100)KEYNAM,FROM,TO,STRAND,DESCRP
1000  FORMAT('FT','   ',A8,' ',I6,' ',I6,'  ',A,'    ',A)
      RETURN
100   CONTINUE
      END
