PROGRAM DRLINREC C C Driver for testing double precision LINEAR RECURRENCE. C Martin J. McBride. 8/7/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: 9 Input data for Linear Recurrence C Output: 10 Output data for Linear Recurrence C PARAMETER(NROUTS = 8) 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 8 subprograms of Linear C Recurrence. SUBNAME(1) = 'FOLR' SUBNAME(2) = 'FOLRP' SUBNAME(3) = 'FOLR2' SUBNAME(4) = 'FOLR2P' SUBNAME(5) = 'FOLRN' SUBNAME(6) = 'SOLR' SUBNAME(7) = 'SOLRN' SUBNAME(8) = 'SOLR3' C Initialization of tolerance value and CRAY information. TOL = 0.0000000001 READ(3,505) HRDWRE CLOSE(3) C Initialization of data heading. READ(9,500,END=99) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,COMMENTS 15 IF (ROUTNME .NE. ' ') GO TO 20 READ(9,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(9,505) DUMMY CALL FDATE(DATERUN) WRITE(10,590) WRITE(10,590) WRITE(10,600) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,COMMENTS WRITE(10,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. 'FOLR') THEN TEMP = NFAILS(1) CALL DRFOLR(NTESTS(1),NFAILS(1),TOL) IF (NFAILS(1) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'FOLRP') THEN TEMP = NFAILS(2) CALL DRFOLRP(NTESTS(2),NFAILS(2),TOL) IF (NFAILS(2) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'FOLR2') THEN TEMP = NFAILS(3) CALL DRFOLR2(NTESTS(3),NFAILS(3),TOL) IF (NFAILS(3) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'FOLR2P') THEN TEMP = NFAILS(4) CALL DRFOLR2P(NTESTS(4),NFAILS(4),TOL) IF (NFAILS(4) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'FOLRN') THEN TEMP = NFAILS(5) CALL DRFOLRN(NTESTS(5),NFAILS(5),TOL) IF (NFAILS(5) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'SOLR') THEN TEMP = NFAILS(6) CALL DRSOLR(NTESTS(6),NFAILS(6),TOL) IF (NFAILS(6) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'SOLRN') THEN TEMP = NFAILS(7) CALL DRSOLRN(NTESTS(7),NFAILS(7),TOL) IF (NFAILS(7) .GT. TEMP) WRITE(6,900) IDENT ELSE IF (ROUTNME .EQ. 'SOLR3') THEN TEMP = NFAILS(8) CALL DRSOLR3(NTESTS(8),NFAILS(8),TOL) IF (NFAILS(8) .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(9,500,END=99) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,COMMENTS 30 IF (ROUTNME .NE. ' ') GO TO 20 READ(9,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(10,590) WRITE(10,590) WRITE(10,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(9) CLOSE(10) END C------------------------------------------------------------- ************ C DRFOLR C ************ SUBROUTINE DRFOLR(NTESTS,NFAILS,TOL) C C Test driver for FOLR. C Martin J. McBride. 8/8/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,MESS*6 LOGICAL FAILED INTEGER N,INCA,INCB,I,NUM,ABSINCA,ABSINCB INTEGER NTESTS,NFAILS DOUBLE PRECISION A,B,CRB,TOL,DIFF DIMENSION A(MAXDIM),B(MAXDIM),CRB(MAXDIM) C Read and write input data and read previous results. READ(9,*) STR1,NUM N = NUM MESS = 'DRFOLR' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(9,*) STR2,INCA,INCB READ(9,*) STR3,(A(I), I=1,NUM) READ(9,*) STR4,(B(I), I=1,NUM) READ(9,*) STR5,(CRB(I), I=1,NUM) ABSINCA = ABS(INCA) ABSINCB = ABS(INCB) IF (ABSINCA .GE. ABSINCB) THEN IF (INCA .NE. 0) N = (NUM + (ABSINCA-1))/ABSINCA ELSE N = (NUM + (ABSINCB-1))/ABSINCB ENDIF WRITE(10,600) STR1,NUM WRITE(10,605) STR2,INCA,INCB WRITE(10,610) STR3,(A(I), I=1,NUM) WRITE(10,610) STR4,(B(I), I=1,NUM) CALL FOLR(N,A,INCA,B,INCB) C Check difference between new and previous results. FAILED = .FALSE. DO 10 I = 1,NUM DIFF = B(I) - CRB(I) IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE. 10 CONTINUE C Output new results and increment counters. WRITE(10,610) STR5,(B(I), I=1,NUM) 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 DRFOLRP C ************ SUBROUTINE DRFOLRP(NTESTS,NFAILS,TOL) C C Test driver for FOLRP. C Martin J. McBride. 8/8/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,MESS*7 LOGICAL FAILED INTEGER N,INCA,INCB,I,NUM,ABSINCA,ABSINCB INTEGER NTESTS,NFAILS DOUBLE PRECISION A,B,CRB,TOL,DIFF DIMENSION A(MAXDIM),B(MAXDIM),CRB(MAXDIM) C Read and write input data and read previous results. READ(9,*) STR1,NUM N = NUM MESS = 'DRFOLRP' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(9,*) STR2,INCA,INCB READ(9,*) STR3,(A(I), I=1,NUM) READ(9,*) STR4,(B(I), I=1,NUM) READ(9,*) STR5,(CRB(I), I=1,NUM) ABSINCA = ABS(INCA) ABSINCB = ABS(INCB) IF (ABSINCA .GE. ABSINCB) THEN IF (INCA .NE. 0) N = (NUM + (ABSINCA-1))/ABSINCA ELSE N = (NUM + (ABSINCB-1))/ABSINCB ENDIF WRITE(10,600) STR1,NUM WRITE(10,605) STR2,INCA,INCB WRITE(10,610) STR3,(A(I), I=1,NUM) WRITE(10,610) STR4,(B(I), I=1,NUM) CALL FOLRP(N,A,INCA,B,INCB) C Check difference between new and previous results. FAILED = .FALSE. DO 10 I = 1,NUM DIFF = B(I) - CRB(I) IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE. 10 CONTINUE C Output new results and increment counters. WRITE(10,610) STR5,(B(I), I=1,NUM) 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 DRFOLR2 C ************ SUBROUTINE DRFOLR2(NTESTS,NFAILS,TOL) C C Test driver for FOLR2. C Martin J. McBride. 8/8/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,MESS*7 LOGICAL FAILED INTEGER N,INCA,INCB,INCC,ABSINCA,ABSINCB,ABSINCC INTEGER NTESTS,NFAILS,I,NUM DOUBLE PRECISION A,B,C,CRC,TOL,DIFF DIMENSION A(MAXDIM),B(MAXDIM),C(MAXDIM),CRC(MAXDIM) C Read and write input data and read previous results. READ(9,*) STR1,NUM N = NUM MESS = 'DRFOLR2' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(9,*) STR2,INCA,INCB,INCC READ(9,*) STR3,(A(I), I=1,NUM) READ(9,*) STR4,(B(I), I=1,NUM) READ(9,*) STR5,(CRC(I), I=1,NUM) ABSINCA = ABS(INCA) ABSINCB = ABS(INCB) ABSINCC = ABS(INCC) IF (ABSINCA .GE. ABSINCB .AND. ABSINCA .GE. ABSINCC) THEN IF (INCA .NE. 0) N = (NUM + (ABSINCA-1))/ABSINCA ELSE IF (ABSINCB .GE. ABSINCC) THEN IF (INCB .NE. 0) N = (NUM + (ABSINCB-1))/ABSINCB ELSE N = (NUM + (ABSINCC-1))/ABSINCC ENDIF WRITE(10,600) STR1,NUM WRITE(10,605) STR2,INCA,INCB,INCC WRITE(10,610) STR3,(A(I), I=1,NUM) WRITE(10,610) STR4,(B(I), I=1,NUM) CALL FOLR2(N,A,INCA,B,INCB,C,INCC) C Check difference between new and previous results. FAILED = .FALSE. DO 10 I = 1,NUM DIFF = C(I) - CRC(I) IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE. 10 CONTINUE C Output new results and increment counters. WRITE(10,610) STR5,(C(I), I=1,NUM) IF (FAILED) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 605 FORMAT('''',A10,'''',1X,3I4) 610 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14, & ',',G21.14,',',G21.14)) RETURN END C------------------------------------------------------------- ************ C DRFOLR2P C ************ SUBROUTINE DRFOLR2P(NTESTS,NFAILS,TOL) C C Test driver for FOLR2P. C Martin J. McBride. 8/8/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,MESS*8 LOGICAL FAILED INTEGER N,INCA,INCB,INCC,ABSINCA,ABSINCB,ABSINCC INTEGER NTESTS,NFAILS,I,NUM DOUBLE PRECISION A,B,C,CRC,TOL,DIFF DIMENSION A(MAXDIM),B(MAXDIM),C(MAXDIM),CRC(MAXDIM) C Read and write input data and read previous results. READ(9,*) STR1,NUM N = NUM MESS = 'DRFOLR2P' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(9,*) STR2,INCA,INCB,INCC READ(9,*) STR3,(A(I), I=1,NUM) READ(9,*) STR4,(B(I), I=1,NUM) READ(9,*) STR5,(CRC(I), I=1,NUM) ABSINCA = ABS(INCA) ABSINCB = ABS(INCB) ABSINCC = ABS(INCC) IF (ABSINCA .GE. ABSINCB .AND. ABSINCA .GE. ABSINCC) THEN IF (INCA .NE. 0) N = (NUM + (ABSINCA-1))/ABSINCA ELSE IF (ABSINCB .GE. ABSINCC) THEN IF (INCB .NE. 0) N = (NUM + (ABSINCB-1))/ABSINCB ELSE N = (NUM + (ABSINCC-1))/ABSINCC ENDIF WRITE(10,600) STR1,NUM WRITE(10,605) STR2,INCA,INCB,INCC WRITE(10,610) STR3,(A(I), I=1,NUM) WRITE(10,610) STR4,(B(I), I=1,NUM) CALL FOLR2P(N,A,INCA,B,INCB,C,INCC) C Check difference between new and previous results. FAILED = .FALSE. DO 10 I = 1,NUM DIFF = C(I) - CRC(I) IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE. 10 CONTINUE C Output new results and increment counters. WRITE(10,610) STR5,(C(I), I=1,NUM) IF (FAILED) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 605 FORMAT('''',A10,'''',1X,3I4) 610 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14, & ',',G21.14,',',G21.14)) RETURN END C------------------------------------------------------------- ************ C DRFOLRN C ************ SUBROUTINE DRFOLRN(NTESTS,NFAILS,TOL) C C Test driver for FOLRN. C Martin J. McBride. 8/8/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,MESS*7 INTEGER N,INCA,INCB,I,NUM,ABSINCA,ABSINCB INTEGER NTESTS,NFAILS DOUBLE PRECISION A,B,RESULT,TOL,DIFF,CRESULT,FOLRN DIMENSION A(MAXDIM),B(MAXDIM) C Read and write input data and read previous results. READ(9,*) STR1,NUM N = NUM MESS = 'DRFOLRN' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(9,*) STR2,INCA,INCB READ(9,*) STR3,(A(I), I=1,NUM) READ(9,*) STR4,(B(I), I=1,NUM) READ(9,*) STR5,CRESULT ABSINCA = ABS(INCA) ABSINCB = ABS(INCB) IF (ABSINCA .GE. ABSINCB) THEN IF (INCA .NE. 0) N = (NUM + (ABSINCA-1))/ABSINCA ELSE N = (NUM + (ABSINCB-1))/ABSINCB ENDIF WRITE(10,600) STR1,NUM WRITE(10,605) STR2,INCA,INCB WRITE(10,610) STR3,(A(I), I=1,NUM) RESULT = FOLRN(N,A,INCA,B,INCB) WRITE(10,610) STR4,(B(I), I=1,NUM) C Write new result and check difference between new and previous result. WRITE(10,615) STR5,RESULT DIFF = RESULT - CRESULT 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,2(G21.14,','),G21.14,:/(13X,G21.14, & ',',G21.14,',',G21.14)) 615 FORMAT('''',A10,'''',1X,G21.14) RETURN END C------------------------------------------------------------- ************ C DRSOLR C ************ SUBROUTINE DRSOLR(NTESTS,NFAILS,TOL) C C Test driver for SOLR. C Martin J. McBride. 8/8/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,STR6,MESS*6 LOGICAL FAILED INTEGER N,INCA,INCB,INCC,ABSINCA,ABSINCB,ABSINCC INTEGER NTESTS,NFAILS,I,NUM DOUBLE PRECISION A,B,C,CRC,TOL,DIFF DIMENSION A(MAXDIM),B(MAXDIM),C(MAXDIM),CRC(MAXDIM) C Read and write input data and read previous results. READ(9,*) STR1,NUM N = NUM MESS = 'DRSOLR' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(9,*) STR2,INCA,INCB,INCC READ(9,*) STR3,(A(I), I=1,NUM) READ(9,*) STR4,(B(I), I=1,NUM) READ(9,*) STR5,(C(I), I=1,NUM) READ(9,*) STR6,(CRC(I), I=1,NUM) ABSINCA = ABS(INCA) ABSINCB = ABS(INCB) ABSINCC = ABS(INCC) IF (ABSINCA .GE. ABSINCB .AND. ABSINCA .GE. ABSINCC) THEN IF (INCA .NE. 0) N = (NUM + (ABSINCA-1))/ABSINCA ELSE IF (ABSINCB .GE. ABSINCC) THEN IF (INCB .NE. 0) N = (NUM + (ABSINCB-1))/ABSINCB ELSE N = (NUM + (ABSINCC-1))/ABSINCC ENDIF WRITE(10,600) STR1,NUM WRITE(10,605) STR2,INCA,INCB,INCC WRITE(10,610) STR3,(A(I), I=1,NUM) WRITE(10,610) STR4,(B(I), I=1,NUM) WRITE(10,610) STR5,(C(I), I=1,NUM) CALL SOLR(N,A,INCA,B,INCB,C,INCC) C Check difference between new and previous results. FAILED = .FALSE. DO 10 I = 1,NUM DIFF = C(I) - CRC(I) IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE. 10 CONTINUE C Output new results and increment counters. WRITE(10,610) STR6,(C(I), I=1,NUM) IF (FAILED) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 605 FORMAT('''',A10,'''',1X,3I4) 610 FORMAT('''',A10,'''',1X,2(G21.14,','),G21.14,:/(13X,G21.14, & ',',G21.14,',',G21.14)) RETURN END C------------------------------------------------------------- ************ C DRSOLRN C ************ SUBROUTINE DRSOLRN(NTESTS,NFAILS,TOL) C C Test driver for SOLRN. C Martin J. McBride. 8/8/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,STR6,MESS*7 INTEGER N,INCA,INCB,INCC,ABSINCA,ABSINCB,ABSINCC INTEGER NTESTS,NFAILS,I,NUM DOUBLE PRECISION A,B,C,TOL,DIFF,RESULT,CRESULT,SOLRN DIMENSION A(MAXDIM),B(MAXDIM),C(MAXDIM) C Read and write input data and read previous results. READ(9,*) STR1,NUM N = NUM MESS = 'DRSOLRN' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(9,*) STR2,INCA,INCB,INCC READ(9,*) STR3,(A(I), I=1,NUM) READ(9,*) STR4,(B(I), I=1,NUM) READ(9,*) STR5,(C(I), I=1,NUM) READ(9,*) STR6,CRESULT ABSINCA = ABS(INCA) ABSINCB = ABS(INCB) ABSINCC = ABS(INCC) IF (ABSINCA .GE. ABSINCB .AND. ABSINCA .GE. ABSINCC) THEN IF (INCA .NE. 0) N = (NUM + (ABSINCA-1))/ABSINCA ELSE IF (ABSINCB .GE. ABSINCC) THEN IF (INCB .NE. 0) N = (NUM + (ABSINCB-1))/ABSINCB ELSE N = (NUM + (ABSINCC-1))/ABSINCC ENDIF WRITE(10,600) STR1,NUM WRITE(10,605) STR2,INCA,INCB,INCC WRITE(10,610) STR3,(A(I), I=1,NUM) WRITE(10,610) STR4,(B(I), I=1,NUM) RESULT = SOLRN(N,A,INCA,B,INCB,C,INCC) WRITE(10,610) STR5,(C(I), I=1,NUM) C Output new results and increment counters. WRITE(10,615) STR6,RESULT DIFF = RESULT - CRESULT IF (ABS(DIFF) .GE. TOL) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 605 FORMAT('''',A10,'''',1X,3I4) 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 DRSOLR3 C ************ SUBROUTINE DRSOLR3(NTESTS,NFAILS,TOL) C C Test driver for SOLR3. C Martin J. McBride. 8/8/85. C General Electric CRD, Information System Operation. C PARAMETER(MAXDIM = 50) CHARACTER*10 STR1,STR2,STR3,STR4,STR5,STR6,MESS*7 LOGICAL FAILED INTEGER N,INCA,INCB,INCC,ABSINCA,ABSINCB,ABSINCC INTEGER NTESTS,NFAILS,I,NUM DOUBLE PRECISION A,B,C,CRC,TOL,DIFF DIMENSION A(MAXDIM),B(MAXDIM),C(MAXDIM),CRC(MAXDIM) C Read and write input data and read previous results. READ(9,*) STR1,NUM N = NUM MESS = 'DRSOLR3' CALL DIMCHECK(NUM,MAXDIM,MESS) READ(9,*) STR2,INCA,INCB,INCC READ(9,*) STR3,(A(I), I=1,NUM) READ(9,*) STR4,(B(I), I=1,NUM) READ(9,*) STR5,(C(I), I=1,NUM) READ(9,*) STR6,(CRC(I), I=1,NUM) ABSINCA = ABS(INCA) ABSINCB = ABS(INCB) ABSINCC = ABS(INCC) IF (ABSINCA .GE. ABSINCB .AND. ABSINCA .GE. ABSINCC) THEN IF (INCA .NE. 0) N = (NUM + (ABSINCA-1))/ABSINCA ELSE IF (ABSINCB .GE. ABSINCC) THEN IF (INCB .NE. 0) N = (NUM + (ABSINCB-1))/ABSINCB ELSE N = (NUM + (ABSINCC-1))/ABSINCC ENDIF WRITE(10,600) STR1,NUM WRITE(10,605) STR2,INCA,INCB,INCC WRITE(10,610) STR3,(A(I), I=1,NUM) WRITE(10,610) STR4,(B(I), I=1,NUM) WRITE(10,610) STR5,(C(I), I=1,NUM) CALL SOLR3(N,A,INCA,B,INCB,C,INCC) C Check difference between new and previous results. FAILED = .FALSE. DO 10 I = 1,NUM DIFF = C(I) - CRC(I) IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE. 10 CONTINUE C Output new results and increment counters. WRITE(10,610) STR6,(C(I), I=1,NUM) IF (FAILED) NFAILS = NFAILS + 1 NTESTS = NTESTS + 1 600 FORMAT('''',A10,'''',1X,I4) 605 FORMAT('''',A10,'''',1X,3I4) 610 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