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 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 3 FILTER subprograms. SUBNAME(1) = 'FILTERG' SUBNAME(2) = 'FILTERS' SUBNAME(3) = 'OPFILT' C Initialization of tolerance value and CRAY information. TOL = 0.0000000001 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 = 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 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 = 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(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 DOUBLE PRECISION 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,2(G21.14,','),G21.14,:/(13X,G21.14, & ',',G21.14,',',G21.14)) 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 DOUBLE PRECISION 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,2(G21.14,','),G21.14,:/(13X,G21.14, & ',',G21.14,',',G21.14)) 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 DOUBLE PRECISION 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,2(G21.14,','),G21.14,:/(13X,G21.14, & ',',G21.14,',',G21.14)) 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