File: lspe2.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 (56 lines) | stat: -rw-r--r-- 1,317 bytes parent folder | download | duplicates (4) 
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
 
      subroutine lspe2(ma,na,nela,inda,i,ni,j,nj,
c     Copyright INRIA
     $     mr,nr,nelr,indr,ptr,ierr)
c     extract a submatrix from a sparse boolean matrix
c!
      integer inda(*),indr(*),i(*),j(*),ptr(*)
      integer ma,na,ni,nj,mr,nr,nela,nelr,ierr
      logical allrow,allcol
c
      mr=ni
      nr=nj
      allrow=ni.lt.0
      allcol=nj.lt.0
      if(allrow) then 
         mr=ma
         ni=mr
      endif
      if(allcol) then 
         nr=na
         nj=na
      endif
      ptr(1)=1
      do 10 kk=1,ma
         ptr(kk+1)=ptr(kk)+inda(kk)
 10   continue
      jr=1
      do 40 l=1,mr
         indr(l)=0
         if(allrow) then
            ii=l
         else
            ii=i(l)
         endif
         if(inda(ii).eq.0) goto 40
         if(allcol) then
            indr(l)=inda(ii)
            call icopy(inda(ii),inda(ma+ptr(ii)),1,indr(mr+jr),1)
            jr=jr+inda(ii)
         else
            do 30 k=1,nj
               jj=j(k)
               do 20 kk=ptr(ii),ptr(ii+1)-1
                  if(inda(ma+kk).eq.jj) then
                     indr(l)=indr(l)+1
                     indr(mr+jr)=k
                     jr=jr+1
                     goto 30
                  endif
 20            continue
 30         continue
         endif
 40   continue
      nelr=jr-1
      return
      end