GNU Octave  4.4.1
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
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