      PROGRAM GATSCAT
C
C     Driver for testing GATHER/SCATTER.
C     Martin J. McBride.  10/25/85.
C     General Electric CRD, Information System Operation.
C
C     FORTRAN logical unit numbers used:
C         Input:    3     One line containing CRAY information
C         Input:   17     Input data for GATHER/SCATTER
C         Output:  18     Output data for GATHER/SCATTER
C
      PARAMETER(NROUTS = 2)
      CHARACTER ROUTNME*31,SUBNAME*31,IDENT*5,DATEIN*8
      CHARACTER DATERUN*8,COMMENTS*23,HRDWRE*30
      CHARACTER DUMMY*30,PERSON*5
      INTEGER NTESTS,NFAILS,TTESTS,TFAILS,TEMP
      DOUBLE PRECISION TOL,PFAILS
      DIMENSION NTESTS(NROUTS),NFAILS(NROUTS),SUBNAME(NROUTS)
      DATA NTESTS,NFAILS /NROUTS*0,NROUTS*0/

C  An array is set up to hold the names of the 2 subprograms of GATHER/SCATTER.
      SUBNAME(1) = 'GATHER'
      SUBNAME(2) = 'SCATTER'

C  Initialization of tolerance value and CRAY information.
      TOL = 0.0000000001
      READ(3,505) HRDWRE
      CLOSE(3)

C  Initialization of data heading.
      READ(17,500,END=99) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,COMMENTS
   15 IF (ROUTNME .NE. ' ') GO TO 20
         READ(17,500,END=99) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,COMMENTS
         GO TO 15

C  Loop to run through all sets of input data, which ends with XXX.
   20 IF (ROUTNME .EQ. 'XXX') GO TO 99
         READ(17,505,END=99) DUMMY
         CALL FDATE(DATERUN)
         WRITE(18,590)
         WRITE(18,590)
         WRITE(18,600) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,COMMENTS
         WRITE(18,605) HRDWRE
  500    FORMAT(A31,A5,A8,A5,A8,A23)
  505    FORMAT(A30)
  590    FORMAT(1X)
  600    FORMAT(A31,A5,A8,A5,A8,A23)
  605    FORMAT(A30)

C  Determine which of the subprograms is currently being tested.
         IF (ROUTNME .EQ. 'GATHER') THEN
            TEMP = NFAILS(1)
            CALL DRGATHER(NTESTS(1),NFAILS(1),TOL)
            IF (NFAILS(1) .GT. TEMP) WRITE(6,900) IDENT
         ELSE IF (ROUTNME .EQ. 'SCATTER') THEN
            TEMP = NFAILS(2)
            CALL DRSCATTR(NTESTS(2),NFAILS(2),TOL)
            IF (NFAILS(2) .GT. TEMP) WRITE(6,900) IDENT
         ELSE
            PRINT*,'ERROR IN ROUTINE NAME --- ',ROUTNME
            PRINT*,'  IDENTIFICATION # ',IDENT
            STOP
         ENDIF
  900    FORMAT(1X,'ERROR IN SCIPORT RESULT - DATA ID# ',A5)

C  Read next data input heading.
         READ(17,500,END=99) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,COMMENTS
   30    IF (ROUTNME .NE. ' ') GO TO 20
            READ(17,500,END=99) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,
     &                COMMENTS
            GO TO 30

C  Print XXX at bottom of output file and proceed to printing of results.
   99 CONTINUE
      WRITE(18,590)
      WRITE(18,590)
      WRITE(18,600) ROUTNME

C  Output of results of all test data.
      DO 55 I = 1,NROUTS
         WRITE(6,700)
         WRITE(6,705) SUBNAME(I)
         IF (NTESTS(I) .EQ. 0) THEN
            WRITE(6,708)
            WRITE(6,707)
            WRITE(6,708)
         ELSE IF (NFAILS(I) .GT. 0) THEN
            PFAILS = DBLE(NFAILS(I))/DBLE(NTESTS(I)) * 100.0
            WRITE(6,708)
            WRITE(6,710) NTESTS(I)
            WRITE(6,715) NFAILS(I)
            WRITE(6,720) PFAILS
            WRITE(6,708)
         ELSE
            WRITE(6,710) NTESTS(I)
            WRITE(6,730)
         ENDIF
   55 CONTINUE

C  Compute and print totals.
      TTESTS = 0
      TFAILS = 0
      DO 65 I = 1,NROUTS
         TTESTS = TTESTS + NTESTS(I)
         TFAILS = TFAILS + NFAILS(I)
   65 CONTINUE
      WRITE(6,700)
      WRITE(6,700)
      WRITE(6,701)
      WRITE(6,700)
      WRITE(6,702)
      PFAILS = DBLE(TFAILS)/DBLE(TTESTS) * 100.0
      WRITE(6,710) TTESTS
      WRITE(6,715) TFAILS
      WRITE(6,720) PFAILS
      WRITE(6,700)

  700 FORMAT(1X)
  701 FORMAT(1X,50('-'))
  702 FORMAT(1X,'TOTALS')
  705 FORMAT(1X,A31)
  707 FORMAT(5X,'There were no tests performed on this unit.')
  708 FORMAT(45X,'******')
  710 FORMAT(5X,'Number of tests performed:   ',I4)
  715 FORMAT(5X,'Number of tests that failed: ',I4)
  720 FORMAT(5X,'Percentage of failures:    ',F6.2)
  730 FORMAT(5X,'All tests on this unit were successful.')

      CLOSE(17)
      CLOSE(18)
      END

C-------------------------------------------------------------     ************
C                                                                    DRGATHER
C                                                                  ************
      SUBROUTINE DRGATHER(NTESTS,NFAILS,TOL)
C
C     Test driver for GATHER.
C     Martin J. McBride.  10/30/85.
C     General Electric CRD, Information System Operation
C
      PARAMETER(MAXDIM = 50)
      CHARACTER*10 STR1,STR2,STR3,STR4,MESS*8
      LOGICAL FAILED
      INTEGER NTESTS,NFAILS,I,NA,NB,INDEX
      DOUBLE PRECISION TOL,A,B,CRA
      DIMENSION A(MAXDIM),B(MAXDIM),CRA(MAXDIM),INDEX(MAXDIM)

C  Read and write input data and read previous results.
      READ(17,*) STR1,NA,NB
      MESS = 'DRGATHER'
      CALL DIMCHECK(NA,MAXDIM,MESS)
      CALL DIMCHECK(NB,MAXDIM,MESS)
      READ(17,*) STR2,(B(I), I=1,NB)
      READ(17,*) STR3,(INDEX(I), I=1,NA)
      READ(17,*) STR4,(CRA(I), I=1,NA)
      WRITE(18,600) STR1,NA,NB
      WRITE(18,605) STR2,(B(I), I=1,NB)
      WRITE(18,610) STR3,(INDEX(I), I=1,NA)

      CALL GATHER(NA,A,B,INDEX)

C  Check difference between new and previous results.
      FAILED = .FALSE.
      DO 10 I = 1,NA
         DIFF = CRA(I) - A(I)
         IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE.
   10 CONTINUE

C  Output new results and increment counters.
      WRITE(18,605) STR4,(A(I), I=1,NA)
      IF (FAILED) NFAILS = NFAILS + 1
      NTESTS = NTESTS + 1
  600 FORMAT('''',A10,'''',1X,2I4)
  605 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14,
     &   ',',G21.14,',',G21.14))
  610 FORMAT('''',A10,'''',1X,9(I5,','),I5,:/(13X,I5,',',I5,',',
     &   I5,',',I5,',',I5,',',I5,',',I5,',',I5,',',I5,',',I5))

      RETURN
      END

C-------------------------------------------------------------     ************
C                                                                    DRSCATTR
C                                                                  ************
      SUBROUTINE DRSCATTR(NTESTS,NFAILS,TOL)
C
C     Test driver for SCATTER.
C     Martin J. McBride.  10/30/85.
C     General Electric CRD, Information System Operation
C
      PARAMETER(MAXDIM = 50)
      CHARACTER*10 STR1,STR2,STR3,STR4,MESS*8
      LOGICAL FAILED
      INTEGER NTESTS,NFAILS,I,NA,NB,INDEX
      DOUBLE PRECISION TOL,A,B,CRA
      DIMENSION A(MAXDIM),B(MAXDIM),CRA(MAXDIM),INDEX(MAXDIM)

C  Read and write input data and read previous results.
      READ(17,*) STR1,NA,NB
      MESS = 'DRSCATTR'
      CALL DIMCHECK(NA,MAXDIM,MESS)
      CALL DIMCHECK(NB,MAXDIM,MESS)
      READ(17,*) STR2,(B(I), I=1,NB)
      READ(17,*) STR3,(INDEX(I), I=1,NB)
      READ(17,*) STR4,(CRA(I), I=1,NA)
      WRITE(18,600) STR1,NA,NB
      WRITE(18,605) STR2,(B(I), I=1,NB)
      WRITE(18,610) STR3,(INDEX(I), I=1,NB)

      CALL SCATTER(NB,A,INDEX,B)

C  Check difference between new and previous results.
      FAILED = .FALSE.
      DO 10 I = 1,NA
         DIFF = CRA(I) - A(I)
         IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE.
   10 CONTINUE

C  Output new results and increment counters.
      WRITE(18,605) STR4,(A(I), I=1,NA)
      IF (FAILED) NFAILS = NFAILS + 1
      NTESTS = NTESTS + 1
  600 FORMAT('''',A10,'''',1X,2I4)
  605 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14,
     &   ',',G21.14,',',G21.14))
  610 FORMAT('''',A10,'''',1X,9(I5,','),I5,:/(13X,I5,',',I5,',',
     &   I5,',',I5,',',I5,',',I5,',',I5,',',I5,',',I5,',',I5))

      RETURN
      END

C-------------------------------------------------------------     ************
C                                                                    DIMCHECK
C                                                                  ************
      SUBROUTINE DIMCHECK(NUSED,NALLCTD,MESS)
C
C     Checks the bounds on an array.
C
      CHARACTER*(*) MESS
      IF(NUSED.LE.NALLCTD)RETURN
      PRINT *,' DIMENSION FOR ',MESS,' = ',NALLCTD,' EXCEEDED BY ',
     1  NUSED - NALLCTD
      STOP ' SORRY '
      END