← Back to branch summary

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

« back to all changes in this revision

Viewing changes to routines/poly/dmptld.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/dmptld.f
 
1
C/MEMBR ADD NAME=DMPTLD,SSI=0
 
2
c     Copyright INRIA
 
3
      subroutine dmptld(pm1,d1,ld1,pm2,d2,m,n)
 
4
c!but
 
5
c     cette routine determine la matrice polynomiale :
 
6
c     z**n*pm(1/z)' ou n est le degre maximum des elements de pm
 
7
c     et z la variable formelle. pm a coefficients reels
 
8
c!liste d'appel
 
9
c
 
10
c    subroutine dmptld(pm1,d1,ld1,pm2,d2,m,n)
 
11
c    double precision pm1(*),pm2(*)
 
12
c    integer d1(*),d2(n,m),m,n,iw(n)
 
13
c
 
14
c     pm1 : tableau reel contenant les coefficients des polynomes,
 
15
c           le coefficient de degre k du polynome pm1(i,j) est range
 
16
c           dans pm1( d1(i + (j-1)*ld1 + k) )
 
17
c           pm1 doit etre de taille au moins d1(ld1*n+1)-d1(1)
 
18
c     d1 : tableau entier de taille ld1*n+1,  si k=i+(j-1)*ld1 alors
 
19
c          d1(k)) contient  l'adresse dans pm1 du coeff de degre 0
 
20
c          du polynome pm1(i,j). Le degre du polynome pm1(i,j) vaut:
 
21
c          d1(k+1)-d1(k) -1
 
22
c     ld1 : entier definissant le rangement dans d1
 
23
c
 
24
c     pm2,d2 : definitions similaires a celles de pm1,d1, ld2
 
25
c                 est suppose  egal a n
 
26
c     m : nombre de ligne de la matrice pm1
 
27
c     n : nombre de colonne de matrice pm1
 
28
c!origine
 
29
c    s Steer INRIA
 
30
c!
 
31
      double precision pm1(*),pm2(*),norm,dasum
 
32
      integer d1(*),d2(*),m,n
 
33
c
 
34
c determination du degre maxi
 
35
      d2(1)=1
 
36
      nmax=0
 
37
      i2=1
 
38
      do 12 i=1,m
 
39
      i1=i
 
40
      do 11 j=1,n
 
41
      l1=d1(i1)
 
42
      n1=d1(i1+1)-l1+1
 
43
      norm=dasum(n1-1,pm1(l1),1)
 
44
   10 n1=n1-1
 
45
      if(abs(pm1(l1+n1-1))+norm.le.norm) goto 10
 
46
      i1=i1+ld1
 
47
      i2=i2+1
 
48
      d2(i2)=n1
 
49
      nmax=max(nmax,n1)
 
50
   11 continue
 
51
   12 continue
 
52
c
 
53
c     transcription
 
54
      d2(1)=1
 
55
      i2=1
 
56
      do 32 i=1,m
 
57
      i1=i
 
58
      do 31 j=1,n
 
59
      n1=d2(i2+1)
 
60
      l2=d2(i2)
 
61
      if(n1.lt.nmax) call dset(nmax-n1,0.0d+0,pm2(l2),1)
 
62
      call dcopy(n1,pm1(d1(i1)),1,pm2(l2+nmax-n1),-1)
 
63
      i1=i1+ld1
 
64
      i2=i2+1
 
65
      d2(i2)=l2+nmax
 
66
   31 continue
 
67
   32 continue
 
68
c
 
69
      return
 
70
      end