GNU Octave 10.1.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 
Loading...
Searching...
No Matches
cs1s2.f
Go to the documentation of this file.
1 SUBROUTINE cs1s2(ZR, S1, S2, NZ, ASCLE, ALIM, IUF)
2C***BEGIN PROLOGUE CS1S2
3C***REFER TO CBESK,CAIRY
4C
5C CS1S2 TESTS FOR A POSSIBLE UNDERFLOW RESULTING FROM THE
6C ADDITION OF THE I AND K FUNCTIONS IN THE ANALYTIC CON-
7C TINUATION FORMULA WHERE S1=K FUNCTION AND S2=I FUNCTION.
8C ON KODE=1 THE I AND K FUNCTIONS ARE DIFFERENT ORDERS OF
9C MAGNITUDE, BUT FOR KODE=2 THEY CAN BE OF THE SAME ORDER
10C OF MAGNITUDE AND THE MAXIMUM MUST BE AT LEAST ONE
11C PRECISION ABOVE THE UNDERFLOW LIMIT.
12C
13C***ROUTINES CALLED (NONE)
14C***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
subroutine cs1s2(zr, s1, s2, nz, ascle, alim, iuf)
Definition cs1s2.f:2
ColumnVector real(const ComplexColumnVector &a)