GNU Octave: libcruft/amos/cs1s2.f Source File

Go to the documentation of this file.
00001       SUBROUTINE CS1S2(ZR, S1, S2, NZ, ASCLE, ALIM, IUF)
00002 C***BEGIN PROLOGUE  CS1S2
00003 C***REFER TO  CBESK,CAIRY
00004 C
00005 C     CS1S2 TESTS FOR A POSSIBLE UNDERFLOW RESULTING FROM THE
00006 C     ADDITION OF THE I AND K FUNCTIONS IN THE ANALYTIC CON-
00007 C     TINUATION FORMULA WHERE S1=K FUNCTION AND S2=I FUNCTION.
00008 C     ON KODE=1 THE I AND K FUNCTIONS ARE DIFFERENT ORDERS OF
00009 C     MAGNITUDE, BUT FOR KODE=2 THEY CAN BE OF THE SAME ORDER
00010 C     OF MAGNITUDE AND THE MAXIMUM MUST BE AT LEAST ONE
00011 C     PRECISION ABOVE THE UNDERFLOW LIMIT.
00012 C
00013 C***ROUTINES CALLED  (NONE)
00014 C***END PROLOGUE  CS1S2
00015       COMPLEX CZERO, C1, S1, S1D, S2, ZR
00016       REAL AA, ALIM, ALN, ASCLE, AS1, AS2, XX
00017       INTEGER IUF, NZ
00018       DATA CZERO / (0.0E0,0.0E0) /
00019       NZ = 0
00020       AS1 = CABS(S1)
00021       AS2 = CABS(S2)
00022       AA = REAL(S1)
00023       ALN = AIMAG(S1)
00024       IF (AA.EQ.0.0E0 .AND. ALN.EQ.0.0E0) GO TO 10
00025       IF (AS1.EQ.0.0E0) GO TO 10
00026       XX = REAL(ZR)
00027       ALN = -XX - XX + ALOG(AS1)
00028       S1D = S1
00029       S1 = CZERO
00030       AS1 = 0.0E0
00031       IF (ALN.LT.(-ALIM)) GO TO 10
00032       C1 = CLOG(S1D) - ZR - ZR
00033       S1 = CEXP(C1)
00034       AS1 = CABS(S1)
00035       IUF = IUF + 1
00036    10 CONTINUE
00037       AA = AMAX1(AS1,AS2)
00038       IF (AA.GT.ASCLE) RETURN
00039       S1 = CZERO
00040       S2 = CZERO
00041       NZ = 1
00042       IUF = 0
00043       RETURN
00044       END