[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / g / probkl.F


*
* $Id$
*
* $Log$
* Revision 1.2  1997/04/08 14:39:00  mclareni
* A fourth term is needed for part of the range of X, Fred James
*
* Revision 1.1.1.1  1996/04/01 15:02:42  mclareni
* Mathlib gen
*
*
#include "gen/pilot.h"
C     This corresponds to PROBKL,IF=DOUBLE and PROBKL64,IF=-DOUBLE
      FUNCTION PROBKL(X)

      DIMENSION FJ(4),R(4)

      PARAMETER (PI = 3.14159 265D0)
      PARAMETER (W  = 2.50662 827D0)
      PARAMETER (C1 = -PI**2/8, C2 = 9*C1, C3 = 25*C1)

      DATA FJ /-2,-8,-18,-32/

      U=ABS(X)
      IF(U .LT. 0.2) THEN
       P=1.
      ELSEIF(U .LT. 0.755) THEN
       V=1/U**2
       P=1-W*(EXP(C1*V)+EXP(C2*V)+EXP(C3*V))/U
      ELSEIF(U .LT. 6.8116) THEN
       R(2)=0.
       R(3)=0.
       R(4)=0.
       V=U**2
       DO 1 J = 1,MAX(1,NINT(3/U))
    1  R(J)=EXP(FJ(J)*V)
       P=2*(R(1)-R(2)+R(3)-R(4))
CCC         PRINT '(35x,4e10.2)', (R(JJ),JJ=1,4)
      ELSE
       P=0
      ENDIF
      PROBKL=P
      RETURN
      END
Commit	Line	Data
fe4da5cc	1
	2	*
	3	* $Id$
	4	*
	5	* $Log$
	6	* Revision 1.2 1997/04/08 14:39:00 mclareni
	7	* A fourth term is needed for part of the range of X, Fred James
	8	*
	9	* Revision 1.1.1.1 1996/04/01 15:02:42 mclareni
	10	* Mathlib gen
	11	*
	12	*
	13	#include "gen/pilot.h"
	14	C This corresponds to PROBKL,IF=DOUBLE and PROBKL64,IF=-DOUBLE
	15	FUNCTION PROBKL(X)
	16
	17	DIMENSION FJ(4),R(4)
	18
	19	PARAMETER (PI = 3.14159 265D0)
	20	PARAMETER (W = 2.50662 827D0)
	21	PARAMETER (C1 = -PI*2/8, C2 = 9C1, C3 = 25*C1)
	22
	23	DATA FJ /-2,-8,-18,-32/
	24
	25	U=ABS(X)
	26	IF(U .LT. 0.2) THEN
	27	P=1.
	28	ELSEIF(U .LT. 0.755) THEN
	29	V=1/U**2
	30	P=1-W(EXP(C1V)+EXP(C2V)+EXP(C3V))/U
	31	ELSEIF(U .LT. 6.8116) THEN
	32	R(2)=0.
	33	R(3)=0.
	34	R(4)=0.
	35	V=U**2
	36	DO 1 J = 1,MAX(1,NINT(3/U))
	37	1 R(J)=EXP(FJ(J)*V)
	38	P=2*(R(1)-R(2)+R(3)-R(4))
	39	CCC PRINT '(35x,4e10.2)', (R(JJ),JJ=1,4)
	40	ELSE
	41	P=0
	42	ENDIF
	43	PROBKL=P
	44	RETURN
	45	END
	46
	47
	48
	49
	50
	51