      PROGRAM DRFILTER
C
C     Driver for testing single precision FILTER routines.
C     Martin J. McBride.  9/30/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:   15       Input data for FILTERs
C         Output:  16       Output data for FILTERs
C
      PARAMETER(NROUTS = 3)
      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
      REAL 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 3 FILTER subprograms.
      SUBNAME(1) = 'FILTERG'
      SUBNAME(2) = 'FILTERS'
      SUBNAME(3) = 'OPFILT'

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

C  Initialization of data heading.
      READ(15,500,END=99) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,COMMENTS
   15 IF (ROUTNME .NE. ' ') GO TO 20
         READ(15,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(15,505) DUMMY
         CALL FDATE(DATERUN)
         WRITE(16,590)
         WRITE(16,590)
         WRITE(16,600) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,COMMENTS
         WRITE(16,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 subprogram is currently being tested.
         IF (ROUTNME .EQ. 'FILTERG') THEN
            TEMP = NFAILS(1)
            CALL DRFILTG(NTESTS(1),NFAILS(1),TOL)
            IF (NFAILS(1) .GT. TEMP) WRITE(6,900) IDENT
         ELSE IF (ROUTNME .EQ. 'FILTERS') THEN
            TEMP = NFAILS(2)
            CALL DRFILTS(NTESTS(2),NFAILS(2),TOL)
            IF (NFAILS(2) .GT. TEMP) WRITE(6,900) IDENT
         ELSE IF (ROUTNME .EQ. 'OPFILT') THEN
            TEMP = NFAILS(3)
            CALL DROPFILT(NTESTS(3),NFAILS(3),TOL)
            IF (NFAILS(3) .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 heading.
         READ(15,500,END=99) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,COMMENTS
   30    IF (ROUTNME .NE. ' ') GO TO 20
            READ(15,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(16,590)
      WRITE(16,590)
      WRITE(16,600) ROUTNME

C  Output of results of each individual test case.
      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 = REAL(NFAILS(I))/REAL(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  Computation and output of 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 = REAL(TFAILS)/REAL(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(15)
      CLOSE(16)
      END

C-------------------------------------------------------------     ************
C                                                                     DRFILTG
C                                                                  ************
      SUBROUTINE DRFILTG(NTESTS,NFAILS,TOL)
C
C     Test driver for FILTERG.
C     Martin J. McBride.  09/30/85.
C     General Electric CRD, Information System Operation.
C
      PARAMETER(MAXDIM = 50)
      CHARACTER*10 STR1,STR2,STR3,STR4,MESS*7
      LOGICAL FAILED
      INTEGER NTESTS,NFAILS,I,M,N
      REAL A,D,O,CRO,TOL
      DIMENSION A(MAXDIM),D(MAXDIM),O(MAXDIM),CRO(MAXDIM)

      READ(15,*) STR1,M,N
      MESS = 'DRFILTG'
      CALL DIMCHECK(M,MAXDIM,MESS)
      CALL DIMCHECK(N,MAXDIM,MESS)
      READ(15,*) STR2,(A(I), I=1,M)
      READ(15,*) STR3,(D(I), I=1,N)
      READ(15,*) STR4,(CRO(I), I=1,N)
      WRITE(16,600) STR1,M,N
      WRITE(16,605) STR2,(A(I), I=1,M)
      WRITE(16,605) STR3,(D(I), I=1,N)

      DO 25 I = 1,N
         O(I) = 1.0
   25 CONTINUE

      CALL FILTERG(A,M,D,N,O)

      FAILED = .FALSE.
      DO 10 I = 1,N
         DIFF = O(I) - CRO(I)
         IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE.
   10 CONTINUE

      WRITE(16,605) STR4,(O(I), I=1,N)
      IF (FAILED) NFAILS = NFAILS + 1
      NTESTS = NTESTS + 1
  600 FORMAT('''',A10,'''',1X,2I4)
  605 FORMAT('''',A10,'''',1X,3(G14.7,','),G14.7,:/(13X,G14.7,
     &   ',',G14.7,',',G14.7,',',G14.7))
      RETURN
      END

C-------------------------------------------------------------     ************
C                                                                     DRFILTS
C                                                                  ************
      SUBROUTINE DRFILTS(NTESTS,NFAILS,TOL)
C
C     Test driver for FILTERS.
C     Martin J. McBride.  09/30/85.
C     General Electric CRD, Information System Operation.
C
      PARAMETER(MAXDIM = 50)
      CHARACTER*10 STR1,STR2,STR3,STR4,MESS*7
      LOGICAL FAILED
      INTEGER NTESTS,NFAILS,I,M,N
      REAL A,D,O,CRO,TOL
      DIMENSION A(MAXDIM),D(MAXDIM),O(MAXDIM),CRO(MAXDIM)

      READ(15,*) STR1,M,N
      MESS = 'DRFILTS'
      CALL DIMCHECK(M,MAXDIM,MESS)
      CALL DIMCHECK(N,MAXDIM,MESS)
      READ(15,*) STR2,(A(I), I=1,M)
      READ(15,*) STR3,(D(I), I=1,N)
      READ(15,*) STR4,(CRO(I), I=1,N)
      WRITE(16,600) STR1,M,N
      WRITE(16,605) STR2,(A(I), I=1,M)
      WRITE(16,605) STR3,(D(I), I=1,N)

      DO 25 I = 1,N
         O(I) = 1.0
   25 CONTINUE

      CALL FILTERS(A,M,D,N,O)

      FAILED = .FALSE.
      DO 10 I = 1,N
         DIFF = O(I) - CRO(I)
         IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE.
   10 CONTINUE

      WRITE(16,605) STR4,(O(I), I=1,N)
      IF (FAILED) NFAILS = NFAILS + 1
      NTESTS = NTESTS + 1
  600 FORMAT('''',A10,'''',1X,2I4)
  605 FORMAT('''',A10,'''',1X,3(G14.7,','),G14.7,:/(13X,G14.7,
     &   ',',G14.7,',',G14.7,',',G14.7))
      RETURN
      END

C-------------------------------------------------------------     ************
C                                                                    DROPFILT
C                                                                  ************
      SUBROUTINE DROPFILT(NTESTS,NFAILS,TOL)
C
C     Test driver for OPFILT.
C     Martin J. McBride.  1/6/86.
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,M
      REAL A,B,C,R,CRA,TOL
      DIMENSION A(MAXDIM),B(MAXDIM),R(MAXDIM),CRA(MAXDIM),C(2*MAXDIM)

      READ(15,*) STR1,M
      MESS = 'DROPFILT'
      CALL DIMCHECK(M,MAXDIM,MESS)
      READ(15,*) STR2,(B(I), I=1,M)
      READ(15,*) STR3,(R(I), I=1,M)
      READ(15,*) STR4,(CRA(I), I=1,M)
      WRITE(16,600) STR1,M
      WRITE(16,605) STR2,(B(I), I=1,M)
      WRITE(16,605) STR3,(R(I), I=1,M)

      CALL OPFILT(M,A,B,C,R)

      FAILED = .FALSE.
      DO 10 I = 1,M
         DIFF = A(I) - CRA(I)
         IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE.
   10 CONTINUE

      WRITE(16,605) STR4,(A(I), I=1,M)
      IF (FAILED) NFAILS = NFAILS + 1
      NTESTS = NTESTS + 1
  600 FORMAT('''',A10,'''',1X,I4)
  605 FORMAT('''',A10,'''',1X,3(G14.7,','),G14.7,:/(13X,G14.7,
     &   ',',G14.7,',',G14.7,',',G14.7))
      RETURN
      END

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