*DECK CPRIN SUBROUTINE CPRIN (LUN, NUM1, KPRINT, IP, EXACT, RESULT, ABSERR, + NEVAL, IERV, LIERV) C***BEGIN PROLOGUE CPRIN C***SUBSIDIARY C***PURPOSE Subsidiary to CQAG, CQAG, CQAGI, CQAGP, CQAGS, CQAWC, C CQAWF, CQAWO, CQAWS, and CQNG. C***LIBRARY SLATEC C***AUTHOR Piessens, Robert C Applied Mathematics and Programming Division C K. U. Leuven C de Doncker, Elise C Applied Mathematics and Programming Division C K. U. Leuven C***DESCRIPTION C C This program is called by the (single precision) Quadpack quick C check routines for printing out their messages. C C***ROUTINES CALLED (NONE) C***REVISION HISTORY (YYMMDD) C 810401 DATE WRITTEN C 890831 Modified array declarations. (WRB) C 891214 Prologue converted to Version 4.0 format. (BAB) C 910627 Code completely rewritten. (WRB) C***END PROLOGUE CPRIN C .. Scalar Arguments .. REAL ABSERR, EXACT, RESULT INTEGER IP, KPRINT, LIERV, LUN, NEVAL, NUM1 C .. Array Arguments .. INTEGER IERV(*) C .. Local Scalars .. REAL ERROR INTEGER IER, K C .. Intrinsic Functions .. INTRINSIC ABS C***FIRST EXECUTABLE STATEMENT CPRIN IER = IERV(1) ERROR = ABS(EXACT-RESULT) C IF (KPRINT .GE. 2) THEN IF (IP.EQ.1) THEN IF (KPRINT .GE. 3) THEN C C Write PASS message. C WRITE (UNIT=LUN, FMT=9000) NUM1 ENDIF ELSE C C Write failure messages. C WRITE (UNIT=LUN, FMT=9010) NUM1 IF (NUM1 .EQ. 0) WRITE (UNIT=LUN, FMT=9020) IF (NUM1 .GT. 0) WRITE (UNIT=LUN, FMT=9030) NUM1 IF (LIERV .GT. 1) WRITE (UNIT=LUN, FMT=9040) (IERV(K), + K=2,LIERV) IF (NUM1 .EQ. 6) WRITE (UNIT=LUN, FMT=9050) WRITE (UNIT=LUN, FMT=9060) WRITE (UNIT=LUN, FMT=9070) IF (NUM1 .NE. 5) THEN WRITE (UNIT=LUN, FMT=9080) EXACT,RESULT,ERROR,ABSERR,IER, + NEVAL ELSE WRITE (LUN,FMT=9090) RESULT,ABSERR,IER,NEVAL ENDIF ENDIF ENDIF C RETURN C 9000 FORMAT (' TEST ON IER = ', I2, ' PASSED') 9010 FORMAT (' TEST ON IER = ', I1, ' FAILED.') 9020 FORMAT (' WE MUST HAVE IER = 0, ERROR.LE.ABSERR AND ABSERR.LE', + '.MAX(EPSABS,EPSREL*ABS(EXACT))') 9030 FORMAT (' WE MUST HAVE IER = ', I1) 9040 FORMAT (' OR IER = ', 8(I1,2X)) 9050 FORMAT (' RESULT, ABSERR, NEVAL AND EVENTUALLY LAST SHOULD BE', + ' ZERO') 9060 FORMAT (' WE HAVE ') 9070 FORMAT (7X, 'EXACT', 11X, 'RESULT', 6X, 'ERROR', 4X, 'ABSERR', + 4X, 'IER NEVAL', /, ' ', 42X, + '(EST.ERR.)(FLAG)(NO F-EVAL)') 9080 FORMAT (' ', 2(E15.7,1X), 2(E9.2,1X), I4, 4X, I6) 9090 FORMAT (5X, 'INFINITY', 4X, E15.7, 11X, E9.2, I5, 4X, I6) END