← Back to branch summary

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

« back to all changes in this revision

Viewing changes to routines/poly/wmpcle.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/poly/wmpcle.f
 
1
      subroutine wmpcle(pm1r,pm1i,d1,m,n,d2,epsr,epsa)
 
2
c!but
 
3
c     Dans une matrice polynomiale pm1 cette routine met (pour 
 
4
c     chaque polynome) a zero les coefficients de polynomes 
 
5
c     de module inferieur a epsa ou epsr*(norme un du vecteur
 
6
c     des coefficients du polynome)
 
7
c
 
8
c!liste d'appel
 
9
c
 
10
c    subroutine wmpclea(pm1r,pm1i,d1,m,n,d2,epsr,epsa)
 
11
c    double precision pm1r(*),pm1i(*)
 
12
c    integer d1(*),m,n
 
13
c
 
14
c     pm1r : tableau reel contenant les coefficients des polynomes,
 
15
c           parties relles
 
16
c           le coefficient de degre k du polynome pm1(i,j) est range
 
17
c           dans pm1( d1(i + (j-1)*ld1 + k) )
 
18
c           pm1 doit etre de taille au moins d1(ld1*n+1)-d1(1)
 
19
c     pm1i : tableau reel contenant les coefficients des polynomes,
 
20
c           parties imaginaires
 
21
c           le coefficient de degre k du polynome pm1(i,j) est range
 
22
c           dans pm1( d1(i + (j-1)*ld1 + k) )
 
23
c           pm1 doit etre de taille au moins d1(ld1*n+1)-d1(1)
 
24
c     d1 : tableau entier de taille ld1*n+1,  si k=i+(j-1)*ld1 alors
 
25
c          d1(k)) contient  l'adresse dans pm1 du coeff de degre 0
 
26
c          du polynome pm1(i,j). Le degre du polynome pm1(i,j) vaut:
 
27
c          d1(k+1)-d1(k) -1
 
28
c     m : nombre de ligne de la matrice pm1
 
29
c     n : nombre de colonne de matrice pm1
 
30
c     d2 : cf d1
 
31
c!origine
 
32
c    s Steer INRIA
 
33
c!
 
34
c     Copyright INRIA
 
35
      double precision pm1r(*),pm1i(*),norm,normr,normi,epsr,epsa,eps
 
36
      integer d1(*),d2(*),m,n
 
37
c
 
38
c
 
39
c
 
40
      mn=m*n
 
41
      do 1 k=1,mn
 
42
      lmin=d1(k)
 
43
      lmax=d1(k+1)-1
 
44
      normr=0.d0
 
45
      normi=0.d0
 
46
      do 2 l=lmin,lmax
 
47
      normr=normr+abs(pm1r(l))
 
48
      normi=normi+abs(pm1i(l))
 
49
      norm=normr+normi
 
50
 2    continue
 
51
      eps=max(epsa,epsr*norm)
 
52
      do 3 l=lmin,lmax
 
53
      if (abs(pm1r(l)).le.eps) then
 
54
      pm1r(l)=0.0d0
 
55
      endif
 
56
      if (abs(pm1i(l)).le.eps) then
 
57
      pm1i(l)=0.0d0
 
58
      endif
 
59
 3    continue
 
60
 1    continue
 
61
      return
 
62
      end