← Back to branch summary

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

« back to all changes in this revision

Viewing changes to routines/sparse/dspmax.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/sparse/dspmax.f
 
1
      subroutine dspmax(nr,nc,a,nela,inda,b,nelb,indb,c,nelc,indc,ierr)
 
2
c!pupose
 
3
c     computes the sparse matrix formed with maximum elementwise of two 
 
4
c     sparse matrices.
 
5
c!parameters     
 
6
c     a,b,c : arrays. 
 
7
c             Contain non zero elements of first,second and sum matrices.
 
8
c     nr : integer: row dimension of a b c matrices
 
9
c     nc : integer: column dimension of a b c matrices
 
10
c     nela :integer: number of non zero elements of a
 
11
c     nelb :integer: number of non zero elements of b
 
12
c     nelc :integer: 
 
13
c            on entry maximum number  of non zero elements of c
 
14
c            on return number of non zero elements of c
 
15
c     inda : a matrix control data:
 
16
c            inda(i) 1<=i<=nr contains the number of ith row non zero elements
 
17
c            of a
 
18
c            inda(m+i) 1<=i<=nela column index of each non zero element
 
19
c     indb : b matrix control data:
 
20
c            indb(i) 1<=i<=nr contains the number of ith row non zero elements
 
21
c            of b
 
22
c            indb(m+i) 1<=i<=nelb column index of each non zero element
 
23
c
 
24
c     indc : on return contains c matrix control data:
 
25
c            indc(i) 1<=i<=nr contains the number of ith row non zero elements
 
26
c            of c
 
27
c            indc(m+i) 1<=i<=nelb column index of each non zero element
 
28
c     ierr : if non zero initial value of nelc is to small
 
29
c!
 
30
c     Copyright INRIA
 
31
      double precision a(*),b(*),c(*)
 
32
      integer nr,nc,nela,inda(*),nelb,indb(*),nelc,indc(*),ierr
 
33
c
 
34
      integer jc,ka,kb,jb,kf,i,ka1,ja,j1,j2,nold
 
35
c     
 
36
      nelmx=nelc
 
37
      ierr=0
 
38
c     clear indc.
 
39
      do 1 i = 1,nr
 
40
         indc(i) = 0
 
41
 1    continue
 
42
c     jc counts elements of c.
 
43
      jc     = 1
 
44
c     ka,kb are numbers in first i rows of a,b.
 
45
      ka     = 0
 
46
      kb     = 0
 
47
c     kf is number of control data in a,b or c.
 
48
      kf     = nr
 
49
c     jb counts elements of b.
 
50
      jb     = 1
 
51
c     i counts rows of a,b,c.
 
52
      do 15 i=1,nr
 
53
         kb      = kb+indb(i)
 
54
c     nira is number in row i of a.
 
55
         nira    = inda(i)
 
56
         if (nira.eq.0) go to 12
 
57
         ka1     = ka+1
 
58
         ka      = ka+nira
 
59
c     ja counts elements of a.
 
60
         do 11 ja= ka1,ka
 
61
 6          j1     = inda(ja+kf)
 
62
c     at end of b-row transfer rest of a-row.
 
63
            if (jb.gt.kb) then
 
64
               if(a(ja).gt.0.0d0) then
 
65
                  if (jc.gt.nelmx) go to 16
 
66
                  c(jc)  = a(ja)
 
67
                  indc(jc+kf)=j1
 
68
                  jc     = jc+1
 
69
               endif
 
70
               goto 11
 
71
            endif
 
72
            j2     = indb(jb+kf)
 
73
            if(j1.lt.j2) then
 
74
c     if a-index less than b-index transfer a-element to c.
 
75
               if(a(ja).gt.0.0d0) then
 
76
                  if (jc.gt.nelmx) go to 16
 
77
                  c(jc)  = a(ja)
 
78
                  indc(jc+kf)=j1
 
79
                  jc     = jc+1
 
80
               endif
 
81
            elseif(j1.eq.j2) then
 
82
               if (jc.gt.nelmx) go to 16
 
83
               c(jc)  = max(a(ja),b(jb))
 
84
               jb     = jb+1
 
85
               indc(jc+kf)=j1
 
86
               jc     = jc+1
 
87
            else
 
88
c     if a-index greater than b-index transfer b-element to c.
 
89
               if(b(jb).gt.0.0d0) then
 
90
                  if (jc.gt.nelmx) go to 16
 
91
                  c(jc)  = b(jb)
 
92
                  indc(jc+kf)=j2
 
93
                  jc     = jc+1
 
94
               endif
 
95
               jb     = jb+1
 
96
               go to 6
 
97
            endif
 
98
 11      continue
 
99
c     end of row of a.  transfer rest of row of b.
 
100
 12      if (jb.gt.kb) go to 13
 
101
         if(b(jb).gt.0.0d0) then
 
102
            if (jc.gt.nelmx) go to 16
 
103
            c(jc) = b(jb)
 
104
            j2    = indb(jb+kf)
 
105
            indc(jc+kf)=j2
 
106
            jc    = jc+1
 
107
         endif
 
108
         jb      = jb+1
 
109
         go to 12
 
110
 13      if (i.gt.1) go to 14
 
111
         nold  = jc-1
 
112
c     nirc is number in row i of c.
 
113
         nirc  = jc-1
 
114
         go to 15
 
115
 14      nirc   = jc-1-nold
 
116
         nold  = jc-1
 
117
 15      indc(i)=nirc
 
118
         nelc  = jc-1
 
119
         return
 
120
c     error messages.
 
121
 16      ierr=1
 
122
c     no more place for c
 
123
 
 
124
         return 
 
125
         end