← Back to branch summary

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

« back to all changes in this revision

Viewing changes to routines/scicos/sctree.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/scicos/sctree.f
 
1
      subroutine sctree(nb,vec,in,depu,outptr,cmat,ord,nord,ok,kk)
 
2
c     inputs:
 
3
c     nb: number of regular blocks
 
4
c     vec: integer vector of size nb
 
5
c     in: integer vector
 
6
c     depu: logical vector, first column of dep_ut
 
7
c     outptr: integer vector
 
8
c     cmat: integer vector
 
9
c     kk: integer work area of size nb
 
10
c
 
11
c     outputs:
 
12
c     ok: integer
 
13
c     ord: integer vector of size nord (=<nb)
 
14
c     nord
 
15
c     Copyright INRIA
 
16
      integer vec(nb),in(*),outptr(*),cmat(*),ord(*)
 
17
      integer nb,i,j,lkk
 
18
      integer depu(*),ok
 
19
      logical fini
 
20
      integer kk(nb)
 
21
c
 
22
c
 
23
      ok=1
 
24
      do 60 j=1,nb+2
 
25
      fini=.true.
 
26
         do 50 i=1,nb
 
27
            if(vec(i).eq.j-1) then 
 
28
               if(j.eq.nb+2) then 
 
29
                  ok=0
 
30
                  return
 
31
               endif
 
32
               lkk=0
 
33
               do 40 l=outptr(i),outptr(i+1)-1
 
34
                  ii=in(cmat(l))
 
35
                  if (depu(ii).eq.1) then
 
36
                     lkk=lkk+1
 
37
                     kk(lkk)=ii
 
38
                  endif
 
39
 40            continue
 
40
               if (lkk.gt.0) then
 
41
                  fini=.false.
 
42
                  do 45 l=1,lkk
 
43
                     vec(kk(l))=j
 
44
 45               continue
 
45
               endif
 
46
            endif
 
47
 50      continue
 
48
         if (fini) goto 65
 
49
 60   continue
 
50
 65   continue
 
51
      do 70 l=1,nb
 
52
         kk(l)=-vec(l)
 
53
 70   continue
 
54
      call isort(kk,nb,ord)
 
55
      nord=0
 
56
      do 80 l=1,nb
 
57
         if(kk(l).ne.1.and.outptr(ord(l)+1)-outptr(ord(l)).ne.0) then
 
58
            nord=nord+1
 
59
            ord(nord)=ord(l)
 
60
         endif
 
61
 80   continue
 
62
      end
 
63