134 lines
4.1 KiB
Fortran
134 lines
4.1 KiB
Fortran
C DBCHEK
|
|
C TO CHECK THE SELF CONSISTENCY OF A DB
|
|
C ARE ALL NEIGHBOURS HOLDING HANDS OR DO SOME HAVE
|
|
C GELS WHICH DO NOT BELONG TO ANY CONTIG? OR WORSE BELONG TO MORE
|
|
C THAN ONE CONTIG?
|
|
C ARE THERE ANY LOOPS IN CONTIGS (THE WORST PROBLEM)
|
|
C ARE ALL RELATIVE POSITIONS IN SAME ORDER AS NEIGHBOURS?
|
|
C ARE THERE ANY CONTIGS OF LENGTH <1 ?
|
|
C ARE THERE ANY GELS OF ZERO LENGTH ?
|
|
C RETURN ERROR CODE OF ZERO FOR ALL OK, 1 FOR GELS NOT USED
|
|
C AND 2 FOR ALL OTHER ERRORS
|
|
SUBROUTINE DBCHEK(RELPG,LNGTHG,LNBR,RNBR,NGELS,NCONTS,IDBSIZ,
|
|
+TEMP,IERR,KBOUT)
|
|
C AUTHOR: RODGER STADEN
|
|
INTEGER RELPG(IDBSIZ)
|
|
INTEGER LNGTHG(IDBSIZ),LNBR(IDBSIZ),RNBR(IDBSIZ)
|
|
INTEGER TEMP(IDBSIZ)
|
|
IERR=0
|
|
C HAND HOLDING OK?
|
|
DO 100 I=1,NGELS
|
|
K=LNBR(I)
|
|
IF(K.EQ.0)GO TO 50
|
|
IF(RNBR(K).EQ.I)GO TO 50
|
|
WRITE(KBOUT,1000)I
|
|
1000 FORMAT(' Hand holding problem for gel reading',I6)
|
|
WRITE(KBOUT,1001)I,RELPG(I),LNGTHG(I),LNBR(I),RNBR(I)
|
|
WRITE(KBOUT,1001)K,RELPG(K),LNGTHG(K),LNBR(K),RNBR(K)
|
|
1001 FORMAT(' ',5I6)
|
|
IERR=2
|
|
50 CONTINUE
|
|
K=RNBR(I)
|
|
IF(K.EQ.0)GO TO 100
|
|
IF(LNBR(K).EQ.I)GO TO 100
|
|
WRITE(KBOUT,1000)I
|
|
WRITE(KBOUT,1001)I,RELPG(I),LNGTHG(I),LNBR(I),RNBR(I)
|
|
WRITE(KBOUT,1001)K,RELPG(K),LNGTHG(K),LNBR(K),RNBR(K)
|
|
IERR=2
|
|
100 CONTINUE
|
|
C
|
|
C ALL GELS IN CONTIGS OR IN MORE THAN ONE CONTIG?
|
|
C TEMP IS USED TO COUNT THE NUMBER OF TIMES EACH GEL IS USED
|
|
CALL FILLI(TEMP,IDBSIZ,0)
|
|
N=IDBSIZ-NCONTS
|
|
C COUNT NUMBER OF PASSES THRU LOOP 320 TO 300. IF THIS EXCEEDS
|
|
C THE DATABASE SIZE A LOOP HAS BEEN FOUND!
|
|
ICOUNT=0
|
|
DO 300 I=N,IDBSIZ-1
|
|
II=I
|
|
K=LNBR(I)
|
|
J=RNBR(I)
|
|
IF((K.NE.0).AND.(J.NE.0))GO TO 310
|
|
C THIS CONTIG POINTS TO ZERO GEL NUMBER AS LEFT OR RIGHT END!
|
|
WRITE(KBOUT,1002)I
|
|
1002 FORMAT(' Contig',I4,' has zero gel numbers')
|
|
IERR=2
|
|
GO TO 290
|
|
310 CONTINUE
|
|
IF((LNBR(K).EQ.0).AND.(RNBR(J).EQ.0))GO TO 290
|
|
C THIS LEFT END IS NOT A LEFT END OR THIS RIGHT END IS NOT A RIGHT END
|
|
WRITE(KBOUT,1004)I
|
|
1004 FORMAT(' The end gels of contig',I4,' have outward neighbours')
|
|
IERR=2
|
|
290 CONTINUE
|
|
C DOES THE CONTIG HAVE SOME +VE LENGTH?
|
|
IF(RELPG(I).GT.0)GO TO 320
|
|
WRITE(KBOUT,1010)I
|
|
1010 FORMAT(' The contig on line number',I4,' has zero length')
|
|
IERR=2
|
|
320 CONTINUE
|
|
TEMP(K)=TEMP(K)+1
|
|
ICOUNT=ICOUNT+1
|
|
IF(ICOUNT.GT.IDBSIZ)GO TO 601
|
|
K=RNBR(K)
|
|
IF(K.NE.0)GO TO 320
|
|
300 CONTINUE
|
|
DO 400 I=1,NGELS
|
|
IF(TEMP(I).EQ.1)GO TO 390
|
|
IF(TEMP(I).EQ.0)GO TO 410
|
|
WRITE(KBOUT,1005)I,TEMP(I)
|
|
1005 FORMAT(' Gel number ',I6,' is used ',I6,' times')
|
|
IERR=2
|
|
GO TO 400
|
|
390 CONTINUE
|
|
C DOES THE GEL HAVE NONZERO LENGTH? (ONLY CHECK THOSE USED ONCE)
|
|
IF(LNGTHG(I).NE.0)GO TO 400
|
|
WRITE(KBOUT,1011)I
|
|
1011 FORMAT(' Gel number',I6,' has zero length')
|
|
IERR=2
|
|
GO TO 400
|
|
410 CONTINUE
|
|
WRITE(KBOUT,1006)I
|
|
1006 FORMAT(' Gel number ',I6,' is not used')
|
|
C NEED TO INCREMENT THE ERROR COUNT NOT RESET IT TO A LOWER VALUE!
|
|
IF(IERR.LT.2)IERR=1
|
|
400 CONTINUE
|
|
C ALL RELATIVE POSNS OK?
|
|
N=IDBSIZ-NCONTS
|
|
DO 500 I=N,IDBSIZ-1
|
|
K=LNBR(I)
|
|
IF(K.EQ.0)GO TO 500
|
|
510 CONTINUE
|
|
J=RNBR(K)
|
|
IF(J.EQ.0)GO TO 500
|
|
IF(RELPG(K).GT.RELPG(J))GO TO 520
|
|
K=J
|
|
GO TO 510
|
|
520 CONTINUE
|
|
WRITE(KBOUT,1007)K,RELPG(K),J,RELPG(J)
|
|
1007 FORMAT(' Gel number',I6,' with position',I6,
|
|
+ ' is the left neighbour of',
|
|
+ /,' gel number',I6,' with position',I6)
|
|
K=J
|
|
IERR=2
|
|
GO TO 510
|
|
500 CONTINUE
|
|
IF(IERR.EQ.0)WRITE(KBOUT,1013)
|
|
1013 FORMAT(' Database is logically consistent')
|
|
RETURN
|
|
601 CONTINUE
|
|
IERR=2
|
|
WRITE(KBOUT,1008)II
|
|
1008 FORMAT(' Loop in contig',I6,/,
|
|
+' No further checking done but gel numbers follow')
|
|
CALL FILLI(TEMP,IDBSIZ,0)
|
|
K=LNBR(II)
|
|
710 CONTINUE
|
|
TEMP(K)=TEMP(K)+1
|
|
WRITE(KBOUT,1009)K
|
|
1009 FORMAT(' ',I6)
|
|
IF(TEMP(K).GT.1)RETURN
|
|
K=RNBR(K)
|
|
GO TO 710
|
|
END
|