MICROCERN/gausscod.inc

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2.4.1  2002/11/26 16:46:57  hristov
   6 * Merging NewIO with v3-09-04
   7 *
   8 * Revision 1.2  2002/10/14 14:57:10  hristov
   9 * Merging the VirtualMC branch to the main development branch (HEAD)
  10 *
  11 * Revision 1.1.2.1  2002/07/11 17:15:24  alibrary
  12 * Adding MICROCERN
  13 *
  14 * Revision 1.1.1.1  1999/05/18 15:55:34  fca
  15 * AliRoot sources
  16 *
  17 * Revision 1.1.1.1  1996/04/01 15:02:13  mclareni
  18 * Mathlib gen
  19 *
  20 *
  21 *
  22 * gausscod.inc
  23 *
  24       DIMENSION W(12),X(12)
  25
  26       PARAMETER (Z1 = 1, HF = Z1/2, CST = 5*Z1/1000)
  27
  28       DATA X( 1) /9.6028985649753623D-1/, W( 1) /1.0122853629037626D-1/
  29       DATA X( 2) /7.9666647741362674D-1/, W( 2) /2.2238103445337447D-1/
  30       DATA X( 3) /5.2553240991632899D-1/, W( 3) /3.1370664587788729D-1/
  31       DATA X( 4) /1.8343464249564980D-1/, W( 4) /3.6268378337836198D-1/
  32       DATA X( 5) /9.8940093499164993D-1/, W( 5) /2.7152459411754095D-2/
  33       DATA X( 6) /9.4457502307323258D-1/, W( 6) /6.2253523938647893D-2/
  34       DATA X( 7) /8.6563120238783174D-1/, W( 7) /9.5158511682492785D-2/
  35       DATA X( 8) /7.5540440835500303D-1/, W( 8) /1.2462897125553387D-1/
  36       DATA X( 9) /6.1787624440264375D-1/, W( 9) /1.4959598881657673D-1/
  37       DATA X(10) /4.5801677765722739D-1/, W(10) /1.6915651939500254D-1/
  38       DATA X(11) /2.8160355077925891D-1/, W(11) /1.8260341504492359D-1/
  39       DATA X(12) /9.5012509837637440D-2/, W(12) /1.8945061045506850D-1/
  40
  41       H=0
  42       IF(B .EQ. A) GO TO 99
  43       CONST=CST/ABS(B-A)
  44       BB=A
  45     1 AA=BB
  46       BB=B
  47     2 C1=HF*(BB+AA)
  48       C2=HF*(BB-AA)
  49       S8=0
  50       DO 3 I = 1,4
  51       U=C2*X(I)
  52     3 S8=S8+W(I)*(F(C1+U)+F(C1-U))
  53       S16=0
  54       DO 4 I = 5,12
  55       U=C2*X(I)
  56     4 S16=S16+W(I)*(F(C1+U)+F(C1-U))
  57       S16=C2*S16
  58       IF(ABS(S16-C2*S8) .LE. EPS*(1+ABS(S16))) THEN
  59        H=H+S16
  60        IF(BB .NE. B) GO TO 1
  61       ELSE
  62        BB=C1
  63        IF(1+CONST*ABS(C2) .NE. 1) GO TO 2
  64        H=0
  65        CALL MTLPRT(NAME,'D103.1','TOO HIGH ACCURACY REQUIRED')
  66        GO TO 99
  67       END IF