zs1s2.f

Go to the documentation of this file.

      SUBROUTINE zs1s2(ZRR, ZRI, S1R, S1I, S2R, S2I, NZ, ASCLE, ALIM,
     * IUF)
C***BEGIN PROLOGUE  ZS1S2
C***REFER TO  ZBESK,ZAIRY
C
C     ZS1S2 TESTS FOR A POSSIBLE UNDERFLOW RESULTING FROM THE
C     ADDITION OF THE I AND K FUNCTIONS IN THE ANALYTIC CON-
C     TINUATION FORMULA WHERE S1=K FUNCTION AND S2=I FUNCTION.
C     ON KODE=1 THE I AND K FUNCTIONS ARE DIFFERENT ORDERS OF
C     MAGNITUDE, BUT FOR KODE=2 THEY CAN BE OF THE SAME ORDER
C     OF MAGNITUDE AND THE MAXIMUM MUST BE AT LEAST ONE
C     PRECISION ABOVE THE UNDERFLOW LIMIT.
C
C***ROUTINES CALLED  XZABS,XZEXP,XZLOG
C***END PROLOGUE  ZS1S2
C     COMPLEX CZERO,C1,S1,S1D,S2,ZR
      DOUBLE PRECISION AA, ALIM, ALN, ASCLE, AS1, AS2, C1I, C1R, S1DI,
     * s1dr, s1i, s1r, s2i, s2r, zeroi, zeror, zri, zrr, xzabs
      INTEGER IUF, IDUM, NZ
      DATA zeror,zeroi  / 0.0d0 , 0.0d0 /
      nz = 0
      as1 = xzabs(s1r,s1i)
      as2 = xzabs(s2r,s2i)
      IF (s1r.EQ.0.0d0 .AND. s1i.EQ.0.0d0) GO TO 10
      IF (as1.EQ.0.0d0) GO TO 10
      aln = -zrr - zrr + dlog(as1)
      s1dr = s1r
      s1di = s1i
      s1r = zeror
      s1i = zeroi
      as1 = zeror
      IF (aln.LT.(-alim)) GO TO 10
      CALL xzlog(s1dr, s1di, c1r, c1i, idum)
      c1r = c1r - zrr - zrr
      c1i = c1i - zri - zri
      CALL xzexp(c1r, c1i, s1r, s1i)
      as1 = xzabs(s1r,s1i)
      iuf = iuf + 1
   10 CONTINUE
      aa = dmax1(as1,as2)
      IF (aa.GT.ascle) RETURN
      s1r = zeror
      s1i = zeroi
      s2r = zeror
      s2i = zeroi
      nz = 1
      iuf = 0
      RETURN
      END