Child: [0a3c74] (diff)

Download this file

SpezFunkt2.def    244 lines (204 with data), 15.3 kB

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
DEFINITION MODULE SpezFunkt2;
(*------------------------------------------------------------------------*)
(* Modul fuer einige spezielle Funktionen - Gammafunktion(en) *)
(* Module for the calculation of several forms of the Gamma function *)
(*------------------------------------------------------------------------*)
(*------------------------------------------------------------------------*)
(* Implementation : Michael Riedl *)
(* Licence : GNU Lesser General Public License (LGPL) *)
(*------------------------------------------------------------------------*)
(* $Id: SpezFunkt2.def,v 1.5 2018/05/25 13:35:18 mriedl Exp mriedl $ *)
CONST MaxGam = 171.624376956302; (* Max. argument for Gamma *)
MaxLgm = 2.556348E+305; (* Max. argument for LnGamma *)
PROCEDURE GammaIn( X : LONGREAL;
P : LONGREAL;
VAR iFehl : INTEGER) : LONGREAL;
(*----------------------------------------------------------------*)
(* Berechnet die unvollst��ndige Gammafunktion der Ordnung P *)
(* Computes the incomplete gamma ratio. *)
(* *)
(* A series expansion is used if P > X or X <= 1. Otherwise, a *)
(* continued fraction approximation is used. *)
(* *)
(* iFehl : 1 wenn P <= 0 *)
(* 2 wenn X < 0 *)
(* 4 wenn Fehler in lnGamma *)
(* *)
(* Ref.: Bhattacharjee, G; "Algorithm AS 32: The Incomplete Gamma *)
(* Integral", Applied Statistics, 19/3, 285-287 (1970) *)
(* *)
(* Translation of a Fortran 90 version of Burkardt, John *)
(* *)
(* This routine is less precise then GammaU (about 10-12 digits) *)
(* but considerably faster than its equivalent. *)
(*----------------------------------------------------------------*)
PROCEDURE GammaU(a,x : LONGREAL) : LONGREAL;
(*----------------------------------------------------------------*)
(* Berechnet die regularisierte unvollst��ndige Gammafunktion mit *)
(* der oberen Grenze x *)
(* *)
(* P(a,x) = {1 \over \Gamma a} \int_0^x e^{-t} t^{a-1} dt *)
(*----------------------------------------------------------------*)
PROCEDURE IGamma(A,X : LONGREAL) : LONGREAL;
(*----------------------------------------------------------------*)
(* Incomplete Gamma function as defined by *)
(* *)
(* IGamma(a,x) = { 1 \over |a|} \int_0^x e^{-t} t^{a-1} dt *)
(* *)
(* Based on dtmath86 / Cephes *)
(* This routine can be used as an alternative to GammaU *)
(*----------------------------------------------------------------*)
PROCEDURE JGamma(A,X : LONGREAL) : LONGREAL;
(*----------------------------------------------------------------*)
(* Complement of incomplete Gamma function as defined by *)
(* *)
(* JGamma(a,x) = { 1 \over |a|} \int_x^\inf e^{-t} t^{a-1} dt *)
(* *)
(* Based on dtmath86 / Cephes *)
(*----------------------------------------------------------------*)
PROCEDURE aLnGamma( X : LONGREAL;
VAR iFehl : INTEGER): LONGREAL;
(*----------------------------------------------------------------*)
(* Berechnet den natuerlichen Logarithmus der Gammafunktion *)
(* *)
(* iFehl : 1 wenn X <= 0 *)
(* 2 wenn X > MaxX *)
(* *)
(* Ref.: Macleod, Allan; "Algorithm AS 245, A Robust and Reliable *)
(* Algorithm for the Logarithm of the Gamma Function", *)
(* Applied Statistics, 38/2, 397-402 (1989) *)
(* *)
(* Translation of a Fortran 90 version of Burkardt, John *)
(* *)
(* This routine is less precise then dLnGamma (about *)
(* 10-12 digits) but considerably faster than its equivalent. *)
(*----------------------------------------------------------------*)
PROCEDURE LnGamma(z : LONGREAL) : LONGREAL;
(*----------------------------------------------------------------*)
(* Berechnet den Logarithmus der Gammafunktion mit *)
(* \Gamma z = \int_0^\infty t^{z-1} e^{-t} dt *)
(* Genauigkeit 2.5E-13 *)
(*----------------------------------------------------------------*)
PROCEDURE dLnGamma (X : LONGREAL) : LONGREAL;
(*----------------------------------------------------------------*)
(* This routine calculates the ln(Gamma) function for a *)
(* positive real argument X. *)
(* Computation is based on an algorithm outlined in *)
(* references 1 and 2. The program uses rational functions that *)
(* theoretically approximate ln(Gamma) to at least 18 *)
(* significant decimal digits. The approximation for X > 12 is *)
(* from reference 3, while approximations for X < 12.0 are *)
(* similar to those in reference 1, but are unpublished. The *)
(* accuracy achieved depends on the arithmetic system, the *)
(* compiler, the intrinsic functions and proper selection of the *)
(* machine dependent constants in the implementation module. *)
(* *)
(* Error returns: *)
(* *)
(* The program returns the value INF when overflow would occur *)
(* and NaN for negative arguments. The computation is believed *)
(* to be free of underflow and overflow. *)
(* *)
(* References: *)
(* *)
(* 1) W. J. Cody and K. E. Hillstrom, *)
(* 'Chebyshev Approximations for the Natural Logarithm of *)
(* the Gamma Function,' Math. Comp. 21,1967, pp. 198-203. *)
(* 2) K. E. Hillstrom, ANL/AMD Program ANLC366S, DGAMMA/DLGAMA, *)
(* May, 1969. *)
(* 3) Hart, Et. Al., Computer Approximations, Wiley and sons, *)
(* New York, 1968. *)
(* *)
(* Authors: Cody,W.J.; Stoltz,L. (Argonne National Laboratory) *)
(*----------------------------------------------------------------*)
PROCEDURE dGamma(x : LONGREAL) : LONGREAL;
(*----------------------------------------------------------------*)
(* Berechnet die vollst"andige Gammafunktion f"ur das Argument x *)
(* *)
(* This routine calculates the Gamma function for a real *)
(* argument x. *)
(* *)
(* Lit: Broucke,R; Algorithm 446, CACM, 16, 254 (1973). *)
(*----------------------------------------------------------------*)
PROCEDURE Errf(x : LONGREAL) : LONGREAL;
(*----------------------------------------------------------------*)
(* Berechnet die Fehlerfunktion Errf(x) im Intervall [0,x) *)
(* Errf x = {2 \over \sqrt\pi} \int_0^x e^{-{t^2}} dt *)
(*----------------------------------------------------------------*)
PROCEDURE ErrorF(x : LONGREAL) : LONGREAL;
(*----------------------------------------------------------------*)
(* Berechnet die Fehlerfunktion durch Polynomapproximation *)
(* *)
(* Lit.: Cody,W.J.; Waite,W.; "Software Manual for the Elementary *)
(* Functions", Prentice-Hall, Englewood Cliffs, NJ (1980). *)
(* *)
(* Basiert auf: *)
(* *)
(* http://history.dcs.ed.ac.uk/archive/os/emas/emas3/compilers/ *)
(* ercs07/olddps.txt *)
(* *)
(* Maximale Abweichung mit F77 Routine ist *)
(* *)
(* 4.4408921E-016 im Intervall (0 ,2 ) *)
(* 0.0 im Intervall (2 ,25) *)
(*----------------------------------------------------------------*)
PROCEDURE CompErrorF(x : LONGREAL) : LONGREAL;
(*----------------------------------------------------------------*)
(* Berechnet die komplementaere Fehlerfunktion durch Polynom- *)
(* approximation. *)
(* *)
(* Lit. etc. siehe Kommentare f��r ApproxErf *)
(*----------------------------------------------------------------*)
PROCEDURE CLnGamma(Z : LONGCOMPLEX) : LONGCOMPLEX;
(*----------------------------------------------------------------*)
(* Logarithm of the Gamma function for complex argument. *)
(* Returns CMPLX(INF,INF) in case of Z=0 or negative integer *)
(* *)
(* Translation of CERN Libray function CLGAMA *)
(*----------------------------------------------------------------*)
PROCEDURE CGamma(Z : LONGCOMPLEX) : LONGCOMPLEX;
(*----------------------------------------------------------------*)
(* Complex Gamma function *)
(* Returns CMPLX(INF,INF) in case of Z=0 or negative integer *)
(* or overflow *)
(*----------------------------------------------------------------*)
PROCEDURE CdGamma(x : LONGCOMPLEX) : LONGCOMPLEX;
(*----------------------------------------------------------------*)
(* Complex gamma function in double precision *)
(*----------------------------------------------------------------*)
PROCEDURE IBeta(A,B : LONGREAL;
X : LONGREAL) : LONGREAL;
(*----------------------------------------------------------------*)
(* Incomplete beta integral of the arguments, evaluated from zero *)
(* to x. *)
(* *)
(* IBeta(a,b,x) = { |a+b| \over |a| |b|} *)
(* \int_0^x t^{a-1} (1-t)^{b-1} dt *)
(* *)
(* Based on dtmath86 / Cephes *)
(*----------------------------------------------------------------*)
PROCEDURE SetGamitFast(opt : BOOLEAN);
(*----------------------------------------------------------------*)
(* Choose if aLnGamma / GammaIn are used in dGamit (speed) or *)
(* dLnGamma / GammaU (precision). If opt=true the faster variant *)
(* if opt=false the more precise subroutines are called. *)
(*----------------------------------------------------------------*)
PROCEDURE dGamit(A,X : LONGREAL): LONGREAL;
(*----------------------------------------------------------------*)
(* Calculate Tricomis form of the incomplete gamma function *)
(* defined by *)
(* *)
(* gamit = { x^(-a) \over \Gamma a } \int_0^x e^{-t} t^{a - 1} *)
(* *)
(* Code is a partial translation of W. Fullertons Fortran code *)
(* used in SLATEC. *)
(* *)
(* Gautschi, W.; "A computational procedure for incomplete gamma *)
(* functions", ACM Transactions on mathematical software, 5,4 *)
(* pp 466-481 (1979) *)
(* Gautschi, W.; "Incomplete gamma functions", Algorithm 542, *)
(* ACM Transactions on mathematical software 5,4; 482-489 (1979) *)
(* Code is a partial translation of W. Fullertons Fortran code *)
(* used in SLATEC. *)
(*----------------------------------------------------------------*)
END SpezFunkt2.