mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
c977aa998f
Replace amos with slatec
124 lines
6 KiB
Fortran
124 lines
6 KiB
Fortran
*DECK PSIXN
|
|
FUNCTION PSIXN (N)
|
|
C***BEGIN PROLOGUE PSIXN
|
|
C***SUBSIDIARY
|
|
C***PURPOSE Subsidiary to EXINT
|
|
C***LIBRARY SLATEC
|
|
C***TYPE SINGLE PRECISION (PSIXN-S, DPSIXN-D)
|
|
C***AUTHOR Amos, D. E., (SNLA)
|
|
C***DESCRIPTION
|
|
C
|
|
C This subroutine returns values of PSI(X)=derivative of log
|
|
C GAMMA(X), X .GT. 0.0 at integer arguments. A table look-up is
|
|
C performed for N .LE. 100, and the asymptotic expansion is
|
|
C evaluated for N .GT. 100.
|
|
C
|
|
C***SEE ALSO EXINT
|
|
C***ROUTINES CALLED R1MACH
|
|
C***REVISION HISTORY (YYMMDD)
|
|
C 800501 DATE WRITTEN
|
|
C 890531 Changed all specific intrinsics to generic. (WRB)
|
|
C 891214 Prologue converted to Version 4.0 format. (BAB)
|
|
C 900328 Added TYPE section. (WRB)
|
|
C 910722 Updated AUTHOR section. (ALS)
|
|
C***END PROLOGUE PSIXN
|
|
C
|
|
INTEGER N, K
|
|
REAL AX, B, C, FN, RFN2, TRM, S, WDTOL
|
|
REAL R1MACH
|
|
DIMENSION B(6), C(100)
|
|
C-----------------------------------------------------------------------
|
|
C PSIXN(N), N = 1,100
|
|
C-----------------------------------------------------------------------
|
|
DATA C(1), C(2), C(3), C(4), C(5), C(6), C(7), C(8), C(9), C(10),
|
|
1 C(11), C(12), C(13), C(14), C(15), C(16), C(17), C(18),
|
|
2 C(19), C(20), C(21), C(22), C(23), C(24)/
|
|
3 -5.77215664901532861E-01, 4.22784335098467139E-01,
|
|
4 9.22784335098467139E-01, 1.25611766843180047E+00,
|
|
5 1.50611766843180047E+00, 1.70611766843180047E+00,
|
|
6 1.87278433509846714E+00, 2.01564147795561000E+00,
|
|
7 2.14064147795561000E+00, 2.25175258906672111E+00,
|
|
8 2.35175258906672111E+00, 2.44266167997581202E+00,
|
|
9 2.52599501330914535E+00, 2.60291809023222227E+00,
|
|
1 2.67434666166079370E+00, 2.74101332832746037E+00,
|
|
2 2.80351332832746037E+00, 2.86233685773922507E+00,
|
|
3 2.91789241329478063E+00, 2.97052399224214905E+00,
|
|
4 3.02052399224214905E+00, 3.06814303986119667E+00,
|
|
5 3.11359758531574212E+00, 3.15707584618530734E+00/
|
|
DATA C(25), C(26), C(27), C(28), C(29), C(30), C(31), C(32),
|
|
1 C(33), C(34), C(35), C(36), C(37), C(38), C(39), C(40),
|
|
2 C(41), C(42), C(43), C(44), C(45), C(46), C(47), C(48)/
|
|
3 3.19874251285197401E+00, 3.23874251285197401E+00,
|
|
4 3.27720405131351247E+00, 3.31424108835054951E+00,
|
|
5 3.34995537406483522E+00, 3.38443813268552488E+00,
|
|
6 3.41777146601885821E+00, 3.45002953053498724E+00,
|
|
7 3.48127953053498724E+00, 3.51158256083801755E+00,
|
|
8 3.54099432554389990E+00, 3.56956575411532847E+00,
|
|
9 3.59734353189310625E+00, 3.62437055892013327E+00,
|
|
1 3.65068634839381748E+00, 3.67632737403484313E+00,
|
|
2 3.70132737403484313E+00, 3.72571761793728215E+00,
|
|
3 3.74952714174680596E+00, 3.77278295570029433E+00,
|
|
4 3.79551022842756706E+00, 3.81773245064978928E+00,
|
|
5 3.83947158108457189E+00, 3.86074817682925274E+00/
|
|
DATA C(49), C(50), C(51), C(52), C(53), C(54), C(55), C(56),
|
|
1 C(57), C(58), C(59), C(60), C(61), C(62), C(63), C(64),
|
|
2 C(65), C(66), C(67), C(68), C(69), C(70), C(71), C(72)/
|
|
3 3.88158151016258607E+00, 3.90198967342789220E+00,
|
|
4 3.92198967342789220E+00, 3.94159751656514710E+00,
|
|
5 3.96082828579591633E+00, 3.97969621032421822E+00,
|
|
6 3.99821472884273674E+00, 4.01639654702455492E+00,
|
|
7 4.03425368988169777E+00, 4.05179754953082058E+00,
|
|
8 4.06903892884116541E+00, 4.08598808138353829E+00,
|
|
9 4.10265474805020496E+00, 4.11904819067315578E+00,
|
|
1 4.13517722293122029E+00, 4.15105023880423617E+00,
|
|
2 4.16667523880423617E+00, 4.18205985418885155E+00,
|
|
3 4.19721136934036670E+00, 4.21213674247469506E+00,
|
|
4 4.22684262482763624E+00, 4.24133537845082464E+00,
|
|
5 4.25562109273653893E+00, 4.26970559977879245E+00/
|
|
DATA C(73), C(74), C(75), C(76), C(77), C(78), C(79), C(80),
|
|
1 C(81), C(82), C(83), C(84), C(85), C(86), C(87), C(88),
|
|
2 C(89), C(90), C(91), C(92), C(93), C(94), C(95), C(96)/
|
|
3 4.28359448866768134E+00, 4.29729311880466764E+00,
|
|
4 4.31080663231818115E+00, 4.32413996565151449E+00,
|
|
5 4.33729786038835659E+00, 4.35028487337536958E+00,
|
|
6 4.36310538619588240E+00, 4.37576361404398366E+00,
|
|
7 4.38826361404398366E+00, 4.40060929305632934E+00,
|
|
8 4.41280441500754886E+00, 4.42485260777863319E+00,
|
|
9 4.43675736968339510E+00, 4.44852207556574804E+00,
|
|
1 4.46014998254249223E+00, 4.47164423541605544E+00,
|
|
2 4.48300787177969181E+00, 4.49424382683587158E+00,
|
|
3 4.50535493794698269E+00, 4.51634394893599368E+00,
|
|
4 4.52721351415338499E+00, 4.53796620232542800E+00,
|
|
5 4.54860450019776842E+00, 4.55913081598724211E+00/
|
|
DATA C(97), C(98), C(99), C(100)/
|
|
1 4.56954748265390877E+00, 4.57985676100442424E+00,
|
|
2 4.59006084263707730E+00, 4.60016185273808740E+00/
|
|
C-----------------------------------------------------------------------
|
|
C COEFFICIENTS OF ASYMPTOTIC EXPANSION
|
|
C-----------------------------------------------------------------------
|
|
DATA B(1), B(2), B(3), B(4), B(5), B(6)/
|
|
1 8.33333333333333333E-02, -8.33333333333333333E-03,
|
|
2 3.96825396825396825E-03, -4.16666666666666666E-03,
|
|
3 7.57575757575757576E-03, -2.10927960927960928E-02/
|
|
C
|
|
C***FIRST EXECUTABLE STATEMENT PSIXN
|
|
IF (N.GT.100) GO TO 10
|
|
PSIXN = C(N)
|
|
RETURN
|
|
10 CONTINUE
|
|
WDTOL = MAX(R1MACH(4),1.0E-18)
|
|
FN = N
|
|
AX = 1.0E0
|
|
S = -0.5E0/FN
|
|
IF (ABS(S).LE.WDTOL) GO TO 30
|
|
RFN2 = 1.0E0/(FN*FN)
|
|
DO 20 K=1,6
|
|
AX = AX*RFN2
|
|
TRM = -B(K)*AX
|
|
IF (ABS(TRM).LT.WDTOL) GO TO 30
|
|
S = S + TRM
|
|
20 CONTINUE
|
|
30 CONTINUE
|
|
PSIXN = S + LOG(FN)
|
|
RETURN
|
|
END
|