/* dfo.f -- translated by f2c (version 20000817). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ #include "f2c.h" #include "blaswrap.h" /* Common Block Declarations */ struct { integer iout, iprint; doublereal mcheps, cnstol; } dfocm_; #define dfocm_1 dfocm_ struct { integer npmin, layer, effort; } opti_; #define opti_1 opti_ /* Inserted by Sergej V. Aksenov, March 2002 */ struct { double delmin, delmax, delta, lowbnd, anoise, rnoise, pivthr, addthr, xchthr; int maxnf, maxit, varnt, scale; } dfopar; /* Table of constant values */ static integer c__1 = 1; static integer c__2 = 2; static integer c__0 = 0; /* Copyright (C) 2000, International Business Machines */ /* Corporation and others. All Rights Reserved. */ /* Subroutine */ int dfo_(n, nx, x, ldx, fx, ifiniv, nclin, ncnln, lb, ub, a, lda, ldcj, xnames, pname, gnames, it, nf, info, wrk, lwrk, iwrk, liwrk, xnames_len, pname_len, gnames_len) integer *n, *nx; doublereal *x; integer *ldx; doublereal *fx; logical *ifiniv; integer *nclin, *ncnln; doublereal *lb, *ub, *a; integer *lda, *ldcj; char *xnames, *pname, *gnames; integer *it, *nf, *info; doublereal *wrk; integer *lwrk, *iwrk, *liwrk; ftnlen xnames_len; ftnlen pname_len; ftnlen gnames_len; { /* Format strings */ static char fmt_1000[] = "(/\002 DFO: *** ERROR: NUMBER OF VARIABLES\002\ ,/\002 HAS ILLEGAL VALUE:\002,i6,/)"; static char fmt_1010[] = "(/\002 DFO: *** ERROR: NUMBER OF LINEAR CONSTR\ AINTS\002,/\002 HAS ILLEGAL VALUE:\002,i6,/)"; static char fmt_1020[] = "(/\002 DFO: *** ERROR: NUMBER OF NONLINEAR CON\ STRAINTS\002,/\002 HAS ILLEGAL VALUE:\002,i6,/)"; static char fmt_1030[] = "(/\002 DFO: *** ERROR: THE UPPER AND LOWER BOU\ NDS ARE\002,/,\002 INCONSISTENT\002,/)"; static char fmt_1060[] = "(/\002 DFO: *** ERROR: THE LEADING DIMENSION O\ F \002,/,\002 LINEAR CONSTRAINTS SHOULD BE AT LEAST\002,i6,/)" ; static char fmt_1065[] = "(/\002 DFO: *** ERROR: THE LEADING DIMENSION O\ F \002,/,\002 NONLINEAR JACOBIAN SHOULD BE AT LEAST\002,i6,/)" ; static char fmt_1080[] = "(/\002 DFO: *** ERROR: THE LEADING DIMENSION O\ F \002,/,\002 INITIAL SET \"X\" SHOULD BE AT LEAST\002,i6,/)"; static char fmt_1090[] = "(/\002 DFO: *** ERROR: THE NUMBER OF INITIAL\ \002,/,\002 POINTS \"X\" SHOULD BE POSITIVE\002)"; static char fmt_3000[] = "(4(d12.4,/),2(i12,/),6(d12.4,/),6(i12,/),i12)"; static char fmt_1050[] = "(/\002 DFO: *** ERROR: MAXNF IS TOO SMALL\ !\002/\002 IT SHOULD BE AT LEAST \002,i5)"; static char fmt_4000[] = "(\002 Minimum frobenius norm models will be us\ ed\002,/)"; static char fmt_4020[] = "(\002 Models based on incomplete Newton Polyno\ mial basis\002,/\002 will be used\002,/)"; static char fmt_1070[] = "(\002 DFO: *** ERROR: LWRK IS TOO SMALL EVEN \ TO START!\002/\002 IT IS: \002,i10)"; static char fmt_1040[] = "(/\002 DFO: *** ERROR: FUNCTION VALUE CANNOT B\ E OBTAINED\002,/,\002 FOR INITIAL POINT!\002)"; static char fmt_5000[] = "(/\002 DFO: *** WARNING: SCALING IS NOT SUPPOR\ TED \002,/,\002 FOR PROBLEMS WITH NONLINEAR CONSTRAINTS\002,/,\002 \ NO SCALING WILL BE PERFORMED\002,/)"; static char fmt_5200[] = "(\002 DFO: *** WARNING:\002,i4,\002-th variabl\ e cannot be scaled,\002,/,\002 scaling coefficient is too small o\ r\002,/,\002 too large\002,/)"; static char fmt_8000[] = "(\002SCALING COEFFICIENTS:\002,/)"; static char fmt_8010[] = "(d14.7,1x)"; static char fmt_6000[] = "(\002OPTIMAL POINT:\002,/)"; static char fmt_6200[] = "(a10,d12.6,/)"; static char fmt_6100[] = "(\002LINEAR CONSTRAINTS:\002,/)"; static char fmt_6300[] = "(\002NONLINEAR CONSTRAINTS:\002,/)"; static char fmt_6400[] = "(/,24(\002*\002),\002DFO: FINAL OUTPUT \002,\ 24(\002*\002)//\002 problem = \002,a10,/,\002 # variabl\ es = \002,i10,/,\002 # constraints = \002,i1\ 0,/,\002 # objective functions = \002,i10,/,\002 # iterations \ = \002,i10,/,\002 Final f = \002,d15.7,/,\002 \ Exit code = \002,i10,/,65(\002*\002)/)"; /* System generated locals */ integer i__1, i__2; doublereal d__1; olist o__1; cllist cl__1; alist al__1; /* Builtin functions */ integer s_wsfe(), do_fio(), e_wsfe(); /* Subroutine */ int s_copy(); integer f_open(), f_rew(), s_rsfe(), e_rsfe(), f_clos(); double log(), exp(); /* Local variables */ extern doublereal ddot_(); static integer lenw, i__, j, scale; static doublereal delta; static integer iscal, lscal; static doublereal avgsc; static logical iferr; static integer maxnf; static doublereal noise[2]; static char specs[64]; static integer maxit; extern /* Subroutine */ int unscl_(); static integer icurw, varnt, badbnd, ip[6]; static doublereal rp[7], addthr, delmin, delmax, anoise; static integer iospec; static doublereal lowbnd; extern /* Subroutine */ int funcon_(), dfoslv_(); static doublereal rnoise, xchthr, pivthr, val; extern /* Subroutine */ int scl_(), fun_(); /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, fmt_1000, 0 }; static cilist io___2 = { 0, 0, 0, fmt_1010, 0 }; static cilist io___3 = { 0, 0, 0, fmt_1020, 0 }; static cilist io___6 = { 0, 0, 0, fmt_1030, 0 }; static cilist io___7 = { 0, 0, 0, fmt_1060, 0 }; static cilist io___8 = { 0, 0, 0, fmt_1065, 0 }; static cilist io___9 = { 0, 0, 0, fmt_1080, 0 }; static cilist io___10 = { 0, 0, 0, fmt_1090, 0 }; static cilist io___13 = { 0, 45, 0, fmt_3000, 0 }; static cilist io___30 = { 0, 0, 0, fmt_1050, 0 }; static cilist io___31 = { 0, 0, 0, fmt_4000, 0 }; static cilist io___32 = { 0, 0, 0, fmt_4020, 0 }; static cilist io___37 = { 0, 0, 0, fmt_1070, 0 }; static cilist io___39 = { 0, 0, 0, fmt_1040, 0 }; static cilist io___40 = { 0, 0, 0, fmt_5000, 0 }; static cilist io___42 = { 0, 0, 0, fmt_5200, 0 }; static cilist io___44 = { 0, 0, 0, fmt_8000, 0 }; static cilist io___45 = { 0, 0, 0, fmt_8010, 0 }; static cilist io___46 = { 0, 0, 0, fmt_6000, 0 }; static cilist io___47 = { 0, 0, 0, fmt_6200, 0 }; static cilist io___48 = { 0, 0, 0, fmt_6100, 0 }; static cilist io___50 = { 0, 0, 0, fmt_6200, 0 }; static cilist io___51 = { 0, 0, 0, fmt_6300, 0 }; static cilist io___52 = { 0, 0, 0, fmt_6200, 0 }; static cilist io___53 = { 0, 0, 0, fmt_6400, 0 }; /* Added by Sergej V. Aksenov; integer flag to see if fun_ had internal error and it is necessary to abort dfo */ int funflag = 0; /* **************************************************************** */ /* THIS SUBROUTINE MINIMIZES A NONLINEAR OBJECTIVE FUNCTION */ /* SUBJECT TO LINEAR AND (POSSIBLY) NONLINEAR CONSTRAINTS */ /* AND SIMPLE BOUNDS, WITHOUT USING DERIVATIVES OF */ /* THE OBJECTIVE FUNCTION. */ /* THE PROBLEM IS CONSIDERED TO BE OF THE FORM */ /* MIN F( X ) */ /* S.T. */ /* / X \ */ /* LB <= ( AX ) <= UB */ /* \C(X)/ */ /* THIS PROGRAM IS BASED ON USING QUADRATIC INTERPOLATION OF THE */ /* OBJECTIVE FUNCTION IN COMBINATION WITH TRUST REGION FRAMEWORK */ /* PARAMETERS */ /* ========== */ /* (INPUT) */ /* X : ARRAY OF NX INITIAL POINTS, GIVEN BY THE USER */ /* 'X' HAS TO CONTAIN AT LEAST ONE STARTING POINT */ /* IF NO FUNCTION VALUES ARE PROVIDED FOR THE POINTS */ /* IN 'X', THEN ALL BUT THE FIRST POINT ARE IGNORED. */ /* LDX : LEADING DIMENSION OF ARRAY 'X' (LDX>= N) */ /* FX : ARRAY OF FUNCTION VALUES AT THE INITIAL POINTS */ /* OF LENGTH AT LEAST 1 ( MAY BE DUMMY IF NO VALUES */ /* ARE PROVIDED ) */ /* NX : NUMBER OF INITIAL POINTS FOR WHICH THE VALUE IS */ /* PROVIDED. IF NO SUCH POINTS PROVIDED, THEN NX=1 */ /* IFINIV : LOGICAL VARIABLE, .TRUE. IS INITIAL VALUES FOR */ /* NX INITIAL POINTS ARE PROVIDED, .FALSE. OTHERWISE */ /* N : PROBLEM DIMENSION */ /* NCLIN : NUMBER F LINEAR CONSTRAINTS */ /* NCNLN : NUMBER OF NONLINEAR CONSTRAINTS */ /* LB : ARRAY OF LOWER BOUNDS OF LENGTH >= (N+NCLIN+NCNLN) */ /* UB : ARRAY OF UPPER BOUNDS OF LENGTH >= (N+NCLIN+NCNLN) */ /* A : MATRIX OF LINEAR CONSTRAINTS,( DIMENSIONS: LDA X N) */ /* LDA : LEADING DIMENSION OF MATRIX A, HAS TO BE >= MAX(1, NCLIN) */ /* LDCJ : LEADING DIMENSION OF THE JACOBIAN OF NONLINEAR */ /* CONSTRAINTS, AS COMPUTED BY THE USER ROUTINE 'FUNCON' */ /* XNAMES : ARRAY OF STRINGS OF CHARACTERS, CONTAINING */ /* NAMES OF THE VARIABLES */ /* PNAME : STRING OF CHARACTERS CONTAINING THE NAME OF THE PROBLEMS */ /* GNAMES : ARRAY OF STRINGS OF CHARACTERS, CONTAINING NAMES */ /* OF CONSTRAINTS */ /* WRK : REAL WORKSPACE ARRAY OF SIZE LWRK */ /* THE REQUIRED LENGTH OF LWRK IS APPROXIMATED FROM ABOVE BY: */ /* (2N+24)(N+NCLIN+NCNLN)+(2NCNLN+6)*N+(MAXNF+NX)(N+2)+ */ /* [(N+1)**2 (N+2)(N+14)]/4 */ /* IWRK : INTEGER WORKSPACE ARRAY OF SIZE LIWRK */ /* THE REQUIRED LENGTH OF INTEGER SPACE IS */ /* 4((N+NCLIN+NCNLN) + (MAXNF+NX) + (N+1)(N+2)/2 */ /* (OUTPUT) */ /* X : THE OPTIMAL (OR BEST FOUND) POINT */ /* FX : THE VALUE OF OBJECTIVE FUNCTION AT X */ /* INFO : THE EXIT INFORMATION: */ /* 0 SUCCESSFUL MINIMIZATION */ /* 1 TOO MANY FUNCTION EVALUATIONS */ /* 2 TOO MANY ITERATIONS */ /* -1 ILLEGAL VALUE OF N, NCLIN OR NCNLN */ /* -2 ILLEGAL VALUE OF LDA OR LDX */ /* -3 REAL WORKSPACE IS TOO SMALL */ /* -4 INTEGER WORKSPACE IS TOO SMALL */ /* -5 INCONSISTENT BOUNDS */ /* -6 FUNCTION VALUE CANNOT BE COMPUTED */ /* AT INITIAL POINT */ /* -7 MINIMIZATION OVER TRUST REGION FAILED */ /* -8 MAXNF IS TOO SMALL, LESS THAN 2 */ /* -9 CANNOT BUILD A 2 POINT MODEL */ /* IT : THE NUMBER OF ITERATIONS */ /* NF : THE NUMBER OF FUNCTION EVALUATIONS */ /* ******************************************************************** */ /* Programming: K. Scheinberg, Spring 1998. */ /* ******************************************************************** */ /* SUBROUTINE PARAMETERS */ /* COMMON VARIABLES */ /* PROCESS CONTROL PARAMETERS */ /* INTERPOLATION CONTROL PARAMETERS */ /* EXTERNAL ROUTINES */ /* LOCAL VARIABLES */ /* PARAMETERS */ /* SUBROUTINES CALLED: */ /* APPLICATIONS: DFOSLV, FUN, SCL, UNSCL, FUNCON */ /* BLAS : DDOT */ /* ---------------------------------- */ /* CHECK IF THE INITIAL DATA IS VALID */ /* ---------------------------------- */ /* Note by Sergej V. Aksenov: checking is done before dfocm_1 receives values*/ /* CHECK IF THE DIMENSIONS ARE POSITIVE */ /* Parameter adjustments */ xnames -= 10; --fx; --x; gnames -= 10; --ub; --lb; --a; --wrk; --iwrk; /* Function Body */ if (*n <= 0) { if (dfocm_1.iprint >= 0) { io___1.ciunit = dfocm_1.iout; s_wsfe(&io___1); do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); e_wsfe(); } *info = -1; return 0; } if (*nclin < 0) { if (dfocm_1.iprint >= 0) { io___2.ciunit = dfocm_1.iout; s_wsfe(&io___2); do_fio(&c__1, (char *)&(*nclin), (ftnlen)sizeof(integer)); e_wsfe(); } *info = -1; return 0; } if (*ncnln < 0) { if (dfocm_1.iprint >= 0) { io___3.ciunit = dfocm_1.iout; s_wsfe(&io___3); do_fio(&c__1, (char *)&(*ncnln), (ftnlen)sizeof(integer)); e_wsfe(); } *info = -1; return 0; } /* CHECK IF THE BOUNDS ARE CONSISTENT */ badbnd = 0; i__1 = *n + *nclin + *ncnln; for (i__ = 1; i__ <= i__1; ++i__) { if (lb[i__] > ub[i__] + dfocm_1.mcheps) { badbnd = 1; } /* L10: */ } if (badbnd == 1) { if (dfocm_1.iprint >= 0) { io___6.ciunit = dfocm_1.iout; s_wsfe(&io___6); e_wsfe(); } *info = -5; return 0; } /* CHECK IF DIMENSION OF LINEAR CONSTRAINT MATRIX IS SATISFACTORY */ if (*lda < max(*nclin,1)) { if (dfocm_1.iprint >= 0) { io___7.ciunit = dfocm_1.iout; s_wsfe(&io___7); i__1 = max(*nclin,1); do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); e_wsfe(); } *info = -2; return 0; } /* CHECK IF DIMENSION OF NONLINEAR CONSTRAINT JACOBIAN IS SATISFACTORY */ if (*ldcj < max(*ncnln,1)) { if (dfocm_1.iprint >= 0) { io___8.ciunit = dfocm_1.iout; s_wsfe(&io___8); i__1 = max(*ncnln,1); do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); e_wsfe(); } *info = -2; return 0; } /* CHECK IF LEADING DIMENSION OF INITIAL SET 'X' IS SATISFACTORY */ if (*ldx < *n) { if (dfocm_1.iprint >= 0) { io___9.ciunit = dfocm_1.iout; s_wsfe(&io___9); do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); e_wsfe(); } *info = -2; return 0; } /* CHECK IF OTHER DIMENSION OF INITIAL SET 'X' IS POSITIVE */ if (*nx <= 0) { if (dfocm_1.iprint >= 0) { io___10.ciunit = dfocm_1.iout; s_wsfe(&io___10); e_wsfe(); } *info = -2; return 0; } /* READ THE SPECIFICATION FILE */ /* Reading the file commented out by Sergej V. Aksenov; instead, data are read from a common block */ /* s_copy(specs, "DFO.SPC", (ftnlen)64, (ftnlen)7); o__1.oerr = 1; o__1.ounit = 45; o__1.ofnmlen = 64; o__1.ofnm = specs; o__1.orl = 0; o__1.osta = "OLD"; o__1.oacc = 0; o__1.ofm = "FORMATTED"; o__1.oblnk = 0; iospec = f_open(&o__1); al__1.aerr = 0; al__1.aunit = 45; f_rew(&al__1); s_rsfe(&io___13); do_fio(&c__1, (char *)&delmin, (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&delmax, (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&delta, (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&lowbnd, (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&maxnf, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&maxit, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&anoise, (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&rnoise, (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&pivthr, (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&addthr, (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&xchthr, (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&dfocm_1.cnstol, (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&opti_1.npmin, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&opti_1.layer, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&opti_1.effort, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&varnt, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&scale, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&dfocm_1.iprint, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&dfocm_1.iout, (ftnlen)sizeof(integer)); e_rsfe(); cl__1.cerr = 0; cl__1.cunit = 45; cl__1.csta = 0; f_clos(&cl__1); */ delmin = dfopar.delmin; delmax = dfopar.delmax; delta = dfopar.delta; lowbnd = dfopar.lowbnd; maxnf = dfopar.maxnf; maxit = dfopar.maxit; anoise = dfopar.anoise; rnoise = dfopar.rnoise; pivthr = dfopar.pivthr; addthr = dfopar.addthr; xchthr = dfopar.xchthr; dfocm_1.cnstol = 1.e-8; varnt = dfopar.varnt; scale = dfopar.scale; /* STORE THE MINIMIZATION PARAMETERS, OBTAINED FROM SPECIFICATION FILE */ dfocm_1.mcheps = 1.5e-16; ip[0] = maxit; ip[1] = maxnf; ip[2] = opti_1.npmin; ip[3] = opti_1.layer; ip[4] = opti_1.effort; ip[5] = varnt; rp[0] = delta; rp[1] = delmax; rp[2] = delmin; rp[3] = pivthr; rp[4] = addthr; rp[5] = xchthr; rp[6] = lowbnd; noise[0] = anoise; noise[1] = rnoise; /* CHECK IF THE INITIAL NUMBER OF INTERPOLATION POINTS */ /* IS NOT LARGER THAN MAXIMUM NUMBER OF FUNCTION EVALUATIONS */ if (maxnf < 2) { if (dfocm_1.iprint >= 0) { io___30.ciunit = dfocm_1.iout; s_wsfe(&io___30); do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer)); e_wsfe(); } *info = -8; return 0; } /* PRINT OUT SOME SPECIFICATIONS INFO */ if (dfocm_1.iprint >= 2) { if (varnt == 1) { io___31.ciunit = dfocm_1.iout; s_wsfe(&io___31); e_wsfe(); } else { io___32.ciunit = dfocm_1.iout; s_wsfe(&io___32); e_wsfe(); } } /* IF THERE ARE NO NONLINEAR CONSTRAINTS SET THE CONSTRAINT */ /* TOLERANCE, USED BY NPSOL, TO A DEFAULT VALUE */ if (*ncnln == 0) { dfocm_1.cnstol = 1e-8; } /* SET THE POINTERS TO SPACE FOR SCALING COEFFICIENTS */ iscal = 1; lscal = iscal - 1; /* CHECK IF REAL SPACE IS SUFFICIENT */ icurw = iscal + *n; lenw = *lwrk - icurw + 1; if (lenw < 0) { io___37.ciunit = dfocm_1.iout; s_wsfe(&io___37); do_fio(&c__1, (char *)&(*lwrk), (ftnlen)sizeof(integer)); e_wsfe(); *info = -3; return 0; } /* Changed by Sergej V. Aksenov to read the output flag of fun_ into int funflag */ /* INITIALIZE NF TO ZERO. */ /* IF NO INITIAL POINT WITH FUNCTION VALUE IS PROVIDED, COMPUTE */ /* THE FUNCTION VALUE AT THE FIRST POINT AND SET NF = 1 */ *nf = 0; if (! (*ifiniv)) { funflag = fun_(n, &x[1], &fx[1], &iferr); if (iferr) { if (dfocm_1.iprint >= 0) { io___39.ciunit = dfocm_1.iout; s_wsfe(&io___39); e_wsfe(); } *info = -6; return 0; } /* Added by Sergej V. Aksenov to get out of dfo if funflag=-1 */ if (funflag) { *info = -10; return 0; } *nf = 1; *nx = 1; } /* CHECK IF SCALING AND NONLINEAR CONSTRAINTS ARE NOT USED AT */ /* THE SAME TIME (NOT SUPPORTED BY CURRENT VERSION) */ if (scale != 0 && *ncnln > 0) { if (dfocm_1.iprint >= 0) { io___40.ciunit = dfocm_1.iout; s_wsfe(&io___40); e_wsfe(); } scale = 0; } /* SCALE THE PROBLEM IF REQUIRED */ if (scale != 0) { avgsc = 1.; i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { if (scale == 1) { wrk[lscal + i__] = (d__1 = x[i__], abs(d__1)) + 1.; avgsc *= wrk[lscal + i__]; } else { wrk[lscal + i__] = ub[i__] - lb[i__]; if (wrk[lscal + i__] < dfocm_1.cnstol || wrk[lscal + i__] > 1e20) { if (dfocm_1.iprint >= 0) { io___42.ciunit = dfocm_1.iout; s_wsfe(&io___42); do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); e_wsfe(); } wrk[lscal + i__] = 1.; avgsc *= wrk[lscal + i__]; } } /* L20: */ } } /* SCALE THE POINT AND THE BOUNDS */ if (scale != 0) { i__1 = *nx; for (i__ = 1; i__ <= i__1; ++i__) { scl_(n, &x[(i__ - 1) * *n + 1], &wrk[iscal]); /* L25: */ } scl_(n, &lb[1], &wrk[iscal]); scl_(n, &ub[1], &wrk[iscal]); /* SHOULD SCALE THE TRUST REGION RADIUS AS WELL. RIGHT NOW ONLY SCALE */ /* THE LOWER BOUND ON THE TRUST REGIONS RADIUS */ /* RP( 1 ) = RP( 1 )*(N/AVGSC) */ /* RP( 2 ) = RP( 2 )*(N/AVGSC) */ rp[2] /= exp(log(avgsc) / *n); i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { i__2 = *nclin; for (j = 1; j <= i__2; ++j) { a[*lda * (i__ - 1) + j] *= wrk[lscal + i__]; /* L30: */ } /* L40: */ } if (dfocm_1.iprint >= 2) { io___44.ciunit = dfocm_1.iout; s_wsfe(&io___44); e_wsfe(); i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { io___45.ciunit = dfocm_1.iout; s_wsfe(&io___45); do_fio(&c__1, (char *)&wrk[lscal + i__], (ftnlen)sizeof( doublereal)); e_wsfe(); /* L45: */ } } } /* CALL THE DFO SOLVER */ dfoslv_(n, nx, nclin, ncnln, &x[1], ldx, &fx[1], &lb[1], &ub[1], &a[1], lda, ldcj, &scale, &wrk[iscal], info, it, nf, noise, ip, rp, &wrk[ icurw], &lenw, &iwrk[1], liwrk); /* UNSCALE THE PROBLEM IF SCALED */ if (scale != 0) { unscl_(n, &x[1], &wrk[iscal]); unscl_(n, &lb[1], &wrk[iscal]); unscl_(n, &ub[1], &wrk[iscal]); i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { i__2 = *nclin; for (j = 1; j <= i__2; ++j) { a[*lda * (j - 1) + i__] /= wrk[lscal + i__]; /* L50: */ } /* L60: */ } } /* IF DEMANDED, PRINT OUT THE FINAL OUTPUT */ if (dfocm_1.iprint >= 0) { io___46.ciunit = dfocm_1.iout; s_wsfe(&io___46); e_wsfe(); i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { io___47.ciunit = dfocm_1.iout; s_wsfe(&io___47); do_fio(&c__1, xnames + i__ * 10, (ftnlen)10); do_fio(&c__1, (char *)&x[i__], (ftnlen)sizeof(doublereal)); e_wsfe(); /* L70: */ } if (*nclin > 0) { io___48.ciunit = dfocm_1.iout; s_wsfe(&io___48); e_wsfe(); i__1 = *nclin; for (i__ = 1; i__ <= i__1; ++i__) { val = ddot_(n, &a[i__], lda, &x[1], &c__1); io___50.ciunit = dfocm_1.iout; s_wsfe(&io___50); do_fio(&c__1, gnames + i__ * 10, (ftnlen)10); do_fio(&c__1, (char *)&val, (ftnlen)sizeof(doublereal)); e_wsfe(); /* L80: */ } } if (*ncnln > 0) { io___51.ciunit = dfocm_1.iout; s_wsfe(&io___51); e_wsfe(); i__1 = *ncnln; for (i__ = 1; i__ <= i__1; ++i__) { iwrk[i__] = 1; /* L85: */ } funcon_(&c__0, ncnln, n, ldcj, &iwrk[1], &x[1], &wrk[icurw], &wrk[ icurw + *ldcj], &c__1); i__1 = *ncnln; for (i__ = 1; i__ <= i__1; ++i__) { io___52.ciunit = dfocm_1.iout; s_wsfe(&io___52); do_fio(&c__1, gnames + (*nclin + i__) * 10, (ftnlen)10); do_fio(&c__1, (char *)&wrk[icurw + i__ - 1], (ftnlen)sizeof( doublereal)); e_wsfe(); /* L90: */ } } io___53.ciunit = dfocm_1.iout; s_wsfe(&io___53); do_fio(&c__1, pname, (ftnlen)10); do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); i__1 = *nclin + *ncnln; do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&(*nf), (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&(*it), (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&fx[1], (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&(*info), (ftnlen)sizeof(integer)); e_wsfe(); /* WRITE( IOUT, 6600 ) PNAME, N, NCLIN+NCNLN, NF, IT, FX(1), INFO */ } return 0; /* NON-EXECUTABLE STATEMENTS */ /* L6600: */ } /* dfo_ */