Mercurial > octave-nkf

annotate liboctave/cruft/slatec-fn/dasinh.f @ 20595:c1a6c31ac29a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
eliminate more simple uses of error_state * ov-classdef.cc: Eliminate simple uses of error_state.
author John W. Eaton <jwe@octave.org>
date Tue, 06 Oct 2015 00:20:02 -0400
parents 648dabbb4c6b
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
2329
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
1 *DECK DASINH
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
2 DOUBLE PRECISION FUNCTION DASINH (X)
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
3 C***BEGIN PROLOGUE DASINH
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
4 C***PURPOSE Compute the arc hyperbolic sine.
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
5 C***LIBRARY SLATEC (FNLIB)
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
6 C***CATEGORY C4C
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
7 C***TYPE DOUBLE PRECISION (ASINH-S, DASINH-D, CASINH-C)
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
8 C***KEYWORDS ARC HYPERBOLIC SINE, ASINH, ELEMENTARY FUNCTIONS, FNLIB,
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
9 C INVERSE HYPERBOLIC SINE
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
10 C***AUTHOR Fullerton, W., (LANL)
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
11 C***DESCRIPTION
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
12 C
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
13 C DASINH(X) calculates the double precision arc hyperbolic
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
14 C sine for double precision argument X.
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
15 C
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
16 C***REFERENCES (NONE)
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
17 C***ROUTINES CALLED D1MACH, DCSEVL, INITDS
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
18 C***REVISION HISTORY (YYMMDD)
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
19 C 770601 DATE WRITTEN
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
20 C 890531 Changed all specific intrinsics to generic. (WRB)
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
21 C 890531 REVISION DATE from Version 3.2
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
22 C 891214 Prologue converted to Version 4.0 format. (BAB)
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
23 C***END PROLOGUE DASINH
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
24 DOUBLE PRECISION X, ASNHCS(39), ALN2, SQEPS, XMAX, Y,
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
25 1 DCSEVL, D1MACH
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
26 LOGICAL FIRST
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
27 SAVE ASNHCS, ALN2, NTERMS, XMAX, SQEPS, FIRST
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
28 DATA ASNHCS( 1) / -.1282003991 1738186343 3721273592 68 D+0 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
29 DATA ASNHCS( 2) / -.5881176118 9951767565 2117571383 62 D-1 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
30 DATA ASNHCS( 3) / +.4727465432 2124815640 7252497560 29 D-2 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
31 DATA ASNHCS( 4) / -.4938363162 6536172101 3601747902 73 D-3 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
32 DATA ASNHCS( 5) / +.5850620705 8557412287 4948352593 21 D-4 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
33 DATA ASNHCS( 6) / -.7466998328 9313681354 7550692171 88 D-5 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
34 DATA ASNHCS( 7) / +.1001169358 3558199265 9661920158 12 D-5 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
35 DATA ASNHCS( 8) / -.1390354385 8708333608 6164722588 86 D-6 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
36 DATA ASNHCS( 9) / +.1982316948 3172793547 3173602371 48 D-7 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
37 DATA ASNHCS( 10) / -.2884746841 7848843612 7472728003 17 D-8 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
38 DATA ASNHCS( 11) / +.4267296546 7159937953 4575149959 07 D-9 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
39 DATA ASNHCS( 12) / -.6397608465 4366357868 7526323096 81 D-10 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
40 DATA ASNHCS( 13) / +.9699168608 9064704147 8782931311 79 D-11 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
41 DATA ASNHCS( 14) / -.1484427697 2043770830 2466583656 96 D-11 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
42 DATA ASNHCS( 15) / +.2290373793 9027447988 0401843789 83 D-12 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
43 DATA ASNHCS( 16) / -.3558839513 2732645159 9789426513 10 D-13 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
44 DATA ASNHCS( 17) / +.5563969408 0056789953 3745390885 54 D-14 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
45 DATA ASNHCS( 18) / -.8746250959 9624678045 6665935201 62 D-15 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
46 DATA ASNHCS( 19) / +.1381524884 4526692155 8688022981 29 D-15 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
47 DATA ASNHCS( 20) / -.2191668828 2900363984 9551422641 49 D-16 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
48 DATA ASNHCS( 21) / +.3490465852 4827565638 3139237068 80 D-17 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
49 DATA ASNHCS( 22) / -.5578578840 0895742439 6301570321 06 D-18 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
50 DATA ASNHCS( 23) / +.8944514661 7134012551 0508827989 33 D-19 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
51 DATA ASNHCS( 24) / -.1438342634 6571317305 5518452394 66 D-19 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
52 DATA ASNHCS( 25) / +.2319181187 2169963036 3261446826 66 D-20 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
53 DATA ASNHCS( 26) / -.3748700795 3314343674 5706045439 99 D-21 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
54 DATA ASNHCS( 27) / +.6073210982 2064279404 5492428800 00 D-22 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
55 DATA ASNHCS( 28) / -.9859940276 4633583177 3701734400 00 D-23 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
56 DATA ASNHCS( 29) / +.1603921745 2788496315 2326382933 33 D-23 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
57 DATA ASNHCS( 30) / -.2613884735 0287686596 7161343999 99 D-24 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
58 DATA ASNHCS( 31) / +.4267084960 6857390833 3581653333 33 D-25 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
59 DATA ASNHCS( 32) / -.6977021703 9185243299 7307733333 33 D-26 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
60 DATA ASNHCS( 33) / +.1142508833 6806858659 8126933333 33 D-26 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
61 DATA ASNHCS( 34) / -.1873529207 8860968933 0210133333 33 D-27 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
62 DATA ASNHCS( 35) / +.3076358441 4464922794 0659200000 00 D-28 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
63 DATA ASNHCS( 36) / -.5057736403 1639824787 0463999999 99 D-29 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
64 DATA ASNHCS( 37) / +.8325075471 2689142224 2133333333 33 D-30 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
65 DATA ASNHCS( 38) / -.1371845728 2501044163 9253333333 33 D-30 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
66 DATA ASNHCS( 39) / +.2262986842 6552784104 1066666666 66 D-31 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
67 DATA ALN2 / 0.6931471805 5994530941 7232121458 18D0 /
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
68 DATA FIRST /.TRUE./
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
69 C***FIRST EXECUTABLE STATEMENT DASINH
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
70 IF (FIRST) THEN
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
71 NTERMS = INITDS (ASNHCS, 39, 0.1*REAL(D1MACH(3)) )
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
72 SQEPS = SQRT(D1MACH(3))
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
73 XMAX = 1.0D0/SQEPS
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
74 ENDIF
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
75 FIRST = .FALSE.
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
76 C
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
77 Y = ABS(X)
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
78 IF (Y.GT.1.0D0) GO TO 20
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
79 C
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
80 DASINH = X
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
81 IF (Y.GT.SQEPS) DASINH = X*(1.0D0 + DCSEVL (2.D0*X*X-1.D0,
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
82 1 ASNHCS, NTERMS) )
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
83 RETURN
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
84 20 IF (Y.LT.XMAX) DASINH = LOG (Y+SQRT(Y*Y+1.D0))
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
85 IF (Y.GE.XMAX) DASINH = ALN2 + LOG(Y)
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
86 DASINH = SIGN (DASINH, X)
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
87 RETURN
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
88 C
30c606bec7a8 [project @ 1996-07-19 01:29:05 by jwe]
jwe
parents:
diff changeset
89 END