GNU Octave  3.8.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Properties Friends Macros Pages
zs1s2.f
Go to the documentation of this file.
1  SUBROUTINE zs1s2(ZRR, ZRI, S1R, S1I, S2R, S2I, NZ, ASCLE, ALIM,
2  * iuf)
3 C***BEGIN PROLOGUE ZS1S2
4 C***REFER TO ZBESK,ZAIRY
5 C
6 C ZS1S2 TESTS FOR A POSSIBLE UNDERFLOW RESULTING FROM THE
7 C ADDITION OF THE I AND K FUNCTIONS IN THE ANALYTIC CON-
8 C TINUATION FORMULA WHERE S1=K FUNCTION AND S2=I FUNCTION.
9 C ON KODE=1 THE I AND K FUNCTIONS ARE DIFFERENT ORDERS OF
10 C MAGNITUDE, BUT FOR KODE=2 THEY CAN BE OF THE SAME ORDER
11 C OF MAGNITUDE AND THE MAXIMUM MUST BE AT LEAST ONE
12 C PRECISION ABOVE THE UNDERFLOW LIMIT.
13 C
14 C***ROUTINES CALLED XZABS,XZEXP,XZLOG
15 C***END PROLOGUE ZS1S2
16 C COMPLEX CZERO,C1,S1,S1D,S2,ZR
17  DOUBLE PRECISION aa, alim, aln, ascle, as1, as2, c1i, c1r, s1di,
18  * s1dr, s1i, s1r, s2i, s2r, zeroi, zeror, zri, zrr, xzabs
19  INTEGER iuf, idum, nz
20  DATA zeror,zeroi / 0.0d0 , 0.0d0 /
21  nz = 0
22  as1 = xzabs(s1r,s1i)
23  as2 = xzabs(s2r,s2i)
24  IF (s1r.EQ.0.0d0 .AND. s1i.EQ.0.0d0) go to 10
25  IF (as1.EQ.0.0d0) go to 10
26  aln = -zrr - zrr + dlog(as1)
27  s1dr = s1r
28  s1di = s1i
29  s1r = zeror
30  s1i = zeroi
31  as1 = zeror
32  IF (aln.LT.(-alim)) go to 10
33  CALL xzlog(s1dr, s1di, c1r, c1i, idum)
34  c1r = c1r - zrr - zrr
35  c1i = c1i - zri - zri
36  CALL xzexp(c1r, c1i, s1r, s1i)
37  as1 = xzabs(s1r,s1i)
38  iuf = iuf + 1
39  10 CONTINUE
40  aa = dmax1(as1,as2)
41  IF (aa.GT.ascle) RETURN
42  s1r = zeror
43  s1i = zeroi
44  s2r = zeror
45  s2i = zeroi
46  nz = 1
47  iuf = 0
48  RETURN
49  END