~ubuntu-branches/ubuntu/wily/julia/wily

« back to all changes in this revision

Viewing changes to deps/openlibm/slatec/cs1s2.f

  • Committer: Package Import Robot
  • Author(s): Sébastien Villemot
  • Date: 2013-01-16 12:29:42 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130116122942-x86e42akjq31repw
Tags: 0.0.0+20130107.gitd9656f41-1
* New upstream snashot
* No longer try to rebuild helpdb.jl.
   + debian/rules: remove helpdb.jl from build-arch rule
   + debian/control: move back python-sphinx to Build-Depends-Indep
* debian/copyright: reflect upstream changes
* Add Build-Conflicts on libatlas3-base (makes linalg tests fail)
* debian/rules: replace obsolete USE_DEBIAN makeflag by a list of
  USE_SYSTEM_* flags
* debian/rules: on non-x86 systems, use libm instead of openlibm
* dpkg-buildflags.patch: remove patch, applied upstream
* Refreshed other patches

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
*DECK CS1S2
 
2
      SUBROUTINE CS1S2 (ZR, S1, S2, NZ, ASCLE, ALIM, IUF)
 
3
C***BEGIN PROLOGUE  CS1S2
 
4
C***SUBSIDIARY
 
5
C***PURPOSE  Subsidiary to CAIRY and CBESK
 
6
C***LIBRARY   SLATEC
 
7
C***TYPE      ALL (CS1S2-A, ZS1S2-A)
 
8
C***AUTHOR  Amos, D. E., (SNL)
 
9
C***DESCRIPTION
 
10
C
 
11
C     CS1S2 TESTS FOR A POSSIBLE UNDERFLOW RESULTING FROM THE
 
12
C     ADDITION OF THE I AND K FUNCTIONS IN THE ANALYTIC CON-
 
13
C     TINUATION FORMULA WHERE S1=K FUNCTION AND S2=I FUNCTION.
 
14
C     ON KODE=1 THE I AND K FUNCTIONS ARE DIFFERENT ORDERS OF
 
15
C     MAGNITUDE, BUT FOR KODE=2 THEY CAN BE OF THE SAME ORDER
 
16
C     OF MAGNITUDE AND THE MAXIMUM MUST BE AT LEAST ONE
 
17
C     PRECISION ABOVE THE UNDERFLOW LIMIT.
 
18
C
 
19
C***SEE ALSO  CAIRY, CBESK
 
20
C***ROUTINES CALLED  (NONE)
 
21
C***REVISION HISTORY  (YYMMDD)
 
22
C   830501  DATE WRITTEN
 
23
C   910415  Prologue converted to Version 4.0 format.  (BAB)
 
24
C***END PROLOGUE  CS1S2
 
25
      COMPLEX CZERO, C1, S1, S1D, S2, ZR
 
26
      REAL AA, ALIM, ALN, ASCLE, AS1, AS2, XX
 
27
      INTEGER IUF, NZ
 
28
      DATA CZERO / (0.0E0,0.0E0) /
 
29
C***FIRST EXECUTABLE STATEMENT  CS1S2
 
30
      NZ = 0
 
31
      AS1 = ABS(S1)
 
32
      AS2 = ABS(S2)
 
33
      AA = REAL(S1)
 
34
      ALN = AIMAG(S1)
 
35
      IF (AA.EQ.0.0E0 .AND. ALN.EQ.0.0E0) GO TO 10
 
36
      IF (AS1.EQ.0.0E0) GO TO 10
 
37
      XX = REAL(ZR)
 
38
      ALN = -XX - XX + ALOG(AS1)
 
39
      S1D = S1
 
40
      S1 = CZERO
 
41
      AS1 = 0.0E0
 
42
      IF (ALN.LT.(-ALIM)) GO TO 10
 
43
      C1 = CLOG(S1D) - ZR - ZR
 
44
      S1 = CEXP(C1)
 
45
      AS1 = ABS(S1)
 
46
      IUF = IUF + 1
 
47
   10 CONTINUE
 
48
      AA = MAX(AS1,AS2)
 
49
      IF (AA.GT.ASCLE) RETURN
 
50
      S1 = CZERO
 
51
      S2 = CZERO
 
52
      NZ = 1
 
53
      IUF = 0
 
54
      RETURN
 
55
      END