File: dmpins.f

package info (click to toggle)
scilab 4.0-12
  • links: PTS
  • area: non-free
  • in suites: etch, etch-m68k
  • size: 100,640 kB
  • ctags: 57,333
  • sloc: ansic: 377,889; fortran: 242,862; xml: 179,819; tcl: 42,062; sh: 10,593; ml: 9,441; makefile: 4,377; cpp: 1,354; java: 621; csh: 260; yacc: 247; perl: 130; lex: 126; asm: 72; lisp: 30
file content (69 lines) | stat: -rw-r--r-- 1,772 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
C/MEMBR ADD NAME=DMPINS,SSI=0
c     Copyright INRIA
      subroutine dmpins(mat1,dep1,lig1,col1,mat2,
     & dep2,lig2,col2,matr,depr,ligr,colr)
c!but
c
c     Cette subroutine fait l'insertion (ampliation?) d'une matrice
c     de polynomes mat2 dans une autre mat1 d'apres deux vecteurs.
c     On suppose donnees depr, ligr et colr.
c     Le resultat viendra dans une troisieme matrice.
c
c!parametres d'appel
c
c     call dmpins(mat1,dep1,lig1,col1,mat2,dep2,lig2,
c    1            col2,matr,depr,ligr,colr)
c
c     ou
c
c     mat1: matrice double precision de polynomes
c
c     dep1: matrice entiere qui donne les deplacements relatifs des
c           elements de mat1
c
c     lig1, col1: entiers, dimensions de mat1
c
c     mat2 ,dep2, lig2, col2: analogues aux correspondents 1
c     (correspond a m dans l'example)
c
c     matr, depr, ligr, colr: parametres de sortie, matrice matr et
c     autres valeurs relationnes.
c
c
c     attention!: aucune de matrices mat1, mat2,matr,dep1, dep2 ou depr
c     doit coincider. Cas contraire, les resultats seraient
c     imprevisibles.
c
c!auteur:
c     carlos klimann, inria, 12-XI-85.
c
c
c!
      double precision mat1(*),mat2(*),matr(*)
      integer dep1(*),dep2(*),depr(*)
c
      integer lig1,col1,lig2,col2,ligr,colr
      depr(1)=1
      kr=1
c
      do 20 j=1,colr
      do 20 i=1,ligr
      kr=kr+1
      lr=depr(kr)
      if(lr) 11,12,13
   11 l2=-lr
      l=dep2(l2+1)-dep2(l2)
      call dcopy(l,mat2(dep2(l2)),1,matr(depr(kr-1)),1)
      depr(kr)=depr(kr-1)+l
      goto 20
   12 matr(depr(kr-1))=0.0d+0
      depr(kr)=depr(kr-1)+1
      goto 20
   13 l1=lr
      l=dep1(l1+1)-dep1(l1)
      call dcopy(l,mat1(dep1(l1)),1,matr(depr(kr-1)),1)
      depr(kr)=depr(kr-1)+l
c
   20 continue
      return
       end