[u/mrichter/AliRoot.git] / HERWIG / src / hwrpow.f


CDECK  ID>, HWRPOW.

*CMZ :-        -26/04/91  11.11.56  by  Bryan Webber

*-- Author :    Bryan Webber

C-----------------------------------------------------------------------

      SUBROUTINE HWRPOW(XVAL,XJAC)

C-----------------------------------------------------------------------

C     RETURNS XVAL DISTRIBUTED ON (XMIN,XMAX) LIKE XVAL**XPOW

C     AND CORRESPONDING JACOBIAN FACTOR XJAC

C     SET FIRST=.TRUE. IF NEW XMIN,XMAX OR XPOW

C-----------------------------------------------------------------------

      DOUBLE PRECISION HWR,XVAL,XJAC,XMIN,XMAX,XPOW,P,Q,A,B,C,Z,ZERO

      LOGICAL FIRST

      PARAMETER(ZERO=0.0D0)

      EXTERNAL HWR

      SAVE Q,A,B,C

      COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST

      IF (FIRST) THEN

        P=XPOW+1.

        IF (P.EQ.ZERO) CALL HWWARN('HWRPOW',500,*999)

        Q=1./P

        A=XMIN**P

        B=XMAX**P-A

        C=B*Q

        FIRST=.FALSE.

      ENDIF

      Z=A+B*HWR()

      XVAL=Z**Q

      XJAC=XVAL*C/Z

  999 END

CDECK  ID>, HWRUNG.

*CMZ :-        -26/04/91  14.55.45  by  Federico Carminati

*-- Author :    David Ward, modified by Bryan Webber

C-----------------------------------------------------------------------

      FUNCTION HWRUNG(A,B)

C-----------------------------------------------------------------------

C     Random number from distribution having flat top [-A,A] & gaussian

C     tail of s.d. B

C-----------------------------------------------------------------------

      DOUBLE PRECISION HWRUNG,HWRGAU,HWRUNI,A,B,PRUN,ZERO

      LOGICAL HWRLOG

      EXTERNAL HWRGAU,HWRUNI,HWRLOG

      PARAMETER (ZERO=0.D0)

      IF (A.EQ.ZERO) THEN

        PRUN=0

      ELSE

        PRUN=1./(1.+B*1.2533/A)

      ENDIF

      IF(HWRLOG(PRUN)) THEN

        HWRUNG=HWRUNI(0,-A,A)

      ELSE

        HWRUNG=HWRGAU(0,ZERO,B)

        HWRUNG=HWRUNG+SIGN(A,HWRUNG)

      ENDIF

      END
Commit	Line	Data
3820ca8e	1
	2	CDECK ID>, HWRPOW.
	3
	4	*CMZ :- -26/04/91 11.11.56 by Bryan Webber
	5
	6	*-- Author : Bryan Webber
	7
	8	C-----------------------------------------------------------------------
	9
	10	SUBROUTINE HWRPOW(XVAL,XJAC)
	11
	12	C-----------------------------------------------------------------------
	13
	14	C RETURNS XVAL DISTRIBUTED ON (XMIN,XMAX) LIKE XVAL**XPOW
	15
	16	C AND CORRESPONDING JACOBIAN FACTOR XJAC
	17
	18	C SET FIRST=.TRUE. IF NEW XMIN,XMAX OR XPOW
	19
	20	C-----------------------------------------------------------------------
	21
	22	DOUBLE PRECISION HWR,XVAL,XJAC,XMIN,XMAX,XPOW,P,Q,A,B,C,Z,ZERO
	23
	24	LOGICAL FIRST
	25
	26	PARAMETER(ZERO=0.0D0)
	27
	28	EXTERNAL HWR
	29
	30	SAVE Q,A,B,C
	31
	32	COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST
	33
	34	IF (FIRST) THEN
	35
	36	P=XPOW+1.
	37
	38	IF (P.EQ.ZERO) CALL HWWARN('HWRPOW',500,*999)
	39
	40	Q=1./P
	41
	42	A=XMIN**P
	43
	44	B=XMAX**P-A
	45
	46	C=B*Q
	47
	48	FIRST=.FALSE.
	49
	50	ENDIF
	51
	52	Z=A+B*HWR()
	53
	54	XVAL=Z**Q
	55
	56	XJAC=XVAL*C/Z
	57
	58	999 END
	59
	60	CDECK ID>, HWRUNG.
	61
	62	*CMZ :- -26/04/91 14.55.45 by Federico Carminati
	63
	64	*-- Author : David Ward, modified by Bryan Webber
65
66	C-----------------------------------------------------------------------
67
68	FUNCTION HWRUNG(A,B)
69
70	C-----------------------------------------------------------------------
71
72	C Random number from distribution having flat top [-A,A] & gaussian
73
74	C tail of s.d. B
75
76	C-----------------------------------------------------------------------
77
78	DOUBLE PRECISION HWRUNG,HWRGAU,HWRUNI,A,B,PRUN,ZERO
79
80	LOGICAL HWRLOG
81
82	EXTERNAL HWRGAU,HWRUNI,HWRLOG
83
84	PARAMETER (ZERO=0.D0)
85
86	IF (A.EQ.ZERO) THEN
87
88	PRUN=0
89
90	ELSE
91
92	PRUN=1./(1.+B*1.2533/A)
93
94	ENDIF
95
96	IF(HWRLOG(PRUN)) THEN
97
98	HWRUNG=HWRUNI(0,-A,A)
99
100	ELSE
101
102	HWRUNG=HWRGAU(0,ZERO,B)
103
104	HWRUNG=HWRUNG+SIGN(A,HWRUNG)
105
106	ENDIF
107
108	END