File: hilber.f

package info (click to toggle)
scilab 4.0-12
  • links: PTS
  • area: non-free
  • in suites: etch, etch-m68k
  • size: 100,640 kB
  • ctags: 57,333
  • sloc: ansic: 377,889; fortran: 242,862; xml: 179,819; tcl: 42,062; sh: 10,593; ml: 9,441; makefile: 4,377; cpp: 1,354; java: 621; csh: 260; yacc: 247; perl: 130; lex: 126; asm: 72; lisp: 30
file content (31 lines) | stat: -rw-r--r-- 890 bytes parent folder | download | duplicates (4) 
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
 
C/MEMBR ADD NAME=HILBER,SSI=0
c     Copyright INRIA
      subroutine hilber(a,lda,n)
      double precision a(lda,n)
c!but
c     hilber genere l'inverse de la matrice de hilbert
c!liste d'appel
c      subroutine hilber(a,lda,n)
c     double precision a(lda,n)
c
c     a : tableau contenant apres execution l'inverse de la matrice
c         de hilbert de dimension n
c     lda : nombre de ligne de a dans le programme appelant
c     n : dimension de la matrice de hilbert
c!
      double precision p,r
      p = dble(n)
      do 20 i = 1, n
        if (i.ne.1) p = (dble(n-i+1)*p*dble(n+i-1))/dble(i-1)**2
        r = p*p
        a(i,i) = r/dble(2*i-1)
        if (i.eq.n) go to 20
        ip1 = i+1
        do 10 j = ip1, n
          r = -(dble(n-j+1)*r*(n+j-1))/dble(j-1)**2
          a(i,j) = r/dble(i+j-1)
          a(j,i) = a(i,j)
   10   continue
   20 continue
      return
      end