← Back to branch summary

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

« back to all changes in this revision

Viewing changes to routines/signal/transn.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:
routines/signal/transn.f
 
1
      subroutine transn(ityp,om,norma,vsn,vd,a)
 
2
c!purpose
 
3
c computation of the parameters of the normalized lowpass
 
4
c!
 
5
c
 
6
      implicit double precision (a-h,o-z)
 
7
      double precision  om(*)
 
8
c
 
9
      tan2(aa) = sin(aa/2.0d+0)/cos(aa/2.0d+0)
 
10
c
 
11
c
 
12
c         Nomenclature Rabiner-Gold (page 241)
 
13
c         Si ityp = < 2
 
14
c         vsn=1/k
 
15
      v1 = tan2(om(1))
 
16
      v2 = tan2(om(2))
 
17
      if (ityp.le.2) go to 210
 
18
      v3 = tan2(om(3))
 
19
      v4 = tan2(om(4))
 
20
      if (ityp.eq.3) go to 10
 
21
      q = v1
 
22
      v1 = -v4
 
23
      v4 = -q
 
24
      q = v2
 
25
      v2 = -v3
 
26
      v3 = -q
 
27
c
 
28
  10  jj = 1
 
29
      j = norma + 1
 
30
      go to (30, 30, 40, 70), j
 
31
  30  vdq1 = v2*v3
 
32
      vsn1 = vdq1/v1 - v1
 
33
      q = v4 - vdq1/v4
 
34
      if (q.lt.vsn1) vsn1 = q
 
35
      a1 = 1.0d+0/(v3-v2)
 
36
      vsn1 = vsn1*a1
 
37
      go to (40, 50, 40), j
 
38
  40  vdq = v1*v4
 
39
      a = v2/(vdq-v2*v2)
 
40
      q = v3/(v3*v3-vdq)
 
41
      if (q.lt.a) a = q
 
42
      vsn = a*(v4-v1)
 
43
      if (norma.eq.2) go to 200
 
44
      if (vsn.ge.vsn1) go to 200
 
45
  50  vdq = vdq1
 
46
  60  vsn = vsn1
 
47
      a = a1
 
48
      go to 200
 
49
c
 
50
  70  vdq = sqrt(v1*v2*v3*v4)
 
51
      a1 = v3/(v3*v3-vdq)
 
52
      vsn1 = (v4-vdq/v4)*a1
 
53
      a = v2/(vdq-v2*v2)
 
54
      vsn = (vdq/v1-v1)*a
 
55
      if (vsn.ge.vsn1) go to 200
 
56
      go to 60
 
57
c
 
58
c       BUG:       NO PATH TO HERE !!!!!
 
59
cccp      vdq = v2*v3
 
60
cccp      vsn = v4 - vdq/v4
 
61
c                       
 
62
cccp      a = 1.0d+0/(v3-v2)
 
63
cccp      vsn = vsn*a
 
64
c
 
65
 200  vd = sqrt(vdq)
 
66
      a = a*vd
 
67
      if (ityp.le.3) go to 270
 
68
      a = a/vsn
 
69
      go to 270
 
70
c
 
71
 210  j = ityp
 
72
      go to (220, 220, 230, 240, 250, 260), j
 
73
 220  vsn = v2/v1
 
74
      go to (250, 240), j
 
75
 230  vd = v2/vsn
 
76
      go to 270
 
77
 240  vd = v2
 
78
      go to 270
 
79
 250  vd = v1
 
80
      go to 270
 
81
 260  vd = v1*vsn
 
82
c
 
83
 270  return
 
84
      end