1669 lines
52 KiB
Fortran
1669 lines
52 KiB
Fortran
C 9-11-90 very many changes concerning use of file of file names
|
|
C and switching radio to radion
|
|
C 3-7-91 Removed annotation "filename" from pattern files
|
|
C 4-7-91 replaced embout by eftout
|
|
C 18-7-91 added titles to pattern files
|
|
C 2-3-92 set filnam = ' ' for some 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,
|
|
+MAT1,IDMAT1,MAT2,IDMAT2,MAT3,IDMAT3,MAT4,IDMAT4,
|
|
+PMINT,PMAXT,PROBT,EXPTT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KEYNS,NAMSAV,FILNAM,IPROB,TITLE)
|
|
C MAT1 SIMPLE IDENTITY
|
|
C MAT2 IUB SCORES 0-1
|
|
C MAT3 IUB SCORES 0-36
|
|
C MAT4 INVERTED REPEAT
|
|
INTEGER LENGTH(MAXMOT),CLASS(MAXMOT),RELMOT(MAXMOT)
|
|
INTEGER RANGES(MAXMOT),RANGEL(MAXMOT),STRNGS(MAXMOT)
|
|
INTEGER WTSTR(MAXMOT),RANGET(MAXMOT),RANGEM(MAXMOT)
|
|
INTEGER RELEND(MAXMOT)
|
|
CHARACTER STRING(MAXSTR),FILNAM*(*),HELPF*(*)
|
|
CHARACTER*(*) KEYNS(MAXMOT),TITLE
|
|
REAL WEIGHT(MAXWTS),CUTOFF(MAXMOT)
|
|
CHARACTER COMBIN(MAXMOT),TCLASS
|
|
INTEGER MAT1(IDMAT1,IDMAT1),MAT2(IDMAT2,IDMAT2)
|
|
INTEGER MAT3(IDMAT3,IDMAT3),MAT4(IDMAT4,IDMAT4)
|
|
CHARACTER*(*) NAMSAV(MAXMOT)
|
|
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
|
|
IF(CLASS(IREL).EQ.6)THEN
|
|
READ(JDEV,1001,ERR=901)MEND
|
|
IF(MEND.LT.0)GO TO 901
|
|
RELEND(MOTIF) = 5
|
|
IF(MEND.EQ.3)RELEND(MOTIF) = 3
|
|
READ(JDEV,1001,ERR=901)ID
|
|
IF(ID.LT.0)GO TO 901
|
|
ELSE
|
|
READ(JDEV,1001,ERR=901)ID
|
|
END IF
|
|
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
|
|
C KEYNS(MOTIF) = KEYNAM
|
|
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,
|
|
+MAT1,IDMAT1,MAT2,IDMAT2,MAT3,IDMAT3,MAT4,IDMAT4,
|
|
+PMINT,PMAXT,PROBT,EXPTT,EXPTS,PROBS,PMINS,PMAXS,
|
|
+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.6).OR.(CLASS(I).EQ.8)) 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,
|
|
+MAT1,IDMAT1,MAT2,IDMAT2,MAT3,IDMAT3,MAT4,IDMAT4,
|
|
+PMINT,PMAXT,PROBT,EXPTT,EXPTS,PROBS,PMINS,PMAXS,
|
|
+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)
|
|
CHARACTER STRING(MAXSTR),FILNAM*(*),HELPF*(*)
|
|
REAL WEIGHT(MAXWTS),CUTOFF(MAXMOT)
|
|
CHARACTER COMBIN(MAXMOT)
|
|
INTEGER MAT1(IDMAT1,IDMAT1),MAT2(IDMAT2,IDMAT2)
|
|
INTEGER MAT3(IDMAT3,IDMAT3),MAT4(IDMAT4,IDMAT4)
|
|
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,
|
|
+ MAT1,IDMAT1,MAT2,IDMAT2,MAT3,IDMAT3,MAT4,IDMAT4,
|
|
+ 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,
|
|
+ MAT1,IDMAT1,MAT2,IDMAT2,MAT3,IDMAT3,MAT4,IDMAT4,
|
|
+ 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),MAT3,IDMAT3,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,
|
|
+ MAT1,IDMAT1,MAT2,IDMAT2,MAT3,IDMAT3,MAT4,IDMAT4,
|
|
+ WEIGHT(IWT))
|
|
SCMIN = CUTOFF(MOTIF)
|
|
SCMAX = LENGTH(MOTIF)
|
|
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,
|
|
+ MAT1,IDMAT1,MAT2,IDMAT2,MAT3,IDMAT3,MAT4,IDMAT4,
|
|
+ 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
|
|
MXWT = MAXWTS - IWT + 1
|
|
CALL GETMT5(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
|
|
SCMIN = CUTOFF(MOTIF)
|
|
IF(IPROB.EQ.0) THEN
|
|
CALL GETP(CLASS(MOTIF),STRING(ISTRNG),
|
|
+ LENGTH(MOTIF),IDM,
|
|
+ MAT1,IDMAT1,MAT2,IDMAT2,MAT3,IDMAT3,MAT4,IDMAT4,
|
|
+ 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.6)THEN
|
|
CALL GETMT6(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,
|
|
+ MAT1,IDMAT1,MAT2,IDMAT2,MAT3,IDMAT3,MAT4,IDMAT4,
|
|
+ WEIGHT(IWT))
|
|
SCMIN = CUTOFF(MOTIF)
|
|
SCMAX = LENGTH(MOTIF)*2
|
|
PROB = PSCORE(SCMIN)
|
|
PMAX = PSCORE(SCMAX)
|
|
PMIN = PROB
|
|
END IF
|
|
XRAN = ABS(RANGEM(MOTIF))-ABS(RANGET(MOTIF))+1
|
|
ELSE IF(CLASS(MOTIF).EQ.7)THEN
|
|
MXSTR = MAXSTR - ISTRNG + 1
|
|
CALL GETMT7(STRING(ISTRNG),MXSTR,LENGTH(MOTIF),KBIN,KBOUT,
|
|
+ IOK,JDEV,CUTOFF(MOTIF),
|
|
+ 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,
|
|
+ MAT1,IDMAT1,MAT2,IDMAT2,MAT3,IDMAT3,MAT4,IDMAT4,
|
|
+ WEIGHT(IWT))
|
|
STRNGS(MOTIF) = ISTRNG
|
|
ISTRNG = ISTRNG + LENGTH(MOTIF)
|
|
SCMIN = LENGTH(MOTIF)
|
|
PROB = PSCORE(SCMIN)
|
|
PMIN = PROB
|
|
PMAX = PROB
|
|
END IF
|
|
XRAN = 1.0 / CUTOFF(MOTIF)
|
|
ELSE IF(CLASS(MOTIF).EQ.8)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,
|
|
+ MAT1,IDMAT1,MAT2,IDMAT2,MAT3,IDMAT3,MAT4,IDMAT4,
|
|
+ WEIGHT(IWT))
|
|
SCMIN = CUTOFF(MOTIF)
|
|
SCMAX = LENGTH(MOTIF)
|
|
PROB = PSCORE(SCMIN)
|
|
PMAX = PSCORE(SCMAX)
|
|
PMIN = PROB
|
|
END IF
|
|
XRAN = ABS(RANGEM(MOTIF))-ABS(RANGET(MOTIF))+1
|
|
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 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 GETMT4(WEIGHT,MAXWTS,LENGTH,CUTOFF,YMAX,IDEV,
|
|
+KBIN,KBOUT,IOK,JDEV,FILNAM,IDM,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,IPROB)
|
|
CHARACTER HELPF*(*)
|
|
PARAMETER (MAXLEN = 120, MAXCHR = 5)
|
|
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 GETMT5(WEIGHT,MAXWTS,LENGTH,CUTOFF,SCMAX,IDEV,
|
|
+KBIN,KBOUT,IOK,JDEV,FILNAM,IDM,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,IPROB)
|
|
CHARACTER HELPF*(*)
|
|
REAL WEIGHT(MAXWTS)
|
|
CHARACTER FILNAM*(*)
|
|
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
|
|
CALL RDMT5(WEIGHT,MAXWTS,LENGTH,CUTOFF,SCMAX,IDEV,IOK,IDM,KBOUT,
|
|
+IPROB)
|
|
END
|
|
C*********************************************************************
|
|
SUBROUTINE RDMT5(WEIGHT,MAXWTS,LENGTH,CUTOFF,YMAX,IDEV,IOK,IDM,
|
|
+KBOUT,IPROB)
|
|
C AUTHOR: RODGER STADEN
|
|
PARAMETER (MAXLEN = 120, MAXCHR = 5)
|
|
REAL WEIGHT(MAXWTS)
|
|
INTEGER TOT(MAXLEN),SUM(MAXCHR,MAXLEN)
|
|
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
|
|
CALL GETW(TOT,SUM,WEIGHT,LENGTH,IDM,MAXLEN)
|
|
C NOW COMPLEMENT THE WEIGHT MATRIX
|
|
CALL COMPWM(WEIGHT,LENGTH,MAXLEN,IDM)
|
|
END
|
|
C*********************************************************************
|
|
SUBROUTINE GETMT6(RANGES,RANGEL,LENGTH,CUTOFF,
|
|
+KBIN,KBOUT,JDEV,IOK,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH)
|
|
CHARACTER HELPF*(*)
|
|
INTEGER RANGES,RANGEL
|
|
C GETS DETAILS FOR MOTIF CLASS 6
|
|
IF(JDEV.EQ.KBIN)THEN
|
|
IOK = 1
|
|
MININ = 1
|
|
MAXIN = 60
|
|
LENGTH = 6
|
|
CALL GETINT(MININ,MAXIN,LENGTH,'Stem length',IVAL,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
LENGTH = IVAL
|
|
MININ = -LENGTH
|
|
MAXIN = 60
|
|
ID = 0
|
|
CALL GETINT(MININ,MAXIN,ID,'Minimum loop length',
|
|
+IVAL,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
ID = IVAL
|
|
MININ = ID
|
|
MAXIN = 60
|
|
IR = ID
|
|
CALL GETINT(MININ,MAXIN,IR,'Maximum loop length',
|
|
+IVAL,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
IR = IVAL
|
|
SMININ = 1
|
|
SMAXIN = 2 * LENGTH
|
|
CUTOFF = SMAXIN
|
|
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
|
|
C COMMENT NEXT LINE TO ALLOW PALLINDROMES
|
|
C IF(IR.LT.0)GO TO 230
|
|
READ(JDEV,1006,ERR=901)CUTOFF
|
|
1006 FORMAT(F10.0)
|
|
END IF
|
|
RANGES = ID + 2*LENGTH
|
|
RANGEL = IR + 2*LENGTH
|
|
IOK = 0
|
|
RETURN
|
|
901 CONTINUE
|
|
IOK = 1
|
|
END
|
|
C*********************************************************************
|
|
SUBROUTINE GETMT7(STRING,MAXSTR,LENGTH,KBIN,KBOUT,IOK,JDEV,STEP,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH)
|
|
CHARACTER HELPF*(*)
|
|
CHARACTER NEW(50),STRING(MAXSTR)
|
|
REAL STEP
|
|
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)
|
|
MININ = 1
|
|
MAXIN = 20
|
|
ISTEP = 3
|
|
CALL GETINT(MININ,MAXIN,ISTEP,'Step',IVAL,KBIN,KBOUT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
ISTEP = IVAL
|
|
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)ISTEP
|
|
1002 FORMAT(I6)
|
|
END IF
|
|
STEP = ISTEP
|
|
IF(ISTEP.LT.1)STEP = 3.0
|
|
IOK = 0
|
|
RETURN
|
|
901 CONTINUE
|
|
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
|
|
SMININ = 1
|
|
SMAXIN = LENGTH
|
|
CUTOFF = SMAXIN
|
|
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 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,1007)TITLE
|
|
1007 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,RELEND(I),RELMOT(I)
|
|
1008 FORMAT(' and the 5 prime base can take positions',
|
|
+ I7,' to ',I7,/,
|
|
+ ' relative to the ',I1,' prime 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,RELEND(I),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,RELEND(I),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,RELEND(I),RELMOT(I)
|
|
ELSE IF(CLASS(I).EQ.5)THEN
|
|
WRITE(KBOUT,1011)CUTOFF(I)
|
|
1011 FORMAT(' Which is a match to the complement of a',
|
|
+ ' weight matrix with score',
|
|
+ F8.3)
|
|
IF(I.NE.1)
|
|
+ WRITE(KBOUT,1008)RANGES(I)+1,
|
|
+ RANGES(I)+RANGEL(I)-LENGTH(I)+1,RELEND(I),RELMOT(I)
|
|
ELSE IF(CLASS(I).EQ.6)THEN
|
|
WRITE(KBOUT,1005)LENGTH(I),CUTOFF(I)
|
|
1005 FORMAT(' Which is a stem-loop structure with stem length',I5,
|
|
+ ' and score ',F6.0)
|
|
WRITE(KBOUT,1006)RANGET(I)-2*LENGTH(I),RANGEM(I)-2*LENGTH(I)
|
|
1006 FORMAT(' The loop can have sizes ',I6,' to ',I6)
|
|
IF(I.NE.1)
|
|
+ WRITE(KBOUT,1008)RANGES(I)+1,
|
|
+ RANGES(I)+RANGEL(I),RELEND(I),RELMOT(I)
|
|
ELSE IF(CLASS(I).EQ.7)THEN
|
|
WRITE(KBOUT,1002)
|
|
+ (STRING(K),K=STRNGS(I),STRNGS(I)+LENGTH(I)-1)
|
|
WRITE(KBOUT,1013)INT(CUTOFF(I))
|
|
1013 FORMAT(' with a step size of',I6)
|
|
IF(I.NE.1)
|
|
+ WRITE(KBOUT,1008)RANGES(I)+1,
|
|
+ RANGES(I)+RANGEL(I)-LENGTH(I)+1,RELEND(I),RELMOT(I)
|
|
ELSE IF(CLASS(I).EQ.8)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),RELEND(I),RELMOT(I)
|
|
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,TITLE,KBIN,KBOUT)
|
|
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),SCLASS*10
|
|
CHARACTER*(*) KEYNS(NMOT)
|
|
CHARACTER*(*) NAMSAV(NMOT),TITLE
|
|
C
|
|
C
|
|
C SAVE THE SIGNAL
|
|
C
|
|
1 CONTINUE
|
|
LIN = 0
|
|
CALL GTSTR('Pattern title',' ',TITLE,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)TITLE
|
|
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')
|
|
IF(CLASS(RELMOT(I)).EQ.6)WRITE(IDEV,1007)RELEND(I)
|
|
1007 FORMAT(I7,' Relative end')
|
|
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)
|
|
ELSE IF(CLASS(I).EQ.5)THEN
|
|
WRITE(IDEV,1005)NAMSAV(I)
|
|
ELSE IF(CLASS(I).EQ.6)THEN
|
|
WRITE(IDEV,1010)LENGTH(I)
|
|
1010 FORMAT(I7,' Length')
|
|
WRITE(IDEV,1012)RANGET(I)-2*LENGTH(I)
|
|
WRITE(IDEV,1013)RANGEM(I)-2*LENGTH(I)
|
|
1012 FORMAT(I7,' Minimum loop')
|
|
1013 FORMAT(I7,' Maximum loop')
|
|
WRITE(IDEV,1009)CUTOFF(I)
|
|
1009 FORMAT(F10.5,' Cutoff')
|
|
ELSE IF(CLASS(I).EQ.7)THEN
|
|
WRITE(IDEV,1002)
|
|
+ (STRING(K),K=STRNGS(I),STRNGS(I)+LENGTH(I)-1)
|
|
WRITE(IDEV,1006)
|
|
WRITE(IDEV,1015)INT(CUTOFF(I))
|
|
1015 FORMAT(I7,' Step size')
|
|
ELSE IF(CLASS(I).EQ.8)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)
|
|
END IF
|
|
100 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
|
|
CDEBUG
|
|
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
|
|
IF(CLASS(NOTIF).EQ.6)THEN
|
|
IF(RELEND(JMOT).EQ.3) START(JMOT) = MATCHQ(MOTIF) +
|
|
+ RANGES(JMOT)
|
|
IF(RELEND(JMOT).EQ.5) START(JMOT) = MATCHP(MOTIF) +
|
|
+ RANGES(JMOT)
|
|
ELSE
|
|
START(JMOT) = START(MOTIF) + RANGES(JMOT) - 1
|
|
END IF
|
|
C NEXT LINE 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)
|
|
CDEBUG
|
|
C DO 1000 I = 1,NMOT
|
|
C WRITE(*,*)'START',START(I)
|
|
C1000 CONTINUE
|
|
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
|
|
CDEBUG
|
|
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
|
|
C CHANGE ON NEXT LINE MADE 30-07-7
|
|
C IF((CLASS(MOTIF).EQ.6).AND.(RELEND(MOTIF).EQ.3))
|
|
C + START(MOTIF) = MATCHQ(IREL) + RANGES(MOTIF)
|
|
IF(CLASS(IREL).EQ.6)THEN
|
|
IF(RELEND(MOTIF).EQ.3)
|
|
+ START(MOTIF) = MATCHQ(IREL) + RANGES(MOTIF)
|
|
IF(RELEND(MOTIF).EQ.5)
|
|
+ START(MOTIF) = MATCHP(IREL) + RANGES(MOTIF)
|
|
ELSE
|
|
START(MOTIF) = START(IREL) + RANGES(MOTIF)
|
|
END IF
|
|
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
|
|
C CHANGE ON NEXT LINE MADE 30-07-87
|
|
C IF((CLASS(MOTIF).EQ.6).AND.(RELEND(MOTIF).EQ.3))
|
|
C + START(MOTIF) = MATCHQ(IREL) + RANGES(MOTIF)
|
|
IF(CLASS(IREL).EQ.6)THEN
|
|
IF(RELEND(MOTIF).EQ.3)
|
|
+ START(MOTIF) = MATCHQ(IREL) + RANGES(MOTIF)
|
|
IF(RELEND(MOTIF).EQ.5)
|
|
+ START(MOTIF) = MATCHP(IREL) + RANGES(MOTIF)
|
|
ELSE
|
|
START(MOTIF) = START(IREL) + RANGES(MOTIF)
|
|
END IF
|
|
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)
|
|
CDEBUG
|
|
C DO 1000 I = 1,NMOT
|
|
C WRITE(*,*)'START',START(I)
|
|
C1000 CONTINUE
|
|
END
|
|
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 FIND6(SEQ(ISTART),L1,STRING,IDIM2,ISTEP,IFOUND)
|
|
IF(IFOUND.EQ.0)RETURN
|
|
C SAVE MATCH POSITION
|
|
MATCHP = ISTART+IFOUND-1
|
|
MATCHS = IDIM2
|
|
RETURN
|
|
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
|
|
RETURN
|
|
END
|
|
SUBROUTINE GETCLS(JDEV,KBOUT,ICLASS,TCLASS,KEYNAM)
|
|
CHARACTER TCLASS,STRING*21,NUMBER*10,STRNG2*10,KEYNAM*(*)
|
|
SAVE NUMBER
|
|
DATA NUMBER/'0987654321'/
|
|
C WRITE(*,*)'JDEV,KBOUT,ICLASS,TCLASS',JDEV,KBOUT,ICLASS,TCLASS
|
|
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
|
|
C*********************************************************************
|
|
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 IUBM1
|
|
EXTERNAL IUBM1
|
|
MINSCR = MINSC
|
|
IDIF=(IE-IS+2)-IDIM2
|
|
IPSEQ=IS
|
|
DO 200 I=1,IDIF
|
|
NTOT=0
|
|
IP=IPSEQ
|
|
DO 100 J=1,IDIM2
|
|
NTOT = NTOT + IUBM1(STRING(J),SEQ(IP))
|
|
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
|
|
RETURN
|
|
END
|
|
SUBROUTINE GETP(ICLASS,STRING,LENGTH,IDM,
|
|
+MAT1,IDMAT1,MAT2,IDMAT2,MAT3,IDMAT3,MAT4,IDMAT4,WEIGHT)
|
|
C MAT1 SIMPLE IDENTITY
|
|
C MAT2 IUB SCORES 0-1
|
|
C MAT3 IUB SCORES 0-36
|
|
C MAT4 INVERTED REPEAT
|
|
PARAMETER (
|
|
+ MAXCHR=17,
|
|
+ MAXSIG=120)
|
|
INTEGER MAT1(IDMAT1,IDMAT1),MAT2(IDMAT2,IDMAT2)
|
|
INTEGER MAT3(IDMAT3,IDMAT3),MAT4(IDMAT4,IDMAT4)
|
|
INTEGER IWT(MAXCHR,MAXSIG)
|
|
REAL WEIGHT(IDM,LENGTH),FB(MAXCHR),F(MAXCHR)
|
|
CHARACTER STRING(LENGTH)
|
|
COMMON /COMPC/COMP(MAXCHR)
|
|
DO 10 I = 1,MAXCHR
|
|
F(I) = COMP(I)
|
|
10 CONTINUE
|
|
IF(ICLASS.EQ.1)THEN
|
|
CALL GETP1(STRING,LENGTH,IDMAT3,MAT2,IDMAT2,IWT,F)
|
|
RETURN
|
|
END IF
|
|
IF(ICLASS.EQ.2)THEN
|
|
CALL GETP1(STRING,LENGTH,IDMAT3,MAT2,IDMAT2,IWT,F)
|
|
RETURN
|
|
END IF
|
|
IF(ICLASS.EQ.3)THEN
|
|
CALL GETP3(STRING,LENGTH,IDMAT3,MAT3,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 GETP4(WEIGHT,IWT,IDM,LENGTH,F)
|
|
RETURN
|
|
END IF
|
|
IF(ICLASS.EQ.6)THEN
|
|
CALL GETP8(MAT4,IDMAT4,IWT,IDM,LENGTH,F,FB)
|
|
RETURN
|
|
END IF
|
|
IF(ICLASS.EQ.7)THEN
|
|
CALL GETP1(STRING,LENGTH,IDMAT3,MAT2,IDMAT2,IWT,F)
|
|
RETURN
|
|
END IF
|
|
IF(ICLASS.EQ.8)THEN
|
|
CALL GETP8(MAT1,IDMAT1,IWT,IDM,LENGTH,F,FB)
|
|
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)
|
|
C AUTHOR RODGER STADEN
|
|
C PROBABILITIES FOR DIRECT AND INVERTED REPEATS
|
|
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)
|
|
SMIN = MIN(SMIN,T)
|
|
SMAX = MAX(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 (I.E 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
|
|
DO 20 I = 1,IDIM
|
|
J = DTONUM(SEQ(I))
|
|
COMP(J) = COMP(J) + 1.
|
|
20 CONTINUE
|
|
T = MAX(1,IDIM)
|
|
DO 30 I = 1,IDM
|
|
COMP(I) = COMP(I) / T
|
|
30 CONTINUE
|
|
END
|
|
SUBROUTINE MATSC(MAT,IDMAT,IWT,MAXCHR,LENGTH,MAXS,
|
|
+SMIN,SCALE)
|
|
INTEGER IWT(IDMAT,IDMAT)
|
|
INTEGER MAT(IDMAT,IDMAT)
|
|
PARAMETER (SMALL=1E-10)
|
|
PARAMETER (MAXPOL = 4000)
|
|
ISMIN = 99999999
|
|
ISMAX = -99999999
|
|
DO 100 J = 1,IDMAT
|
|
DO 90 I = 1,IDMAT
|
|
K = MAT(I,J)
|
|
ISMIN = MIN(ISMIN,K)
|
|
ISMAX = MAX(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) = MAT(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 EFTOUT(FTNAME,I1,I2,IDEV)
|
|
CHARACTER LINOUT*80,FTNAME*(*)
|
|
EXTERNAL ITOSL
|
|
C produces ft lines from a pair of positions
|
|
LINOUT = 'FT '
|
|
LINOUT(6:80) = FTNAME
|
|
L = 22
|
|
J = ITOSL(LINOUT(L:),I1)
|
|
IF(J.EQ.0) GO TO 100
|
|
L = L + J
|
|
LINOUT(L:L+1) = '..'
|
|
L = L + 2
|
|
J = ITOSL(LINOUT(L:),I2)
|
|
IF(J.EQ.0) GO TO 100
|
|
WRITE(IDEV,1000,ERR=100)LINOUT
|
|
1000 FORMAT(A)
|
|
RETURN
|
|
100 CONTINUE
|
|
WRITE(*,*)'Error in EFTOUT'
|
|
END
|