PROGRAM DRBLASD C C Driver for testing double precision BLAS routines. C Martin J. McBride. 7/12/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: 1 Input data for BLAS C Output: 2 Output data for BLAS C PARAMETER(NROUTS = 33) CHARACTER ROUTNME*31,SUBNAME*31,IDENT*5,DATEIN*8 CHARACTER DATERUN*8,COMMENTS*23,HRDWRE*30,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 33 subprograms of BLAS. SUBNAME(1) = 'ISAMAX' SUBNAME(2) = 'SASUM' SUBNAME(3) = 'SAXPY' SUBNAME(4) = 'SCOPY' SUBNAME(5) = 'SNRM2' SUBNAME(6) = 'SDOT' SUBNAME(7) = 'SROTG' SUBNAME(8) = 'SROT' SUBNAME(9) = 'SROTMG' SUBNAME(10) = 'SROTM' SUBNAME(11) = 'SSCAL' SUBNAME(12) = 'SSWAP' SUBNAME(13) = 'SPAXPY' SUBNAME(14) = 'SPDOT' SUBNAME(15) = 'ISMAX' SUBNAME(16) = 'ISMIN' SUBNAME(17) = 'ISAMIN' SUBNAME(18) = 'SSUM' SUBNAME(19) = 'SMACH' SUBNAME(20) = 'ICAMAX' SUBNAME(21) = 'SCASUM' SUBNAME(22) = 'CAXPY' SUBNAME(23) = 'CCOPY' SUBNAME(24) = 'SCNRM2' SUBNAME(25) = 'CDOTC' SUBNAME(26) = 'CDOTU' SUBNAME(27) = 'CSSCAL' SUBNAME(28) = 'CSCAL' SUBNAME(29) = 'CSWAP' SUBNAME(30) = 'CSUM' SUBNAME(31) = 'CROTG' SUBNAME(32) = 'CROT' SUBNAME(33) = 'CMACH' C Initialization of tolerance value and CRAY information. TOL = 0.0000000001 READ(3,505) HRDWRE CLOSE(3) C Initialization of input data heading. READ(1,500,END=99) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,COMMENTS 15 IF (ROUTNME .NE. ' ') GO TO 20 READ(1,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(1,505) DUMMY CALL FDATE(DATERUN) WRITE(2,590) WRITE(2,590) WRITE(2,600) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,COMMENTS WRITE(2,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. 'ISAMAX') THEN TEMP = NFAILS(1) CALL DRISAMAX(NTESTS(1),NFAILS(1)) IF (NFAILS(1) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'SASUM') THEN TEMP = NFAILS(2) CALL DRSASUM(NTESTS(2),NFAILS(2),TOL) IF (NFAILS(2) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'SAXPY') THEN TEMP = NFAILS(3) CALL DRSAXPY(NTESTS(3),NFAILS(3),TOL) IF (NFAILS(3) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'SCOPY') THEN TEMP = NFAILS(4) CALL DRSCOPY(NTESTS(4),NFAILS(4),TOL) IF (NFAILS(4) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'SNRM2') THEN TEMP = NFAILS(5) CALL DRSNRM2(NTESTS(5),NFAILS(5),TOL) IF (NFAILS(5) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'SDOT') THEN TEMP = NFAILS(6) CALL DRSDOT(NTESTS(6),NFAILS(6),TOL) IF (NFAILS(6) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'SROTG') THEN TEMP = NFAILS(7) CALL DRSROTG(NTESTS(7),NFAILS(7),TOL) IF (NFAILS(7) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'SROT') THEN TEMP = NFAILS(8) CALL DRSROT(NTESTS(8),NFAILS(8),TOL) IF (NFAILS(8) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'SROTMG') THEN TEMP = NFAILS(9) CALL DRSROTMG(NTESTS(9),NFAILS(9)) IF (NFAILS(9) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'SROTM') THEN TEMP = NFAILS(10) CALL DRSROTM(NTESTS(10),NFAILS(10),TOL) IF (NFAILS(10) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'SSCAL') THEN TEMP = NFAILS(11) CALL DRSSCAL(NTESTS(11),NFAILS(11),TOL) IF (NFAILS(11) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'SSWAP') THEN TEMP = NFAILS(12) CALL DRSSWAP(NTESTS(12),NFAILS(12),TOL) IF (NFAILS(12) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'SPAXPY') THEN TEMP = NFAILS(13) CALL DRSPAXPY(NTESTS(13),NFAILS(13),TOL) IF (NFAILS(13) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'SPDOT') THEN TEMP = NFAILS(14) CALL DRSPDOT(NTESTS(14),NFAILS(14),TOL) IF (NFAILS(14) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'ISMAX') THEN TEMP = NFAILS(15) CALL DRISMAX(NTESTS(15),NFAILS(15)) IF (NFAILS(15) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'ISMIN') THEN TEMP = NFAILS(16) CALL DRISMIN(NTESTS(16),NFAILS(16)) IF (NFAILS(16) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'ISAMIN') THEN TEMP = NFAILS(17) CALL DRISAMIN(NTESTS(17),NFAILS(17)) IF (NFAILS(17) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'SSUM') THEN TEMP = NFAILS(18) CALL DRSSUM(NTESTS(18),NFAILS(18),TOL) IF (NFAILS(18) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'SMACH') THEN TEMP = NFAILS(19) CALL DRSMACH(NTESTS(19),NFAILS(19),TOL) IF (NFAILS(19) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'ICAMAX') THEN TEMP = NFAILS(20) CALL DRICAMAX(NTESTS(20),NFAILS(20)) IF (NFAILS(20) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'SCASUM') THEN TEMP = NFAILS(21) CALL DRSCASUM(NTESTS(21),NFAILS(21),TOL) IF (NFAILS(21) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'CAXPY') THEN TEMP = NFAILS(22) CALL DRCAXPY(NTESTS(22),NFAILS(22),TOL) IF (NFAILS(22) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'CCOPY') THEN TEMP = NFAILS(23) CALL DRCCOPY(NTESTS(23),NFAILS(23),TOL) IF (NFAILS(23) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'SCNRM2') THEN TEMP = NFAILS(24) CALL DRSCNRM2(NTESTS(24),NFAILS(24),TOL) IF (NFAILS(24) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'CDOTC') THEN TEMP = NFAILS(25) CALL DRCDOTC(NTESTS(25),NFAILS(25),TOL) IF (NFAILS(25) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'CDOTU') THEN TEMP = NFAILS(26) CALL DRCDOTU(NTESTS(26),NFAILS(26),TOL) IF (NFAILS(26) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'CSSCAL') THEN TEMP = NFAILS(27) CALL DRCSSCAL(NTESTS(27),NFAILS(27),TOL) IF (NFAILS(27) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'CSCAL') THEN TEMP = NFAILS(28) CALL DRCSCAL(NTESTS(28),NFAILS(28),TOL) IF (NFAILS(28) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'CSWAP') THEN TEMP = NFAILS(29) CALL DRCSWAP(NTESTS(29),NFAILS(29),TOL) IF (NFAILS(29) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'CSUM') THEN TEMP = NFAILS(30) CALL DRCSUM(NTESTS(30),NFAILS(30),TOL) IF (NFAILS(30) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'CROTG') THEN TEMP = NFAILS(31) CALL DRCROTG(NTESTS(31),NFAILS(31),TOL) IF (NFAILS(31) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'CROT') THEN TEMP = NFAILS(32) CALL DRCROT(NTESTS(32),NFAILS(32),TOL) IF (NFAILS(32) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'CMACH') THEN TEMP = NFAILS(33) CALL DRCMACH(NTESTS(33),NFAILS(33),TOL) IF (NFAILS(33) .GT. TEMP) WRITE(6,900) IDENT ELSE WRITE(6,*) 'ERROR IN ROUTINE NAME --- ',ROUTNME WRITE(6,*) ' IDENTIFICATION #',IDENT STOP ENDIF 900 FORMAT(1X,'ERROR IN SCIPORT RESULT - DATA ID# ',A5) C Read next data input heading. READ(1,500,END=99) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,COMMENTS 30 IF (ROUTNME .NE. ' ') GO TO 20 READ(1,500,END=99) ROUTNME,IDENT,DATEIN,PERSON,DATERUN, & COMMENTS GO TO 30 99 CONTINUE WRITE(2,590) WRITE(2,590) WRITE(2,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(1) CLOSE(2) END C------------------------------------------------------------- ************ C DRISAMAX C ************ SUBROUTINE DRISAMAX(NTESTS,NFAILS) C C Test driver for ISAMAX. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,MESS*8 INTEGER N,INCX,NUM,I,CRIMAX,IMAX,NFAILS,NTESTS INTEGER ABSINCX DOUBLE PRECISION SX DIMENSION SX(MAXDIM) C Read and write input data and read CRAY result. READ(1,*) STR1,NUM N = NUM MESS = 'DRISAMAX' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX READ(1,*) STR3,(SX(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,600) STR2,INCX WRITE(2,610) STR3,(SX(I), I=1,NUM) ABSINCX = ABS(INCX) IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX READ(1,*) STR4,CRIMAX IMAX = ISAMAX(N,SX,INCX) C Write new result and test for same result. WRITE(2,600) STR4,IMAX IF (IMAX .NE. CRIMAX) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 610 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14,',', & G21.14,',',G21.14)) RETURN END C------------------------------------------------------------- ************ C DRICAMAX C ************ SUBROUTINE DRICAMAX(NTESTS,NFAILS) C C Test driver for ICAMAX. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,MESS*8 INTEGER N,INCX,NUM,I,CRIMAX,IMAX,NFAILS,NTESTS INTEGER ABSINCX COMPLEX*16 CX DIMENSION CX(MAXDIM) C Read and write input data and read CRAY result. READ(1,*) STR1,NUM N = NUM MESS = 'DRICAMAX' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX READ(1,*) STR3,(CX(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,600) STR2,INCX WRITE(2,610) STR3,(CX(I), I=1,NUM) ABSINCX = ABS(INCX) IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX READ(1,*) STR4,CRIMAX IMAX = ICAMAX(N,CX,INCX) C Write new result and test for same result. WRITE(2,600) STR4,IMAX IF (IMAX .NE. CRIMAX) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 610 FORMAT('''',A10,'''',1X,'(',G21.14,',',G21.14,')',:/ & (13X,'(',G21.14,',',G21.14,')')) RETURN END C------------------------------------------------------------- ************ C DRSASUM C ************ SUBROUTINE DRSASUM(NTESTS,NFAILS,TOL) C C Test driver for SASUM. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,MESS*7 INTEGER N,INCX,NUM,I,NFAILS,NTESTS INTEGER ABSINCX DOUBLE PRECISION SX,SUM,CRSUM,DIFF,TOL,SASUM DIMENSION SX(MAXDIM) C Read and write input data and read CRAY result. READ(1,*) STR1,NUM N = NUM MESS = 'DRSASUM' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX READ(1,*) STR3,(SX(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,600) STR2,INCX WRITE(2,610) STR3,(SX(I), I=1,NUM) ABSINCX = ABS(INCX) IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX READ(1,*) STR4,CRSUM SUM = SASUM(N,SX,INCX) C Test for close results. DIFF = SUM - CRSUM IF (DIFF .GE. TOL) NFAILS = NFAILS + 1 C Write new result. WRITE(2,615) STR4,SUM NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 610 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14,',', & G21.14,',',G21.14)) 615 FORMAT('''',A10,'''',1X,G21.14) RETURN END C------------------------------------------------------------- ************ C DRSCASUM C ************ SUBROUTINE DRSCASUM(NTESTS,NFAILS,TOL) C C Test driver for SCASUM. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,MESS*8 INTEGER N,INCX,NUM,I,NFAILS,NTESTS INTEGER ABSINCX DOUBLE PRECISION TOL,DIFF,SUM,CRSUM,SCASUM COMPLEX*16 CX DIMENSION CX(MAXDIM) C Read and write input data and read CRAY result. READ(1,*) STR1,NUM N = NUM MESS = 'DRSCASUM' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX READ(1,*) STR3,(CX(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,600) STR2,INCX WRITE(2,610) STR3,(CX(I), I=1,NUM) ABSINCX = ABS(INCX) IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX READ(1,*) STR4,CRSUM SUM = SCASUM(N,CX,INCX) C Test for close results. DIFF = SUM - CRSUM IF (DIFF .GE. TOL) NFAILS = NFAILS + 1 C Write new result. WRITE(2,615) STR4,SUM NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 610 FORMAT('''',A10,'''',1X,'(',G21.14,',',G21.14,')',:/ & (13X,'(',G21.14,',',G21.14,')')) 615 FORMAT('''',A10,'''',1X,G21.14) RETURN END C------------------------------------------------------------- ************ C DRSAXPY C ************ SUBROUTINE DRSAXPY(NTESTS,NFAILS,TOL) C C Test driver for SAXPY. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,STR6,MESS*7 INTEGER N,INCX,INCY,NUM,I,NTESTS,NFAILS,IY INTEGER ABSINCX,ABSINCY LOGICAL FAILED DOUBLE PRECISION SA,SX,SY,CRSY,DIFF,TOL DIMENSION SX(MAXDIM),SY(MAXDIM),CRSY(MAXDIM) C Read and write input data, compute N, and read CRAY results. READ(1,*) STR1,NUM N = NUM MESS = 'DRSAXPY' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX,INCY READ(1,*) STR3,SA READ(1,*) STR4,(SX(I), I=1,NUM) READ(1,*) STR5,(SY(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,605) STR2,INCX,INCY WRITE(2,610) STR3,SA WRITE(2,615) STR4,(SX(I), I=1,NUM) WRITE(2,615) STR5,(SY(I), I=1,NUM) ABSINCX = ABS(INCX) ABSINCY = ABS(INCY) IF (INCX .GE. INCY) THEN IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX ELSE IF (INCY .NE. 0) N = (NUM + (ABSINCY-1))/ABSINCY ENDIF READ(1,*) STR6,(CRSY(I), I=1,NUM) CALL SAXPY(N,SA,SX,INCX,SY,INCY) C Test differences in old and new results, and write new results. IY = 1 FAILED = .FALSE. DO 10 I = 1,N DIFF = SY(IY) - CRSY(IY) IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE. IY = IY + INCY 10 CONTINUE WRITE(2,615) STR6,(SY(I), I=1,NUM) C Increment number of failures (if any) and number of tests for SAXPY. IF (FAILED) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 605 FORMAT('''',A10,'''',1X,2I4) 610 FORMAT('''',A10,'''',1X,G21.14) 615 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14,',', & G21.14,',',G21.14)) RETURN END C------------------------------------------------------------- ************ C DRCAXPY C ************ SUBROUTINE DRCAXPY(NTESTS,NFAILS,TOL) C C Test driver for CAXPY. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,STR6,MESS*7 INTEGER N,INCX,INCY,NUM,I,NTESTS,NFAILS,IY INTEGER ABSINCX,ABSINCY LOGICAL FAILED DOUBLE PRECISION TOL COMPLEX*16 CA,CX,CY,CRSY,DIFF DIMENSION CX(MAXDIM),CY(MAXDIM),CRSY(MAXDIM) C Read and write input data, compute N, and read CRAY results. READ(1,*) STR1,NUM N = NUM MESS = 'DRCAXPY' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX,INCY READ(1,*) STR3,CA READ(1,*) STR4,(CX(I), I=1,NUM) READ(1,*) STR5,(CY(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,605) STR2,INCX,INCY WRITE(2,610) STR3,CA WRITE(2,615) STR4,(CX(I), I=1,NUM) WRITE(2,615) STR5,(CY(I), I=1,NUM) ABSINCX = ABS(INCX) ABSINCY = ABS(INCY) IF (INCX .GE. INCY) THEN IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX ELSE IF (INCY .NE. 0) N = (NUM + (ABSINCY-1))/ABSINCY ENDIF READ(1,*) STR6,(CRSY(I), I=1,NUM) CALL CAXPY(N,CA,CX,INCX,CY,INCY) C Test differences in old and new results, and write new results. IY = 1 FAILED = .FALSE. DO 10 I = 1,N DIFF = CY(IY) - CRSY(IY) IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE. IY = IY + INCY 10 CONTINUE WRITE(2,615) STR6,(CY(I), I=1,NUM) C Increment number of failures (if any) and number of tests for CAXPY. IF (FAILED) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 605 FORMAT('''',A10,'''',1X,2I4) 610 FORMAT('''',A10,'''',1X,'(',G21.14,',',G21.14,')') 615 FORMAT('''',A10,'''',1X,'(',G21.14,',',G21.14,')',:/ & (13X,'(',G21.14,',',G21.14,')')) RETURN END C------------------------------------------------------------- ************ C DRSCOPY C ************ SUBROUTINE DRSCOPY(NTESTS,NFAILS,TOL) C C Test driver for SCOPY. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,MESS*7 INTEGER N,INCX,INCY,NUM,I,NTESTS,NFAILS,IY INTEGER ABSINCX,ABSINCY LOGICAL FAILED DOUBLE PRECISION SX,SY,CRSY,DIFF,TOL DIMENSION SX(MAXDIM),SY(MAXDIM),CRSY(MAXDIM) C Read and write input data, compute N, and read CRAY results. READ(1,*) STR1,NUM N = NUM MESS = 'DRSCOPY' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX,INCY READ(1,*) STR3,(SX(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,605) STR2,INCX,INCY WRITE(2,610) STR3,(SX(I), I=1,NUM) ABSINCX = ABS(INCX) ABSINCY = ABS(INCY) IF (INCX .GE. INCY) THEN IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX ELSE IF (INCY .NE. 0) N = (NUM + (ABSINCY-1))/ABSINCY ENDIF READ(1,*) STR4,(CRSY(I), I=1,NUM) CALL SCOPY(N,SX,INCX,SY,INCY) C Test differences in old and new results, and write new results. IY = 1 FAILED = .FALSE. DO 10 I = 1,N DIFF = SY(IY) - CRSY(IY) IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE. IY = IY + INCY 10 CONTINUE WRITE(2,610) STR4,(SY(I), I=1,NUM) C Increment number of failures (if any) and number of tests for SAXPY. IF (FAILED) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 605 FORMAT('''',A10,'''',1X,2I4) 610 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14,',', & G21.14,',',G21.14)) RETURN END C------------------------------------------------------------- ************ C DRCCOPY C ************ SUBROUTINE DRCCOPY(NTESTS,NFAILS,TOL) C C Test driver for CCOPY. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,MESS*7 INTEGER N,INCX,INCY,NUM,I,NTESTS,NFAILS,IY INTEGER ABSINCX LOGICAL FAILED DOUBLE PRECISION TOL COMPLEX*16 CX,CY,CRSY,DIFF DIMENSION CX(MAXDIM),CY(MAXDIM),CRSY(MAXDIM) C Read and write input data, compute N, and read CRAY results. READ(1,*) STR1,NUM N = NUM MESS = 'DRCCOPY' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX,INCY READ(1,*) STR3,(CX(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,605) STR2,INCX,INCY WRITE(2,610) STR3,(CX(I), I=1,NUM) ABSINCX = ABS(INCX) IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX READ(1,*) STR4,(CRSY(I), I=1,NUM) CALL CCOPY(N,CX,INCX,CY,INCY) C Test differences in old and new results, and write new results. IY = 1 FAILED = .FALSE. DO 10 I = 1,N DIFF = CY(IY) - CRSY(IY) IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE. IY = IY + INCY 10 CONTINUE WRITE(2,610) STR4,(CY(I), I=1,NUM) C Increment number of failures (if any) and number of tests for CAXPY. IF (FAILED) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 605 FORMAT('''',A10,'''',1X,2I4) 610 FORMAT('''',A10,'''',1X,'(',G21.14,',',G21.14,')',:/ & (13X,'(',G21.14,',',G21.14,')')) RETURN END C------------------------------------------------------------- ************ C DRSDOT C ************ SUBROUTINE DRSDOT(NTESTS,NFAILS,TOL) C C Test driver for SDOT. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,MESS*6 INTEGER N,INCX,INCY,NUM,I,NTESTS,NFAILS INTEGER ABSINCX,ABSINCY DOUBLE PRECISION SX,SY,CRDOT,DOT,TOL,DIFF,SDOT DIMENSION SX(MAXDIM),SY(MAXDIM) C Read and write input data, compute N, and read CRAY results. READ(1,*) STR1,NUM N = NUM MESS = 'DRSDOT' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX,INCY READ(1,*) STR3,(SX(I), I=1,NUM) READ(1,*) STR4,(SY(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,605) STR2,INCX,INCY WRITE(2,610) STR3,(SX(I), I=1,NUM) WRITE(2,610) STR4,(SY(I), I=1,NUM) ABSINCX = ABS(INCX) ABSINCY = ABS(INCY) IF (INCX .GE. INCY) THEN IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX ELSE IF (INCY .NE. 0) N = (NUM + (ABSINCY-1))/ABSINCY ENDIF READ(1,*) STR5,CRDOT DOT = SDOT(N,SX,INCX,SY,INCY) C Test differences in old and new results, and write new results. WRITE(2,615) STR5,DOT DIFF = DOT - CRDOT IF (DIFF .GE. TOL) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 605 FORMAT('''',A10,'''',1X,2I4) 610 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14,',', & G21.14,',',G21.14)) 615 FORMAT('''',A10,'''',1X,G21.14) RETURN END C------------------------------------------------------------- ************ C DRCDOTC C ************ SUBROUTINE DRCDOTC(NTESTS,NFAILS,TOL) C C Test driver for CDOTC. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,MESS*7 INTEGER N,INCX,INCY,NUM,I,NTESTS,NFAILS INTEGER ABSINCX,ABSINCY DOUBLE PRECISION TOL COMPLEX*16 CX,CY,CRDOT,CDOT,DIFF,CDOTC DIMENSION CX(MAXDIM),CY(MAXDIM) C Read and write input data, compute N, and read CRAY results. READ(1,*) STR1,NUM N = NUM MESS = 'DRCDOTC' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX,INCY READ(1,*) STR3,(CX(I), I=1,NUM) READ(1,*) STR4,(CY(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,605) STR2,INCX,INCY WRITE(2,610) STR3,(CX(I), I=1,NUM) WRITE(2,610) STR4,(CY(I), I=1,NUM) ABSINCX = ABS(INCX) ABSINCY = ABS(INCY) IF (INCX .GE. INCY) THEN IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX ELSE IF (INCY .NE. 0) N = (NUM + (ABSINCY-1))/ABSINCY ENDIF READ(1,*) STR5,CRDOT CDOT = CDOTC(N,CX,INCX,CY,INCY) C Test differences in old and new results, and write new results. WRITE(2,615) STR5,CDOT DIFF = CDOT - CRDOT IF (ABS(DIFF) .GE. TOL) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 605 FORMAT('''',A10,'''',1X,2I4) 610 FORMAT('''',A10,'''',1X,'(',G21.14,',',G21.14,')',:/ & (13X,'(',G21.14,',',G21.14,')')) 615 FORMAT('''',A10,'''',1X,'(',G21.14,',',G21.14,')') RETURN END C------------------------------------------------------------- ************ C DRCDOTU C ************ SUBROUTINE DRCDOTU(NTESTS,NFAILS,TOL) C C Test driver for CDOTU. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,MESS*7 INTEGER N,INCX,INCY,NUM,I,NTESTS,NFAILS INTEGER ABSINCX,ABSINCY DOUBLE PRECISION TOL COMPLEX*16 CX,CY,CRDOT,CDOT,DIFF,CDOTU DIMENSION CX(MAXDIM),CY(MAXDIM) C Read and write input data, compute N, and read CRAY results. READ(1,*) STR1,NUM N = NUM MESS = 'DRCDOTU' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX,INCY READ(1,*) STR3,(CX(I), I=1,NUM) READ(1,*) STR4,(CY(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,605) STR2,INCX,INCY WRITE(2,610) STR3,(CX(I), I=1,NUM) WRITE(2,610) STR4,(CY(I), I=1,NUM) ABSINCX = ABS(INCX) ABSINCY = ABS(INCY) IF (INCX .GE. INCY) THEN IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX ELSE IF (INCY .NE. 0) N = (NUM + (ABSINCY-1))/ABSINCY ENDIF READ(1,*) STR5,CRDOT CDOT = CDOTU(N,CX,INCX,CY,INCY) C Test differences in old and new results, and write new results. WRITE(2,615) STR5,CDOT DIFF = CDOT - CRDOT IF (ABS(DIFF) .GE. TOL) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 605 FORMAT('''',A10,'''',1X,2I4) 610 FORMAT('''',A10,'''',1X,'(',G21.14,',',G21.14,')',:/ & (13X,'(',G21.14,',',G21.14,')')) 615 FORMAT('''',A10,'''',1X,'(',G21.14,',',G21.14,')') RETURN END C------------------------------------------------------------- ************ C DRSNRM2 C ************ SUBROUTINE DRSNRM2(NTESTS,NFAILS,TOL) C C Test driver for SNRM2. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,MESS*7 INTEGER N,INCX,NUM,I,NFAILS,NTESTS INTEGER ABSINCX DOUBLE PRECISION SX,EUCNORM,CREUCNRM,DIFF,TOL,SNRM2 DIMENSION SX(MAXDIM) C Read and write input data and read CRAY result. READ(1,*) STR1,NUM N = NUM MESS = 'DRSNRM2' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX READ(1,*) STR3,(SX(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,600) STR2,INCX WRITE(2,610) STR3,(SX(I), I=1,NUM) ABSINCX = ABS(INCX) IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX READ(1,*) STR4,CREUCNRM EUCNORM = SNRM2(N,SX,INCX) C Test for close results. DIFF = EUCNORM - CREUCNRM IF (DIFF .GE. TOL) NFAILS = NFAILS + 1 C Write new result. WRITE(2,615) STR4,EUCNORM NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 610 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14,',', & G21.14,',',G21.14)) 615 FORMAT('''',A10,'''',1X,G21.14) RETURN END C------------------------------------------------------------- ************ C DRSCNRM2 C ************ SUBROUTINE DRSCNRM2(NTESTS,NFAILS,TOL) C C Test driver for SCNRM2. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,MESS*8 INTEGER N,INCX,NUM,I,NFAILS,NTESTS INTEGER ABSINCX DOUBLE PRECISION EUCNORM,CREUCNRM,DIFF,TOL,SCNRM2 COMPLEX*16 CX DIMENSION CX(MAXDIM) C Read and write input data and read CRAY result. READ(1,*) STR1,NUM N = NUM MESS = 'DRSCNRM2' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX READ(1,*) STR3,(CX(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,600) STR2,INCX WRITE(2,610) STR3,(CX(I), I=1,NUM) ABSINCX = ABS(INCX) IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX READ(1,*) STR4,CREUCNRM EUCNORM = SCNRM2(N,CX,INCX) C Test for close results. DIFF = EUCNORM - CREUCNRM IF (DIFF .GE. TOL) NFAILS = NFAILS + 1 C Write new result. WRITE(2,615) STR4,EUCNORM NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 610 FORMAT('''',A10,'''',1X,'(',G21.14,',',G21.14,')',:/ & (13X,'(',G21.14,',',G21.14,')')) 615 FORMAT('''',A10,'''',1X,G21.14) RETURN END C------------------------------------------------------------- ************ C DRSROTG C ************ SUBROUTINE DRSROTG(NTESTS,NFAILS,TOL) C C Test driver for SROTG. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C CHARACTER*10 STR1,STR2 INTEGER I,NTESTS,NFAILS LOGICAL FAILED DOUBLE PRECISION A,B,C,S,TOL,DIFF DOUBLE PRECISION CRA,CRB,CRC,CRS DIMENSION DIFF(4) C Read and write input data and read CRAY results. READ(1,*) STR1,A,B,C,S WRITE(2,600) STR1,A,B,C,S READ(1,*) STR2,CRA,CRB,CRC,CRS CALL SROTG(A,B,C,S) C Compute differences between CRAY results and new results and compare C with tolerance value. DIFF(1) = A - CRA DIFF(2) = B - CRB DIFF(3) = C - CRC DIFF(4) = S - CRS FAILED = .FALSE. DO 20 I = 1,4 IF (ABS(DIFF(I)) .GE. TOL) FAILED = .TRUE. 20 CONTINUE C Write new results and update counters. WRITE(2,600) STR2,A,B,C,S IF (FAILED) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,G21.14,',',G21.14,:/13X,G21.14, & ',',G21.14) RETURN END C------------------------------------------------------------- ************ C DRSROT C ************ SUBROUTINE DRSROT(NTESTS,NFAILS,TOL) C C Test driver for SROT. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,STR6,STR7,MESS*6 INTEGER N,INCX,INCY,NUM,I,NTESTS,NFAILS,IY,IX INTEGER ABSINCX,ABSINCY LOGICAL FAILED DOUBLE PRECISION SX,SY,CRSY,CRSX,DIFFX,DIFFY,TOL,C,S,A,B DIMENSION SX(MAXDIM),SY(MAXDIM),CRSY(MAXDIM),CRSX(MAXDIM) C Read and write input data, compute N, and read CRAY results. READ(1,*) STR1,NUM N = NUM MESS = 'DRSROT' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX,INCY READ(1,*) STR3,A,B READ(1,*) STR4,(SX(I), I=1,NUM) READ(1,*) STR5,(SY(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,605) STR2,INCX,INCY WRITE(2,610) STR3,A,B WRITE(2,615) STR4,(SX(I), I=1,NUM) WRITE(2,615) STR5,(SY(I), I=1,NUM) ABSINCX = ABS(INCX) ABSINCY = ABS(INCY) IF (INCX .GE. INCY) THEN IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX ELSE IF (INCY .NE. 0) N = (NUM + (ABSINCY-1))/ABSINCY ENDIF READ(1,*) STR6,(CRSX(I), I=1,NUM) READ(1,*) STR7,(CRSY(I), I=1,NUM) CALL SROTG(A,B,C,S) CALL SROT(N,SX,INCX,SY,INCY,C,S) C Test differences in old and new results. IX = 1 IY = 1 FAILED = .FALSE. DO 10 I = 1,N DIFFX = SX(IX) - CRSX(IX) IF (ABS(DIFFX) .GE. TOL) FAILED = .TRUE. DIFFY = SY(IY) - CRSY(IY) IF (ABS(DIFFY) .GE. TOL) FAILED = .TRUE. IX = IX + INCX IY = IY + INCY 10 CONTINUE C Write new results. WRITE(2,615) STR6,(SX(I), I=1,NUM) WRITE(2,615) STR7,(SY(I), I=1,NUM) C Increment number of failures (if any) and number of tests for SROT. IF (FAILED) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 605 FORMAT('''',A10,'''',1X,2I4) 610 FORMAT('''',A10,'''',1X,G21.14,',',G21.14) 615 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14,',', & G21.14,',',G21.14)) RETURN END C------------------------------------------------------------- ************ C DRSROTMG C ************ SUBROUTINE DRSROTMG(NTESTS,NFAILS) C C Test driver for SROTMG. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C CHARACTER*10 STR1,STR2,STR3,STR4 INTEGER I,J,NTESTS,NFAILS LOGICAL FAILED DOUBLE PRECISION D1,B1,D2,B2,PARAM,TOL,DIFF DOUBLE PRECISION CRD1,CRB1,CRD2,CRB2,CRPARAM DIMENSION PARAM(5),CRPARAM(5),DIFF(9) C Read and write input data and read CRAY results. TOL = 0.0000001 READ(1,*) STR1,D1,B1,D2,B2 READ(1,*) STR2,(PARAM(I), I=1,5) WRITE(2,600) STR1,D1,B1,D2,B2 WRITE(2,605) STR2,(PARAM(I), I=1,5) READ(1,*) STR3,CRD1,CRB1,CRD2,CRB2 READ(1,*) STR4,(CRPARAM(I), I=1,5) CALL SROTMG(D1,B1,D2,B2,PARAM) C Compute differences between CRAY results and new results and compare C with tolerance value. DIFF(1) = D1 - CRD1 DIFF(2) = D2 - CRD2 DIFF(3) = B1 - CRB1 DIFF(4) = B2 - CRB2 DO 10 I = 5,9 J = I - 4 DIFF(I) = PARAM(J) - CRPARAM(J) 10 CONTINUE FAILED = .FALSE. DO 20 I = 1,9 IF (ABS(DIFF(I)) .GE. TOL) FAILED = .TRUE. 20 CONTINUE C Write new results. WRITE(2,600) STR3,D1,B1,D2,B2 WRITE(2,605) STR4,(PARAM(I), I=1,5) IF (FAILED) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,G21.14,',',G21.14,:/13X,G21.14, & ',',G21.14) 605 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/13X,G21.14, & ',',G21.14) RETURN END C------------------------------------------------------------- ************ C DRSROTM C ************ SUBROUTINE DRSROTM(NTESTS,NFAILS,TOL) C C Test driver for SROTM. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,STR6,STR7,MESS*7 INTEGER N,INCX,INCY,NUM,I,NTESTS,NFAILS,IY,IX INTEGER ABSINCX,ABSINCY LOGICAL FAILED DOUBLE PRECISION SX,SY,CRSY,CRSX,DIFFX,DIFFY,TOL,PARAM DIMENSION SX(MAXDIM),SY(MAXDIM),CRSY(MAXDIM),CRSX(MAXDIM) DIMENSION PARAM(5) C Read and write input data, compute N, and read CRAY results. READ(1,*) STR1,NUM N = NUM MESS = 'DRSROTM' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX,INCY READ(1,*) STR3,(PARAM(I), I=1,5) READ(1,*) STR4,(SX(I), I=1,NUM) READ(1,*) STR5,(SY(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,605) STR2,INCX,INCY WRITE(2,610) STR3,(PARAM(I), I=1,5) WRITE(2,615) STR4,(SX(I), I=1,NUM) WRITE(2,615) STR5,(SY(I), I=1,NUM) ABSINCX = ABS(INCX) ABSINCY = ABS(INCY) IF (INCX .GE. INCY) THEN IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX ELSE IF (INCY .NE. 0) N = (NUM + (ABSINCY-1))/ABSINCY ENDIF READ(1,*) STR6,(CRSX(I), I=1,NUM) READ(1,*) STR7,(CRSY(I), I=1,NUM) CALL SROTM(N,SX,INCX,SY,INCY,PARAM) C Test differences in old and new results. IX = 1 IY = 1 FAILED = .FALSE. DO 10 I = 1,N DIFFX = SX(IX) - CRSX(IX) IF (ABS(DIFFX) .GE. TOL) FAILED = .TRUE. DIFFY = SY(IY) - CRSY(IY) IF (ABS(DIFFY) .GE. TOL) FAILED = .TRUE. IX = IX + INCX IY = IY + INCY 10 CONTINUE C Write new results. WRITE(2,615) STR6,(SX(I), I=1,NUM) WRITE(2,615) STR7,(SY(I), I=1,NUM) C Increment number of failures (if any) and number of tests for SROTM. IF (FAILED) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 605 FORMAT('''',A10,'''',1X,2I4) 610 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/13X,G21.14, & ',',G21.14) 615 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14,',', & G21.14,',',G21.14)) RETURN END C------------------------------------------------------------- ************ C DRSSCAL C ************ SUBROUTINE DRSSCAL(NTESTS,NFAILS,TOL) C C Test driver for SSCAL. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,MESS*7 INTEGER N,INCX,NUM,I,NFAILS,NTESTS,IX INTEGER ABSINCX LOGICAL FAILED DOUBLE PRECISION SX,SA,CRSX,DIFF,TOL DIMENSION SX(MAXDIM),CRSX(MAXDIM) C Read and write input data and read CRAY result. READ(1,*) STR1,NUM N = NUM MESS = 'DRSSCAL' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX READ(1,*) STR3,SA READ(1,*) STR4,(SX(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,600) STR2,INCX WRITE(2,605) STR3,SA WRITE(2,610) STR4,(SX(I), I=1,NUM) ABSINCX = ABS(INCX) IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX READ(1,*) STR5,(CRSX(I), I=1,NUM) CALL SSCAL(N,SA,SX,INCX) C Test for same results. IX = 1 FAILED = .FALSE. DO 10 I = 1,N DIFF = SX(IX) - CRSX(IX) IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE. IX = IX + INCX 10 CONTINUE C Write results and increment counters. WRITE(2,610) STR5,(SX(I), I=1,NUM) IF (FAILED) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 605 FORMAT('''',A10,'''',1X,G21.14) 610 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14,',', & G21.14,',',G21.14)) RETURN END C------------------------------------------------------------- ************ C DRCSSCAL C ************ SUBROUTINE DRCSSCAL(NTESTS,NFAILS,TOL) C C Test driver for CSSCAL. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,MESS*8 INTEGER N,INCX,NUM,I,NFAILS,NTESTS,IX INTEGER ABSINCX LOGICAL FAILED DOUBLE PRECISION SA,TOL COMPLEX*16 CX,CRSX,DIFF DIMENSION CX(MAXDIM),CRSX(MAXDIM) C Read and write input data and read CRAY result. READ(1,*) STR1,NUM N = NUM MESS = 'DRCSSCAL' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX READ(1,*) STR3,SA READ(1,*) STR4,(CX(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,600) STR2,INCX WRITE(2,605) STR3,SA WRITE(2,610) STR4,(CX(I), I=1,NUM) ABSINCX = ABS(INCX) IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX READ(1,*) STR5,(CRSX(I), I=1,NUM) CALL CSSCAL(N,SA,CX,INCX) C Test for same results. IX = 1 FAILED = .FALSE. DO 10 I = 1,N DIFF = CX(IX) - CRSX(IX) IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE. IX = IX + 1 10 CONTINUE C Write results and increment counters. WRITE(2,610) STR5,(CX(I), I=1,NUM) IF (FAILED) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 605 FORMAT('''',A10,'''',1X,G21.14) 610 FORMAT('''',A10,'''',1X,'(',G21.14,',',G21.14,')',:/ & (13X,'(',G21.14,',',G21.14,')')) RETURN END C------------------------------------------------------------- ************ C DRCSCAL C ************ SUBROUTINE DRCSCAL(NTESTS,NFAILS,TOL) C C Test driver for CSCAL. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,MESS*7 INTEGER N,INCX,NUM,I,NFAILS,NTESTS,IX INTEGER ABSINCX LOGICAL FAILED DOUBLE PRECISION TOL COMPLEX*16 CX,CRSX,CA,DIFF DIMENSION CX(MAXDIM),CRSX(MAXDIM) C Read and write input data and read CRAY result. READ(1,*) STR1,NUM N = NUM MESS = 'DRCSCAL' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX READ(1,*) STR3,CA READ(1,*) STR4,(CX(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,600) STR2,INCX WRITE(2,605) STR3,CA WRITE(2,610) STR4,(CX(I), I=1,NUM) ABSINCX = ABS(INCX) IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX READ(1,*) STR5,(CRSX(I), I=1,NUM) CALL CSCAL(N,CA,CX,INCX) C Test for same results. IX = 1 FAILED = .FALSE. DO 10 I = 1,N DIFF = CX(IX) - CRSX(IX) IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE. IX = IX + 1 10 CONTINUE C Write results and increment counters. WRITE(2,610) STR5,(CX(I), I=1,NUM) IF (FAILED) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 605 FORMAT('''',A10,'''',1X,'(',G21.14,',',G21.14,')') 610 FORMAT('''',A10,'''',1X,'(',G21.14,',',G21.14,')',:/ & (13X,'(',G21.14,',',G21.14,')')) RETURN END C------------------------------------------------------------- ************ C DRSSWAP C ************ SUBROUTINE DRSSWAP(NTESTS,NFAILS,TOL) C C Test driver for SSWAP. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,STR6,MESS*7 INTEGER N,INCX,INCY,NUM,I,NTESTS,NFAILS,IY,IX INTEGER ABSINCX,ABSINCY LOGICAL FAILED DOUBLE PRECISION SX,SY,CRSY,CRSX,DIFFX,DIFFY,TOL DIMENSION SX(MAXDIM),SY(MAXDIM),CRSY(MAXDIM),CRSX(MAXDIM) C Read and write input data, compute N, and read CRAY results. READ(1,*) STR1,NUM N = NUM MESS = 'DRSSWAP' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX,INCY READ(1,*) STR3,(SX(I), I=1,NUM) READ(1,*) STR4,(SY(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,605) STR2,INCX,INCY WRITE(2,610) STR3,(SX(I), I=1,NUM) WRITE(2,610) STR4,(SY(I), I=1,NUM) ABSINCX = ABS(INCX) ABSINCY = ABS(INCY) IF (INCX .GE. INCY) THEN IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX ELSE IF (INCY .NE. 0) N = (NUM + (ABSINCY-1))/ABSINCY ENDIF READ(1,*) STR5,(CRSX(I), I=1,NUM) READ(1,*) STR6,(CRSY(I), I=1,NUM) CALL SSWAP(N,SX,INCX,SY,INCY) C Test differences in old and new results. IX = 1 IY = 1 FAILED = .FALSE. DO 10 I = 1,N DIFFX = SX(IX) - CRSX(IX) IF (ABS(DIFFX) .GE. TOL) FAILED = .TRUE. DIFFY = SY(IY) - CRSY(IY) IF (ABS(DIFFY) .GE. TOL) FAILED = .TRUE. IX = IX + INCX IY = IY + INCY 10 CONTINUE C Write new results. WRITE(2,610) STR5,(SX(I), I=1,NUM) WRITE(2,610) STR6,(SY(I), I=1,NUM) C Increment number of failures (if any) and number of tests for SSWAP. IF (FAILED) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 605 FORMAT('''',A10,'''',1X,2I4) 610 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14,',', & G21.14,',',G21.14)) RETURN END C------------------------------------------------------------- ************ C DRCSWAP C ************ SUBROUTINE DRCSWAP(NTESTS,NFAILS,TOL) C C Test driver for CSWAP. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,STR6,MESS*7 INTEGER N,INCX,INCY,NUM,I,NTESTS,NFAILS,IY,IX INTEGER ABSINCX,ABSINCY LOGICAL FAILED DOUBLE PRECISION TOL COMPLEX*16 CX,CY,CRSY,CRSX,DIFFX,DIFFY DIMENSION CX(MAXDIM),CY(MAXDIM),CRSY(MAXDIM),CRSX(MAXDIM) C Read and write input data, compute N, and read CRAY results. READ(1,*) STR1,NUM N = NUM MESS = 'DRCSWAP' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX,INCY READ(1,*) STR3,(CX(I), I=1,NUM) READ(1,*) STR4,(CY(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,605) STR2,INCX,INCY WRITE(2,610) STR3,(CX(I), I=1,NUM) WRITE(2,610) STR4,(CY(I), I=1,NUM) ABSINCX = ABS(INCX) ABSINCY = ABS(INCY) IF (INCX .GE. INCY) THEN IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX ELSE IF (INCY .NE. 0) N = (NUM + (ABSINCY-1))/ABSINCY ENDIF READ(1,*) STR5,(CRSX(I), I=1,NUM) READ(1,*) STR6,(CRSY(I), I=1,NUM) CALL CSWAP(N,CX,INCX,CY,INCY) C Test differences in old and new results. IX = 1 IY = 1 FAILED = .FALSE. DO 10 I = 1,N DIFFX = CX(IX) - CRSX(IX) IF (ABS(DIFFX) .GE. TOL) FAILED = .TRUE. DIFFY = CY(IY) - CRSY(IY) IF (ABS(DIFFY) .GE. TOL) FAILED = .TRUE. IX = IX + INCX IY = IY + INCY 10 CONTINUE C Write new results. WRITE(2,610) STR5,(CX(I), I=1,NUM) WRITE(2,610) STR6,(CY(I), I=1,NUM) C Increment number of failures (if any) and number of tests for CSWAP. IF (FAILED) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 605 FORMAT('''',A10,'''',1X,2I4) 610 FORMAT('''',A10,'''',1X,'(',G21.14,',',G21.14,')',:/ & (13X,'(',G21.14,',',G21.14,')')) RETURN END C------------------------------------------------------------- ************ C DRSPAXPY C ************ SUBROUTINE DRSPAXPY(NTESTS,NFAILS,TOL) C C Test driver for SPAXPY. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,STR6,MESS*8 INTEGER NX,NY,I,NTESTS,NFAILS,INDEX LOGICAL FAILED DOUBLE PRECISION SA,SX,SY,DIFF,CRSY DIMENSION SX(MAXDIM),SY(MAXDIM),INDEX(MAXDIM),CRSY(MAXDIM) C Read and write input data, and read CRAY results. READ(1,*) STR1,NX,NY MESS = 'DRSPAXPY' CALL DIMCHECK(NX,MAXDIM,MESS) CALL DIMCHECK(NY,MAXDIM,MESS) READ(1,*) STR2,SA READ(1,*) STR3,(SX(I), I=1,NX) READ(1,*) STR4,(SY(I), I=1,NY) READ(1,*) STR5,(INDEX(I), I=1,NX) WRITE(2,600) STR1,NX,NY WRITE(2,605) STR2,SA WRITE(2,610) STR3,(SX(I), I=1,NX) WRITE(2,610) STR4,(SY(I), I=1,NY) WRITE(2,615) STR5,(INDEX(I), I=1,NX) READ(1,*) STR6,(CRSY(I), I=1,NX) CALL SPAXPY(NX,SA,SX,SY,INDEX) C Test difference between new results and old results. FAILED = .FALSE. DO 10 I = 1,NX DIFF = SY(INDEX(I)) - CRSY(I) IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE. 10 CONTINUE C Write new results and increment counters. WRITE(2,610) STR6,(SY(INDEX(I)), I=1,NX) IF (FAILED) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,2I4) 605 FORMAT('''',A10,'''',1X,G21.14) 610 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14,',', & G21.14,',',G21.14)) 615 FORMAT('''',A10,'''',1X,9(I5,','),I5,:/(13X,I5,',',I5,',',I5, & ',',I5,',',I5,',',I5,',',I5,',',I5,',',I5,',',I5)) RETURN END C------------------------------------------------------------- ************ C DRSPDOT C ************ SUBROUTINE DRSPDOT(NTESTS,NFAILS,TOL) C C Test driver for SPDOT. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,MESS*7 INTEGER NX,NY,I,NTESTS,NFAILS,INDEX DOUBLE PRECISION SX,SY,DIFF,PDOT,CRPDOT,SPDOT DIMENSION SX(MAXDIM),SY(MAXDIM),INDEX(MAXDIM) C Read and write input data, and read CRAY result. READ(1,*) STR1,NX,NY MESS = 'DRSPDOT' CALL DIMCHECK(NX,MAXDIM,MESS) CALL DIMCHECK(NY,MAXDIM,MESS) READ(1,*) STR2,(SX(I), I=1,NX) READ(1,*) STR3,(SY(I), I=1,NY) READ(1,*) STR4,(INDEX(I), I=1,NX) WRITE(2,600) STR1,NX,NY WRITE(2,610) STR2,(SX(I), I=1,NX) WRITE(2,610) STR3,(SY(I), I=1,NY) WRITE(2,615) STR4,(INDEX(I), I=1,NX) READ(1,*) STR5,CRPDOT PDOT = SPDOT(NX,SY,INDEX,SX) C Write result and test difference between new result and old result. WRITE(2,620) STR5,PDOT DIFF = PDOT - CRPDOT IF (ABS(DIFF) .GE. TOL) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,2I4) 610 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14,',', & G21.14,',',G21.14)) 615 FORMAT('''',A10,'''',1X,9(I5,','),I5,:/(13X,I5,',',I5,',',I5, & ',',I5,',',I5,',',I5,',',I5,',',I5,',',I5,',',I5)) 620 FORMAT('''',A10,'''',1X,G21.14) RETURN END C------------------------------------------------------------- ************ C DRISMAX C ************ SUBROUTINE DRISMAX(NTESTS,NFAILS) C C Test driver for ISMAX. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,MESS*7 INTEGER N,INCX,NUM,I,CRIMAX,IMAX,NFAILS,NTESTS INTEGER ABSINCX DOUBLE PRECISION SX DIMENSION SX(MAXDIM) C Read and write input data and read CRAY result. READ(1,*) STR1,NUM N = NUM MESS = 'DRISMAX' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX READ(1,*) STR3,(SX(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,600) STR2,INCX WRITE(2,610) STR3,(SX(I), I=1,NUM) ABSINCX = ABS(INCX) IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX READ(1,*) STR4,CRIMAX IMAX = ISMAX(N,SX,INCX) C Test for same results. IF (IMAX .NE. CRIMAX) NFAILS = NFAILS + 1 C Write new result. WRITE(2,600) STR4,IMAX NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 610 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14,',', & G21.14,',',G21.14)) RETURN END C------------------------------------------------------------- ************ C DRISMIN C ************ SUBROUTINE DRISMIN(NTESTS,NFAILS) C C Test driver for ISMIN. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,MESS*7 INTEGER N,INCX,NUM,I,CRIMIN,IMIN,NFAILS,NTESTS INTEGER ABSINCX DOUBLE PRECISION SX DIMENSION SX(MAXDIM) C Read and write input data and read CRAY result. READ(1,*) STR1,NUM N = NUM MESS = 'DRISMIN' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX READ(1,*) STR3,(SX(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,600) STR2,INCX WRITE(2,610) STR3,(SX(I), I=1,NUM) ABSINCX = ABS(INCX) IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX READ(1,*) STR4,CRIMIN IMIN = ISMIN(N,SX,INCX) C Test for same results. IF (IMIN .NE. CRIMIN) NFAILS = NFAILS + 1 C Write new result. WRITE(2,600) STR4,IMIN NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 610 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14,',', & G21.14,',',G21.14)) RETURN END C------------------------------------------------------------- ************ C DRISAMIN C ************ SUBROUTINE DRISAMIN(NTESTS,NFAILS) C C Test driver for ISAMIN. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,MESS*8 INTEGER N,INCX,NUM,I,CRIMIN,IMIN,NFAILS,NTESTS INTEGER ABSINCX DOUBLE PRECISION SX DIMENSION SX(MAXDIM) C Read and write input data and read CRAY result. READ(1,*) STR1,NUM N = NUM MESS = 'DRISAMIN' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX READ(1,*) STR3,(SX(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,600) STR2,INCX WRITE(2,610) STR3,(SX(I), I=1,NUM) ABSINCX = ABS(INCX) IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX READ(1,*) STR4,CRIMIN IMIN = ISAMIN(N,SX,INCX) C Test for same results. IF (IMIN .NE. CRIMIN) NFAILS = NFAILS + 1 C Write new result. WRITE(2,600) STR4,IMIN NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 610 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14,',', & G21.14,',',G21.14)) RETURN END C------------------------------------------------------------- ************ C DRSSUM C ************ SUBROUTINE DRSSUM(NTESTS,NFAILS,TOL) C C Test driver for SSUM. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,MESS*6 INTEGER N,INCX,NUM,I,NFAILS,NTESTS INTEGER ABSINCX DOUBLE PRECISION SX,SUM,CRSUM,DIFF,TOL,SSUM DIMENSION SX(MAXDIM) C Read and write input data and read CRAY result. READ(1,*) STR1,NUM N = NUM MESS = 'DRSSUM' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX READ(1,*) STR3,(SX(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,600) STR2,INCX WRITE(2,610) STR3,(SX(I), I=1,NUM) ABSINCX = ABS(INCX) IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX READ(1,*) STR4,CRSUM SUM = SSUM(N,SX,INCX) C Test for close results. DIFF = SUM - CRSUM IF (DIFF .GE. TOL) NFAILS = NFAILS + 1 C Write new result. WRITE(2,615) STR4,SUM NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 610 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14,',', & G21.14,',',G21.14)) 615 FORMAT('''',A10,'''',1X,G21.14) RETURN END C------------------------------------------------------------- ************ C DRCSUM C ************ SUBROUTINE DRCSUM(NTESTS,NFAILS,TOL) C C Test driver for CSUM. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,MESS*6 INTEGER N,INCX,NUM,I,NFAILS,NTESTS INTEGER ABSINCX DOUBLE PRECISION TOL COMPLEX*16 CX,CSUM,SUM,CRSUM,DIFF DIMENSION CX(MAXDIM) C Read and write input data and read CRAY result. READ(1,*) STR1,NUM N = NUM MESS = 'DRCSUM' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX READ(1,*) STR3,(CX(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,600) STR2,INCX WRITE(2,610) STR3,(CX(I), I=1,NUM) ABSINCX = ABS(INCX) IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX READ(1,*) STR4,CRSUM SUM = CSUM(N,CX,INCX) C Test for close results. DIFF = SUM - CRSUM IF (ABS(DIFF) .GE. TOL) NFAILS = NFAILS + 1 C Write new result. WRITE(2,615) STR4,SUM NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 610 FORMAT('''',A10,'''',1X,'(',G21.14,',',G21.14,')',:/ & (13X,'(',G21.14,',',G21.14,')')) 615 FORMAT('''',A10,'''',1X,'(',G21.14,',',G21.14,')') RETURN END C------------------------------------------------------------- ************ C DRCROTG C ************ SUBROUTINE DRCROTG(NTESTS,NFAILS,TOL) C C Test driver for CROTG. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C CHARACTER*10 STR1,STR2 INTEGER I,NTESTS,NFAILS LOGICAL FAILED DOUBLE PRECISION TOL COMPLEX*16 CA,CB,CC,CS,DIFF,CRA,CRB,CRC,CRS DIMENSION DIFF(4) C Read and write input data and read CRAY results. READ(1,*) STR1,CA,CB,CC,CS WRITE(2,600) STR1,CA,CB,CC,CS READ(1,*) STR2,CRA,CRB,CRC,CRS CALL CROTG(CA,CB,CC,CS) C Compute differences between CRAY results and new results and compare C with tolerance value. DIFF(1) = CA - CRA DIFF(2) = CB - CRB DIFF(3) = CC - CRC DIFF(4) = CS - CRS FAILED = .FALSE. DO 20 I = 1,4 IF (ABS(DIFF(I)) .GE. TOL) FAILED = .TRUE. 20 CONTINUE C Write new results and update counters. WRITE(2,600) STR2,CA,CB,CC,CS IF (FAILED) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,'(',G21.14,',',G21.14,')',:/ & (13X,'(',G21.14,',',G21.14,')')) RETURN END C------------------------------------------------------------- ************ C DRCROT C ************ SUBROUTINE DRCROT(NTESTS,NFAILS,TOL) C C Test driver for CROT. C Martin J. McBride. 7/12/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,STR6,STR7,MESS*6 INTEGER N,INCX,INCY,NUM,I,NTESTS,NFAILS,IY,IX INTEGER ABSINCX,ABSINCY LOGICAL FAILED DOUBLE PRECISION TOL COMPLEX*16 CX,CY,CRSY,CRSX,DIFFX,DIFFY,CC,CS,CA,CB DIMENSION CX(MAXDIM),CY(MAXDIM),CRSY(MAXDIM),CRSX(MAXDIM) C Read and write input data, compute N, and read CRAY results. READ(1,*) STR1,NUM N = NUM MESS = 'DRCROT' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(1,*) STR2,INCX,INCY READ(1,*) STR3,CA,CB READ(1,*) STR4,(CX(I), I=1,NUM) READ(1,*) STR5,(CY(I), I=1,NUM) WRITE(2,600) STR1,NUM WRITE(2,605) STR2,INCX,INCY WRITE(2,610) STR3,CA,CB WRITE(2,615) STR4,(CX(I), I=1,NUM) WRITE(2,615) STR5,(CY(I), I=1,NUM) ABSINCX = ABS(INCX) ABSINCY = ABS(INCY) IF (INCX .GE. INCY) THEN IF (INCX .NE. 0) N = (NUM + (ABSINCX-1))/ABSINCX ELSE IF (INCY .NE. 0) N = (NUM + (ABSINCY-1))/ABSINCY ENDIF READ(1,*) STR6,(CRSX(I), I=1,NUM) READ(1,*) STR7,(CRSY(I), I=1,NUM) CALL CROTG(CA,CB,CC,CS) CALL CROT(N,CX,INCX,CY,INCY,CC,CS) C Test differences in old and new results. IX = 1 IY = 1 FAILED = .FALSE. DO 10 I = 1,N DIFFX = CX(IX) - CRSX(IX) IF (ABS(DIFFX) .GE. TOL) FAILED = .TRUE. DIFFY = CY(IY) - CRSY(IY) IF (ABS(DIFFY) .GE. TOL) FAILED = .TRUE. IX = IX + INCX IY = IY + INCY 10 CONTINUE C Write new results. WRITE(2,615) STR6,(CX(I), I=1,NUM) WRITE(2,615) STR7,(CY(I), I=1,NUM) C Increment number of failures (if any) and number of tests for CROT. IF (FAILED) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 605 FORMAT('''',A10,'''',1X,2I4) 610 FORMAT('''',A10,'''',1X,'(',G21.14,',',G21.14,')',:/ & 13X,'(',G21.14,',',G21.14,')') 615 FORMAT('''',A10,'''',1X,'(',G21.14,',',G21.14,')',:/ & (13X,'(',G21.14,',',G21.14,')')) RETURN END C------------------------------------------------------------- ************ C DRCMACH C ************ SUBROUTINE DRCMACH(NTESTS,NFAILS,TOL) INTEGER NTESTS,NFAILS DOUBLE PRECISION CMACH,ONE,TWO,THREE,TOL ONE = CMACH(1) TWO = CMACH(2) THREE = CMACH(3) NTESTS = NTESTS + 1 RETURN END C------------------------------------------------------------- ************ C DRSMACH C ************ SUBROUTINE DRSMACH(NTESTS,NFAILS,TOL) INTEGER NTESTS,NFAILS DOUBLE PRECISION SMACH,ONE,TWO,THREE,TOL ONE = SMACH(1) TWO = SMACH(2) THREE = SMACH(3) NTESTS = NTESTS + 1 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