Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-02 - 43,50250/dacomp.f4
There are no other files named dacomp.f4 in the archive.
      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