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