00001 /* 00002 ------------------------------------------------------------------- 00003 00004 Copyright (C) 2006, 2007, 2008, 2009, 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_ROOT_H 00024 #define O2SCL_CERN_ROOT_H 00025 00026 #include <o2scl/root.h> 00027 00028 #ifndef DOXYGENP 00029 namespace o2scl { 00030 #endif 00031 00032 /** 00033 \brief One-dimensional root-finding routine (CERNLIB) 00034 00035 This class attempts to find \f$ x_1 \f$ and \f$ x_2 \f$ in \f$ 00036 [a,b] \f$ such that \f$ f(x_1) f(x_2) \leq 0 \f$, \f$ |f(x_1)| 00037 \leq|f(x_2)| \f$, and \f$ | x_1-x_2| \leq 00038 2~\mathrm{tolx}~(1+|x_0|) \f$. The function solve_bkt() requires 00039 inputs \c x1 and \c x2 such that \f$ f(x_1) f(x_2) \leq 0 \f$. 00040 00041 The variable cern_root::tolx defaults to \f$ 10^{-8} \f$ and 00042 cern_root::ntrial defaults to 200. 00043 \comment 00044 I'm not sure why I chose these values for tolx and ntrial above, 00045 as it doesn't seem to me that these values are suggested in 00046 CERNLIB. However, they're reasonable so I'll leave them in for 00047 now. 00048 \endcomment 00049 00050 The function solve_bkt() returns 0 for success, \ref gsl_einval 00051 if the root is not initially bracketed, and \ref gsl_emaxiter if 00052 the number of function evaluations is greater than 00053 cern_root::ntrial. 00054 00055 Based on the CERNLIB routines RZEROX and DZEROX, which was 00056 based on \ref Bus75 and is documented at 00057 http://wwwasdoc.web.cern.ch/wwwasdoc/shortwrupsdir/c200/top.html 00058 */ 00059 #ifdef DOXYGENP 00060 template<class param_t, class func_t=funct<param_t> > 00061 class cern_root : public root_bkt 00062 #else 00063 template<class param_t, class func_t=funct<param_t> > 00064 class cern_root : public root_bkt<param_t,func_t> 00065 #endif 00066 { 00067 00068 #ifndef DOXYGEN_INTERNAL 00069 00070 protected: 00071 00072 /** 00073 \brief Internal storage for the mode 00074 00075 This internal variable is actually defined to be smaller by 00076 1 than the "mode" as it is defined in the CERNLIB 00077 documentation in order to avoid needless subtraction in 00078 solve_bkt(). 00079 */ 00080 int mode; 00081 00082 /// FORTRAN-like function for sign 00083 inline double sign(double a, double b) { 00084 if (b>=0.0) return fabs(a); 00085 return -fabs(a); 00086 } 00087 00088 friend class io_tlate<cern_root>; 00089 00090 #endif 00091 00092 public: 00093 00094 cern_root() 00095 { 00096 mode=0; 00097 this->tolx=1.0e-8; 00098 this->ntrial=200; 00099 } 00100 00101 /** 00102 \brief Set mode of solution (1 or 2) 00103 00104 - \c 1 should be used for simple functions where the cost is 00105 inexpensive in comparison to one iteration of solve_bkt(), 00106 or functions which have a pole near the root (this is the 00107 default). 00108 - \c 2 should be used for more time-consuming functions. 00109 00110 If an integer other than \c 1 or \c 2 is specified, \c 1 is 00111 assumed. 00112 00113 */ 00114 int set_mode(int m) { 00115 if (m!=1 && m!=2) { 00116 mode=0; 00117 O2SCL_ERR_RET("Invalid mode in cern_root::set_mode().", 00118 o2scl::gsl_einval); 00119 } 00120 mode=m-1; 00121 return 0; 00122 } 00123 00124 /// Return the type, \c "cern_root". 00125 virtual const char *type() { return "cern_root"; } 00126 00127 /** \brief Solve \c func in region \f$ x_1<x<x_2 \f$ returning 00128 \f$ x_1 \f$. 00129 00130 The parameters \c x1 and \c x2 should be set so that \f$ 00131 f(x_1) f(x_2) \leq 0 \f$ before calling solve_bkt(). If this 00132 is not the case, the error handler will be called and 00133 the solver will fail. 00134 00135 This function converges unless the number of iterations is 00136 larger than root::ntrial, in which case root::last_conv is 00137 set to \ref gsl_emaxiter and the error handler is called if 00138 root::err_nonconv is true. 00139 */ 00140 virtual int solve_bkt(double &x1, double x2, param_t &pa, 00141 func_t &func) 00142 { 00143 00144 double im1[2]={2.0,3.0}, im2[2]={-1.0,3.0}, c=0.0, fa, fb; 00145 double atl, a, b, mft; 00146 double fc=0.0, d=0.0, fd=0.0, tol, h, hb, w, p, q, fdb, fda, f=0.0; 00147 bool lmt[2]; 00148 int ie=0, loop, mf; 00149 char ch; 00150 this->last_conv=0; 00151 00152 func(x1,fb,pa); 00153 func(x2,fa,pa); 00154 00155 if (fa*fb>0.0) { 00156 O2SCL_ERR_RET 00157 ("Endpoints don't bracket function in cern_root::solve_bkt().", 00158 o2scl::gsl_einval); 00159 } 00160 00161 atl=fabs(this->tolx); 00162 b=x1; 00163 a=x2; 00164 lmt[1]=true; 00165 mf=2; 00166 loop=1; 00167 do { 00168 if (loop==1) { 00169 c=a; 00170 fc=fa; 00171 ie=0; 00172 } else if (loop==2) { 00173 ie=0; 00174 } 00175 if (fabs(fc)<fabs(fb)) { 00176 if (c!=a) { 00177 d=a; 00178 fd=fa; 00179 } 00180 a=b; 00181 b=c; 00182 c=a; 00183 fa=fb; 00184 fb=fc; 00185 fc=fa; 00186 } 00187 tol=atl*(1.0+fabs(c)); 00188 h=0.5*(c+b); 00189 hb=h-b; 00190 00191 if (this->verbose>0) { 00192 this->print_iter(c,fc,mf-2,fabs(hb),tol,"cern_root"); 00193 } 00194 00195 if (fabs(hb)>tol) { 00196 if (ie>im1[mode]) { 00197 w=hb; 00198 } else { 00199 tol*=sign(1.0,hb); 00200 p=(b-a)*fb; 00201 lmt[0]=(ie<=1); 00202 if (lmt[mode]) { 00203 q=fa-fb; 00204 lmt[1]=false; 00205 } else { 00206 fdb=(fd-fb)/(d-b); 00207 fda=(fd-fa)/(d-a); 00208 p*=fda; 00209 q=fdb*fa-fda*fb; 00210 } 00211 if (p<0.0) { 00212 p=-p; 00213 q=-q; 00214 } 00215 if (ie==im2[mode]) p+=p; 00216 if (p==0.0 || p<=q*tol) { 00217 w=tol; 00218 } else if (p<hb*q) { 00219 w=p/q; 00220 } else { 00221 w=hb; 00222 } 00223 } 00224 d=a; 00225 a=b; 00226 fd=fa; 00227 fa=fb; 00228 b+=w; 00229 mf++; 00230 if (mf>this->ntrial) { 00231 this->last_conv=gsl_emaxiter; 00232 if (this->err_nonconv) { 00233 O2SCL_ERR_RET 00234 ("Too many function calls in cern_root::solve_bkt().", 00235 gsl_emaxiter); 00236 } else { 00237 return gsl_emaxiter; 00238 } 00239 } 00240 00241 func(b,fb,pa); 00242 00243 if (fb==0.0 || sign(1.0,fc)==sign(1.0,fb)) { 00244 loop=1; 00245 } else if (w==hb) { 00246 loop=2; 00247 } else { 00248 ie++; 00249 loop=3; 00250 } 00251 } else { 00252 loop=0; 00253 } 00254 } while (loop>0); 00255 x1=c; 00256 this->last_ntrial=mf; 00257 return o2scl::gsl_success; 00258 } 00259 00260 }; 00261 00262 #ifndef DOXYGENP 00263 template<> int io_tlate<cern_root<int,funct<int> > >::input 00264 (cinput *co, in_file_format *ins, cern_root<int, funct<int> > *ro); 00265 template<> int io_tlate<cern_root<int,funct<int> > >::output 00266 (coutput *co, out_file_format *outs, 00267 cern_root<int, funct<int> > *ro); 00268 template<> const char *io_tlate<cern_root<int,funct<int> > >::type(); 00269 #endif 00270 00271 typedef io_tlate<cern_root<int,funct<int> > > cern_root_io_type; 00272 00273 #ifndef DOXYGENP 00274 } 00275 #endif 00276 00277 #endif
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