      PROGRAM DRFFT
C
C     Driver for testing single precision FFT routines.
C     Martin J. McBride.  11/18/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:   13       Input data for FFTs
C         Output:  14       Output data for FFTs
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 FFT subprograms.
      SUBNAME(1) = 'CFFT2'
      SUBNAME(2) = 'RCFFT2'
      SUBNAME(3) = 'CRFFT2'

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

C  Initialization of data heading.
      READ(13,500,END=99) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,COMMENTS
   15 IF (ROUTNME .NE. ' ') GO TO 20
         READ(13,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(13,505) DUMMY
         CALL FDATE(DATERUN)
         WRITE(14,590)
         WRITE(14,590)
         WRITE(14,600) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,COMMENTS
         WRITE(14,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. 'CFFT2') THEN
            TEMP = NFAILS(1)
            CALL DRCFFT2(NTESTS(1),NFAILS(1),TOL)
            IF (NFAILS(1) .GT. TEMP) WRITE(6,900) IDENT
         ELSE IF (ROUTNME .EQ. 'RCFFT2') THEN
            TEMP = NFAILS(2)
            CALL DRRCFFT2(NTESTS(2),NFAILS(2),TOL)
            IF (NFAILS(2) .GT. TEMP) WRITE(6,900) IDENT
         ELSE IF (ROUTNME .EQ. 'CRFFT2') THEN
            TEMP = NFAILS(3)
            CALL DRCRFFT2(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(13,500,END=99) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,
     &             COMMENTS
   30    IF (ROUTNME .NE. ' ') GO TO 20
            READ(13,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(14,590)
      WRITE(14,590)
      WRITE(14,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(13)
      CLOSE(14)
      END

C-------------------------------------------------------------     ************
C                                                                    DRCFFT2
C                                                                  ************
      SUBROUTINE DRCFFT2(NTESTS,NFAILS,TOL)
C
C     Test driver for CFFT2.
C     Martin J. McBride.  1/6/86.
C     General Electric CRD, Information System Operation
C
      PARAMETER(MAXDIM = 1024)
      CHARACTER*10 STR1,STR2,STR3,STR4,MESS*7
      LOGICAL FAILED
      INTEGER NTESTS,NFAILS,IX,N
      REAL TOL
      COMPLEX X,Y,WORK,CRY,DIFF
      DIMENSION X(MAXDIM),Y(MAXDIM),CRY(MAXDIM),WORK(5*MAXDIM/2)

C  Read and write input data and read previous results.
      READ(13,*) STR1,N
      MESS = 'DRCFFT2'
      CALL DIMCHECK(N,MAXDIM,MESS)
      READ(13,*) STR2,IX
      READ(13,*) STR3,(X(I), I=1,N)
      READ(13,*) STR4,(CRY(I), I=1,N)
      WRITE(14,600) STR1,N
      WRITE(14,600) STR2,IX
      WRITE(14,610) STR3,(X(I), I=1,N)

C  Initialize the work space to zero.
      DO 5 I = 1,5*N/2
    5    WORK(I) = 0.0

      CALL CFFT2(1,IX,N,X,WORK,Y)
      CALL CFFT2(0,IX,N,X,WORK,Y)

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

C  Output new results and increment counters.
      WRITE(14,610) STR4,(Y(I), I=1,N)
      IF (FAILED) NFAILS = NFAILS + 1
      NTESTS = NTESTS + 1
  600 FORMAT('''',A10,'''',1X,I4)
  610 FORMAT('''',A10,'''',1X,'(',G14.7,',',G14.7,')',2X,'(',G14.7,
     &    ',',G14.7,')',:/(13X,'(',G14.7,',',G14.7,')',2X,'(',G14.7,
     &    ',',G14.7,')'))

      RETURN
      END

C-------------------------------------------------------------     ************
C                                                                    DRRCFFT2
C                                                                  ************
      SUBROUTINE DRRCFFT2(NTESTS,NFAILS,TOL)
C
C     Test driver for RCFFT2.
C     Martin J. McBride.  1/6/86.
C     General Electric CRD, Information System Operation
C
      PARAMETER(MAXDIM = 1024)
      CHARACTER*10 STR1,STR2,STR3,STR4,MESS*8
      LOGICAL FAILED
      INTEGER NTESTS,NFAILS,IX,N
      REAL X,TOL
      COMPLEX Y,WORK,CRY,DIFF
      DIMENSION X(MAXDIM),Y(MAXDIM),CRY(MAXDIM),WORK(3*MAXDIM/2 + 2)

C  Read and write input data and read previous results.
      READ(13,*) STR1,N
      MESS = 'DRRCFFT2'
      CALL DIMCHECK(N,MAXDIM,MESS)
      READ(13,*) STR2,IX
      READ(13,*) STR3,(X(I), I=1,N)
      READ(13,*) STR4,(CRY(I), I=1,N/2+1)
      WRITE(14,600) STR1,N
      WRITE(14,600) STR2,IX
      WRITE(14,605) STR3,(X(I), I=1,N)

C  Initialize the work space to zero.
      DO 5 I = 1,5*N/2
    5    WORK(I) = 0.0

      CALL RCFFT2(1,IX,N,X,WORK,Y)
      CALL RCFFT2(0,IX,N,X,WORK,Y)

C  Check difference between new and previous results.
      FAILED = .FALSE.
      DO 10 I = 1,N/2+1
         DIFF = CRY(I) - Y(I)
         IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE.
   10 CONTINUE

C  Output new results and increment counters.
      WRITE(14,610) STR4,(Y(I), I=1,N/2+1)
      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))
  610 FORMAT('''',A10,'''',1X,'(',G14.7,',',G14.7,')',2X,'(',G14.7,
     &    ',',G14.7,')',:/(13X,'(',G14.7,',',G14.7,')',2X,'(',G14.7,
     &    ',',G14.7,')'))

      RETURN
      END

C-------------------------------------------------------------     ************
C                                                                    DRCRFFT2
C                                                                  ************
      SUBROUTINE DRCRFFT2(NTESTS,NFAILS,TOL)
C
C     Test driver for CRFFT2.
C     Martin J. McBride.  1/6/86.
C     General Electric CRD, Information System Operation
C
      PARAMETER(MAXDIM = 1024)
      CHARACTER*10 STR1,STR2,STR3,STR4,MESS*8
      LOGICAL FAILED
      INTEGER NTESTS,NFAILS,IX,N,ULIM
      REAL Y,CRY,TOL,DIFF
      COMPLEX X,WORK
      DIMENSION X(MAXDIM/2+1),Y(MAXDIM),CRY(MAXDIM),WORK(3*MAXDIM/2+2)

C  Read and write input data and read previous results.
      READ(13,*) STR1,N
      MESS = 'DRCRFFT2'
      CALL DIMCHECK(N,MAXDIM,MESS)
      READ(13,*) STR2,IX
      READ(13,*) STR3,(X(I), I=1,N/2+1)
      READ(13,*) STR4,(CRY(I), I=1,N)
      WRITE(14,600) STR1,N
      WRITE(14,600) STR2,IX
      WRITE(14,605) STR3,(X(I), I=1,N/2+1)

C  Initialize the work space to zero.
      ULIM = 3 * N/2 + 2
      DO 5 I = 1,ULIM
    5    WORK(I) = 0.0

      CALL CRFFT2(1,IX,N,X,WORK,Y)
      CALL CRFFT2(0,IX,N,X,WORK,Y)

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

C  Output new results and increment counters.
      WRITE(14,610) STR4,(Y(I), I=1,N)
      IF (FAILED) NFAILS = NFAILS + 1
      NTESTS = NTESTS + 1
  600 FORMAT('''',A10,'''',1X,I4)
  605 FORMAT('''',A10,'''',1X,'(',G14.7,',',G14.7,')',2X,'(',G14.7,
     &    ',',G14.7,')',:/(13X,'(',G14.7,',',G14.7,')',2X,'(',G14.7,
     &    ',',G14.7,')'))
  610 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