alnrel.f

Go to the documentation of this file.

*DECK ALNREL
      FUNCTION alnrel (X)
C***BEGIN PROLOGUE  ALNREL
C***PURPOSE  Evaluate ln(1+X) accurate in the sense of relative error.
C***LIBRARY   SLATEC (FNLIB)
C***CATEGORY  C4B
C***TYPE      SINGLE PRECISION (ALNREL-S, DLNREL-D, CLNREL-C)
C***KEYWORDS  ELEMENTARY FUNCTIONS, FNLIB, LOGARITHM
C***AUTHOR  Fullerton, W., (LANL)
C***DESCRIPTION
C
C ALNREL(X) evaluates ln(1+X) accurately in the sense of relative
C error when X is very small.  This routine must be used to
C maintain relative error accuracy whenever X is small and
C accurately known.
C
C Series for ALNR       on the interval -3.75000D-01 to  3.75000D-01
C                                        with weighted error   1.93E-17
C                                         log weighted error  16.72
C                               significant figures required  16.44
C                                    decimal places required  17.40
C
C***REFERENCES  (NONE)
C***ROUTINES CALLED  CSEVL, INITS, R1MACH, XERMSG
C***REVISION HISTORY  (YYMMDD)
C   770401  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***END PROLOGUE  ALNREL
      dimension alnrcs(23)
      LOGICAL first
      SAVE alnrcs, nlnrel, xmin, first
      DATA alnrcs( 1) /   1.0378693562 743770e0 /
      DATA alnrcs( 2) /   -.1336430150 4908918e0 /
      DATA alnrcs( 3) /    .0194082491 35520563e0 /
      DATA alnrcs( 4) /   -.0030107551 12753577e0 /
      DATA alnrcs( 5) /    .0004869461 47971548e0 /
      DATA alnrcs( 6) /   -.0000810548 81893175e0 /
      DATA alnrcs( 7) /    .0000137788 47799559e0 /
      DATA alnrcs( 8) /   -.0000023802 21089435e0 /
      DATA alnrcs( 9) /    .0000004164 04162138e0 /
      DATA alnrcs(10) /   -.0000000735 95828378e0 /
      DATA alnrcs(11) /    .0000000131 17611876e0 /
      DATA alnrcs(12) /   -.0000000023 54670931e0 /
      DATA alnrcs(13) /    .0000000004 25227732e0 /
      DATA alnrcs(14) /   -.0000000000 77190894e0 /
      DATA alnrcs(15) /    .0000000000 14075746e0 /
      DATA alnrcs(16) /   -.0000000000 02576907e0 /
      DATA alnrcs(17) /    .0000000000 00473424e0 /
      DATA alnrcs(18) /   -.0000000000 00087249e0 /
      DATA alnrcs(19) /    .0000000000 00016124e0 /
      DATA alnrcs(20) /   -.0000000000 00002987e0 /
      DATA alnrcs(21) /    .0000000000 00000554e0 /
      DATA alnrcs(22) /   -.0000000000 00000103e0 /
      DATA alnrcs(23) /    .0000000000 00000019e0 /
      DATA first /.true./
C***FIRST EXECUTABLE STATEMENT  ALNREL
      IF (first) THEN
         nlnrel = inits(alnrcs, 23, 0.1*r1mach(3))
         xmin = -1.0 + sqrt(r1mach(4))
      ENDIF
      first = .false.
C
      IF (x .LE. (-1.0)) CALL xermsg('SLATEC', 'ALNREL', 'X IS LE -1',
     +   2, 2)
      IF (x .LT. xmin) CALL xermsg('SLATEC', 'ALNREL',
     +   'ANSWER LT HALF PRECISION BECAUSE X TOO NEAR -1', 1, 1)
C
      IF (abs(x).LE.0.375) alnrel = x*(1. -
     1  x*csevl(x/.375, alnrcs, nlnrel))
      IF (abs(x).GT.0.375) alnrel = log(1.0+x)
C
      RETURN
      END