summaryrefslogtreecommitdiffstats
path: root/scilab/modules/sparse
diff options
context:
space:
mode:
authorYann Collette <yann.collette@scilab.org>2010-02-04 09:27:39 +0100
committerYann Collette <yann.collette@scilab.org>2010-02-04 09:27:39 +0100
commit1d20c9a4389f463119508e71bdd5345929ccf061 (patch)
treeb022a43621b0b4594814d03ea6ad8c6f4638120c /scilab/modules/sparse
parentdabc3ee8f919ffa2518465e1bf29b2b538a111eb (diff)
parent75a9837ab7199e79b5148a39664c41259a3bf34e (diff)
downloadscilab-1d20c9a4389f463119508e71bdd5345929ccf061.zip
scilab-1d20c9a4389f463119508e71bdd5345929ccf061.tar.gz
Merge remote branch 'origin/5.2'
Diffstat (limited to 'scilab/modules/sparse')
-rw-r--r--scilab/modules/sparse/Makefile.am6
-rw-r--r--scilab/modules/sparse/Makefile.in18
-rw-r--r--scilab/modules/sparse/includes/gw_sparse.h1
-rw-r--r--scilab/modules/sparse/macros/sp2adj.sci2
-rw-r--r--scilab/modules/sparse/sci_gateway/c/gw_sparse.c3
-rw-r--r--scilab/modules/sparse/sci_gateway/fortran/sci_ta2lpd.f79
-rw-r--r--scilab/modules/sparse/sci_gateway/sparse_gateway.xml1
-rw-r--r--scilab/modules/sparse/src/fortran/ta2lpd.f54
8 files changed, 155 insertions, 9 deletions
diff --git a/scilab/modules/sparse/Makefile.am b/scilab/modules/sparse/Makefile.am
index 3e2016f..e73d788 100644
--- a/scilab/modules/sparse/Makefile.am
+++ b/scilab/modules/sparse/Makefile.am
@@ -103,7 +103,8 @@ src/fortran/dspmat.f \
103src/fortran/wspmsp.f \ 103src/fortran/wspmsp.f \
104src/fortran/lspis.f \ 104src/fortran/lspis.f \
105src/fortran/dspmin.f \ 105src/fortran/dspmin.f \
106src/fortran/writebuf.f 106src/fortran/writebuf.f \
107src/fortran/ta2lpd.f
107 108
108GATEWAY_C_SOURCES = sci_gateway/c/sci_spcompa.c \ 109GATEWAY_C_SOURCES = sci_gateway/c/sci_spcompa.c \
109sci_gateway/c/sci_full.c \ 110sci_gateway/c/sci_full.c \
@@ -153,7 +154,8 @@ sci_gateway/fortran/sci_spchol.f \
153sci_gateway/fortran/sci_spmax.f \ 154sci_gateway/fortran/sci_spmax.f \
154sci_gateway/fortran/sci_lusolve.f \ 155sci_gateway/fortran/sci_lusolve.f \
155sci_gateway/fortran/sci_fadj2sp.f \ 156sci_gateway/fortran/sci_fadj2sp.f \
156sci_gateway/fortran/sci_sfinit.f 157sci_gateway/fortran/sci_sfinit.f \
158sci_gateway/fortran/sci_ta2lpd.f
157 159
158libscisparse_la_CFLAGS= -I$(srcdir)/includes/ \ 160libscisparse_la_CFLAGS= -I$(srcdir)/includes/ \
159 -I$(top_srcdir)/modules/api_scilab/includes \ 161 -I$(top_srcdir)/modules/api_scilab/includes \
diff --git a/scilab/modules/sparse/Makefile.in b/scilab/modules/sparse/Makefile.in
index d9caed5..1faee56 100644
--- a/scilab/modules/sparse/Makefile.in
+++ b/scilab/modules/sparse/Makefile.in
@@ -1,4 +1,4 @@
1# Makefile.in generated by automake 1.11.1 from Makefile.am. 1# Makefile.in generated by automake 1.11 from Makefile.am.
2# @configure_input@ 2# @configure_input@
3 3
4# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 4# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
@@ -134,7 +134,7 @@ am__objects_2 = spcompack.lo wsposp.lo dspmax.lo findl.lo spcho1.lo \
134 wspasp.lo wij2sp.lo wspcsp.lo lspops.lo spifp.lo isort1.lo \ 134 wspasp.lo wij2sp.lo wspcsp.lo lspops.lo spifp.lo isort1.lo \
135 dspis.lo wspxs.lo lspe2.lo wspisp.lo dsmsp.lo dspms.lo \ 135 dspis.lo wspxs.lo lspe2.lo wspisp.lo dsmsp.lo dspms.lo \
136 spord.lo dsosp.lo dspmat.lo wspmsp.lo lspis.lo dspmin.lo \ 136 spord.lo dsosp.lo dspmat.lo wspmsp.lo lspis.lo dspmin.lo \
137 writebuf.lo 137 writebuf.lo ta2lpd.lo
138am__objects_3 = libscisparse_la-sci_spcompa.lo \ 138am__objects_3 = libscisparse_la-sci_spcompa.lo \
139 libscisparse_la-sci_full.lo libscisparse_la-sci_blkslvi.lo \ 139 libscisparse_la-sci_full.lo libscisparse_la-sci_blkslvi.lo \
140 libscisparse_la-sci_inpnvi.lo libscisparse_la-sci_nnz.lo \ 140 libscisparse_la-sci_inpnvi.lo libscisparse_la-sci_nnz.lo \
@@ -154,7 +154,7 @@ am__objects_4 = sci_spcompa.lo sci_sparse.lo sci_full.lo \
154 sci_bfinit.lo spops.lo sci_spmatrix.lo sci_blkfc1i.lo \ 154 sci_bfinit.lo spops.lo sci_spmatrix.lo sci_blkfc1i.lo \
155 sci_lufact.lo sci_symfcti.lo sci_luget.lo sci_ordmmd.lo \ 155 sci_lufact.lo sci_symfcti.lo sci_luget.lo sci_ordmmd.lo \
156 sci_spget.lo sci_spclean.lo sci_spchol.lo sci_spmax.lo \ 156 sci_spget.lo sci_spclean.lo sci_spchol.lo sci_spmax.lo \
157 sci_lusolve.lo sci_fadj2sp.lo sci_sfinit.lo 157 sci_lusolve.lo sci_fadj2sp.lo sci_sfinit.lo sci_ta2lpd.lo
158am_libscisparse_la_OBJECTS = $(am__objects_1) $(am__objects_2) \ 158am_libscisparse_la_OBJECTS = $(am__objects_1) $(am__objects_2) \
159 $(am__objects_3) $(am__objects_4) 159 $(am__objects_3) $(am__objects_4)
160libscisparse_la_OBJECTS = $(am_libscisparse_la_OBJECTS) 160libscisparse_la_OBJECTS = $(am_libscisparse_la_OBJECTS)
@@ -526,7 +526,8 @@ src/fortran/dspmat.f \
526src/fortran/wspmsp.f \ 526src/fortran/wspmsp.f \
527src/fortran/lspis.f \ 527src/fortran/lspis.f \
528src/fortran/dspmin.f \ 528src/fortran/dspmin.f \
529src/fortran/writebuf.f 529src/fortran/writebuf.f \
530src/fortran/ta2lpd.f
530 531
531GATEWAY_C_SOURCES = sci_gateway/c/sci_spcompa.c \ 532GATEWAY_C_SOURCES = sci_gateway/c/sci_spcompa.c \
532sci_gateway/c/sci_full.c \ 533sci_gateway/c/sci_full.c \
@@ -576,7 +577,8 @@ sci_gateway/fortran/sci_spchol.f \
576sci_gateway/fortran/sci_spmax.f \ 577sci_gateway/fortran/sci_spmax.f \
577sci_gateway/fortran/sci_lusolve.f \ 578sci_gateway/fortran/sci_lusolve.f \
578sci_gateway/fortran/sci_fadj2sp.f \ 579sci_gateway/fortran/sci_fadj2sp.f \
579sci_gateway/fortran/sci_sfinit.f 580sci_gateway/fortran/sci_sfinit.f \
581sci_gateway/fortran/sci_ta2lpd.f
580 582
581libscisparse_la_CFLAGS = -I$(srcdir)/includes/ \ 583libscisparse_la_CFLAGS = -I$(srcdir)/includes/ \
582 -I$(top_srcdir)/modules/api_scilab/includes \ 584 -I$(top_srcdir)/modules/api_scilab/includes \
@@ -1316,6 +1318,9 @@ dspmin.lo: src/fortran/dspmin.f
1316writebuf.lo: src/fortran/writebuf.f 1318writebuf.lo: src/fortran/writebuf.f
1317 $(LIBTOOL) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS) -c -o writebuf.lo `test -f 'src/fortran/writebuf.f' || echo '$(srcdir)/'`src/fortran/writebuf.f 1319 $(LIBTOOL) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS) -c -o writebuf.lo `test -f 'src/fortran/writebuf.f' || echo '$(srcdir)/'`src/fortran/writebuf.f
1318 1320
1321ta2lpd.lo: src/fortran/ta2lpd.f
1322 $(LIBTOOL) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS) -c -o ta2lpd.lo `test -f 'src/fortran/ta2lpd.f' || echo '$(srcdir)/'`src/fortran/ta2lpd.f
1323
1319sci_spcompa.lo: sci_gateway/fortran/sci_spcompa.f 1324sci_spcompa.lo: sci_gateway/fortran/sci_spcompa.f
1320 $(LIBTOOL) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS) -c -o sci_spcompa.lo `test -f 'sci_gateway/fortran/sci_spcompa.f' || echo '$(srcdir)/'`sci_gateway/fortran/sci_spcompa.f 1325 $(LIBTOOL) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS) -c -o sci_spcompa.lo `test -f 'sci_gateway/fortran/sci_spcompa.f' || echo '$(srcdir)/'`sci_gateway/fortran/sci_spcompa.f
1321 1326
@@ -1382,6 +1387,9 @@ sci_fadj2sp.lo: sci_gateway/fortran/sci_fadj2sp.f
1382sci_sfinit.lo: sci_gateway/fortran/sci_sfinit.f 1387sci_sfinit.lo: sci_gateway/fortran/sci_sfinit.f
1383 $(LIBTOOL) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS) -c -o sci_sfinit.lo `test -f 'sci_gateway/fortran/sci_sfinit.f' || echo '$(srcdir)/'`sci_gateway/fortran/sci_sfinit.f 1388 $(LIBTOOL) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS) -c -o sci_sfinit.lo `test -f 'sci_gateway/fortran/sci_sfinit.f' || echo '$(srcdir)/'`sci_gateway/fortran/sci_sfinit.f
1384 1389
1390sci_ta2lpd.lo: sci_gateway/fortran/sci_ta2lpd.f
1391 $(LIBTOOL) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS) -c -o sci_ta2lpd.lo `test -f 'sci_gateway/fortran/sci_ta2lpd.f' || echo '$(srcdir)/'`sci_gateway/fortran/sci_ta2lpd.f
1392
1385mostlyclean-libtool: 1393mostlyclean-libtool:
1386 -rm -f *.lo 1394 -rm -f *.lo
1387 1395
diff --git a/scilab/modules/sparse/includes/gw_sparse.h b/scilab/modules/sparse/includes/gw_sparse.h
index 6364186..61b0f9a 100644
--- a/scilab/modules/sparse/includes/gw_sparse.h
+++ b/scilab/modules/sparse/includes/gw_sparse.h
@@ -43,6 +43,7 @@ int C2F(sci_bfinit) (char *fname,unsigned long fname_len);
43int C2F(sci_msparse) (char *fname,unsigned long fname_len); 43int C2F(sci_msparse) (char *fname,unsigned long fname_len);
44int C2F(sci_mspget) (char *fname,unsigned long fname_len); 44int C2F(sci_mspget) (char *fname,unsigned long fname_len);
45int C2F(sci_mfull) (char *fname,unsigned long fname_len); 45int C2F(sci_mfull) (char *fname,unsigned long fname_len);
46int C2F(sci_ta2lpd) (char *fname,unsigned long fname_len);
46/*--------------------------------------------------------------------------*/ 47/*--------------------------------------------------------------------------*/
47#endif /* __GW_SPARSE__ */ 48#endif /* __GW_SPARSE__ */
48/*--------------------------------------------------------------------------*/ 49/*--------------------------------------------------------------------------*/
diff --git a/scilab/modules/sparse/macros/sp2adj.sci b/scilab/modules/sparse/macros/sp2adj.sci
index 13c5123..a1218d0 100644
--- a/scilab/modules/sparse/macros/sp2adj.sci
+++ b/scilab/modules/sparse/macros/sp2adj.sci
@@ -24,7 +24,7 @@ function [lp,ln,v]=sp2adj(A)
24 if ij == [] then, 24 if ij == [] then,
25 lp=ones(n(2)+1,1);ln=[];v=[]; 25 lp=ones(n(2)+1,1);ln=[];v=[];
26 else, 26 else,
27 [lp,la,ln]=m6ta2lpd(ij(:,1)',ij(:,2)',N+1,N) 27 [lp,la,ln]=ta2lpd(ij(:,1)',ij(:,2)',N+1,N)
28 lp=lp(:);ln=ln(:); 28 lp=lp(:);ln=ln(:);
29 end; 29 end;
30endfunction 30endfunction
diff --git a/scilab/modules/sparse/sci_gateway/c/gw_sparse.c b/scilab/modules/sparse/sci_gateway/c/gw_sparse.c
index 9c4f2d8..6bcc025 100644
--- a/scilab/modules/sparse/sci_gateway/c/gw_sparse.c
+++ b/scilab/modules/sparse/sci_gateway/c/gw_sparse.c
@@ -40,7 +40,8 @@ static gw_generic_table Tab[]=
40 {C2F(sci_bfinit),"bfinit"}, 40 {C2F(sci_bfinit),"bfinit"},
41 {C2F(sci_msparse),"msparse"}, 41 {C2F(sci_msparse),"msparse"},
42 {C2F(sci_mspget),"mspget"}, 42 {C2F(sci_mspget),"mspget"},
43 {C2F(sci_mfull),"mfull"} 43 {C2F(sci_mfull),"mfull"},
44 {C2F(sci_ta2lpd),"ta2lpd"}
44}; 45};
45/*--------------------------------------------------------------------------*/ 46/*--------------------------------------------------------------------------*/
46int gw_sparse(void) 47int gw_sparse(void)
diff --git a/scilab/modules/sparse/sci_gateway/fortran/sci_ta2lpd.f b/scilab/modules/sparse/sci_gateway/fortran/sci_ta2lpd.f
new file mode 100644
index 0000000..e129443
--- /dev/null
+++ b/scilab/modules/sparse/sci_gateway/fortran/sci_ta2lpd.f
@@ -0,0 +1,79 @@
1 subroutine sci_ta2lpd(fname)
2c
3 character*(*) fname
4 include 'stack.h'
5c
6 integer iadr, sadr
7 integer topk,rhsk,topl
8 logical checkrhs,checklhs,getvectrow,getscalar,checkval,cremat
9 iadr(l)=l+l-1
10 sadr(l)=(l/2)+1
11 rhs = max(0,rhs)
12c
13 topk = top
14 rhsk = rhs
15 if(.not.checkrhs(fname,4,4)) return
16 if(.not.checklhs(fname,1,3)) return
17c checking variable tail (number 1)
18c
19 if(.not.getvectrow(fname,top,top-rhs+1,it1,m1,n1,lr1,lc1)) return
20c checking variable head (number 2)
21c
22 if(.not.getvectrow(fname,top,top-rhs+2,it2,m2,n2,lr2,lc2)) return
23c checking variable n1 (number 3)
24c
25 if(.not.getscalar(fname,top,top-rhs+3,lr3)) return
26c checking variable n (number 4)
27c
28 if(.not.getscalar(fname,top,top-rhs+4,lr4)) return
29c
30c cross variable size checking
31c
32 if(.not.checkval(fname,n1,n2)) return
33 call entier(n1,stk(lr1),istk(iadr(lr1)))
34 call entier(n2,stk(lr2),istk(iadr(lr2)))
35 call entier(1,stk(lr4),istk(iadr(lr4)))
36 nn5= int(stk(lr3))
37 if(.not.cremat(fname,top+1,0,nn5,1,lw5,loc5)) return
38 if(.not.cremat(fname,top+2,0,n1,1,lw6,loc6)) return
39 if(.not.cremat(fname,top+3,0,n1,1,lw7,loc7)) return
40 call ta2lpd(istk(iadr(lr1)),istk(iadr(lr2)),n1,istk(iadr(lr4)),st
41 $ k(lw5),stk(lw6),stk(lw7))
42 if(err .gt. 0 .or. err1 .gt. 0) return
43c
44 topk=top-rhs
45 topl=top+3
46c
47 if(lhs .ge. 1) then
48c --------------output variable: lp
49 top=topl+1
50 if(.not.cremat(fname,top,0,1,nn5,lrs,lcs)) return
51 call int2db(1*nn5,istk(iadr(lw5)),-1,stk(lrs),-1)
52 endif
53c
54 if(lhs .ge. 2) then
55c --------------output variable: la
56 top=topl+2
57 if(.not.cremat(fname,top,0,1,n1,lrs,lcs)) return
58 call int2db(1*n1,istk(iadr(lw6)),-1,stk(lrs),-1)
59 endif
60c
61 if(lhs .ge. 3) then
62c --------------output variable: ls
63 top=topl+3
64 if(.not.cremat(fname,top,0,1,n1,lrs,lcs)) return
65 call int2db(1*n1,istk(iadr(lw7)),-1,stk(lrs),-1)
66 endif
67c Putting in order the stack
68 if(lhs .ge. 1) then
69 call copyobj(fname,topl+1,topk+1)
70 endif
71 if(lhs .ge. 2) then
72 call copyobj(fname,topl+2,topk+2)
73 endif
74 if(lhs .ge. 3) then
75 call copyobj(fname,topl+3,topk+3)
76 endif
77 top=topk+lhs
78 return
79 end
diff --git a/scilab/modules/sparse/sci_gateway/sparse_gateway.xml b/scilab/modules/sparse/sci_gateway/sparse_gateway.xml
index fe2b748..fd8850d 100644
--- a/scilab/modules/sparse/sci_gateway/sparse_gateway.xml
+++ b/scilab/modules/sparse/sci_gateway/sparse_gateway.xml
@@ -56,4 +56,5 @@
56<PRIMITIVE gatewayId="27" primitiveId="23" primitiveName="mtlb_sparse" /> 56<PRIMITIVE gatewayId="27" primitiveId="23" primitiveName="mtlb_sparse" />
57<PRIMITIVE gatewayId="27" primitiveId="24" primitiveName="%msp_spget" /> 57<PRIMITIVE gatewayId="27" primitiveId="24" primitiveName="%msp_spget" />
58<PRIMITIVE gatewayId="27" primitiveId="25" primitiveName="%msp_full" /> 58<PRIMITIVE gatewayId="27" primitiveId="25" primitiveName="%msp_full" />
59<PRIMITIVE gatewayId="27" primitiveId="26" primitiveName="ta2lpd" />
59</GATEWAY> 60</GATEWAY>
diff --git a/scilab/modules/sparse/src/fortran/ta2lpd.f b/scilab/modules/sparse/src/fortran/ta2lpd.f
new file mode 100644
index 0000000..24fccf6
--- /dev/null
+++ b/scilab/modules/sparse/src/fortran/ta2lpd.f
@@ -0,0 +1,54 @@
1 subroutine ta2lpd(tail,head,ma,n,lp,la,ls)
2c
3c ta2lpd computes the adjacency vectors lp, la and ls
4c from vectors tail and head for a directed graph
5c NO CHECKING IS MADE on tail, head and n
6c input: tail(ma) = tail nodes
7c head(ma) = head nodes
8c ma = number of edges
9c n = number of nodes
10c output: lp(n+1) = pointer vector
11c la(ma) = vector of arcs
12c ls(ma) = vector of corresponding head nodes
13c
14 integer tail(ma),head(ma),ma,n
15 integer lp(*),la(ma),ls(ma)
16c
17 integer iarc,inode
18c
19c first computation of lp
20c lp(i+1) = number of tail nodes
21c = number of arcs with tail node i+1
22c
23 do 1,inode=1,n+1
24 lp(inode)=0
25 1 continue
26 do 2,iarc=1,ma
27 lp(tail(iarc)+1)=lp(tail(iarc)+1)+1
28 2 continue
29c
30c second computation of lp
31c lp(i) = pointer to the first arc
32c with tail i in sorted tail
33c
34 lp(1)=1
35 do 3,inode=2,n
36 lp(inode)=lp(inode-1)+lp(inode)
37 3 continue
38c
39c computation of la and ls
40c
41 do 4,iarc=1,ma
42 inode=tail(iarc)
43 la(lp(inode))=iarc
44 ls(lp(inode))=head(iarc)
45 lp(inode)=lp(inode)+1
46 4 continue
47c
48c last computation of lp
49c
50 do 5,inode=n,1,-1
51 lp(inode+1)=lp(inode)
52 5 continue
53 lp(1)=1
54 end