GEANT321/gstrag/gxgint.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:39  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.25  by  S.Giani
  11 *-- Author :
  12       FUNCTION GXGINT(EXT,A,B,EPS)
  13 *
  14 *    Gauss integration routine
  15 *
  16 #include "geant321/gcunit.inc"
  17 #if !defined(CERNLIB_SINGLE)
  18       DOUBLE PRECISION OTB,U1,U2,W1,W2,Y
  19 #endif
  20       EXTERNAL EXT
  21       PARAMETER (U1=.3399810,U2=.8611363,W1=.6521452,W2=.3478548)
  22 *
  23 *-----------------------------------------------------------------------
  24 *
  25       N      = 5
  26       OTB    = 0
  27       DHALF  = (B-A)/N
  28    10 CONTINUE
  29 *
  30 *   Convergence loop
  31 *
  32       Y = OTB
  33       OTB = 0
  34       D = DHALF
  35       DHALF = 0.5*D
  36       CENTX = A-DHALF
  37       D1 = U1*DHALF
  38       D2 = U2*DHALF
  39 *
  40 *   Piecewise integration loop
  41 *
  42       DO 20 I=1,N
  43          CENTX=CENTX+D
  44          OTB = OTB +W2*(EXT(CENTX-D2)+EXT(CENTX+D2)) +W1*(EXT(CENTX-D1)
  45      +   +EXT(CENTX+D1))
  46    20 CONTINUE
  47       OTB=OTB*DHALF
  48 *
  49       IF(EPS.GT.0.AND.ABS(OTB-Y).GT.ABS(EPS*OTB)) THEN
  50          N = 2*N
  51          IF (N.GT.100 000) THEN
  52 *
  53 *   Check N>100 000
  54 *
  55             WRITE(CHMAIL,10000) EPS, ABS((OTB-Y)/OTB)
  56             CALL GMAIL(1,0)
  57             GO TO 30
  58          END IF
  59          GOTO 10
  60       ENDIF
  61 *
  62    30 CONTINUE
  63       GXGINT=OTB
  64 10000 FORMAT('*** GXGINT : required precision ',G10.3,
  65      +      ' obtained precision ',G10.3)
  66       END