Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0050/dacomp.for
There is 1 other file named dacomp.for in the archive. Click here to see a list.
SUBROUTINE DACOMP(KOMPAR,ILPT,IARRAY,ILOW,IHIGH,
1JARRAY,JLOW,JHIGH)
C
C SUBROUTINE TO REPORT DIFFERENCES BETWEEN 2 ARRAYS
C
C KOMPAR = 0, RETURNED IF ARRAYS DIFFER
C = 1, RETURNED IF ARRAYS IDENTICAL
C ILPT = UNIT ON WHICH OUTPUT IS WRITTEN
C IARRAY = FIRST ARRAY TO BE TESTED
C ILOW = SUBSCRIPT OF START OF IARRAY
C IHIGH = SUBSCRIPT OF END OF IARRAY
C JARRAY = SECOND ARRAY TO BE TESTED
C JLOW = SUBSCRIPT OF START OF JARRAY
C JHIGH = SUBSCRIPT OF END OF JARRAY
C
C DONALD BARTH, CHEMISTRY DEPT., HARVARD UNIVERSITY
C
DIMENSION IARRAY(1),JARRAY(1),IOCT(13)
C
ISTART=ILOW
JSTART=JLOW
IF(ISTART.LE.0)ISTART=1
IF(JSTART.LE.0)JSTART=1
IF(ISTART.GT.IHIGH)GO TO 1
IF(JSTART.GT.JHIGH)GO TO 1
J=0
IEND=ISTART
JEND=JSTART
GO TO 8
1 J=-1
2 IEND=IHIGH
JEND=JHIGH
GO TO 19
C
C SEARCH FOR START OF DIFFERENCE
3 ISTART=IEND
JSTART=JEND
4 ISTART=ISTART+1
JSTART=JSTART+1
IF(ISTART.GT.IHIGH)GO TO 5
IF(JSTART.GT.JHIGH)GO TO 6
IF(IARRAY(ISTART).EQ.JARRAY(JSTART))GO TO 4
C
C SEARCH FOR END OF DIFFERENCE
IF(J.EQ.0)J=-1
IEND=ISTART
JEND=JSTART
GO TO 16
5 IF(JSTART.GT.JHIGH)GO TO 33
6 IF(J.EQ.0)GO TO 1
GO TO 2
7 IEND=IEND+1
8 INDEX=JSTART
M=0
9 IF(IARRAY(IEND).NE.JARRAY(INDEX))GO TO 14
K=IEND
L=INDEX
GO TO 12
10 JEND=JEND+1
INDEX=ISTART
M=1
11 IF(IARRAY(INDEX).NE.JARRAY(JEND))GO TO 15
K=INDEX
L=JEND
C FOLLOWING LIMIT SETS DEPTH OF MATCH NECESSARY
12 I=3
13 K=K+1
L=L+1
I=I-1
IF(I.EQ.0)GO TO 17
IF(K.GT.IHIGH)GO TO 17
IF(L.GT.JHIGH)GO TO 17
IF(IARRAY(K).EQ.JARRAY(L))GO TO 13
IF(M.NE.0)GO TO 15
14 IF(J.EQ.0)J=-1
INDEX=INDEX+1
IF(INDEX.LE.JEND)GO TO 9
IF(JEND.LT.JHIGH)GO TO 10
IF(IEND.LT.IHIGH)GO TO 7
GO TO 19
15 IF(J.EQ.0)J=-1
INDEX=INDEX+1
IF(INDEX.LE.IEND)GO TO 11
16 IF(IEND.LT.IHIGH)GO TO 7
IF(JEND.LT.JHIGH)GO TO 10
GO TO 19
17 IF(M.NE.0)GO TO 18
JEND=INDEX
GO TO 19
18 IEND=INDEX
C
C PRINT SECTIONS WHICH DO NOT MATCH
19 IF(J.EQ.0)GO TO 3
IF(J.LT.0)WRITE(ILPT,20)
20 FORMAT(1X,17HARRAY DIFFERENCES/1X,5H*****)
IF(ISTART.GT.IHIGH)GO TO 27
J=1
21 IF(IARRAY(ISTART).LT.0)GO TO 23
I=0
CALL DANUMB(1,IARRAY(ISTART),8,IOCT,I,13,13)
WRITE(ILPT,22)J,ISTART,(IOCT(I),I=1,13),IARRAY(ISTART)
22 FORMAT(1X,1I1,1H),1I6,5H OCT ,13A1,5H DEC ,1I13)
GO TO 25
23 WRITE(ILPT,24)J,ISTART,IARRAY(ISTART),IARRAY(ISTART)
24 FORMAT(1X,1I1,1H),1I6,5H OCT ,1O13,5H DEC ,1I13)
25 ISTART=ISTART+1
IF(ISTART.LE.IEND)GO TO 21
IF(JSTART.GT.JHIGH)GO TO 31
WRITE(ILPT,26)
26 FORMAT(1X,1H*)
27 IF(JSTART.GT.JHIGH)GO TO 31
J=2
28 IF(JARRAY(JSTART).LT.0)GO TO 29
I=0
CALL DANUMB(1,JARRAY(JSTART),8,IOCT,I,13,13)
WRITE(ILPT,22)J,JSTART,(IOCT(I),I=1,13),JARRAY(JSTART)
GO TO 30
29 WRITE(ILPT,24)J,JSTART,JARRAY(JSTART),JARRAY(JSTART)
30 JSTART=JSTART+1
IF(JSTART.LE.JEND)GO TO 28
31 WRITE(ILPT,32)
32 FORMAT(1X,5H*****)
GO TO 3
C
C RETURN TO MAIN PROGRAM
33 IF(J.NE.0)GO TO 34
KOMPAR=1
GO TO 35
34 KOMPAR=0
35 RETURN
END