File: spcompack.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 (46 lines) | stat: -rw-r--r-- 1,529 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
C**********************************************************************
       SUBROUTINE SPCOMPACK ( NEQNS , NSUPER, NSUB, NNZ, XLINDX, LINDX , 
     &                        XLNZ  ,  ADJNCY)
C***********************************************************************
C
C       -----------
C       PARAMETERS.
C       -----------
C
        INTEGER         NEQNS, NSUPER, NSUB, NZL
c
        INTEGER         XLINDX(nsuper+1), XLNZ(neqns+1)
        INTEGER         LINDX(nsub)     , ADJNCY(nnz)
C***********************************************************************
C   PURPOSE:
C       THIS SUBROUTINE Convert a compact adjacency representation into 
C       a standard adjacency form
C*******************************************************************

       call icopy (nsub,lindx,1,adjncy,1)
       i=1
       do 1140 j=1,neqns
       if (i .eq. nsuper+1) go to 1141
       if ((xlnz(j+1)-xlnz(j) .eq. xlindx(i+1)-xlindx(i)) 
     &    .and. (adjncy(xlnz(j)) .eq. j))          go to 1120
       l=xlindx(nsuper+1)-xlindx(i)+(xlnz(j+1)-xlnz(j))
       call icopy(l,lindx(xlindx(i)-(xlnz(j+1)-xlnz(j))),
     &     1,adjncy(xlnz(j)),1)
       i=i-1
 1120  continue
       i=i+1
 1140  continue
       go to 1135
 1141  k=xlnz(neqns+1)-xlnz(j)
       i=1
         ii=1
 1125  if (i.gt.k) go to 1135 
        do 1130 j=1,ii 
       adjncy(xlnz(neqns+1)-i) = neqns-j+1
 1130  i=i+1
        ii=ii+1
        go to 1125
 1135  continue
       return
       end
C**********************************************************************