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
66
67
68
69
70
71
|
C/MEMBR ADD NAME=FRANCK,SSI=0
c Copyright INRIA
subroutine franck(a,na,n,job)
c!but
c cette subroutine genere la matrice de franck d'ordre n
c definie par : a(i,j)=j si i.le.j , a(j,j-1)=j , a(i,j)=0
c si i.gt.j+1 . ou son inverse
c!liste d'appel
c subroutine franck(a,na,n,job)
c
c double precision a(na,n)
c integer na,n,job
c
c a :tableau contenant apres execution la matrice
c na:nombre de ligne du tableau a
c n : dimension de la matrice
c job : entier caracterisant le resultat demande
c job = 0 : matrice de franck
c job = 1 : son inverse
c!sous programme appeles
c dble real (fortran)
c!
double precision a(na,n)
c variables internes
integer n1,k,l,ls
double precision x,dble
c
if(job.eq.1) goto 50
c
a(1,1)=dble(real(n))
if(n.eq.1) return
do 20 k=2,n
x=dble(real(n+1-k))
a(k,k-1)=x
do 10 l=1,k
a(l,k)=x
10 continue
20 continue
if(n.eq.2) return
do 40 l=3,n
n1=l-2
do 40 k=1,n1
a(l,k)=0.0d+0
40 continue
return
c
50 continue
if(n.eq.1) return
n1=n-1
do 60 k=1,n1
a(k,k+1)=-1.0d+0
a(k+1,k+1)=dble(real(n+1-k))
60 continue
a(1,1)=1.0d+0
do 66 ksd=1,n1
ls=n-ksd
do 65 l=1,ls
klig=n+1-l
kcol=klig-ksd
a(klig,kcol)=-a(klig-1,kcol)*l
65 continue
66 continue
c
if(n.lt.3) return
do 70 kcol=3,n
n1=kcol-2
do 70 klig=1,n1
a(klig,kcol)=0.0d+0
70 continue
return
end
|
