Context Navigation

source: branches/dev/Apps/CUTErInterface/CUTErInterface.f @ 529

Last change on this file since 529 was 529, checked in by andreasw, 15 years ago
in Vector class, copy cached values in Copy and update them in Scal perform iterative refinement only once for adaptive strategy fix bugs in PDPerturbationHandler avoid some overhead in CalculateQualityFunction? minor changes in timing
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 26.4 KB

Line
1	C Copyright (C) 2002, 2004, 2005 Carnegie Mellon University,
2	C Dominique Orban and others.
3	C All Rights Reserved.
4	C This code is published under the Common Public License.
5	C*******************************************************************************
6	PROGRAM IPOPTMA
7	C
8	C IPOPT CUTEr driver.
9	C D. Orban, adapted from Andreas Waechter's CUTE driver.
10	C Adapted for C++ version by Andreas Waechter, Oct 2004
11	C
12	IMPLICIT NONE
13	INTEGER IOUT
14	PARAMETER( IOUT = 6 )
15
16	C
17	C Maximal sizes for CUTEr
18	C
19	CB CUTE_NMAX maximal number of variables
20	CB CUTE_MMAX maximal number of constraints
21	CB CUTE_NZMAX maximal number of nonzero elements
22	INTEGER CUTE_NMAX, CUTE_MMAX, CUTE_NZMAX
23	CTOY PARAMETER( CUTE_NMAX = 1000, CUTE_MMAX = 1000 )
24	CMED PARAMETER( CUTE_NMAX = 10000, CUTE_MMAX = 10000 )
25	CBIG PARAMETER( CUTE_NMAX = 50000, CUTE_MMAX = 50000 )
26	CCUS PARAMETER( CUTE_NMAX = 200000, CUTE_MMAX = 200000 )
27	CTOY PARAMETER( CUTE_NZMAX = 100000 )
28	CMED PARAMETER( CUTE_NZMAX = 200000 )
29	CBIG PARAMETER( CUTE_NZMAX = 1000000 )
30	CCUS PARAMETER( CUTE_NZMAX = 10000000 )
31
32	C
33	C
34	C
35	INTEGER N, M
36	DOUBLE PRECISION X( CUTE_NMAX )
37	DOUBLE PRECISION X_L( CUTE_NMAX )
38	DOUBLE PRECISION X_U( CUTE_NMAX )
39	DOUBLE PRECISION Z_L( CUTE_NMAX )
40	DOUBLE PRECISION Z_U( CUTE_NMAX )
41	DOUBLE PRECISION G( CUTE_MMAX )
42	DOUBLE PRECISION G_L( CUTE_MMAX )
43	DOUBLE PRECISION G_U( CUTE_MMAX )
44	DOUBLE PRECISION LAM( CUTE_MMAX )
45
46	INTEGER IERR, IPSOLVE
47
48	INTEGER IPROBLEM, IPCREATE
49	C64BIT INTEGER*8 IPROBLEM, IPCREATE
50	C
51	integer IDX_STYLE, NELE_JAC, NELE_HESS
52
53	external EV_F, EV_G, EV_GRAD_F, EV_JAC_G, EV_HESS
54	C
55	C The following arrays are work space for the evaluation subroutines
56	C
57	DOUBLE PRECISION DAT(CUTE_NMAX+CUTE_NZMAX)
58	INTEGER IDAT(2*CUTE_NZMAX)
59
60	REAL CALLS( 7 ), CPU( 2 )
61	CHARACTER*10 PNAME
62	CHARACTER*10 VNAMES( CUTE_NMAX ), GNAMES( CUTE_MMAX )
63	DOUBLE PRECISION F
64	C
65	logical equatn(CUTE_MMAX), linear(CUTE_MMAX)
66	integer i, cnr_input
67	logical efirst, lfirst, nvfrst, ex
68	double precision init_val
69	C
70	C Initialize the CUTEr interface and get the initial point
71	C
72	cnr_input = 60
73	efirst = .false.
74	lfirst = .false.
75	nvfrst = .false.
76
77	open(cnr_input,file='OUTSDIF.d',status='old')
78
79	call CSETUP(cnr_input, IOUT, N, M, X, X_L, X_U, CUTE_NMAX,
80	1 equatn, linear, LAM, G_L, G_U, CUTE_MMAX,
81	2 efirst, lfirst, nvfrst)
82	close(cnr_input)
83	C
84	C See if we want to set a different initial point
85	C
86	inquire(file='INITPOINT.VAL', exist=ex)
87	if (ex) then
88	open(70, file='INITPOINT.VAL', status='old')
89	read(70,'(d25.16)') init_val
90	do i = 1, N
91	X(i) = init_val
92	enddo
93	close(70)
94	endif
95	C
96	C Obtain the number of nonzeros in Jacobian and Hessian
97	C
98	CALL CDIMSJ(NELE_JAC)
99	NELE_JAC = NELE_JAC - N
100	if (NELE_JAC.gt.CUTE_NZMAX) then
101	write(,) 'NELE_JAC = ',NELE_JAC,' larger than CUTE_NZMAX = ',
102	1 CUTE_NZMAX
103	write(,) 'Increase CUTE_NZMAX'
104	stop
105	endif
106	CALL CDIMSH(NELE_HESS)
107	if (NELE_HESS.gt.CUTE_NZMAX) then
108	write(,) 'NELE_HESS = ',NELE_HESS,
109	1 ' larger than CUTE_NZMAX = ', CUTE_NZMAX
110	write(,) 'Increase CUTE_NZMAX'
111	stop
112	endif
113	C
114	C Get problem name.
115	C
116	CALL CNAMES(N, M, PNAME, VNAMES, GNAMES)
117	C
118	C Call IPOPT
119	C
120	IDX_STYLE = 1
121	IPROBLEM = IPCREATE(N, X_L, X_U, M, G_L, G_U, NELE_JAC, NELE_HESS,
122	1 IDX_STYLE, EV_F, EV_G, EV_GRAD_F, EV_JAC_G, EV_HESS)
123	if (IPROBLEM.eq.0) then
124	write(,) 'Error creating Ipopt Problem.'
125	stop
126	endif
127	C
128	IERR = IPSOLVE(IPROBLEM, X, G, F, LAM, Z_L, Z_U, IDAT, DAT)
129	C
130	call IPFREE(IPROBLEM)
131	C
132	C Display CUTEr statistics
133	C
134	CALL CREPRT( CALLS, CPU )
135	WRITE ( IOUT, 2000 ) PNAME, N, M, CALLS(1), CALLS(2),
136	. CALLS(3), CALLS(4), CALLS(5), CALLS(6), CALLS(7),
137	. IERR, F, CPU(1), CPU(2)
138	c
139	2000 FORMAT( /, 24(''), ' CUTEr statistics ', 24('') //
140	* ,/,' Code used : IPOPT', /
141	* ,' Problem : ', A10, /
142	* ,' # variables = ', I10 /
143	* ,' # constraints = ', I10 /
144	* ,' # objective functions = ', E15.7 /
145	* ,' # objective gradients = ', E15.7 /
146	* ,' # objective Hessians = ', E15.7 /
147	* ,' # Hessian-vector prdct = ', E15.7 /
148	* ,' # constraints functions = ', E15.7 /
149	* ,' # constraints gradients = ', E15.7 /
150	* ,' # constraints Hessians = ', E15.7 /
151	* ,' Exit code = ', I10 /
152	* ,' Final f = ', E15.7 /
153	* ,' Set up time = ', 0P, F10.2, ' seconds' /
154	* ,' Solve time = ', 0P, F10.2, ' seconds' //
155	* ,/,66('*') / )
156
157	9999 CONTINUE
158	END
159
160
161
162	C Copyright (C) 2002, Carnegie Mellon University and others.
163	C All Rights Reserved.
164	C This code is published under the Common Public License.
165	C*******************************************************************************
166	C
167	subroutine EV_F(N, X, NEW_X, F, IDAT, DAT, IERR)
168	C
169	C*******************************************************************************
170	C
171	C $Id: CUTErInterface.f 529 2005-09-29 21:12:38Z andreasw $
172	C
173	C-------------------------------------------------------------------------------
174	C Title
175	C-------------------------------------------------------------------------------
176	C
177	CT Compute objective function value to CUTEr problem
178	C
179	C-------------------------------------------------------------------------------
180	C Programm description
181	C-------------------------------------------------------------------------------
182	C
183	CB
184	C
185	C-------------------------------------------------------------------------------
186	C Author, date
187	C-------------------------------------------------------------------------------
188	C
189	CA Andreas Waechter 02/25/99
190	CA Andreas Waechter 10/29/04 adapted for C++ version
191	C
192	C-------------------------------------------------------------------------------
193	C Documentation
194	C-------------------------------------------------------------------------------
195	C
196	CD
197	C
198	C-------------------------------------------------------------------------------
199	C Parameter list
200	C-------------------------------------------------------------------------------
201	C
202	C Name I/O Type Meaning
203	C
204	CP N I INT number of variables in problem statement
205	CP X I DP point where F is to be evaluated
206	CP NEW_X I INT if 1, X has not been changed since last call
207	CP F O DP objective function value
208	CP IDAT P INT privat INT data for evaluation routines
209	CP DAT P DP privat DP data for evaluation routines
210	CP IERR O INT set to nonzero value if error occurred
211	C
212	C-------------------------------------------------------------------------------
213	C local variables
214	C-------------------------------------------------------------------------------
215	C
216	CL
217	C
218	C-------------------------------------------------------------------------------
219	C used subroutines
220	C-------------------------------------------------------------------------------
221	C
222	CS COFG
223	C
224	C*******************************************************************************
225	C
226	C Declarations
227	C
228	C*******************************************************************************
229	C
230	IMPLICIT NONE
231	C
232	C-------------------------------------------------------------------------------
233	C Parameter list
234	C-------------------------------------------------------------------------------
235	C
236	integer N
237	double precision X(N)
238	integer NEW_X
239	double precision F
240	double precision DAT(*)
241	integer IDAT(*)
242	integer IERR
243	C
244	C-------------------------------------------------------------------------------
245	C Local varibales
246	C-------------------------------------------------------------------------------
247	C
248	double precision dummy
249	C
250	C*******************************************************************************
251	C
252	C Executable Statements
253	C
254	C*******************************************************************************
255	C
256	IERR = 0
257	C
258	C Call COFG to obtain value of objective function
259	C
260	call COFG( N, X, F, dummy, .false.)
261
262	9999 continue
263	return
264	end
265	C Copyright (C) 2002, Carnegie Mellon University and others.
266	C All Rights Reserved.
267	C This code is published under the Common Public License.
268	C*******************************************************************************
269	C
270	subroutine EV_GRAD_F(N, X, NEW_X, GRAD, IDAT, DAT, IERR)
271	C
272	C*******************************************************************************
273	C
274	C $Id: CUTErInterface.f 529 2005-09-29 21:12:38Z andreasw $
275	C
276	C-------------------------------------------------------------------------------
277	C Title
278	C-------------------------------------------------------------------------------
279	C
280	CT Compute gradient of objective function to CUTEr problem
281	C
282	C-------------------------------------------------------------------------------
283	C Programm description
284	C-------------------------------------------------------------------------------
285	C
286	CB
287	C
288	C-------------------------------------------------------------------------------
289	C Author, date
290	C-------------------------------------------------------------------------------
291	C
292	CA Andreas Waechter 02/25/99
293	CA Andreas Waechter 10/29/04 adapted for C++ version
294	C
295	C-------------------------------------------------------------------------------
296	C Documentation
297	C-------------------------------------------------------------------------------
298	C
299	CD
300	C
301	C-------------------------------------------------------------------------------
302	C Parameter list
303	C-------------------------------------------------------------------------------
304	C
305	C Name I/O Type Meaning
306	C
307	CP N I INT number of variables in problem statement
308	CP (including slacks for inequality constraints)
309	CP X I DP point where G is to be evaluated
310	CP NEW_X I INT if 1, X has not been changed since last call
311	CP GRAD O DP gradient of objective function
312	CP IDAT P INT privat INT data for evaluation routines
313	CP DAT P DP privat DP data for evaluation routines
314	CP IERR O INT set to nonzero value if error occurred
315	C
316	C-------------------------------------------------------------------------------
317	C local variables
318	C-------------------------------------------------------------------------------
319	C
320	CL
321	C
322	C-------------------------------------------------------------------------------
323	C used subroutines
324	C-------------------------------------------------------------------------------
325	C
326	CS COFG
327	C
328	C*******************************************************************************
329	C
330	C Declarations
331	C
332	C*******************************************************************************
333	C
334	IMPLICIT NONE
335	C
336	C-------------------------------------------------------------------------------
337	C Parameter list
338	C-------------------------------------------------------------------------------
339	C
340	integer N
341	double precision X(N)
342	integer NEW_X
343	double precision GRAD(N)
344	double precision DAT(*)
345	integer IDAT(*)
346	integer IERR
347	C
348	C-------------------------------------------------------------------------------
349	C Local varibales
350	C-------------------------------------------------------------------------------
351	C
352	double precision f
353	C
354	C*******************************************************************************
355	C
356	C Executable Statements
357	C
358	C*******************************************************************************
359	C
360	IERR = 0
361	C
362	C Call COFG to obtain gradient of objective function
363	C
364	call COFG( N, X, f, GRAD, .true.)
365
366	9999 continue
367	return
368	end
369	C Copyright (C) 2002, Carnegie Mellon University and others.
370	C All Rights Reserved.
371	C This code is published under the Common Public License.
372	C*******************************************************************************
373	C
374	subroutine EV_G(N, X, NEW_X, M, G, IDAT, DAT, IERR)
375	C
376	C*******************************************************************************
377	C
378	C $Id: CUTErInterface.f 529 2005-09-29 21:12:38Z andreasw $
379	C
380	C-------------------------------------------------------------------------------
381	C Title
382	C-------------------------------------------------------------------------------
383	C
384	CT Compute values of constraints to CUTEr problem
385	C
386	C-------------------------------------------------------------------------------
387	C Programm description
388	C-------------------------------------------------------------------------------
389	C
390	CB
391	C
392	C-------------------------------------------------------------------------------
393	C Author, date
394	C-------------------------------------------------------------------------------
395	C
396	CA Andreas Waechter 02/25/99
397	CA Andreas Waechter 07/01/99 BUG: problems if ineq not first
398	CA Andreas Waechter 10/29/04 adapted for C++ version
399	C
400	C-------------------------------------------------------------------------------
401	C Documentation
402	C-------------------------------------------------------------------------------
403	C
404	CD
405	C
406	C-------------------------------------------------------------------------------
407	C Parameter list
408	C-------------------------------------------------------------------------------
409	C
410	C Name I/O Type Meaning
411	C
412	CP N I INT number of variables in problem statement
413	CP (including slacks for inequality constraints)
414	CP X I DP point where G is to be evaluated
415	CP NEW_X I INT if 1, X has not been changed since last call
416	CP M I INT number of constraints
417	CP G O DP values of constraints
418	CP IDAT P INT privat INT data for evaluation routines
419	CP DAT P DP privat DP data for evaluation routines
420	CP IERR O INT set to nonzero value if error occurred
421	C
422	C-------------------------------------------------------------------------------
423	C local variables
424	C-------------------------------------------------------------------------------
425	C
426	CL
427	C
428	C-------------------------------------------------------------------------------
429	C used subroutines
430	C-------------------------------------------------------------------------------
431	C
432	CS CCFG
433	C
434	C*******************************************************************************
435	C
436	C Declarations
437	C
438	C*******************************************************************************
439	C
440	IMPLICIT NONE
441	C
442	C-------------------------------------------------------------------------------
443	C Parameter list
444	C-------------------------------------------------------------------------------
445	C
446	integer N
447	double precision X(N)
448	integer NEW_X
449	integer M
450	double precision G(M)
451	double precision DAT(*)
452	integer IDAT(*)
453	integer IERR
454	C
455	C-------------------------------------------------------------------------------
456	C Local varibales
457	C-------------------------------------------------------------------------------
458	C
459	double precision dummy
460	C
461	C*******************************************************************************
462	C
463	C Executable Statements
464	C
465	C*******************************************************************************
466	C
467	IERR = 0
468	C
469	C Call CCFG to obtain constraint values, but without slacks
470	C
471	call CCFG(N, M, X, M, G, .FALSE., 1, 1, dummy, .FALSE.)
472
473	9999 continue
474	return
475	end
476	C Copyright (C) 2002, Carnegie Mellon University and others.
477	C All Rights Reserved.
478	C This code is published under the Common Public License.
479	C*******************************************************************************
480	C
481	subroutine EV_JAC_G(TASK, N, X, NEW_X, M, NZ, ACON, AVAR, A,
482	1 IDAT, DAT, IERR)
483	C
484	C*******************************************************************************
485	C
486	C $Id: CUTErInterface.f 529 2005-09-29 21:12:38Z andreasw $
487	C
488	C-------------------------------------------------------------------------------
489	C Title
490	C-------------------------------------------------------------------------------
491	C
492	CT Compute Jacobian of constraints to CUTEr problem
493	C
494	C-------------------------------------------------------------------------------
495	C Programm description
496	C-------------------------------------------------------------------------------
497	C
498	CB
499	C
500	C-------------------------------------------------------------------------------
501	C Author, date
502	C-------------------------------------------------------------------------------
503	C
504	CA Andreas Waechter 02/25/99
505	CA Andreas Waechter 10/29/04 adapted for C++ version
506	C
507	C-------------------------------------------------------------------------------
508	C Documentation
509	C-------------------------------------------------------------------------------
510	C
511	CD
512	C
513	C-------------------------------------------------------------------------------
514	C Parameter list
515	C-------------------------------------------------------------------------------
516	C
517	C Name I/O Type Meaning
518	C
519	CP TASK I INT =0: Fill ACON and AVAR, don't use A
520	CP <>0: Fill A, don't use ACON, AVAR
521	CP N I INT number of variables in problem statement
522	CP X I DP point where A is to be evaluated
523	CP NEW_X I INT if 1, X has not been changed since last call
524	CP M I INT number of constraints
525	CP NZ I INT number of nonzero elements
526	CP (size of A, AVAR, ACON)
527	CP ACON O INT (only TASK=0) row indices
528	CP AVAR O INT (only TASK=0) column indices
529	CP A O DP (only TASK<>0) values in Jacobian
530	CP IDAT P INT privat INT data for evaluation routines
531	CP DAT P DP privat DP data for evaluation routines
532	CP IERR O INT set to nonzero value if error occurred
533	C
534	C-------------------------------------------------------------------------------
535	C local variables
536	C-------------------------------------------------------------------------------
537	C
538	CL
539	C
540	C-------------------------------------------------------------------------------
541	C used subroutines
542	C-------------------------------------------------------------------------------
543	C
544	CS CDIMSJ
545	CS CCFSG
546	C
547	C*******************************************************************************
548	C
549	C Declarations
550	C
551	C*******************************************************************************
552	C
553	IMPLICIT NONE
554	C
555	C-------------------------------------------------------------------------------
556	C Parameter list
557	C-------------------------------------------------------------------------------
558	C
559	integer TASK
560	integer N
561	double precision X(N)
562	integer NEW_X
563	integer M
564	integer NZ
565	double precision A(NZ)
566	integer ACON(NZ)
567	integer AVAR(NZ)
568	double precision DAT(*)
569	integer IDAT(*)
570	integer IERR
571	C
572	C-------------------------------------------------------------------------------
573	C Local varibales
574	C-------------------------------------------------------------------------------
575	C
576	integer i, nele_jac
577	C
578	C*******************************************************************************
579	C
580	C Executable Statements
581	C
582	C*******************************************************************************
583	C
584	IERR = 0
585	if( TASK.eq.0 ) then
586	C
587	C Get the nonzero structure
588	C
589	do i = 1, N
590	DAT(i) = 0.d0
591	enddo
592	call CCFSG(N, M, DAT(1), M, DAT(1), nele_jac,
593	1 NZ, DAT(N+1), AVAR, ACON, .TRUE.)
594	else
595	C
596	C Get the values of nonzeros
597	C
598	call CCFSG(N, M, X, M, DAT(1), nele_jac,
599	1 NZ, A, IDAT(1), IDAT(1+NZ), .TRUE.)
600	endif
601
602	9999 continue
603	return
604	end
605	C Copyright (C) 2002, Carnegie Mellon University and others.
606	C All Rights Reserved.
607	C This code is published under the Common Public License.
608	C*******************************************************************************
609	C
610
611	subroutine EV_HESS(TASK, N, X, NEW_X, OBJFACT, M, LAM, NEW_LAM,
612	1 NNZH, IRNH, ICNH, HESS, IDAT, DAT, IERR)
613	C
614	C*******************************************************************************
615	C
616	C $Id: CUTErInterface.f 529 2005-09-29 21:12:38Z andreasw $
617	C
618	C-------------------------------------------------------------------------------
619	C Title
620	C-------------------------------------------------------------------------------
621	C
622	CT Compute Hessian of Lagrangian for CUTEr problem
623	C
624	C-------------------------------------------------------------------------------
625	C Programm description
626	C-------------------------------------------------------------------------------
627	C
628	CB
629	C
630	C-------------------------------------------------------------------------------
631	C Author, date
632	C-------------------------------------------------------------------------------
633	C
634	CA Andreas Waechter 03/23/00
635	CA Andreas Waechter 10/29/04 adapted for C++ version
636	C
637	C-------------------------------------------------------------------------------
638	C Documentation
639	C-------------------------------------------------------------------------------
640	C
641	CD
642	C
643	C-------------------------------------------------------------------------------
644	C Parameter list
645	C-------------------------------------------------------------------------------
646	C
647	C Name I/O Type Meaning
648	C
649	CP TASK I INT =0: Fill IRNH and ICNH, don't use HESS
650	CP <>0: Fill HESS, don't use IRNH, ICNH
651	CP N I INT number of variables in problem statement
652	CP X I DP point where A is to be evaluated
653	CP NEW_X I INT if 1, X has not been changed since last call
654	CP OBJFACT I DP weighting factor for objective function Hessian
655	CP M I INT number of constriants
656	CP LAM I DP weighting factors for the constraints
657	CP NEW_LAM I INT if 1, LAM has not been changed since last call
658	CP NNZH I INT number of nonzero elements
659	CP (size of HESS, IRNH, ICNH)
660	CP IRNH O INT (only TASK=0) row indices
661	CP ICNH O INT (only TASK=0) column indices
662	CP HESS O DP (only TASK<>0) values in Hessian
663	CP IDAT P INT privat INT data for evaluation routines
664	CP DAT P DP privat DP data for evaluation routines
665	CP IERR O INT set to nonzero value if error occurred
666	C
667	C-------------------------------------------------------------------------------
668	C local variables
669	C-------------------------------------------------------------------------------
670	C
671	CL
672	C
673	C-------------------------------------------------------------------------------
674	C used subroutines
675	C-------------------------------------------------------------------------------
676	C
677	CS CSH
678	C
679	C*******************************************************************************
680	C
681	C Declarations
682	C
683	C*******************************************************************************
684	C
685	IMPLICIT NONE
686	C
687	C-------------------------------------------------------------------------------
688	C Parameter list
689	C-------------------------------------------------------------------------------
690	C
691	integer TASK
692	integer N
693	double precision X(N)
694	integer NEW_X
695	double precision OBJFACT
696	integer M
697	double precision LAM(M)
698	integer NEW_LAM
699	integer NNZH
700	integer IRNH(NNZH)
701	integer ICNH(NNZH)
702	double precision HESS(NNZH)
703	double precision DAT(*)
704	integer IDAT(*)
705	integer IERR
706	C
707	C-------------------------------------------------------------------------------
708	C Local varibales
709	C-------------------------------------------------------------------------------
710	C
711	integer i, nnzh2
712	C
713	C*******************************************************************************
714	C
715	C Executable Statements
716	C
717	C*******************************************************************************
718	C
719	IERR = 0
720	if( TASK.eq.0 ) then
721	C
722	C Get the nonzero structure
723	C
724	do i = 1, N
725	DAT(i) = 0.d0
726	enddo
727	call CSH(N, M, DAT(1), M, DAT(1), nnzh2, NNZH, DAT(N+1),
728	1 IRNH, ICNH)
729	else
730	C
731	C Call CSH to get the values
732	C
733	if( OBJFACT.ne.0.d0 ) then
734
735	if( OBJFACT.ne.1.d0 ) then
736	do i = 1, M
737	DAT(i) = LAM(i)/OBJFACT
738	enddo
739	call CSH(N, M, X, M, DAT(1), nnzh2, NNZH, HESS,
740	1 IDAT(1), IDAT(1+NNZH))
741	do i = 1, NNZH
742	HESS(i) = HESS(i)*OBJFACT
743	enddo
744	else
745	call CSH(N, M, X, M, LAM, nnzh2, NNZH, HESS,
746	1 IDAT(1), IDAT(1+NNZH))
747	endif
748
749	else
750	C now we have to call CSH twice, since we can't otherwise get rid of
751	C the objective function entries
752	do i = 1, M
753	DAT(i) = 0.d0
754	enddo
755	call CSH(N, M, X, M, DAT(1), nnzh2, NNZH, DAT(1+M),
756	1 IDAT(1), IDAT(1+NNZH))
757	call CSH(N, M, X, M, LAM, nnzh2, NNZH, HESS,
758	1 IDAT(1), IDAT(1+NNZH))
759	do i = 1, NNZH
760	HESS(i) = HESS(i) - DAT(M+i)
761	enddo
762	endif
763	endif
764
765	9999 continue
766	return
767	end

Note: See TracBrowser for help on using the repository browser.

Download in other formats: