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