[u/mrichter/AliRoot.git] / GEANT321 / gphys / gmol4.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:21:26  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.22  by  S.Giani
*-- Author :
      SUBROUTINE GMOL4(Y,X,VAL,ARG,EPS,IER)
C.
C.    ******************************************************************
C.    *                                                                *
C.    * ROUTINE TAKEN FROM IBM SCIENTIFIC SUBROUTINE PACKAGE           *
C.    *                                                                *
C.    * 4 POINT CONTINUED FRACTION INTERPOLATION                       *
C.    * Y=INTERPOLATED VALUE FOR THE ARGUMENT X .                      *
C.    * VAL=VALUE ARRAY .                                              *
C.    * ARG=ARGUMENT ARRAY .                                           *
C.    * EPS=DESIRED ACCURACY .                                         *
C.    * OUTPUT ERROR PARAMETER IER = 0 ACCURACY O.K.                   *
C.    *                            = 1 ACCURACY CAN NOT BE TESTED      *
C.    *                                IN 4TH ORDER INTERPOLATION .    *
C.    *                            = 2 TWO IDENTICAL ELEMENTS IN THE   *
C.    *                                ARGUMENT ARRAY .                *
C.    *                                                                *
C.    *    ==>Called by : GMOLIE                                       *
C.    *         Author M.S. Dixit NRCC Ottawa    *********             *
C.    *                                                                *
C.    ******************************************************************
C.
      DIMENSION ARG(4),VAL(4)
C.
C.    ------------------------------------------------------------------
C.
      IER=1
      Y=VAL(1)
      P2=1.
      P3=Y
      Q2=0.
      Q3=1.
      DO 16 I=2,4
         II=0
         P1=P2
         P2=P3
         Q1=Q2
         Q2=Q3
         Z=Y
         JEND=I-1
   3     AUX=VAL(I)
         DO 10 J=1,JEND
            H=VAL(I)-VAL(J)
            IF(ABS(H).GT.1.E-6*ABS(VAL(I)))GO TO 9
            IF(ARG(I).EQ.ARG(J))GO TO 17
            IF(J.LT.JEND)GO TO 8
            II=II+1
            III=I+II
            IF(III.GT.4)GO TO 19
            VAL(I)=VAL(III)
            VAL(III)=AUX
            AUX=ARG(I)
            ARG(I)=ARG(III)
            ARG(III)=AUX
            GO TO 3
   8        VAL(I)=1.E36
            GO TO 10
   9        VAL(I)=(ARG(I)-ARG(J))/H
  10     CONTINUE
         P3=VAL(I)*P2+(X-ARG(I-1))*P1
         Q3=VAL(I)*Q2+(X-ARG(I-1))*Q1
         IF(Q3.NE.0.)THEN
            Y=P3/Q3
         ELSE
            Y=1.E36
         ENDIF
         DELT=ABS(Z-Y)
         IF(DELT.LE.EPS)GO TO 19
  16  CONTINUE
      RETURN
  17  IER=2
      RETURN
  19  IER=0
      END
Commit	Line	Data
fe4da5cc	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