← Back to branch summary

~ubuntu-branches/ubuntu/hoary/scilab/hoary

« back to all changes in this revision

Viewing changes to demos/simulation/wheel2/Maple/dlslv.f

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2005-01-09 22:58:21 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20050109225821-473xr8vhgugxxx5j
Tags: 3.0-12
http://bugs.debian.org/255869
changed configure.in to build scilab's own malloc.o, closes: #255869

Show diffs side-by-side

added added

removed removed

Lines of Context:
demos/simulation/wheel2/Maple/dlslv.f
 
1
      subroutine dlslv(a,na,n,b,nb,m,w,rcond,ierr,job)
 
2
c!but
 
3
c      ce sous programme effectue:
 
4
c        la factorisation lu de la matrice a si job=0
 
5
c        la resolution du systeme a*x=b si job=1
 
6
c        la resolution du systeme x*a=b si job=2
 
7
c        l'inversion de a si job=3
 
8
c
 
9
c!liste d'appel
 
10
c           subroutine dlslv(a,na,n,b,nb,m,w,rcond,ierr,job)
 
11
c      a:tableau de taille na*n contenant la matrice a
 
12
c         apres execution a contient la factorisation lu
 
13
c      na:dimensionnement de a dans le programme appelant
 
14
c      n:dimensions de la matrice a
 
15
c      b:tableau de taille nb*m contenant la matrice b et le resultat x
 
16
c      nb:dimensionnement de b dans le programme appelant
 
17
c      m:nombre de colonnes de b si job=1 ;ou nombre de ligne si job=2
 
18
c      w:tableau de travail de taille n+adr(n,1)
 
19
c      rcond:reel contenant le conditionnement inverse de a
 
20
c      ierr:indicateur de deroulement
 
21
c          ierr=0 ok
 
22
c          ierr=1 rcond=0
 
23
c          ierr=-1 rcond negligeable
 
24
c      job:
 
25
c     si a et w n'ont pas ete modifies on peut reentrer dans le
 
26
c     sous programme avec une nouvelle matrice b (job=-1 ou job=-2)
 
27
c
 
28
c!sous programmes appeles
 
29
c     dgeco dgesl dgedi (linpack)
 
30
c     dcopy (blas)
 
31
c     abs (fortran)
 
32
c!Origine S Steer
 
33
c     Copyright INRIA
 
34
c!
 
35
      double precision a(na,n),b(*),w(*),rcond,dt(2)
 
36
      integer sadr
 
37
c
 
38
c     
 
39
c      iadr(l)=l+l-1
 
40
      sadr(l)=(l/2)+1
 
41
c
 
42
      k1=1+sadr(n)
 
43
      ierr=0
 
44
      if(job.lt.0) goto 20
 
45
c factorisation lu
 
46
      call dgeco(a,na,n,w,rcond,w(k1))
 
47
      if(rcond.eq.0.0d+0) goto 70
 
48
      if(rcond+1.0d+0.eq.1.0d+0) ierr=-1
 
49
      if(job.eq.0) return
 
50
      if(job.eq.3) goto 60
 
51
c resolution
 
52
  20  if(abs(job).eq.2) goto 40
 
53
      jb=1
 
54
      do 30 j=1,m
 
55
      call dgesl(a,na,n,w,b(jb),0)
 
56
      jb=jb+nb
 
57
   30 continue
 
58
      return
 
59
   40 do 50 j=1,m
 
60
      call dcopy(n,b(j),nb,w(k1),1)
 
61
      call dgesl(a,na,n,w,w(k1),1)
 
62
      call dcopy(n,w(k1),1,b(j),nb)
 
63
   50 continue
 
64
      return
 
65
   60 call dgedi(a,na,n,w,dt,w(k1),1)
 
66
      return
 
67
   70 ierr=1
 
68
      return
 
69
      end