← Back to branch summary

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

« back to all changes in this revision

Viewing changes to routines/sparse/dspos.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/dspos.f
 
1
      subroutine dspos(op,ma,na,a,nela,inda,mb,nb,b,
 
2
c     Copyright INRIA
 
3
     $     nelc,indc,ierr)
 
4
c!purpose
 
5
c     compare the elements of a  sparse matrix A and a full matrix B.
 
6
c!parameters     
 
7
c     a : array. 
 
8
c         Contain non zero elements of the A matrix
 
9
c     ma,na: row and column dimension of the a matrix  
 
10
c     mb,nb: row and column dimension of the b matrix  
 
11
c     nela :integer: number of non zero elements of a
 
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<=ma contains the number of ith row non zero elements
 
17
c            of a
 
18
c            inda(ma+i) 1<=i<=nela column index of each non zero element
 
19
c     indc : on return contains c matrix control data:
 
20
c            indc(i) 1<=i<=mr contains the number of ith row non zero elements
 
21
c            of c
 
22
c            indc(mr+i) 1<=i<=nelb column index of each non zero element
 
23
c     b    :(mb,nb) matrix
 
24
c     ierr : if non zero initial value of nelc is to small
 
25
c     !
 
26
      double precision a(*),b(mb,nb)
 
27
      integer op,nr,nc,nela,inda(*),nelc,indc(*),ierr
 
28
c     
 
29
      integer jc,ka,kb,jb,i,ja,j1
 
30
      double precision t
 
31
      logical dcompa,z
 
32
      external dcompa
 
33
c     
 
34
      nr=max(ma,mb)
 
35
      nc=max(na,nb)
 
36
c     
 
37
      nelmx=nelc
 
38
      ierr=0
 
39
 
 
40
c     jc counts elements of c.
 
41
      jc     = 1
 
42
c     ka,kb are numbers in first i rows of a,b.
 
43
      ka     = 1
 
44
      kb     = 1
 
45
      kc     = 1
 
46
c     jb counts elements of b.
 
47
      jb     = 1
 
48
c     i counts rows of a,b,c.
 
49
      if(ma*na.eq.1.and.mb*nb.gt.1) then
 
50
c     compare all element of b with scalar a
 
51
         t=0.0d0
 
52
         if(inda(1).eq.1) t=a(1)
 
53
         z=dcompa(t,0.0d0,op)   
 
54
         do 10 i=1,nr
 
55
            indc(i)=0
 
56
            jc=kc
 
57
            do 04 j=1,nc
 
58
               if (dcompa(t,b(i,j),op)) then
 
59
                  if(jc+1.gt.nelmx) goto 99
 
60
                  indc(nr+jc)=j
 
61
                  jc=jc+1
 
62
               endif 
 
63
 04         continue
 
64
            indc(i)=jc-kc
 
65
            kc=jc
 
66
 10      continue
 
67
 
 
68
      elseif(ma*na.gt.1.and.mb*nb.eq.1) then
 
69
c     compare all elements of a with scalar b  
 
70
         t=b(1,1)
 
71
         z=dcompa(0.0d0,t,op)
 
72
         do 20 i=1,nr
 
73
            indc(i)=0
 
74
            nira=inda(i)
 
75
            ja=ka       
 
76
            jc=kc
 
77
            if(nira.eq.0) then
 
78
               if(z) then
 
79
                  if(kc+nc.gt.nelmx) goto 99
 
80
                  indc(i)=nc
 
81
                  do 11 j=1,nc
 
82
                     indc(nr+kc-1+j)=j
 
83
 11               continue
 
84
                  jc=kc+nc
 
85
               endif
 
86
            else
 
87
               j1=inda(nr+ja)
 
88
               do 12 j=1,nc
 
89
                  if(j1.eq.j) then
 
90
                     if (dcompa(a(ja),t,op)) then
 
91
                        if(jc+1.gt.nelmx) goto 99
 
92
                        indc(nr+jc)=j
 
93
                        jc=jc+1
 
94
                     endif
 
95
                     if(ja-ka+1.lt.nira) ja=ja+1
 
96
                     j1=inda(nr+ja)
 
97
                  elseif(z) then
 
98
                     if(jc+1.gt.nelmx) goto 99
 
99
                     indc(nr+jc)=j
 
100
                     jc=jc+1
 
101
                  endif
 
102
 12            continue
 
103
            endif
 
104
            indc(i)=jc-kc
 
105
            ka=ka+nira
 
106
            kc=jc
 
107
 20      continue 
 
108
      else
 
109
         z=dcompa(0.0d0,0.0d0,op)   
 
110
         do 30 i=1,nr
 
111
            indc(i)=0
 
112
            nira=inda(i)
 
113
            ja=ka
 
114
            jc=kc
 
115
            if(nira.eq.0) then
 
116
               do 22 j=1,nc
 
117
                  if (dcompa(0.0d0,b(i,j),op)) then
 
118
                     if(jc+1.gt.nelmx) goto 99
 
119
                     indc(nr+jc)=j
 
120
                     jc=jc+1
 
121
                  endif
 
122
 22            continue
 
123
            else
 
124
               j1=inda(nr+ja)
 
125
               do 24 j=1,nc
 
126
                  if(j1.eq.j) then
 
127
                     if (dcompa(a(ja),b(i,j),op)) then
 
128
                        if(jc+1.gt.nelmx) goto 99
 
129
                        indc(nr+jc)=j
 
130
                        jc=jc+1
 
131
                     endif 
 
132
                     if(ja-ka+1.lt.nira) ja=ja+1
 
133
                     j1=inda(nr+ja)
 
134
                  else
 
135
                     if (dcompa(0.0d0,b(i,j),op)) then
 
136
                        if(jc+1.gt.nelmx) goto 99
 
137
                        indc(nr+jc)=j
 
138
                        jc=jc+1
 
139
                     endif
 
140
                  endif
 
141
 24            continue
 
142
            endif
 
143
            ka=ka+inda(i)
 
144
            indc(i)=jc-kc
 
145
            kc=jc
 
146
 30      continue
 
147
      endif
 
148
      nelc  = jc-1
 
149
      return
 
150
c     error messages.
 
151
 99   ierr=1
 
152
c     no more place for c
 
153
 
 
154
      return 
 
155
      end
 
156