*
* $Id: d103ch.F,v 1.1.1.1 1996/02/15 17:48:39 mclareni Exp $
*
* $Log: d103ch.F,v $
* Revision 1.1.1.1  1996/02/15 17:48:39  mclareni
* Kernlib
*
*
#include "kernnumt/pilot.h"
#if defined(CERNLIB_NEVER)
      SUBROUTINE D103CH(NREP,OKPK)
      EXTERNAL D103F1,D103F2
      LOGICAL OKPK,OKFN1(10),OKFN2(10)
      DOUBLE PRECISION DGAUSS,D103F2
      DOUBLE PRECISION PI,A,B,P,Q,EPS2,ERR2,EXACT,APPRX2
      DIMENSION MRATIO(2),ERR1(10),ERR2(10)
#include "kernnumt/sysdat.inc"
      COMMON /D103CM/DMY,NFN,A,B,P,Q
      DATA MRATIO/ 20, 200 /
C
C  TEST-ROUTINE FOR D103 (GAUSS, DGAUSS).
C  CALLS ... FUNCTIONS GAUSS, DGAUSS.
C        ... TEST-FUNCTIONS D103F1, D103F2.
C
C  START.
      OKPK=.FALSE.
      IF(NREP.LE.0) RETURN
      EPS1=MRATIO(1)*RELPRT(1)
      EPS2=MRATIO(2)*RELPRT(2)
      PI=4.D0*DATAN(1.D0)
      NFN=0
C
C  1. SHARP PEAK.
      NFN=NFN+1
      A=0.5D0
      B=0.1D0
      P=100.D0
      Q=0.2D0
      EXACT=-SQRT(PI)
      A1=A
      B1=B
      P1=P
      Q1=Q
      EXACT1=EXACT
      APPRX1=GAUSS(D103F1,A1,B1,EPS1)
      ERR1(NFN)=ABS(APPRX1-EXACT1)
      OKFN1(NFN)=ERR1(NFN).LT.EPS1
      APPRX2=DGAUSS(D103F2,A,B,EPS2)
      ERR2(NFN)=ABS(APPRX2-EXACT)
      OKFN2(NFN)=ERR2(NFN).LT.EPS2
C
C  2. NON-POLYNOMIAL END-POINTS.
      NFN=NFN+1
      A=0.5D0
      B=-1.5D0
      P=1.D0
      EXACT=SIGN(0.125D0,B-A)*P*PI*(B-A)**2
      A1=A
      B1=B
      P1=P
      EXACT1=EXACT
      APPRX1=GAUSS(D103F1,A1,B1,EPS1)
      ERR1(NFN)=ABS(APPRX1-EXACT1)
      OKFN1(NFN)=ERR1(NFN).LT.EPS1
      APPRX2=DGAUSS(D103F2,A,B,EPS2)
      ERR2(NFN)=ABS(APPRX2-EXACT)
      OKFN2(NFN)=ERR2(NFN).LT.EPS2
C
C  3. OSCILLATORY FUNCTION (ABSOLUTE ERROR CRITERION).
      NFN=NFN+1
      A=0.D0
      B=1.5D0*PI
      P=1.D0
      Q=10.D0
      EXACT=0.D0
      A1=A
      B1=B
      P1=P
      Q1=Q
      EXACT1=EXACT
      APPRX1=GAUSS(D103F1,A1,B1,EPS1)
      ERR1(NFN)=ABS(APPRX1-EXACT1)
      OKFN1(NFN)=ERR1(NFN).LT.EPS1
      APPRX2=DGAUSS(D103F2,A,B,EPS2)
      ERR2(NFN)=ABS(APPRX2-EXACT)
      OKFN2(NFN)=ERR2(NFN).LT.EPS2
C
C  4. OSCILLATORY FUNCTION (RELATIVE ERROR CRITERION).
      NFN=NFN+1
      A=0.D0
      B=-1.5D0*PI
      P=1.D20
      Q=12.D0
      EXACT=P*(B-A)
      A1=A
      B1=B
      P1=P
      Q1=Q
      EXACT1=EXACT
      APPRX1=GAUSS(D103F1,A1,B1,EPS1)
      ERR1(NFN)=ABS((APPRX1-EXACT1)/EXACT1)
      OKFN1(NFN)=ERR1(NFN).LT.EPS1
      APPRX2=DGAUSS(D103F2,A,B,EPS2)
      ERR2(NFN)=ABS((APPRX2-EXACT)/EXACT)
      OKFN2(NFN)=ERR2(NFN).LT.EPS2
C
C  CHECK FOR ERRORS.
      OKPK=.TRUE.
      DO 1 I=1,NFN
         OKPK=OKPK.AND.OKFN1(I).AND.OKFN2(I)
    1 CONTINUE
      IF(.NOT.OKPK) THEN
         WRITE(*,2000)
         DO 2 I=1,NFN
            IF(.NOT.OKFN1(I)) WRITE(*,2001) I,ERR1(I),EPS1
            IF(.NOT.OKFN2(I)) WRITE(*,2002) I,ERR2(I),EPS2
    2    CONTINUE
      ENDIF
C
C  PRINT ERROR MESSAGES.
      IF(       ERPRNT .AND.       ERSTOP) WRITE(*,2003)
      IF(       ERPRNT .AND. .NOT. ERSTOP) WRITE(*,2004)
      IF( .NOT. ERPRNT .AND.       ERSTOP) WRITE(*,2005)
      NFN=NFN+1
      A=1.D0
      B=0.D0
      APPRX1=GAUSS(D103F1,A1,B1,EPS1)
      APPRX2=DGAUSS(D103F2,A,B,EPS2)
      RETURN
C
 2000 FORMAT( // ' ***** D103CH ... TEST FAILURE.' )
 2001 FORMAT( 4X, 'NFN =', I2, 4X, 'ERR1 =', 1PE9.1, 4X, 'EPS1 =', E9.1)
 2002 FORMAT( 4X, 'NFN =', I2, 4X, 'ERR2 =', 1PD9.1, 4X, 'EPS2 =', D9.1)
 2003 FORMAT( / ' TWO ERROR AND ABEND MESSAGES SHOULD NOW FOLLOW ...' )
 2004 FORMAT( / ' TWO ERROR MESSAGES SHOULD NOW FOLLOW ...' )
 2005 FORMAT( / ' TWO ABEND MESSAGES SHOULD NOW FOLLOW ...' )
      END
#endif