1152 lines
36 KiB
Fortran
1152 lines
36 KiB
Fortran
C 24-9-90 Changed definition of xmax from xmax=idseq to xmax=idseq+kstart-1
|
|
C because a match with j1=53000, j2=59000 did not get plotted. Note
|
|
C that kstart is called j1 in main
|
|
C 5-11-90 Very many changes for addition of file of file names, plus
|
|
C replacement of calls to radio by radion
|
|
C 18-7-91 added titles to pattern files
|
|
C 2-3-92 set filnam = ' ' for calls to openf1
|
|
SUBROUTINE PATTEN(SEQ,IDSEQ,STRING,MAXSTR,
|
|
+LENGTH,CLASS,RELMOT,RANGES,RANGEL,RANGET,RANGEM,IENTRY,
|
|
+START2,IEND2,WTSTR,START,IEND,MATCHQ,RELEND,MATCHP,
|
|
+STRNGS,LAST5,LAST3S,LAST3E,MATCHS,CUTOFF,WEIGHT,FILNAM,
|
|
+MAXMOT,MAXWTS,
|
|
+IDEV1,IDEV2,IDEV3,
|
|
+MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,KSTART,KBIN,KBOUT,
|
|
+IDEV4,IDM,COMBIN,IDME,MAT1,MAT2,MAT3,MAT4,NAMSAV,KEYNS,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,FOFNAM,IDEVFF)
|
|
INTEGER LENGTH(MAXMOT),CLASS(MAXMOT),RELMOT(MAXMOT)
|
|
INTEGER RANGES(MAXMOT),RANGEL(MAXMOT)
|
|
INTEGER RANGET(MAXMOT),RANGEM(MAXMOT),IENTRY(MAXMOT)
|
|
INTEGER START2(MAXMOT),IEND2(MAXMOT)
|
|
CHARACTER SEQ(IDSEQ),STRING(MAXSTR)
|
|
INTEGER WTSTR(MAXMOT),START(MAXMOT),IEND(MAXMOT)
|
|
INTEGER MATCHQ(MAXMOT),RELEND(MAXMOT)
|
|
INTEGER MATCHP(MAXMOT),STRNGS(MAXMOT)
|
|
INTEGER LAST5(MAXMOT),LAST3S(MAXMOT),LAST3E(MAXMOT)
|
|
INTEGER MAT1(IDM,IDM),MAT2(IDME,IDME)
|
|
INTEGER MAT3(IDME,IDME),MAT4(IDM,IDM)
|
|
REAL WEIGHT(MAXWTS),CUTOFF(MAXMOT),MATCHS(MAXMOT)
|
|
REAL MINSCR,MAXSCR
|
|
CHARACTER FILNAM*(*),HELPF*(*),FOFNAM*(*),TITLE*80
|
|
CHARACTER COMBIN(MAXMOT)
|
|
CHARACTER*(*) NAMSAV(MAXMOT),KEYNS(MAXMOT)
|
|
PARAMETER (MAXCLS = 8)
|
|
PARAMETER (SMALL=1.0E-5)
|
|
C MAT1 SIMPLE IDENTITY
|
|
C MAT2 IUB SCORES 0-1
|
|
C MAT3 IUB SCORES 0-36
|
|
C MAT4 INVERTED REPEAT
|
|
C
|
|
PARAMETER (MAXPRM = 30)
|
|
CHARACTER PROMPT(4)*(MAXPRM)
|
|
WRITE(KBOUT,*)' Pattern searcher'
|
|
JDEV = KBIN
|
|
PROMPT(1) = 'Use keyboard'
|
|
PROMPT(2) = 'Use pattern file'
|
|
PROMPT(3) = 'Use file of pattern file names'
|
|
IN = 1
|
|
CALL RADION('Select pattern definition mode',PROMPT,3,IN,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(IN.LT.1) RETURN
|
|
IF(IN.EQ.2)THEN
|
|
FILNAM = ' '
|
|
CALL OPENF1(IDEV3,FILNAM,0,IOK,KBIN,KBOUT,
|
|
+ 'Pattern definition file',
|
|
+ IHELPS,IHELPE,HELPF,IDEVH)
|
|
IF(IOK.NE.0)RETURN
|
|
JDEV = IDEV3
|
|
ELSE IF(IN.EQ.3) THEN
|
|
FOFNAM = ' '
|
|
CALL OPENF1(IDEVFF,FOFNAM,0,IOK,KBIN,KBOUT,
|
|
+ 'File of pattern file names',
|
|
+ IHELPS,IHELPE,HELPF,IDEVH)
|
|
IF(IOK.NE.0)RETURN
|
|
JDEV = IDEV3
|
|
END IF
|
|
IOPT = 1
|
|
PROMPT(1) = 'Motif by motif'
|
|
PROMPT(2) = 'Inclusive'
|
|
PROMPT(3) = 'Graphical'
|
|
PROMPT(4) = 'EMBL feature table'
|
|
CALL RADION('Select results display mode',PROMPT,4,IOPT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(IOPT.LT.1) GO TO 201
|
|
IF((IN.EQ.3).AND.(IOPT.EQ.3)) IOPT = 2
|
|
PMINC = 1.
|
|
CUTSCR = -99999.
|
|
NPAT = 0
|
|
IPROB = 0
|
|
NTOTAL = 0
|
|
JTOTAL = 0
|
|
CALL SETCMP(SEQ,IDSEQ,IDME)
|
|
IF(IN.EQ.3) THEN
|
|
IPROB = 1
|
|
CALL BUSY(KBOUT)
|
|
END IF
|
|
10 CONTINUE
|
|
IF(IN.EQ.3) THEN
|
|
READ(IDEVFF,1000,ERR=100,END=200)FOFNAM
|
|
CALL OPENRS(IDEV3,FOFNAM,IOK,LRECL,2)
|
|
IF(IOK.NE.0) GO TO 200
|
|
NPAT = NPAT + 1
|
|
END IF
|
|
1000 FORMAT(A)
|
|
C ZERO ARRAYS
|
|
C
|
|
CALL FILLI(LENGTH,MAXMOT,0)
|
|
CALL FILLI(CLASS,MAXMOT,0)
|
|
CALL FILLI(RELMOT,MAXMOT,0)
|
|
CALL FILLI(RANGES,MAXMOT,0)
|
|
CALL FILLI(RANGEL,MAXMOT,0)
|
|
CALL FILLI(RANGET,MAXMOT,0)
|
|
CALL FILLI(RANGEM,MAXMOT,0)
|
|
CALL FILLI(IENTRY,MAXMOT,0)
|
|
CALL FILLI(START2,MAXMOT,0)
|
|
CALL FILLI(IEND2,MAXMOT,0)
|
|
CALL FILLI(WTSTR,MAXMOT,0)
|
|
CALL FILLI(START,MAXMOT,0)
|
|
CALL FILLI(IEND,MAXMOT,0)
|
|
CALL FILLI(MATCHQ,MAXMOT,0)
|
|
CALL FILLI(RELEND,MAXMOT,0)
|
|
CALL FILLI(MATCHP,MAXMOT,0)
|
|
CALL FILLI(STRNGS,MAXMOT,0)
|
|
CALL FILLI(LAST5,MAXMOT,0)
|
|
CALL FILLI(LAST3S,MAXMOT,0)
|
|
CALL FILLI(LAST3E,MAXMOT,0)
|
|
CALL FILLR(CUTOFF,MAXMOT,0.0)
|
|
CALL FILLR(MATCHS,MAXMOT,0.0)
|
|
CALL FILLR(WEIGHT,MAXWTS,0.0)
|
|
CALL FILLC(COMBIN,MAXMOT,'A')
|
|
ITOTAL = 0
|
|
C
|
|
C
|
|
C
|
|
C GET MOTIF DEFINITIONS
|
|
C
|
|
C RETURN STRING LENGTH FOR COMPATIBILITY WITH LIB SEARCH
|
|
NSTRNG = MAXSTR
|
|
IF(IN.EQ.1) THEN
|
|
CALL GETMK(KBIN,KBOUT,STRING,NSTRNG,ISTRNG,
|
|
+ LENGTH,MAXMOT,CLASS,RELMOT,RANGES,RANGEL,
|
|
+ RANGET,RANGEM,
|
|
+ STRNGS,NMOT,WEIGHT,MAXWTS,CUTOFF,IDEV2,
|
|
+ WTSTR,JDEV,IOK,RELEND,IDSEQ,IDEV4,IDM,COMBIN,
|
|
+ MAXCLS,
|
|
+ MAT1,IDM,MAT2,IDME,MAT3,IDME,MAT4,IDM,
|
|
+ PMINT,PMAXT,PROBT,EXPTT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,KEYNS,NAMSAV,FILNAM,TITLE)
|
|
ELSE
|
|
CALL GETMF(KBIN,KBOUT,STRING,NSTRNG,ISTRNG,
|
|
+ LENGTH,MAXMOT,CLASS,RELMOT,RANGES,RANGEL,
|
|
+ RANGET,RANGEM,
|
|
+ STRNGS,NMOT,WEIGHT,MAXWTS,CUTOFF,IDEV2,
|
|
+ WTSTR,JDEV,IOK,RELEND,IDSEQ,IDEV4,IDM,COMBIN,
|
|
+ MAXCLS,
|
|
+ MAT1,IDM,MAT2,IDME,MAT3,IDME,MAT4,IDM,
|
|
+ PMINT,PMAXT,PROBT,EXPTT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,KEYNS,NAMSAV,FILNAM,IPROB,TITLE)
|
|
END IF
|
|
IF(IOK.NE.0) GO TO 201
|
|
IF(NMOT.LT.1) GO TO 201
|
|
C
|
|
C
|
|
C DISPLAY THE SIGNAL DESCRIPTION
|
|
C
|
|
RANGES(1) = 1
|
|
IF(IN.NE.3) THEN
|
|
CALL DESSIG(
|
|
+ KBOUT,STRING,MAXSTR,
|
|
+ LENGTH,CLASS,RELMOT,RANGES,RANGEL,
|
|
+ RANGET,RANGEM,
|
|
+ STRNGS,NMOT,WEIGHT,MAXWTS,CUTOFF,
|
|
+ WTSTR,RELEND,COMBIN,KEYNS,TITLE)
|
|
C
|
|
C
|
|
WRITE(KBOUT,2003)PROBT
|
|
2003 FORMAT(' Probability of finding pattern = ',E10.4)
|
|
WRITE(KBOUT,2004)EXPTT
|
|
2004 FORMAT(' Expected number of matches = ',E10.4)
|
|
CALL GETRL(0.,1.,1.0,'Maximum pattern probability',
|
|
+ XP,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
PMINC = XP
|
|
CALL GETRL(-9999.,9999.,-9999.,'Minimum pattern score',
|
|
+ XP,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
CUTSCR = XP
|
|
MINSCR = 9999999.
|
|
MAXSCR = -9999999.
|
|
YMIN = LOG(1.-PMINT)
|
|
YMAX = LOG(1.-PMAXT)
|
|
YDEL = ABS(YMIN - YMAX)
|
|
IF(YDEL.LT.SMALL)THEN
|
|
YMAX = YMAX + SMALL
|
|
YMIN = YMIN - SMALL
|
|
END IF
|
|
YDEL = ABS(YMIN - YMAX) * 0.1
|
|
YMIN = YMIN - YDEL
|
|
YMAX = YMAX + YDEL
|
|
CALL BUSY(KBOUT)
|
|
END IF
|
|
IF(IOPT.EQ.3)THEN
|
|
XMAX = IDSEQ + KSTART - 1
|
|
XMIN = KSTART
|
|
CALL VECTOM
|
|
CALL FRAME(MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
|
|
CALL CLEARV
|
|
END IF
|
|
C
|
|
C DO THE SEARCH
|
|
C
|
|
CALL SRCSIG(KBIN,KBOUT,WTSTR,LENGTH,CLASS,
|
|
+RANGES,RANGEL,START,IEND,RELMOT,MATCHP,STRNGS,WEIGHT,
|
|
+MAXWTS,CUTOFF,MATCHS,NMOT,STRING,MAXSTR,SEQ,IDSEQ,
|
|
+RANGET,RANGEM,IENTRY,START2,IEND2,MATCHQ,RELEND,
|
|
+IDEV1,LAST5,LAST3S,LAST3E,MARGL,MARGR,MARGB,MARGT,ISXMAX,
|
|
+ISYMAX,IOPT,XMAX,XMIN,YMAX,YMIN,ITOTAL,KSTART,IDM,COMBIN,
|
|
+CUTSCR,MINSCR,MAXSCR,IDME,PMINT,PMAXT,PROBT,MAT1,MAT2,MAT3,
|
|
+MAT4,PMINC,KEYNS)
|
|
CALL VT100M
|
|
IF(IN.EQ.3) THEN
|
|
IF(ITOTAL.NE.0) THEN
|
|
WRITE(IDEV1,1003)TITLE
|
|
1003 FORMAT(' ',A)
|
|
WRITE(IDEV1,1001)FOFNAM,ITOTAL
|
|
1001 FORMAT(' ',A,' ',I6,/)
|
|
NTOTAL = NTOTAL + ITOTAL
|
|
JTOTAL = JTOTAL + 1
|
|
END IF
|
|
GO TO 10
|
|
END IF
|
|
WRITE(KBOUT,1002)ITOTAL
|
|
1002 FORMAT(' Total matches found',I7)
|
|
IF((ITOTAL.GT.0).AND.(IN.NE.3))WRITE(KBOUT,1006)MINSCR,MAXSCR
|
|
1006 FORMAT(' Minimum and maximum observed scores',2F12.2)
|
|
RETURN
|
|
100 CONTINUE
|
|
WRITE(KBOUT,*)'Error reading file of file names'
|
|
200 CONTINUE
|
|
WRITE(KBOUT,*)'Of the ',NPAT,' patterns processed'
|
|
WRITE(KBOUT,*)JTOTAL,' gave a total of',NTOTAL,' matches'
|
|
201 CONTINUE
|
|
CLOSE(UNIT=IDEVFF)
|
|
END
|
|
SUBROUTINE GETMK(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,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*(*)
|
|
REAL WEIGHT(MAXWTS),CUTOFF(MAXMOT)
|
|
CHARACTER COMBIN(MAXMOT),TCLASS
|
|
INTEGER MAT1(IDMAT1,IDMAT1),MAT2(IDMAT2,IDMAT2)
|
|
INTEGER MAT3(IDMAT3,IDMAT3),MAT4(IDMAT4,IDMAT4)
|
|
CHARACTER*(*) KEYNS(MAXMOT)
|
|
CHARACTER*(*) NAMSAV(MAXMOT),TITLE
|
|
PARAMETER (MAXPRM = 31)
|
|
CHARACTER PROMPT(9)*(MAXPRM)
|
|
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 = 0
|
|
IPROB = 0
|
|
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
|
|
TCLASS = 'A'
|
|
C SET CLASS TO EXACT MATCH
|
|
ICLASS = 1
|
|
100 CONTINUE
|
|
IOK = 1
|
|
PROMPT(1) = 'Exact match'
|
|
PROMPT(2) = 'Percentage match'
|
|
PROMPT(3) = 'Cut-off score and score matrix'
|
|
PROMPT(4) = 'Cut-off score and weight matrix'
|
|
PROMPT(5) = 'Complement of weight matrix'
|
|
PROMPT(6) = 'Inverted repeat or stem-loop'
|
|
PROMPT(7) = 'Exact match, defined step'
|
|
PROMPT(8) = 'Direct repeat'
|
|
PROMPT(9) = 'Pattern complete'
|
|
CALL RADION('Select motif definition mode',PROMPT,9,ICLASS,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(ICLASS.LT.1) RETURN
|
|
IF(ICLASS.EQ.9)GO TO 900
|
|
101 CONTINUE
|
|
LKEY = 0
|
|
CALL GTSTR('Motif name',' ',KEYNS(MOTIF+1),LKEY,
|
|
+KBOUT,KBIN,INFLAG)
|
|
IF(INFLAG.EQ.2) RETURN
|
|
IF(INFLAG.EQ.1) THEN
|
|
CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
GO TO 101
|
|
END IF
|
|
IF(MOTIF.GT.0) THEN
|
|
IF(COMBIN(MOTIF).NE.'N') THEN
|
|
PROMPT(1) = 'And'
|
|
PROMPT(2) = 'Or'
|
|
PROMPT(3) = 'Not'
|
|
IC = 1
|
|
CALL RADION('Select logical operator',PROMPT,3,IC,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(IC.LT.1) RETURN
|
|
IF(IC.EQ.1) TCLASS = 'A'
|
|
IF(IC.EQ.2) TCLASS = 'O'
|
|
IF(IC.EQ.3) TCLASS = 'N'
|
|
ELSE
|
|
PROMPT(1) = 'And'
|
|
PROMPT(2) = 'Not'
|
|
IC = 1
|
|
CALL RADION('Select logical operator',PROMPT,2,IC,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(IC.LT.1) RETURN
|
|
IF(IC.EQ.1) TCLASS = 'A'
|
|
IF(IC.EQ.2) TCLASS = 'N'
|
|
END IF
|
|
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
|
|
IOK = 0
|
|
IF((MOTIF.GT.1).AND.(COMBIN(MOTIF).NE.'O'))THEN
|
|
C WRITE(KBOUT,1002)
|
|
C1002 FORMAT(' RANGES ARE DEFINED RELATIVE TO OTHER MOTIFS',/,
|
|
C +' AND BY STARTS AND DISTANCES.')
|
|
IOK = 1
|
|
MININ = 1
|
|
MAXIN = MOTIF
|
|
211 CONTINUE
|
|
MAXIN = MAXIN - 1
|
|
IF(COMBIN(MAXIN).NE.'A') GO TO 211
|
|
IREL = MAXIN
|
|
CALL GETINT(MININ,MAXIN,IREL,'Number of reference motif',
|
|
+ IVAL,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
IREL = IVAL
|
|
RELMOT(MOTIF) = IREL
|
|
IOK = 1
|
|
IF(CLASS(IREL).EQ.6)THEN
|
|
CALL YESNO(MEND,'Relative to 5 prime end',
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(MEND.LT.0)RETURN
|
|
RELEND(MOTIF) = 5
|
|
IF(MEND.EQ.1)RELEND(MOTIF) = 3
|
|
END IF
|
|
MININ = -1000
|
|
MAXIN = 1000
|
|
ID = LENGTH(IREL) + 1
|
|
IF((CLASS(IREL).EQ.6).OR.(CLASS(IREL).EQ.8)) ID = 1
|
|
CALL GETINT(MININ,MAXIN,ID,'Relative start position',
|
|
+ IVAL,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
ID = IVAL
|
|
RANGES(MOTIF) = ID - 1
|
|
MININ = 0
|
|
MAXIN = 1000
|
|
IR = 0
|
|
CALL GETINT(MININ,MAXIN,IR,'Number of extra positions',
|
|
+ IVAL,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
IR = IVAL
|
|
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
|
|
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
|
|
RETURN
|
|
900 CONTINUE
|
|
EXPTT = EXPTT * EXPTS
|
|
PROBT = PROBT * PROBS
|
|
PMINT = PMINT * PMINS
|
|
PMAXT = PMAXT * PMAXS
|
|
CALL YESNO(IN,'Save pattern in a file',
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(IN.LT.0)RETURN
|
|
IF(IN.EQ.0)THEN
|
|
FILNAM = ' '
|
|
CALL OPENF1(IDEVSV,FILNAM,1,IOK,KBIN,KBOUT,
|
|
+ 'Pattern definition file',
|
|
+ IHELPS,IHELPE,HELPF,IDEVH)
|
|
IF(IOK.NE.0)RETURN
|
|
CALL SAVSIG(
|
|
+ IDEVSV,STRING,MAXSTR,
|
|
+ LENGTH,CLASS,RELMOT,RANGES,RANGEL,
|
|
+ RANGET,RANGEM,
|
|
+ STRNGS,NMOT,WEIGHT,MAXWTS,CUTOFF,
|
|
+ WTSTR,RELEND,NAMSAV,COMBIN,KEYNS,TITLE,KBIN,KBOUT)
|
|
CLOSE(UNIT=IDEVSV)
|
|
END IF
|
|
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 SRCSIG(KBIN,KBOUT,WTSTR,LENGTH,CLASS,
|
|
+RANGES,RANGEL,START,IEND,RELMOT,MATCHP,STRNGS,WEIGHT,
|
|
+MAXWTS,CUTOFF,MATCHS,NMOT,STRING,MAXSTR,SEQ,IDSEQ,
|
|
+RANGET,RANGEM,IENTRY,START2,IEND2,MATCHQ,RELEND,
|
|
+IDEVOT,LAST5,LAST3S,LAST3E,MARGL,MARGR,MARGB,MARGT,ISXMAX,
|
|
+ISYMAX,IOPT,XMAX,XMIN,YMAX,YMIN,ITOTAL,KSTART,IDM,COMBIN,
|
|
+CUTSCR,MINSCR,MAXSCR,IDME,PMINT,PMAXT,PROBT,MAT1,MAT2,MAT3,MAT4,
|
|
+PMINC,KEYNS)
|
|
C ROUTINE TO SEARCH FOR SIGNALS COMPOSED OF MOTIFS
|
|
C WEIGHT = WEIGHTS FOR MATRICES
|
|
C CUTOFF = CUTOFF SCORES
|
|
C LENGTH = MOTIF LENGTHS
|
|
C CLASS = MOTIF CLASS
|
|
C COMBIN = LOGICAL COMBINATION A, O, N
|
|
C WTSTR = POINTER TO WEIGHT STARTS
|
|
C RANGES = RANGES START
|
|
C RANGEL = RANGE LENGTH (A DISTANCE MEASURED FROM RANGES)
|
|
C RELMOT = MOTIF NUMBER THAT A RANGE IS RELATIVE TO IE THE
|
|
C FIRST MOTIF'S RANGE IS RELATIVE TO MOTIF 0, BUT
|
|
C ANY OTHER MOTIF MAY HAVE TO BE DEFINED RELATIVE
|
|
C TO ANY OTHER. THE MOST COMMON WOULD BE THE FIRST
|
|
C MOTIF OR THE LAST ONE SEARCHED FOR.
|
|
C RELEND = IS A SPECIAL CASE FLAG FOR STEMS. IT ALLOWS OTHER
|
|
C MOTIFS TO HAVE THEIR POSITIONS RELATIVE TO THE 3' SIDE
|
|
C OF A STEM. IT IS 5 FOR THE 5 PRIME SIDE, 3 FOR 3' SIDE
|
|
C START = RANGE START DURING SEARCH (SOME POSITIONS MAY HAVE
|
|
C BEEN TRIED)
|
|
C IEND = RANGE END POSITION FOR CURRENT INITIAL START (WHEN IT
|
|
C IS RESET DEPENDS ON WHETHER IT IS DEFINED RELATIVE TO
|
|
C THE FIRST OR THE PREVIOUS MOTIF. IF IT IS DEFINED RELATIVE
|
|
C TO THE FIRST MOTIF IT IS RESET WHEN WE FIND A MATCH FOR THE
|
|
C FIRST MOTIF. IF IT IS DEFINED RELATIVE TO THE PREVIOUS MOTIF
|
|
C WE MUST RESET WHEN WE MOVE FORWARD ONE MOTIF. I THINK THIS
|
|
C CAN BE TAKEN CARE OF BY UPDATING ALL THOSE MOTIFS THAT ARE
|
|
C DEFINED TO THE CURRENT MOTIF EVERY TIME WE MOVE FORWARD
|
|
C ONE MOTIF (IE IT INCLUDES THE FIRST MOTIF SO IT IS NOT A
|
|
C SPECIAL CASE). OTHERWISE WE UPDATE POSITIONS WHEN WE FIND
|
|
C A MATCH FOR THEM (WE SET TO THE MATCH POSITION PLUS 1)
|
|
C MATCHP = LIST OF CURRENT MATCH POSITIONS FOR EACH MOTIF
|
|
C MATCHS = LIST OF CURRENT MATCH SCORES FOR EACH MOTIF
|
|
C IFOUND = A FLAG TO INDICATE SUCCESS OR FAILURE OF A SEARCH ROUTINE
|
|
C 1 = SUCCESS, 0 = FAIL
|
|
C STRNGS = POINTER TO STRING STARTS IN CHARACTER ARRAY STRING
|
|
C TEMPORARY VALUES ARE:
|
|
C MOTIF = ACTUAL MOTIF NUMBER
|
|
C ICLASS = CLASS
|
|
C ILEN = LENGTH OF MOTIF
|
|
C CUT = CUTOFF
|
|
C WT = START OF WEIGHTS FOR THIS MOTIF
|
|
C ISTRST = START OF STRING
|
|
C RANGET = START OF 3' RANGE FOR STEM SEARCHES
|
|
C RANGEM = END OF 3' RANGE FOR STEM SEARCHES
|
|
C IENTRY = FLAG TO SIGNIFY MORE 3' STEM POSITIONS FOR LAST 5' START
|
|
C 0 = NONE, ON RETURN FROM MOTIF6 IT CONTAINS THE 3' MATCH
|
|
C POSITION
|
|
C MATCHQ = MATCH POSITION FOR STEM SEARCH
|
|
C COMB = LOGICAL COMBINATION A, O, N
|
|
INTEGER WTSTR(NMOT),LENGTH(NMOT),CLASS(NMOT)
|
|
INTEGER RANGES(NMOT),RANGEL(NMOT),START(NMOT),IEND(NMOT)
|
|
INTEGER RELMOT(NMOT),MATCHP(NMOT),STRNGS(NMOT)
|
|
INTEGER RANGET(NMOT),RANGEM(NMOT),IENTRY(NMOT),RELEND(NMOT)
|
|
INTEGER START2(NMOT),IEND2(NMOT),MATCHQ(NMOT)
|
|
INTEGER LAST5(NMOT),LAST3S(NMOT),LAST3E(NMOT)
|
|
INTEGER MAT1(IDM,IDM),MAT2(IDME,IDME)
|
|
INTEGER MAT3(IDME,IDME),MAT4(IDM,IDM)
|
|
REAL WEIGHT(MAXWTS),CUTOFF(NMOT),MATCHS(NMOT)
|
|
REAL MINSCR,MAXSCR
|
|
CHARACTER SEQ(IDSEQ),STRING(MAXSTR)
|
|
CHARACTER COMBIN(NMOT),COMB
|
|
CHARACTER*(*) KEYNS(NMOT)
|
|
C
|
|
C
|
|
C INITIALIZE
|
|
JMOT = 0
|
|
IRET = 0
|
|
5 CONTINUE
|
|
JMOT = JMOT + 1
|
|
IF(JMOT.LE.NMOT)THEN
|
|
IF(RELMOT(JMOT).EQ.0)THEN
|
|
START(JMOT) = RANGES(1)
|
|
IEND(JMOT) = RANGES(1) + RANGEL(1) -1
|
|
GO TO 5
|
|
END IF
|
|
END IF
|
|
MOTIF = 1
|
|
ICLASS = CLASS(1)
|
|
ILEN = LENGTH(1)
|
|
CUT = CUTOFF(1)
|
|
IWT = WTSTR(1)
|
|
ISTRST = STRNGS(1)
|
|
IENTRY(1) = 0
|
|
COMB = COMBIN(1)
|
|
DO 10 I = 1,NMOT
|
|
MATCHP(I) = 0
|
|
10 CONTINUE
|
|
C
|
|
C
|
|
C
|
|
100 CONTINUE
|
|
C
|
|
C
|
|
C THIS A CLASS CLASS MOTIF, PERFORM THE APPROPRIATE SEARCH IF THE START
|
|
C POSITION IS >0. (IF IT IS NOT THE CURRENT MOTIF IS A NOT THAT HAS
|
|
C ALREADY BEEN SEARCHED FOR
|
|
C
|
|
IFOUND = 0
|
|
IF(START(MOTIF).GT.0)THEN
|
|
C
|
|
C
|
|
IF(ICLASS.EQ.1)THEN
|
|
C WRITE(*,*)'SRCSIG,MOTIF,ICLASS,START,END'
|
|
C WRITE(*,*)MOTIF,ICLASS,START(MOTIF),IEND(MOTIF)
|
|
CALL MOTIF1(SEQ,IDSEQ,STRING(ISTRST),ILEN,START(MOTIF),
|
|
+ IEND(MOTIF),MATCHP(MOTIF),MATCHS(MOTIF),IFOUND,
|
|
+ CUTOFF(MOTIF),0)
|
|
ELSE IF(ICLASS.EQ.2)THEN
|
|
CALL MOTIF2(SEQ,IDSEQ,STRING(ISTRST),ILEN,START(MOTIF),
|
|
+ IEND(MOTIF),CUT,MATCHP(MOTIF),MATCHS(MOTIF),IFOUND)
|
|
ELSE IF(ICLASS.EQ.3)THEN
|
|
CALL MOTIF3(SEQ,IDSEQ,STRING(ISTRST),ILEN,START(MOTIF),
|
|
+ IEND(MOTIF),CUT,MATCHP(MOTIF),MATCHS(MOTIF),IFOUND,MAT3,
|
|
+ IDME)
|
|
ELSE IF(ICLASS.EQ.4)THEN
|
|
CALL MOTIF4(SEQ,IDSEQ,ILEN,START(MOTIF),
|
|
+ IEND(MOTIF),WEIGHT(IWT),CUT,MATCHP(MOTIF),MATCHS(MOTIF),
|
|
+ IFOUND,IDM)
|
|
ELSE IF(ICLASS.EQ.5)THEN
|
|
CALL MOTIF4(SEQ,IDSEQ,ILEN,START(MOTIF),
|
|
+ IEND(MOTIF),WEIGHT(IWT),CUT,MATCHP(MOTIF),MATCHS(MOTIF),
|
|
+ IFOUND,IDM)
|
|
ELSE IF(ICLASS.EQ.6)THEN
|
|
CALL MOTIF6(SEQ,IDSEQ,MAT4,LENGTH(MOTIF),START(MOTIF),
|
|
+ IEND(MOTIF),RANGET(MOTIF),RANGEM(MOTIF),
|
|
+ CUTOFF(MOTIF),MATCHP(MOTIF),MATCHS(MOTIF),
|
|
+ IENTRY(MOTIF),IFOUND,MATCHQ(MOTIF),
|
|
+ LAST5(MOTIF),LAST3S(MOTIF),LAST3E(MOTIF),IDM)
|
|
ELSE IF(ICLASS.EQ.7)THEN
|
|
CALL MOTIF1(SEQ,IDSEQ,STRING(ISTRST),ILEN,START(MOTIF),
|
|
+ IEND(MOTIF),MATCHP(MOTIF),MATCHS(MOTIF),IFOUND,
|
|
+ CUTOFF(MOTIF),1)
|
|
ELSE IF(ICLASS.EQ.8)THEN
|
|
CALL MOTIF8(SEQ,IDSEQ,MAT2,LENGTH(MOTIF),START(MOTIF),
|
|
+ IEND(MOTIF),RANGET(MOTIF),RANGEM(MOTIF),
|
|
+ CUTOFF(MOTIF),MATCHP(MOTIF),MATCHS(MOTIF),
|
|
+ IENTRY(MOTIF),IFOUND,MATCHQ(MOTIF),
|
|
+ LAST5(MOTIF),LAST3S(MOTIF),LAST3E(MOTIF),IDME)
|
|
ELSE
|
|
WRITE(KBOUT,*)'UNKNOWN CLASS!!'
|
|
END IF
|
|
C
|
|
C
|
|
END IF
|
|
C
|
|
C
|
|
C MATCH FOUND WHEN MATCH WANTED ?
|
|
C
|
|
C
|
|
C
|
|
IF(((IFOUND.EQ.0).AND.(COMB.NE.'N')).OR.
|
|
+ ((IFOUND.GT.0).AND.(COMB.EQ.'N')))THEN
|
|
C
|
|
C NO SO GO BACK OR SIDEWAYS ONE MOTIF
|
|
C
|
|
C
|
|
CALL BAKSID(CLASS,LENGTH,CUTOFF,STRNGS,NMOT,
|
|
+ MOTIF,ICLASS,ILEN,CUT,IWT,ISTRST,WTSTR,
|
|
+ RELMOT,START,IEND,MATCHQ,RANGES,RANGEL,RELEND,IRET,MATCHP,
|
|
+ COMBIN,COMB)
|
|
C
|
|
C
|
|
C IF CANT GO BACK ANY FURTHER QUIT
|
|
IF(IRET.NE.0)RETURN
|
|
C
|
|
C
|
|
ELSE
|
|
C
|
|
C
|
|
C MATCH FOUND.
|
|
C
|
|
C
|
|
C PREPARE FOR NEXT SEARCH THIS MOTIF BY INCREMENTING POINTER
|
|
C TO SEARCH RANGE (NOT FOR CLASS 6 WHICH IS HANDLED BY MOTIF6)
|
|
C
|
|
C
|
|
IF(COMB.EQ.'N')THEN
|
|
START(MOTIF) = -9
|
|
ELSE
|
|
C IF((ICLASS.NE.6).AND.(ICLASS.NE.8))
|
|
C REPLACE LAST LINE 7-7-89
|
|
IF(ICLASS.NE.6)START(MOTIF) = MATCHP(MOTIF) + 1
|
|
C ERROR?????????
|
|
IF(ICLASS.EQ.7)START(MOTIF) = MATCHP(MOTIF) + CUTOFF(MOTIF)
|
|
END IF
|
|
C
|
|
C TRY GOING FORWARD ONE MOTIF
|
|
C
|
|
C
|
|
CALL 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)
|
|
C
|
|
C
|
|
C
|
|
C IS THIS THE LAST MOTIF? IF SO DISPLAY THE MATCH
|
|
C
|
|
C
|
|
IF(IDSPLY.EQ.1)THEN
|
|
ITOTAL = ITOTAL + 1
|
|
CALL DSPLAY(MATCHP,LENGTH,NMOT,SEQ,IDSEQ,IDEVOT,
|
|
+ CLASS,MATCHQ,MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,IOPT,
|
|
+ XMAX,XMIN,YMAX,YMIN,KSTART,MATCHS,CUTSCR,MINSCR,MAXSCR,
|
|
+ PMINT,PMAXT,PROBT,IDM,MAT1,IDM,MAT2,IDME,MAT3,IDM,
|
|
+ MAT4,IDM,WEIGHT,MAXWTS,WTSTR,CUTOFF,PMINC,KEYNS)
|
|
C
|
|
C
|
|
C HORRIBLE SPECIAL CASE - IF LAST MOTIF IS NOTTED WE MUST MOVE BACK AFTER
|
|
C DISPLAY
|
|
IF(COMB.EQ.'N')THEN
|
|
CALL BAKSID(CLASS,LENGTH,CUTOFF,STRNGS,NMOT,
|
|
+ MOTIF,ICLASS,ILEN,CUT,IWT,ISTRST,WTSTR,
|
|
+ RELMOT,START,IEND,MATCHQ,RANGES,RANGEL,RELEND,IRET,MATCHP,
|
|
+ COMBIN,COMB)
|
|
C
|
|
C
|
|
C IF CANT GO BACK ANY FURTHER QUIT
|
|
IF(IRET.NE.0)RETURN
|
|
END IF
|
|
END IF
|
|
C
|
|
C
|
|
END IF
|
|
C
|
|
C
|
|
C GO BACK FOR NEXT SEARCH
|
|
C
|
|
C
|
|
GO TO 100
|
|
END
|
|
C*********************************************************************
|
|
SUBROUTINE DSPLAY(MATCHP,LENGTH,NMOT,SEQ,IDSEQ,IDEV,
|
|
+CLASS,MATCHQ,MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,IOPT,
|
|
+XMAX,XMIN,YMAX,YMIN,KSTART,MATCHS,CUTSCR,MINSCR,MAXSCR,
|
|
+PMINT,PMAXT,PROBT,IDM,MAT1,IDMAT1,MAT2,IDMAT2,MAT3,IDMAT3,
|
|
+MAT4,IDMAT4,WEIGHT,MAXWTS,WTSTR,CUTOFF,PMINC,KEYNS)
|
|
INTEGER MATCHP(NMOT),LENGTH(NMOT),CLASS(NMOT)
|
|
INTEGER MATCHQ(NMOT)
|
|
CHARACTER SEQ(IDSEQ)
|
|
REAL MATCHS(NMOT),MINSCR,MAXSCR
|
|
REAL WEIGHT(MAXWTS),CUTOFF(NMOT)
|
|
INTEGER MAT1(IDMAT1,IDMAT1),MAT2(IDMAT2,IDMAT2)
|
|
INTEGER MAT3(IDMAT3,IDMAT3),MAT4(IDMAT4,IDMAT4)
|
|
INTEGER WTSTR(NMOT)
|
|
CHARACTER*(*) KEYNS(NMOT)
|
|
EXTERNAL PSCORE
|
|
C ADD SCORES
|
|
T = 0.
|
|
DO 10 I = 1,NMOT
|
|
IF(MATCHP(I).NE.0) T = T + MATCHS(I)
|
|
10 CONTINUE
|
|
POBS = 1.0
|
|
IF((PMINC.LT.1.0).OR.(IOPT.EQ.3))THEN
|
|
C CALC PROB
|
|
DO 20 I = 1,NMOT
|
|
IF(MATCHP(I).NE.0)THEN
|
|
CALL GETP(CLASS(I),SEQ(MATCHP(I)+KSTART-1),LENGTH(I),
|
|
+ IDM,MAT1,IDMAT1,MAT2,IDMAT2,MAT3,IDMAT3,MAT4,IDMAT4,
|
|
+ WEIGHT(MAX(1,WTSTR(I))))
|
|
PROB = PSCORE(MATCHS(I))
|
|
POBS = POBS * PROB
|
|
END IF
|
|
20 CONTINUE
|
|
IF((PMINC.LT.1.0).AND.(POBS.GT.PMINC))RETURN
|
|
END IF
|
|
C
|
|
IF(T.GT.MAXSCR) MAXSCR = T
|
|
IF(T.LT.MINSCR) MINSCR = T
|
|
IF(T.LT.CUTSCR) RETURN
|
|
C
|
|
IF(IOPT.EQ.1)THEN
|
|
WRITE(IDEV,1001)
|
|
1001 FORMAT(' Match')
|
|
DO 100 I=1,NMOT
|
|
J = I
|
|
C CHECK FOR NO MATCH (NEEDED FOR ORED MOTIFS)
|
|
IF(MATCHP(J).NE.0)THEN
|
|
WRITE(IDEV,1000)MATCHP(J)+KSTART-1,KEYNS(I)
|
|
WRITE(IDEV,1002)(SEQ(K),K=MATCHP(J),MATCHP(J)+LENGTH(J)-1)
|
|
C STEM ?
|
|
IF(CLASS(J).EQ.6)THEN
|
|
WRITE(IDEV,1002)(SEQ(K),K=MATCHQ(J),MATCHQ(J)-LENGTH(J)+1,-1)
|
|
WRITE(IDEV,1000)MATCHQ(J)+KSTART-1
|
|
END IF
|
|
C REPEAT ?
|
|
IF(CLASS(J).EQ.8)THEN
|
|
WRITE(IDEV,1002)(SEQ(K),K=MATCHQ(J),MATCHQ(J)+LENGTH(J)-1)
|
|
WRITE(IDEV,1000)MATCHQ(J)+KSTART-1
|
|
END IF
|
|
END IF
|
|
100 CONTINUE
|
|
1000 FORMAT(' ',I7,' ',A8)
|
|
1002 FORMAT(' ',60A1)
|
|
IF(PMINC.LT.1.0)WRITE(IDEV,1004)POBS
|
|
1004 FORMAT(' Probability =',E10.4)
|
|
RETURN
|
|
END IF
|
|
IF(IOPT.EQ.3)THEN
|
|
C MARK THE POSITION OF THE FIRST NON-ZERO MATCH ONLY
|
|
DO 200 I = 1,NMOT
|
|
IF(MATCHP(I).NE.0)THEN
|
|
X = MATCHP(I) + KSTART - 1
|
|
Y = LOG(1.-POBS)
|
|
CALL VECTOM
|
|
CALL LINE(X,X,YMIN,Y,XMAX,XMIN,YMAX,YMIN,
|
|
+ MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
|
|
CALL VT100M
|
|
GO TO 201
|
|
END IF
|
|
200 CONTINUE
|
|
201 CONTINUE
|
|
END IF
|
|
IF(IOPT.EQ.2)THEN
|
|
MINP = 999999
|
|
MAXP = -999999
|
|
DO 300 I = 1, NMOT
|
|
K = MATCHP(I)
|
|
IF(K.NE.0)THEN
|
|
IF(K.LT.MINP)MINP = K
|
|
K = K + LENGTH(I) - 1
|
|
C INVERTED REPEAT ?
|
|
IF(CLASS(I).EQ.6) K = MATCHQ(I)
|
|
C REPEAT ?
|
|
IF(CLASS(I).EQ.8) K = MATCHQ(I) + LENGTH(I) - 1
|
|
IF(K.GT.MAXP)MAXP = K
|
|
END IF
|
|
300 CONTINUE
|
|
WRITE(IDEV,1000)MINP+KSTART-1,KEYNS(1)
|
|
WRITE(IDEV,1002)
|
|
+ ((SEQ(K1),K1=K2,MIN(K2+59,MAXP)),K2=MINP,MAXP,60)
|
|
IF(PMINC.LT.1.0)WRITE(IDEV,1004)POBS
|
|
RETURN
|
|
END IF
|
|
IF(IOPT.EQ.4)THEN
|
|
MINP = 999999
|
|
MAXP = -999999
|
|
K1 = 0
|
|
DO 400 I = 1, NMOT
|
|
K = MATCHP(I)
|
|
IF(K.NE.0)THEN
|
|
IF(K1.EQ.0) INAM = I
|
|
K1 = 1
|
|
IF(K.LT.MINP)MINP = K
|
|
K = K + LENGTH(I) - 1
|
|
C INVERTED REPEAT ?
|
|
IF(CLASS(I).EQ.6) K = MATCHQ(I)
|
|
C REPEAT ?
|
|
IF(CLASS(I).EQ.8) K = MATCHQ(I) + LENGTH(I) - 1
|
|
IF(K.GT.MAXP)MAXP = K
|
|
END IF
|
|
400 CONTINUE
|
|
CALL EFTOUT(KEYNS(INAM),MINP+KSTART-1,MAXP+KSTART-1,IDEV)
|
|
END IF
|
|
END
|
|
C*********************************************************************
|
|
SUBROUTINE MOTIF3(SEQ,IDIM1,STRING,IDIM2,ISTART,IEND,CUTOFF,
|
|
+MATCHP,MATCHS,IFOUND,MATRIC,IDM)
|
|
CHARACTER SEQ(IDIM1),STRING(IDIM2)
|
|
INTEGER MATRIC(IDM,IDM)
|
|
REAL MATCHS
|
|
IFOUND = 0
|
|
IF(ISTART.LT.1)ISTART=1
|
|
IF(ISTART.GT.IDIM1)RETURN
|
|
CALL SQFIT5(SEQ,IDIM1,STRING,IDIM2,ISTART,IEND,CUTOFF,MATCHS,
|
|
+IFOUND,MATRIC,IDM)
|
|
IF(IFOUND.EQ.0)RETURN
|
|
C SAVE MATCH POSITION
|
|
MATCHP = IFOUND
|
|
RETURN
|
|
END
|
|
C*********************************************************************
|
|
SUBROUTINE MOTIF4(SEQ,IDIM1,LENGTH,ISTART,IEND,
|
|
+WEIGHT,CUTOFF,MATCHP,MATCHS,IFOUND,IDM)
|
|
REAL MATCHS
|
|
CHARACTER SEQ(IDIM1)
|
|
IFOUND = 0
|
|
IF(ISTART.LT.1)ISTART=1
|
|
L1 = IEND-ISTART+1
|
|
IF(ISTART.GT.IDIM1)RETURN
|
|
IF(L1.LT.LENGTH)RETURN
|
|
CALL FMOT4(SEQ(ISTART),L1,WEIGHT,LENGTH,CUTOFF,SCORE,IFOUND,IDM)
|
|
IF(IFOUND.EQ.0)RETURN
|
|
C SAVE MATCH POSITION
|
|
MATCHP = ISTART+IFOUND-1
|
|
MATCHS = SCORE
|
|
RETURN
|
|
END
|
|
C*********************************************************************
|
|
SUBROUTINE FMOT4(SEQ,IDIM,WT,LENGTH,CUTOFF,SUM,IFOUND,IDM)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDIM)
|
|
REAL WT(IDM,LENGTH)
|
|
INTEGER CTONUM
|
|
EXTERNAL CTONUM
|
|
DO 10 I=1,IDIM-LENGTH+1
|
|
SUM=0.
|
|
K=0
|
|
DO 5 J=I,I+LENGTH-1
|
|
K=K+1
|
|
IP = CTONUM(SEQ(J))
|
|
SUM=SUM+WT(IP,K)
|
|
5 CONTINUE
|
|
IF(SUM.GE.CUTOFF)THEN
|
|
IFOUND = I
|
|
RETURN
|
|
END IF
|
|
10 CONTINUE
|
|
IFOUND = 0
|
|
RETURN
|
|
END
|
|
C*********************************************************************
|
|
SUBROUTINE MOTIF6(SEQ,IDSEQ,MATRIX,LENGTH,I5STAR,I5END,
|
|
+ I3STAR,I3END,CUTOFF,MATCHP,MATCHS,
|
|
+ IENTRY,IFOUND,MATCHQ,
|
|
+ LAST5,LAST3S,LAST3E,IDM)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDSEQ)
|
|
INTEGER MATRIX(IDM,IDM)
|
|
REAL MATCHS
|
|
EXTERNAL LOOP
|
|
C WE HAVE A START POSITION FOR THE 5' END OF THE 5' END OF
|
|
C A POTENTIAL STEM I5STAR AND AN END DEFINED BY A RANGE I5END
|
|
C WE HAVE A STEM LENGTH LENGTH
|
|
C WE HAVE A RANGE OF POSITIONS FOR THE 3' STEM TO START
|
|
C I3STAR TO I3END
|
|
C TRY THE TIGHTEST LOOPS FIRST
|
|
C BUT FIRST WE MAY HAVE TO FINISH A PREVIOUS SEARCH
|
|
C THIS IS DENOTED BY IENTRY NE 0.
|
|
C NOTE IENTRY IS ALSO USED TO RETURN THE 3' MATCH POSITION
|
|
ICUT = CUTOFF
|
|
C WRITE(*,*)'ICUT',ICUT
|
|
IFOUND = 0
|
|
JENTRY = IENTRY
|
|
IENTRY = 0
|
|
IF(I5STAR.LT.1)I5STAR=1
|
|
IF((I5STAR+I3STAR-1).GT.IDSEQ)RETURN
|
|
IF(JENTRY.NE.0)THEN
|
|
I1 = LAST5
|
|
C WRITE(*,*)'I5STAR,I5END',I5STAR,I5END
|
|
C WRITE(*,*)'I1,LAST3S,LAST3E',I1,LAST3S,LAST3E
|
|
DO 50 J=LAST3S+1,LAST3E
|
|
J1 = J
|
|
ISUM = LOOP(SEQ,IDSEQ,MATRIX,LENGTH,I1,J1,IDM)
|
|
C RETURN IF GOOD ENOUGH
|
|
IF(ISUM.GE.CUTOFF)THEN
|
|
MATCHP = I1
|
|
IENTRY = J1
|
|
MATCHQ = J1
|
|
MATCHS = ISUM
|
|
IFOUND = MATCHP
|
|
LAST3S = J1
|
|
CDEBUG
|
|
C WRITE(*,*)'MATCHP',MATCHP
|
|
RETURN
|
|
END IF
|
|
50 CONTINUE
|
|
C NOW MOVE 5' STEM START POSITION (WE HAVE JUST FINISHED THE LAST)
|
|
C TO THE LAST MATCH + 1
|
|
I5STAR = MATCHP + 1
|
|
END IF
|
|
C SET ENTRY FLAG TO ZERO TO SIGNIFY LAST SEARCH NOW COMPLETED
|
|
IENTRY = 0
|
|
ISUM = 0
|
|
LOOPI1 = I5STAR
|
|
IF((I5STAR+I3STAR-1).GT.IDSEQ)RETURN
|
|
LOOPI2 = MIN(IDSEQ,I5END)
|
|
C WRITE(*,*)'IDSEQ,LENGTH,I5STAR,I5END',
|
|
C +IDSEQ,LENGTH,I5STAR,I5END
|
|
C
|
|
C TRY ALL STEM STARTS FROM 5' START TO 5' END
|
|
C
|
|
C
|
|
DO 200 I = LOOPI1,LOOPI2
|
|
C
|
|
C
|
|
I1 = I
|
|
C
|
|
C TRY ALL LOOPS FROM 3' START TO 3' END
|
|
C
|
|
LOOPJ1 = I+I3STAR-1
|
|
IF(LOOPJ1.GT.IDSEQ)RETURN
|
|
LOOPJ2 = MIN(IDSEQ,I+I3END-1)
|
|
C WRITE(*,*)'I3STAR,I3END',I3STAR,I3END
|
|
C
|
|
C
|
|
C
|
|
DO 100 J = LOOPJ1,LOOPJ2
|
|
C
|
|
C
|
|
C
|
|
J1 = J
|
|
C IN LOOP NOTE THAT
|
|
C THE 5' END POINTER I1 GOES FORWARDS
|
|
C THE 3' END POINTER J1 GOES BACKWARDS
|
|
C
|
|
ISUM = LOOP(SEQ,IDSEQ,MATRIX,LENGTH,I1,J1,IDM)
|
|
C RETURN IF GOOD ENOUGH
|
|
C WRITE(*,*)ISUM
|
|
IF(ISUM.GE.ICUT)THEN
|
|
MATCHP = I1
|
|
IENTRY = J1
|
|
MATCHQ = J1
|
|
MATCHS = ISUM
|
|
IFOUND = MATCHP
|
|
C SAVE CURRENT POSITION FOR LATER ENTRIES
|
|
LAST5 = I1
|
|
LAST3S = J1
|
|
LAST3E = LOOPJ2
|
|
CDEBUG
|
|
C WRITE(*,*)'MATCHP',MATCHP
|
|
RETURN
|
|
END IF
|
|
100 CONTINUE
|
|
200 CONTINUE
|
|
CDEBUG
|
|
C WRITE(*,*)'MATCHPEND',MATCHP
|
|
END
|
|
C*********************************************************************
|
|
INTEGER FUNCTION LOOP(SEQ,IDSEQ,MATRIX,LENGTH,I5P,I3P,IDM)
|
|
CHARACTER SEQ(IDSEQ)
|
|
INTEGER MATRIX(IDM,IDM),CTONUM
|
|
EXTERNAL CTONUM
|
|
C THE 5' END POINTER GOES FORWARDS
|
|
C THE 3' END POINTER GOES BACKWARDS
|
|
L=0
|
|
I5=I5P-1
|
|
I3=I3P+1
|
|
DO 100 I=1,LENGTH
|
|
I5 = I5 + 1
|
|
I3 = I3 - 1
|
|
C WRITE(*,*)'I5,I3',I5,I3
|
|
L5 = CTONUM(SEQ(I5))
|
|
L3 = CTONUM(SEQ(I3))
|
|
L = L + MATRIX(L5,L3)
|
|
100 CONTINUE
|
|
LOOP = L
|
|
END
|
|
SUBROUTINE MOTIF8(SEQ,IDSEQ,MATRIX,LENGTH,I5STAR,I5END,
|
|
+ I3STAR,I3END,CUTOFF,MATCHP,MATCHS,
|
|
+ IENTRY,IFOUND,MATCHQ,
|
|
+ LAST5,LAST3S,LAST3E,IDM)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDSEQ)
|
|
INTEGER MATRIX(IDM,IDM),REPEET
|
|
REAL MATCHS
|
|
EXTERNAL REPEET
|
|
C WE HAVE A START POSITION FOR THE 5' END OF THE 5' END OF
|
|
C A POTENTIAL REPEAT I5STAR AND AN END DEFINED BY A RANGE I5END
|
|
C WE HAVE A REPEAT LENGTH LENGTH
|
|
C WE HAVE A RANGE OF POSITIONS FOR THE 3' STEM TO START
|
|
C I3STAR TO I3END
|
|
C TRY THE TIGHTEST LOOPS FIRST
|
|
C BUT FIRST WE MAY HAVE TO FINISH A PREVIOUS SEARCH
|
|
C THIS IS DENOTED BY IENTRY NE 0.
|
|
C NOTE IENTRY IS ALSO USED TO RETURN THE 3' MATCH POSITION
|
|
ICUT = CUTOFF
|
|
C WRITE(*,*)'ICUT',ICUT
|
|
IFOUND = 0
|
|
JENTRY = IENTRY
|
|
IENTRY = 0
|
|
IF(I5STAR.LT.1)I5STAR=1
|
|
IF((I5STAR+I3STAR+LENGTH-2).GT.IDSEQ)RETURN
|
|
IF(JENTRY.NE.0)THEN
|
|
I1 = LAST5
|
|
C WRITE(*,*)'I1,LAST3S,LAST3E',I1,LAST3S,LAST3E
|
|
DO 50 J=LAST3S+1,LAST3E
|
|
J1 = J
|
|
ISUM = REPEET(SEQ,IDSEQ,MATRIX,LENGTH,I1,J1,IDM)
|
|
C RETURN IF GOOD ENOUGH
|
|
IF(ISUM.GE.ICUT)THEN
|
|
MATCHP = I1
|
|
IENTRY = J1
|
|
MATCHQ = J1
|
|
MATCHS = ISUM
|
|
IFOUND = MATCHP
|
|
LAST3S = J1
|
|
RETURN
|
|
END IF
|
|
50 CONTINUE
|
|
C NOW MOVE 5' STEM START POSITION (WE HAVE JUST FINISHED THE LAST)
|
|
C TO THE LAST MATCH + 1
|
|
I5STAR = MATCHP + 1
|
|
END IF
|
|
C SET ENTRY FLAG TO ZERO TO SIGNIFY LAST SEARCH NOW COMPLETED
|
|
IENTRY = 0
|
|
ISUM = 0
|
|
LOOPI1 = I5STAR
|
|
IF((I5STAR+I3STAR+LENGTH-2).GT.IDSEQ)RETURN
|
|
LOOPI2 = MIN(IDSEQ-2*LENGTH+1,I5END)
|
|
C WRITE(*,*)'IDSEQ,LENGTH,I5STAR,I5END',
|
|
C +IDSEQ,LENGTH,I5STAR,I5END
|
|
C
|
|
C TRY ALL STEM STARTS FROM 5' START TO 5' END
|
|
C
|
|
C
|
|
DO 200 I = LOOPI1,LOOPI2
|
|
C
|
|
C
|
|
I1 = I
|
|
C
|
|
C TRY ALL LOOPS FROM 3' START TO 3' END
|
|
C
|
|
LOOPJ1 = I + I3STAR -1
|
|
IF((LOOPJ1+LENGTH-1).GT.IDSEQ)RETURN
|
|
LOOPJ2 = MIN(IDSEQ-LENGTH+1,I+I3END-1)
|
|
C WRITE(*,*)'I3STAR,I3END',I3STAR,I3END
|
|
C
|
|
C
|
|
C
|
|
DO 100 J = LOOPJ1,LOOPJ2
|
|
C
|
|
C
|
|
C
|
|
J1 = J
|
|
C IN REPEAT NOTE THAT
|
|
C THE 5' END POINTER I1 GOES FORWARDS
|
|
C THE 3' END POINTER J1 GOES FORWARDS
|
|
C
|
|
ISUM = REPEET(SEQ,IDSEQ,MATRIX,LENGTH,I1,J1,IDM)
|
|
C RETURN IF GOOD ENOUGH
|
|
C WRITE(*,*)ISUM
|
|
IF(ISUM.GE.ICUT)THEN
|
|
MATCHP = I1
|
|
IENTRY = J1
|
|
MATCHQ = J1
|
|
MATCHS = ISUM
|
|
IFOUND = MATCHP
|
|
C SAVE CURRENT POSITION FOR LATER ENTRIES
|
|
LAST5 = I1
|
|
LAST3S = J1
|
|
LAST3E = LOOPJ2
|
|
RETURN
|
|
END IF
|
|
100 CONTINUE
|
|
200 CONTINUE
|
|
END
|
|
C*********************************************************************
|
|
INTEGER FUNCTION REPEET(SEQ,IDSEQ,MATRIX,LENGTH,I5P,I3P,IDM)
|
|
CHARACTER SEQ(IDSEQ)
|
|
INTEGER MATRIX(IDM,IDM),DTONUM
|
|
EXTERNAL DTONUM
|
|
C THE 5' END POINTER GOES FORWARDS
|
|
C THE 3' END POINTER GOES FORWARDS
|
|
L=0
|
|
I5=I5P-1
|
|
I3=I3P-1
|
|
DO 100 I=1,LENGTH
|
|
I5 = I5 + 1
|
|
I3 = I3 + 1
|
|
C WRITE(*,*)'I5,I3',I5,I3
|
|
L5 = DTONUM(SEQ(I5))
|
|
L3 = DTONUM(SEQ(I3))
|
|
L = L + MATRIX(L5,L3)
|
|
100 CONTINUE
|
|
REPEET = L
|
|
END
|
|
SUBROUTINE SQFIT5(SEQ,IDIM1,STRING,IDIM2,
|
|
1IS,IE,MINSC,MATCHS,IFOUND,MATRIC,IDM)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDIM1),STRING(IDIM2)
|
|
REAL MATCHS,MINSC
|
|
INTEGER MATRIC(IDM,IDM),DTONUM
|
|
EXTERNAL DTONUM
|
|
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 + MATRIC(DTONUM(SEQ(IP)),DTONUM(STRING(J)))
|
|
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 SETCMP(SEQ,IDIM,IDM)
|
|
CHARACTER SEQ(IDIM)
|
|
PARAMETER (MAXCHR = 17)
|
|
INTEGER DTONUM
|
|
EXTERNAL DTONUM
|
|
COMMON /COMPC/COMP(MAXCHR)
|
|
SAVE /COMPC/
|
|
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
|