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
63
64
65
|
c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
c Copyright (C) ????-2008 - INRIA
c
c This file must be used under the terms of the CeCILL.
c This source file is licensed as described in the file COPYING, which
c you should have received as part of this distribution. The terms
c are also available at
c http://www.cecill.info/licences/Licence_CeCILL_V2.1-en.txt
C/MEMBR ADD NAME=MPTRI,SSI=0
c Copyright INRIA
subroutine mptri(d,m,n,diag,dd,job)
c
integer d(*),m,n,dd(*),diag,job
c
do 10 i=2,m*n+1
10 dd(i)=i-1
c
if(job.eq.0) goto 15
c triangle superieur
if(diag.le.0) goto 11
call iset(m*diag,0,dd(2),1)
ls=m*diag+2
nn=n-diag
ll=m-1
goto 12
11 ls=2-diag
nn=n
ll=m-1+diag
12 do 13 j=1,nn
if(ll.le.0) goto 20
call iset(ll,0,dd(ls+1),1)
ll=ll-1
ls=ls+m+1
13 continue
goto 20
c
c triangle inferieur
15 nn=n
if(diag.lt.0) goto 16
ls=m*(diag+1)+1
nn=n-diag-1
ll=1
goto 17
16 ls=1
ll=-diag
nn=n
17 do 19 j=1,nn
if(ll.gt.m) ll=m
call iset(ll,0,dd(ls+1),1)
ls=ls+m
ll=ll+1
19 continue
c
c calcul du volume
20 l=0
do 21 i=2,m*n+1
if(dd(i).eq.0) then
l=l+1
else
l=l+d(dd(i)+1)-d(dd(i))
endif
21 continue
dd(1)=l
return
end
|
