*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