00001 /* 00002 ------------------------------------------------------------------- 00003 00004 Copyright (C) 2006, 2007, Andrew W. Steiner 00005 00006 This file is part of O2scl. 00007 00008 O2scl is free software; you can redistribute it and/or modify 00009 it under the terms of the GNU General Public License as published by 00010 the Free Software Foundation; either version 3 of the License, or 00011 (at your option) any later version. 00012 00013 O2scl is distributed in the hope that it will be useful, 00014 but WITHOUT ANY WARRANTY; without even the implied warranty of 00015 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00016 GNU General Public License for more details. 00017 00018 You should have received a copy of the GNU General Public License 00019 along with O2scl. If not, see <http://www.gnu.org/licenses/>. 00020 00021 ------------------------------------------------------------------- 00022 */ 00023 #ifndef O2SCL_CERN_MROOT_H 00024 #define O2SCL_CERN_MROOT_H 00025 00026 #include <o2scl/mroot.h> 00027 00028 #ifndef DOXYGENP 00029 namespace o2scl { 00030 #endif 00031 00032 /** 00033 \brief Multi-dimensional mroot-finding routine (CERNLIB) 00034 00035 If \f$ x_i \f$ denotes the current iteration, and \f$ 00036 x^{\prime}_i \f$ denotes the previous iteration, then the 00037 calculation is terminated if either of the following tests is 00038 successful 00039 \f[ 00040 1:\quad \mathrm{max} | f_i(x) | \leq \mathrm{tolf} 00041 \f] 00042 \f[ 00043 2:\quad \mathrm{max} |x_i-x^{\prime}_i| \leq 00044 \mathrm{tolx} \times \mathrm{max} | x_i | 00045 \f] 00046 00047 This routine treats the functions specified as a \ref mm_funct 00048 object slightly differently than \ref gsl_mroot_hybrids. First 00049 the equations should be numbered (as much as is possible) in 00050 order of increasing nonlinearity. Also, instead of calculating 00051 all of the equations on each function call, only the equation 00052 specified by the \c size_t parameter needs to be calculated. If 00053 the equations are specified as 00054 \f{eqnarray*} 00055 &0=f_0(x_0,x_1,...,x_{n-1})& \\ 00056 &0=f_1(x_0,x_1,...,x_{n-1})& \\ 00057 &...& \\ 00058 &0=f_{n-1}(x_0,x_1,...,x_{n-1})& \\ 00059 \f} 00060 then when the \c size_t argument is given as \c i, then 00061 only the function \f$ f_i \f$ needs to be calculated. 00062 00063 Based on \ref More79 and \ref More80 00064 00065 \warning This code has not been checked to ensure that it cannot 00066 fail to solve the equations without calling the error handler 00067 and returning a non-zero value. Until then, the solution may 00068 need to be checked explicitly by the caller. 00069 00070 \future Modify this so it handles functions which return 00071 non-zero values. 00072 00073 */ 00074 template<class param_t, class func_t=mm_funct<param_t>, 00075 class vec_t=ovector_view, class alloc_vec_t=ovector, 00076 class alloc_t=ovector_alloc, 00077 class jfunc_t=jac_funct<param_t,vec_t,omatrix_view> > 00078 class cern_mroot : public mroot<param_t,func_t,vec_t,jfunc_t> { 00079 00080 #ifndef DOXYGEN_INTERNAL 00081 00082 protected: 00083 00084 /// Memory allocator for objects of type \c alloc_vec_t 00085 alloc_t ao; 00086 00087 #endif 00088 00089 public: 00090 00091 cern_mroot() { 00092 info=0; 00093 eps=0.1490116119384766e-07; 00094 scale=10.0; 00095 maxf=0; 00096 00097 int tmp_mpt[289]= 00098 {0,1,2,3,3,3,4,4,4,5,5,5,5,6,6,6,6,7,7,7,7,8,8,8,8,9,9,9,9,9,10, 00099 10,10,10,10,11,11,11,11,11,12,12,12,12,12,13,13,13,13,13,14,14, 00100 14,14,14,15,15,15,15,15,15,16,16,16,16,16,16,17,17,17,17,17,18, 00101 18,18,18,18,18,19,19,19,19,19,19,20,20,20,20,20,20,21,21,21,21, 00102 21,21,21,22,22,22,22,22,22,23,23,23,23,23,23,24,24,24,24,24,24, 00103 24,25,25,25,25,25,25,26,26,26,26,26,26,26,27,27,27,27,27,27,28, 00104 28,28,28,28,28,28,29,29,29,29,29,29,29,30,30,30,30,30,30,30,31, 00105 31,31,31,31,31,31,32,32,32,32,32,32,32,33,33,33,33,33,33,33,34, 00106 34,34,34,34,34,34,35,35,35,35,35,35,35,36,36,36,36,36,36,36,37, 00107 37,37,37,37,37,37,37,38,38,38,38,38,38,38,39,39,39,39,39,39,39, 00108 40,40,40,40,40,40,40,40,41,41,41,41,41,41,41,42,42,42,42,42,42, 00109 42,42,43,43,43,43,43,43,43,44,44,44,44,44,44,44,44,45,45,45,45, 00110 45,45,45,45,46,46,46,46,46,46,46,47,47,47,47,47,47,47,47,48,48, 00111 48,48,48,48,48,48}; 00112 for(size_t i=0;i<289;i++) mpt[i]=tmp_mpt[i]; 00113 } 00114 00115 /** 00116 \brief Get the value of \c INFO from the last call to msolve() 00117 00118 The value of info is assigned according to the following list. 00119 The values 1-8 are the standard behavior from CERNLIB. 00120 0 - The function solve() has not been called. 00121 1 - Test 1 was successful. \n 00122 2 - Test 2 was successful. \n 00123 3 - Both tests were successful. \n 00124 4 - Number of iterations is greater than cern_mroot_root::maxf. \n 00125 5 - Approximate (finite difference) Jacobian matrix is 00126 singular. \n 00127 6 - Iterations are not making good progress. \n 00128 7 - Iterations are diverging. \n 00129 8 - Iterations are converging, but either cern_mroot_root::tolx 00130 is too small or the Jacobian is nearly singular 00131 or the variables are badly scaled. \n 00132 9 - Either root::tolf or root::tolx is not greater than zero 00133 or the specified number of variables is \f$ \leq 0\f$. 00134 */ 00135 int get_info() { return info; } 00136 00137 /** 00138 \brief Maximum number of function evaluations 00139 00140 If \f$ \mathrm{maxf}\leq 0 \f$ , then \f$ 50(\mathrm{nv}+3) \f$ 00141 (which is the CERNLIB default) is used. The default value of 00142 \c maxf is zero which then implies the default from CERNLIB. 00143 */ 00144 int maxf; 00145 00146 /// Return the type, \c "cern_mroot". 00147 virtual const char *type() { return "cern_mroot"; } 00148 00149 /** \brief The original scale parameter from CERNLIB (default 10.0) 00150 */ 00151 double scale; 00152 00153 /** \brief The smallest floating point number 00154 (default \f$ \sim 1.49012 \times 10^{-8} \f$ ) 00155 00156 The original prescription from CERNLIB for \c eps is 00157 given below: 00158 \verbatim 00159 #if !defined(CERNLIB_DOUBLE) 00160 PARAMETER (EPS = 0.84293 69702 17878 97282 52636 392E-07) 00161 #endif 00162 #if defined(CERNLIB_IBM) 00163 PARAMETER (EPS = 0.14901 16119 38476 562D-07) 00164 #endif 00165 #if defined(CERNLIB_VAX) 00166 PARAMETER (EPS = 0.37252 90298 46191 40625D-08) 00167 #endif 00168 #if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_DOUBLE)) 00169 PARAMETER (EPS = 0.14901 16119 38476 600D-07) 00170 #endif 00171 \endverbatim 00172 */ 00173 double eps; 00174 00175 /// Solve \c func using \c x as an initial guess, returning \c x. 00176 virtual int msolve(size_t nvar, vec_t &x, param_t &pa, func_t &func) { 00177 int mopt=0, i, j, k, it=0; 00178 double fky; 00179 00180 int lmaxf; 00181 if (maxf<=0) lmaxf=50*(nvar+3); 00182 else lmaxf=maxf; 00183 00184 info=0; 00185 00186 if (nvar<=0 || this->tolf<=0.0 || this->tolx<=0.0) { 00187 info=9; 00188 set_err_ret("Invalid arguments in cern_mroot_t::msolve().", 00189 gsl_efailed); 00190 } 00191 00192 // Find optimal \c mopt for iterative refinement 00193 00194 if (nvar<=288) mopt=mpt[nvar-1]; 00195 else { 00196 bool done=false; 00197 double h=0.0; 00198 for(i=49;i<=((int)nvar) && done==false;i++) { 00199 double temp=log(((double)i)+1.0)/((double)(nvar+2*i+1)); 00200 if (temp<h) { 00201 mopt=i-1; 00202 done=true; 00203 } 00204 if (!done) h=temp; 00205 } 00206 } 00207 00208 int iflag=0, numf=0, nfcall=0, nier6=-1, nier7=-1, nier8=0; 00209 double fnorm=0.0, difit=0.0, xnorm=0.0; 00210 bool set=false; 00211 00212 for(i=0;i<((int)nvar);i++) { 00213 if (xnorm<fabs(x[i])) { 00214 xnorm=fabs(x[i]); 00215 set=true; 00216 } 00217 } 00218 double delta=scale*xnorm; 00219 if (set==false) delta=scale; 00220 00221 double **w=new double *[nvar]; 00222 for(i=0;i<((int)nvar);i++) { 00223 w[i]=new double[nvar]; 00224 } 00225 00226 alloc_vec_t f, w0, w1, w2; 00227 ao.allocate(f,nvar); 00228 ao.allocate(w0,nvar); 00229 ao.allocate(w1,nvar); 00230 ao.allocate(w2,nvar); 00231 00232 bool solve_done=false; 00233 while (solve_done==false) { 00234 bool bskip=false; 00235 00236 int nsing=nvar; 00237 double fnorm1=fnorm; 00238 double difit1=difit; 00239 fnorm=0.0; 00240 00241 // Compute step H for the divided difference which approximates 00242 // the K-th row of the Jacobian matrix 00243 00244 double h=eps*xnorm; 00245 if (h==0.0) h=eps; 00246 for(j=0;j<((int)nvar);j++) { 00247 for(i=0;i<((int)nvar);i++) { 00248 w[j][i]=0.0; 00249 } 00250 w[j][j]=h; 00251 w1[j]=x[j]; 00252 } 00253 00254 // Enter a subiteration 00255 00256 for(k=0;k<((int)nvar);k++) { 00257 iflag=k; 00258 00259 func(iflag,w1,f,pa); 00260 00261 fky=f[k]; 00262 nfcall++; 00263 numf=(int)(((double)nfcall)/((double)nvar)); 00264 if (fnorm<fabs(fky)) fnorm=fabs(fky); 00265 00266 // Compute the K-th row of the Jacobian matrix 00267 00268 for(j=k;j<((int)nvar);j++) { 00269 for(i=0;i<((int)nvar);i++) { 00270 w2[i]=w1[i]+w[j][i]; 00271 } 00272 00273 func(iflag,w2,f,pa); 00274 00275 double fkz=f[k]; 00276 nfcall++; 00277 numf=(int)(((double)nfcall)/((double)nvar)); 00278 w0[j]=fkz-fky; 00279 } 00280 00281 f[k]=fky; 00282 00283 // Compute the Householder transformation to reduce the K-th row 00284 // of the Jacobian matrix to a multiple of the K-th unit vector 00285 00286 double eta=0.0; 00287 for(i=k;i<((int)nvar);i++) if (eta<fabs(w0[i])) eta=fabs(w0[i]); 00288 00289 if (eta!=0.0) { 00290 nsing--; 00291 double sknorm=0.0; 00292 for(i=k;i<((int)nvar);i++) { 00293 w0[i]/=eta; 00294 sknorm+=w0[i]*w0[i]; 00295 } 00296 sknorm=sqrt(sknorm); 00297 if (w0[k]<0.0) sknorm=-sknorm; 00298 w0[k]+=sknorm; 00299 00300 // Apply the transformation 00301 00302 for(i=0;i<((int)nvar);i++) { 00303 w2[i]=0.0; 00304 } 00305 for(j=k;j<((int)nvar);j++) { 00306 for(i=0;i<((int)nvar);i++) { 00307 w2[i]+=w0[j]*w[j][i]; 00308 } 00309 } 00310 for(j=k;j<((int)nvar);j++) { 00311 double temp=w0[j]/(sknorm*w0[k]); 00312 for(i=0;i<((int)nvar);i++) { 00313 w[j][i]-=temp*w2[i]; 00314 } 00315 } 00316 00317 // Compute the subiterate 00318 00319 w0[k]=sknorm*eta; 00320 double temp2=fky/w0[k]; 00321 if (h*fabs(temp2)>delta) 00322 temp2=(temp2>=0.0) ? fabs(delta/h) : -fabs(delta/h); 00323 for(i=0;i<((int)nvar);i++) { 00324 w1[i]+=temp2*w[k][i]; 00325 } 00326 } 00327 } 00328 00329 // Compute the norms of the iterate and correction vector 00330 00331 xnorm=0.0; 00332 difit=0.0; 00333 for(i=0;i<((int)nvar);i++) { 00334 if (xnorm<fabs(w1[i])) xnorm=fabs(w1[i]); 00335 if (difit<fabs(x[i]-w1[i])) difit=fabs(x[i]-w1[i]); 00336 x[i]=w1[i]; 00337 } 00338 00339 // Update the bound on the correction vector 00340 00341 if(delta<scale*xnorm) delta=scale*xnorm; 00342 00343 // Determine the progress of the iteration 00344 00345 bool lcv=(fnorm<fnorm1 && difit<difit1 && nsing==0); 00346 nier6++; 00347 nier7++; 00348 nier8++; 00349 if (lcv) nier6=0; 00350 if (fnorm<fnorm1 || difit<difit1) nier7=0; 00351 if (difit>eps*xnorm) nier8=0; 00352 00353 // Print iteration information 00354 00355 if (this->verbose>0) { 00356 print_iter(nvar,x,f,++it,fnorm,this->tolf,"cern_mroot"); 00357 } 00358 00359 // Tests for convergence 00360 00361 if (fnorm<=this->tolf) info=1; 00362 if (difit<=this->tolx*xnorm && lcv) info=2; 00363 if (fnorm<=this->tolf && info==2) info=3; 00364 if (info!=0) { 00365 00366 for(int ix=0;ix<((int)nvar);ix++) delete[] w[ix]; 00367 delete[] w; 00368 ao.free(f); 00369 ao.free(w0); 00370 ao.free(w1); 00371 ao.free(w2); 00372 00373 return 0; 00374 } 00375 00376 // Tests for termination 00377 00378 if (numf>=lmaxf) { 00379 info=4; 00380 set_err_ret("Too many iterations in cern_mroot::msolve().", 00381 gsl_emaxiter); 00382 } 00383 if (nsing==((int)nvar)) { 00384 info=5; 00385 set_err_ret("Jacobian matrix singular in cern_mroot::msolve().", 00386 gsl_esing); 00387 } 00388 if (nier6==5) { 00389 info=6; 00390 set_err_ret("No progress in cern_mroot::msolve().", 00391 gsl_enoprog); 00392 } 00393 if (nier7==3) { 00394 info=7; 00395 set_err_ret("Iterations diverging in cern_mroot::msolve().", 00396 gsl_erunaway); 00397 } 00398 if (nier8==4) { 00399 info=8; 00400 std::string s="Variable tolx too small, J singular, or bad "; 00401 s+="scaling in cern_mroot::msolve()."; 00402 set_err(s.c_str(),gsl_efailed); 00403 } 00404 if (numf>=lmaxf) info=4; 00405 if (nsing==((int)nvar)) info=5; 00406 if (nier6==5) info=6; 00407 if (nier7==3) info=7; 00408 if (nier8==4) info=8; 00409 00410 // Exit if necessary 00411 00412 if (info!=0) { 00413 00414 for(int ix=0;ix<((int)nvar);ix++) delete[] w[ix]; 00415 delete[] w; 00416 ao.free(f); 00417 ao.free(w0); 00418 ao.free(w1); 00419 ao.free(w2); 00420 00421 return gsl_efailed; 00422 } 00423 00424 if (!((!lcv) || difit>0.05*xnorm)) { 00425 00426 // Iterative refinement (if the iteration is converging) 00427 00428 for(int m=2;m<=mopt && bskip==false;m++) { 00429 fnorm1=fnorm; 00430 fnorm=0.0; 00431 for(k=0;k<((int)nvar) && bskip==false;k++) { 00432 iflag=k; 00433 00434 func(iflag,w1,f,pa); 00435 00436 fky=f[k]; 00437 nfcall++; 00438 numf=(int)(((double)nfcall)/((double)nvar)); 00439 00440 if (fnorm<fabs(fky)) fnorm=fabs(fky); 00441 00442 // Iterative refinement is terminated if it does not give a 00443 // reduction on residuals 00444 00445 if (fnorm>=fnorm1) { 00446 fnorm=fnorm1; 00447 bskip=true; 00448 } 00449 00450 if (!bskip) { 00451 double temp3=fky/w0[k]; 00452 00453 for(i=0;i<((int)nvar);i++) { 00454 w1[i]+=temp3*w[k][i]; 00455 } 00456 } 00457 } 00458 00459 if (!bskip) { 00460 00461 // Compute the norms of the iterate and correction vector 00462 00463 xnorm=0.0; 00464 difit=0.0; 00465 00466 for(i=0;i<((int)nvar);i++) { 00467 if (xnorm<fabs(w1[i])) xnorm=fabs(w1[i]); 00468 if (difit<fabs(x[i]-w1[i])) difit=fabs(x[i]-w1[i]); 00469 x[i]=w1[i]; 00470 } 00471 00472 // Stopping criteria for iterative refinement 00473 00474 if (fnorm<=this->tolf) info=1; 00475 if (difit<=xnorm*this->tolx) info=2; 00476 if (fnorm<=this->tolf && info==2) info=3; 00477 if (numf>=lmaxf && info==0) info=4; 00478 00479 if (info!=0) { 00480 00481 for(int ix=0;ix<((int)nvar);ix++) delete[] w[ix]; 00482 delete[] w; 00483 ao.free(f); 00484 ao.free(w0); 00485 ao.free(w1); 00486 ao.free(w2); 00487 00488 return 0; 00489 } 00490 } 00491 } 00492 } 00493 } 00494 00495 for(int ix=0;ix<((int)nvar);ix++) delete[] w[ix]; 00496 delete[] w; 00497 ao.free(f); 00498 ao.free(w0); 00499 ao.free(w1); 00500 ao.free(w2); 00501 00502 return 0; 00503 } 00504 00505 #ifndef DOXYGEN_INTERNAL 00506 00507 protected: 00508 00509 /// Internal storage for the value of \c info 00510 int info; 00511 00512 /// Store the number of function evaluations 00513 int mpt[289]; 00514 00515 #endif 00516 00517 }; 00518 00519 00520 #ifndef DOXYGENP 00521 } 00522 #endif 00523 00524 #endif 00525
Documentation generated with Doxygen and provided under the GNU Free Documentation License. See License Information for details.
Project hosting provided by
,
O2scl Sourceforge Project Page