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
cs1s2.f
Go to the documentation of this file.
1  SUBROUTINE cs1s2(ZR, S1, S2, NZ, ASCLE, ALIM, IUF)
2 C***BEGIN PROLOGUE CS1S2
3 C***REFER TO CBESK,CAIRY
4 C
5 C CS1S2 TESTS FOR A POSSIBLE UNDERFLOW RESULTING FROM THE
6 C ADDITION OF THE I AND K FUNCTIONS IN THE ANALYTIC CON-
7 C TINUATION FORMULA WHERE S1=K FUNCTION AND S2=I FUNCTION.
8 C ON KODE=1 THE I AND K FUNCTIONS ARE DIFFERENT ORDERS OF
9 C MAGNITUDE, BUT FOR KODE=2 THEY CAN BE OF THE SAME ORDER
10 C OF MAGNITUDE AND THE MAXIMUM MUST BE AT LEAST ONE
11 C PRECISION ABOVE THE UNDERFLOW LIMIT.
12 C
13 C***ROUTINES CALLED (NONE)
14 C***END PROLOGUE CS1S2
15  COMPLEX czero, c1, s1, s1d, s2, zr
16  REAL aa, alim, aln, ascle, as1, as2, xx
17  INTEGER iuf, nz
18  DATA czero / (0.0e0,0.0e0) /
19  nz = 0
20  as1 = cabs(s1)
21  as2 = cabs(s2)
22  aa = REAL(s1)
23  aln = aimag(s1)
24  IF (aa.EQ.0.0e0 .AND. aln.EQ.0.0e0) go to 10
25  IF (as1.EQ.0.0e0) go to 10
26  xx = REAL(zr)
27  aln = -xx - xx + alog(as1)
28  s1d = s1
29  s1 = czero
30  as1 = 0.0e0
31  IF (aln.LT.(-alim)) go to 10
32  c1 = clog(s1d) - zr - zr
33  s1 = cexp(c1)
34  as1 = cabs(s1)
35  iuf = iuf + 1
36  10 CONTINUE
37  aa = amax1(as1,as2)
38  IF (aa.GT.ascle) RETURN
39  s1 = czero
40  s2 = czero
41  nz = 1
42  iuf = 0
43  RETURN
44  END