1594 lines
49 KiB
Fortran
1594 lines
49 KiB
Fortran
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
|