← Back to branch summary

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

« back to all changes in this revision

Viewing changes to routines/optim/anrs01.f

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2002-03-21 16:57:43 UTC
  • Revision ID: james.westby@ubuntu.com-20020321165743-e9mv12c1tb1plztg
Tags: upstream-2.6
Import upstream version 2.6

Show diffs side-by-side

added added

removed removed

Lines of Context:
routines/optim/anrs01.f
 
1
      SUBROUTINE ANRS01(R,IR,M,B,X,IND,IO)
 
2
C
 
3
C***********************************************************************
 
4
C                                                                      *
 
5
C                                                                      *
 
6
C     ORIGEN:           Eduardo Casas Renteria                         *
 
7
C                       Cecilia Pola Mendez                            *
 
8
C                                                                      *
 
9
C       Departamento de Matematicas,Estadistica y Computacion          *
 
10
C       -----------------------------------------------------          *
 
11
C                     UNIVERSIDAD DE CANTABRIA                         *
 
12
C                     ------------------------                         *
 
13
C                          FEBRERO 1987                                *
 
14
C                                                                      *
 
15
C***********************************************************************
 
16
C
 
17
C     OBJETIVO:
 
18
C        Esta subrutina resuelve un sistema de ecuaciones lineales en el
 
19
C        que la matriz de coeficientes es triangular.
 
20
C
 
21
C     LISTA DE LLAMADA:
 
22
C     DE ENTRADA:
 
23
C
 
24
C        R      Matriz de dimension (IR,M),triangular superior.Contiene
 
25
C               en sus M primeras filas a la matriz de coeficientes del
 
26
C               sistema.La parte subdiagonal de R no es utilizada.
 
27
C
 
28
C        IR     Primera dimension de la matriz R. IR >= N.
 
29
C
 
30
C        M      Numero de filas y columnas de la matriz de coeficientes.
 
31
C
 
32
C        B      Vector M-dimensional.Guarda los terminos independientes
 
33
C               del sistema.
 
34
C
 
35
C        IND    Indica el tipo de sistema a resolver,con los valores:
 
36
C                  1  : Se resuelve R'x=b
 
37
C                  2  : Se resuelve Rx=b
 
38
C
 
39
C        IO     Numero de canal de salida de resultados.
 
40
C
 
41
C     DE SALIDA:
 
42
C
 
43
C        X      Vector m-dimensional en el que se recoge  la solucion
 
44
C               del sistema.
 
45
C
 
46
C        Esta subrutina trabaja en doble precision via una sentencia
 
47
C     "implicit":
 
48
C                Implicit double precision (a-h,o-z)
 
49
C
 
50
C     SUBPROGRAMAS AUXILIARES: ddot,dlamch
 
51
C     FUNCIONES FORTRAN INTRINSECAS: abs,mod
 
52
C
 
53
C
 
54
      implicit double precision(a-h,o-z)
 
55
      dimension r(ir,*),b(*),x(*)
 
56
CXC
 
57
CXC     Se comprueba si los valores de las variables son correctos
 
58
CXC
 
59
CX      if(m.lt.1 .or. ir.lt.1 .or. m.gt.ir .or. ind.lt.1 .or. ind.gt.2)
 
60
CX     &   then
 
61
CX         write(io,1000) 'INCORRECT LIST OF CALLING IN ANRS01.'
 
62
CX         stop
 
63
CX      end if
 
64
CXC
 
65
CXC     Se calcula un parametro para detectar la posible singularidad de
 
66
CXC     la matriz de coeficientes
 
67
CXC
 
68
CX      epsmch=dlamch('p')**0.9
 
69
C
 
70
C     Se comienza la resolucion del sistema segun sea el indicador
 
71
C
 
72
      if(ind.eq.1) then
 
73
         j=1
 
74
      else
 
75
         j=m
 
76
      end if
 
77
CX      if(abs(r(j,j)).lt.epsmch) then
 
78
CX         write(io,1000) 'SINGULAR MATRIX IN ANRS01.'
 
79
CX         stop
 
80
CX      end if
 
81
      x(j)=b(j)/r(j,j)
 
82
      if(m.eq.1) return
 
83
      do 10 i=2,m
 
84
         i1=i-1
 
85
         if(ind.eq.1) then
 
86
            j=i
 
87
            j1=1
 
88
            j2=i
 
89
            j3=1
 
90
            k=1
 
91
         else
 
92
            j=m-i1
 
93
            j1=j
 
94
            j2=j+1
 
95
            j3=j2
 
96
            k=ir
 
97
         end if
 
98
CX         if(abs(r(j,j)).lt.epsmch) then
 
99
CX            write(io,1000) 'SINGULAR MATRIX IN ANRS01.'
 
100
CX            stop
 
101
CX         end if
 
102
         x(j)=(b(j)-ddot(i1,r(j1,j2),k,x(j3),1))/r(j,j)
 
103
10    continue
 
104
1000  format(10x,A)
 
105
      end