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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
SUBROUTINE NVKT03(A,IA,C,IC,G,V,W,IPVT,DNORMA,N,M,MI1,MI,NMD,NDF)
C
C***********************************************************************
C *
C *
C ORIGEN: Eduardo Casas Renteria *
C Cecilia Pola Mendez *
C *
C Departamento de Matematicas,Estadistica y Computacion *
C ----------------------------------------------------- *
C UNIVERSIDAD DE CANTABRIA *
C ------------------------ *
C AGOSTO 1987 *
C *
C***********************************************************************
C
C OBJETIVO:
C Esta es una subrutina auxiliar a OPTR03. Calcula la norma del
C vector de Kuhn-Tucker.
C
C LISTA DE LLAMADA:
C
C A Matriz de dimension (IA,NDF-NMD). (Referencia en OPTR03)
C
C C Matriz de dimension (IC,MI+NMD-N). ( Referencia en
C OPTR03).
C
C G Vector de dimension N que contiene el vector gradiente.
C
C V Vector de dimension M que contiene el vector de los
C multiplicadores de Lagrange.
C
C W Vector de trabajo de dimension N+M.
C
C IPVT Vector de dimension M. (Referencia en OPTR03).
C
C DNORMA Variable de salida que contiene la norma del vector de
C Kuhn-Tucker.
C
C MI1 (Referencia en OPTR03).
C
C MI (Referencia en OPTR03).
C
C NMD N+MD (Referencia en OPTR03).
C
C NDF NMD+MIF+MDF+1 (Referencia en OPTR03).
C
C
C Esta subrutina trabaja en doble precision via una sentencia
C "implicit":
C Implicit double precision (a-h,o-z)
C
C SUBPROGRAMAS AUXILIARES: ddot,dadd,dnrm2
C FUNCIONES FORTRAN INTRINSECAS: abs,mod,sqrt
C
implicit double precision(a-h,o-z)
dimension a(ia,*),c(ic,*),v(*),w(*),ipvt(*),g(*)
m1=m+1
mi2=mi1+1
ni=mi-n
do 30 i=1,n
do 10 j=1,mi1
10 w(j)=c(i,ipvt(j))
do 20 j=mi2,m
ij=ipvt(j)
if(ij.lt.0) then
if(i.eq.-ij) then
w(j)=-1
else
w(j)=0
end if
else if(ij.le.n) then
if(i.eq.ij) then
w(j)=1
else
w(j)=0
end if
else if(ij.le.nmd) then
w(j)=c(i,ij+ni)
else if(ij.lt.ndf) then
w(j)=a(i,ij-nmd)
end if
20 continue
w(m+i)=ddot(m,w,1,v,1)
30 continue
call dadd(n,g,1,w(m1),1)
dnorma=dnrm2(n,w(m1),1)
end
|
