*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1999/05/18 15:55:34  fca
* AliRoot sources
*
* Revision 1.1.1.1  1996/04/01 15:02:13  mclareni
* Mathlib gen
*
*
#include "gen/pilot.h"
#if defined(CERNLIB_QUAD)
#if defined(CERNLIB_DOUBLE)
      FUNCTION QGAUSS(F,A,B,EPS)

C     QGAUSS FOR IBM AND ALIKE
#endif
#if !defined(CERNLIB_DOUBLE)
      FUNCTION DGAUSS(F,A,B,EPS)

C     DGAUSS FOR CRAY AND ALIKE
#endif
#include "gen/imp128.inc"
      CHARACTER NAME*(*)
#if defined(CERNLIB_DOUBLE)
      PARAMETER (NAME = 'QGAUSS')
#endif
#if !defined(CERNLIB_DOUBLE)
      PARAMETER (NAME = 'DGAUSS')
#endif
      DIMENSION W(12),X(12)

      PARAMETER (Z1 = 1, HF = Z1/2, CST = 5*Z1/1000)

      DATA X
#if defined(CERNLIB_DOUBLE)
     1        /0.96028 98564 97536 23168 35608 68569 47Q0,
     2         0.79666 64774 13626 73959 15539 36475 83Q0,
     3         0.52553 24099 16328 98581 77390 49189 25Q0,
     4         0.18343 46424 95649 80493 94761 42360 18Q0,
     5         0.98940 09349 91649 93259 61541 73450 33Q0,
     6         0.94457 50230 73232 57607 79884 15534 61Q0,
     7         0.86563 12023 87831 74388 04678 97712 39Q0,
     8         0.75540 44083 55003 03389 51011 94847 44Q0,
     9         0.61787 62444 02643 74844 66717 64048 79Q0,
     A         0.45801 67776 57227 38634 24194 42983 58Q0,
     B         0.28160 35507 79258 91323 04605 01460 50Q0,
     C         0.95012 50983 76374 40185 31933 54249 58Q-1/

      DATA W
     1        /0.10122 85362 90376 25915 25313 54309 96Q0,
     2         0.22238 10344 53374 47054 43559 94426 24Q0,
     3         0.31370 66458 77887 28733 79622 01986 60Q0,
     4         0.36268 37833 78361 98296 51504 49277 20Q0,
     5         0.27152 45941 17540 94851 78057 24560 18Q-1,
     6         0.62253 52393 86478 92862 84383 69943 78Q-1,
     7         0.95158 51168 24927 84809 92510 76022 46Q-1,
     8         0.12462 89712 55533 87205 24762 82192 02Q0,
     9         0.14959 59888 16576 73208 15017 30547 48Q0,
     A         0.16915 65193 95002 53818 93120 79030 36Q0,
     B         0.18260 34150 44923 58886 67636 67969 22Q0,
     C         0.18945 06104 55068 49628 53967 23208 28Q0/
#endif
#if !defined(CERNLIB_DOUBLE)
     1        /0.96028 98564 97536 23168 35608 68569 47D0,
     2         0.79666 64774 13626 73959 15539 36475 83D0,
     3         0.52553 24099 16328 98581 77390 49189 25D0,
     4         0.18343 46424 95649 80493 94761 42360 18D0,
     5         0.98940 09349 91649 93259 61541 73450 33D0,
     6         0.94457 50230 73232 57607 79884 15534 61D0,
     7         0.86563 12023 87831 74388 04678 97712 39D0,
     8         0.75540 44083 55003 03389 51011 94847 44D0,
     9         0.61787 62444 02643 74844 66717 64048 79D0,
     A         0.45801 67776 57227 38634 24194 42983 58D0,
     B         0.28160 35507 79258 91323 04605 01460 50D0,
     C         0.95012 50983 76374 40185 31933 54249 58D-1/

      DATA W
     1        /0.10122 85362 90376 25915 25313 54309 96D0,
     2         0.22238 10344 53374 47054 43559 94426 24D0,
     3         0.31370 66458 77887 28733 79622 01986 60D0,
     4         0.36268 37833 78361 98296 51504 49277 20D0,
     5         0.27152 45941 17540 94851 78057 24560 18D-1,
     6         0.62253 52393 86478 92862 84383 69943 78D-1,
     7         0.95158 51168 24927 84809 92510 76022 46D-1,
     8         0.12462 89712 55533 87205 24762 82192 02D0,
     9         0.14959 59888 16576 73208 15017 30547 48D0,
     A         0.16915 65193 95002 53818 93120 79030 36D0,
     B         0.18260 34150 44923 58886 67636 67969 22D0,
     C         0.18945 06104 55068 49628 53967 23208 28D0/
#endif

      H=0
      IF(B .EQ. A) GO TO 99
      CONST=CST/ABS(B-A)
      BB=A
    1 AA=BB
      BB=B
    2 C1=HF*(BB+AA)
      C2=HF*(BB-AA)
      S8=0
      DO 3 I = 1,4
      U=C2*X(I)
    3 S8=S8+W(I)*(F(C1+U)+F(C1-U))
      S16=0
      DO 4 I = 5,12
      U=C2*X(I)
    4 S16=S16+W(I)*(F(C1+U)+F(C1-U))
      S16=C2*S16
      IF(ABS(S16-C2*S8) .LE. EPS*(1+ABS(S16))) THEN
       H=H+S16
       IF(BB .NE. B) GO TO 1
      ELSE
       BB=C1
       IF(1+CONST*ABS(C2) .NE. 1) GO TO 2
       H=0
       CALL MTLPRT(NAME,'D103.1','TOO HIGH ACCURACY REQUIRED')
       GO TO 99
      END IF
#if !defined(CERNLIB_DOUBLE)
   99 DGAUSS=H
#endif
#if defined(CERNLIB_DOUBLE)
   99 QGAUSS=H
#endif
      RETURN
      END
#else
      SUBROUTINE gauss128_dummy
      END
#endif