~ubuntu-branches/ubuntu/karmic/scilab/karmic

« back to all changes in this revision

Viewing changes to routines/control/calcsc.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
      subroutine calcsc(type)
 
2
c this routine calculates scalar quantities used to
 
3
c compute the next k polynomial and new estimates of
 
4
c the quadratic coefficients.
 
5
c type - integer variable set here indicating how the
 
6
c calculations are normalized to avoid overflow
 
7
      common /gloglo/ p, qp, k, qk, svk, sr, si, u,
 
8
     * v, a, b, c, d, a1, a2, a3, a6, a7, e, f, g,
 
9
     * h, szr, szi, lzr, lzi, eta, are, mre, n, nn
 
10
      double precision p(101), qp(101), k(101),
 
11
     * qk(101), svk(101), sr, si, u, v, a, b, c, d,
 
12
     * a1, a2, a3, a6, a7, e, f, g, h, szr, szi,
 
13
     * lzr, lzi
 
14
      real eta, are, mre
 
15
      integer n, nn
 
16
      integer type
 
17
c synthetic division of k by the quadratic 1,u,v
 
18
      call quadsd(n, u, v, k(1), qk(1), c, d)
 
19
      if (abs(c).gt.abs(k(n))*100.*eta) go to 10
 
20
      if (abs(d).gt.abs(k(n-1))*100.*eta) go to 10
 
21
      type = 3
 
22
c type=3 indicates the quadratic is almost a factor
 
23
c of k
 
24
      return
 
25
   10 if (abs(d).lt.abs(c)) go to 20
 
26
      type = 2
 
27
c type=2 indicates that all formulas are divided by d
 
28
      e = a/d
 
29
      f = c/d
 
30
      g = u*b
 
31
      h = v*b
 
32
      a3 = (a+g)*e + h*(b/d)
 
33
      a1 = b*f - a
 
34
      a7 = (f+u)*a +h
 
35
      return
 
36
   20 type = 1
 
37
c type=1 indicates that all formulas are divided by c
 
38
      e = a/c
 
39
      f = d/c
 
40
      g = u*e
 
41
      h = v*b
 
42
      a3 = a*e + (h/c+g)*b
 
43
      a1 = b - a*(d/c)
 
44
      a7 = a + g*d + h*f
 
45
      return
 
46
      end