* /****************************************************************
* Copyright (C) 1997 Lucent Technologies
* All Rights Reserved
*
* Permission to use, copy, modify, and distribute this software and
* its documentation for any purpose and without fee is hereby
* granted, provided that the above copyright notice appear in all
* copies and that both that the copyright notice and this
* permission notice and warranty disclaimer appear in supporting
* documentation, and that the name of Lucent or any of its entities
* not be used in advertising or publicity pertaining to
* distribution of the software without specific, written prior
* permission.
*
* LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
* IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
* SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
* IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
* ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
* THIS SOFTWARE.
* ****************************************************************/

	subroutine calcr(n, p, x, nf, r, ui, ur, uf)
	integer n, p, nf, ui(*)
*	n observations, p parameters
	double precision x(p), r(n), ur(*)
	external uf

	integer i, nerror

	nerror = 0
	call conval(n, p, x, r, nerror)
	if (nerror .ne. 0) then
		nf = 0
	else
		do 10 i = 1, n
 10			r(i) = r(i) - ur(i)
		endif
	end

	subroutine calcj(n, p, x, nf, jac, ui, ur, uf)
	integer n, p, nf, ui(*)
	double precision x(p), jac(n,p), ur(*)
	external uf

	integer nerror

	nerror = 0
	call jacval(n, p, ui(1), x, jac, nerror)
	if (nerror .ne. 0) nf = 0
	end

	program fnl21
	integer liv, lv, nmax, pmax, nzmax
	parameter(nmax = 200, pmax = 20, nzmax = nmax*pmax)
	parameter(liv = 82 + 4*pmax)
	parameter(lv = 105 + pmax*(nmax + 2*pmax + 21) + 2*nmax)
	integer i, n, no, nz, p
	character*80 stub
	double precision b(2,pmax), d(pmax), v(lv), x(pmax)
	integer iv(liv)
	external calcj, calcr
	character*40 endmsg(2)
	character*5 arg2
	logical amplfl

	integer prunit
	parameter (prunit = 21)

*** The following are only needed to satisfy calling sequences...
	integer mxrow, mxcol
	integer jp(nmax+1)
	integer*2 ji(nzmax)
	double precision l(pmax), u(pmax), lrhs(nmax), urhs(nmax)
	double precision inf

	call getarg(1,stub)
	call jacdim(stub, n, p, no, nz, mxrow, mxcol)
	if (n .gt. nmax .or. p .gt. pmax) then
		write(*,*) 'Problem too large: ',n,' equations,',
     1				p, ' variables'
		stop
		endif
	call jacinc(n, p, nz, jp, ji, x, l, u, lrhs, urhs, inf)
	call densej
	do 10 i = 1, n
		d(i) = 1
		b(1,i) = l(i)
		b(2,i) = u(i)
 10		continue
	call divset(1, iv, liv, lv, v)
	amplfl = .false.
	call getarg(2,arg2)
	if (arg2 .eq. '-AMPL') then
		amplfl = .true.
		iv(prunit) = 0
		endif
	call dn2gb(n, p, x, b, calcr, calcj, iv, liv, lv, v, nz, lrhs,
     1		   calcr)
	write(endmsg, '(''dn2gb return code ='',i3/''final f ='',
     1 1p,g18.10)') iv(1), v(10)
	if (amplfl) then
		call wrtsol(endmsg,2,x,urhs)
	else
		write(*,*) endmsg
		endif
	end