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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
subroutine wspe2(ma,na,ar,ai,nela,inda,i,ni,j,nj,
$ mr,nr,rr,ri,nelr,indr,ptr,ierr)
c extract a submatrix from a sparse matrix
c!
integer inda(*),indr(*),i(*),j(*),ptr(*)
integer ma,na,ni,nj,mr,nr,nela,nelr,ierr
double precision ar(nela),ai(nela),rr(*),ri(*)
logical allrow,allcol
c
mr=ni
nr=nj
allrow=ni.lt.0
allcol=nj.lt.0
if(allrow) then
mr=ma
ni=mr
endif
if(allcol) then
nr=na
nj=na
endif
ptr(1)=1
do 10 kk=1,ma
ptr(kk+1)=ptr(kk)+inda(kk)
10 continue
jr=1
do 40 l=1,mr
indr(l)=0
if(allrow) then
ii=l
else
ii=i(l)
endif
if(inda(ii).eq.0) goto 40
if(allcol) then
indr(l)=inda(ii)
call icopy(inda(ii),inda(ma+ptr(ii)),1,indr(mr+jr),1)
call dcopy(inda(ii),ar(ptr(ii)),1,rr(jr),1)
call dcopy(inda(ii),ai(ptr(ii)),1,ri(jr),1)
jr=jr+inda(ii)
else
do 30 k=1,nj
jj=j(k)
do 20 kk=ptr(ii),ptr(ii+1)-1
if(inda(ma+kk).eq.jj) then
indr(l)=indr(l)+1
indr(mr+jr)=k
rr(jr)=ar(kk)
ri(jr)=ai(kk)
jr=jr+1
goto 30
endif
20 continue
30 continue
endif
40 continue
nelr=jr-1
return
end
|
