GEANT321/gphys/gmol4.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:26  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.22  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GMOL4(Y,X,VAL,ARG,EPS,IER)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    * ROUTINE TAKEN FROM IBM SCIENTIFIC SUBROUTINE PACKAGE           *
  17 C.    *                                                                *
  18 C.    * 4 POINT CONTINUED FRACTION INTERPOLATION                       *
  19 C.    * Y=INTERPOLATED VALUE FOR THE ARGUMENT X .                      *
  20 C.    * VAL=VALUE ARRAY .                                              *
  21 C.    * ARG=ARGUMENT ARRAY .                                           *
  22 C.    * EPS=DESIRED ACCURACY .                                         *
  23 C.    * OUTPUT ERROR PARAMETER IER = 0 ACCURACY O.K.                   *
  24 C.    *                            = 1 ACCURACY CAN NOT BE TESTED      *
  25 C.    *                                IN 4TH ORDER INTERPOLATION .    *
  26 C.    *                            = 2 TWO IDENTICAL ELEMENTS IN THE   *
  27 C.    *                                ARGUMENT ARRAY .                *
  28 C.    *                                                                *
  29 C.    *    ==>Called by : GMOLIE                                       *
  30 C.    *         Author M.S. Dixit NRCC Ottawa    *********             *
  31 C.    *                                                                *
  32 C.    ******************************************************************
  33 C.
  34       DIMENSION ARG(4),VAL(4)
  35 C.
  36 C.    ------------------------------------------------------------------
  37 C.
  38       IER=1
  39       Y=VAL(1)
  40       P2=1.
  41       P3=Y
  42       Q2=0.
  43       Q3=1.
  44       DO 16 I=2,4
  45          II=0
  46          P1=P2
  47          P2=P3
  48          Q1=Q2
  49          Q2=Q3
  50          Z=Y
  51          JEND=I-1
  52    3     AUX=VAL(I)
  53          DO 10 J=1,JEND
  54             H=VAL(I)-VAL(J)
  55             IF(ABS(H).GT.1.E-6*ABS(VAL(I)))GO TO 9
  56             IF(ARG(I).EQ.ARG(J))GO TO 17
  57             IF(J.LT.JEND)GO TO 8
  58             II=II+1
  59             III=I+II
  60             IF(III.GT.4)GO TO 19
  61             VAL(I)=VAL(III)
  62             VAL(III)=AUX
  63             AUX=ARG(I)
  64             ARG(I)=ARG(III)
  65             ARG(III)=AUX
  66             GO TO 3
  67    8        VAL(I)=1.E36
  68             GO TO 10
  69    9        VAL(I)=(ARG(I)-ARG(J))/H
  70   10     CONTINUE
  71          P3=VAL(I)*P2+(X-ARG(I-1))*P1
  72          Q3=VAL(I)*Q2+(X-ARG(I-1))*Q1
  73          IF(Q3.NE.0.)THEN
  74             Y=P3/Q3
  75          ELSE
  76             Y=1.E36
  77          ENDIF
  78          DELT=ABS(Z-Y)
  79          IF(DELT.LE.EPS)GO TO 19
  80   16  CONTINUE
  81       RETURN
  82   17  IER=2
  83       RETURN
  84   19  IER=0
  85       END