2330 lines
71 KiB
Fortran
2330 lines
71 KiB
Fortran
C SUBROUTINES FOR ANALYSEP
|
|
C AUTHOR: RODGER STADEN
|
|
C 8-2-90 back translation: zeroed righthand end of workr
|
|
C 9-7-90 removed menu routine
|
|
C 24-7-90 edited helixw to use getint for compatibility with x versions
|
|
C 5-11-90 signlp call to rdwmt added zero as last parameter
|
|
C 4-12-90 Changed name of compc to compcp for the stupid sun linker
|
|
C 21-12-90 Changed signlp so that text output gives position as
|
|
C I+MIDDLE (was I)
|
|
SUBROUTINE SETPAR(IOK)
|
|
PARAMETER (MINOPT = 17,
|
|
+ MAXOPT = 28,
|
|
+ NUMBER = 9)
|
|
INTEGER VALUES(NUMBER,MINOPT:MAXOPT)
|
|
C INTEGER TEMP(NUMBER)
|
|
SAVE /PAMDEF/
|
|
COMMON /PAMDEF/VALUES
|
|
IOK = 0
|
|
C SEARCH
|
|
C WRITE(KBOUT,*)' Search for short sequences'
|
|
C CALL GETPAR(17,7,IOK,IFILE,OPTION,OPTOUT,NOPOUT,
|
|
C +MININC,MAXINC,INC)
|
|
VALUES(1,17) = 1
|
|
VALUES(2,17) = 0
|
|
VALUES(3,17) = 0
|
|
VALUES(4,17) = 0
|
|
VALUES(5,17) = 1
|
|
VALUES(6,17) = 12
|
|
VALUES(7,17) = 1
|
|
C PERCENT MATCH
|
|
VALUES(1,18) = 0
|
|
VALUES(2,18) = 70
|
|
C SCORE MATRIX MATCH
|
|
VALUES(1,19) = 0
|
|
C WEIGHT MATRIX
|
|
C WRITE(KBOUT,*)' MOTIF SEARCH USING WEIGHT MATRIX'
|
|
C CALL GETPAR(20,2,IOK,IOPT,IGON)
|
|
VALUES(1,20) = 0
|
|
VALUES(2,20) = 0
|
|
C HYDROPHOBICITY
|
|
VALUES(1,22) = 1
|
|
VALUES(2,22) = 101
|
|
VALUES(3,22) = 11
|
|
VALUES(4,22) = 1
|
|
VALUES(5,22) = 101
|
|
VALUES(6,22) = 3
|
|
C CHARGE
|
|
VALUES(1,23) = 1
|
|
VALUES(2,23) = 101
|
|
VALUES(3,23) = 11
|
|
VALUES(4,23) = 1
|
|
VALUES(5,23) = 101
|
|
VALUES(6,23) = 3
|
|
C ROBSON
|
|
C CALL GETPAR(24,4,IOK,MINIW,MAXIW,IWRIT,IGON)
|
|
VALUES(1,24) = 1
|
|
VALUES(2,24) = 101
|
|
VALUES(3,24) = 1
|
|
VALUES(4,24) = 0
|
|
C HYDROPHOBIC MOMENT
|
|
VALUES(1,25) = 1
|
|
VALUES(2,25) = 130
|
|
VALUES(3,25) = 100
|
|
VALUES(4,25) = 1
|
|
VALUES(5,25) = 60
|
|
VALUES(6,25) = 18
|
|
VALUES(7,25) = 1
|
|
VALUES(8,25) = 101
|
|
VALUES(9,25) = 3
|
|
C HELIX WHEEL
|
|
VALUES(1,26) = 1
|
|
VALUES(2,26) = 130
|
|
VALUES(3,26) = 100
|
|
VALUES(4,26) = 1
|
|
VALUES(5,26) = 60
|
|
VALUES(6,26) = 18
|
|
C BACK TRANSLATE
|
|
VALUES(1,27) = 0
|
|
VALUES(2,27) = 0
|
|
VALUES(3,27) = 1
|
|
VALUES(4,27) = 11
|
|
VALUES(5,27) = 11
|
|
VALUES(6,27) = 1
|
|
VALUES(7,27) = 11
|
|
VALUES(8,27) = 3
|
|
C PATTERNS TO DO
|
|
C OPEN(UNIT=99,FILE='ANALYSEP.PAR',STATUS ='OLD')
|
|
C10 CONTINUE
|
|
C READ(99,*,ERR=100,END=200)TEMP
|
|
C IF((TEMP(1).GE.MINOPT).AND.(TEMP(1).LE.MAXOPT)) THEN
|
|
C DO 20 I = 1,NUMBER-1
|
|
C VALUES(I,TEMP(1)) = TEMP(I+1)
|
|
C WRITE(*,*)TEMP(1),TEMP(I+1)
|
|
C20 CONTINUE
|
|
C END IF
|
|
C GO TO 10
|
|
C100 CONTINUE
|
|
C WRITE(*,*)'ERROR IN PARMS FILE'
|
|
C GO TO 10
|
|
C200 CONTINUE
|
|
C CLOSE(UNIT = 99)
|
|
IOK = 0
|
|
END
|
|
SUBROUTINE GETPAR(IOPT,NPAM,IOK,I1,I2,I3,I4,I5,I6,I7,I8,I9)
|
|
PARAMETER (MINOPT = 17,
|
|
+ MAXOPT = 28,
|
|
+ NUMBER = 9)
|
|
INTEGER VALUES(NUMBER,MINOPT:MAXOPT)
|
|
COMMON /PAMDEF/VALUES
|
|
IOK = 0
|
|
IF((IOPT.GE.MINOPT).AND.(IOPT.LE.MAXOPT)) THEN
|
|
I = 1
|
|
I1 = VALUES(I,IOPT)
|
|
IF(I.EQ.NPAM) RETURN
|
|
I = I + 1
|
|
I2 = VALUES(I,IOPT)
|
|
IF(I.EQ.NPAM) RETURN
|
|
I = I + 1
|
|
I3 = VALUES(I,IOPT)
|
|
IF(I.EQ.NPAM) RETURN
|
|
I = I + 1
|
|
I4 = VALUES(I,IOPT)
|
|
IF(I.EQ.NPAM) RETURN
|
|
I = I + 1
|
|
I5 = VALUES(I,IOPT)
|
|
IF(I.EQ.NPAM) RETURN
|
|
I = I + 1
|
|
I6 = VALUES(I,IOPT)
|
|
IF(I.EQ.NPAM) RETURN
|
|
I = I + 1
|
|
I7 = VALUES(I,IOPT)
|
|
IF(I.EQ.NPAM) RETURN
|
|
I = I + 1
|
|
I8 = VALUES(I,IOPT)
|
|
IF(I.EQ.NPAM) RETURN
|
|
I = I + 1
|
|
I9 = VALUES(I,IOPT)
|
|
IF(I.EQ.NPAM) RETURN
|
|
END IF
|
|
IOK = 1
|
|
END
|
|
C COMPH
|
|
SUBROUTINE COMPH(SEQ,IDIM1P,MXSPAN,
|
|
1MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,KBIN,KBOUT,
|
|
+SCORES,IDSCOR,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,DIALOG)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER HELPF*(*)
|
|
CHARACTER SEQ(IDIM1P)
|
|
INTEGER DIALOG
|
|
INTEGER SPAN
|
|
REAL SCORES(IDSCOR)
|
|
CALL SHOWFU(KBOUT,'Plot hydrophobicity')
|
|
CALL GETPAR(22,6,IOK,MINSP,MAXSP,SPAN,MINIW,MAXIW,IWRIT,
|
|
+IPAR7,IPAR8,IPAR9)
|
|
IF(IOK.NE.0) RETURN
|
|
IF(DIALOG.EQ.1) THEN
|
|
CALL GSPIN(MINSP,MAXSP,SPAN,MINIW,MAXIW,IWRIT,KBIN,KBOUT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
END IF
|
|
CALL PHYDRO(SEQ,IDIM1P,MXSPAN,
|
|
1MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,
|
|
+SCORES,IDSCOR,SPAN,IWRIT)
|
|
END
|
|
SUBROUTINE PHYDRO(SEQ,IDIM1P,MXSPAN,
|
|
1MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,
|
|
+SCORES,IDSCOR,SPAN,IWRIT)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDIM1P)
|
|
INTEGER SPAN,CTONUM
|
|
REAL SCORES(IDSCOR)
|
|
EXTERNAL CTONUM
|
|
C max score
|
|
SCRMAX=-9999.
|
|
SCRMIN=99999.
|
|
DO 1 I=1,IDSCOR
|
|
IF(SCORES(I).GT.SCRMAX)SCRMAX=SCORES(I)
|
|
IF(SCORES(I).LT.SCRMIN)SCRMIN=SCORES(I)
|
|
1 CONTINUE
|
|
I1INM1=1+MXSPAN/2
|
|
J1P=J1+I1INM1
|
|
J2P=J2+I1INM1
|
|
XMIN=J1
|
|
XMAX=J2
|
|
C length forward and back
|
|
LF=SPAN/2
|
|
LB=1+SPAN/2
|
|
C set ymax
|
|
RANGE=SPAN*(SCRMAX-SCRMIN)
|
|
RANGEP=RANGE/100.
|
|
YMIN=SPAN*SCRMIN
|
|
YMAX=SPAN*SCRMAX
|
|
XBIT=XMIN+(XMAX-XMIN)*0.01
|
|
YMID=YMIN+RANGE*0.5
|
|
YMID45=YMID-RANGEP*5.0
|
|
C do edge
|
|
CALL STARTR(SEQ(J1P-LB),IDIM1P,SCORES,IDSCOR,SPAN,SUM)
|
|
CALL CLEARV
|
|
CALL VECTOM
|
|
CALL FRAME(MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
|
|
DO 40 K=-40,40,10
|
|
YPLOT=YMID+RANGEP*K
|
|
CALL LINE(XMIN,XBIT,YPLOT,YPLOT,XMAX,XMIN,YMAX,YMIN,
|
|
+ MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
|
|
40 CONTINUE
|
|
C PLOT MID LINE
|
|
CALL LINE(XMIN,XMAX,YMID45,YMID45,XMAX,XMIN,YMAX,YMIN,
|
|
+MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
|
|
C do rest
|
|
IDONE=0
|
|
XF=J1
|
|
YF=SUM
|
|
DO 100 I=J1P,J2P
|
|
IDONE=IDONE+1
|
|
SUM=SUM+SCORES(CTONUM(SEQ(I+LF)))
|
|
+ -SCORES(CTONUM(SEQ(I-LB)))
|
|
IF(MOD(I,IWRIT).EQ.0)THEN
|
|
XT=I-I1INM1
|
|
CALL LINE(XF,XT,YF,SUM,XMAX,XMIN,YMAX,YMIN,
|
|
+ MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
|
|
XF=XT
|
|
YF=SUM
|
|
END IF
|
|
100 CONTINUE
|
|
CALL VT100M
|
|
END
|
|
C COMPCP
|
|
SUBROUTINE COMPCP(SEQ,IDIM1P,MXSPAN,
|
|
1MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,KBIN,KBOUT,
|
|
+SCORES,IDSCOR,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,DIALOG)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER HELPF*(*)
|
|
CHARACTER SEQ(IDIM1P)
|
|
INTEGER DIALOG
|
|
INTEGER SPAN
|
|
REAL SCORES(IDSCOR)
|
|
CALL SHOWFU(KBOUT,'Plot charge')
|
|
CALL GETPAR(23,6,IOK,MINSP,MAXSP,SPAN,MINIW,MAXIW,IWRIT,
|
|
+IPAR7,IPAR8,IPAR9)
|
|
IF(IOK.NE.0) RETURN
|
|
IF(DIALOG.EQ.1) THEN
|
|
CALL GSPIN(MINSP,MAXSP,SPAN,MINIW,MAXIW,IWRIT,KBIN,KBOUT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
END IF
|
|
CALL PCOMPC(SEQ,IDIM1P,MXSPAN,
|
|
+MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,
|
|
+SCORES,IDSCOR,SPAN,IWRIT)
|
|
END
|
|
SUBROUTINE PCOMPC(SEQ,IDIM1P,MXSPAN,
|
|
+MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,
|
|
+SCORES,IDSCOR,SPAN,IWRIT)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDIM1P)
|
|
INTEGER SPAN,CTONUM
|
|
REAL SCORES(IDSCOR)
|
|
EXTERNAL CTONUM
|
|
SCRMAX=-9999.
|
|
SCRMIN=9999.
|
|
DO 1 I=1,IDSCOR
|
|
IF(SCORES(I).GT.SCRMAX)SCRMAX=SCORES(I)
|
|
IF(SCORES(I).LT.SCRMIN)SCRMIN=SCORES(I)
|
|
1 CONTINUE
|
|
C length forward and back
|
|
LF=SPAN/2
|
|
LB=1+SPAN/2
|
|
I1INM1=1+MXSPAN/2
|
|
J1P=J1+I1INM1
|
|
J2P=J2+I1INM1
|
|
XMIN=J1
|
|
XMAX=J2
|
|
C set ymax
|
|
RANGE=SPAN*(SCRMAX-SCRMIN)
|
|
RANGEP=RANGE/100.
|
|
YMIN=SPAN*SCRMIN
|
|
YMAX=SPAN*SCRMAX
|
|
XBIT=XMIN+(XMAX-XMIN)*0.01
|
|
YMID=YMIN+RANGE*0.5
|
|
C do edge
|
|
CALL STARTR(SEQ(J1P-LB),IDIM1P,SCORES,IDSCOR,SPAN,SUM)
|
|
CALL CLEARV
|
|
CALL VECTOM
|
|
CALL FRAME(MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
|
|
DO 40 K=-40,40,10
|
|
YPLOT=YMID+RANGEP*K
|
|
CALL LINE(XMIN,XBIT,YPLOT,YPLOT,XMAX,XMIN,YMAX,YMIN,
|
|
+ MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
|
|
40 CONTINUE
|
|
C PLOT MID LINE
|
|
CALL LINE(XMIN,XMAX,YMID,YMID,XMAX,XMIN,YMAX,YMIN,
|
|
+MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
|
|
C do rest
|
|
IDONE=0
|
|
XF=J1
|
|
YF=SUM
|
|
DO 100 I=J1P,J2P
|
|
IDONE=IDONE+1
|
|
SUM=SUM+SCORES(CTONUM(SEQ(I+LF)))
|
|
+ -SCORES(CTONUM(SEQ(I-LB)))
|
|
IF(MOD(I,IWRIT).EQ.0)THEN
|
|
XT=I-I1INM1
|
|
CALL LINE(XF,XT,YF,SUM,XMAX,XMIN,YMAX,YMIN,
|
|
+ MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
|
|
XF=XT
|
|
YF=SUM
|
|
END IF
|
|
100 CONTINUE
|
|
CALL VT100M
|
|
END
|
|
SUBROUTINE STARTR(SEQ,IDIM,SCORES,IDIMS,LENW,SUM)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDIM)
|
|
REAL SCORES(IDIMS)
|
|
INTEGER CTONUM
|
|
EXTERNAL CTONUM
|
|
SUM=0.
|
|
DO 10 I=1,LENW
|
|
SUM = SUM + SCORES(CTONUM(SEQ(I)))
|
|
10 CONTINUE
|
|
END
|
|
C this routine uses the following arrays and variables:
|
|
C a concatenated array of recognition sequences recseq maxrec idrseq prec
|
|
C a concatenated array of enzyme names names maxnam idnaml pnam
|
|
C a list of pointers to enzyme names in names namep maxnam itoten
|
|
C a list of enzyme name lengths namlen maxen itoten
|
|
C a list of numbers of recognition sequences per enzyme numrec maxen
|
|
C a list of lenghts of recognition sequences per enzyme (all expected
|
|
C to be the same) lenen maxen itoten
|
|
C a list of pointers to the first character of the first recognition
|
|
C sequence per enzyme recstr maxen itoten
|
|
C it also needs temporary storage of matches in psave and nsave of
|
|
C size maxmat and temporary storage of lengths of fragments in length
|
|
C output of results is on unit idev
|
|
SUBROUTINE SERCHP(SEQ,IDSEQ,J1,J2,KSTART,
|
|
+RENZYM,MAXREN,RECSEQ,MAXREC,
|
|
+NAMES,MAXNAM,LENGTH,PSAVE,NSAVE,MAXMAT,
|
|
+NAMEP,NAMLEN,NUMREC,LENEN,RECSTR,NAMLST,MAXENZ,
|
|
+MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,IDEV,
|
|
+IDEVEN,FILNAM,FILEA,FILEAA,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,DIALOG)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER FILNAM*(*),FILEA*(*),FILEAA*(*),HELPF*(*)
|
|
CHARACTER SEQ(IDSEQ),RENZYM(MAXREN),RECSEQ(MAXREC),NAMES(MAXNAM)
|
|
INTEGER OPTION,OPTOUT
|
|
INTEGER LENGTH(MAXMAT),PSAVE(MAXMAT),NSAVE(MAXMAT)
|
|
INTEGER NAMEP(MAXENZ),NAMLEN(MAXENZ),NUMREC(MAXENZ)
|
|
INTEGER LENEN(MAXENZ)
|
|
INTEGER RECSTR(MAXENZ),NAMLST(MAXENZ),DIALOG
|
|
PARAMETER (IBH=256)
|
|
CALL SHOWFU(KBOUT,'Search for short sequences')
|
|
CALL GETPAR(17,7,IOK,IFILE,OPTION,OPTOUT,NOPOUT,
|
|
+MININC,MAXINC,INC,
|
|
+IPAR8,IPAR9)
|
|
IF(IOK.NE.0) RETURN
|
|
10 CONTINUE
|
|
IDREN = MAXREN
|
|
IDRSEQ = MAXREC
|
|
IDNAML = MAXNAM
|
|
IDNLST = MAXENZ
|
|
MAXEN = MAXENZ
|
|
IDMAT = MAXMAT
|
|
LEVEL = 0
|
|
CALL SERCHD(RENZYM,IDREN,RECSEQ,IDRSEQ,
|
|
+NAMES,IDNAML,MARGT,
|
|
+NAMEP,NAMLEN,NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,
|
|
+IDEVEN,FILNAM,FILEA,FILEAA,KBIN,KBOUT,
|
|
+OPTION,OPTOUT,NOPOUT,IFILE,MININC,MAXINC,INC,DIALOG,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
CALL BUSY(KBOUT)
|
|
IF(OPTOUT.EQ.2) THEN
|
|
C CALL FINDL1(SEQ,IDSEQ,J1,J2,KSTART,RECSEQ,IDRSEQ,NAMES,IDNAML,
|
|
C + NAMEP,NAMLEN,
|
|
C + NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,OPTION,OPTOUT,
|
|
C + PSAVE,NSAVE,LENGTH,IDMAT,NOPOUT,IBH,LEVEL,
|
|
C + MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,INC,KBIN,KBOUT,IDEV,
|
|
C + IHELPS,IHELPE,HELPF,IDEVH)
|
|
ELSE IF((OPTOUT.EQ.0).AND.(NOPOUT.EQ.1)) THEN
|
|
CALL FINDL2(SEQ,IDSEQ,J1,J2,KSTART,RECSEQ,IDRSEQ,NAMES,IDNAML,
|
|
+ NAMEP,NAMLEN,
|
|
+ NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,OPTION,OPTOUT,
|
|
+ PSAVE,NSAVE,LENGTH,IDMAT,NOPOUT,IBH,LEVEL,
|
|
+ MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,INC,KBIN,KBOUT,IDEV,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH)
|
|
ELSE IF((OPTOUT.EQ.1).AND.(NOPOUT.EQ.1)) THEN
|
|
CALL FINDL3(SEQ,IDSEQ,J1,J2,KSTART,RECSEQ,IDRSEQ,NAMES,IDNAML,
|
|
+ NAMEP,NAMLEN,
|
|
+ NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,OPTION,OPTOUT,
|
|
+ PSAVE,NSAVE,LENGTH,IDMAT,NOPOUT,IBH,LEVEL,
|
|
+ MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,INC,KBIN,KBOUT,IDEV,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH)
|
|
ELSE IF((OPTOUT.EQ.0).AND.(NOPOUT.EQ.0)) THEN
|
|
CALL FINDL4(SEQ,IDSEQ,J1,J2,KSTART,RECSEQ,IDRSEQ,NAMES,IDNAML,
|
|
+ NAMEP,NAMLEN,
|
|
+ NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,OPTION,OPTOUT,
|
|
+ PSAVE,NSAVE,LENGTH,IDMAT,NOPOUT,IBH,LEVEL,
|
|
+ MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,INC,KBIN,KBOUT,IDEV,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH)
|
|
ELSE IF((OPTOUT.EQ.1).AND.(NOPOUT.EQ.0)) THEN
|
|
CALL FINDL5(SEQ,IDSEQ,J1,J2,KSTART,RECSEQ,IDRSEQ,NAMES,IDNAML,
|
|
+ NAMEP,NAMLEN,
|
|
+ NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,OPTION,OPTOUT,
|
|
+ PSAVE,NSAVE,LENGTH,IDMAT,NOPOUT,IBH,LEVEL,
|
|
+ MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,INC,KBIN,KBOUT,IDEV,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH)
|
|
END IF
|
|
CALL BPAUSE(KBIN,KBOUT,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
DIALOG = 1
|
|
GO TO 10
|
|
END
|
|
SUBROUTINE GETRNP(RENZYM,IDREN,IDEV,FILNAM,FILEA,FILEAA,
|
|
+ IOK,KBIN,KBOUT,IFILE,DIALOG,
|
|
+IHELPS,IHELPE,HELPF,IDEVH)
|
|
CHARACTER HELPF*(*)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER FILNAM*(*),FILEA*(*),FILEAA*(*),RENZYM(IDREN)
|
|
INTEGER DIALOG
|
|
PARAMETER (MAXPRM = 16)
|
|
CHARACTER PROMPT(4)*(MAXPRM)
|
|
IOK = 1
|
|
IF(DIALOG.EQ.0) NOPT = IFILE
|
|
IOP = 1
|
|
1 CONTINUE
|
|
IF(DIALOG.EQ.1) THEN
|
|
PROMPT(1) = 'Search'
|
|
PROMPT(2) = 'List enzyme file'
|
|
PROMPT(3) = 'Clear text'
|
|
PROMPT(4) = 'Clear graphics'
|
|
IOP = 1
|
|
CALL RADION('Select option',PROMPT,4,IOP,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(IOP.LT.1) THEN
|
|
IOK = 1
|
|
RETURN
|
|
END IF
|
|
IF(IOP.EQ.3) THEN
|
|
CALL CLEARV
|
|
CALL BPAUSE(KBIN,KBOUT,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
GO TO 1
|
|
END IF
|
|
IF(IOP.EQ.4) THEN
|
|
CALL CLEARG
|
|
CALL BPAUSE(KBIN,KBOUT,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
GO TO 1
|
|
END IF
|
|
IF((IOP.EQ.1).OR.(IOP.EQ.2)) THEN
|
|
NOPT = IFILE
|
|
PROMPT(1) = 'All acids'
|
|
PROMPT(2) = 'Named groups'
|
|
PROMPT(3) = 'Personal file'
|
|
PROMPT(4) = 'Keyboard'
|
|
CALL RADION('Select string definition mode',PROMPT,4,NOPT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(NOPT.LT.1) THEN
|
|
IOK = 1
|
|
RETURN
|
|
END IF
|
|
END IF
|
|
END IF
|
|
IF(NOPT.EQ.1)THEN
|
|
CALL OPENRS(IDEV,FILEAA,IOK,LRECL,2)
|
|
IF(IOK.NE.0)GO TO 100
|
|
IF(IOP.EQ.2)THEN
|
|
CALL TTEXT1(IDEV,KBIN,KBOUT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,IQUIT)
|
|
GO TO 1
|
|
END IF
|
|
CALL ARRFIL(IDEV,RENZYM,IDREN,KBOUT)
|
|
CLOSE(UNIT=IDEV)
|
|
RETURN
|
|
END IF
|
|
IF(NOPT.EQ.2)THEN
|
|
CALL OPENRS(IDEV,FILEA,IOK,LRECL,2)
|
|
IF(IOK.NE.0)GO TO 100
|
|
IF(IOP.EQ.2)THEN
|
|
CALL TTEXT1(IDEV,KBIN,KBOUT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,IQUIT)
|
|
GO TO 1
|
|
END IF
|
|
CALL ARRFIL(IDEV,RENZYM,IDREN,KBOUT)
|
|
CLOSE(UNIT=IDEV)
|
|
RETURN
|
|
END IF
|
|
IF(NOPT.EQ.3)THEN
|
|
FILNAM = ' '
|
|
CALL OPENF1(IDEV,FILNAM,0,IOK,KBIN,KBOUT,
|
|
+ 'Named sequences file',
|
|
+ IHELPS,IHELPE,HELPF,IDEVH)
|
|
IF(IOK.EQ.2) GO TO 1
|
|
IF(IOK.NE.0)GO TO 100
|
|
IF(IOP.EQ.2)THEN
|
|
CALL TTEXT1(IDEV,KBIN,KBOUT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,IQUIT)
|
|
GO TO 1
|
|
END IF
|
|
CALL ARRFIL(IDEV,RENZYM,IDREN,KBOUT)
|
|
CLOSE(UNIT=IDEV)
|
|
RETURN
|
|
END IF
|
|
IF(NOPT.EQ.4)THEN
|
|
CALL GETRKB(RENZYM,IDREN,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,
|
|
+ IOK)
|
|
RETURN
|
|
END IF
|
|
GO TO 1
|
|
100 CONTINUE
|
|
CALL ERROM(KBOUT,'Error opening file')
|
|
IOK=1
|
|
GO TO 1
|
|
END
|
|
SUBROUTINE DECREN(RENZYM,IDREN,RECSEQ,IDRSEQ,NAMES,IDNAML,
|
|
+NAMEP,NAMLEN,NUMREC,LENEN,RECSTR,MAXEN,KBOUT)
|
|
C routine to decode a restriction enzyme file array renzym idren
|
|
C into the following:
|
|
C a concatenated array of recognition sequences recseq idrseq prec
|
|
C a concatenated array of enzyme names names idnaml,pnam
|
|
C a list of pointers to enzyme names in names namep maxen itoten
|
|
C a list of enzyme name lengths namlen maxen itoten
|
|
C a list of numbers of recognition sequences per enzyme numrec maxen
|
|
C a list of lenghts of recognition sequences per enzyme (all expected
|
|
C to be the same) lenen maxen itoten
|
|
C a list of pointers to the first character of the first recognition
|
|
C sequence per enzyme recstr maxen itoten
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER RENZYM(IDREN),RECSEQ(IDRSEQ),NAMES(IDNAML)
|
|
INTEGER NAMEP(MAXEN),NAMLEN(MAXEN),NUMREC(MAXEN),LENEN(MAXEN)
|
|
INTEGER RECSTR(MAXEN),TOTEN,PREC,PREN,PNAM
|
|
TOTEN=0
|
|
PREC=1
|
|
PREN=0
|
|
PNAM=1
|
|
10 CONTINUE
|
|
PREN=PREN+1
|
|
IF(PREN.LT.IDREN)THEN
|
|
CALL CHARCT(RENZYM,IDREN,PREN,NCHAR)
|
|
IF(NCHAR.GT.0)THEN
|
|
TOTEN=TOTEN+1
|
|
IF(TOTEN.LT.MAXEN)THEN
|
|
IF((PNAM+NCHAR-1).GT.IDNAML)THEN
|
|
WRITE(KBOUT,1006)
|
|
1006 FORMAT(' Names array full')
|
|
GO TO 101
|
|
END IF
|
|
NAMEP(TOTEN)=PNAM
|
|
NAMLEN(TOTEN)=NCHAR
|
|
CALL SQCOPY(RENZYM(PREN),NAMES(PNAM),NCHAR)
|
|
PNAM=PNAM+NCHAR
|
|
NREC=0
|
|
LMAX=0
|
|
20 CONTINUE
|
|
PREN=PREN+NCHAR+1
|
|
NCHAR=0
|
|
IF(PREN.LT.IDREN)CALL CHARCT(RENZYM,IDREN,PREN,NCHAR)
|
|
IF(NCHAR.EQ.0)THEN
|
|
IF(NREC.EQ.0)THEN
|
|
WRITE(KBOUT,1002)
|
|
1002 FORMAT(' Name with no strings!')
|
|
TOTEN=TOTEN-1
|
|
GO TO 100
|
|
END IF
|
|
NUMREC(TOTEN)=NREC
|
|
LENEN(TOTEN)=LMAX
|
|
GO TO 10
|
|
END IF
|
|
NREC=NREC+1
|
|
IF(NCHAR.GT.LMAX)LMAX=NCHAR
|
|
CALL SQCOPY(RENZYM(PREN),RECSEQ(PREC),NCHAR)
|
|
IF(NREC.EQ.1)RECSTR(TOTEN)=PREC
|
|
PREC=PREC+NCHAR
|
|
GO TO 20
|
|
END IF
|
|
CALL ERROM(KBOUT,'Too many names')
|
|
GO TO 100
|
|
END IF
|
|
CALL ERROM(KBOUT,'Error in names and strings file')
|
|
END IF
|
|
100 CONTINUE
|
|
101 CONTINUE
|
|
C WRITE(KBOUT,1001)TOTEN
|
|
C1001 FORMAT(' number of names=',I6)
|
|
IDNAML=PNAM-1
|
|
MAXEN=TOTEN
|
|
IDRSEQ=PREC
|
|
END
|
|
SUBROUTINE FIND4(SEQ,IDIM1,STRING,IDIM2,INC,IMATCH)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDIM1),STRING(IDIM2),DASH
|
|
INTEGER PSEQ,PSTR
|
|
SAVE DASH
|
|
DATA DASH/'-'/
|
|
PSEQ=1-1*INC
|
|
PSTR=1
|
|
IMATCH=0
|
|
100 CONTINUE
|
|
PSEQ=PSEQ+1-PSTR
|
|
PSEQ=PSEQ+INC-1
|
|
400 CONTINUE
|
|
PSTR=0
|
|
500 CONTINUE
|
|
PSEQ=PSEQ+1
|
|
IF(PSEQ.GT.IDIM1)GO TO 300
|
|
PSTR=PSTR+1
|
|
IF(STRING(PSTR).EQ.DASH)GO TO 450
|
|
IF(SEQ(PSEQ).NE.STRING(PSTR))GO TO 100
|
|
450 CONTINUE
|
|
IF(PSTR.LT.IDIM2)GO TO 500
|
|
IMATCH=PSEQ-IDIM2+1
|
|
300 CONTINUE
|
|
END
|
|
SUBROUTINE S1(SEQ,IDSEQ,NREC,LREC,JEN,IREC,J1,J2,INC,KSTART,
|
|
+RECSTR,MAXEN,PSAVE,NSAVE,MAXMAT,RECSEQ,IDRSEQ,IFOUND,KBOUT,IOK)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDSEQ),RECSEQ(IDRSEQ)
|
|
INTEGER RECSTR(MAXEN),PSAVE(MAXMAT),NSAVE(MAXMAT)
|
|
IOK = 1
|
|
DO 50 IREC=1,NREC
|
|
ISTR=RECSTR(JEN)+(IREC-1)*(LREC)
|
|
C NOTE WE NEED TO POINT TO THE CORRECT ARRAY ELEMENT BUT
|
|
C TO REMEMBER THE SEQUENCE ELEMENT FOR OUTPUT
|
|
C IAT IS THE ARRAY ELEMENT
|
|
IAT=J1-INC-KSTART+1
|
|
10 CONTINUE
|
|
IAT=IAT+INC
|
|
ILEFT=J2-IAT+1-KSTART+1
|
|
IF(ILEFT.GT.0)THEN
|
|
CALL FIND8(SEQ(IAT),ILEFT,
|
|
+ RECSEQ(ISTR),LREC,INC,IMATCH)
|
|
IF(IMATCH.GT.0)THEN
|
|
IFOUND=IFOUND+1
|
|
IF(IFOUND.GT.MAXMAT)THEN
|
|
CALL ERROM(KBOUT,'Too many matches')
|
|
RETURN
|
|
END IF
|
|
IAT=IAT+IMATCH-1
|
|
C SAVE POSITION RELATIVE TO ARRAY
|
|
PSAVE(IFOUND)=IAT
|
|
NSAVE(IFOUND)=JEN
|
|
GO TO 10
|
|
END IF
|
|
END IF
|
|
50 CONTINUE
|
|
IOK = 0
|
|
END
|
|
SUBROUTINE S2(SEQ,IDSEQ,IFOUND,NAMEP,NAMLEN,LENEN,MAXEN,
|
|
+NSAVE,PSAVE,LENGTH,MAXMAT,NAMES,IDNAML,
|
|
+LENN,IDEV,J2,KSTART,JOB)
|
|
PARAMETER (IDT = 20)
|
|
CHARACTER SEQ(IDSEQ),TEMP1(IDT),TEMP2(IDT),NAMES(IDNAML)
|
|
INTEGER NAMEP(MAXEN),NAMLEN(MAXEN),LENEN(MAXEN)
|
|
INTEGER NSAVE(MAXMAT),PSAVE(MAXMAT),LENGTH(MAXMAT)
|
|
DO 60 KOUT=1,IFOUND
|
|
KR1=NAMEP(NSAVE(KOUT))
|
|
KS1=PSAVE(KOUT)
|
|
CALL FILLC(TEMP1,IDT,' ')
|
|
CALL FILLC(TEMP2,IDT,' ')
|
|
KR2 = NAMLEN(NSAVE(KOUT))
|
|
CALL SQCOPY(NAMES(KR1),TEMP1,KR2)
|
|
KR2 = LENEN(NSAVE(KOUT))
|
|
CALL SQCOPY(SEQ(KS1),TEMP2,KR2)
|
|
LENN=PSAVE(KOUT)-LENN
|
|
IF(JOB.EQ.0) THEN
|
|
WRITE(IDEV,1008)
|
|
+ TEMP1,TEMP2,PSAVE(KOUT)+KSTART-1,LENN,LENGTH(KOUT)
|
|
ELSE IF(JOB.EQ.1) THEN
|
|
WRITE(IDEV,1008)
|
|
+ TEMP1,TEMP2,PSAVE(KOUT)+KSTART-1,LENGTH(KOUT)
|
|
END IF
|
|
LENN=PSAVE(KOUT)
|
|
1008 FORMAT(' ',20A1,2X,20A1,2X,I6,2X,I6,2X,I6)
|
|
60 CONTINUE
|
|
IF(JOB.EQ.0) THEN
|
|
LEND=J2-PSAVE(IFOUND)+1-KSTART+1
|
|
WRITE(IDEV,1020)LEND,LENGTH(IFOUND+1)
|
|
1020 FORMAT(' ',52X,I6,2X,I6)
|
|
ELSE IF (JOB.EQ.1) THEN
|
|
LEND=J2-PSAVE(IFOUND)+1-KSTART+1
|
|
WRITE(IDEV,1020)LEND
|
|
END IF
|
|
END
|
|
SUBROUTINE FINDL2(SEQ,IDSEQ,J1,J2,KSTART,RECSEQ,IDRSEQ,
|
|
1NAMES,IDNAML,NAMEP,NAMLEN,
|
|
1NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,OPTION,OPTOUT,
|
|
1PSAVE,NSAVE,LENGTH,MAXMAT,NOPOUT,IBH,LEVEL,
|
|
1MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,INC,KBIN,KBOUT,IDEV,
|
|
+IHELPS,IHELPE,HELPF,IDEVH)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDSEQ),NAMES(IDNAML),RECSEQ(IDRSEQ)
|
|
INTEGER NAMEP(MAXEN),NAMLEN(MAXEN),NUMREC(MAXEN),LENEN(MAXEN)
|
|
INTEGER RECSTR(MAXEN),NAMLST(IDNLST),PSAVE(MAXMAT)
|
|
INTEGER LENGTH(MAXMAT)
|
|
INTEGER NSAVE(MAXMAT),OPTION,OPTOUT
|
|
CHARACTER HELPF*(*)
|
|
CHARACTER*20 ATOS
|
|
EXTERNAL ATOS
|
|
C OPTOUT=0 ENZYME BY ENZYME
|
|
C NOPOUT=1 GRAPHICAL OUTPUT
|
|
C FOR GRAPHICS NEED TO CHECK FOR END OF SCREEN
|
|
CALL CLEARV
|
|
CALL VECTOM
|
|
LEVEL1=LEVEL
|
|
LEVELM=MARGT-IBH
|
|
C names max length 20 chars, strings 20 chars
|
|
LAST=MAXEN
|
|
IF(OPTION.EQ.1)LAST=IDNLST
|
|
DO 100 IEN=1,LAST
|
|
IFOUND=0
|
|
JEN=IEN
|
|
IF(OPTION.EQ.1)JEN=NAMLST(IEN)
|
|
NREC=NUMREC(JEN)
|
|
LREC=LENEN(JEN)
|
|
CALL S1(SEQ,IDSEQ,NREC,LREC,JEN,IREC,J1,J2,INC,KSTART,
|
|
+ RECSTR,MAXEN,PSAVE,NSAVE,MAXMAT,RECSEQ,IDRSEQ,IFOUND,KBOUT,
|
|
+ IOK)
|
|
IF(IOK.NE.0) THEN
|
|
CALL VT100M
|
|
RETURN
|
|
END IF
|
|
IF(IFOUND.GT.0) THEN
|
|
IF(LEVEL.GE.LEVELM)THEN
|
|
CALL PSRCHX(LEVEL1,LEVEL,KBIN,KBOUT,IQUIT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH)
|
|
IF(IQUIT.EQ.1) THEN
|
|
CALL VT100M
|
|
RETURN
|
|
END IF
|
|
END IF
|
|
CALL PLSRCH(J1-KSTART+1,J2-KSTART+1,
|
|
+ PSAVE,IFOUND,IBH,LEVEL,
|
|
+ ATOS(NAMES(NAMEP(JEN)),NAMLEN(JEN)),
|
|
+ NAMLEN(JEN),
|
|
+ MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
|
|
END IF
|
|
100 CONTINUE
|
|
CALL VT100M
|
|
END
|
|
SUBROUTINE FINDL3(SEQ,IDSEQ,J1,J2,KSTART,RECSEQ,IDRSEQ,
|
|
+NAMES,IDNAML,NAMEP,NAMLEN,
|
|
+NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,OPTION,OPTOUT,
|
|
+PSAVE,NSAVE,LENGTH,MAXMAT,NOPOUT,IBH,LEVEL,
|
|
+MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,INC,KBIN,KBOUT,IDEV,
|
|
+IHELPS,IHELPE,HELPF,IDEVH)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDSEQ),NAMES(IDNAML),RECSEQ(IDRSEQ)
|
|
INTEGER NAMEP(MAXEN),NAMLEN(MAXEN),NUMREC(MAXEN),LENEN(MAXEN)
|
|
INTEGER RECSTR(MAXEN),NAMLST(IDNLST),PSAVE(MAXMAT)
|
|
INTEGER LENGTH(MAXMAT)
|
|
INTEGER NSAVE(MAXMAT),OPTION,OPTOUT
|
|
CHARACTER HELPF*(*)
|
|
C OPTOUT=1 ALL ENZYMES TOGETHER
|
|
C NOPOUT=1 GRAPHICAL OUTPUT
|
|
C FOR GRAPHICS NEED TO CHECK FOR END OF SCREEN
|
|
CALL CLEARV
|
|
CALL VECTOM
|
|
LEVEL1=LEVEL
|
|
LEVELM=MARGT-IBH
|
|
C names max length 20 chars, strings 20 chars
|
|
LAST=MAXEN
|
|
IF(OPTION.EQ.1)LAST=IDNLST
|
|
IFOUND=0
|
|
DO 100 IEN=1,LAST
|
|
JEN=IEN
|
|
IF(OPTION.EQ.1)JEN=NAMLST(IEN)
|
|
NREC=NUMREC(JEN)
|
|
LREC=LENEN(JEN)
|
|
CALL S1(SEQ,IDSEQ,NREC,LREC,JEN,IREC,J1,J2,INC,KSTART,
|
|
+ RECSTR,MAXEN,PSAVE,NSAVE,MAXMAT,RECSEQ,IDRSEQ,IFOUND,KBOUT,
|
|
+ IOK)
|
|
IF(IOK.NE.0) THEN
|
|
CALL VT100M
|
|
RETURN
|
|
END IF
|
|
100 CONTINUE
|
|
IF(IFOUND.GT.0)THEN
|
|
CALL PLSRCH(J1-KSTART+1,J2-KSTART+1,
|
|
+ PSAVE,IFOUND,IBH,LEVEL,'ALL',3,
|
|
+ MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
|
|
END IF
|
|
CALL VT100M
|
|
IF(IFOUND.EQ.0)WRITE(IDEV,3000)
|
|
3000 FORMAT(' no matches')
|
|
END
|
|
SUBROUTINE FINDL4(SEQ,IDSEQ,J1,J2,KSTART,RECSEQ,IDRSEQ,
|
|
+NAMES,IDNAML,NAMEP,NAMLEN,
|
|
+NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,OPTION,OPTOUT,
|
|
+PSAVE,NSAVE,LENGTH,MAXMAT,NOPOUT,IBH,LEVEL,
|
|
+MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,INC,KBIN,KBOUT,IDEV,
|
|
+IHELPS,IHELPE,HELPF,IDEVH)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDSEQ),NAMES(IDNAML),RECSEQ(IDRSEQ)
|
|
INTEGER NAMEP(MAXEN),NAMLEN(MAXEN),NUMREC(MAXEN),LENEN(MAXEN)
|
|
INTEGER RECSTR(MAXEN),NAMLST(IDNLST),PSAVE(MAXMAT)
|
|
INTEGER LENGTH(MAXMAT)
|
|
INTEGER NSAVE(MAXMAT),OPTION,OPTOUT
|
|
CHARACTER HELPF*(*)
|
|
C OPTOUT=0 ENZYME BY ENZYME
|
|
C names max length 20 chars, strings 20 chars
|
|
LAST=MAXEN
|
|
IF(OPTION.EQ.1)LAST=IDNLST
|
|
DO 100 IEN=1,LAST
|
|
IFOUND=0
|
|
JEN=IEN
|
|
IF(OPTION.EQ.1)JEN=NAMLST(IEN)
|
|
NREC=NUMREC(JEN)
|
|
LREC=LENEN(JEN)
|
|
CALL S1(SEQ,IDSEQ,NREC,LREC,JEN,IREC,J1,J2,INC,KSTART,
|
|
+ RECSTR,MAXEN,PSAVE,NSAVE,MAXMAT,RECSEQ,IDRSEQ,IFOUND,KBOUT,
|
|
+ IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
IF(IFOUND.GT.0) THEN
|
|
WRITE(IDEV,1010)IFOUND
|
|
1010 FORMAT(' matches=',I6)
|
|
CALL BUB2AS(PSAVE,NSAVE,IFOUND)
|
|
C calc lengths
|
|
LENGTH(1)=PSAVE(1)-(J1-KSTART+1)
|
|
DO 45 KOUT=2,IFOUND
|
|
LENGTH(KOUT)=PSAVE(KOUT)-PSAVE(KOUT-1)
|
|
45 CONTINUE
|
|
C do length to end
|
|
LENGTH(IFOUND+1)=J2-KSTART+1-PSAVE(IFOUND)+1
|
|
IFP1=IFOUND+1
|
|
CALL BUBBLE(LENGTH,IFP1)
|
|
LENN=J1-KSTART
|
|
WRITE(IDEV,1011)
|
|
1011 FORMAT(' NAME SEQUENCE POSITION',
|
|
+ ' FRAGMENT LENGTHS')
|
|
CALL S2(SEQ,IDSEQ,IFOUND,NAMEP,NAMLEN,LENEN,MAXEN,
|
|
+ NSAVE,PSAVE,LENGTH,MAXMAT,NAMES,IDNAML,
|
|
+ LENN,IDEV,J2,KSTART,0)
|
|
END IF
|
|
100 CONTINUE
|
|
END
|
|
SUBROUTINE FINDL5(SEQ,IDSEQ,J1,J2,KSTART,RECSEQ,IDRSEQ,
|
|
+NAMES,IDNAML,NAMEP,NAMLEN,
|
|
+NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,OPTION,OPTOUT,
|
|
+PSAVE,NSAVE,LENGTH,MAXMAT,NOPOUT,IBH,LEVEL,
|
|
+MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,INC,KBIN,KBOUT,IDEV,
|
|
+IHELPS,IHELPE,HELPF,IDEVH)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDSEQ),NAMES(IDNAML),RECSEQ(IDRSEQ)
|
|
INTEGER NAMEP(MAXEN),NAMLEN(MAXEN),NUMREC(MAXEN),LENEN(MAXEN)
|
|
INTEGER RECSTR(MAXEN),NAMLST(IDNLST),PSAVE(MAXMAT)
|
|
INTEGER LENGTH(MAXMAT)
|
|
INTEGER NSAVE(MAXMAT),OPTION,OPTOUT
|
|
CHARACTER HELPF*(*)
|
|
C OPTOUT=1 ALL ENZYMES TOGETHER
|
|
C NOPOUT = 0 (LISTED)
|
|
C names max length 20 chars, strings 20 chars
|
|
LAST=MAXEN
|
|
IF(OPTION.EQ.1)LAST=IDNLST
|
|
IFOUND=0
|
|
DO 100 IEN=1,LAST
|
|
JEN=IEN
|
|
IF(OPTION.EQ.1)JEN=NAMLST(IEN)
|
|
NREC=NUMREC(JEN)
|
|
LREC=LENEN(JEN)
|
|
CALL S1(SEQ,IDSEQ,NREC,LREC,JEN,IREC,J1,J2,INC,KSTART,
|
|
+ RECSTR,MAXEN,PSAVE,NSAVE,MAXMAT,RECSEQ,IDRSEQ,IFOUND,KBOUT,
|
|
+ IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
100 CONTINUE
|
|
IF(IFOUND.GT.0) THEN
|
|
CALL BUB2AS(PSAVE,NSAVE,IFOUND)
|
|
LENN=J1-KSTART
|
|
WRITE(IDEV,1011)
|
|
1011 FORMAT(' NAME SEQUENCE POSITION',
|
|
+ ' FRAGMENT LENGTHS')
|
|
LENGTH(1)=PSAVE(1)-(J1-KSTART+1)
|
|
DO 59 KOUT=2,IFOUND
|
|
LENGTH(KOUT)=PSAVE(KOUT)-PSAVE(KOUT-1)
|
|
59 CONTINUE
|
|
CALL S2(SEQ,IDSEQ,IFOUND,NAMEP,NAMLEN,LENEN,MAXEN,
|
|
+ NSAVE,PSAVE,LENGTH,MAXMAT,NAMES,IDNAML,
|
|
+ LENN,IDEV,J2,KSTART,1)
|
|
ELSE
|
|
WRITE(IDEV,3000)
|
|
3000 FORMAT(' no matches')
|
|
END IF
|
|
END
|
|
SUBROUTINE SERCHD(RENZYM,IDREN,RECSEQ,IDRSEQ,
|
|
+NAMES,IDNAML,MARGT,
|
|
+NAMEP,NAMLEN,NUMREC,LENEN,RECSTR,MAXEN,NAMLST,IDNLST,
|
|
+IDEVEN,FILNAM,FILEA,FILEAA,KBIN,KBOUT,
|
|
+OPTION,OPTOUT,NOPOUT,IFILE,MININC,MAXINC,INC,DIALOG,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER FILNAM*(*),FILEA*(*),FILEAA*(*),HELPF*(*)
|
|
CHARACTER RENZYM(IDREN),RECSEQ(IDRSEQ),NAMES(IDNAML)
|
|
INTEGER OPTION,OPTOUT
|
|
INTEGER NAMEP(MAXEN),NAMLEN(MAXEN),NUMREC(MAXEN)
|
|
INTEGER LENEN(MAXEN)
|
|
INTEGER RECSTR(MAXEN),NAMLST(IDNLST),DIALOG
|
|
IOK = 0
|
|
CALL GETRNP(RENZYM,IDREN,IDEVEN,FILNAM,FILEA,FILEAA,
|
|
+IOK,KBIN,KBOUT,IFILE,DIALOG,
|
|
+IHELPS,IHELPE,HELPF,IDEVH)
|
|
IF(IOK.NE.0)RETURN
|
|
IF(IDREN.LT.5) THEN
|
|
IOK = 1
|
|
RETURN
|
|
END IF
|
|
CALL DECREN(RENZYM,IDREN,RECSEQ,IDRSEQ,NAMES,IDNAML,
|
|
+NAMEP,NAMLEN,NUMREC,LENEN,RECSTR,MAXEN,KBOUT)
|
|
IF(MAXEN.LT.1) THEN
|
|
IOK = 1
|
|
RETURN
|
|
END IF
|
|
IF(DIALOG.EQ.0) RETURN
|
|
IOP = OPTION
|
|
CALL YESONO(IOP,'All names','Selected names',
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(IOP.LT.0) THEN
|
|
IOK = 1
|
|
RETURN
|
|
END IF
|
|
OPTION = IOP
|
|
IF(OPTION.EQ.1)THEN
|
|
CALL GETNAM(NAMLST,IDNLST,NAMES,IDNAML,NAMEP,NAMLEN,
|
|
+ MAXEN,KBIN,KBOUT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH)
|
|
IF(IDNLST.LT.1) THEN
|
|
IOK = 1
|
|
RETURN
|
|
END IF
|
|
END IF
|
|
IOP = OPTOUT
|
|
CALL YESONO(IOP,'Show results name by name',
|
|
+'Show results all names together',
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(IOP.LT.0) THEN
|
|
IOK = 1
|
|
RETURN
|
|
END IF
|
|
OPTOUT = IOP
|
|
IOP = NOPOUT
|
|
CALL YESONO(IOP,'List matches','Plot matches',
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(IOP.LT.0) THEN
|
|
IOK = 1
|
|
RETURN
|
|
END IF
|
|
NOPOUT = IOP
|
|
C IF(NOPOUT.EQ.1)THEN
|
|
C LEVEL = LEVELI
|
|
C CALL SD2(IBLIPH,IBH,LEVEL,MARGT,
|
|
C + IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
|
|
C LEVELI = LEVEL
|
|
C IF(IOK.NE.0) RETURN
|
|
C END IF
|
|
C CALL GETINT(MININC,MAXINC,INC,'Step',
|
|
C +IVAL,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
C IF(IOK.NE.0) RETURN
|
|
C INC = IVAL
|
|
INC = 1
|
|
END
|
|
SUBROUTINE SIGNLP(SEQ,IDIM,MARGL,MARGR,MARGB,MARGT,
|
|
+ISXMAX,ISYMAX,J1,J2,IDEV,FILNAM,
|
|
+KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IDEVOT,
|
|
+SUM,WT,TOT,IDM,MAXLEN,LINE,CHRSET,DIALOG)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDIM),FILNAM*(*),HELPF*(*),CHRSET(IDM)
|
|
CHARACTER LINE(MAXLEN)
|
|
INTEGER SUM(IDM,MAXLEN),TOT(MAXLEN)
|
|
INTEGER DIALOG
|
|
REAL WT(IDM,MAXLEN)
|
|
CALL SHOWFU(KBOUT,'Motif search using weight matrix')
|
|
CALL GETPAR(20,2,IOK,IOPT,IGON,
|
|
+IPAR3,IPAR4,
|
|
+IPAR5,IPAR6,IPAR7,IPAR8,IPAR9)
|
|
IF(IOK.NE.0) RETURN
|
|
CALL SIGNLD(IDEV,FILNAM,
|
|
+KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,
|
|
+SUM,IDM,MAXLEN,TOT,WT,LENGTH,MIDDLE,YMIN,YMIN1,YMAX,
|
|
+IGON,IOPT,IDEVOT,LINE,CHRSET,DIALOG,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
CALL PSIGNL(SEQ,IDIM,MARGL,MARGR,MARGB,MARGT,
|
|
+ISXMAX,ISYMAX,J1,J2,IDEVOT,WT,IDM,MAXLEN,LENGTH,
|
|
+YMIN,YMIN1,YMAX,IGON,MIDDLE)
|
|
END
|
|
SUBROUTINE SIGNLD(IDEV,FILNAM,
|
|
+KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,
|
|
+SUM,IDM,MAXLEN,TOT,WT,LENGTH,MIDDLE,YMIN,YMIN1,YMAX,
|
|
+IGON,IOPT,IDEVOT,LINE,CHRSET,DIALOG,IOK)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER FILNAM*(*),HELPF*(*),CHRSET(IDM),LINE(MAXLEN)
|
|
INTEGER SUM(IDM,MAXLEN),TOT(MAXLEN),DIALOG
|
|
REAL WT(IDM,MAXLEN)
|
|
INTEGER VALUE
|
|
PARAMETER (MAXPRM = 21)
|
|
CHARACTER PROMPT(3)*(MAXPRM)
|
|
IOK = 1
|
|
IDO = 1
|
|
PROMPT(1) = 'Use weight matrix'
|
|
PROMPT(2) = 'Make weight matrix'
|
|
PROMPT(3) = 'Rescale weight matrix'
|
|
CALL RADION('Select operation',PROMPT,3,IDO,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(IDO.LT.1) RETURN
|
|
IF(IDO.GT.1) THEN
|
|
CALL MKWT(WT,SUM,TOT,CHRSET,IDM,MAXLEN,
|
|
+ IDEV,IDEVOT,KBIN,KBOUT,LINE,
|
|
+ FILNAM,IDO,IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IOK = 1
|
|
RETURN
|
|
END IF
|
|
FILNAM = ' '
|
|
CALL OPENF1(IDEV,FILNAM,0,IOK,KBIN,KBOUT,
|
|
+'Motif weight matrix file',
|
|
+IHELPS,IHELPE,HELPF,IDEVH)
|
|
IF(IOK.NE.0) RETURN
|
|
LENGTH=MAXLEN
|
|
CALL RDWMT(TOT,SUM,MIDDLE,LENGTH,MAXLEN,YMIN,YMAX,IDEV,
|
|
+ IOK,IDM,KBOUT,0)
|
|
IF(IOK.NE.0)THEN
|
|
CALL ERROM(KBOUT,'Error in weight matrix')
|
|
RETURN
|
|
END IF
|
|
CALL YESONO(IOPT,'Use frequencies as weights',
|
|
+'Membership of set',IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(IOPT.LT.0) THEN
|
|
IOK = 1
|
|
RETURN
|
|
END IF
|
|
IF(IOPT.EQ.1)THEN
|
|
CALL GETW1(SUM,WT,LENGTH,IDM,MAXLEN)
|
|
MININ = 1
|
|
MAXIN = LENGTH
|
|
CALL GETINT(MININ,MAXIN,LENGTH,'Cutoff score',
|
|
+ VALUE,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
YMIN = 0.
|
|
YMAX = LENGTH
|
|
YMIN1 = VALUE
|
|
ELSE
|
|
IF(DIALOG.EQ.1) THEN
|
|
AMN = -9999.
|
|
AMX = 9999.
|
|
CALL GETRL(AMN,AMX,YMIN,'Cutoff score',VAL,KBIN,KBOUT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
YMIN = VAL
|
|
END IF
|
|
IF(YMIN.LT.0.0)CALL GETW(TOT,SUM,WT,LENGTH,IDM,MAXLEN)
|
|
IF(YMIN.GE.0.0)CALL GETW2(SUM,WT,LENGTH,IDM,MAXLEN)
|
|
YMIN1 = YMIN
|
|
END IF
|
|
CALL YESONO(IGON,'Plot results','List results',
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(IGON.LT.0) RETURN
|
|
IOK = 0
|
|
END
|
|
SUBROUTINE PSIGNL(SEQ,IDIM,MARGL,MARGR,MARGB,MARGT,
|
|
+ISXMAX,ISYMAX,J1,J2,IDEVOT,WT,IDM,MAXLEN,LENGTH,
|
|
+YMIN,YMIN1,YMAX,IGON,MIDDLE)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDIM)
|
|
REAL WT(IDM,MAXLEN)
|
|
INTEGER CTONUM
|
|
EXTERNAL CTONUM
|
|
XMAX=J2
|
|
XMIN=J1
|
|
IF(IGON.EQ.0)THEN
|
|
CALL CLEARV
|
|
CALL VECTOM
|
|
CALL FRAME(MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
|
|
END IF
|
|
DO 10 I=J1,J2-LENGTH+1
|
|
SUM1=0.
|
|
K=0
|
|
DO 5 J=I,I+LENGTH-1
|
|
K=K+1
|
|
SUM1=SUM1+WT(CTONUM(SEQ(J)),K)
|
|
5 CONTINUE
|
|
IF(SUM1.GE.YMIN1)THEN
|
|
IF(IGON.EQ.0)THEN
|
|
X=I+MIDDLE
|
|
CALL LINE(X,X,YMIN,SUM1,XMAX,XMIN,YMAX,YMIN,
|
|
+ MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
|
|
END IF
|
|
IF(IGON.EQ.1)THEN
|
|
CALL VT100M
|
|
WRITE(IDEVOT,1010)I+MIDDLE,SUM1,(SEQ(K),K=I,I+LENGTH-1)
|
|
1010 FORMAT(' ',I7,F10.2,' ',120A1)
|
|
END IF
|
|
END IF
|
|
10 CONTINUE
|
|
CALL VT100M
|
|
END
|
|
SUBROUTINE LSTSEP(SEQ,IDIM,IDEV,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,DIALOG)
|
|
CHARACTER HELPF*(*)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDIM)
|
|
INTEGER DIALOG
|
|
CALL SHOWFU(KBOUT,'List the sequence')
|
|
I1 = 1
|
|
I2 = IDIM
|
|
LENGTH = 60
|
|
IF(DIALOG.EQ.1) THEN
|
|
CALL LSTSPD(IDIM,KBIN,KBOUT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,I1,I2,LENGTH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
END IF
|
|
CALL LSTSP(SEQ,IDIM,I1,I2,LENGTH,IDEV)
|
|
END
|
|
SUBROUTINE LSTSPD(IDIM,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,I1,I2,LENGTH,IOK)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER HELPF*(*)
|
|
INTEGER VALUE
|
|
IOK = 1
|
|
1 CONTINUE
|
|
VALUE = I1
|
|
CALL GETINT(I1,I2,VALUE,
|
|
+'List from ',
|
|
+VALUE,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0)RETURN
|
|
I1 = VALUE
|
|
VALUE = I2
|
|
CALL GETINT(I1,I2,VALUE,
|
|
+'List to ',
|
|
+VALUE,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0)RETURN
|
|
I2 = VALUE
|
|
MININ = 10
|
|
MAXIN = 120
|
|
LENGTH = 60
|
|
CALL GETINT(MININ,MAXIN,LENGTH,
|
|
+'Line length ',
|
|
+VALUE,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0)RETURN
|
|
IF(MOD(VALUE,10).NE.0)VALUE = LENGTH
|
|
LENGTH = VALUE
|
|
END
|
|
SUBROUTINE LSTSP(SEQ,IDIM,I1,I2,LENGTH,IDEV)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDIM)
|
|
CALL FMTSEP(SEQ,IDIM,I1,I2,LENGTH,IDEV)
|
|
END
|
|
SUBROUTINE FMTSEP(SEQ1,IDIM,ISW,ISE,LINLEN,IDEV)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ1(IDIM)
|
|
INTEGER KL(12)
|
|
ISWW=ISW-1
|
|
IE=ISW-1
|
|
1 CONTINUE
|
|
WRITE(IDEV,1003)
|
|
1003 FORMAT( )
|
|
C SET UP DECIMAL COUNTERS
|
|
DO 50 J=1,LINLEN/10
|
|
ISWW=ISWW+10
|
|
KL(J)=ISWW
|
|
50 CONTINUE
|
|
IS=IE+1
|
|
IE=IE+LINLEN
|
|
IF(IE.GT.ISE)IE=ISE
|
|
WRITE(IDEV,1001)(KL(KKK),KKK=1,MIN(IE-IS+1,LINLEN)/10)
|
|
WRITE(IDEV,1002)(SEQ1(K),K=IS,IE)
|
|
1002 FORMAT( ' ',12(10A1,1X))
|
|
1001 FORMAT( ' ',12(5X,I6))
|
|
IF(IE.EQ.ISE)RETURN
|
|
GO TO 1
|
|
END
|
|
C ROUTINE TO PERFORM ROBSON SECONDARY STRUCTURE PREDICTION FOR PROTEINS
|
|
SUBROUTINE ROBSON(SEQ,IDIM1,
|
|
+MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,KBIN,KBOUT,
|
|
+IDEV,FILNAM,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,IDEVOT,DIALOG)
|
|
C AUTHOR: RODGER STADEN
|
|
INTEGER DIALOG
|
|
CHARACTER HELPF*(*),FILNAM*(*)
|
|
CHARACTER SEQ(IDIM1)
|
|
INTEGER HELIX(-8:8,26),EXTEND(-8:8,26),TURN(-8:8,26),COIL(-8:8,26)
|
|
CALL SHOWFU(KBOUT,'Plot Robson secondary structure predictions')
|
|
CALL OPENRS(IDEV,FILNAM,IOK,LRECL,2)
|
|
IF(IOK.NE.0)THEN
|
|
CALL ERROM(KBOUT,'Error opening Robson weights file')
|
|
RETURN
|
|
END IF
|
|
CALL REDROB(HELIX,IDEV,IFAIL)
|
|
CALL REDROB(EXTEND,IDEV,IFAIL)
|
|
CALL REDROB(TURN,IDEV,IFAIL)
|
|
CALL REDROB(COIL,IDEV,IFAIL)
|
|
CLOSE(UNIT=IDEV)
|
|
IF(IFAIL.NE.0)THEN
|
|
CALL ERROM(KBOUT,'Error in Robson score matrix')
|
|
RETURN
|
|
END IF
|
|
CALL GETPAR(24,4,IOK,MINIW,MAXIW,IWRIT,IGON,
|
|
+IPAR5,IPAR6,IPAR7,IPAR8,IPAR9)
|
|
IF(IOK.NE.0) RETURN
|
|
IF(DIALOG.EQ.1) THEN
|
|
CALL ROBSND(MINIW,MAXIW,IWRIT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IGON,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
END IF
|
|
CALL ROBSNP(SEQ,IDIM1,
|
|
+HELIX,EXTEND,TURN,COIL,
|
|
+MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,
|
|
+IDEVOT,IWRIT,IGON)
|
|
END
|
|
SUBROUTINE ROBSNP(SEQ,IDIM1,
|
|
+HELIX,EXTEND,TURN,COIL,
|
|
+MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,
|
|
+IDEVOT,IWRIT,IGON)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDIM1)
|
|
INTEGER CTONUM
|
|
INTEGER HELIX(-8:8,26),EXTEND(-8:8,26),TURN(-8:8,26),COIL(-8:8,26)
|
|
EXTERNAL CTONUM
|
|
YMINH=-400.
|
|
YMAXH=400.
|
|
YMINE=-400.
|
|
YMAXE=400.
|
|
YMINT=-400.
|
|
YMAXT=400.
|
|
YMINC=-400.
|
|
YMAXC=400.
|
|
YMEAN = 0.
|
|
YMIND=0.0
|
|
YMAXD=100.0
|
|
YHD=20.
|
|
YED=40.
|
|
YTD=60.
|
|
YCD=80.
|
|
XMIN=J1
|
|
XMAX=J2
|
|
YMID=YMINH+(YMAXH-YMINH)*0.75
|
|
XMARG=REAL(MARGT)/5.0
|
|
IMARG=NINT(XMARG)
|
|
MARGBH=MARGB+XMARG
|
|
MARGTH=IMARG
|
|
MARGBE=MARGB+2*XMARG
|
|
MARGTE=IMARG
|
|
MARGBT=MARGB+3*XMARG
|
|
MARGTT=IMARG
|
|
MARGBC=MARGB+4*XMARG
|
|
MARGTC=IMARG
|
|
MARGBD=MARGB
|
|
MARGTD=IMARG
|
|
NH = 0
|
|
NE = 0
|
|
NT = 0
|
|
NC = 0
|
|
IF(IGON.EQ.0)THEN
|
|
CALL CLEARV
|
|
CALL VECTOM
|
|
CALL FRAME(MARGL,MARGR,MARGBH,MARGTH,ISXMAX,ISYMAX)
|
|
CALL FRAME(MARGL,MARGR,MARGBE,MARGTE,ISXMAX,ISYMAX)
|
|
CALL FRAME(MARGL,MARGR,MARGBT,MARGTT,ISXMAX,ISYMAX)
|
|
CALL FRAME(MARGL,MARGR,MARGBC,MARGTC,ISXMAX,ISYMAX)
|
|
CALL FRAME(MARGL,MARGR,MARGBD,MARGTD,ISXMAX,ISYMAX)
|
|
CALL TEXT(XMIN,YMID,' H',2,0,XMAX,XMIN,YMAXH,YMINH,
|
|
1MARGL,MARGR,MARGBH,MARGTH,ISXMAX,ISYMAX)
|
|
CALL TEXT(XMIN,YMID,' E',2,0,XMAX,XMIN,YMAXE,YMINE,
|
|
1MARGL,MARGR,MARGBE,MARGTE,ISXMAX,ISYMAX)
|
|
CALL TEXT(XMIN,YMID,' T',2,0,XMAX,XMIN,YMAXT,YMINT,
|
|
1MARGL,MARGR,MARGBT,MARGTT,ISXMAX,ISYMAX)
|
|
CALL TEXT(XMIN,YMID,' C',2,0,XMAX,XMIN,YMAXC,YMINC,
|
|
1MARGL,MARGR,MARGBC,MARGTC,ISXMAX,ISYMAX)
|
|
CALL TEXT(XMIN,YCD,' D',2,0,XMAX,XMIN,YMAXD,YMIND,
|
|
1MARGL,MARGR,MARGBD,MARGTD,ISXMAX,ISYMAX)
|
|
END IF
|
|
IDONE=0
|
|
XP=MAX(J1,9)
|
|
X=XP
|
|
YPH=0.
|
|
YPE=0.
|
|
YPC=0.
|
|
YPT=0.
|
|
IOPT = 1
|
|
DO 10 I=MAX(J1,9),MIN(J2,IDIM1-8)
|
|
IDONE=IDONE+1
|
|
SUMH=0.
|
|
SUME=0.
|
|
SUMC=0.
|
|
SUMT=0.
|
|
K=I-9
|
|
DO 5 J=8,-8,-1
|
|
K=K+1
|
|
ISEQ=CTONUM(SEQ(K))
|
|
SUMH=SUMH+HELIX(J,ISEQ)
|
|
SUME=SUME+EXTEND(J,ISEQ)
|
|
SUMC=SUMC+COIL(J,ISEQ)
|
|
SUMT=SUMT+TURN(J,ISEQ)
|
|
5 CONTINUE
|
|
IF(MOD(IDONE,IWRIT).EQ.0)THEN
|
|
YMAX=MAX(SUMH,SUME,SUMC,SUMT)
|
|
X=I
|
|
IF(IGON.EQ.0)THEN
|
|
CALL LINE(XP,X,YPH,SUMH,XMAX,XMIN,YMAXH,YMINH,
|
|
+ MARGL,MARGR,MARGBH,MARGTH,ISXMAX,ISYMAX)
|
|
IF(YMAX.EQ.SUMH)THEN
|
|
CALL POINT(X,YHD,XMAX,XMIN,YMAXD,YMIND,
|
|
+ MARGL,MARGR,MARGBD,MARGTD,ISXMAX,ISYMAX)
|
|
CALL POINT(X,YMEAN,XMAX,XMIN,YMAXH,YMINH,
|
|
+ MARGL,MARGR,MARGBH,MARGTH,ISXMAX,ISYMAX)
|
|
NH = NH + 1
|
|
END IF
|
|
YPH=SUMH
|
|
CALL LINE(XP,X,YPE,SUME,XMAX,XMIN,YMAXE,YMINE,
|
|
+ MARGL,MARGR,MARGBE,MARGTE,ISXMAX,ISYMAX)
|
|
IF(YMAX.EQ.SUME)THEN
|
|
CALL POINT(X,YED,XMAX,XMIN,YMAXD,YMIND,
|
|
+ MARGL,MARGR,MARGBD,MARGTD,ISXMAX,ISYMAX)
|
|
CALL POINT(X,YMEAN,XMAX,XMIN,YMAXE,YMINE,
|
|
+ MARGL,MARGR,MARGBE,MARGTE,ISXMAX,ISYMAX)
|
|
NE = NE + 1
|
|
END IF
|
|
YPE=SUME
|
|
CALL LINE(XP,X,YPT,SUMT,XMAX,XMIN,YMAXT,YMINT,
|
|
+ MARGL,MARGR,MARGBT,MARGTT,ISXMAX,ISYMAX)
|
|
IF(YMAX.EQ.SUMT)THEN
|
|
CALL POINT(X,YTD,XMAX,XMIN,YMAXD,YMIND,
|
|
+ MARGL,MARGR,MARGBD,MARGTD,ISXMAX,ISYMAX)
|
|
CALL POINT(X,YMEAN,XMAX,XMIN,YMAXT,YMINT,
|
|
+ MARGL,MARGR,MARGBT,MARGTT,ISXMAX,ISYMAX)
|
|
NT = NT + 1
|
|
END IF
|
|
YPT=SUMT
|
|
CALL LINE(XP,X,YPC,SUMC,XMAX,XMIN,YMAXC,YMINC,
|
|
+ MARGL,MARGR,MARGBC,MARGTC,ISXMAX,ISYMAX)
|
|
IF(YMAX.EQ.SUMC)THEN
|
|
CALL POINT(X,YCD,XMAX,XMIN,YMAXD,YMIND,
|
|
+ MARGL,MARGR,MARGBD,MARGTD,ISXMAX,ISYMAX)
|
|
CALL POINT(X,YMEAN,XMAX,XMIN,YMAXC,YMINC,
|
|
+ MARGL,MARGR,MARGBC,MARGTC,ISXMAX,ISYMAX)
|
|
NC = NC + 1
|
|
END IF
|
|
YPC=SUMC
|
|
XP=I
|
|
END IF
|
|
IF(IGON.EQ.1)THEN
|
|
CALL VT100M
|
|
WRITE(IDEVOT,1005)
|
|
+ I,SEQ(I),INT(SUMH),INT(SUME),INT(SUMT),INT(SUMC)
|
|
1005 FORMAT(' ',I6,' ',A1,' ',4I5)
|
|
IF(IGON.EQ.0)CALL VECTOM
|
|
END IF
|
|
END IF
|
|
10 CONTINUE
|
|
CALL VT100M
|
|
WRITE(IDEVOT,1006)NH,NE,NT,NC
|
|
1006 FORMAT(
|
|
+' Helix =',I6,', Extended =',I6,', Turn =',I6,', Coil =',I6)
|
|
END
|
|
SUBROUTINE ROBSND(MINIW,MAXIW,IWRIT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IGON,IOK)
|
|
CHARACTER HELPF*(*)
|
|
IOK = 1
|
|
CALL YESONO(IGON,'Plot results','List results',
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(IGON.LT.0) RETURN
|
|
IF(IGON.EQ.0) THEN
|
|
CALL GETINT(MINIW,MAXIW,IWRIT,'Plot interval',IVAL,KBIN,KBOUT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
IWRIT = IVAL
|
|
END IF
|
|
IOK = 0
|
|
END
|
|
SUBROUTINE REDROB(TABLE,IDEV,IFAIL)
|
|
C AUTHOR: RODGER STADEN
|
|
INTEGER TABLE(-8:8,26)
|
|
C SET FAIL FLAG
|
|
IFAIL=1
|
|
1000 FORMAT( )
|
|
1001 FORMAT(3X,17I4)
|
|
C READ TITLE
|
|
READ(IDEV,1000,END=100,ERR=100)
|
|
C READ POSITIONS
|
|
READ(IDEV,1000,END=100,ERR=100)
|
|
C READ VALUES
|
|
DO 10 I=1,26
|
|
READ(IDEV,1001,ERR=100,END=100)(TABLE(K,I),K=-8,8)
|
|
10 CONTINUE
|
|
C SET FAIL FLAG TO GOOD
|
|
IFAIL=0
|
|
RETURN
|
|
100 CONTINUE
|
|
RETURN
|
|
END
|
|
C SUBROUTINE TO DRAW HELIX WHEELS
|
|
SUBROUTINE HELIXW(SEQ,IDSEQ,KSTART,J1,J2,IX0,IXLEN,IY0,IYLEN,
|
|
+ISXMAX,ISYMAX,KBIN,KBOUT,HYDRO,IDSCOR,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,DIALOG)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDSEQ),HELPF*(*)
|
|
INTEGER DIALOG
|
|
INTEGER WINDOW
|
|
REAL HYDRO(IDSCOR)
|
|
PARAMETER (DEGTOR = 0.017453)
|
|
CALL SHOWFU(KBOUT,'Draw helix wheel')
|
|
CALL GETPAR(26,6,IOK,MINANG,MAXANG,IANGLE,MINIW,MAXIW,WINDOW,
|
|
+IPAR7,IPAR8,IPAR9)
|
|
IF(IOK.NE.0) RETURN
|
|
IF(DIALOG.EQ.1) THEN
|
|
CALL HELIXD(MINANG,MAXANG,IANGLE,MINIW,MAXIW,WINDOW,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
END IF
|
|
ANGLE = REAL(IANGLE)*DEGTOR
|
|
CALL HELIXP(SEQ,IDSEQ,KSTART,J1,J2,IX0,IXLEN,IY0,IYLEN,
|
|
+ISXMAX,ISYMAX,KBIN,KBOUT,HYDRO,IDSCOR,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,WINDOW,ANGLE)
|
|
END
|
|
SUBROUTINE HELIXP(SEQ,IDSEQ,KSTART,J1,J2,IX0,IXLEN,IY0,IYLEN,
|
|
+ISXMAX,ISYMAX,KBIN,KBOUT,HYDRO,IDSCOR,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,WINDOW,ANGLE)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDSEQ),HELPF*(*)
|
|
CHARACTER SYMBOL*26,ATOS*60,SYMT*2,POSN*6,POSNHP*8
|
|
CHARACTER*2 NUMBER(1:60)
|
|
INTEGER CTONUM,WINDOW
|
|
REAL HYDRO(IDSCOR)
|
|
EXTERNAL CTONUM,ATOS
|
|
PARAMETER (
|
|
+ RAD1 = 0.78,
|
|
+ RAD2 = 1.25,
|
|
+ RAD3 = 1.50,
|
|
+ RAD4 = 1.0,
|
|
+ XMIN = -1.75,
|
|
+ XMAX = 1.75,
|
|
+ YMIN = -1.75,
|
|
+ YMAX = 1.75,
|
|
+ CENTRX = 0.0,
|
|
+ CENTRY = 0.0,
|
|
+ TXMIN = XMIN + (XMAX-XMIN)*0.05,
|
|
+ TYMIN = YMAX - (YMAX-YMIN)*0.04,
|
|
+ PXMIN = XMIN + (XMAX-XMIN)*0.05,
|
|
+ PYMIN = YMAX - (YMAX-YMIN)*0.16,
|
|
+ HMXMIN = XMIN + (XMAX-XMIN)*0.05,
|
|
+ HMYMIN = YMAX - (YMAX-YMIN)*0.08,
|
|
+ HXMIN = XMIN + (XMAX-XMIN)*0.05,
|
|
+ HYMIN = YMAX - (YMAX-YMIN)*0.12)
|
|
C + TXMIN = XMIN + (XMAX-XMIN)*0.05,
|
|
C + TYMIN = YMAX - (YMAX-YMIN)*0.03,
|
|
C + PXMIN = XMIN + (XMAX-XMIN)*0.05,
|
|
C + PYMIN = YMAX - (YMAX-YMIN)*0.14,
|
|
C + HMXMIN = XMIN + (XMAX-XMIN)*0.05,
|
|
C + HMYMIN = YMAX - (YMAX-YMIN)*0.06,
|
|
C + HXMIN = XMIN + (XMAX-XMIN)*0.05,
|
|
C + HYMIN = YMAX - (YMAX-YMIN)*0.1)
|
|
PARAMETER (DELTA = 0.001)
|
|
C
|
|
SYMBOL =' -- +++ ...... '
|
|
DO 1 I = 1,60
|
|
WRITE(NUMBER(I),1005)I
|
|
1 CONTINUE
|
|
1005 FORMAT(I2)
|
|
POSNHP=' '
|
|
C
|
|
C SEQUENCE CHARACTER IN ELEMENT 1 OF SEQ ARRAY IS KSTART
|
|
C FIRST SEQUENCE CHARACTER IN ACTIVE REGION IS J1, LAST J2
|
|
C DIMENSION OF SEQ ARRAY IS IDSEQ
|
|
C ELEMENT NUMBER FOR J1 IS J1-KSTART+1
|
|
C ELEMENT NUMBER FOR J2 IS J2-KSTART+1
|
|
C NUMBER OF ELEMENTS TO PROCESS IS J2-J1+1
|
|
C WORK IN ELEMENT NUMBERS AND SET TO SEQUENCE NUMBERS FOR OUTPUT
|
|
C SET FIRST ELEMENT NUMBER
|
|
I1 = J1-KSTART+1
|
|
C
|
|
C
|
|
10 CONTINUE
|
|
C
|
|
C
|
|
CALL CLEARV
|
|
CALL VECTOM
|
|
CALL CLEARG
|
|
CALL VECTOM
|
|
CALL FRAME(IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
|
|
XF = 0.0
|
|
YF = RAD1
|
|
ICLOCK = 0
|
|
I2 = MIN(I1+WINDOW-1,J2-KSTART+1)
|
|
IWIN = I2-I1+1
|
|
DO 20 I = I1,I2
|
|
ICLOCK = ICLOCK + 1
|
|
TX = COS(1.5708-((I-I1)*ANGLE))
|
|
TY = SIN(1.5708-((I-I1)*ANGLE))
|
|
X = RAD2*TX
|
|
Y = RAD2*TY
|
|
SYMT = SEQ(I)
|
|
CALL TEXT(X,Y,SYMT,1,ISIZE,XMAX,XMIN,YMAX,YMIN,
|
|
+ IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
|
|
X = RAD4*TX
|
|
Y = RAD4*TY
|
|
SYMT = NUMBER(ICLOCK)
|
|
CALL TEXT(X,Y,SYMT,2,ISIZE,XMAX,XMIN,YMAX,YMIN,
|
|
+ IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
|
|
X = RAD3*TX
|
|
Y = RAD3*TY
|
|
K = CTONUM(SEQ(I))
|
|
SYMT = SYMBOL(K:K)
|
|
CALL TEXT(X,Y,SYMT,1,ISIZE,XMAX,XMIN,YMAX,YMIN,
|
|
+ IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
|
|
X = RAD1*TX
|
|
Y = RAD1*TY
|
|
CALL LINE(XF,X,YF,Y,XMAX,XMIN,YMAX,YMIN,
|
|
+ IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
|
|
XF = X
|
|
YF = Y
|
|
I3 = I
|
|
20 CONTINUE
|
|
CALL EISEN(SEQ(I1),IWIN,HYDRO,IDSCOR,ANGLE,HM,H)
|
|
CALL TEXT(TXMIN,TYMIN,ATOS(SEQ(I1),IWIN),IWIN,ISIZE,
|
|
+ XMAX,XMIN,YMAX,YMIN,
|
|
+ IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
|
|
WRITE(POSN,1000)I1+KSTART-1
|
|
1000 FORMAT(I6)
|
|
CALL TEXT(PXMIN,PYMIN,POSN,6,ISIZE,
|
|
+ XMAX,XMIN,YMAX,YMIN,
|
|
+ IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
|
|
WRITE(POSN,1001)HM*WINDOW
|
|
1001 FORMAT(F6.2)
|
|
POSNHP(2:) = POSN
|
|
POSNHP(1:1) = 'M'
|
|
CALL TEXT(HMXMIN,HMYMIN,POSNHP,8,ISIZE,
|
|
+ XMAX,XMIN,YMAX,YMIN,
|
|
+ IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
|
|
WRITE(POSN,1001)H*WINDOW
|
|
POSNHP(2:) = POSN
|
|
POSNHP(1:1) = 'H'
|
|
CALL TEXT(HXMIN,HYMIN,POSNHP,8,ISIZE,
|
|
+ XMAX,XMIN,YMAX,YMIN,
|
|
+ IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
|
|
ICLOCK = ICLOCK + 1
|
|
TX = COS(1.5708-((I3+1-I1)*ANGLE))
|
|
TY = SIN(1.5708-((I3+1-I1)*ANGLE))
|
|
X = RAD1*TX
|
|
Y = RAD1*TY
|
|
IF((ABS(X).LT.DELTA).AND.(ABS(Y-RAD1).LT.DELTA))
|
|
+ CALL LINE(XF,0.0,YF,RAD1,XMAX,XMIN,YMAX,YMIN,
|
|
+ IX0,IXLEN,IY0,IYLEN,ISXMAX,ISYMAX)
|
|
CALL FLUSHG
|
|
30 CONTINUE
|
|
CALL VT100M
|
|
MINSTP = -1000
|
|
MAXSTP = 1000
|
|
NEXT = 1
|
|
CALL GETINT(MINSTP,MAXSTP,NEXT,'Step',
|
|
+ IVAL,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) GO TO 40
|
|
NEXT = IVAL
|
|
I1 = I1 + NEXT
|
|
IF(I1.LT.0)GO TO 40
|
|
IF(I1.GT.J2-KSTART+1)GO TO 40
|
|
IF(I1.LT.J1-KSTART+1)GO TO 40
|
|
GO TO 10
|
|
40 CONTINUE
|
|
CALL VT100M
|
|
END
|
|
SUBROUTINE HELIXD(MINANG,MAXANG,IANGLE,MINIW,MAXIW,WINDOW,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER HELPF*(*)
|
|
INTEGER WINDOW
|
|
IOK = 1
|
|
CALL GETINT(MINANG,MAXANG,IANGLE,'Angle',IVAL,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
IANGLE = IVAL
|
|
CALL GETINT(MINIW,MAXIW,WINDOW,'Window',IVAL,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
WINDOW = IVAL
|
|
END
|
|
C SUBROUTINE TO PLOT HYDROPHOBIC MOMENTS
|
|
SUBROUTINE HYDMOM(SEQ,IDSEQ,HYDRO,IDSCOR,
|
|
+IX0,IXLEN,IY0,IYLEN,
|
|
+ISXMAX,ISYMAX,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,DIALOG)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDSEQ),HELPF*(*)
|
|
INTEGER DIALOG
|
|
INTEGER WINDOW
|
|
REAL HYDRO(IDSCOR)
|
|
PARAMETER (DEGTOR = 0.017453)
|
|
EXTERNAL CTONUM
|
|
CALL SHOWFU(KBOUT,'Plot hydrophobic moment')
|
|
CALL GETPAR(25,9,IOK,MINANG,MAXANG,IANGLE,MINWIN,MAXWIN,WINDOW,
|
|
+MINIW,MAXIW,IWRIT)
|
|
IF(IOK.NE.0) RETURN
|
|
IF(DIALOG.EQ.1) THEN
|
|
CALL HYDMD(MINANG,MAXANG,IANGLE,MINWIN,MAXWIN,WINDOW,
|
|
+ MINIW,MAXIW,IWRIT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
END IF
|
|
ANGLE = REAL(IANGLE)*DEGTOR
|
|
CALL HYDMP(SEQ,IDSEQ,HYDRO,IDSCOR,
|
|
+IX0,IXLEN,IY0,IYLEN,
|
|
+ISXMAX,ISYMAX,WINDOW,ANGLE,IWRIT)
|
|
END
|
|
SUBROUTINE HYDMP(SEQ,IDSEQ,HYDRO,IDSCOR,
|
|
+IX0,IXLEN,IY0,IYLEN,
|
|
+ISXMAX,ISYMAX,WINDOW,ANGLE,IWRIT)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDSEQ)
|
|
INTEGER CTONUM,WINDOW
|
|
REAL HYDRO(IDSCOR)
|
|
EXTERNAL CTONUM
|
|
XMIN = 1
|
|
XMAX = IDSEQ
|
|
CALL CLEARV
|
|
CALL VECTOM
|
|
Y = REAL(IYLEN)/2.
|
|
IYLEN1 = NINT(Y)
|
|
IY1 = IY0 + IYLEN1
|
|
CALL FRAME(IX0,IXLEN,IY0,IYLEN1,ISXMAX,ISYMAX)
|
|
CALL FRAME(IX0,IXLEN,IY1,IYLEN1,ISXMAX,ISYMAX)
|
|
IBH = 150
|
|
CALL SCALES(XMAX,XMIN,1.5,-1.0,
|
|
1 IX0,IXLEN,IY1,IYLEN1,ISXMAX,ISYMAX,
|
|
1 0.5,IBH,-1.0,2)
|
|
CALL SCALES(XMAX,XMIN,1.5,0.0,
|
|
1 IX0,IXLEN,IY0,IYLEN1,ISXMAX,ISYMAX,
|
|
1 0.5,IBH,0.0,2)
|
|
IBH = 50
|
|
CALL SCALES(XMAX,XMIN,1.5,-1.0,
|
|
1 IX0,IXLEN,IY1,IYLEN1,ISXMAX,ISYMAX,
|
|
1 0.1,IBH,-1.0,2)
|
|
CALL SCALES(XMAX,XMIN,1.5,0.0,
|
|
1 IX0,IXLEN,IY0,IYLEN1,ISXMAX,ISYMAX,
|
|
1 0.1,IBH,0.0,2)
|
|
C CALL TEXT(2.,1.4,'HYDROPHOBIC MOMENT',18,ISIZE,
|
|
C + 100.0,1.0,1.5,0.0,
|
|
C + IX0,IXLEN,IY0,IYLEN1,ISXMAX,ISYMAX)
|
|
C CALL TEXT(2.0,1.3,'HYDROPHOBICITY',14,ISIZE,
|
|
C + 100.,1.0,1.5,-1.0,
|
|
C + IX0,IXLEN,IY1,IYLEN1,ISXMAX,ISYMAX)
|
|
C CALL LINE(1.,XMAX,0.55,0.55,XMAX,XMIN,1.5,-1.0,
|
|
C + IX0,IXLEN,IY1,IYLEN1,ISXMAX,ISYMAX)
|
|
C CALL LINE(1.,XMAX,0.68,0.68,XMAX,XMIN,1.5,-1.0,
|
|
C + IX0,IXLEN,IY1,IYLEN1,ISXMAX,ISYMAX)
|
|
C CALL LINE(1.,XMAX,0.42,0.42,XMAX,XMIN,1.5,-1.0,
|
|
C + IX0,IXLEN,IY1,IYLEN1,ISXMAX,ISYMAX)
|
|
IDONE = 0
|
|
XF = 0.
|
|
HMF = 0.
|
|
HF = 0.
|
|
DO 40 J = 1,IDSEQ-WINDOW+1
|
|
I1 = J
|
|
CALL EISEN(SEQ(I1),WINDOW,HYDRO,IDSCOR,ANGLE,HM,H)
|
|
IDONE = IDONE + 1
|
|
IF(MOD(IDONE,IWRIT).EQ.0)THEN
|
|
X = I1
|
|
CALL LINE(XF,X,HMF,HM,XMAX,XMIN,1.5,0.0,
|
|
+ IX0,IXLEN,IY0,IYLEN1,ISXMAX,ISYMAX)
|
|
CALL LINE(XF,X,HF,H,XMAX,XMIN,1.5,-1.0,
|
|
+ IX0,IXLEN,IY1,IYLEN1,ISXMAX,ISYMAX)
|
|
XF = X
|
|
HMF = HM
|
|
HF = H
|
|
END IF
|
|
C
|
|
40 CONTINUE
|
|
CALL VT100M
|
|
END
|
|
SUBROUTINE HYDMD(MINANG,MAXANG,IANGLE,MINWIN,MAXWIN,WINDOW,
|
|
+MINIW,MAXIW,IWRIT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER HELPF*(*)
|
|
INTEGER WINDOW
|
|
IOK = 1
|
|
CALL GETINT(MINANG,MAXANG,IANGLE,'Angle',IVAL,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
IANGLE = IVAL
|
|
CALL GETINT(MINWIN,MAXWIN,WINDOW,'Window',IVAL,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
WINDOW = IVAL
|
|
CALL GETINT(MINIW,MAXIW,IWRIT,'Plot interval',IVAL,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
IWRIT = IVAL
|
|
IOK = 0
|
|
END
|
|
SUBROUTINE EISEN(SEQ,WINDOW,HYDRO,IDHYD,DELTA,HM,H)
|
|
INTEGER WINDOW
|
|
CHARACTER SEQ(WINDOW)
|
|
REAL HYDRO(IDHYD)
|
|
INTEGER CTONUM
|
|
EXTERNAL CTONUM
|
|
C AUTHOR RODGER STADEN
|
|
C CALCULATES THE MEAN HYDROPHOBICITY AND MEAN HYDROPHOBIC MOMENT
|
|
C AFTER EISENBERG, FOR A WINDOW OF SIZE WINDOW, AND ANGLE DELTA
|
|
T1 = 0.
|
|
T2 = 0.
|
|
H = 0.
|
|
DO 20 I = 1, WINDOW
|
|
C
|
|
IT =CTONUM(SEQ(I))
|
|
T = HYDRO(IT)
|
|
T3 = DELTA * I - 1
|
|
T1 = T1 + T * SIN(T3)
|
|
T2 = T2 + T * COS(T3)
|
|
H = H + T
|
|
C
|
|
20 CONTINUE
|
|
T1 = T1 * T1
|
|
T2 = T2 * T2
|
|
HM = T1 + T2
|
|
IF(HM.GT.0.0)HM = SQRT(HM)
|
|
H = H / WINDOW
|
|
HM = HM / WINDOW
|
|
END
|
|
C BACK
|
|
SUBROUTINE BACK(SEQ,IDSEQ,CODIN,KBIN,KBOUT,FILNAM,IDEV,
|
|
+DNA,MAXSEQ,PCOD,IDIM1P,MXSPAN,
|
|
+MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,DIALOG)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDSEQ),DNA(MAXSEQ),FILNAM*(*),PAA(5,5,5)
|
|
CHARACTER*3 CODON(26),CODIN(26)
|
|
REAL CODS(4,4,4),PROB(26),PCOD(IDIM1P)
|
|
CHARACTER HELPF*(*)
|
|
INTEGER DIALOG
|
|
INTEGER SPAN
|
|
SAVE PAA
|
|
DATA PAA/'F','F','L','L','-','S','S','S','S','S',
|
|
1'Y','Y','*','*','-','C','C','*','W','-',
|
|
1'-','-','-','-','-','L','L','L','L','L',
|
|
1'P','P','P','P','P','H','H','Q','Q','-',
|
|
1'R','R','R','R','R','-','-','-','-','-','I','I','I','M','-',
|
|
1'T','T','T','T','T',
|
|
1'N','N','K','K','-','S','S','R','R','-','-','-','-','-','-',
|
|
1'V','V','V','V','V','A','A','A','A','A','D','D','E','E','-',
|
|
1'G','G','G','G','G',
|
|
1'-','-','-','-','-','-','-','-','-','-',
|
|
1'-','-','-','-','-','-','-','-','-','-',
|
|
1'-','-','-','-','-','-','-','-','-','-'/
|
|
CALL GETPAR(27,8,IOK,IOP,IPLOT,MINWIN,MAXWIN,SPAN,
|
|
+MINIW,MAXIW,IWRIT,IPAR9)
|
|
IF(IOK.NE.0) RETURN
|
|
CALL SHOWFU(KBOUT,'Back translate')
|
|
DO 10 I = 1,26
|
|
CODON(I) = CODIN(I)
|
|
10 CONTINUE
|
|
CALL FILLR(PROB,26,0.)
|
|
CALL FILLR(CODS,64,0.)
|
|
C GET CODON TABLE FROM FILE IF REQUIRED
|
|
IF(DIALOG.EQ.1) THEN
|
|
CALL BACKD1(IOP,IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,
|
|
+ FILNAM,IDEV,CODS,PAA,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
END IF
|
|
C BACK TRANSLATE
|
|
CALL BACKA(CODS,PAA,CODON,PROB,PCOD,IDIM1P,MXSPAN,
|
|
+SEQ,IDSEQ,DNA,MAXSEQ)
|
|
C SET UP PLOTTING
|
|
IF(DIALOG.EQ.1) THEN
|
|
CALL BACKD2(IPLOT,MINWIN,MAXWIN,SPAN,MINIW,MAXIW,IWRIT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
IF(IPLOT.LT.0) RETURN
|
|
END IF
|
|
IF(IPLOT.EQ.0)THEN
|
|
C PLOT REDUNDANCY
|
|
CALL PLOTRD(PCOD,IDIM1P,MXSPAN,1,IDSEQ,
|
|
+ MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,SPAN,IWRIT)
|
|
CALL BPAUSE(KBIN,KBOUT,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
END IF
|
|
IDIM = 3*IDSEQ
|
|
C SAVE TO DISK
|
|
CALL BACKO(DNA,IDIM,FILNAM,IDEV,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH)
|
|
END
|
|
SUBROUTINE BACKD2(IPLOT,MINWIN,MAXWIN,SPAN,MINIW,MAXIW,IWRIT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER HELPF*(*)
|
|
INTEGER SPAN
|
|
CALL YESNO(IPLOT,'Plot redundancy',
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(IPLOT.LT.0)RETURN
|
|
IF(IPLOT.EQ.0) THEN
|
|
CALL GSPIN(MINWIN,MAXWIN,SPAN,MINIW,MAXIW,IWRIT,KBIN,KBOUT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
END IF
|
|
END
|
|
SUBROUTINE BACKO(DNA,IDIM,FILNAM,IDEV,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER DNA(IDIM)
|
|
CHARACTER FILNAM*(*),HELPF*(*)
|
|
CALL YESNO(IN,'Save DNA to disk',
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(IN.LT.0)RETURN
|
|
IF(IN.EQ.0)THEN
|
|
FILNAM = ' '
|
|
CALL OPENF1(IDEV,FILNAM,1,IOK,KBIN,KBOUT,
|
|
+ 'File name for DNA sequence',
|
|
+ IHELPS,IHELPE,HELPF,IDEVH)
|
|
IF(IOK.EQ.0)THEN
|
|
CALL FMTDK(IDEV,DNA,IDIM)
|
|
CLOSE(UNIT=IDEV)
|
|
END IF
|
|
END IF
|
|
END
|
|
SUBROUTINE BACKD1(IOP,IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,
|
|
+FILNAM,IDEV,CODS,PAA,IOK)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER FILNAM*(*),HELPF*(*),PAA(5,5,5)
|
|
REAL CODS(4,4,4)
|
|
IOK = 1
|
|
CALL YESONO(IOP,'No codon preference',
|
|
+'Use file of codon preferences',
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(IOP.LT.0) RETURN
|
|
IF(IOP.EQ.0) THEN
|
|
IOK = 0
|
|
RETURN
|
|
END IF
|
|
IF(IOP.EQ.1)THEN
|
|
FILNAM = ' '
|
|
CALL OPENF1(IDEV,FILNAM,0,IOK,KBIN,KBOUT,
|
|
+ 'Codon table file name',
|
|
+ IHELPS,IHELPE,HELPF,IDEVH)
|
|
IF(IOK.EQ.0)THEN
|
|
CALL REDCOD(CODS,IDEV)
|
|
CLOSE(UNIT=IDEV)
|
|
CALL WRTCOD(CODS,KBOUT,PAA)
|
|
END IF
|
|
END IF
|
|
END
|
|
SUBROUTINE BACKA(CODS,PAA,CODON,PROB,PCOD,IDIM1P,MXSPAN,
|
|
+SEQ,IDSEQ,DNA,MAXSEQ)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDSEQ),DNA(MAXSEQ),PAA(5,5,5)
|
|
CHARACTER*3 CODON(26)
|
|
REAL CODS(4,4,4),PROB(26),PCOD(IDIM1P)
|
|
INTEGER CTONUM
|
|
EXTERNAL CTONUM
|
|
C USE TOP CODONS
|
|
CALL TOPCOD(CODS,PAA,CODON,PROB)
|
|
C BACK TRANSLATE
|
|
I1 = 1+MXSPAN/2
|
|
CALL FILLR(PCOD,I1,0.)
|
|
DO 100 I = 1,IDSEQ
|
|
K = CTONUM(SEQ(I))
|
|
DNA(1+3*(I-1)) = CODON(K)(1:1)
|
|
DNA(2+3*(I-1)) = CODON(K)(2:2)
|
|
DNA(3+3*(I-1)) = CODON(K)(3:3)
|
|
PCOD(I+I1) = PROB(K)
|
|
100 CONTINUE
|
|
CALL FILLR(PCOD(IDSEQ+I1+1),I1,0.)
|
|
END
|
|
C CHECK EACH AMINO ACID IN TURN FOR EVEN CODON USE
|
|
SUBROUTINE TOPCOD(CODUSE,PAA,CODON,PROB)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER PAA(5,5,5),AA(22),BASE(4)
|
|
CHARACTER*3 CODON(26)
|
|
REAL CODUSE(4,4,4),PROB(26)
|
|
SAVE AA,BASE
|
|
DATA AA/'C','S','T','P','A','G','N','D','E','Q','B',
|
|
+'Z','H','R','K','M','I','L','V','F','Y','W'/
|
|
DATA BASE/'T','C','A','G'/
|
|
C IF CODONS FOR AN ACID ARE EVENLY USED EMPLOY ALL CODONS
|
|
C OTHERWISE EMPLOY THE TOP SCORER. CHECK THE USAGE
|
|
C LOOP FOR EACH ACID
|
|
DO 300 L=1,22
|
|
IMAX = 0
|
|
JMAX = 0
|
|
KMAX = 0
|
|
AMAX=0.0
|
|
NCOD = 0
|
|
TCOD = 0.0
|
|
IEVEN = 1
|
|
C LOOP FOR EACH CODON
|
|
DO 200 I=1,4
|
|
DO 200 J=1,4
|
|
DO 200 K=1,4
|
|
C EXAMINE CODONS FOR ACID L
|
|
IF(PAA(K,J,I).EQ.AA(L))THEN
|
|
NCOD = NCOD + 1
|
|
TCOD = TCOD + CODUSE(I,J,K)
|
|
IF(CODUSE(I,J,K).GT.AMAX)THEN
|
|
AMAX = CODUSE(I,J,K)
|
|
IMAX = I
|
|
JMAX = J
|
|
KMAX = K
|
|
IEVEN = 0
|
|
ELSE IF(CODUSE(I,J,K).EQ.AMAX)THEN
|
|
IEVEN = 1
|
|
END IF
|
|
END IF
|
|
200 CONTINUE
|
|
C IF THERE IS A PREFERENCE, USE IT
|
|
IF((AMAX.GT.0.0).AND.(IEVEN.EQ.0))THEN
|
|
CODON(L) = BASE(IMAX)//BASE(JMAX)//BASE(KMAX)
|
|
PROB(L) = AMAX/TCOD
|
|
ELSE
|
|
PROB(L) = 1.0/(MAX(1,NCOD))
|
|
END IF
|
|
300 CONTINUE
|
|
END
|
|
SUBROUTINE PLOTRD(SEQ,IDIM1P,MXSPAN,J1,J2,
|
|
+MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,SPAN,IWRIT)
|
|
C AUTHOR: RODGER STADEN
|
|
REAL SEQ(IDIM1P)
|
|
INTEGER SPAN
|
|
C length forward and back
|
|
LF=SPAN/2
|
|
LB=1+SPAN/2
|
|
C max score
|
|
SCRMAX=1.
|
|
SCRMIN=0.16
|
|
I1INM1=1+MXSPAN/2
|
|
J1P=J1+I1INM1
|
|
J2P=J2+I1INM1
|
|
XMIN=J1
|
|
XMAX=J2
|
|
C set ymax
|
|
YMIN=SPAN*SCRMIN
|
|
YMAX=SPAN*SCRMAX
|
|
C do edge
|
|
SUM=0.
|
|
DO 90 I=J1P-LB,J1P-LB+SPAN
|
|
SUM=SUM+SEQ(I)
|
|
90 CONTINUE
|
|
CALL CLEARV
|
|
CALL VECTOM
|
|
CALL FRAME(MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
|
|
C do rest
|
|
IDONE=0
|
|
XF=J1
|
|
YF=SUM
|
|
DO 100 I=J1P,J2P
|
|
IDONE=IDONE+1
|
|
SUM=SUM+SEQ(I+LF)-SEQ(I-LB)
|
|
IF(MOD(I,IWRIT).EQ.0)THEN
|
|
XT=I-I1INM1
|
|
CALL LINE(XF,XT,YF,SUM,XMAX,XMIN,YMAX,YMIN,
|
|
+ MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
|
|
XF=XT
|
|
YF=SUM
|
|
END IF
|
|
100 CONTINUE
|
|
CALL VT100M
|
|
END
|
|
SUBROUTINE FIND8(SEQ,IDIM1,STRING,IDIM2,INC,IMATCH)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDIM1),STRING(IDIM2)
|
|
INTEGER PSEQ,PSTR
|
|
INTEGER CTONUM
|
|
EXTERNAL CTONUM
|
|
PSEQ=1-1*INC
|
|
PSTR=1
|
|
IMATCH=0
|
|
100 CONTINUE
|
|
PSEQ=PSEQ+1-PSTR
|
|
PSEQ=PSEQ+INC-1
|
|
PSTR=0
|
|
500 CONTINUE
|
|
PSEQ=PSEQ+1
|
|
IF(PSEQ.GT.IDIM1)RETURN
|
|
PSTR=PSTR+1
|
|
KSTRNG = CTONUM(STRING(PSTR))
|
|
KSEQ = CTONUM(SEQ(PSEQ))
|
|
IF((KSTRNG.NE.KSEQ).AND.(KSTRNG.NE.23)) GO TO 100
|
|
IF(PSTR.LT.IDIM2)GO TO 500
|
|
IMATCH=PSEQ-IDIM2+1
|
|
END
|
|
SUBROUTINE SQPFIT(SEQNCE,IDIM1,SEQ2,IDIM3I,ITOT,ITOTEL,ITOTID,
|
|
+MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,KSTART,
|
|
+IDEV,IDEVIN,FILE2,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,DIALOG)
|
|
C AUTHOR: RODGER STADEN
|
|
INTEGER DIALOG
|
|
PARAMETER (MAXSTR = 50)
|
|
CHARACTER HELPF*(*)
|
|
CHARACTER SEQNCE(IDIM1),STRING(MAXSTR)
|
|
CHARACTER SEQ2(IDIM3I),FILE2*(*)
|
|
CHARACTER MATCH(MAXSTR)
|
|
INTEGER ITOT(ITOTID),ITOTEL(ITOTID)
|
|
INTEGER ANSTY
|
|
CALL SHOWFU(KBOUT,'Find percentage matches')
|
|
IDIM2 = 0
|
|
IDIM2I = MAXSTR
|
|
IDIM3 = IDIM3I
|
|
IS = J1
|
|
IE = J2
|
|
ISS = 1
|
|
ISE = 10
|
|
CALL GETPAR(18,2,IOK,ANSTY,IPR,
|
|
+IPAR3,IPAR4,
|
|
+IPAR5,IPAR6,IPAR7,IPAR8,IPAR9)
|
|
IF(IOK.NE.0) RETURN
|
|
PR = REAL(IPR)
|
|
5 CONTINUE
|
|
IF(DIALOG.EQ.1) THEN
|
|
CALL SQPFD1(SEQ2,IDIM3I,IDIM3,ANSTY,IDEVIN,FILE2,
|
|
+ KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
END IF
|
|
10 CONTINUE
|
|
CALL SQPFD2(SEQ2,IDIM3,MATCH,STRING,
|
|
+J1,J2,KSTART,ISS,ISE,IS,IE,IDIM2I,IDIM2,MAXSTR,PR,ANSTY,MINP,
|
|
+KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
CALL SQPF6(SEQNCE,IDIM1,STRING,IDIM2,ITOT,ITOTEL,ITOTID,
|
|
+IS,IE,MINP,ITOTP,KSTART,J1,J2,
|
|
+MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,IOK)
|
|
IF(IOK.EQ.2)THEN
|
|
WRITE(KBOUT,1017)ITOTID
|
|
1017 FORMAT(/,' more than',I6,' matches.',
|
|
+ ' try changing percentage or region'/)
|
|
GO TO 10
|
|
END IF
|
|
IF(IOK.NE.0) RETURN
|
|
CALL SQPF7(SEQNCE,IDIM1,STRING,IDIM2,MATCH,ITOT,ITOTEL,ITOTID,
|
|
+ITOTP,KSTART,J1,J2,ISS,PR,IDEV,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
GO TO 10
|
|
END
|
|
SUBROUTINE SQPFD2(SEQ2,IDIM3,MATCH,STRING,
|
|
+J1,J2,KSTART,ISS,ISE,IS,IE,IDIM2I,IDIM2,MAXSTR,PR,ANSTY,MINP,
|
|
+KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER HELPF*(*)
|
|
CHARACTER STRING(MAXSTR)
|
|
CHARACTER SEQ2(IDIM3)
|
|
CHARACTER MATCH(MAXSTR)
|
|
INTEGER ANSC,ANSTY
|
|
IOK = 1
|
|
CALL YESNO(ANSC,'Keep picture',
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(ANSC.LT.0)RETURN
|
|
IF(ANSC.EQ.1)CALL CLEARG
|
|
IF(ANSTY.EQ.1) THEN
|
|
CALL SQPF2(SEQ2,IDIM3,STRING,IDIM2I,IDIM2,ISS,ISE,
|
|
+ KBIN,KBOUT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
END IF
|
|
IF(ANSTY.EQ.0) THEN
|
|
CALL SQPF3(STRING,MATCH,IDIM2I,IDIM2,
|
|
+ KBIN,KBOUT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
END IF
|
|
C CALL SQPF4(KBIN,KBOUT,J1,J2,IS,IE,
|
|
C +IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
C IF(IOK.NE.0) RETURN
|
|
CALL SQPF5(IDIM2,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,PR,MINP,IOK)
|
|
C IF(IOK.NE.0) RETURN
|
|
RETURN
|
|
END
|
|
SUBROUTINE SQPF6(SEQNCE,IDIM1,STRING,IDIM2,ITOT,ITOTEL,ITOTID,
|
|
+IS,IE,MINP,ITOTP,KSTART,J1,J2,
|
|
+MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,IOK)
|
|
CHARACTER SEQNCE(IDIM1),STRING(IDIM2)
|
|
INTEGER ITOT(ITOTID),ITOTEL(ITOTID)
|
|
IOK = 1
|
|
CALL FILLI(ITOT,ITOTID,0)
|
|
CALL FILLI(ITOTEL,ITOTID,0)
|
|
CALL SQFIT7(SEQNCE,IDIM1,STRING,IDIM2,ITOT,ITOTEL,ITOTID,
|
|
+IS,IE,MINP,ITOTP,KSTART)
|
|
IF(ITOTP.GT.ITOTID)THEN
|
|
IOK = 2
|
|
RETURN
|
|
END IF
|
|
IF(ITOTP.GT.0)THEN
|
|
XMIN=J1
|
|
XMAX=J2
|
|
YMIN=0.
|
|
YMAX=IDIM2
|
|
CALL CLEARV
|
|
CALL VECTOM
|
|
CALL FRAME(MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
|
|
DO 203 I=1,ITOTP
|
|
X=ITOTEL(I)
|
|
Y=ITOT(I)
|
|
CALL LINE(X,X,YMIN,Y,XMAX,XMIN,YMAX,YMIN,
|
|
+ MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
|
|
203 CONTINUE
|
|
END IF
|
|
CALL VT100M
|
|
IOK = 0
|
|
END
|
|
SUBROUTINE SEPFIT(SEQNCE,IDIM1,SEQ2,IDIM3I,ITOT,ITOTEL,ITOTID,
|
|
+MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,J1,J2,KSTART,
|
|
+IDEV,IDEVIN,FILE2,KBIN,KBOUT,MATRIX,IDM,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,DIALOG)
|
|
C AUTHOR: RODGER STADEN
|
|
INTEGER DIALOG
|
|
PARAMETER (MAXSTR = 50)
|
|
CHARACTER HELPF*(*)
|
|
CHARACTER SEQNCE(IDIM1),STRING(MAXSTR)
|
|
CHARACTER SEQ2(IDIM3I),FILE2*(*)
|
|
CHARACTER MATCH(MAXSTR)
|
|
INTEGER ITOT(ITOTID),ITOTEL(ITOTID),MATRIX(IDM,IDM)
|
|
INTEGER ANSTY,SMIN,SMAX
|
|
CALL SHOWFU(KBOUT,'Find matches using a score matrix')
|
|
MINP = 0
|
|
IDIM2 = 0
|
|
IDIM2I = MAXSTR
|
|
IDIM3 = IDIM3I
|
|
IS = J1
|
|
IE = J2
|
|
ISS = 1
|
|
ISE = 10
|
|
CALL GETPAR(19,1,IOK,ANSTY,
|
|
+IPAR2,IPAR3,IPAR4,
|
|
+IPAR5,IPAR6,IPAR7,IPAR8,IPAR9)
|
|
IF(IOK.NE.0) RETURN
|
|
5 CONTINUE
|
|
IF(DIALOG.EQ.1) THEN
|
|
CALL SQPFD1(SEQ2,IDIM3I,IDIM3,ANSTY,IDEVIN,FILE2,
|
|
+ KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
END IF
|
|
10 CONTINUE
|
|
CALL SEPFD2(SEQ2,IDIM3,MATCH,STRING,
|
|
+J1,J2,KSTART,ISS,ISE,IS,IE,IDIM2I,IDIM2,MAXSTR,ANSTY,MINP,
|
|
+KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,MATRIX,IDM,
|
|
+SMIN,SMAX,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
CALL SEPF6(SEQNCE,IDIM1,STRING,IDIM2,ITOT,ITOTEL,ITOTID,
|
|
+IS,IE,MINP,ITOTP,KSTART,J1,J2,
|
|
+MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,MATRIX,IDM,
|
|
+SMIN,SMAX,IOK)
|
|
IF(IOK.EQ.2)THEN
|
|
WRITE(KBOUT,1017)ITOTID
|
|
1017 FORMAT(/,' more than',I6,' matches.',
|
|
+ ' try changing score or region'/)
|
|
GO TO 10
|
|
END IF
|
|
IF(IOK.NE.0) RETURN
|
|
CALL SEPF7(SEQNCE,IDIM1,STRING,IDIM2,MATCH,ITOT,ITOTEL,ITOTID,
|
|
+ITOTP,MINP,KSTART,J1,J2,ISS,IDEV,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
GO TO 10
|
|
END
|
|
SUBROUTINE SEPFD2(SEQ2,IDIM3,MATCH,STRING,
|
|
+J1,J2,KSTART,ISS,ISE,IS,IE,IDIM2I,IDIM2,MAXSTR,ANSTY,MINP,
|
|
+KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,MATRIX,IDM,
|
|
+SMIN,SMAX,IOK)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER HELPF*(*)
|
|
CHARACTER STRING(MAXSTR)
|
|
CHARACTER SEQ2(IDIM3)
|
|
CHARACTER MATCH(MAXSTR)
|
|
INTEGER ANSC,ANSTY,MATRIX(IDM,IDM),SMIN,SMAX
|
|
IOK = 1
|
|
CALL YESNO(ANSC,'Keep picture',
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IF(ANSC.LT.0)RETURN
|
|
IF(ANSC.EQ.1)CALL CLEARG
|
|
IF(ANSTY.EQ.1) THEN
|
|
CALL SEPF2(SEQ2,IDIM3,STRING,IDIM2I,IDIM2,ISS,ISE,
|
|
+ KBIN,KBOUT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
END IF
|
|
IF(ANSTY.EQ.0) THEN
|
|
CALL SQPF3(STRING,MATCH,IDIM2I,IDIM2,
|
|
+ KBIN,KBOUT,
|
|
+ IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
END IF
|
|
C CALL SEPF4(KBIN,KBOUT,J1,J2,IS,IE,
|
|
C +IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
C IF(IOK.NE.0) RETURN
|
|
CALL SEPF5(IDIM2,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,MINP,MATRIX,IDM,
|
|
+SMIN,SMAX,STRING,IOK)
|
|
C IF(IOK.NE.0) RETURN
|
|
RETURN
|
|
END
|
|
SUBROUTINE SEPF2(SEQ2,IDIM3,STRING,IDIM2I,IDIM2,I1,I2,
|
|
+KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
CHARACTER HELPF*(*)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ2(IDIM3),STRING(IDIM2I)
|
|
IOK = 1
|
|
MININ = 1
|
|
MAXIN = IDIM3
|
|
WRITE(KBOUT,1000)
|
|
1000 FORMAT(' Define string ends')
|
|
CALL GETINT(MININ,MAXIN,I1,'Start',IVAL,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
IF(IVAL.NE.I1) THEN
|
|
I2 = IVAL + 10
|
|
END IF
|
|
I1 = IVAL
|
|
MININ = I1 + 1
|
|
MAXIN = I1 + IDIM2I - 1
|
|
CALL GETINT(MININ,MAXIN,I2,'End',IVAL,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
I2 = IVAL
|
|
IDIM2 =I2 - I1 + 1
|
|
CALL SQCOPY(SEQ2(I1),STRING,IDIM2)
|
|
WRITE(KBOUT,1001)(STRING(K),K=1,IDIM2)
|
|
1001 FORMAT(' string=',50A1)
|
|
IOK = 0
|
|
END
|
|
SUBROUTINE SEPF5(IDIM2,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,MINP,MATRIX,IDM,
|
|
+SMIN,SMAX,STRING,IOK)
|
|
CHARACTER HELPF*(*)
|
|
CHARACTER STRING(IDIM2)
|
|
INTEGER MATRIX(IDM,IDM),SMIN,SMAX,VALUE
|
|
IOK = 1
|
|
CALL GTSCR(STRING,IDIM2,MATRIX,IDM,SMIN,SMAX)
|
|
WRITE(KBOUT,1000)SMIN,SMAX
|
|
1000 FORMAT(' Minimum score=',I6,' Maximum score=',I6)
|
|
MININ = SMIN
|
|
MAXIN = SMAX
|
|
IF(MINP.EQ.0) MINP = SMAX
|
|
CALL GETINT(MININ,MAXIN,MINP,'Score',VALUE,KBIN,KBOUT,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
|
IF(IOK.NE.0) RETURN
|
|
MINP = VALUE
|
|
IOK = 0
|
|
END
|
|
SUBROUTINE SEPF6(SEQNCE,IDIM1,STRING,IDIM2,ITOT,ITOTEL,ITOTID,
|
|
+IS,IE,MINP,ITOTP,KSTART,J1,J2,
|
|
+MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,MATRIX,IDM,
|
|
+SMIN,SMAX,IOK)
|
|
CHARACTER SEQNCE(IDIM1),STRING(IDIM2)
|
|
INTEGER ITOT(ITOTID),ITOTEL(ITOTID),MATRIX(IDM,IDM)
|
|
INTEGER SMIN,SMAX
|
|
IOK = 1
|
|
CALL FILLI(ITOT,ITOTID,0)
|
|
CALL FILLI(ITOTEL,ITOTID,0)
|
|
CALL SPFIT(SEQNCE,IDIM1,STRING,IDIM2,ITOT,ITOTEL,ITOTID,
|
|
+IS,IE,MINP,ITOTP,MATRIX,IDM,KSTART)
|
|
IF(ITOTP.GT.ITOTID)THEN
|
|
IOK = 2
|
|
RETURN
|
|
END IF
|
|
IF(ITOTP.GT.0)THEN
|
|
XMIN = J1
|
|
XMAX = J2
|
|
YMIN = SMIN
|
|
YMAX = SMAX
|
|
CALL CLEARV
|
|
CALL VECTOM
|
|
CALL FRAME(MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
|
|
DO 203 I=1,ITOTP
|
|
X=ITOTEL(I)
|
|
Y=ITOT(I)
|
|
CALL LINE(X,X,YMIN,Y,XMAX,XMIN,YMAX,YMIN,
|
|
+ MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
|
|
203 CONTINUE
|
|
END IF
|
|
CALL VT100M
|
|
IOK = 0
|
|
END
|
|
C SQFITP
|
|
SUBROUTINE SQFITP(SEQ,IDIM1,STRING,IDIM2,ITOT,ITOTEL,ITOTID,
|
|
+IS,IE,MINP,ITOTP,KSTART)
|
|
C AUTHOR: RODGER STADEN
|
|
CHARACTER SEQ(IDIM1),STRING(IDIM2)
|
|
INTEGER ITOT(ITOTID),ITOTEL(ITOTID)
|
|
IDIF=(IE-IS+2)-IDIM2
|
|
IPSEQ=IS-KSTART+1
|
|
ITOTP=0
|
|
DO 200 I=1,IDIF
|
|
NTOT=0
|
|
IP=IPSEQ
|
|
DO 100 J=1,IDIM2
|
|
IF(SEQ(IP).EQ.STRING(J))THEN
|
|
NTOT=NTOT+1
|
|
ELSE IF (STRING(J).EQ.'-')THEN
|
|
NTOT=NTOT+1
|
|
END IF
|
|
IP=IP+1
|
|
100 CONTINUE
|
|
IF(NTOT.GE.MINP)THEN
|
|
ITOTP=ITOTP+1
|
|
IF(ITOTP.GT.ITOTID)RETURN
|
|
ITOT(ITOTP)=NTOT
|
|
ITOTEL(ITOTP)=IP-IDIM2+KSTART-1
|
|
END IF
|
|
IPSEQ=IPSEQ+1
|
|
200 CONTINUE
|
|
END
|
|
C SQFIT7
|
|
SUBROUTINE SQFIT7(SEQ,IDIM1,STRING,IDIM2,ITOT,ITOTEL,ITOTID
|
|
1,IS,IE,MINS,ITOTP,KSTART)
|
|
C AUTHOR: RODGER STADEN
|
|
C COMPARE POINTERS, NOT ACTUAL CHARACTERS
|
|
CHARACTER SEQ(IDIM1),STRING(IDIM2)
|
|
INTEGER ITOT(ITOTID),ITOTEL(ITOTID)
|
|
INTEGER CTONUM
|
|
EXTERNAL CTONUM
|
|
IDIF=(IE-IS+2)-IDIM2
|
|
IPSEQ=IS-KSTART+1
|
|
ITOTP=0
|
|
DO 200 I=1,IDIF
|
|
NTOT = 0
|
|
IP=IPSEQ
|
|
DO 100 J=1,IDIM2
|
|
IF(STRING(J).EQ.'-')THEN
|
|
NTOT = NTOT + 1
|
|
ELSE
|
|
K = CTONUM(STRING(J))
|
|
IF(K.EQ.CTONUM(SEQ(IP)))NTOT = NTOT + 1
|
|
END IF
|
|
IP=IP+1
|
|
100 CONTINUE
|
|
IF(NTOT.GE.MINS)THEN
|
|
ITOTP=ITOTP+1
|
|
IF(ITOTP.GT.ITOTID)RETURN
|
|
ITOT(ITOTP)=NTOT
|
|
ITOTEL(ITOTP)=IP-IDIM2+KSTART-1
|
|
END IF
|
|
IPSEQ=IPSEQ+1
|
|
200 CONTINUE
|
|
END
|