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 
1C Copyright (C) 2002, 2004, 2005 Carnegie Mellon University,
2C                                Dominique Orban and others.
3C All Rights Reserved.
4C This code is published under the Common Public License.
5C*******************************************************************************
6      PROGRAM           IPOPTMA
7C
8C     IPOPT CUTEr driver.
9C     D. Orban,  adapted from Andreas Waechter's CUTE driver.
10C     Adapted for C++ version by Andreas Waechter, Oct 2004
11C
12      IMPLICIT NONE
13      INTEGER IOUT
14      PARAMETER( IOUT = 6 )
15
16C
17C     Maximal sizes for CUTEr
18C
19CB    CUTE_NMAX       maximal number of variables
20CB    CUTE_MMAX       maximal number of constraints
21CB    CUTE_NZMAX      maximal number of nonzero elements
22      INTEGER CUTE_NMAX, CUTE_MMAX, CUTE_NZMAX
23CTOY  PARAMETER( CUTE_NMAX = 1000,  CUTE_MMAX = 1000  )
24CMED  PARAMETER( CUTE_NMAX = 10000, CUTE_MMAX = 10000 )
25CBIG  PARAMETER( CUTE_NMAX = 50000, CUTE_MMAX = 50000 )
26CCUS  PARAMETER( CUTE_NMAX = 200000, CUTE_MMAX = 200000 )
27CTOY  PARAMETER( CUTE_NZMAX = 100000  )
28CMED  PARAMETER( CUTE_NZMAX = 200000  )
29CBIG  PARAMETER( CUTE_NZMAX = 1000000 )
30CCUS  PARAMETER( CUTE_NZMAX = 10000000 )
31
32C
33C     
34C
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
49C64BIT     INTEGER*8 IPROBLEM, IPCREATE
50C
51      integer IDX_STYLE, NELE_JAC, NELE_HESS
52
53      external EV_F, EV_G, EV_GRAD_F, EV_JAC_G, EV_HESS
54C
55C     The following arrays are work space for the evaluation subroutines
56C
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
64C
65      logical equatn(CUTE_MMAX), linear(CUTE_MMAX)
66      integer i, cnr_input
67      logical efirst, lfirst, nvfrst, ex
68      double precision init_val
69C
70C     Initialize the CUTEr interface and get the initial point
71C
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)
83C
84C     See if we want to set a different initial point
85C
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
95C
96C     Obtain the number of nonzeros in Jacobian and Hessian
97C
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
113C
114C     Get problem name.
115C
116      CALL CNAMES(N, M, PNAME, VNAMES, GNAMES)
117C
118C     Call IPOPT
119C
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
127C
128      IERR = IPSOLVE(IPROBLEM, X, G, F, LAM, Z_L, Z_U, IDAT, DAT)
129C
130      call IPFREE(IPROBLEM)
131C
132C     Display CUTEr statistics
133C
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)
138c
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
162C Copyright (C) 2002, Carnegie Mellon University and others.
163C All Rights Reserved.
164C This code is published under the Common Public License.
165C*******************************************************************************
166C
167      subroutine EV_F(N, X, NEW_X, F, IDAT, DAT, IERR)
168C
169C*******************************************************************************
170C
171C    $Id: CUTErInterface.f 529 2005-09-29 21:12:38Z andreasw $
172C
173C-------------------------------------------------------------------------------
174C                                 Title
175C-------------------------------------------------------------------------------
176C
177CT    Compute objective function value to CUTEr problem
178C
179C-------------------------------------------------------------------------------
180C                          Programm description
181C-------------------------------------------------------------------------------
182C
183CB
184C
185C-------------------------------------------------------------------------------
186C                             Author, date
187C-------------------------------------------------------------------------------
188C
189CA    Andreas Waechter      02/25/99
190CA    Andreas Waechter      10/29/04 adapted for C++ version
191C
192C-------------------------------------------------------------------------------
193C                             Documentation
194C-------------------------------------------------------------------------------
195C
196CD
197C
198C-------------------------------------------------------------------------------
199C                             Parameter list
200C-------------------------------------------------------------------------------
201C
202C    Name     I/O   Type   Meaning
203C
204CP   N         I    INT    number of variables in problem statement
205CP   X         I    DP     point where F is to be evaluated
206CP   NEW_X     I    INT    if 1, X has not been changed since last call
207CP   F         O    DP     objective function value
208CP   IDAT      P    INT    privat INT data for evaluation routines
209CP   DAT       P    DP     privat DP data for evaluation routines
210CP   IERR      O    INT    set to nonzero value if error occurred
211C
212C-------------------------------------------------------------------------------
213C                             local variables
214C-------------------------------------------------------------------------------
215C
216CL
217C
218C-------------------------------------------------------------------------------
219C                             used subroutines
220C-------------------------------------------------------------------------------
221C
222CS    COFG
223C
224C*******************************************************************************
225C
226C                              Declarations
227C
228C*******************************************************************************
229C
230      IMPLICIT NONE
231C
232C-------------------------------------------------------------------------------
233C                             Parameter list
234C-------------------------------------------------------------------------------
235C
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
243C
244C-------------------------------------------------------------------------------
245C                            Local varibales
246C-------------------------------------------------------------------------------
247C
248      double precision dummy
249C
250C*******************************************************************************
251C
252C                           Executable Statements
253C
254C*******************************************************************************
255C
256      IERR = 0
257C
258C     Call COFG to obtain value of objective function
259C
260      call COFG( N, X, F, dummy, .false.)
261
262 9999 continue
263      return
264      end
265C Copyright (C) 2002, Carnegie Mellon University and others.
266C All Rights Reserved.
267C This code is published under the Common Public License.
268C*******************************************************************************
269C
270      subroutine EV_GRAD_F(N, X, NEW_X, GRAD, IDAT, DAT, IERR)
271C
272C*******************************************************************************
273C
274C    $Id: CUTErInterface.f 529 2005-09-29 21:12:38Z andreasw $
275C
276C-------------------------------------------------------------------------------
277C                                 Title
278C-------------------------------------------------------------------------------
279C
280CT    Compute gradient of objective function to CUTEr problem
281C
282C-------------------------------------------------------------------------------
283C                          Programm description
284C-------------------------------------------------------------------------------
285C
286CB
287C
288C-------------------------------------------------------------------------------
289C                             Author, date
290C-------------------------------------------------------------------------------
291C
292CA    Andreas Waechter      02/25/99
293CA    Andreas Waechter      10/29/04 adapted for C++ version
294C
295C-------------------------------------------------------------------------------
296C                             Documentation
297C-------------------------------------------------------------------------------
298C
299CD
300C
301C-------------------------------------------------------------------------------
302C                             Parameter list
303C-------------------------------------------------------------------------------
304C
305C    Name     I/O   Type   Meaning
306C
307CP   N         I    INT    number of variables in problem statement
308CP                            (including slacks for inequality constraints)
309CP   X         I    DP     point where G is to be evaluated
310CP   NEW_X     I    INT    if 1, X has not been changed since last call
311CP   GRAD      O    DP     gradient of objective function
312CP   IDAT      P    INT    privat INT data for evaluation routines
313CP   DAT       P    DP     privat DP data for evaluation routines
314CP   IERR      O    INT    set to nonzero value if error occurred
315C
316C-------------------------------------------------------------------------------
317C                             local variables
318C-------------------------------------------------------------------------------
319C
320CL
321C
322C-------------------------------------------------------------------------------
323C                             used subroutines
324C-------------------------------------------------------------------------------
325C
326CS    COFG
327C
328C*******************************************************************************
329C
330C                              Declarations
331C
332C*******************************************************************************
333C
334      IMPLICIT NONE
335C
336C-------------------------------------------------------------------------------
337C                             Parameter list
338C-------------------------------------------------------------------------------
339C
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
347C
348C-------------------------------------------------------------------------------
349C                            Local varibales
350C-------------------------------------------------------------------------------
351C
352      double precision f
353C
354C*******************************************************************************
355C
356C                           Executable Statements
357C
358C*******************************************************************************
359C
360      IERR = 0
361C
362C     Call COFG to obtain gradient of objective function
363C
364      call COFG( N, X, f, GRAD, .true.)
365
366 9999 continue
367      return
368      end
369C Copyright (C) 2002, Carnegie Mellon University and others.
370C All Rights Reserved.
371C This code is published under the Common Public License.
372C*******************************************************************************
373C
374      subroutine EV_G(N, X, NEW_X, M, G, IDAT, DAT, IERR)
375C
376C*******************************************************************************
377C
378C    $Id: CUTErInterface.f 529 2005-09-29 21:12:38Z andreasw $
379C
380C-------------------------------------------------------------------------------
381C                                 Title
382C-------------------------------------------------------------------------------
383C
384CT    Compute values of constraints to CUTEr problem
385C
386C-------------------------------------------------------------------------------
387C                          Programm description
388C-------------------------------------------------------------------------------
389C
390CB
391C
392C-------------------------------------------------------------------------------
393C                             Author, date
394C-------------------------------------------------------------------------------
395C
396CA    Andreas Waechter      02/25/99
397CA    Andreas Waechter      07/01/99 BUG: problems if ineq not first
398CA    Andreas Waechter      10/29/04 adapted for C++ version
399C
400C-------------------------------------------------------------------------------
401C                             Documentation
402C-------------------------------------------------------------------------------
403C
404CD
405C
406C-------------------------------------------------------------------------------
407C                             Parameter list
408C-------------------------------------------------------------------------------
409C
410C    Name     I/O   Type   Meaning
411C
412CP   N         I    INT    number of variables in problem statement
413CP                            (including slacks for inequality constraints)
414CP   X         I    DP     point where G is to be evaluated
415CP   NEW_X     I    INT    if 1, X has not been changed since last call
416CP   M         I    INT    number of constraints
417CP   G         O    DP     values of constraints
418CP   IDAT      P    INT    privat INT data for evaluation routines
419CP   DAT       P    DP     privat DP data for evaluation routines
420CP   IERR      O    INT    set to nonzero value if error occurred
421C
422C-------------------------------------------------------------------------------
423C                             local variables
424C-------------------------------------------------------------------------------
425C
426CL
427C
428C-------------------------------------------------------------------------------
429C                             used subroutines
430C-------------------------------------------------------------------------------
431C
432CS    CCFG
433C
434C*******************************************************************************
435C
436C                              Declarations
437C
438C*******************************************************************************
439C
440      IMPLICIT NONE
441C
442C-------------------------------------------------------------------------------
443C                             Parameter list
444C-------------------------------------------------------------------------------
445C
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
454C
455C-------------------------------------------------------------------------------
456C                            Local varibales
457C-------------------------------------------------------------------------------
458C
459      double precision dummy
460C
461C*******************************************************************************
462C
463C                           Executable Statements
464C
465C*******************************************************************************
466C
467      IERR = 0
468C
469C     Call CCFG to obtain constraint values, but without slacks
470C
471      call CCFG(N, M, X, M, G, .FALSE., 1, 1, dummy, .FALSE.)
472
473 9999 continue
474      return
475      end
476C Copyright (C) 2002, Carnegie Mellon University and others.
477C All Rights Reserved.
478C This code is published under the Common Public License.
479C*******************************************************************************
480C
481      subroutine EV_JAC_G(TASK, N, X, NEW_X, M, NZ, ACON, AVAR, A,
482     1     IDAT, DAT, IERR)
483C
484C*******************************************************************************
485C
486C    $Id: CUTErInterface.f 529 2005-09-29 21:12:38Z andreasw $
487C
488C-------------------------------------------------------------------------------
489C                                 Title
490C-------------------------------------------------------------------------------
491C
492CT    Compute Jacobian of constraints to CUTEr problem
493C
494C-------------------------------------------------------------------------------
495C                          Programm description
496C-------------------------------------------------------------------------------
497C
498CB
499C
500C-------------------------------------------------------------------------------
501C                             Author, date
502C-------------------------------------------------------------------------------
503C
504CA    Andreas Waechter      02/25/99
505CA    Andreas Waechter      10/29/04 adapted for C++ version
506C
507C-------------------------------------------------------------------------------
508C                             Documentation
509C-------------------------------------------------------------------------------
510C
511CD
512C
513C-------------------------------------------------------------------------------
514C                             Parameter list
515C-------------------------------------------------------------------------------
516C
517C    Name     I/O   Type   Meaning
518C
519CP   TASK      I    INT     =0: Fill ACON and AVAR, don't use A
520CP                         <>0: Fill A, don't use ACON, AVAR
521CP   N         I    INT    number of variables in problem statement
522CP   X         I    DP     point where A is to be evaluated
523CP   NEW_X     I    INT    if 1, X has not been changed since last call
524CP   M         I    INT    number of constraints
525CP   NZ        I    INT    number of nonzero elements
526CP                                     (size of A, AVAR, ACON)
527CP   ACON      O    INT    (only TASK=0) row indices
528CP   AVAR      O    INT    (only TASK=0) column indices
529CP   A         O    DP     (only TASK<>0) values in Jacobian
530CP   IDAT      P    INT    privat INT data for evaluation routines
531CP   DAT       P    DP     privat DP data for evaluation routines
532CP   IERR      O    INT    set to nonzero value if error occurred
533C
534C-------------------------------------------------------------------------------
535C                             local variables
536C-------------------------------------------------------------------------------
537C
538CL
539C
540C-------------------------------------------------------------------------------
541C                             used subroutines
542C-------------------------------------------------------------------------------
543C
544CS    CDIMSJ
545CS    CCFSG
546C
547C*******************************************************************************
548C
549C                              Declarations
550C
551C*******************************************************************************
552C
553      IMPLICIT NONE
554C
555C-------------------------------------------------------------------------------
556C                             Parameter list
557C-------------------------------------------------------------------------------
558C
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
571C
572C-------------------------------------------------------------------------------
573C                            Local varibales
574C-------------------------------------------------------------------------------
575C
576      integer i, nele_jac
577C
578C*******************************************************************************
579C
580C                           Executable Statements
581C
582C*******************************************************************************
583C
584      IERR = 0
585      if( TASK.eq.0 ) then
586C
587C     Get the nonzero structure
588C
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
595C
596C     Get the values of nonzeros
597C
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
605C Copyright (C) 2002, Carnegie Mellon University and others.
606C All Rights Reserved.
607C This code is published under the Common Public License.
608C*******************************************************************************
609C
610
611      subroutine EV_HESS(TASK, N, X, NEW_X, OBJFACT, M, LAM, NEW_LAM,
612     1     NNZH, IRNH, ICNH, HESS, IDAT, DAT, IERR)
613C
614C*******************************************************************************
615C
616C    $Id: CUTErInterface.f 529 2005-09-29 21:12:38Z andreasw $
617C
618C-------------------------------------------------------------------------------
619C                                 Title
620C-------------------------------------------------------------------------------
621C
622CT    Compute Hessian of Lagrangian for CUTEr problem
623C
624C-------------------------------------------------------------------------------
625C                          Programm description
626C-------------------------------------------------------------------------------
627C
628CB
629C
630C-------------------------------------------------------------------------------
631C                             Author, date
632C-------------------------------------------------------------------------------
633C
634CA    Andreas Waechter      03/23/00
635CA    Andreas Waechter      10/29/04 adapted for C++ version
636C
637C-------------------------------------------------------------------------------
638C                             Documentation
639C-------------------------------------------------------------------------------
640C
641CD
642C
643C-------------------------------------------------------------------------------
644C                             Parameter list
645C-------------------------------------------------------------------------------
646C
647C    Name     I/O   Type   Meaning
648C
649CP   TASK      I    INT     =0: Fill IRNH and ICNH, don't use HESS
650CP                         <>0: Fill HESS, don't use IRNH, ICNH
651CP   N         I    INT    number of variables in problem statement
652CP   X         I    DP     point where A is to be evaluated
653CP   NEW_X     I    INT    if 1, X has not been changed since last call
654CP   OBJFACT   I    DP     weighting factor for objective function Hessian
655CP   M         I    INT    number of constriants
656CP   LAM       I    DP     weighting factors for the constraints
657CP   NEW_LAM   I    INT    if 1, LAM has not been changed since last call
658CP   NNZH      I    INT    number of nonzero elements
659CP                                     (size of HESS, IRNH, ICNH)
660CP   IRNH      O    INT    (only TASK=0) row indices
661CP   ICNH      O    INT    (only TASK=0) column indices
662CP   HESS      O    DP     (only TASK<>0) values in Hessian
663CP   IDAT      P    INT    privat INT data for evaluation routines
664CP   DAT       P    DP     privat DP data for evaluation routines
665CP   IERR      O    INT    set to nonzero value if error occurred
666C
667C-------------------------------------------------------------------------------
668C                             local variables
669C-------------------------------------------------------------------------------
670C
671CL
672C
673C-------------------------------------------------------------------------------
674C                             used subroutines
675C-------------------------------------------------------------------------------
676C
677CS    CSH
678C
679C*******************************************************************************
680C
681C                              Declarations
682C
683C*******************************************************************************
684C
685      IMPLICIT NONE
686C
687C-------------------------------------------------------------------------------
688C                             Parameter list
689C-------------------------------------------------------------------------------
690C
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
706C
707C-------------------------------------------------------------------------------
708C                            Local varibales
709C-------------------------------------------------------------------------------
710C
711      integer i, nnzh2
712C
713C*******************************************************************************
714C
715C                           Executable Statements
716C
717C*******************************************************************************
718C
719      IERR = 0
720      if( TASK.eq.0 ) then
721C
722C     Get the nonzero structure
723C
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
730C
731C     Call CSH to get the values
732C
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
750C     now we have to call CSH twice, since we can't otherwise get rid of
751C     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.