2510 lines
80 KiB
FortranFixed
2510 lines
80 KiB
FortranFixed
|
C dbsys routines that were changed when starting to use .rd files
|
||
|
C these versions are the pre .rd ones and afre used by sap and xsap
|
||
|
C post .rd equivalents are in dbsysnew.f
|
||
|
C 8-4-92 removed prompt for minsli in dbauto
|
||
|
C 22-5-91 added new remove gel reading function. Changed movgel, breakc
|
||
|
C 21-8-91 Added routines to find internal overlaps
|
||
|
C 8-11-91 Fixed bugs in routines to find internal joins
|
||
|
C 2-3-92 Set filnam = ' ' for some call to openf1
|
||
|
C
|
||
|
C SUBROUTINE TO ENTER NEW GEL SEQUENCES INTO DATA BASE.
|
||
|
C IT READS IN AN ARCHIVE VERSION AND WRITES OUT A WORKING VERSION.
|
||
|
C IT ALSO SETS UP ANY RELATIONSHIPS WITH OTHER DATA IN THE DATABASE
|
||
|
C BOTH BY POSITION IN A CONTIG AND POINTERS TO LEFT AND RIGHT
|
||
|
C NEIGHBOURS.
|
||
|
SUBROUTINE AENTER(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+GEL,NAMARC,X,ITYPE,ISENSE,SEQC2,ITOTPC,
|
||
|
+IDIM,IDC,NCONTC,LINCON,IFAIL,IDBSIZ,KBOUT,IDEVR,IDEVW,IDEVN,
|
||
|
+MAXGEL)
|
||
|
C AUTHOR: RODGER STADEN
|
||
|
INTEGER RELPG(IDBSIZ),X,Y
|
||
|
INTEGER LNGTHG(IDBSIZ),LNBR(IDBSIZ),RNBR(IDBSIZ)
|
||
|
CHARACTER GEL(MAXGEL),NAMARC*(*)
|
||
|
CHARACTER SEQC2(IDC)
|
||
|
CHARACTER NAMARK*10
|
||
|
C WRITE(*,*)'X,ITYPE,ISENSE,IDIM,IDC'
|
||
|
C WRITE(*,*)X,ITYPE,ISENSE,IDIM,IDC
|
||
|
C SET FAIL FLAG
|
||
|
IFAIL=0
|
||
|
C WRITE(KBOUT,1000)
|
||
|
C1000 FORMAT(' TRYING TO ENTER NEW GEL READING INTO DATABASE')
|
||
|
C IS THERE SPACE?
|
||
|
IF((IDBSIZ-(NGELS+NCONTS)).GT.2)GO TO 5
|
||
|
C FULL
|
||
|
WRITE(KBOUT,1999)IDBSIZ
|
||
|
1999 FORMAT(' Database full, current size=',I6,' Extend with copy')
|
||
|
IFAIL=7
|
||
|
RETURN
|
||
|
5 CONTINUE
|
||
|
C NEED TO CHECK TO SEE IF GEL ALREADY IN DB
|
||
|
C LOOK THRU ARC FILE
|
||
|
DO 10 J=1,NGELS
|
||
|
C READ(IDEVN,REC=J)NAMARK
|
||
|
CALL READN(IDEVN,J,NAMARK)
|
||
|
IF(NAMARK.NE.NAMARC(1:10))GO TO 10
|
||
|
C FOUND
|
||
|
WRITE(KBOUT,1013)J
|
||
|
1013 FORMAT(' New gel already in database with number',I6,
|
||
|
+' Entry aborted')
|
||
|
IFAIL=6
|
||
|
RETURN
|
||
|
10 CONTINUE
|
||
|
C INCREMENT NUMBER OF GELS
|
||
|
NGELS=NGELS+1
|
||
|
C SET LENGTH THIS GEL
|
||
|
LNGTHG(NGELS)=IDIM*ISENSE
|
||
|
C WRITE NAME OF ARCHIVE TO LIST OF ARCHIVES
|
||
|
C NAMPRO,ARC
|
||
|
C WRITE(IDEVN,REC=NGELS)NAMARC(1:10)
|
||
|
NAMARK=NAMARC(1:10)
|
||
|
CALL WRITEN(IDEVN,NGELS,NAMARK)
|
||
|
WRITE(KBOUT,1003)NGELS
|
||
|
1003 FORMAT(' This gel reading has been given the number ',I6)
|
||
|
C WRITE GEL TO WORKING VERSION
|
||
|
CALL WRITEW(IDEVW,NGELS,GEL,MAXGEL)
|
||
|
C WRITE(IDEVW,REC=NGELS)GEL
|
||
|
C
|
||
|
C
|
||
|
C SET UP RELATIONSHIPS
|
||
|
C DOES THIS GEL OVERLAP?
|
||
|
IF(ITYPE.NE.0)GO TO 100
|
||
|
C
|
||
|
C DOES NOT OVERLAP SO IT STARTS A CONTIG OF ITS OWN
|
||
|
C SET LEFT AND RIGHT POINTERS TO ZERO,RELPG TO 1
|
||
|
LNBR(NGELS)=0
|
||
|
RNBR(NGELS)=0
|
||
|
RELPG(NGELS)=1
|
||
|
C WRITE NEW GEL LINE
|
||
|
CALL WRITER(IDEVR,NGELS,RELPG(NGELS),LNGTHG(NGELS),
|
||
|
+LNBR(NGELS),RNBR(NGELS))
|
||
|
C WRITE(IDEVR,REC=NGELS)RELPG(NGELS),LNGTHG(NGELS),LNBR(NGELS),
|
||
|
C 1RNBR(NGELS)
|
||
|
C
|
||
|
C SET CONTIG POINTERS AND GENERAL VALUES
|
||
|
C INCREMENT NUMBER OF CONTIGS
|
||
|
NCONTS=NCONTS+1
|
||
|
C POINTER TO THIS CONTIG
|
||
|
N=IDBSIZ-NCONTS
|
||
|
C POINTER TO LEFT GEL THIS CONTIG
|
||
|
LNBR(N)=NGELS
|
||
|
C POINTER TO RIGHT GEL THIS CONTIG
|
||
|
RNBR(N)=NGELS
|
||
|
C LENGTH OF CONTIG
|
||
|
RELPG(N)=IDIM
|
||
|
C WRITE CONTIG DESCRIPTOR
|
||
|
CALL WRITER(IDEVR,N,RELPG(N),LNGTHG(N),
|
||
|
+LNBR(N),RNBR(N))
|
||
|
C WRITE(IDEVR,REC=N)RELPG(N),LNGTHG(N),LNBR(N),RNBR(N)
|
||
|
C WRITE DB DESCRIPTOR
|
||
|
CALL WRITER(IDEVR,IDBSIZ,NGELS,NCONTS,NGELS,NCONTS)
|
||
|
C WRITE(IDEVR,REC=IDBSIZ)NGELS,NCONTS
|
||
|
RETURN
|
||
|
C
|
||
|
100 CONTINUE
|
||
|
C
|
||
|
C
|
||
|
C DOES OVERLAP
|
||
|
150 CONTINUE
|
||
|
C
|
||
|
C LEFT END OR RIGHT OVERLAP?
|
||
|
IF(ITYPE.EQ.1)GO TO 400
|
||
|
C RIGHT END OR INTERNAL OVERLAP
|
||
|
C
|
||
|
160 CONTINUE
|
||
|
C NEED TO SEARCH THRU THIS CONTIG TO FIND LEFT AND RIGHT
|
||
|
C NEIGHBOURS FOR THIS NEW GEL
|
||
|
C LINE NUMBER OF LEFT END OF CONTIG
|
||
|
N=NCONTC
|
||
|
C LOOK THRU UNTIL CURRENT IS >= THEN IT MUST BE THE PREVIOUS ONE
|
||
|
200 CONTINUE
|
||
|
IF(RELPG(N).GT.X)GO TO 250
|
||
|
C IS THIS THE LAST GEL IN CONTIG?
|
||
|
IF(RNBR(N).EQ.0)GO TO 350
|
||
|
C NO SO LOOK AT NEXT
|
||
|
N=RNBR(N)
|
||
|
GO TO 200
|
||
|
250 CONTINUE
|
||
|
C GEL LIES BETWEEN N AND LNBR(N)
|
||
|
C NEED TO EDIT DB HERE
|
||
|
IF(ITOTPC.GT.0)CALL ABEDIN(RELPG,LNGTHG,LNBR,RNBR,
|
||
|
1NGELS,NCONTS,
|
||
|
2GEL,LINCON,X,SEQC2,ITOTPC,IDC,IDBSIZ,KBOUT,IDEVR,IDEVW,
|
||
|
+MAXGEL)
|
||
|
C
|
||
|
C
|
||
|
C SET POINTERS IN NEW GEL
|
||
|
LNBR(NGELS)=LNBR(N)
|
||
|
RNBR(NGELS)=N
|
||
|
RELPG(NGELS)=X
|
||
|
C WRITE NEW GEL LINE
|
||
|
CALL WRITER(IDEVR,NGELS,RELPG(NGELS),LNGTHG(NGELS),
|
||
|
+LNBR(NGELS),RNBR(NGELS))
|
||
|
C WRITE(IDEVR,REC=NGELS)RELPG(NGELS),LNGTHG(NGELS),LNBR(NGELS),
|
||
|
C 1RNBR(NGELS)
|
||
|
C SET POINTERS IN LEFT AND RIGHT NEIGHBOURS
|
||
|
K=LNBR(N)
|
||
|
RNBR(K)=NGELS
|
||
|
C RNBR(LNBR(N))=NGELS
|
||
|
C WRITE LEFT AND RIGHT NEIGHBOURS
|
||
|
CALL WRITER(IDEVR,K,RELPG(K),LNGTHG(K),
|
||
|
+LNBR(K),RNBR(K))
|
||
|
C WRITE(IDEVR,REC=K)RELPG(K),LNGTHG(K),LNBR(K),RNBR(K)
|
||
|
LNBR(N)=NGELS
|
||
|
CALL WRITER(IDEVR,N,RELPG(N),LNGTHG(N),
|
||
|
+LNBR(N),RNBR(N))
|
||
|
C WRITE(IDEVR,REC=N)RELPG(N),LNGTHG(N),LNBR(N),RNBR(N)
|
||
|
C WRITE NGELS NCONTS
|
||
|
CALL WRITER(IDEVR,IDBSIZ,NGELS,NCONTS,NGELS,NCONTS)
|
||
|
C WRITE(IDEVR,REC=IDBSIZ)NGELS,NCONTS
|
||
|
C HAVE WE INCREASED LENGTH OF CONTIG?
|
||
|
C ITS LINE NUMBER IS LINCON
|
||
|
C NEED TO UPDATE IDIM IN CASE OF EDITS
|
||
|
IDIM=ABS(LNGTHG(NGELS))
|
||
|
Y=X+IDIM-1
|
||
|
IF(Y.LE.RELPG(LINCON))RETURN
|
||
|
RELPG(LINCON)=Y
|
||
|
C WRITE NEW CONTIG LINE
|
||
|
CALL WRITER(IDEVR,LINCON,RELPG(LINCON),LNGTHG(LINCON),
|
||
|
+LNBR(LINCON),RNBR(LINCON))
|
||
|
C WRITE(IDEVR,REC=LINCON)RELPG(LINCON),LNGTHG(LINCON),LNBR(LINCON),
|
||
|
C 1RNBR(LINCON)
|
||
|
RETURN
|
||
|
350 CONTINUE
|
||
|
C MUST BE A RIGHT END OVERLAP
|
||
|
C NEED TO EDIT DB HERE
|
||
|
IF(ITOTPC.GT.0)CALL ABEDIN(RELPG,LNGTHG,LNBR,RNBR,
|
||
|
1NGELS,NCONTS,
|
||
|
2GEL,LINCON,X,SEQC2,ITOTPC,IDC,IDBSIZ,KBOUT,IDEVR,IDEVW,
|
||
|
+MAXGEL)
|
||
|
C
|
||
|
C
|
||
|
C SET POINTERS FOR NEW GEL
|
||
|
LNBR(NGELS)=N
|
||
|
RNBR(NGELS)=0
|
||
|
RELPG(NGELS)=X
|
||
|
C WRITE NEW GEL LINE
|
||
|
CALL WRITER(IDEVR,NGELS,RELPG(NGELS),LNGTHG(NGELS),
|
||
|
+LNBR(NGELS),RNBR(NGELS))
|
||
|
C WRITE(IDEVR,REC=NGELS)
|
||
|
C 1RELPG(NGELS),LNGTHG(NGELS),LNBR(NGELS),RNBR(NGELS)
|
||
|
C OLD RIGHT END
|
||
|
RNBR(N)=NGELS
|
||
|
C WRITE NEW RIGHT LINE
|
||
|
CALL WRITER(IDEVR,N,RELPG(N),LNGTHG(N),
|
||
|
+LNBR(N),RNBR(N))
|
||
|
C WRITE(IDEVR,REC=N)RELPG(N),LNGTHG(N),LNBR(N),RNBR(N)
|
||
|
C
|
||
|
C RESET RIGHT NAME IN CONTIG
|
||
|
C ITS LINE NUMBER IS LINCON
|
||
|
RNBR(LINCON)=NGELS
|
||
|
C HAVE WE INCREASED LENGTH OF CONTIG?
|
||
|
C NEED TO UPDATE LENGTH OF GEL IN CASE OF EDITS
|
||
|
IDIM=ABS(LNGTHG(NGELS))
|
||
|
Y=X+IDIM-1
|
||
|
RELPG(LINCON)=MAX(RELPG(LINCON),Y)
|
||
|
C WRITE HERE
|
||
|
C WRITE CONTIG DESCRIPTOR
|
||
|
CALL WRITER(IDEVR,LINCON,RELPG(LINCON),LNGTHG(LINCON),
|
||
|
+LNBR(LINCON),RNBR(LINCON))
|
||
|
C WRITE(IDEVR,REC=LINCON)RELPG(LINCON),LNGTHG(LINCON),LNBR(LINCON)
|
||
|
C 1,RNBR(LINCON)
|
||
|
CALL WRITER(IDEVR,IDBSIZ,NGELS,NCONTS,NGELS,NCONTS)
|
||
|
C WRITE(IDEVR,REC=IDBSIZ)NGELS,NCONTS
|
||
|
RETURN
|
||
|
C
|
||
|
400 CONTINUE
|
||
|
C
|
||
|
C ADDING TO LEFT END
|
||
|
410 CONTINUE
|
||
|
C NEED TO EDIT DB HERE
|
||
|
IF(ITOTPC.GT.0)CALL ABEDIN(RELPG,LNGTHG,LNBR,RNBR,
|
||
|
1NGELS,NCONTS,
|
||
|
2GEL,LINCON,1,SEQC2,ITOTPC,IDC,IDBSIZ,KBOUT,IDEVR,IDEVW,
|
||
|
+MAXGEL)
|
||
|
C
|
||
|
420 CONTINUE
|
||
|
C SET POINTERS IN NEW GEL
|
||
|
RELPG(NGELS)=1
|
||
|
RNBR(NGELS)=NCONTC
|
||
|
LNBR(NGELS)=0
|
||
|
C WRITE NEW GEL LINE
|
||
|
CALL WRITER(IDEVR,NGELS,RELPG(NGELS),LNGTHG(NGELS),
|
||
|
+LNBR(NGELS),RNBR(NGELS))
|
||
|
C WRITE(IDEVR,REC=NGELS)RELPG(NGELS),LNGTHG(NGELS),LNBR(NGELS),
|
||
|
C 1RNBR(NGELS)
|
||
|
C SET POINTERS IN OLD LEFT END
|
||
|
LNBR(NCONTC)=NGELS
|
||
|
RELPG(NCONTC)=X
|
||
|
C WRITE NEW LEFT END
|
||
|
CALL WRITER(IDEVR,NCONTC,RELPG(NCONTC),LNGTHG(NCONTC),
|
||
|
+LNBR(NCONTC),RNBR(NCONTC))
|
||
|
C WRITE(IDEVR,REC=NCONTC)RELPG(NCONTC),LNGTHG(NCONTC),LNBR(NCONTC)
|
||
|
C 1,RNBR(NCONTC)
|
||
|
C NEW LENGTH OF CONTIG
|
||
|
RELPG(LINCON)=RELPG(LINCON)+X-1
|
||
|
C MAY HAVE JUST ADDED A GEL LONGER THAN CONTIG
|
||
|
IDIM=ABS(LNGTHG(NGELS))
|
||
|
Y=IDIM
|
||
|
IF(Y.GT.RELPG(LINCON))RELPG(LINCON)=Y
|
||
|
C NEW NAME OF LEFT END OF CONTIG
|
||
|
LNBR(LINCON)=NGELS
|
||
|
C WRITE CONTIG DESCRIPTOR
|
||
|
CALL WRITER(IDEVR,LINCON,RELPG(LINCON),LNGTHG(LINCON),
|
||
|
+LNBR(LINCON),RNBR(LINCON))
|
||
|
C WRITE(IDEVR,REC=LINCON)RELPG(LINCON),LNGTHG(LINCON),LNBR(LINCON)
|
||
|
C 1,RNBR(LINCON)
|
||
|
CALL WRITER(IDEVR,IDBSIZ,NGELS,NCONTS,NGELS,NCONTS)
|
||
|
C WRITE(IDEVR,REC=IDBSIZ)NGELS,NCONTS
|
||
|
C NOW GO THRU AND CHANGE ALL RELATIVE POSITIONS
|
||
|
N=NCONTC
|
||
|
440 CONTINUE
|
||
|
IF(RNBR(N).EQ.0)RETURN
|
||
|
N=RNBR(N)
|
||
|
RELPG(N)=RELPG(N)+X-1
|
||
|
C WRITE NEW LINE
|
||
|
CALL WRITER(IDEVR,N,RELPG(N),LNGTHG(N),
|
||
|
+LNBR(N),RNBR(N))
|
||
|
C WRITE(IDEVR,REC=N)RELPG(N),LNGTHG(N),LNBR(N),RNBR(N)
|
||
|
GO TO 440
|
||
|
END
|
||
|
SUBROUTINE DBAUTO(RELPG,LNGTHG,LNBR,RNBR,MAXDB,IDBSIZ,
|
||
|
+NGELS,NCONTS,MAXGEL,
|
||
|
+TEMP3,WORDP,WORDN,LPOWRC,POSNS,GELN,
|
||
|
+SEQ1,MAXSEQ,SEQ2,SEQ3,SEQ4,SEQ5,SEQC2,SEQG2,MATCH,
|
||
|
+MAXGLM,MAXGL2,CHRSIZ,ECHRSZ,LENGTH,
|
||
|
+SAV1,SAV2,SAV3,MAXSAV,CENDS,NENDS,MAXCON,CONST,
|
||
|
+KBIN,KBOUT,IDEV1,IDEV2,IDEV3,IDEV4,IDEV7,IDEV8,IDEV,
|
||
|
+IHELPS,IHELPE,HELPF,IDEVH,NAMARC,NAMPRO,FILE,
|
||
|
+PERCD,IOPEN,IDM,SEQG3,SEQC3,IOK)
|
||
|
INTEGER CHRSIZ,ECHRSZ
|
||
|
INTEGER RELPG(MAXDB),PL(2),PR(2),RMOST
|
||
|
INTEGER LNGTHG(MAXDB),LNBR(MAXDB),RNBR(MAXDB)
|
||
|
INTEGER JOINT(2),ITOTPC(2),ITOTPG(2),IDIM22(2),IDOUT(2)
|
||
|
INTEGER LINCON(2),LLINO(2),ITYPE(2),IFAIL(2)
|
||
|
INTEGER ILEFTS(2),ILC(2),IPOSC(2),IPOSG(2),ISENSE(2)
|
||
|
INTEGER LREG,RREG,X,ANS,ANSJOK
|
||
|
INTEGER TEMP3(ECHRSZ,MAXGL2),CONST(LENGTH)
|
||
|
INTEGER POSNS(MAXSEQ),WORDP(LPOWRC),WORDN(LPOWRC),GELN(MAXGLM)
|
||
|
INTEGER CENDS(MAXCON),NENDS(MAXCON)
|
||
|
CHARACTER SEQ3(MAXGLM),SEQC2(MAXGLM,2),SEQG2(MAXGLM,2)
|
||
|
CHARACTER SEQ1(MAXSEQ),SEQ2(MAXGLM),MATCH(MAXGLM),SEQ4(MAXGLM)
|
||
|
INTEGER SAV1(MAXSAV),SAV2(MAXSAV),SAV3(MAXSAV)
|
||
|
CHARACTER NAMARC*(*),NAMPRO*(*),FILE*(*)
|
||
|
CHARACTER GET,SEQ5(MAXGLM),HELPF*(*),SEQG3(MAXGLM),SEQC3(MAXGLM)
|
||
|
PARAMETER (MAXPRM = 32)
|
||
|
CHARACTER PROMPT(3)*(MAXPRM)
|
||
|
SAVE GET
|
||
|
DATA GET/'>'/
|
||
|
WRITE(KBOUT,*)' Automatic sequence assembler'
|
||
|
IFAIL(1) = 0
|
||
|
IEMPTY=0
|
||
|
IF(NGELS.LT.1)IEMPTY=1
|
||
|
CALL DBCHEK(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDBSIZ,
|
||
|
+TEMP3,IERR,KBOUT)
|
||
|
IF(IERR.GT.1) RETURN
|
||
|
CALL YESNO(IOKENT,'Permit entry',
|
||
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
||
|
IF(IOKENT.LT.0) RETURN
|
||
|
CALL YESNO(INF,'Use file of file names',
|
||
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
||
|
IF(INF.LT.0) RETURN
|
||
|
IF(INF.EQ.0) THEN
|
||
|
FILE = ' '
|
||
|
CALL OPENF1(IDEV7,FILE,0,IOK,KBIN,KBOUT,
|
||
|
+ 'File of gel reading names',
|
||
|
+ IHELPS,IHELPE,HELPF,IDEVH)
|
||
|
IF(IOK.NE.0) RETURN
|
||
|
END IF
|
||
|
IF(IOKENT.EQ.0) THEN
|
||
|
FILE = ' '
|
||
|
CALL OPENF1(IDEV8,FILE,1,IOK,KBIN,KBOUT,
|
||
|
+ 'File for names of failures',
|
||
|
+ IHELPS,IHELPE,HELPF,IDEVH)
|
||
|
IF(IOK.NE.0) RETURN
|
||
|
END IF
|
||
|
PROMPT(1) = 'Perform normal shotgun assembly'
|
||
|
PROMPT(2) = 'Put all sequences in one contig'
|
||
|
PROMPT(3) = 'Put all sequences in new contigs'
|
||
|
IOPT = 1
|
||
|
CALL RADION('Select entry mode',PROMPT,3,IOPT,
|
||
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
||
|
IF(IOPT.LT.1) RETURN
|
||
|
IF(IOPT.EQ.1) THEN
|
||
|
C parameters for normal assembly
|
||
|
ANSJOK = 0
|
||
|
CALL YESNO(ANSJOK,'Permit joins',
|
||
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
||
|
IF(ANSJOK.LT.0) RETURN
|
||
|
MN = LENGTH*2
|
||
|
MX = MAXGLM + 1
|
||
|
MINMAT = MAX(15,MN)
|
||
|
CALL GETINT(MN,MX,MINMAT,
|
||
|
+'Minimum initial match',
|
||
|
+IVAL,KBIN,KBOUT,
|
||
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) RETURN
|
||
|
MINMAT = IVAL
|
||
|
MINSLI = 3
|
||
|
MN = 0
|
||
|
MX = 25
|
||
|
MAXPG = 8
|
||
|
CALL GETINT(MN,MX,MAXPG,
|
||
|
+'Maximum pads per gel',
|
||
|
+IVAL,KBIN,KBOUT,
|
||
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) RETURN
|
||
|
MAXPG = IVAL
|
||
|
MN = 0
|
||
|
MX = 25
|
||
|
MAXPC = 8
|
||
|
CALL GETINT(MN,MX,MAXPC,
|
||
|
+'Maximum pads per gel in contig',
|
||
|
+IVAL,KBIN,KBOUT,
|
||
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) RETURN
|
||
|
MAXPC = IVAL
|
||
|
IF(IOKENT.EQ.0) THEN
|
||
|
RMN = 0.
|
||
|
RMX = 15.
|
||
|
PERMAX = 8.
|
||
|
CALL GETRL(RMN,RMX,PERMAX,
|
||
|
+ 'Maximum percent mismatch after alignment',
|
||
|
+ VAL,KBIN,KBOUT,
|
||
|
+ IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) RETURN
|
||
|
PERMAX = VAL
|
||
|
END IF
|
||
|
IDIM1=0
|
||
|
MAXOVR=MAXGEL-3*MAX(MAXPC,MAXPG)
|
||
|
ANS=0
|
||
|
IF(IEMPTY.EQ.0)
|
||
|
+CALL ACONS(RELPG,LNGTHG,LNBR,RNBR,NAMPRO,NGELS,NCONTS,
|
||
|
+SEQ1,MAXSEQ,SEQ2,IDBSIZ,IDIM1,ANS,KDUMM,KDUMM,KDUMM,TEMP3,
|
||
|
+ECHRSZ,MAXGL2,KBOUT,IDEV2,IFAIL(1),MAXGEL,IDM,PERCD)
|
||
|
END IF
|
||
|
JGEL = 0
|
||
|
JNGEL = 0
|
||
|
JNJOIN = 0
|
||
|
IMATC = 0
|
||
|
IF(IFAIL(1).NE.0)GO TO 900
|
||
|
C
|
||
|
C
|
||
|
1 CONTINUE
|
||
|
C
|
||
|
C
|
||
|
IDIM2=MAXGEL
|
||
|
IF(INF.EQ.1) THEN
|
||
|
3 CONTINUE
|
||
|
MN = 0
|
||
|
CALL GTSTR('Gel reading name',' ',NAMARC,MN,KBOUT,KBIN,INFLAG)
|
||
|
IF(INFLAG.EQ.3) RETURN
|
||
|
IF(INFLAG.EQ.2) RETURN
|
||
|
IF(INFLAG.EQ.1) THEN
|
||
|
CALL HELP2(IHELPS,IHELPE,FILEH,IDEVH,KBIN,KBOUT)
|
||
|
GO TO 3
|
||
|
END IF
|
||
|
ELSE
|
||
|
READ(IDEV7,1002,END=900)NAMARC
|
||
|
END IF
|
||
|
1002 FORMAT( A)
|
||
|
DO 77 MM=1,80
|
||
|
MATCH(MM)=GET
|
||
|
77 CONTINUE
|
||
|
WRITE(IDEV,1077)(MATCH(KK),KK=1,79)
|
||
|
1077 FORMAT(' ',79A1)
|
||
|
JGEL = JGEL + 1
|
||
|
WRITE(IDEV,*)'Processing',JGEL,' in batch'
|
||
|
1007 FORMAT(' Gel reading name=',A)
|
||
|
WRITE(IDEV,1007)NAMARC
|
||
|
CALL OPENRS(IDEV4,NAMARC,IOK,LRECL,2)
|
||
|
IF(IOK.NE.0)THEN
|
||
|
IF(INF.EQ.1) RETURN
|
||
|
WRITE(IDEV,*)' Error opening gel reading file'
|
||
|
GO TO 1
|
||
|
END IF
|
||
|
CALL ARRFIM(IDEV4,SEQ2,IDIM2,KBOUT)
|
||
|
CLOSE(UNIT=IDEV4)
|
||
|
WRITE(IDEV,1800)IDIM2
|
||
|
1800 FORMAT(' Gel reading length=',I6)
|
||
|
IF(IOPT.NE.1) THEN
|
||
|
CALL DBAUTP(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+ SEQ2,NAMARC,JOINT,ITYPE,ISENSE,SEQC2,ITOTPC,
|
||
|
+ IDIM2,IDOUT,LLINO,LINCON,IFAIL,IDBSIZ,MAXDB,IDEV,
|
||
|
+ IDEV1,IDEV2,IDEV3,MAXGEL,IMATC,IEMPTY,IOPT)
|
||
|
IF(IFAIL(1).NE.0) GO TO 800
|
||
|
JNGEL = JNGEL + 1
|
||
|
GO TO 1
|
||
|
END IF
|
||
|
IF(IDIM2.LT.MINMAT)THEN
|
||
|
WRITE(IDEV,*)
|
||
|
+' Reading shorter than minimum match, so not processed'
|
||
|
GO TO 1
|
||
|
END IF
|
||
|
CALL SQCOPY(SEQ2,SEQ3,IDIM2)
|
||
|
IFCOMP=0
|
||
|
IMATC=0
|
||
|
IF(IEMPTY.EQ.0)
|
||
|
+CALL AUTOCN(SEQ1,IDIM1,SEQ2,IDIM2,ILEFTS,ILC,IPOSC,
|
||
|
+IPOSG,ISENSE,LLINO,IMATC,IFCOMP,MINMAT,POSNS,WORDP,WORDN,
|
||
|
+CONST,LENGTH,LPOWRC,IDEV,MATCH,MAXGEL,MAXGLM,SEQ5,GELN,
|
||
|
+SAV1,SAV2,SAV3,MAXSAV,CENDS,NENDS,MAXCON,
|
||
|
+SEQG2,SEQC2,SEQ4,IDOUT,IDIM22,ITOTPG,ITOTPC,JOINT,IFAIL,
|
||
|
+ITYPE,MAXPC,MAXPG,PERMAX,MINSLI,SEQG3,SEQC3,KFAIL)
|
||
|
IF(IOKENT.NE.0) GO TO 1
|
||
|
C THIS RETURNS THE FOLLOWING:
|
||
|
C ILEFTS POSITION IN CONSENSUS OF LEFT END OF MATCHING CONTIGS
|
||
|
C ILC LENGTHS OF MATCHING CONTIGS
|
||
|
C IPOSC POSITION OF MATCH RELATIVE TO CONTIG
|
||
|
C IPOSG POSITION OF MATCH RELATIVE TO NEW GEL
|
||
|
C ISENSE SENSE OF NEW GEL
|
||
|
C LLINO LEFT GEL NUMBER IN MATCHING CONTIGS
|
||
|
C IMATC THE NUMBER OF MATCHING CONTIGS (>2 IS ERROR!)
|
||
|
C IFCOMP ERROR FLAG FOR COMPARISON (COMPARISON ARRAYS OVERFLOWED)
|
||
|
IF(IFCOMP.NE.0)GO TO 800
|
||
|
CALL SQCOPY(SEQ3,SEQ2,IDIM2)
|
||
|
IF(IMATC.GT.0)GO TO 200
|
||
|
C
|
||
|
C NO OVERLAP NEW CONTIG
|
||
|
C
|
||
|
C ITYPE 0 = NO OVERLAP
|
||
|
C ISENSE 1 = SAME SENSE AS ARCHIVE
|
||
|
IF(IFAIL(1).NE.0) GO TO 800
|
||
|
ITYPE(1)=0
|
||
|
ISENSE(1)=1
|
||
|
IDOUT(1)=MAXGEL
|
||
|
WRITE(IDEV,1015)
|
||
|
1015 FORMAT(' New gel reading does not overlap: start a new contig')
|
||
|
CALL AENTER(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+SEQ2,NAMARC,X,ITYPE,ISENSE,SEQC2(1,1),ITOTPC(1),
|
||
|
+IDIM2,IDOUT(1),LLINO,LINCON,IFAIL,IDBSIZ,IDEV,
|
||
|
+IDEV1,IDEV2,IDEV3,MAXGEL)
|
||
|
IF(IFAIL(1).NE.0)GO TO 800
|
||
|
IEMPTY=0
|
||
|
IDIM1=IDIM1+1
|
||
|
IF((IDIM1+19+IDIM2).GT.MAXSEQ)THEN
|
||
|
WRITE(IDEV,1021)MAXSEQ
|
||
|
1021 FORMAT(' Database maximum consensus length (',I6,') exceeded')
|
||
|
GO TO 900
|
||
|
END IF
|
||
|
CALL ADDTIT(SEQ1(IDIM1),NAMPRO,NGELS,IDIM1)
|
||
|
CALL MSTLKL(SEQ2,IDIM2)
|
||
|
CALL SQCOPY(SEQ2,SEQ1(IDIM1),IDIM2)
|
||
|
IDIM1=IDIM1+IDIM2-1
|
||
|
JNGEL = JNGEL + 1
|
||
|
GO TO 1
|
||
|
C
|
||
|
C
|
||
|
C
|
||
|
200 CONTINUE
|
||
|
C
|
||
|
C
|
||
|
C OVERLAP SO TRY TO ALIGN THE SEQUENCES
|
||
|
C
|
||
|
C
|
||
|
DO 100 I=1,IMATC
|
||
|
N=IDBSIZ-NCONTS
|
||
|
DO 99 J=N,IDBSIZ-1
|
||
|
IF(LNBR(J).NE.LLINO(I))GO TO 99
|
||
|
LINCON(I)=J
|
||
|
GO TO 100
|
||
|
99 CONTINUE
|
||
|
WRITE(IDEV,10077)LLINO(I)
|
||
|
10077 FORMAT(' Contig line for contig',I6,' not found!')
|
||
|
GO TO 800
|
||
|
100 CONTINUE
|
||
|
C
|
||
|
IF((IMATC.EQ.2).AND.(ANSJOK.EQ.0))GO TO 400
|
||
|
C
|
||
|
C
|
||
|
C SINGLE OVERLAP
|
||
|
C
|
||
|
C
|
||
|
C
|
||
|
WRITE(IDEV,1014)LLINO(1)
|
||
|
1014 FORMAT(' New gel reading overlaps contig',I6)
|
||
|
IF(ITOTPG(1).GT.0) CALL CCTA(SEQG2(1,1),IDIM22(1))
|
||
|
CALL AENTER(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+SEQG2(1,1),NAMARC,JOINT(1),ITYPE(1),ISENSE(1),
|
||
|
+SEQC2(1,1),
|
||
|
+ITOTPC(1),IDIM22(1),IDOUT(1),LLINO(1),LINCON(1),
|
||
|
+IFAIL(1),IDBSIZ,IDEV,IDEV1,IDEV2,IDEV3,MAXGEL)
|
||
|
IF(IFAIL(1).NE.0)GO TO 800
|
||
|
CALL DELCON(SEQ1,ILEFTS(1),ILC(1),IDIM1)
|
||
|
LREG=1
|
||
|
RREG=RELPG(LINCON(1))
|
||
|
IGELC=LNBR(LINCON(1))
|
||
|
ANS=1
|
||
|
CALL ACONS(RELPG,LNGTHG,LNBR,RNBR,NAMPRO,NGELS,NCONTS,
|
||
|
+SEQ1,MAXSEQ,SEQ2,IDBSIZ,IDIM1,ANS,IGELC,LREG,RREG,TEMP3,
|
||
|
+ECHRSZ,MAXGL2,IDEV,IDEV2,IFAIL(1),MAXGEL,IDM,PERCD)
|
||
|
IF(IFAIL(1).NE.0)GO TO 900
|
||
|
JNGEL = JNGEL + 1
|
||
|
IF(KFAIL.NE.0) GO TO 800
|
||
|
GO TO 1
|
||
|
C
|
||
|
C
|
||
|
C DOUBLE OVERLAP
|
||
|
C
|
||
|
C
|
||
|
400 CONTINUE
|
||
|
WRITE(IDEV,1013)LLINO
|
||
|
1013 FORMAT(' Overlap between contigs',I6,' and',I6)
|
||
|
IF(ANSJOK.NE.0)GO TO 800
|
||
|
IF(LLINO(1).EQ.LLINO(2))THEN
|
||
|
WRITE(IDEV,*)' Trying to form loop in contig',LLINO(1)
|
||
|
WRITE(IDEV,*)' Gel not entered'
|
||
|
GO TO 800
|
||
|
END IF
|
||
|
CALL AJOIN3(RELPG,IDBSIZ,LINCON,ITYPE,ISENSE,JOINT,
|
||
|
+IDIM22,KLASS,IOVER,IDEV,PL,PR)
|
||
|
IF(IOVER.GT.MAXOVR)THEN
|
||
|
WRITE(IDEV,*)' Overlap too large: entry only'
|
||
|
IFAIL(2)=1
|
||
|
GO TO 600
|
||
|
END IF
|
||
|
C WHICH CONTIG IS LEFTMOST?
|
||
|
LMOST=1
|
||
|
RMOST=2
|
||
|
IF(PL(1).GT.PL(2))THEN
|
||
|
LMOST=2
|
||
|
RMOST=1
|
||
|
END IF
|
||
|
C SAVE LENGTH OF RMOST CONTIG FOR DELETION STEP LATER
|
||
|
ILCR=ILC(RMOST)
|
||
|
IF(ITOTPG(LMOST).GT.0) CALL CCTA(SEQG2(1,LMOST),IDIM22(LMOST))
|
||
|
WRITE(IDEV,1012)LLINO(LMOST)
|
||
|
1012 FORMAT(' Entering the new gel reading into contig',I6)
|
||
|
CALL AENTER(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+SEQG2(1,LMOST),NAMARC,JOINT(LMOST),ITYPE(LMOST),
|
||
|
+ISENSE(LMOST),SEQC2(1,LMOST),ITOTPC(LMOST),
|
||
|
+IDIM22(LMOST),IDOUT(LMOST),LLINO(LMOST),LINCON(LMOST),
|
||
|
+IFAIL(LMOST),IDBSIZ,IDEV,IDEV1,IDEV2,IDEV3,
|
||
|
+MAXGEL)
|
||
|
IF(IFAIL(LMOST).NE.0)GO TO 800
|
||
|
JNGEL = JNGEL + 1
|
||
|
IF(ITYPE(LMOST).EQ.1)LLINO(LMOST)=NGELS
|
||
|
IF(ILEFTS(LMOST).LT.ILEFTS(RMOST))THEN
|
||
|
ILEFTS(RMOST)=ILEFTS(RMOST)-ILC(LMOST)-20
|
||
|
END IF
|
||
|
CALL DELCON(SEQ1,ILEFTS(LMOST),ILC(LMOST),IDIM1)
|
||
|
LREG=1
|
||
|
RREG=RELPG(LINCON(LMOST))
|
||
|
IGELC=LNBR(LINCON(LMOST))
|
||
|
ANS=1
|
||
|
CALL ACONS(RELPG,LNGTHG,LNBR,RNBR,NAMPRO,NGELS,NCONTS,
|
||
|
+SEQ1,MAXSEQ,SEQ2,IDBSIZ,IDIM1,ANS,IGELC,LREG,RREG,TEMP3,
|
||
|
+ECHRSZ,MAXGL2,IDEV,IDEV2,IFAIL(1),MAXGEL,IDM,PERCD)
|
||
|
IF(IFAIL(1).NE.0)GO TO 900
|
||
|
ILC(LMOST)=RREG
|
||
|
ILEFTS(LMOST)=IDIM1-RREG+1
|
||
|
DO 500 I=1,2
|
||
|
IF(ISENSE(I).EQ.-1)THEN
|
||
|
CALL CMPLMT(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,LINCON(I),
|
||
|
+ LLINO(I),SEQ2,IDBSIZ,IDEV,IDEV1,IDEV2,MAXGEL)
|
||
|
CALL SQREV(SEQ1(ILEFTS(I)),ILC(I))
|
||
|
CALL SQCOM(SEQ1(ILEFTS(I)),ILC(I))
|
||
|
KT=IDIM1
|
||
|
CALL ADDTIT(SEQ1((ILEFTS(I)-20)),NAMPRO,LNBR(LINCON(I)),KT)
|
||
|
END IF
|
||
|
500 CONTINUE
|
||
|
C NEED TO KNOW POSITION OF OVERLAP RELATIVE TO CONTIG, TO CONSENSUS
|
||
|
C WHICH BITS TO SEND TO ALIGNMENT ROUTINES
|
||
|
C SET UP FOR ALINE (NOTE RMOST IS EQUIVALENT TO THE GEL READING AND
|
||
|
C SO IS SLID ALONG THE LMOST CONTIG. THE SECTION SENT TO ALINE MUST
|
||
|
C BE OF LENGTH < MAXGEL-2*MAX(MAXPC,MAXPG)
|
||
|
C IT MUST START AT POSITION 1 IN THE RMOST CONTIG AND EXTEND
|
||
|
IPOSC(LMOST)=PL(RMOST)+RELPG(NGELS)-1
|
||
|
ILCT = RELPG(LINCON(LMOST)) - RELPG(NGELS) - PL(RMOST) + 2
|
||
|
ILC(RMOST)=MIN(ILCT,ILC(RMOST))
|
||
|
IPOSC(RMOST)=1
|
||
|
IDOUT(LMOST)=MAXGEL
|
||
|
IDOUT(RMOST)=MAXGEL
|
||
|
IDSAV=MAXSAV
|
||
|
C ON INPUT TO ALINE ILC(RMOST) CONTAINS THE OVERLAP LENGTH
|
||
|
C ON OUTPUT IT CONTAINS THE LENGTH OF THE ALIGNED SECTION (IE INCLUDING
|
||
|
C PADS)
|
||
|
WRITE(IDEV,1009)
|
||
|
1009 FORMAT(' Trying to align the two contigs')
|
||
|
CALL ALINE(SEQ1(ILEFTS(LMOST)),SEQ1(ILEFTS(RMOST)),
|
||
|
+SEQC2(1,RMOST),SEQC2(1,LMOST),SAV1,SAV2,SAV3,IDSAV,
|
||
|
+ILC(LMOST),ILC(RMOST),IDOUT(LMOST),IPOSC(LMOST),IPOSC(RMOST),
|
||
|
+MINSLI,JOINT(LMOST),ITOTPC(LMOST),ITOTPC(RMOST),IFAIL(1),
|
||
|
+ITYPE(1),MAXPC,MAXPC,PERMAX,IDEV,SEQ4,MAXGEL,Z)
|
||
|
C SEQC2(1,LMOST) NOW CONTAINS THE ALIGNED SECTION OF THE LMOST CONTIG
|
||
|
C SEQC2(1,RMOST) NOW CONTAINS THE ALIGNED SECTION OF THE RMOST CONTIG
|
||
|
C ILC(RMOST) IS NOW THE LENGTH OF ALIGNED SECTION OF THE RMOST CONTIG
|
||
|
C IDOUT(LMOST) IS NOW THE LENGTH OF ALIGNED SECTION OF THE LMOST CONTIG
|
||
|
C JOINT(LMOST) IS THE POSITION OF THE JOIN RLETIVE TO THE LMOST CONTIG
|
||
|
C ITYPE IS TYPE OF OVERLAP (-1 = RIGHT END OR INTERNAL, 1 = LEFT END)
|
||
|
C NB SHOULD ALWAYS BE -1
|
||
|
C IF THIS HAS BEEN DONE OK WE CAN EDIT THE TWO CONTIGS THEN JOIN
|
||
|
IF(IFAIL(1).NE.0)THEN
|
||
|
WRITE(IDEV,*)' Failed to align the two overlapping contigs'
|
||
|
GO TO 800
|
||
|
END IF
|
||
|
IF(ITOTPC(LMOST).GT.0)THEN
|
||
|
WRITE(IDEV,1017)LLINO(LMOST)
|
||
|
1017 FORMAT(' Editing contig',I6)
|
||
|
CALL ABEDIN(RELPG,LNGTHG,LNBR,RNBR,
|
||
|
+ NGELS,NCONTS,SEQ3,LINCON(LMOST),JOINT(LMOST),SEQC2(1,LMOST),
|
||
|
+ ITOTPC(LMOST),IDOUT(LMOST),IDBSIZ,IDEV,IDEV1,IDEV2,
|
||
|
+ MAXGEL)
|
||
|
END IF
|
||
|
JOINT(RMOST)=1
|
||
|
IDOUT(RMOST)=ILC(RMOST)
|
||
|
IF(ITOTPC(RMOST).GT.0)THEN
|
||
|
WRITE(IDEV,1017)LLINO(RMOST)
|
||
|
CALL ABEDIN(RELPG,LNGTHG,LNBR,RNBR,
|
||
|
+ NGELS,NCONTS,SEQ3,LINCON(RMOST),JOINT(RMOST),SEQC2(1,RMOST),
|
||
|
+ ITOTPC(RMOST),IDOUT(RMOST),IDBSIZ,IDEV,IDEV1,IDEV2,
|
||
|
+ MAXGEL)
|
||
|
END IF
|
||
|
ILC(RMOST)=ILCR
|
||
|
LTL=LNBR(LINCON(LMOST))
|
||
|
LTR=LNBR(LINCON(RMOST))
|
||
|
WRITE(IDEV,1018)LNBR(LINCON(LMOST)),LNBR(LINCON(RMOST))
|
||
|
1018 FORMAT(' Completing the join between contigs',I6,' and',I6)
|
||
|
CALL AJOIN2(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDBSIZ,
|
||
|
+JOINT(LMOST),LTL,LTR,LINCON(LMOST),LINCON(RMOST),IDEV1)
|
||
|
LLINO(1)=LTL
|
||
|
IF(ILEFTS(LMOST).GT.ILEFTS(RMOST))THEN
|
||
|
CALL DELCON(SEQ1,ILEFTS(LMOST),ILC(LMOST),IDIM1)
|
||
|
CALL DELCON(SEQ1,ILEFTS(RMOST),ILC(RMOST),IDIM1)
|
||
|
END IF
|
||
|
IF(ILEFTS(RMOST).GE.ILEFTS(LMOST))THEN
|
||
|
CALL DELCON(SEQ1,ILEFTS(RMOST),ILC(RMOST),IDIM1)
|
||
|
CALL DELCON(SEQ1,ILEFTS(LMOST),ILC(LMOST),IDIM1)
|
||
|
END IF
|
||
|
LREG=1
|
||
|
RREG=JOINT(LMOST)
|
||
|
IGELC=LLINO(1)
|
||
|
ANS=1
|
||
|
CALL ACONS(RELPG,LNGTHG,LNBR,RNBR,NAMPRO,NGELS,NCONTS,
|
||
|
+SEQ1,MAXSEQ,SEQ2,IDBSIZ,IDIM1,ANS,IGELC,LREG,RREG,TEMP3,
|
||
|
+ECHRSZ,MAXGL2,IDEV,IDEV2,IFAIL(1),MAXGEL,IDM,PERCD)
|
||
|
IF(IFAIL(1).NE.0)GO TO 900
|
||
|
C CALL FMTDB(SEQ1,IDIM1,1,IDIM1,60,IDEV)
|
||
|
JNJOIN = JNJOIN + 1
|
||
|
IF(KFAIL.NE.0) GO TO 800
|
||
|
GO TO 1
|
||
|
C
|
||
|
C
|
||
|
C JOINS THAT FAIL INITIAL ALIGNMENT CRITERIA
|
||
|
C
|
||
|
C
|
||
|
600 CONTINUE
|
||
|
C COME HERE FOR JOINS THAT FAIL: WE MIGHT BE ABLE TO ENTER THE GEL
|
||
|
C INTO A SINGLE CONTIG
|
||
|
IGOOD=0
|
||
|
IF(IFAIL(1).EQ.0)IGOOD=1
|
||
|
IF(IFAIL(2).EQ.0)IGOOD=2
|
||
|
IF(IGOOD.EQ.0)GO TO 800
|
||
|
IF(ITOTPG(IGOOD).GT.0) CALL CCTA(SEQG2(1,IGOOD),IDIM22(IGOOD))
|
||
|
WRITE(IDEV,1012)LLINO(IGOOD)
|
||
|
CALL AENTER(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+SEQG2(1,IGOOD),NAMARC,JOINT(IGOOD),ITYPE(IGOOD),
|
||
|
+ISENSE(IGOOD),SEQC2(1,IGOOD),ITOTPC(IGOOD),
|
||
|
+IDIM22(IGOOD),IDOUT(IGOOD),LLINO(IGOOD),LINCON(IGOOD),
|
||
|
+IFAIL(IGOOD),IDBSIZ,IDEV,IDEV1,IDEV2,IDEV3,
|
||
|
+MAXGEL)
|
||
|
IF(IFAIL(IGOOD).NE.0)GO TO 800
|
||
|
JNGEL = JNGEL + 1
|
||
|
CALL DELCON(SEQ1,ILEFTS(IGOOD),ILC(IGOOD),IDIM1)
|
||
|
ANS=1
|
||
|
IGELC=LNBR(LINCON(IGOOD))
|
||
|
LREG=1
|
||
|
RREG=RELPG(LINCON(IGOOD))
|
||
|
CALL ACONS(RELPG,LNGTHG,LNBR,RNBR,NAMPRO,NGELS,NCONTS,
|
||
|
+SEQ1,MAXSEQ,SEQ2,IDBSIZ,IDIM1,ANS,IGELC,LREG,RREG,TEMP3,
|
||
|
+ECHRSZ,MAXGL2,IDEV,IDEV2,IFAIL(1),MAXGEL,IDM,PERCD)
|
||
|
IF(IFAIL(1).NE.0)GO TO 900
|
||
|
WRITE(IDEV,1020)LLINO,LLINO(IGOOD)
|
||
|
1020 FORMAT(' Could not join contigs',I4,' and',I4,' but the gel',
|
||
|
+' has been entered into contig',I4,/,
|
||
|
+' If required do the join manually.')
|
||
|
C
|
||
|
C
|
||
|
C ALL FAILURES
|
||
|
C
|
||
|
C
|
||
|
C
|
||
|
800 CONTINUE
|
||
|
WRITE(IDEV,10888)
|
||
|
10888 FORMAT(' Failed gel name written to error file')
|
||
|
WRITE(IDEV8,1002)NAMARC
|
||
|
GO TO 1
|
||
|
900 CONTINUE
|
||
|
WRITE(KBOUT,*)'Batch finished'
|
||
|
WRITE(KBOUT,*)JGEL,' sequences processed'
|
||
|
WRITE(KBOUT,*)JNGEL,' sequences entered into database'
|
||
|
WRITE(KBOUT,*)JNJOIN,' joins made'
|
||
|
RETURN
|
||
|
END
|
||
|
SUBROUTINE DBAUTP(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+SEQ2,NAMARC,JOINT,ITYPE,ISENSE,SEQC2,ITOTPC,
|
||
|
+IDIM2,IDOUT,LLINO,LINCON,IFAIL,IDBSIZ,MAXDB,IDEV,
|
||
|
+IDEV1,IDEV2,IDEV3,MAXGEL,IMATC,IEMPTY,IOPT)
|
||
|
INTEGER RELPG(MAXDB)
|
||
|
INTEGER LNGTHG(MAXDB),LNBR(MAXDB),RNBR(MAXDB)
|
||
|
CHARACTER SEQ2(MAXGEL),SEQC2(MAXGEL)
|
||
|
CHARACTER NAMARC*(*)
|
||
|
C deals with entering all readings into contig 1 (IOPT=2)
|
||
|
C or all readings into new contigs (IOPT=3)
|
||
|
IF(IOPT.EQ.2) THEN
|
||
|
IF(IMATC.EQ.0) THEN
|
||
|
ITYPE=0
|
||
|
ISENSE=1
|
||
|
IDOUT=MAXGEL
|
||
|
CALL AENTER(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+ SEQ2,NAMARC,JOINT,ITYPE,ISENSE,SEQC2,ITOTPC,
|
||
|
+ IDIM2,IDOUT,LLINO,LINCON,IFAIL,IDBSIZ,IDEV,
|
||
|
+ IDEV1,IDEV2,IDEV3,MAXGEL)
|
||
|
IF(IFAIL.NE.0) RETURN
|
||
|
IEMPTY=0
|
||
|
IMATC = 1
|
||
|
ELSE
|
||
|
ITYPE= - 1
|
||
|
ISENSE=1
|
||
|
JOINT = 1
|
||
|
LLINO = 1
|
||
|
LINCON = IDBSIZ - 1
|
||
|
ITOTPC = 0
|
||
|
IDOUT=MAXGEL
|
||
|
CALL AENTER(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+ SEQ2,NAMARC,JOINT,ITYPE,ISENSE,SEQC2,ITOTPC,
|
||
|
+ IDIM2,IDOUT,LLINO,LINCON,IFAIL,IDBSIZ,IDEV,
|
||
|
+ IDEV1,IDEV2,IDEV3,MAXGEL)
|
||
|
IF(IFAIL.NE.0) RETURN
|
||
|
END IF
|
||
|
ELSE IF(IOPT.EQ.3) THEN
|
||
|
ITYPE=0
|
||
|
ISENSE=1
|
||
|
IDOUT=MAXGEL
|
||
|
CALL AENTER(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+ SEQ2,NAMARC,JOINT,ITYPE,ISENSE,SEQC2,ITOTPC,
|
||
|
+ IDIM2,IDOUT,LLINO,LINCON,IFAIL,IDBSIZ,IDEV,
|
||
|
+ IDEV1,IDEV2,IDEV3,MAXGEL)
|
||
|
IF(IFAIL.NE.0) RETURN
|
||
|
END IF
|
||
|
END
|
||
|
SUBROUTINE DBCOPY(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,GEL,
|
||
|
+NAMPRO,IDEV,IDBSIZ,IERR,KBIN,KBOUT,IDEVR,IDEVW,IDEVN,
|
||
|
+IHELPS,IHELPE,FILEH,IDEVH,MAXGEL,MAXDB,IDM)
|
||
|
CHARACTER FILEH*(*)
|
||
|
C AUTHOR: RODGER STADEN
|
||
|
INTEGER RELPG(IDBSIZ)
|
||
|
INTEGER LNGTHG(IDBSIZ),LNBR(IDBSIZ),RNBR(IDBSIZ)
|
||
|
CHARACTER NAMPRO*(*),NAMARC*10,GEL(MAXGEL)
|
||
|
CHARACTER V2,V1
|
||
|
INTEGER IWORD,DELDB
|
||
|
PARAMETER (IWORD=4)
|
||
|
PARAMETER (MAXPRM = 21)
|
||
|
CHARACTER PERR(2)*(MAXPRM)
|
||
|
EXTERNAL DELDB
|
||
|
IERR=1
|
||
|
1 CONTINUE
|
||
|
L = 1
|
||
|
V1='1'
|
||
|
CALL GTSTR('Make version',V1,V2,L,KBOUT,KBIN,INFLAG)
|
||
|
CALL CCASE(V2,1)
|
||
|
IF(INFLAG.EQ.2) RETURN
|
||
|
IF(INFLAG.EQ.1) THEN
|
||
|
CALL HELP2(IHELPS,IHELPE,FILEH,IDEVH,KBIN,KBOUT)
|
||
|
GO TO 1
|
||
|
END IF
|
||
|
IF(L.LT.1) V2 = V1
|
||
|
MN = NGELS + NCONTS + 1
|
||
|
MX = MAXDB
|
||
|
NEWSIZ = IDBSIZ
|
||
|
CALL GETINT(MN,MX,NEWSIZ,
|
||
|
+'New database size',
|
||
|
+IVAL,KBIN,KBOUT,IHELPS,IHELPE,FILEH,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) RETURN
|
||
|
CALL BUSY(KBOUT)
|
||
|
NEWSIZ = IVAL
|
||
|
C WHERE SHOULD CHARS BE CHANGED ?
|
||
|
LLL = INDEX(NAMPRO,'.') + 1
|
||
|
NAMPRO(LLL:)='RL'//V2
|
||
|
CALL OPENRS(IDEV,NAMPRO,IOK,4,3)
|
||
|
IF(IOK.NE.0) THEN
|
||
|
C problem opening file
|
||
|
IF(IOK.EQ.2) THEN
|
||
|
CALL ERROM(KBOUT,'File already exists')
|
||
|
PERR(1) = 'Retype version number'
|
||
|
PERR(2) = 'Replace database'
|
||
|
IDO = 1
|
||
|
CALL RADION('Select action',PERR,2,IDO,
|
||
|
+ IHELPS,IHELPE,FILEH,IDEVH,KBIN,KBOUT)
|
||
|
IF(IDO.LT.1) RETURN
|
||
|
IF(IDO.EQ.1) GO TO 1
|
||
|
IF(IDO.EQ.2) THEN
|
||
|
IOK = DELDB(NAMPRO,V2,IDEV,MAXGEL)
|
||
|
IF(IOK.EQ.0) THEN
|
||
|
LLL = INDEX(NAMPRO,'.') + 1
|
||
|
NAMPRO(LLL:)='RL'//V2
|
||
|
CALL OPENRS(IDEV,NAMPRO,IOK,4,3)
|
||
|
IF(IOK.EQ.0) GO TO 2
|
||
|
ELSE
|
||
|
CALL ERROM(KBOUT,'File delete failed')
|
||
|
END IF
|
||
|
END IF
|
||
|
END IF
|
||
|
GO TO 100
|
||
|
END IF
|
||
|
2 CONTINUE
|
||
|
CALL WRITER(IDEV,NEWSIZ,NGELS,NCONTS,NGELS,NCONTS)
|
||
|
DO 10 I=1,NGELS
|
||
|
CALL WRITER(IDEV,I,RELPG(I),LNGTHG(I),LNBR(I),RNBR(I))
|
||
|
10 CONTINUE
|
||
|
M=NEWSIZ-NCONTS
|
||
|
N=IDBSIZ-NCONTS
|
||
|
DO 15 I=N,IDBSIZ-1
|
||
|
CALL WRITER(IDEV,M,RELPG(I),LNGTHG(I),LNBR(I),RNBR(I))
|
||
|
M=M+1
|
||
|
15 CONTINUE
|
||
|
CLOSE(UNIT=IDEV)
|
||
|
C DO SEQUENCES
|
||
|
NAMPRO(LLL:)='SQ'//V2
|
||
|
IREC=MAXGEL/IWORD
|
||
|
IF(MOD(MAXGEL,IWORD).NE.0)IREC=IREC+1
|
||
|
CALL OPENRS(IDEV,NAMPRO,IOK,IREC,3)
|
||
|
IF(IOK.NE.0)GO TO 100
|
||
|
C
|
||
|
C MAKE SURE FILE IS NEWSIZ LINES LONG!
|
||
|
CALL WRITEW(IDEV,NEWSIZ,GEL,MAXGEL)
|
||
|
DO 20 I=1,NGELS
|
||
|
CALL READW(IDEVW,I,GEL,MAXGEL)
|
||
|
CALL WRITEW(IDEV,I,GEL,MAXGEL)
|
||
|
20 CONTINUE
|
||
|
CLOSE(UNIT=IDEV)
|
||
|
C DO ARCHIVE NAMES
|
||
|
NAMPRO(LLL:)='AR'//V2
|
||
|
CALL OPENRS(IDEV,NAMPRO,IOK,3,3)
|
||
|
IF(IOK.NE.0)GO TO 100
|
||
|
DO 30 I=1,NGELS
|
||
|
CALL READN(IDEVN,I,NAMARC)
|
||
|
CALL WRITEN(IDEV,I,NAMARC)
|
||
|
30 CONTINUE
|
||
|
C MAKE SURE FILE IS 1000 LINES LONG
|
||
|
C ******** PROBLEMS HERE WRITING INTEGER TO NAMES FILE
|
||
|
WRITE(IDEV,REC=MAXDB)NEWSIZ,MAXGEL,IDM
|
||
|
CLOSE(UNIT=IDEV)
|
||
|
IERR=0
|
||
|
RETURN
|
||
|
100 CONTINUE
|
||
|
WRITE(KBOUT,9999)
|
||
|
9999 FORMAT(' Error opening new database, copy aborted')
|
||
|
RETURN
|
||
|
END
|
||
|
INTEGER FUNCTION DELDB(NAMPRO,VERSN,IDEV,MAXGEL)
|
||
|
CHARACTER NAMPRO*(*),VERSN
|
||
|
INTEGER DELF
|
||
|
EXTERNAL DELF
|
||
|
C
|
||
|
C delete an xdap database
|
||
|
C
|
||
|
C assume relationships are 4 words, names are 3 and seqs are maxgel
|
||
|
C all recls in BYTES
|
||
|
C
|
||
|
DELDB = 1
|
||
|
LLL = INDEX(NAMPRO,'.') + 1
|
||
|
NAMPRO(LLL:)='RL'//VERSN
|
||
|
IF(DELF(NAMPRO,IDEV,16,4).NE.0) RETURN
|
||
|
NAMPRO(LLL:)='AR'//VERSN
|
||
|
IF(DELF(NAMPRO,IDEV,12,4).NE.0) RETURN
|
||
|
NAMPRO(LLL:)='SQ'//VERSN
|
||
|
IF(DELF(NAMPRO,IDEV,MAXGEL,4).NE.0) RETURN
|
||
|
DELDB = 0
|
||
|
END
|
||
|
SUBROUTINE DBFIX(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+GEL,GEL2,IDBSIZ,KBIN,KBOUT,IDEVR,IDEVW,IDEVN,
|
||
|
+IHELPS,IHELPE,IHELP1,IHELP2,FILEH,IDEVH,MAXGEL)
|
||
|
CHARACTER FILEH*(*)
|
||
|
C AUTHOR: RODGER STADEN
|
||
|
INTEGER RELPG(IDBSIZ),X
|
||
|
INTEGER LNGTHG(IDBSIZ),LNBR(IDBSIZ),RNBR(IDBSIZ)
|
||
|
CHARACTER GEL(MAXGEL)
|
||
|
CHARACTER NAME*10,NEWNAM*10
|
||
|
PARAMETER (MAXPRM = 32)
|
||
|
CHARACTER PROMPT(8)*(MAXPRM)
|
||
|
INTEGER L,M,N
|
||
|
CHARACTER GEL2(MAXGEL)
|
||
|
INTEGER GCLIN,CHAINL
|
||
|
EXTERNAL GCLIN,CHAINL
|
||
|
WRITE(KBOUT,1000)
|
||
|
1000 FORMAT(
|
||
|
+' Warning:',
|
||
|
+' make a copy first, and check logical consistency after use')
|
||
|
10 CONTINUE
|
||
|
C
|
||
|
C SELECT OPTION
|
||
|
C CALL BELL(1,KBOUT)
|
||
|
C CALL DBMENU(4,NOPT,IHELPS,IHELPE,FILEH,IDEVH,
|
||
|
C +KBIN,KBOUT)
|
||
|
PROMPT(1) = 'Line change'
|
||
|
PROMPT(2) = 'Edit gel reading'
|
||
|
PROMPT(3) = 'Delete contig line'
|
||
|
PROMPT(4) = 'Shift'
|
||
|
PROMPT(5) = 'Move gel reading'
|
||
|
PROMPT(6) = 'Rename gel reading'
|
||
|
PROMPT(7) = 'Break a contig'
|
||
|
PROMPT(8) = 'Remove a gel reading'
|
||
|
NOPT = 1
|
||
|
CALL RADION('Alter relationships', PROMPT, 8, NOPT, IHELPS,
|
||
|
+ IHELPE, FILEH, IDEVH, KBIN, KBOUT)
|
||
|
IF(NOPT.LT.1)RETURN
|
||
|
IF(NOPT.EQ.-1)RETURN
|
||
|
IF(NOPT.EQ.1)THEN
|
||
|
C LINE CHANGE
|
||
|
MN = 0
|
||
|
MX = IDBSIZ
|
||
|
LNO = 0
|
||
|
CALL GETINT(MN,MX,LNO,
|
||
|
+ 'Number of line to change',
|
||
|
+ IVAL,KBIN,KBOUT,
|
||
|
+ IHELPS,IHELPE,FILEH,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) GO TO 10
|
||
|
IF(IVAL.EQ.0) GO TO 10
|
||
|
LNO = IVAL
|
||
|
IF(LNO.EQ.IDBSIZ)GO TO 19
|
||
|
WRITE(KBOUT,*)'Current line'
|
||
|
WRITE(KBOUT,1001)RELPG(LNO),LNGTHG(LNO),LNBR(LNO),RNBR(LNO)
|
||
|
1001 FORMAT(' ',4I6)
|
||
|
MN = 0
|
||
|
MX = 99999
|
||
|
X = RELPG(LNO)
|
||
|
CALL GETINT(MN,MX,X,
|
||
|
+ 'Relative position',
|
||
|
+ IVAL,KBIN,KBOUT,
|
||
|
+ IHELPS,IHELPE,FILEH,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) GO TO 10
|
||
|
X = IVAL
|
||
|
MN = -MAXGEL
|
||
|
MX = 99999
|
||
|
L = LNGTHG(LNO)
|
||
|
CALL GETINT(MN,MX,L,
|
||
|
+ 'Length',
|
||
|
+ IVAL,KBIN,KBOUT,
|
||
|
+ IHELPS,IHELPE,FILEH,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) GO TO 10
|
||
|
L = IVAL
|
||
|
MN = 0
|
||
|
MX = IDBSIZ
|
||
|
M = LNBR(LNO)
|
||
|
CALL GETINT(MN,MX,M,
|
||
|
+ 'Left neighbour',
|
||
|
+ IVAL,KBIN,KBOUT,
|
||
|
+ IHELPS,IHELPE,FILEH,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) GO TO 10
|
||
|
M = IVAL
|
||
|
MN = 0
|
||
|
MX = IDBSIZ
|
||
|
N = RNBR(LNO)
|
||
|
CALL GETINT(MN,MX,N,
|
||
|
+ 'Right neighbour',
|
||
|
+ IVAL,KBIN,KBOUT,
|
||
|
+ IHELPS,IHELPE,FILEH,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) RETURN
|
||
|
N = IVAL
|
||
|
CALL WRITER(IDEVR,LNO,X,L,M,N)
|
||
|
RELPG(LNO)=X
|
||
|
LNGTHG(LNO)=L
|
||
|
LNBR(LNO)=M
|
||
|
RNBR(LNO)=N
|
||
|
GO TO 10
|
||
|
19 CONTINUE
|
||
|
C NCONTS NGELS LINES
|
||
|
MN = 0
|
||
|
MX = IDBSIZ
|
||
|
LL = NGELS
|
||
|
CALL GETINT(MN,MX,LL,
|
||
|
+ 'Number of gel readings',
|
||
|
+ IVAL,KBIN,KBOUT,
|
||
|
+ IHELPS,IHELPE,FILEH,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) GO TO 10
|
||
|
LL = IVAL
|
||
|
MN = 0
|
||
|
MX = IDBSIZ
|
||
|
MM = NCONTS
|
||
|
CALL GETINT(MN,MX,MM,
|
||
|
+ 'Number of contigs',
|
||
|
+ IVAL,KBIN,KBOUT,
|
||
|
+ IHELPS,IHELPE,FILEH,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) GO TO 10
|
||
|
MM = IVAL
|
||
|
CALL WRITER(IDEVR,IDBSIZ,LL,MM,LL,MM)
|
||
|
NGELS=LL
|
||
|
NCONTS=MM
|
||
|
GO TO 10
|
||
|
END IF
|
||
|
C
|
||
|
C
|
||
|
IF(NOPT.EQ.4)THEN
|
||
|
MN = 0
|
||
|
MX = NGELS
|
||
|
LNO = 0
|
||
|
CALL GETINT(MN,MX,LNO,
|
||
|
+ 'Number of first gel reading to shift',
|
||
|
+ IVAL,KBIN,KBOUT,
|
||
|
+ IHELPS,IHELPE,FILEH,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) GO TO 10
|
||
|
IF(IVAL.LT.1) GO TO 10
|
||
|
LNO = IVAL
|
||
|
I = CHAINL(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+ IDBSIZ,LNO)
|
||
|
IF(I.EQ.0)THEN
|
||
|
WRITE(KBOUT,*)
|
||
|
+ 'Problem with this gel reading. Check logical consistency'
|
||
|
WRITE(KBOUT,*)'of database. Shift not done'
|
||
|
GO TO 10
|
||
|
END IF
|
||
|
NCONTO = GCLIN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+ IDBSIZ,I)
|
||
|
IF(NCONTO.EQ.0)THEN
|
||
|
WRITE(KBOUT,*)
|
||
|
+ 'No contig line for this contig. Check logical'
|
||
|
WRITE(KBOUT,*)'consistency of database. Shift not done'
|
||
|
GO TO 10
|
||
|
END IF
|
||
|
MN = 1 - RELPG(LNO)
|
||
|
MX = RELPG(NCONTO) - RELPG(LNO)
|
||
|
X = MN
|
||
|
CALL GETINT(MN,MX,X,
|
||
|
+ 'Distance to shift',
|
||
|
+ IVAL,KBIN,KBOUT,
|
||
|
+ IHELPS,IHELPE,FILEH,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) RETURN
|
||
|
X = IVAL
|
||
|
CALL SHIFTC(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDEVR,
|
||
|
+ IDBSIZ,LNO,NCONTO,X)
|
||
|
WRITE(KBOUT,*)'Shift complete'
|
||
|
GO TO 10
|
||
|
END IF
|
||
|
C
|
||
|
IF(NOPT.EQ.2)THEN
|
||
|
MN = 0
|
||
|
MX = NGELS
|
||
|
LNO = 0
|
||
|
CALL GETINT(MN,MX,LNO,
|
||
|
+ 'Number of gel reading to edit',
|
||
|
+ IVAL,KBIN,KBOUT,
|
||
|
+ IHELPS,IHELPE,FILEH,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) GO TO 10
|
||
|
IF(IVAL.LT.1) GO TO 10
|
||
|
LNO = IVAL
|
||
|
IDIM=ABS(LNGTHG(LNO))
|
||
|
C ALLOW EDITING TO BE RELATIVE TO CONTIG POSITION
|
||
|
ISTART=RELPG(LNO)
|
||
|
CALL READW(IDEVW,LNO,GEL,MAXGEL)
|
||
|
CALL EDITGL(GEL,GEL2,IDIM,KBIN,KBOUT,MAXGEL,
|
||
|
+ IHELP1,IHELP2,FILEH,IDEVH,ISTART)
|
||
|
CALL WRITEW(IDEVW,LNO,GEL,MAXGEL)
|
||
|
LNGTHG(LNO)=SIGN(IDIM,LNGTHG(LNO))
|
||
|
CALL WRITER(IDEVR,LNO,RELPG(LNO),LNGTHG(LNO),
|
||
|
+ LNBR(LNO),RNBR(LNO))
|
||
|
GO TO 10
|
||
|
END IF
|
||
|
IF(NOPT.EQ.3)THEN
|
||
|
MN=IDBSIZ-NCONTS
|
||
|
MX = IDBSIZ - 1
|
||
|
LNO = 0
|
||
|
CALL GETINT(MN,MX,LNO,
|
||
|
+ 'Number of contig line to delete',
|
||
|
+ IVAL,KBIN,KBOUT,
|
||
|
+ IHELPS,IHELPE,FILEH,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) GO TO 10
|
||
|
LNO = IVAL
|
||
|
CALL REMCNL(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDBSIZ,
|
||
|
+ LNO,IDEVR)
|
||
|
GO TO 10
|
||
|
END IF
|
||
|
IF(NOPT.EQ.6)THEN
|
||
|
MN = 0
|
||
|
MX = NGELS
|
||
|
LNO = 0
|
||
|
CALL GETINT(MN,MX,LNO,
|
||
|
+ 'Number of gel reading to rename',
|
||
|
+ IVAL,KBIN,KBOUT,
|
||
|
+ IHELPS,IHELPE,FILEH,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) GO TO 10
|
||
|
IF(IVAL.LT.1) GO TO 10
|
||
|
LNO = IVAL
|
||
|
CALL READN(IDEVN,LNO,NAME)
|
||
|
L = 10
|
||
|
CALL GTSTR('name for gel reading',
|
||
|
+ NAME,NEWNAM,L,KBOUT,KBIN,INFLAG)
|
||
|
IF(L.GT.0)CALL WRITEN(IDEVN,LNO,NEWNAM)
|
||
|
GO TO 10
|
||
|
END IF
|
||
|
IF(NOPT.EQ.5)THEN
|
||
|
MN = 0
|
||
|
MX = NGELS
|
||
|
IFROM = 0
|
||
|
CALL GETINT(MN,MX,IFROM,
|
||
|
+ 'Number of gel reading to move',
|
||
|
+ IVAL,KBIN,KBOUT,
|
||
|
+ IHELPS,IHELPE,FILEH,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) GO TO 10
|
||
|
IF(IVAL.LT.1) GO TO 10
|
||
|
IFROM = IVAL
|
||
|
MN = 0
|
||
|
MX = NGELS
|
||
|
ITO = 0
|
||
|
CALL GETINT(MN,MX,ITO,
|
||
|
+ 'New number for gel reading',
|
||
|
+ IVAL,KBIN,KBOUT,
|
||
|
+ IHELPS,IHELPE,FILEH,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) GO TO 10
|
||
|
IF(IVAL.LT.1) GO TO 10
|
||
|
ITO = IVAL
|
||
|
CALL MOVGEL(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDBSIZ,
|
||
|
+ GEL,IFROM,ITO,IDEVR,IDEVW,IDEVN,MAXGEL,KBOUT)
|
||
|
GO TO 10
|
||
|
END IF
|
||
|
IF(NOPT.EQ.7)THEN
|
||
|
CALL BREAKC(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+ IDBSIZ,KBIN,KBOUT,IDEVR,IDEVW,IDEVN,
|
||
|
+ IHELPS,IHELPE,IHELP1,IHELP2,FILEH,IDEVH,IOK)
|
||
|
GO TO 10
|
||
|
END IF
|
||
|
IF(NOPT.EQ.8) THEN
|
||
|
CALL REMGD(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDBSIZ,
|
||
|
+ KBIN,KBOUT,GEL,MAXGEL,IDEVR,IDEVW,IDEVN,
|
||
|
+ IHELPS,IHELPE,FILEH,IDEVH,IOK)
|
||
|
GO TO 10
|
||
|
END IF
|
||
|
GO TO 10
|
||
|
END
|
||
|
SUBROUTINE REMGD(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDBSIZ,
|
||
|
+KBIN,KBOUT,GEL,MAXGEL,IDEVR,IDEVW,IDEVN,
|
||
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
||
|
INTEGER RELPG(IDBSIZ),LNGTHG(IDBSIZ),LNBR(IDBSIZ),RNBR(IDBSIZ)
|
||
|
CHARACTER HELPF*(*),GEL(MAXGEL)
|
||
|
INTEGER REMME,GCLIN,CHAINL
|
||
|
EXTERNAL GCLIN,CHAINL
|
||
|
C assumes db is logical consistent
|
||
|
WRITE(KBOUT,*)'Remove reading from database'
|
||
|
REMME = NGELS
|
||
|
CALL GETINT(1,NGELS,REMME,
|
||
|
+'Number of reading to remove',
|
||
|
+IVAL,KBIN,KBOUT,
|
||
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) RETURN
|
||
|
REMME = IVAL
|
||
|
I = CHAINL(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+ IDBSIZ,REMME)
|
||
|
ICONT = GCLIN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDBSIZ,I)
|
||
|
IF(ICONT.EQ.0) THEN
|
||
|
WRITE(KBOUT,*)'No contig line for this reading'
|
||
|
IOK = 1
|
||
|
RETURN
|
||
|
END IF
|
||
|
CALL REMGEL(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDBSIZ,
|
||
|
+REMME,ICONT,KBOUT,GEL,MAXGEL,IDEVR,IDEVW,IDEVN)
|
||
|
END
|
||
|
SUBROUTINE REMGEL(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDBSIZ,
|
||
|
+REMME,ICONT,KBOUT,GEL,MAXGEL,IDEVR,IDEVW,IDEVN)
|
||
|
C Routine to remove a reading from a database
|
||
|
C Cases: 1 left end
|
||
|
C 2 right end
|
||
|
C 3 internal and dispensible
|
||
|
C 4 internal and indispensible
|
||
|
C if 1 change contig lnbr, contig length, lnbr of rnbr of remme, relpgs
|
||
|
C if 2 change contig rnbr, contig length, rnbr of lnbr of remme
|
||
|
C if 3 change contig length, lnbr of rnbr of remme rnbr of lnbr of remme
|
||
|
C if 4 need to break contig, then as for 1
|
||
|
C if 1 and 2 then also remove contig line
|
||
|
C for all cases move gel ngels to remme (if remme/=ngels)
|
||
|
C and update line idbsiz
|
||
|
C
|
||
|
INTEGER RELPG(IDBSIZ),LNGTHG(IDBSIZ),LNBR(IDBSIZ),RNBR(IDBSIZ)
|
||
|
INTEGER REMME,CLEN
|
||
|
LOGICAL LEFTE,RIGHTE,DISPEN
|
||
|
CHARACTER GEL(MAXGEL)
|
||
|
EXTERNAL CLEN
|
||
|
LEFTE = .FALSE.
|
||
|
RIGHTE = .FALSE.
|
||
|
DISPEN = .FALSE.
|
||
|
C
|
||
|
C Left end ?
|
||
|
C
|
||
|
IF(LNBR(REMME).EQ.0) LEFTE = .TRUE.
|
||
|
C
|
||
|
C Right end ?
|
||
|
C
|
||
|
IF(RNBR(REMME).EQ.0) RIGHTE = .TRUE.
|
||
|
C
|
||
|
C If both true remove the contig line, then overwrite the gel
|
||
|
C
|
||
|
IF(LEFTE.AND.RIGHTE) THEN
|
||
|
WRITE(KBOUT,*)'Removing reading and contig'
|
||
|
IFROM = NGELS
|
||
|
NGELS = NGELS - 1
|
||
|
CALL REMCNL(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDBSIZ,
|
||
|
+ ICONT,IDEVR)
|
||
|
IF(REMME.NE.IFROM) THEN
|
||
|
WRITE(KBOUT,*)'Renumbering reading',IFROM,' to',REMME
|
||
|
CALL MOVGEL(RELPG,LNGTHG,LNBR,RNBR,NGELS,
|
||
|
+ NCONTS,IDBSIZ,GEL,IFROM,REMME,IDEVR,IDEVW,IDEVN,MAXGEL,KBOUT)
|
||
|
END IF
|
||
|
ELSE IF(LEFTE) THEN
|
||
|
WRITE(KBOUT,*)'Removing reading from left end of contig'
|
||
|
LNBR(ICONT) = RNBR(REMME)
|
||
|
I = 1 - RELPG(RNBR(REMME))
|
||
|
WRITE(KBOUT,*)'Shifting readings in contig by distance=',I
|
||
|
CALL SHIFTC(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDEVR,
|
||
|
+ IDBSIZ,RNBR(REMME),ICONT,I)
|
||
|
I = LNBR(ICONT)
|
||
|
LNBR(I) = 0
|
||
|
CALL WRITER(IDEVR,I,RELPG(I),LNGTHG(I),
|
||
|
+ LNBR(I),RNBR(I))
|
||
|
IFROM = NGELS
|
||
|
IF(REMME.NE.IFROM) THEN
|
||
|
WRITE(KBOUT,*)'Renumbering reading',IFROM,' to',REMME
|
||
|
CALL MOVGEL(RELPG,LNGTHG,LNBR,RNBR,NGELS,
|
||
|
+ NCONTS,IDBSIZ,GEL,IFROM,REMME,IDEVR,IDEVW,IDEVN,MAXGEL,KBOUT)
|
||
|
END IF
|
||
|
NGELS = NGELS - 1
|
||
|
CALL WRITER(IDEVR,IDBSIZ,NGELS,NCONTS,NGELS,NCONTS)
|
||
|
ELSE IF(RIGHTE) THEN
|
||
|
WRITE(KBOUT,*)'Removing reading from right end of contig'
|
||
|
RNBR(ICONT) = LNBR(REMME)
|
||
|
I = RNBR(ICONT)
|
||
|
RNBR(I) = 0
|
||
|
CALL WRITER(IDEVR,I,RELPG(I),LNGTHG(I),
|
||
|
+ LNBR(I),RNBR(I))
|
||
|
RELPG(ICONT) = CLEN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+ IDBSIZ,LNBR(ICONT))
|
||
|
CALL WRITER(IDEVR,ICONT,RELPG(ICONT),LNGTHG(ICONT),
|
||
|
+ LNBR(ICONT),RNBR(ICONT))
|
||
|
IFROM = NGELS
|
||
|
IF(REMME.NE.IFROM) THEN
|
||
|
WRITE(KBOUT,*)'Renumbering reading',IFROM,' to',REMME
|
||
|
CALL MOVGEL(RELPG,LNGTHG,LNBR,RNBR,NGELS,
|
||
|
+ NCONTS,IDBSIZ,GEL,IFROM,REMME,IDEVR,IDEVW,IDEVN,MAXGEL,KBOUT)
|
||
|
END IF
|
||
|
NGELS = NGELS - 1
|
||
|
CALL WRITER(IDEVR,IDBSIZ,NGELS,NCONTS,NGELS,NCONTS)
|
||
|
ELSE
|
||
|
C Is remme indispensible ?
|
||
|
NSTART = RELPG(RNBR(REMME))
|
||
|
I = REMME
|
||
|
10 CONTINUE
|
||
|
I = LNBR(I)
|
||
|
IF(I.NE.0) THEN
|
||
|
IF((RELPG(I)+ABS(LNGTHG(I))-1).LT.NSTART) GO TO 10
|
||
|
DISPEN = .TRUE.
|
||
|
END IF
|
||
|
IF(DISPEN) THEN
|
||
|
WRITE(KBOUT,*)
|
||
|
+ 'Removing dispensible reading from middle of contig'
|
||
|
I = LNBR(REMME)
|
||
|
RNBR(I) = RNBR(REMME)
|
||
|
CALL WRITER(IDEVR,I,RELPG(I),LNGTHG(I),
|
||
|
+ LNBR(I),RNBR(I))
|
||
|
I = RNBR(REMME)
|
||
|
LNBR(I) = LNBR(REMME)
|
||
|
CALL WRITER(IDEVR,I,RELPG(I),LNGTHG(I),
|
||
|
+ LNBR(I),RNBR(I))
|
||
|
IFROM = NGELS
|
||
|
IF(REMME.NE.IFROM) THEN
|
||
|
WRITE(KBOUT,*)'Renumbering reading',IFROM,' to',REMME
|
||
|
CALL MOVGEL(RELPG,LNGTHG,LNBR,RNBR,NGELS,
|
||
|
+ NCONTS,IDBSIZ,GEL,IFROM,REMME,IDEVR,IDEVW,IDEVN,
|
||
|
+ MAXGEL,KBOUT)
|
||
|
END IF
|
||
|
NGELS = NGELS - 1
|
||
|
RELPG(ICONT) = CLEN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+ IDBSIZ,LNBR(ICONT))
|
||
|
CALL WRITER(IDEVR,ICONT,RELPG(ICONT),LNGTHG(ICONT),
|
||
|
+ LNBR(ICONT),RNBR(ICONT))
|
||
|
CALL WRITER(IDEVR,IDBSIZ,NGELS,NCONTS,NGELS,NCONTS)
|
||
|
ELSE
|
||
|
WRITE(KBOUT,*)
|
||
|
+ 'Removing indispensible reading from middle of contig'
|
||
|
WRITE(KBOUT,*)'So breaking contig first'
|
||
|
IR = REMME
|
||
|
IL = LNBR(REMME)
|
||
|
ILO = LNBR(ICONT)
|
||
|
NCONTO = ICONT
|
||
|
NCONTR = IDBSIZ - NCONTS - 1
|
||
|
CALL CBREAK(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDBSIZ,
|
||
|
+ KBOUT,IDEVR,IDEVW,IDEVN,IR,IL,ILO,NCONTO,NCONTR,IOK)
|
||
|
IF(IOK.NE.0) RETURN
|
||
|
WRITE(KBOUT,*)'Removing reading from left end of contig'
|
||
|
ICONT = IDBSIZ - NCONTS
|
||
|
LNBR(ICONT) = RNBR(REMME)
|
||
|
I = 1 - RELPG(RNBR(REMME))
|
||
|
WRITE(KBOUT,*)'Shifting readings in contig by distance=',I
|
||
|
CALL SHIFTC(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDEVR,
|
||
|
+ IDBSIZ,RNBR(REMME),ICONT,I)
|
||
|
I = LNBR(ICONT)
|
||
|
LNBR(I) = 0
|
||
|
CALL WRITER(IDEVR,I,RELPG(I),LNGTHG(I),
|
||
|
+ LNBR(I),RNBR(I))
|
||
|
IFROM = NGELS
|
||
|
IF(REMME.NE.IFROM) THEN
|
||
|
WRITE(KBOUT,*)'Renumbering reading',IFROM,' to',REMME
|
||
|
CALL MOVGEL(RELPG,LNGTHG,LNBR,RNBR,NGELS,
|
||
|
+ NCONTS,IDBSIZ,GEL,IFROM,REMME,IDEVR,IDEVW,IDEVN,
|
||
|
+ MAXGEL,KBOUT)
|
||
|
END IF
|
||
|
NGELS = NGELS - 1
|
||
|
CALL WRITER(IDEVR,IDBSIZ,NGELS,NCONTS,NGELS,NCONTS)
|
||
|
END IF
|
||
|
END IF
|
||
|
END
|
||
|
SUBROUTINE REMCNL(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDBSIZ,
|
||
|
+REMME,IDEVR)
|
||
|
INTEGER RELPG(IDBSIZ),LNGTHG(IDBSIZ),LNBR(IDBSIZ),RNBR(IDBSIZ)
|
||
|
INTEGER REMME
|
||
|
C Routine to remove a contig line from a db
|
||
|
C Loop deals with case of remove top contig
|
||
|
C Move down all lines from above
|
||
|
DO 10 I = REMME,IDBSIZ-NCONTS+1,-1
|
||
|
RELPG(I) = RELPG(I-1)
|
||
|
LNGTHG(I) = LNGTHG(I-1)
|
||
|
LNBR(I) = LNBR(I-1)
|
||
|
RNBR(I) = RNBR(I-1)
|
||
|
CALL WRITER(IDEVR,I,RELPG(I),LNGTHG(I),LNBR(I),RNBR(I))
|
||
|
10 CONTINUE
|
||
|
NCONTS = NCONTS - 1
|
||
|
CALL WRITER(IDEVR,IDBSIZ,NGELS,NCONTS,NGELS,NCONTS)
|
||
|
END
|
||
|
SUBROUTINE MOVGEL(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDBSIZ,
|
||
|
+GEL,FROM,TO,IDEVR,IDEVW,IDEVN,MAXGEL,KBOUT)
|
||
|
C Subroutine to move a gel from line from to line to
|
||
|
C Extended 22-5-91
|
||
|
C AUTHOR: RODGER STADEN
|
||
|
INTEGER RELPG(IDBSIZ),FROM,TO
|
||
|
INTEGER LNGTHG(IDBSIZ),LNBR(IDBSIZ),RNBR(IDBSIZ)
|
||
|
CHARACTER NAMGEL*10,GEL(MAXGEL)
|
||
|
INTEGER GCLIN,CHAINL
|
||
|
LOGICAL LEFTE,RIGHTE
|
||
|
EXTERNAL GCLIN,CHAINL
|
||
|
LEFTE = .FALSE.
|
||
|
RIGHTE = .FALSE.
|
||
|
C
|
||
|
C left end ?
|
||
|
C
|
||
|
IF(LNBR(FROM).EQ.0) LEFTE = .TRUE.
|
||
|
C
|
||
|
C right end ?
|
||
|
C
|
||
|
IF(RNBR(FROM).EQ.0) RIGHTE = .TRUE.
|
||
|
C
|
||
|
C if both true remove the contig line, then overwrite the gel
|
||
|
C
|
||
|
IF(LEFTE.AND.RIGHTE) THEN
|
||
|
NCONTO = GCLIN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+ IDBSIZ,FROM)
|
||
|
IF(NCONTO.EQ.0)THEN
|
||
|
WRITE(KBOUT,*)
|
||
|
+ 'This gel has no left neighbour but does not'
|
||
|
WRITE(KBOUT,*)'appear in a contig line!'
|
||
|
ELSE
|
||
|
LNBR(NCONTO) = TO
|
||
|
RNBR(NCONTO) = TO
|
||
|
CALL WRITER(IDEVR,NCONTO,RELPG(NCONTO),LNGTHG(NCONTO),
|
||
|
+ LNBR(NCONTO),RNBR(NCONTO))
|
||
|
END IF
|
||
|
ELSE IF(LEFTE) THEN
|
||
|
NCONTO = GCLIN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+ IDBSIZ,FROM)
|
||
|
IF(NCONTO.EQ.0)THEN
|
||
|
WRITE(KBOUT,*)
|
||
|
+ 'This gel has no left neighbour but does not'
|
||
|
WRITE(KBOUT,*)'appear in a contig line!'
|
||
|
ELSE
|
||
|
LNBR(NCONTO) = TO
|
||
|
CALL WRITER(IDEVR,NCONTO,RELPG(NCONTO),LNGTHG(NCONTO),
|
||
|
+ LNBR(NCONTO),RNBR(NCONTO))
|
||
|
END IF
|
||
|
ELSE IF(RIGHTE) THEN
|
||
|
I = CHAINL(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+ IDBSIZ,FROM)
|
||
|
NCONTO = GCLIN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+ IDBSIZ,I)
|
||
|
IF(NCONTO.EQ.0)THEN
|
||
|
WRITE(KBOUT,*)
|
||
|
+ 'This gel has no right neighbour and does not'
|
||
|
WRITE(KBOUT,*)'appear in a contig!'
|
||
|
ELSE
|
||
|
IF(RNBR(NCONTO).NE.FROM)THEN
|
||
|
WRITE(KBOUT,*)
|
||
|
+ 'This gel has no right neighbour but does not'
|
||
|
WRITE(KBOUT,*)'appear in a contig line!'
|
||
|
ELSE
|
||
|
RNBR(NCONTO) = TO
|
||
|
CALL WRITER(IDEVR,NCONTO,RELPG(NCONTO),LNGTHG(NCONTO),
|
||
|
+ LNBR(NCONTO),RNBR(NCONTO))
|
||
|
END IF
|
||
|
END IF
|
||
|
END IF
|
||
|
RELPG(TO)=RELPG(FROM)
|
||
|
LNGTHG(TO)=LNGTHG(FROM)
|
||
|
LNBR(TO)=LNBR(FROM)
|
||
|
RNBR(TO)=RNBR(FROM)
|
||
|
CALL READW(IDEVW,FROM,GEL,MAXGEL)
|
||
|
CALL WRITEW(IDEVW,TO,GEL,MAXGEL)
|
||
|
CALL READN(IDEVN,FROM,NAMGEL)
|
||
|
CALL WRITEN(IDEVN,TO,NAMGEL)
|
||
|
CALL WRITER(IDEVR,TO,RELPG(TO),LNGTHG(TO),
|
||
|
+LNBR(TO),RNBR(TO))
|
||
|
C Do neighbours
|
||
|
IF(LNBR(FROM).NE.0) THEN
|
||
|
I=LNBR(FROM)
|
||
|
RNBR(I)=TO
|
||
|
CALL WRITER(IDEVR,I,RELPG(I),LNGTHG(I),
|
||
|
+ LNBR(I),RNBR(I))
|
||
|
END IF
|
||
|
IF(RNBR(FROM).NE.0) THEN
|
||
|
I=RNBR(FROM)
|
||
|
LNBR(I)=TO
|
||
|
CALL WRITER(IDEVR,I,RELPG(I),LNGTHG(I),
|
||
|
+ LNBR(I),RNBR(I))
|
||
|
END IF
|
||
|
END
|
||
|
SUBROUTINE DBOPEN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,NAMPRO,GEL,
|
||
|
+IDBSIS,IDBSIZ,IERR,KBIN,KBOUT,IDEVR,IDEVW,IDEVN,MAXGEL,MAXGLM,
|
||
|
+LLINO,
|
||
|
+IDM,IHELPS,IHELPE,HELPF,IDEVH)
|
||
|
C AUTHOR: RODGER STADEN
|
||
|
CHARACTER GEL(MAXGLM)
|
||
|
INTEGER RELPG(IDBSIS)
|
||
|
INTEGER LNGTHG(IDBSIS),LNBR(IDBSIS),RNBR(IDBSIS)
|
||
|
CHARACTER NAMPRO*(*),COPYNO*4,HELPF*(*)
|
||
|
INTEGER IWORD,ANS
|
||
|
PARAMETER (IWORD=4)
|
||
|
C NOTE THIS IS THE MACHINES WORD LENGTH IE HOW MANY CHARS PER WORD
|
||
|
CALL FILLI(RELPG,IDBSIS,0)
|
||
|
CALL FILLI(LNGTHG,IDBSIS,0)
|
||
|
CALL FILLI(LNBR,IDBSIS,0)
|
||
|
CALL FILLI(RNBR,IDBSIS,0)
|
||
|
NAMPRO(1:)=' '
|
||
|
IERR=1
|
||
|
1 CONTINUE
|
||
|
L = 0
|
||
|
CALL GTSTR('Project name',' ',NAMPRO,L,KBOUT,KBIN,INFLAG)
|
||
|
IF(L.LT.1) RETURN
|
||
|
LL = L
|
||
|
CALL CCASE(NAMPRO,1)
|
||
|
IF(INFLAG.EQ.2) RETURN
|
||
|
IF(INFLAG.EQ.1) THEN
|
||
|
CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
||
|
GO TO 1
|
||
|
END IF
|
||
|
L = 1
|
||
|
CALL GTSTR('Version','0',COPYNO,L,KBOUT,KBIN,INFLAG)
|
||
|
CALL CCASE(COPYNO,1)
|
||
|
IF(INFLAG.EQ.2) RETURN
|
||
|
IF(INFLAG.EQ.1) THEN
|
||
|
CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
||
|
GO TO 1
|
||
|
END IF
|
||
|
IF(L.LT.1) COPYNO(1:1) = '0'
|
||
|
C GET .ARN FIRST AS IT CONTAINS LENGTH OF OTHER FILES
|
||
|
NAMPRO(LL+1:LL+1)='.'
|
||
|
NAMPRO(LL+2:LL+2)='A'
|
||
|
NAMPRO(LL+3:LL+3)='R'
|
||
|
NAMPRO(LL+4:LL+4)=COPYNO(1:1)
|
||
|
CALL OPENRS(IDEVN,NAMPRO,IOK,3,4)
|
||
|
IF(IOK.NE.0)GO TO 100
|
||
|
C ******* PROBLEM HERE READING RECORD 1000 AND INTEGER FROM IDEVN!!!
|
||
|
READ(IDEVN,REC=IDBSIS,ERR=50)IDBSIZ,MAXGEL,IDM
|
||
|
IF(MAXGEL.LT.512)GO TO 50
|
||
|
IF(MAXGEL.GT.MAXGLM)GO TO 50
|
||
|
IF(MOD(MAXGEL,512).NE.0)GO TO 50
|
||
|
20 CONTINUE
|
||
|
IF((IDM.NE.5).AND.(IDM.NE.26))GO TO 51
|
||
|
21 CONTINUE
|
||
|
NAMPRO(LL+2:LL+2)='R'
|
||
|
NAMPRO(LL+3:LL+3)='L'
|
||
|
CALL OPENRS(IDEVR,NAMPRO,IOK,4,4)
|
||
|
IF(IOK.NE.0)GO TO 100
|
||
|
NAMPRO(LL+2:LL+2)='S'
|
||
|
NAMPRO(LL+3:LL+3)='Q'
|
||
|
C DEFINE RECORD LENGTH IN TERMS OF NUMBER OF CHARS PER WORD (4 ON VAX)
|
||
|
C AND MAXGEL SIZE
|
||
|
IREC=MAXGEL/IWORD
|
||
|
IF(MOD(MAXGEL,IWORD).NE.0)IREC=IREC+1
|
||
|
CALL OPENRS(IDEVW,NAMPRO,IOK,IREC,4)
|
||
|
IF(IOK.NE.0)GO TO 100
|
||
|
C READ A LINE FOR LUCK
|
||
|
CALL READW(IDEVW,1,GEL,MAXGEL)
|
||
|
CALL READR(IDEVR,IDBSIZ,NGELS,NCONTS,IDUM1,IDUM2)
|
||
|
WRITE(KBOUT,10011)NGELS,NCONTS,IDBSIZ,MAXGEL
|
||
|
10011 FORMAT(' Number of gel readings=',I3,' Number of contigs=',I3,/,
|
||
|
+' Database size=',I4,' Maximum gel reading length=',I4)
|
||
|
LLINO = 0
|
||
|
IF(NGELS.LT.1)GO TO 5
|
||
|
DO 3 I=1,NGELS
|
||
|
CALL READR(IDEVR,I,RELPG(I),LNGTHG(I),LNBR(I),RNBR(I))
|
||
|
3 CONTINUE
|
||
|
N=IDBSIZ-NCONTS
|
||
|
MXT = 0
|
||
|
DO 4 I=N,IDBSIZ-1
|
||
|
CALL READR(IDEVR,I,RELPG(I),LNGTHG(I),LNBR(I),RNBR(I))
|
||
|
IF(RELPG(I).GT.MXT) THEN
|
||
|
MXT = RELPG(I)
|
||
|
LLINO = LNBR(I)
|
||
|
END IF
|
||
|
4 CONTINUE
|
||
|
5 CONTINUE
|
||
|
NAMPRO(LL+2:LL+2) = COPYNO(1:1)
|
||
|
IERR=0
|
||
|
RETURN
|
||
|
100 CONTINUE
|
||
|
WRITE(KBOUT,9999)
|
||
|
9999 FORMAT(' Error encountered opening database files')
|
||
|
NAMPRO(LL+2:LL+2) = COPYNO(1:1)
|
||
|
RETURN
|
||
|
50 CONTINUE
|
||
|
WRITE(KBOUT,2000)MAXGLM
|
||
|
2000 FORMAT(' Error reading maximum gel reading length',/,
|
||
|
+' The maximum gel reading length must be a multiple',
|
||
|
+' of 512.',/,' E.G. 512, 1024, 1536, 2048, etc up to',I6)
|
||
|
MN = 512
|
||
|
MX = MAXGLM
|
||
|
MAXIN1 = MN
|
||
|
CALL GETINT(MN,MX,MAXIN1,
|
||
|
+'Maximum gel reading length',
|
||
|
+IVAL,KBIN,KBOUT,IHELPS,IHELPE,FILEH,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) RETURN
|
||
|
MAXGEL = IVAL
|
||
|
IF(MOD(MAXGEL,MAXIN1).NE.0)GO TO 50
|
||
|
C PROBLEM WRITING TO RECORD IDBSIZ WITH NO SUBROUTINE CALL!!!!!!!!!!
|
||
|
WRITE(IDEVN,REC=IDBSIS)IDBSIZ,MAXGEL
|
||
|
GO TO 20
|
||
|
51 CONTINUE
|
||
|
WRITE(KBOUT,2003)
|
||
|
2003 FORMAT(' Error reading protein or dna label')
|
||
|
CALL YESNO(ANS,'DNA',
|
||
|
+IHELPS,IHELPE,FILEH,IDEVH,KBIN,KBOUT)
|
||
|
IF(ANS.LT.0) RETURN
|
||
|
IF(ANS.EQ.0)IDM = 5
|
||
|
IF(ANS.EQ.1)IDM = 26
|
||
|
C PROBLEM WRITING TO RECORD IDBSIZ WITH NO SUBROUTINE CALL!!!!!!!!!!
|
||
|
WRITE(IDEVN,REC=IDBSIS)IDBSIZ,MAXGEL,IDM
|
||
|
GO TO 21
|
||
|
END
|
||
|
SUBROUTINE DBSTAR(NAMPRO,GEL,IDBSIS,IDBSIZ,KBIN,KBOUT,
|
||
|
+IDEV1,IDEV2,IDEV3,IERR,IHELPS,IHELPE,IDEVH,FILEH,MAXGEL,
|
||
|
+MAXGLM,IDM)
|
||
|
CHARACTER GEL(MAXGLM),FILEH*(*)
|
||
|
CHARACTER NAMPRO*(*)
|
||
|
INTEGER IWORD
|
||
|
PARAMETER (IWORD=4)
|
||
|
C WRITE(KBOUT,1005)
|
||
|
1005 FORMAT(
|
||
|
+' Define:',/,
|
||
|
+' 1) the maximum database size ',
|
||
|
+'(= number of gel readings + number of contigs)',/,
|
||
|
+' 2) the maximum gel reading length',/,
|
||
|
+' 3) whether the database is for DNA or protein sequences')
|
||
|
IERR=1
|
||
|
3 CONTINUE
|
||
|
MN = 0
|
||
|
CALL GTSTR('New project name',' ',NAMPRO,MN,KBOUT,KBIN,INFLAG)
|
||
|
IF(MN.LT.1) RETURN
|
||
|
LL = MIN(12,MN)
|
||
|
CALL CCASE(NAMPRO,1)
|
||
|
IF(INFLAG.EQ.2) RETURN
|
||
|
IF(INFLAG.EQ.1) THEN
|
||
|
CALL HELP2(IHELPS,IHELPE,FILEH,IDEVH,KBIN,KBOUT)
|
||
|
GO TO 3
|
||
|
END IF
|
||
|
MN = 10
|
||
|
MX = IDBSIS
|
||
|
IDBSIZ = 50
|
||
|
CALL GETINT(MN,MX,IDBSIZ,
|
||
|
+'Database size',
|
||
|
+IVAL,KBIN,KBOUT,
|
||
|
+IHELPS,IHELPE,FILEH,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) RETURN
|
||
|
IDBSIZ = IVAL
|
||
|
5 CONTINUE
|
||
|
MN = 512
|
||
|
MX = MAXGLM
|
||
|
MAXIN1 = MIN(512,MAXGEL)
|
||
|
CALL GETINT(MN,MX,MAXIN1,
|
||
|
+'Maximum gel reading length',
|
||
|
+IVAL,KBIN,KBOUT,
|
||
|
+IHELPS,IHELPE,FILEH,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) RETURN
|
||
|
MAXGEL = IVAL
|
||
|
IF(MOD(IVAL,MAXIN1).NE.0) THEN
|
||
|
MAXGEL = 512 + (IVAL/512)*512
|
||
|
WRITE(KBOUT,*)'Maximum set to',MAXGEL
|
||
|
END IF
|
||
|
CALL YESNO(IDM,'Database is for DNA',
|
||
|
+IHELPS,IHELPE,FILEH,IDEVH,KBIN,KBOUT)
|
||
|
IF(IDM.LT.0) RETURN
|
||
|
IF(IDM.EQ.0)IDM = 5
|
||
|
IF(IDM.EQ.1)IDM = 26
|
||
|
NAMPRO(LL+1:LL+1)='.'
|
||
|
NAMPRO(LL+2:LL+2)='R'
|
||
|
NAMPRO(LL+3:LL+3)='L'
|
||
|
NAMPRO(LL+4:LL+4)='0'
|
||
|
CALL OPENRS(IDEV1,NAMPRO,IOK,4,3)
|
||
|
IF(IOK.NE.0)GO TO 100
|
||
|
WRITE(KBOUT,1004)
|
||
|
1004 FORMAT(' Writing new database files')
|
||
|
J = 0
|
||
|
K = 0
|
||
|
N = 0
|
||
|
M = 0
|
||
|
DO 10 I=1,IDBSIZ
|
||
|
CALL WRITER(IDEV1,I,J,K,M,N)
|
||
|
10 CONTINUE
|
||
|
NAMPRO(LL+2:LL+2)='S'
|
||
|
NAMPRO(LL+3:LL+3)='Q'
|
||
|
IREC=MAXGEL/IWORD
|
||
|
IF(MOD(MAXGEL,IWORD).NE.0)IREC=IREC+1
|
||
|
CALL OPENRS(IDEV2,NAMPRO,IOK,IREC,3)
|
||
|
IF(IOK.NE.0)GO TO 100
|
||
|
CALL FILLC(GEL,MAXGEL,' ')
|
||
|
CALL WRITEW(IDEV2,IDBSIZ,GEL,MAXGEL)
|
||
|
NAMPRO(LL+2:LL+2)='A'
|
||
|
NAMPRO(LL+3:LL+3)='R'
|
||
|
CALL OPENRS(IDEV3,NAMPRO,IOK,3,3)
|
||
|
IF(IOK.NE.0)GO TO 100
|
||
|
C NOTE HERE IS A WRITE TO NAMES FILE NOT USING A SUBROUTINE CALL
|
||
|
WRITE(IDEV3,REC=IDBSIS)IDBSIZ,MAXGEL,IDM
|
||
|
WRITE(KBOUT,1003)NAMPRO(1:LL),IDBSIZ
|
||
|
1003 FORMAT(' Database ',A,' version 0, size',I5,
|
||
|
+' successfully started')
|
||
|
WRITE(KBOUT,1006)NAMPRO(1:LL)
|
||
|
1006 FORMAT(
|
||
|
+' Note the 3 database files are named ',A,'.AR0, .SQ0, .RL0')
|
||
|
IERR=0
|
||
|
NAMPRO(LL+2:LL+2) = '0'
|
||
|
RETURN
|
||
|
100 CONTINUE
|
||
|
WRITE(KBOUT,9999)
|
||
|
9999 FORMAT(' Error when trying to open database,',
|
||
|
+' database not started')
|
||
|
RETURN
|
||
|
END
|
||
|
SUBROUTINE ENTER(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+GEL,GEL2,IDBSIZ,IDEV,KBIN,KBOUT,IDEVR,IDEVW,IDEVN,IDEVG,
|
||
|
+LINLEN,PERCD,NAMARC,
|
||
|
+HELPS1,HELPE1,HELPS2,HELPE2,FILEH,IDEVH,MAXGEL,IDM,NCONTC)
|
||
|
CHARACTER FILEH*(*)
|
||
|
INTEGER HELPS1,HELPS2,HELPE1,HELPE2
|
||
|
C AUTHOR: RODGER STADEN
|
||
|
INTEGER RELPG(IDBSIZ)
|
||
|
INTEGER X,Y,ANS
|
||
|
INTEGER LNGTHG(IDBSIZ),LNBR(IDBSIZ),RNBR(IDBSIZ)
|
||
|
CHARACTER GEL(MAXGEL),NAMARC*(*)
|
||
|
CHARACTER NAMARK*10
|
||
|
CHARACTER GEL2(MAXGEL)
|
||
|
C WRITE(KBOUT,1000)
|
||
|
C1000 FORMAT(
|
||
|
C +' Enter a new gel reading into the database.',//,
|
||
|
C +' Note that before a gel reading is entered into the',/,
|
||
|
C +' database it must be compared with the database to ',/,
|
||
|
C +' search for overlaps using a function such as auto assemble',/,
|
||
|
C +' The replies to all the questions that follow are given',/,
|
||
|
C +' by these searches',//)
|
||
|
IF((IDBSIZ-(NGELS+NCONTS)).GT.2)GO TO 5
|
||
|
WRITE(KBOUT,1999)IDBSIZ
|
||
|
1999 FORMAT(' Current database size=',I5,' extend with copy')
|
||
|
RETURN
|
||
|
5 CONTINUE
|
||
|
C WRITE(KBOUT,1018)
|
||
|
C1018 FORMAT(
|
||
|
C +' We need the name of the file containing the gel reading')
|
||
|
NAMARC = ' '
|
||
|
CALL OPENF1(IDEVG,NAMARC,0,IOK,KBIN,KBOUT,
|
||
|
+'File name of gel reading to enter',
|
||
|
+HELPS1,HELPE1,FILEH,IDEVH)
|
||
|
IF(IOK.NE.0)RETURN
|
||
|
IF(NGELS.GT.0) THEN
|
||
|
DO 10 J=1,NGELS
|
||
|
CALL READN(IDEVN,J,NAMARK)
|
||
|
IF(NAMARC(1:10).NE.NAMARK)GO TO 10
|
||
|
WRITE(KBOUT,1013)J
|
||
|
1013 FORMAT( ' Gel reading already in database (number,',I6,
|
||
|
+ '), entry aborted')
|
||
|
RETURN
|
||
|
10 CONTINUE
|
||
|
END IF
|
||
|
IDIM=MAXGEL
|
||
|
CALL ARRFIM(IDEVG,GEL,IDIM,KBOUT)
|
||
|
CLOSE(UNIT=IDEVG)
|
||
|
NGELS=NGELS+1
|
||
|
LNGTHG(NGELS)=IDIM
|
||
|
NAMARK=NAMARC(1:10)
|
||
|
CALL WRITEN(IDEVN,NGELS,NAMARK)
|
||
|
WRITE(KBOUT,1003)NGELS
|
||
|
1003 FORMAT( ' This gel reading has been given the number ',I6)
|
||
|
ANS=0
|
||
|
IF(NGELS.GT.1)THEN
|
||
|
C WRITE(KBOUT,1017)
|
||
|
C1017 FORMAT(
|
||
|
C +' We need to know if the gel reading overlaps data already in',
|
||
|
C +' the database')
|
||
|
CALL YESNO(ANS,'New gel overlaps a contig',
|
||
|
+ HELPS1,HELPE1,FILEH,IDEVH,KBIN,KBOUT)
|
||
|
IF(ANS.LT.0) THEN
|
||
|
NGELS = NGELS - 1
|
||
|
RETURN
|
||
|
END IF
|
||
|
IF(ANS.EQ.0)GO TO 100
|
||
|
END IF
|
||
|
C
|
||
|
C DOES NOT OVERLAP SO IT STARTS A CONTIG OF ITS OWN
|
||
|
LNBR(NGELS)=0
|
||
|
RNBR(NGELS)=0
|
||
|
RELPG(NGELS)=1
|
||
|
CALL WRITER(IDEVR,NGELS,RELPG(NGELS),LNGTHG(NGELS),
|
||
|
+LNBR(NGELS),RNBR(NGELS))
|
||
|
NCONTS=NCONTS+1
|
||
|
N=IDBSIZ-NCONTS
|
||
|
LNBR(N)=NGELS
|
||
|
RNBR(N)=NGELS
|
||
|
RELPG(N)=(IDIM)
|
||
|
CALL WRITER(IDEVR,N,RELPG(N),LNGTHG(N),
|
||
|
+LNBR(N),RNBR(N))
|
||
|
CALL WRITER(IDEVR,IDBSIZ,NGELS,NCONTS,NGELS,NCONTS)
|
||
|
CALL WRITEW(IDEVW,NGELS,GEL,MAXGEL)
|
||
|
RETURN
|
||
|
C
|
||
|
100 CONTINUE
|
||
|
C WRITE(KBOUT,1019)
|
||
|
C1019 FORMAT(
|
||
|
C +' We need to know if the new gel reading overlaps in the',/,
|
||
|
C +' normal or complementary sense')
|
||
|
C COMPLEMENT GEL IF REQUIRED
|
||
|
CALL YESNO(ANS,'Gel overlaps in normal sense',
|
||
|
+HELPS1,HELPE1,FILEH,IDEVH,KBIN,KBOUT)
|
||
|
IF(ANS.LT.0) THEN
|
||
|
NGELS = NGELS - 1
|
||
|
RETURN
|
||
|
END IF
|
||
|
IF(ANS.EQ.1) THEN
|
||
|
CALL SQREV(GEL,IDIM)
|
||
|
CALL SQCOM(GEL,IDIM)
|
||
|
LNGTHG(NGELS)=-1*LNGTHG(NGELS)
|
||
|
END IF
|
||
|
C WRITE(KBOUT,1020)
|
||
|
C1020 FORMAT(
|
||
|
C +' We need to know which contig the new gel reading overlaps')
|
||
|
CALL GETLN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,LINCON,NCONTC,
|
||
|
+IERR,IDBSIZ,KBIN,KBOUT,IDEVN,
|
||
|
+HELPS1,HELPE1,FILEH,IDEVH)
|
||
|
IF(IERR.NE.0) THEN
|
||
|
NGELS=NGELS-1
|
||
|
RETURN
|
||
|
END IF
|
||
|
C WRITE(KBOUT,1014)
|
||
|
C1014 FORMAT(
|
||
|
C +' We need information about the position of the overlap.',/,
|
||
|
C +' First there are two types: those that extend the contig',/,
|
||
|
C +' leftwards and those that start internally.')
|
||
|
CALL YESNO(ANS,'Left end of gel reading is inside contig',
|
||
|
+ HELPS1,HELPE1,FILEH,IDEVH,KBIN,KBOUT)
|
||
|
IF(ANS.LT.0)THEN
|
||
|
NGELS=NGELS-1
|
||
|
RETURN
|
||
|
END IF
|
||
|
IF(ANS.EQ.1)GO TO 400
|
||
|
C RIGHT END OR INTERNAL OVERLAP
|
||
|
C
|
||
|
C WRITE(KBOUT,1015)
|
||
|
C1015 FORMAT(' Now we need to know the exact position of the overlap')
|
||
|
160 CONTINUE
|
||
|
MN = 1
|
||
|
MX = RELPG(LINCON)
|
||
|
X = 0
|
||
|
CALL GETINT(MN,MX,X,
|
||
|
+'Position in contig of left end of gel reading',
|
||
|
+IVAL,KBIN,KBOUT,
|
||
|
+HELPS1,HELPE1,FILEH,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) THEN
|
||
|
NGELS = NGELS - 1
|
||
|
RETURN
|
||
|
END IF
|
||
|
X = IVAL
|
||
|
IF(X.EQ.0)GO TO 160
|
||
|
N=NCONTC
|
||
|
200 CONTINUE
|
||
|
IF(RELPG(N).GT.X)GO TO 250
|
||
|
IF(RNBR(N).EQ.0)GO TO 350
|
||
|
N=RNBR(N)
|
||
|
GO TO 200
|
||
|
250 CONTINUE
|
||
|
C GEL LIES BETWEEN N AND LNBR(N)
|
||
|
C DISPLAY JOINT
|
||
|
NOPT = 1
|
||
|
CALL BEDIN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+GEL,GEL2,LINCON,NCONTC,NOPT,X,IDBSIZ,IDEV,KBIN,KBOUT,
|
||
|
+IDEVR,IDEVW,IDEVN,LINLEN,PERCD,
|
||
|
+HELPS1,HELPE1,HELPS2,HELPE2,FILEH,IDEVH,MAXGEL,IDM)
|
||
|
C CHECK ON RESULT
|
||
|
IF(NOPT.EQ.1)GO TO 160
|
||
|
IF(NOPT.EQ.3)GO TO 260
|
||
|
C COCKUP
|
||
|
NGELS=NGELS-1
|
||
|
RETURN
|
||
|
260 CONTINUE
|
||
|
CALL WRITEW(IDEVW,NGELS,GEL,MAXGEL)
|
||
|
LNBR(NGELS)=LNBR(N)
|
||
|
RNBR(NGELS)=N
|
||
|
RELPG(NGELS)=X
|
||
|
CALL WRITER(IDEVR,NGELS,RELPG(NGELS),LNGTHG(NGELS),
|
||
|
+LNBR(NGELS),RNBR(NGELS))
|
||
|
RNBR(LNBR(N))=NGELS
|
||
|
K=LNBR(N)
|
||
|
CALL WRITER(IDEVR,K,RELPG(K),LNGTHG(K),
|
||
|
+LNBR(K),RNBR(K))
|
||
|
LNBR(N)=NGELS
|
||
|
CALL WRITER(IDEVR,N,RELPG(N),LNGTHG(N),
|
||
|
+LNBR(N),RNBR(N))
|
||
|
CALL WRITER(IDEVR,IDBSIZ,NGELS,NCONTS,NGELS,NCONTS)
|
||
|
IDIM=ABS(LNGTHG(NGELS))
|
||
|
Y=X+(IDIM)-1
|
||
|
IF(Y.LE.RELPG(LINCON))RETURN
|
||
|
RELPG(LINCON)=Y
|
||
|
CALL WRITER(IDEVR,LINCON,RELPG(LINCON),LNGTHG(LINCON),
|
||
|
+LNBR(LINCON),RNBR(LINCON))
|
||
|
RETURN
|
||
|
350 CONTINUE
|
||
|
C MUST BE A RIGHT END OVERLAP
|
||
|
C DSPLAY JOINT
|
||
|
NOPT = 1
|
||
|
CALL BEDIN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+GEL,GEL2,LINCON,NCONTC,NOPT,X,IDBSIZ,IDEV,KBIN,KBOUT,
|
||
|
+IDEVR,IDEVW,IDEVN,LINLEN,PERCD,
|
||
|
+HELPS1,HELPE1,HELPS2,HELPE2,FILEH,IDEVH,MAXGEL,IDM)
|
||
|
IF(NOPT.EQ.1)GO TO 160
|
||
|
IF(NOPT.EQ.3)GO TO 360
|
||
|
C COCKUP
|
||
|
NGELS=NGELS-1
|
||
|
RETURN
|
||
|
360 CONTINUE
|
||
|
CALL WRITEW(IDEVW,NGELS,GEL,MAXGEL)
|
||
|
LNBR(NGELS)=N
|
||
|
RNBR(NGELS)=0
|
||
|
RELPG(NGELS)=X
|
||
|
CALL WRITER(IDEVR,NGELS,RELPG(NGELS),LNGTHG(NGELS),
|
||
|
+LNBR(NGELS),RNBR(NGELS))
|
||
|
RNBR(N)=NGELS
|
||
|
CALL WRITER(IDEVR,N,RELPG(N),LNGTHG(N),
|
||
|
+LNBR(N),RNBR(N))
|
||
|
RNBR(LINCON)=NGELS
|
||
|
IDIM=ABS(LNGTHG(NGELS))
|
||
|
Y=X+(IDIM)-1
|
||
|
RELPG(LINCON)=MAX(RELPG(LINCON),Y)
|
||
|
CALL WRITER(IDEVR,LINCON,RELPG(LINCON),LNGTHG(LINCON),
|
||
|
+LNBR(LINCON),RNBR(LINCON))
|
||
|
CALL WRITER(IDEVR,IDBSIZ,NGELS,NCONTS,NGELS,NCONTS)
|
||
|
RETURN
|
||
|
C
|
||
|
400 CONTINUE
|
||
|
C
|
||
|
C ADDING TO LEFT END
|
||
|
C WRITE(KBOUT,1015)
|
||
|
410 CONTINUE
|
||
|
MN = 1
|
||
|
MX = IDIM
|
||
|
X = 0
|
||
|
CALL GETINT(MN,MX,X,
|
||
|
+'Position in new gel reading of left end of contig',
|
||
|
+IVAL,KBIN,KBOUT,
|
||
|
+HELPS1,HELPE1,FILEH,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) THEN
|
||
|
NGELS = NGELS - 1
|
||
|
RETURN
|
||
|
END IF
|
||
|
X = IVAL
|
||
|
IF(X.EQ.0)GO TO 410
|
||
|
C SET FLAG TO SHOW LEFT END OVERLAP
|
||
|
NOPT=2
|
||
|
CALL BEDIN(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+GEL,GEL2,LINCON,NCONTC,NOPT,X,IDBSIZ,IDEV,KBIN,KBOUT,
|
||
|
+IDEVR,IDEVW,IDEVN,LINLEN,PERCD,
|
||
|
+HELPS1,HELPE1,HELPS2,HELPE2,FILEH,IDEVH,MAXGEL,IDM)
|
||
|
IF(NOPT.EQ.1)GO TO 400
|
||
|
IF(NOPT.EQ.3)GO TO 420
|
||
|
C COCKUP
|
||
|
NGELS=NGELS-1
|
||
|
RETURN
|
||
|
420 CONTINUE
|
||
|
CALL WRITEW(IDEVW,NGELS,GEL,MAXGEL)
|
||
|
RELPG(NGELS)=1
|
||
|
RNBR(NGELS)=NCONTC
|
||
|
LNBR(NGELS)=0
|
||
|
CALL WRITER(IDEVR,NGELS,RELPG(NGELS),LNGTHG(NGELS),
|
||
|
+LNBR(NGELS),RNBR(NGELS))
|
||
|
LNBR(NCONTC)=NGELS
|
||
|
RELPG(NCONTC)=X
|
||
|
CALL WRITER(IDEVR,NCONTC,RELPG(NCONTC),LNGTHG(NCONTC),
|
||
|
+LNBR(NCONTC),RNBR(NCONTC))
|
||
|
RELPG(LINCON)=RELPG(LINCON)+X-1
|
||
|
IDIM=ABS(LNGTHG(NGELS))
|
||
|
Y=IDIM
|
||
|
IF(Y.GT.RELPG(LINCON))RELPG(LINCON)=Y
|
||
|
LNBR(LINCON)=NGELS
|
||
|
CALL WRITER(IDEVR,LINCON,RELPG(LINCON),LNGTHG(LINCON),
|
||
|
+LNBR(LINCON),RNBR(LINCON))
|
||
|
CALL WRITER(IDEVR,IDBSIZ,NGELS,NCONTS,NGELS,NCONTS)
|
||
|
N=NCONTC
|
||
|
440 CONTINUE
|
||
|
IF(RNBR(N).EQ.0)RETURN
|
||
|
N=RNBR(N)
|
||
|
RELPG(N)=RELPG(N)+X-1
|
||
|
CALL WRITER(IDEVR,N,RELPG(N),LNGTHG(N),
|
||
|
+LNBR(N),RNBR(N))
|
||
|
GO TO 440
|
||
|
END
|
||
|
SUBROUTINE PADCON(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+GEL,LINCON,POSN,NC,IDBSIZ,IDEVR,IDEVW,MAXGEL,KBOUT)
|
||
|
C AUTHOR: RODGER STADEN
|
||
|
INTEGER RELPG(IDBSIZ),POSN,X
|
||
|
INTEGER LNGTHG(IDBSIZ),LNBR(IDBSIZ),RNBR(IDBSIZ)
|
||
|
CHARACTER GEL(MAXGEL)
|
||
|
CHARACTER PAD
|
||
|
SAVE PAD
|
||
|
DATA PAD/'*'/
|
||
|
C NOW FIND FIRST CHAR THAT OVERLAPS REGION
|
||
|
LLINO=LNBR(LINCON)
|
||
|
30 CONTINUE
|
||
|
X=RELPG(LLINO)+ABS(LNGTHG(LLINO))-1
|
||
|
IF(X.GE.POSN)GO TO 40
|
||
|
C NOT IN REGION
|
||
|
LLINO=RNBR(LLINO)
|
||
|
GO TO 30
|
||
|
40 CONTINUE
|
||
|
C NOW GET THIS GEL FROM DISK
|
||
|
C READ(IDEVW,REC=LLINO)GEL
|
||
|
CALL READW(IDEVW,LLINO,GEL,MAXGEL)
|
||
|
C CALC POSN IN THIS GEL TO EDIT
|
||
|
X=POSN-RELPG(LLINO)+1
|
||
|
K=X
|
||
|
C MOVE THE DATA RIGHT
|
||
|
M=ABS(LNGTHG(LLINO))
|
||
|
LNGTHG(LLINO)=LNGTHG(LLINO)+SIGN(NC,LNGTHG(LLINO))
|
||
|
C CHECK FOR OVER END OF ARRAY
|
||
|
N=ABS(LNGTHG(LLINO))
|
||
|
IF(N.GT.MAXGEL)THEN
|
||
|
WRITE(KBOUT,1000)LLINO
|
||
|
1000 FORMAT(
|
||
|
+' Data pushed off end of gel',I4,' during padding')
|
||
|
M=M-(N-MAXGEL)
|
||
|
N=MAXGEL
|
||
|
LNGTHG(LLINO)=SIGN(MAXGEL,LNGTHG(LLINO))
|
||
|
END IF
|
||
|
J=M-K+1
|
||
|
DO 55 I=1,J
|
||
|
GEL(N)=GEL(M)
|
||
|
N=N-1
|
||
|
M=M-1
|
||
|
55 CONTINUE
|
||
|
C PERFORM THE INSERTION
|
||
|
DO 60 I=K,MIN(MAXGEL,K+NC-1)
|
||
|
GEL(I)=PAD
|
||
|
60 CONTINUE
|
||
|
C WRITE BACK TO DISK
|
||
|
CALL WRITEW(IDEVW,LLINO,GEL,MAXGEL)
|
||
|
C WRITE(IDEVW,REC=LLINO)GEL
|
||
|
C WRITE NEW LINE
|
||
|
CALL WRITER(IDEVR,LLINO,RELPG(LLINO),LNGTHG(LLINO),
|
||
|
+LNBR(LLINO),RNBR(LLINO))
|
||
|
C WRITE(IDEVR,REC=LLINO)
|
||
|
C 1RELPG(LLINO),LNGTHG(LLINO),LNBR(LLINO),RNBR(LLINO)
|
||
|
65 CONTINUE
|
||
|
C NOW GET NEXT GEL
|
||
|
LLINO=RNBR(LLINO)
|
||
|
C LAST GEL?
|
||
|
IF(LLINO.EQ.0)GO TO 70
|
||
|
C DOES IT HAVE DATA IN REGION?
|
||
|
C IE DO RELPG AND RELPG+LNGTHG-1 LIE EITHER SIDE OF POSN?
|
||
|
IF(RELPG(LLINO).GT.POSN)GO TO 70
|
||
|
X=RELPG(LLINO)+ABS(LNGTHG(LLINO))-1
|
||
|
IF(X.LT.POSN)GO TO 65
|
||
|
C WITHIN
|
||
|
GO TO 40
|
||
|
70 CONTINUE
|
||
|
C INSERTS FINISHED SO NEED TO INCREMENT ALL THOSE GELS TO RIGHT
|
||
|
LLINO=LNBR(LINCON)
|
||
|
75 CONTINUE
|
||
|
IF(RELPG(LLINO).GT.POSN)GO TO 80
|
||
|
76 CONTINUE
|
||
|
LLINO=RNBR(LLINO)
|
||
|
IF(LLINO.EQ.0)GO TO 90
|
||
|
GO TO 75
|
||
|
80 CONTINUE
|
||
|
RELPG(LLINO)=RELPG(LLINO)+NC
|
||
|
C WRITE NEW LINE
|
||
|
CALL WRITER(IDEVR,LLINO,RELPG(LLINO),LNGTHG(LLINO),
|
||
|
+LNBR(LLINO),RNBR(LLINO))
|
||
|
C WRITE(IDEVR,REC=LLINO)
|
||
|
C 1RELPG(LLINO),LNGTHG(LLINO),LNBR(LLINO),RNBR(LLINO)
|
||
|
GO TO 76
|
||
|
90 CONTINUE
|
||
|
C NEED TO INCREMENT CONTIG LINE
|
||
|
RELPG(LINCON)=RELPG(LINCON)+NC
|
||
|
CALL WRITER(IDEVR,LINCON,RELPG(LINCON),LNGTHG(LINCON),
|
||
|
+LNBR(LINCON),RNBR(LINCON))
|
||
|
C WRITE(IDEVR,REC=LINCON)RELPG(LINCON),LNGTHG(LINCON),LNBR(LINCON),
|
||
|
C 1RNBR(LINCON)
|
||
|
RETURN
|
||
|
END
|
||
|
SUBROUTINE AUTOJ(RELPG,LNGTHG,LNBR,RNBR,MAXDB,IDBSIZ,
|
||
|
+NGELS,NCONTS,MAXGEL,
|
||
|
+TEMP3,WORDP,WORDN,LPOWRC,POSNS,GELN,
|
||
|
+SEQ1,MAXSEQ,SEQ2,SEQ3,SEQ4,SEQ5,SEQC2,SEQG2,MATCH,
|
||
|
+MAXGLM,MAXGL2,CHRSIZ,ECHRSZ,LENGTH,
|
||
|
+SAV1,SAV2,SAV3,MAXSAV,CENDS,NENDS,MAXCON,CONST,
|
||
|
+KBIN,KBOUT,IDEV1,IDEV2,IDEV3,IDEV4,IDEV7,IDEV8,IDEV,
|
||
|
+IHELPS,IHELPE,HELPF,IDEVH,NAMARC,NAMPRO,FILE,
|
||
|
+PERCD,IOPEN,IDM,SEQG3,SEQC3,IOK)
|
||
|
INTEGER CHRSIZ,ECHRSZ
|
||
|
INTEGER RELPG(MAXDB)
|
||
|
INTEGER LNGTHG(MAXDB),LNBR(MAXDB),RNBR(MAXDB)
|
||
|
INTEGER JOINT(2),ITOTPC(2),ITOTPG(2),IDIM22(2),IDOUT(2)
|
||
|
INTEGER LLINO(2),ITYPE(2),IFAIL(2)
|
||
|
INTEGER ILEFTS(2),ILC(2),IPOSC(2),IPOSG(2),ISENSE(2)
|
||
|
INTEGER ANS,WINDOW
|
||
|
INTEGER TEMP3(ECHRSZ,MAXGL2),CONST(LENGTH)
|
||
|
INTEGER POSNS(MAXSEQ),WORDP(LPOWRC),WORDN(LPOWRC),GELN(MAXGLM)
|
||
|
INTEGER CENDS(MAXCON),NENDS(MAXCON)
|
||
|
CHARACTER SEQ3(MAXGLM),SEQC2(MAXGLM,2),SEQG2(MAXGLM,2)
|
||
|
CHARACTER SEQ1(MAXSEQ),SEQ2(MAXGLM),MATCH(MAXGLM),SEQ4(MAXGLM)
|
||
|
INTEGER SAV1(MAXSAV),SAV2(MAXSAV),SAV3(MAXSAV)
|
||
|
CHARACTER NAMARC*(*),NAMPRO*(*),FILE*(*)
|
||
|
CHARACTER SEQ5(MAXGLM),HELPF*(*),SEQG3(MAXGLM),SEQC3(MAXGLM)
|
||
|
CALL DBCHEK(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDBSIZ,
|
||
|
+ TEMP3,IERR,KBOUT)
|
||
|
IF(IERR.GT.1) RETURN
|
||
|
IFAIL(1) = 0
|
||
|
IF(NGELS.LT.1) RETURN
|
||
|
MN = LENGTH*2
|
||
|
MX = MAXGLM + 1
|
||
|
MINMAT = MAX(15,MN)
|
||
|
CALL GETINT(MN,MX,MINMAT,
|
||
|
+'Minimum initial match',
|
||
|
+IVAL,KBIN,KBOUT,
|
||
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) RETURN
|
||
|
MINMAT = IVAL
|
||
|
MN = 2
|
||
|
MX = 5
|
||
|
MINSLI = MAX(3,MN)
|
||
|
CALL GETINT(MN,MX,MINSLI,
|
||
|
+'Minimum alignment block',
|
||
|
+IVAL,KBIN,KBOUT,
|
||
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) RETURN
|
||
|
MINSLI = IVAL
|
||
|
MN = 0
|
||
|
MX = 25
|
||
|
MAXPG = 8
|
||
|
CALL GETINT(MN,MX,MAXPG,
|
||
|
+'Maximum pads per sequence',
|
||
|
+IVAL,KBIN,KBOUT,
|
||
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) RETURN
|
||
|
MAXPG = IVAL
|
||
|
MAXPC = IVAL
|
||
|
RMN = 0.
|
||
|
RMX = 20.
|
||
|
PERMAX = 8.
|
||
|
CALL GETRL(RMN,RMX,PERMAX,
|
||
|
+ 'Maximum percent mismatch after alignment',
|
||
|
+ VAL,KBIN,KBOUT,
|
||
|
+ IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) RETURN
|
||
|
PERMAX = VAL
|
||
|
MN = MINMAT
|
||
|
MX = MAXGEL
|
||
|
WINDOW = 100
|
||
|
CALL GETINT(MN,MX,WINDOW,
|
||
|
+'Probe length',
|
||
|
+IVAL,KBIN,KBOUT,
|
||
|
+IHELPS,IHELPE,HELPF,IDEVH,IOK)
|
||
|
IF(IOK.NE.0) RETURN
|
||
|
WINDOW = IVAL
|
||
|
IWING = 0
|
||
|
IDIM1=0
|
||
|
MAXOVR=MAXGEL-3*MAX(MAXPC,MAXPG)
|
||
|
ANS=0
|
||
|
CALL JCONS(RELPG,LNGTHG,LNBR,RNBR,NAMPRO,NGELS,NCONTS,
|
||
|
+SEQ1,MAXSEQ,SEQ2,IDBSIZ,IDIM1,ANS,KDUMM,KDUMM,KDUMM,TEMP3,
|
||
|
+ECHRSZ,MAXGL2,KBOUT,IDEV2,IFAIL(1),MAXGEL,IDM,PERCD,SEQ5,
|
||
|
+CENDS,NENDS,MAXCON,IWING,NBAD)
|
||
|
IDIM2=MAXGEL
|
||
|
C
|
||
|
C Note I am doing something horrible here to save space:
|
||
|
C sending cends and nends to jcons to get the extension lengths
|
||
|
C then swapping them with temp3 by sending temp to ajoin and
|
||
|
C receiving them as cends and nends, and sending cends nends
|
||
|
C and receiving them as iladd,iradd
|
||
|
CALL AUTOJN(SEQ1,IDIM1,SEQ2,IDIM2,ILEFTS,ILC,IPOSC,
|
||
|
+IPOSG,ISENSE,LLINO,IMATC,IFCOMP,MINMAT,POSNS,WORDP,WORDN,
|
||
|
+CONST,LENGTH,LPOWRC,IDEV,MATCH,MAXGEL,MAXGLM,SEQ5,GELN,
|
||
|
+SAV1,SAV2,SAV3,MAXSAV,TEMP3,TEMP3(MAXCON+1,1),MAXCON,
|
||
|
+SEQG2,SEQC2,SEQ4,IDOUT,IDIM22,ITOTPG,ITOTPC,JOINT,IFAIL,
|
||
|
+ITYPE,MAXPC,MAXPG,PERMAX,MINSLI,SEQG3,SEQC3,KFAIL,
|
||
|
+WINDOW,CENDS,NENDS,RELPG,LNBR,IDBSIZ,NCONTS)
|
||
|
END
|
||
|
SUBROUTINE AUTOJN(SEQ1,IDIMIN,GEL,IDIMGI,ILEFTS,ILC,IPOSC,
|
||
|
+IPOSG,ISENSE,LLINO,IMATC,IFCOMP,MINMAT,POSNS,WORDP,WORDN,
|
||
|
+CONST,LENGTH,LPOWRC,KBOUT,MATCH,MAXGEL,MAXGLM,GELCOP,GELN,
|
||
|
+SAVPS,SAVPG,SAVL,MAXSAV,CENDS,NENDS,MAXCON,
|
||
|
+SEQG2,SEQC2,SEQ4,IDOUT,IDIM22,ITOTPG,ITOTPC,JOINT,IFAIL,
|
||
|
+ITYPE,MAXPC,MAXPG,PERMAX,MINSLI,SEQG3,SEQC3,KFAIL,
|
||
|
+WINDOW,ILADD,IRADD,RELPG,LNBR,IDBSIZ,NCONTS)
|
||
|
C AUTHOR: RODGER STADEN
|
||
|
INTEGER ILEFTS(2),ILC(2),IPOSC(2),IPOSG(2),ISENSE(2),LLINO(2)
|
||
|
INTEGER POSNS(IDIMIN),GELN(MAXGLM),WORDP(LPOWRC),SAVPS(MAXSAV)
|
||
|
INTEGER SAVPG(MAXSAV),SAVL(MAXSAV)
|
||
|
INTEGER WORDN(LPOWRC)
|
||
|
CHARACTER GELCOP(MAXGLM),MATCH(MAXGLM)
|
||
|
INTEGER CENDS(MAXCON),NENDS(MAXCON),ILADD(MAXCON),IRADD(MAXCON)
|
||
|
INTEGER CONST(LENGTH)
|
||
|
CHARACTER SEQ1(IDIMIN),GEL(MAXGLM)
|
||
|
CHARACTER SEQG2(MAXGLM,2),SEQC2(MAXGLM,2),SEQ4(MAXGLM)
|
||
|
INTEGER IDOUT(2),IDIM22(2),ITOTPG(2),ITOTPC(2),JOINT(2)
|
||
|
INTEGER IFAIL(2),ITYPE(2)
|
||
|
PARAMETER (MAXC = 10)
|
||
|
CHARACTER SEQG3(MAXGLM),SEQC3(MAXGLM)
|
||
|
INTEGER JLEFTS(MAXC),JLC(MAXC),JPOSC(MAXC),JPOSG(MAXC),MCON(MAXC)
|
||
|
INTEGER JSENSE(MAXC),JLLINO(MAXC),WINDOW
|
||
|
INTEGER RELPG(IDBSIZ),LNBR(IDBSIZ)
|
||
|
IFAIL(1) = 1
|
||
|
IFAIL(2) = 1
|
||
|
KFAIL = 0
|
||
|
IDCEND=MAXCON
|
||
|
CALL FNDCON(SEQ1,IDIMIN,CENDS,NENDS,IDCEND,MAXCON,KBOUT)
|
||
|
C find possible missed joins
|
||
|
C we have consensus in seq1 in order first contig,second contig etc
|
||
|
C compare the ends in reverse order, simultaneously shortening the consensus
|
||
|
IDIM = IDIMIN
|
||
|
DO 200 JCON = IDCEND,2,-1
|
||
|
IDIM = CENDS(JCON) - 1
|
||
|
CALL ENCO(SEQ1,IDIM,POSNS,CONST,LENGTH)
|
||
|
CALL ENCONA(POSNS,IDIM,WORDP,WORDN,LPOWRC,LENGTH)
|
||
|
JS = CENDS(JCON) + 20
|
||
|
JE = CENDS(JCON+1) - 1
|
||
|
IEND = 1
|
||
|
IDIMG = MIN(WINDOW,JE-JS+1)
|
||
|
C check for case where contig is shorter than probe (window)
|
||
|
C in which case only compare the left hand end
|
||
|
IF(JE-JS+1.LE.WINDOW) IEND = 2
|
||
|
C WRITE(*,*)JCON,JS,JE,IDIMG
|
||
|
1 CONTINUE
|
||
|
IMATC = 0
|
||
|
IF(IEND.EQ.1) THEN
|
||
|
CALL SQCOPY(SEQ1(JE-IDIMG+1),GEL,IDIMG)
|
||
|
ELSE
|
||
|
CALL SQCOPY(SEQ1(JS),GEL,IDIMG)
|
||
|
END IF
|
||
|
CALL SQCOPY(GEL,GELCOP,IDIMG)
|
||
|
ISTRAN=1
|
||
|
2 CONTINUE
|
||
|
CALL ENCO(GEL,IDIMG,GELN,CONST,LENGTH)
|
||
|
IDSAV=MAXSAV
|
||
|
CALL CFGEL(GELN,IDIMG,POSNS,IDIM,WORDP,WORDN,LENGTH,LPOWRC,
|
||
|
+SAVPG,SAVPS,SAVL,
|
||
|
+IDSAV,SEQ1,GEL,MINMAT,IFCOMP,KBOUT)
|
||
|
IF(IFCOMP.NE.0) THEN
|
||
|
CALL ERROM(KBOUT,'Error in CFGEL')
|
||
|
RETURN
|
||
|
END IF
|
||
|
IF(IDSAV.NE.0)THEN
|
||
|
CALL ADISM5(IDIM,IDIMG,SAVPS,SAVPG,IDSAV,CENDS,NENDS,
|
||
|
+ IDCEND,MAXCON,JLEFTS,JLC,JPOSC,JPOSG,JSENSE,JLLINO,
|
||
|
+ IMATC,ISTRAN,MAXC,KBOUT,MCON)
|
||
|
END IF
|
||
|
ISTRAN=ISTRAN+1
|
||
|
IF(ISTRAN.EQ.2) THEN
|
||
|
CALL SQCOPY(GELCOP,GEL,IDIMG)
|
||
|
CALL SQREV(GEL,IDIMG)
|
||
|
CALL SQCOM(GEL,IDIMG)
|
||
|
GO TO 2
|
||
|
END IF
|
||
|
CALL SQCOPY(GELCOP,GEL,IDIMG)
|
||
|
KSENSE = 0
|
||
|
C WRITE(KBOUT,*)'Total matches found',IMATC
|
||
|
IF(IMATC.NE.0) THEN
|
||
|
JMATC = 0
|
||
|
DO 100 I = 1,IMATC
|
||
|
IF(JSENSE(I).EQ.-1) THEN
|
||
|
IF(KSENSE.EQ.0) THEN
|
||
|
CALL SQREV(GEL,IDIMG)
|
||
|
CALL SQCOM(GEL,IDIMG)
|
||
|
KSENSE = 1
|
||
|
END IF
|
||
|
END IF
|
||
|
JDIM22 = IDIMG
|
||
|
JDOUT = MAXGEL
|
||
|
IDSAV = MAXSAV
|
||
|
C IF(IEND.EQ.1) WRITE(KBOUT,*)'Left end of Contig',NENDS(JCON)
|
||
|
C IF(IEND.EQ.2) WRITE(KBOUT,*)'Right end of Contig',NENDS(JCON)
|
||
|
C WRITE(KBOUT,*)'Trying to align with contig',JLLINO(I)
|
||
|
CALL ALINEJ(SEQ1(JLEFTS(I)),GEL,SEQG3,SEQC3,
|
||
|
+ SAVPS,SAVPG,SAVL,IDSAV,JLC(I),JDIM22,JDOUT,
|
||
|
+ JPOSC(I),JPOSG(I),MINSLI,JJOINT,JTOTPC,JTOTPG,
|
||
|
+ JFAIL,JTYPE,MAXPC,MAXPG,PERMAX,KBOUT,SEQ4,MAXGEL,PERMS,
|
||
|
+ NENDS(JCON),IEND,JLLINO(I),JSENSE(I),ILADD,IRADD,MAXCON,MCON(I),
|
||
|
+ JCON,RELPG,LNBR,IDBSIZ,NCONTS,WINDOW)
|
||
|
100 CONTINUE
|
||
|
END IF
|
||
|
IEND = IEND + 1
|
||
|
IF(IEND.EQ.2) GO TO 1
|
||
|
C IDIM = CENDS(JCON)-1
|
||
|
200 CONTINUE
|
||
|
END
|
||
|
SUBROUTINE ALINEJ(SEQ1,SEQ2,SEQG2,SEQC2,ISAV1,ISAV2,ISAV3,
|
||
|
+IDSAV,IDC,IDIM2,IDOUT,IC1,IG1,MINSLI,JOINT,
|
||
|
+ITOTPC,ITOTPG,IFAIL,ITYPE,MAXPC,MAXPG,PERMAX,KBOUT,SEQ3,MAXGEL,
|
||
|
+PERCM,JCONN,IEND,NCON,JSENSE,ILADD,IRADD,MAXCON,MCON,JCON,
|
||
|
+RELPG,LNBR,IDBSIZ,NCONTS,WINDOW)
|
||
|
C AUTHOR: RODGER STADEN
|
||
|
CHARACTER SEQ1(IDC),SEQ2(IDIM2),SEQG2(IDOUT),SEQC2(IDOUT)
|
||
|
CHARACTER SEQ3(MAXGEL)
|
||
|
INTEGER ISAV1(IDSAV),ISAV2(IDSAV),ISAV3(IDSAV),WINDOW
|
||
|
INTEGER ILADD(MAXCON),IRADD(MAXCON),RELPG(IDBSIZ),LNBR(IDBSIZ)
|
||
|
MINSLT=MINSLI
|
||
|
C SAVE SEQ2
|
||
|
CALL SQCOPY(SEQ2,SEQ3,IDIM2)
|
||
|
CALL MSTLKL(SEQ3,IDIM2)
|
||
|
IFAIL=1
|
||
|
C FIND MATCHES
|
||
|
IPP=IDSAV
|
||
|
CALL SLIDER(SEQ1,IDC,SEQ3,IDIM2,IC1,IG1,MAXPG,MAXPC,MINSLT,
|
||
|
+ISAV1,ISAV2,ISAV3,IPP)
|
||
|
IF(IPP.GT.IDSAV)RETURN
|
||
|
IF(IPP.LT.1)RETURN
|
||
|
CALL REMOVL(ISAV2,ISAV3,ISAV1,IPP)
|
||
|
CALL BUB3AS(ISAV2,ISAV3,ISAV1,IPP)
|
||
|
C DO TOPOLOGICAL CHECK
|
||
|
CALL TPCHEK(ISAV2,ISAV3,ISAV1,IPP)
|
||
|
IFAIL=0
|
||
|
CALL LINEUP(SEQ2,SEQ1,SEQG2,SEQC2,IDC,IDIM2,IDOUT,ISAV3,ISAV2,
|
||
|
+ISAV1,IPP,ITOTPC,ITOTPG,JOINT,ITYPE,KBOUT,MAXGEL,IFAIL)
|
||
|
IF(IFAIL.NE.0)RETURN
|
||
|
C IDIM2 IS NOW LENGTH OF ALIGNED GEL
|
||
|
C WRITE(KBOUT,1052)ITOTPC,ITOTPG
|
||
|
C1052 FORMAT(' Padding in contig= ',I4,' and in gel= ',I4)
|
||
|
CALL JALIGN(SEQC2,SEQG2,SEQ3,MAXGEL,IDOUT,IDIM2,JOINT,
|
||
|
+ITYPE,PERCM,KBOUT,IFAIL,PERMAX,JCONN,IEND,NCON,JSENSE,
|
||
|
+ILADD,IRADD,MAXCON,MCON,JCON,RELPG,LNBR,IDBSIZ,NCONTS,WINDOW)
|
||
|
C ARE ALL CHECKS OK?
|
||
|
IF(ITOTPC.GT.MAXPC)IFAIL=1
|
||
|
IF(ITOTPG.GT.MAXPG)IFAIL=1
|
||
|
IF(PERCM.GT.PERMAX)IFAIL=1
|
||
|
END
|
||
|
C SUBROUTINE DALIGN
|
||
|
C
|
||
|
C COUNTS MISMATCHES AND DISPLAYS OVERLAP.
|
||
|
SUBROUTINE JALIGN(SEQC2,SEQG2,SEQ3,MAXGEL,IDOUT,IDIM2,
|
||
|
+JOINT,ITYPE,X,KBOUT,IFAIL,PERMAX,JCONN,IEND,NCON,JSENSE,
|
||
|
+ILADD,IRADD,MAXCON,MCON,JCON,RELPG,LNBR,IDBSIZ,NCONTS,WINDOW)
|
||
|
C AUTHOR: RODGER STADEN
|
||
|
CHARACTER SEQC2(MAXGEL),SEQG2(MAXGEL),SEQ3(MAXGEL)
|
||
|
CHARACTER PAD,DASH,STRAND,NAME1*6,NAME2*6
|
||
|
INTEGER ILADD(MAXCON),IRADD(MAXCON),RELPG(IDBSIZ),LNBR(IDBSIZ)
|
||
|
INTEGER CLINNO,WINDOW
|
||
|
EXTERNAL CLINNO
|
||
|
SAVE PAD,DASH
|
||
|
DATA PAD,DASH/',','-'/
|
||
|
IENDG=1
|
||
|
IENDC=JOINT
|
||
|
C ONLY LOOK AT OVERLAP WHICH IS FROM JOINT FOR LEFT TYPE JOIN
|
||
|
IF(ITYPE.EQ.1)THEN
|
||
|
IENDG=JOINT
|
||
|
IENDC=1
|
||
|
END IF
|
||
|
100 CONTINUE
|
||
|
C LENGTH OF OVERLAP?
|
||
|
LG=IDIM2-IENDG+1
|
||
|
LO=MIN(IDOUT,LG)
|
||
|
C SAVE RAW DATA
|
||
|
CALL SQCOPY(SEQG2,SEQ3,IDIM2)
|
||
|
CALL MSTLKL(SEQ3,IDIM2)
|
||
|
X=FLOAT(LO)
|
||
|
Y=X
|
||
|
K=IENDG+LO-1
|
||
|
C POINT TO CONSENSUS
|
||
|
J=0
|
||
|
C CHECK FOR OVERFLOW
|
||
|
IF(K.GT.MAXGEL)THEN
|
||
|
WRITE(KBOUT,1001)
|
||
|
1001 FORMAT(
|
||
|
+' Matching region too long for routine dalign. Alignment aborted')
|
||
|
IFAIL=1
|
||
|
RETURN
|
||
|
END IF
|
||
|
DO 200 I=IENDG,K
|
||
|
J=J+1
|
||
|
IF(SEQC2(J).EQ.SEQ3(I))GO TO 200
|
||
|
C IF(SEQ3(I).EQ.DASH)GO TO 200
|
||
|
C IF(SEQC2(J).EQ.DASH)GO TO 200
|
||
|
C IF(SEQC2(J).EQ.PAD)GO TO 200
|
||
|
X=X-1.
|
||
|
200 CONTINUE
|
||
|
X=(Y-X)*100./Y
|
||
|
IF(X.LT.PERMAX) THEN
|
||
|
IC = CLINNO(LNBR,IDBSIZ,NCONTS,JCONN)
|
||
|
IF(IC.EQ.0) THEN
|
||
|
IFAIL = 99
|
||
|
RETURN
|
||
|
END IF
|
||
|
IF(JSENSE.EQ.-1) THEN
|
||
|
STRAND = '-'
|
||
|
IF(IEND.EQ.1) THEN
|
||
|
C
|
||
|
C probe is complement of right hand end of contig. Give posns assuming
|
||
|
C this contig is complemented.
|
||
|
C
|
||
|
IENDGT = IENDG - IRADD(JCON)
|
||
|
C
|
||
|
C Next line gives posns relative to original orientation
|
||
|
C IENDGT = RELPG(IC) + IRADD(JCON) - IENDG + 1
|
||
|
ELSE
|
||
|
C
|
||
|
C probe is complement of left end of contig. Give posns assuming this
|
||
|
C contig is going to be complemented.
|
||
|
C
|
||
|
IENDGT = RELPG(IC) - WINDOW + ILADD(JCON) + IENDG
|
||
|
END IF
|
||
|
ELSE
|
||
|
STRAND = '+'
|
||
|
IF(IEND.EQ.2) THEN
|
||
|
C
|
||
|
C probe is left hand end of contig in original sense
|
||
|
C
|
||
|
IENDGT = IENDG - ILADD(JCON)
|
||
|
ELSE
|
||
|
C
|
||
|
C probe is right hand end of contig in original sense
|
||
|
C
|
||
|
IENDGT = RELPG(IC) + IRADD(JCON) - WINDOW + IENDG
|
||
|
END IF
|
||
|
END IF
|
||
|
IENDCT = IENDC - ILADD(MCON)
|
||
|
WRITE(KBOUT,*)
|
||
|
+ ' Possible join between contig ',JCONN,' in the ',
|
||
|
+ STRAND,' sense and contig ',NCON
|
||
|
WRITE(KBOUT,1000)X
|
||
|
1000 FORMAT(' Percentage mismatch after alignment = ',F4.1)
|
||
|
WRITE(NAME1,1002)JCONN
|
||
|
WRITE(NAME2,1002)NCON
|
||
|
1002 FORMAT(I6)
|
||
|
CALL FMT4LP(SEQC2(1),SEQG2(IENDG),LO,IENDCT,IENDGT,KBOUT,
|
||
|
+ NAME2,NAME1)
|
||
|
END IF
|
||
|
IFAIL=0
|
||
|
END
|
||
|
SUBROUTINE ADISM5(IDIM,IDIMG,SAVPS,SAVPG,IDSAV,
|
||
|
+CENDS,NENDS,IDCEND,MAXCON,ILEFTS,ILC,IPOSC,IPOSG,ISENSE,
|
||
|
+LLINO,IMATC,ISTRAN,MAXC,KBOUT,MCON)
|
||
|
C AUTHOR: RODGER STADEN
|
||
|
INTEGER ILEFTS(MAXC),ILC(MAXC),IPOSC(MAXC),IPOSG(MAXC)
|
||
|
INTEGER ISENSE(MAXC),LLINO(MAXC),MCON(MAXC)
|
||
|
INTEGER CENDS(MAXCON)
|
||
|
INTEGER NENDS(MAXCON)
|
||
|
INTEGER SAVPS(IDSAV),SAVPG(IDSAV)
|
||
|
NEXTC=IDIM+1
|
||
|
CALL BUB2AS(SAVPS,SAVPG,IDSAV)
|
||
|
IMATC=IMATC+1
|
||
|
CALL ADISM6(SAVPS(1),SAVPG(1),CENDS,NENDS,IDCEND,MAXCON,
|
||
|
+ ILEFTS,ILC,IPOSC,IPOSG,ISENSE,LLINO,IMATC,ISTRAN,NEXTC,MAXC,
|
||
|
+ KBOUT,MCON)
|
||
|
LEND=IDIMG-SAVPG(1)+SAVPS(1)
|
||
|
DO 10 I=2,IDSAV
|
||
|
IF((SAVPS(I).LT.LEND).AND.(SAVPS(I).LT.NEXTC))GO TO 10
|
||
|
IMATC=IMATC+1
|
||
|
CALL ADISM6(SAVPS(I),SAVPG(I),CENDS,NENDS,IDCEND,MAXCON,
|
||
|
+ ILEFTS,ILC,IPOSC,IPOSG,ISENSE,LLINO,IMATC,ISTRAN,NEXTC,MAXC,
|
||
|
+ KBOUT,MCON)
|
||
|
LEND=IDIMG-SAVPG(I)+SAVPS(I)
|
||
|
10 CONTINUE
|
||
|
IMATC = MIN(IMATC,MAXC)
|
||
|
END
|
||
|
SUBROUTINE ADISM6(ISAVPS,SAVPG,CENDS,NENDS,
|
||
|
+IDCEND,MAXCON,ILEFTS,ILC,IPOSC,IPOSG,ISENSE,LLINO,IMATC,ISTRAN,
|
||
|
+NEXTC,MAXC,KBOUT,MCON)
|
||
|
C AUTHOR: RODGER STADEN
|
||
|
INTEGER ILEFTS(MAXC),ILC(MAXC),IPOSC(MAXC),IPOSG(MAXC)
|
||
|
INTEGER ISENSE(MAXC),LLINO(MAXC),MCON(MAXC)
|
||
|
INTEGER SAVPS,SAVPG,CENDS(MAXCON)
|
||
|
INTEGER NENDS(MAXCON)
|
||
|
SAVPS=ISAVPS-19
|
||
|
JJ=1
|
||
|
DO 5 J=2,IDCEND
|
||
|
IF(SAVPS.GT.CENDS(J))GO TO 5
|
||
|
JJ=J-1
|
||
|
GO TO 6
|
||
|
5 CONTINUE
|
||
|
JJ=IDCEND
|
||
|
6 CONTINUE
|
||
|
C new bit need to save contig number for alinej
|
||
|
SAVPS=SAVPS-1
|
||
|
LCL=SAVPS-CENDS(JJ)
|
||
|
LCR=CENDS(JJ+1)-ISAVPS-1
|
||
|
NEXTC=CENDS(JJ+1)+20
|
||
|
IF(IMATC.LE.MAXC) THEN
|
||
|
MCON(IMATC) = JJ
|
||
|
ILEFTS(IMATC)=CENDS(JJ)+20
|
||
|
ILC(IMATC)=LCL+LCR+1
|
||
|
IPOSC(IMATC)=LCL+1
|
||
|
IPOSG(IMATC)=SAVPG
|
||
|
LLINO(IMATC)=NENDS(JJ)
|
||
|
ISENSE(IMATC)=1
|
||
|
IF(ISTRAN.EQ.2)ISENSE(IMATC)=-1
|
||
|
ELSE
|
||
|
CALL ERROM(KBOUT,'Warning: too many overlaps')
|
||
|
END IF
|
||
|
END
|
||
|
C JCONS
|
||
|
SUBROUTINE JCONS(RELPG,LNGTHG,LNBR,RNBR,NAMPRO,NGELS,NCONTS,
|
||
|
+SEQ1,IDIM1,GEL,IDBSIZ,ISTART,ANS,LLINO,LREG,RREG,TEMP,
|
||
|
+CHRSIZ,MAXGL2,KBOUT,
|
||
|
+IDEVW,IFAIL,MAXGEL,IDM,PERCD,TGEL,ILADD,IRADD,MAXCON,
|
||
|
+IWIN,NBAD)
|
||
|
C AUTHOR: RODGER STADEN
|
||
|
INTEGER RELPG(IDBSIZ),ANS,CHRSIZ,ILADD(MAXCON),IRADD(MAXCON)
|
||
|
INTEGER LREG,RREG,X,Y,TEMP(CHRSIZ,MAXGL2)
|
||
|
CHARACTER SEQ1(IDIM1)
|
||
|
INTEGER LNGTHG(IDBSIZ),LNBR(IDBSIZ),RNBR(IDBSIZ)
|
||
|
CHARACTER GEL(MAXGEL),TGEL(MAXGEL)
|
||
|
CHARACTER NAMPRO*(*)
|
||
|
CALL BUSY(KBOUT)
|
||
|
IF(IWIN.GT.0) PERC = REAL(NBAD)/REAL(IWIN)
|
||
|
IEND = 1
|
||
|
IFAIL=0
|
||
|
N=IDBSIZ-NCONTS
|
||
|
NCONS = 0
|
||
|
DO 110 I=N,IDBSIZ-1
|
||
|
J=LNBR(I)
|
||
|
X=1
|
||
|
Y=RELPG(I)
|
||
|
ISTART=ISTART+1
|
||
|
IF((ISTART+19+Y+2*MAXGEL).GT.IDIM1)THEN
|
||
|
WRITE(KBOUT,1009)IDIM1
|
||
|
1009 FORMAT(
|
||
|
+ ' Maximum consensus length(',I6,') exceeded',/,
|
||
|
+ ' calculation aborted')
|
||
|
IFAIL=1
|
||
|
RETURN
|
||
|
END IF
|
||
|
CALL ADDTIT(SEQ1(ISTART),NAMPRO,J,ISTART)
|
||
|
NCONS = NCONS + 1
|
||
|
IDIN = 0
|
||
|
ILADD(NCONS) = IDIN
|
||
|
ISTART = ISTART + IDIN
|
||
|
CALL SUMMER(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,
|
||
|
+ SEQ1(ISTART),Y,GEL,X,Y,J,IDBSIZ,TEMP,CHRSIZ,MAXGL2,IDEVW,MAXGEL,
|
||
|
+ IDM,PERCD)
|
||
|
ISTART=ISTART+Y-1
|
||
|
IDIN = 0
|
||
|
IRADD(NCONS) = IDIN
|
||
|
ISTART = ISTART + IDIN
|
||
|
110 CONTINUE
|
||
|
END
|