mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
89 lines
3 KiB
Fortran
89 lines
3 KiB
Fortran
*DECK C9LGMC
|
|
COMPLEX FUNCTION C9LGMC (ZIN)
|
|
C***BEGIN PROLOGUE C9LGMC
|
|
C***SUBSIDIARY
|
|
C***PURPOSE Compute the log gamma correction factor so that
|
|
C LOG(CGAMMA(Z)) = 0.5*LOG(2.*PI) + (Z-0.5)*LOG(Z) - Z
|
|
C + C9LGMC(Z).
|
|
C***LIBRARY SLATEC (FNLIB)
|
|
C***CATEGORY C7A
|
|
C***TYPE COMPLEX (R9LGMC-S, D9LGMC-D, C9LGMC-C)
|
|
C***KEYWORDS COMPLETE GAMMA FUNCTION, CORRECTION TERM, FNLIB,
|
|
C LOG GAMMA, LOGARITHM, SPECIAL FUNCTIONS
|
|
C***AUTHOR Fullerton, W., (LANL)
|
|
C***DESCRIPTION
|
|
C
|
|
C Compute the LOG GAMMA correction term for large ABS(Z) when REAL(Z)
|
|
C .GE. 0.0 and for large ABS(AIMAG(Y)) when REAL(Z) .LT. 0.0. We find
|
|
C C9LGMC so that
|
|
C LOG(Z) = 0.5*LOG(2.*PI) + (Z-0.5)*LOG(Z) - Z + C9LGMC(Z)
|
|
C
|
|
C***REFERENCES (NONE)
|
|
C***ROUTINES CALLED R1MACH, XERMSG
|
|
C***REVISION HISTORY (YYMMDD)
|
|
C 780401 DATE WRITTEN
|
|
C 890531 Changed all specific intrinsics to generic. (WRB)
|
|
C 890531 REVISION DATE from Version 3.2
|
|
C 891214 Prologue converted to Version 4.0 format. (BAB)
|
|
C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
|
|
C 900326 Removed duplicate information from DESCRIPTION section.
|
|
C (WRB)
|
|
C 900720 Routine changed from user-callable to subsidiary. (WRB)
|
|
C***END PROLOGUE C9LGMC
|
|
COMPLEX ZIN, Z, Z2INV
|
|
DIMENSION BERN(11)
|
|
LOGICAL FIRST
|
|
SAVE BERN, NTERM, BOUND, XBIG, XMAX, FIRST
|
|
DATA BERN( 1) / .08333333333 3333333E0 /
|
|
DATA BERN( 2) / -.002777777777 7777778E0 /
|
|
DATA BERN( 3) / .0007936507936 5079365E0 /
|
|
DATA BERN( 4) / -.0005952380952 3809524E0 /
|
|
DATA BERN( 5) / .0008417508417 5084175E0 /
|
|
DATA BERN( 6) / -.001917526917 5269175E0 /
|
|
DATA BERN( 7) / .006410256410 2564103E0 /
|
|
DATA BERN( 8) / -.02955065359 4771242E0 /
|
|
DATA BERN( 9) / .1796443723 6883057E0 /
|
|
DATA BERN(10) / -1.392432216 9059011E0 /
|
|
DATA BERN(11) / 13.40286404 4168392E0 /
|
|
DATA FIRST /.TRUE./
|
|
C***FIRST EXECUTABLE STATEMENT C9LGMC
|
|
IF (FIRST) THEN
|
|
NTERM = -0.30*LOG(R1MACH(3))
|
|
BOUND = 0.1170*NTERM*(0.1*R1MACH(3))**(-1./(2*NTERM-1))
|
|
XBIG = 1.0/SQRT(R1MACH(3))
|
|
XMAX = EXP (MIN(LOG(R1MACH(2)/12.0), -LOG(12.*R1MACH(1))) )
|
|
ENDIF
|
|
FIRST = .FALSE.
|
|
C
|
|
Z = ZIN
|
|
X = REAL (Z)
|
|
Y = AIMAG(Z)
|
|
CABSZ = ABS(Z)
|
|
C
|
|
IF (X .LT. 0.0 .AND. ABS(Y) .LT. BOUND) CALL XERMSG ('SLATEC',
|
|
+ 'C9LGMC', 'NOT VALID FOR NEGATIVE REAL(Z) AND SMALL ' //
|
|
+ 'ABS(AIMAG(Z))', 2, 2)
|
|
IF (CABSZ .LT. BOUND) CALL XERMSG ('SLATEC', 'C9LGMC',
|
|
+ 'NOT VALID FOR SMALL ABS(Z)', 3, 2)
|
|
C
|
|
IF (CABSZ.GE.XMAX) GO TO 50
|
|
C
|
|
IF (CABSZ.GE.XBIG) C9LGMC = 1.0/(12.0*Z)
|
|
IF (CABSZ.GE.XBIG) RETURN
|
|
C
|
|
Z2INV = 1.0/Z**2
|
|
C9LGMC = (0.0, 0.0)
|
|
DO 40 I=1,NTERM
|
|
NDX = NTERM + 1 - I
|
|
C9LGMC = BERN(NDX) + C9LGMC*Z2INV
|
|
40 CONTINUE
|
|
C
|
|
C9LGMC = C9LGMC/Z
|
|
RETURN
|
|
C
|
|
50 C9LGMC = (0.0, 0.0)
|
|
CALL XERMSG ('SLATEC', 'C9LGMC', 'Z SO BIG C9LGMC UNDERFLOWS', 1,
|
|
+ 1)
|
|
RETURN
|
|
C
|
|
END
|