← Back to branch summary

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

« back to all changes in this revision

Viewing changes to routines/sparse/wspms.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/wspms.f
 
1
      subroutine wspms(nra,nca,ncb,ar,ai,nela,inda,br,bi,mrb,cr,ci,
 
2
c     Copyright INRIA
 
3
     $     mrc,ita,itb)
 
4
c**********************************************************
 
5
c multiply sparse matrix stored in a,inda on right by full
 
6
c   matrix stored in b. put result in c.
 
7
c*** input
 
8
c  nra         actual row dimension of a and c matrix
 
9
c  nca         actual column dimension of a and row dimension of b matrix
 
10
c  ncb         actual column dimension of a and c matrices
 
11
c  ar,ai          a one-dimensional array containing the non-zero elements
 
12
c                 of the first matrix,arranged row-wise, but not
 
13
c                 necessarily in order within rows.
 
14
c  nela        number of non-zero elements in a
 
15
c  inda(i)     1<=i<=nra number of non-zero elements in row i of a.
 
16
c  inda(nra+i) 1<=i<nela column index of i'th non-zero element of a.
 
17
c  br,bi        a two-dimensional array containing all the
 
18
c               elements of the second matrix.
 
19
c  mrb        row-dimension of b in calling routine.
 
20
c  mrc        row-dimension of c in calling routine.
 
21
c  ita        real/complex a matrix type
 
22
c             set ita=0 if a is real
 
23
c  itb        real/complex b matrix type
 
24
c             set itb=0 if b is real
 
25
c*** output
 
26
c  cr,ci        a two-dimensional array containing all the
 
27
c               elements of the product matrix.
 
28
c!
 
29
      double precision ar(nela),ai(nela), br(mrb,ncb),bi(mrb,ncb)
 
30
      double precision cr(mrc,ncb),ci(mrc,ncb)
 
31
      integer inda(*)
 
32
      double precision tr,ti
 
33
c
 
34
c  nrc,ncc are number of rows,columns in c.
 
35
      nrc = nra
 
36
      ncc = ncb
 
37
c clear c to zero.
 
38
   10 do 30 i=1,nrc
 
39
        do 20 j=1,ncc
 
40
          cr(i,j) = 0.0d0
 
41
          ci(i,j) = 0.0d0
 
42
   20   continue
 
43
   30 continue
 
44
c  n2 will be pointer to end of row i of a.
 
45
      n2 = 0
 
46
c  i will be row-index for a.
 
47
      do 60 i=1,nra
 
48
c  pick out number of non-zero elements in row i.
 
49
        nir = inda(i)
 
50
c if no non-zeroes skip processing of row i of a.
 
51
        if (nir.eq.0) go to 60
 
52
c  n1 points to start of row i in a,n2 to end.
 
53
        n1 = n2 + 1
 
54
        n2 = n2 + nir
 
55
c process row i of a, i.e. form all products of non-zero a(i,l) with
 
56
c   b(l,j); put into c(i,j).
 
57
c k points to non-zero elements in row i of a.
 
58
        do 50 k=n1,n2
 
59
          l = inda(nra+k)
 
60
          tr = ar(k)
 
61
          if(ita.eq.0) then
 
62
             ti=0.0d0
 
63
          else
 
64
             ti = ai(k)
 
65
          endif
 
66
          if(itb.eq.0) then
 
67
             do 40 j=1,ncb
 
68
                cr(i,j) = cr(i,j) + tr*br(l,j)
 
69
                ci(i,j) = ci(i,j) + ti*br(l,j)
 
70
 40          continue
 
71
          else
 
72
             do 41 j=1,ncb
 
73
                cr(i,j) = cr(i,j) + tr*br(l,j)-ti*bi(l,j)
 
74
                ci(i,j) = ci(i,j) + tr*bi(l,j)+ti*br(l,j)
 
75
 41          continue
 
76
          endif
 
77
   50   continue
 
78
   60 continue
 
79
      return
 
80
      end