~ubuntu-branches/ubuntu/hoary/scilab/hoary

« back to all changes in this revision

Viewing changes to routines/calelm/pythag.f

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2002-03-21 16:57:43 UTC
  • Revision ID: james.westby@ubuntu.com-20020321165743-e9mv12c1tb1plztg
Tags: upstream-2.6
ImportĀ upstreamĀ versionĀ 2.6

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
C/MEMBR ADD NAME=PYTHAG,SSI=0
 
2
c     Copyright INRIA
 
3
      double precision function pythag(a,b)
 
4
c!but
 
5
c     pythag calcule (a**2+b**2)**(1/2), par une methode iterative
 
6
c!liste d'appel
 
7
c     double precision function pythag(a,b)
 
8
c     double precision a,b
 
9
c!
 
10
      double precision a,b,dlamch
 
11
      double precision p,q,r,s,t
 
12
c     --------testing Nans 
 
13
      if (isanan(a).eq.1) then 
 
14
         pythag=a 
 
15
         return
 
16
      endif
 
17
      if (isanan(b).eq.1) then 
 
18
         pythag=b
 
19
         return
 
20
      endif
 
21
c     --------testing Inf 
 
22
      if ( a.ge.dlamch('o').or.-a.ge.dlamch('o')) then 
 
23
         pythag = abs(a)
 
24
         return
 
25
      endif
 
26
      if ( b.ge.dlamch('o').or.-b.ge.dlamch('o')) then 
 
27
         pythag = abs(b)
 
28
         return
 
29
      endif
 
30
c     --------generic case 
 
31
      p = max(abs(a),abs(b))
 
32
      q = min(abs(a),abs(b))
 
33
      if (q .eq. 0.0d+0) go to 20
 
34
   10 r = (q/p)**2
 
35
      t = 4.0d+0 + r
 
36
      if (t .eq. 4.0d+0) go to 20
 
37
      s = r/t
 
38
      p = p + 2.0d+0*p*s
 
39
      q = q*s
 
40
      go to 10
 
41
   20 pythag = p
 
42
      return
 
43
      end