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
|
C********************************************************************
SUBROUTINE SPCHO2 ( NEQNS , NSUPER, XSUPER, SNODE , SPLIT ,
& XLINDX, LINDX , XLNZ , LNZ ,
& IWORK , TMPSIZ, TMPVEC,indlnz,nnzl,nsub)
C***********************************************************************
C
C -----------
C PARAMETERS.
C -----------
C
INTEGER level
c
INTEGER XLINDX(nsuper+1) , XLNZ(neqns+1)
INTEGER IWORK(2*neqns+2*nsuper), LINDX(nsub),
& SNODE(neqns) , SPLIT(neqns) ,
& XSUPER(nsuper+1),indlnz(neqns+nnzl)
INTEGER IFLAG , IWSIZ , NEQNS , NSUPER, TMPSIZ
DOUBLE PRECISION LNZ(nnzl) , TMPVEC(tmpsiz)
C***********************************************************************
C PURPOSE:
C THIS SUBROUTINE CALLS THE BLOCK GENERAL SPARSE CHOLESKY ROUTINE,
C BLKFC2.
C
iwsiz=2*neqns+2*nsuper
level = 8
CALL BLKFC1 ( NEQNS , NSUPER, XSUPER, SNODE , SPLIT ,
& XLINDX, LINDX , XLNZ , LNZ , IWSIZ ,
& IWORK , TMPSIZ, TMPVEC, IFLAG ,level)
c********************************************************************
do 1110 i=2,neqns+1
1110 indlnz(i-1)=xlnz(i)-xlnz(i-1)
call icopy (xlindx(nsuper+1)-1,lindx,1,indlnz(neqns+1),1)
i=1
do 1140 j=1,neqns
if (i .eq. nsuper+1) go to 1141
if ((xlnz(j+1)-xlnz(j) .eq. xlindx(i+1)-xlindx(i))
& .and. (indlnz(neqns+xlnz(j)) .eq. j)) go to 1120
l=xlindx(nsuper+1)-xlindx(i)+(xlnz(j+1)-xlnz(j))
call icopy(l,lindx(xlindx(i)-(xlnz(j+1)-xlnz(j))),
& 1,indlnz(neqns+xlnz(j)),1)
i=i-1
1120 continue
i=i+1
1140 continue
go to 1135
1141 k=xlnz(neqns+1)-xlnz(j)
i=1
ii=1
1125 if (i.gt.k) go to 1135
do 1130 j=1,ii
indlnz(neqns+xlnz(neqns+1)-i)=neqns-j+1
1130 i=i+1
ii=ii+1
go to 1125
1135 continue
return
end
C**********************************************************************
|
