/************************************************************ general_newton_raphson(): -- performs Newton-Rapshon method on an arbitrary system. -- inspired in part by Num. Rec.'s routine newt(); Arguements: -- x[] = set of independent variables to solve for; -- n = number of independent variables and residuals; -- funcd = name of function that calculates residuals, etc.; *****************************************************************/ static int general_newton_raphson( FTYPE x[], int n, void (*funcd) (FTYPE [], FTYPE [], FTYPE [], FTYPE [][NEWT_DIM], FTYPE *, FTYPE *, int) ) { FTYPE f, df, dx[NEWT_DIM], x_old[NEWT_DIM], resid[NEWT_DIM], jac[NEWT_DIM][NEWT_DIM]; FTYPE errx, x_orig[NEWT_DIM]; int n_iter, id, jd, i_extra, doing_extra; FTYPE dW,dvsq,vsq_old,vsq,W,W_old, rho,p,u; int keep_iterating; // Initialize various parameters and variables: errx = 1. ; df = f = 1.; i_extra = doing_extra = 0; for( id = 0; id < n ; id++) x_old[id] = x_orig[id] = x[id] ; vsq_old = vsq = W = W_old = 0.; n_iter = 0; /* Start the Newton-Raphson iterations : */ keep_iterating = 1; while( keep_iterating ) { (*funcd) (x, dx, resid, jac, &f, &df, n); /* returns with new dx, f, df */ /* Save old values before calculating the new: */ errx = 0.; for( id = 0; id < n ; id++) { x_old[id] = x[id] ; } for( id = 0; id < n ; id++) { x[id] += dx[id] ; } /****************************************/ /* Make sure that the new x[] is physical : */ /****************************************/ // METHOD specific validate_x( x, x_old ); /****************************************/ /* Calculate the convergence criterion */ /****************************************/ /* For the new criterion, always look at error in "W" : */ // METHOD specific W_old = W; W = W_of_vsq( x[0], &p, &rho, &u); errx = (W==0.) ? fabs(W-W_old) : fabs((W-W_old)/W); errx += (x[0]==0.) ? fabs(x[0]-x_old[0]) : fabs((x[0]-x_old[0])/x[0]); // fprintf(stderr,"NR: %26.20e %26.20e %26.20e %26.20e %26.20e \n", x_old[0], x[0], resid[0], jac[0][0], errx); // fflush(stderr); /*****************************************************************************/ /* If we've reached the tolerance level, then just do a few extra iterations */ /* before stopping */ /*****************************************************************************/ if( (fabs(errx) <= NEWT_TOL) && (doing_extra == 0) && (EXTRA_NEWT_ITER > 0) ) { doing_extra = 1; } if( doing_extra == 1 ) i_extra++ ; // See if we've done the extra iterations, or have done too many iterations: if( ((fabs(errx) <= NEWT_TOL)&&(doing_extra == 0)) || (i_extra > EXTRA_NEWT_ITER) || (n_iter >= (MAX_NEWT_ITER-1)) ) { keep_iterating = 0; } n_iter++; } // END of while(keep_iterating) /* Check for bad untrapped divergences : */ if( (finite(f)==0) || (finite(df)==0) ) { return(2); } // Return in different ways depending on whether a solution was found: if( fabs(errx) > MIN_NEWT_TOL){ #if(LTRACE) fprintf(stderr," totalcount = %d 0 %d %26.20e \n",n_iter,i_extra,errx); fflush(stderr); #endif return(1); } if( (fabs(errx) <= MIN_NEWT_TOL) && (fabs(errx) > NEWT_TOL) ){ //fprintf(stderr," totalcount = %d 1 %d %26.20e \n",n_iter,i_extra,errx); fflush(stderr); return(0); } if( fabs(errx) <= NEWT_TOL ){ //fprintf(stderr," totalcount = %d 2 %d %26.20e \n",n_iter,i_extra,errx); fflush(stderr); return(0); } return(0); }
static int general_newton_raphson_omp( FTYPE x[], int n, void (*funcd) (FTYPE [], FTYPE [], FTYPE [], FTYPE [][NEWT_DIM], FTYPE *, FTYPE *, int, FTYPE, FTYPE, FTYPE, FTYPE, FTYPE), FTYPE local_Bsq, FTYPE local_QdotBsq, FTYPE local_Qtsq, FTYPE local_Qdotn, FTYPE local_D ) { FTYPE f, df, dx[NEWT_DIM], x_old[NEWT_DIM]; FTYPE resid[NEWT_DIM], jac[NEWT_DIM][NEWT_DIM]; FTYPE errx, x_orig[NEWT_DIM]; int n_iter, id, jd, i_extra, doing_extra; FTYPE dW,dvsq,vsq_old,vsq,W,W_old; int keep_iterating; // Initialize various parameters and variables: errx = 1. ; df = f = 1.; i_extra = doing_extra = 0; for( id = 0; id < n ; id++) x_old[id] = x_orig[id] = x[id] ; vsq_old = vsq = W = W_old = 0.; n_iter = 0; /* Start the Newton-Raphson iterations : */ keep_iterating = 1; while( keep_iterating ) { //(*funcd) (x, dx, resid, jac, &f, &df, n); /* returns with new dx, f, df */ (*funcd) (x, dx, resid, jac, &f, &df, n, local_Bsq, local_QdotBsq, local_Qtsq, local_Qdotn, local_D); /* returns with new dx, f, df */ /* Save old values before calculating the new: */ errx = 0.; for( id = 0; id < n ; id++) { x_old[id] = x[id] ; } /* Make the newton step: */ for( id = 0; id < n ; id++) { x[id] += dx[id] ; } /****************************************/ /* Calculate the convergence criterion */ /****************************************/ errx = (x[0]==0.) ? fabs(dx[0]) : fabs(dx[0]/x[0]); /****************************************/ /* Make sure that the new x[] is physical : */ /****************************************/ validate_x( x, x_old ) ; /*****************************************************************************/ /* If we've reached the tolerance level, then just do a few extra iterations */ /* before stopping */ /*****************************************************************************/ if( (fabs(errx) <= NEWT_TOL) && (doing_extra == 0) && (EXTRA_NEWT_ITER > 0) ) { doing_extra = 1; } if( doing_extra == 1 ) i_extra++ ; if( ((fabs(errx) <= NEWT_TOL)&&(doing_extra == 0)) || (i_extra > EXTRA_NEWT_ITER) || (n_iter >= (MAX_NEWT_ITER-1)) ) { keep_iterating = 0; } n_iter++; } // END of while(keep_iterating) /* Check for bad untrapped divergences : */ if( (finite(f)==0) || (finite(df)==0) ) { return(2); } if( fabs(errx) > MIN_NEWT_TOL){ return(1); } if( (fabs(errx) <= MIN_NEWT_TOL) && (fabs(errx) > NEWT_TOL) ){ return(0); } if( fabs(errx) <= NEWT_TOL ){ return(0); } return(0); }
/************************************************************ general_newton_raphson(): -- performs Newton-Rapshon method on an arbitrary system. -- inspired in part by Num. Rec.'s routine newt(); *****************************************************************/ static int general_newton_raphson( FTYPE x[], int n, void (*funcd) (FTYPE [], FTYPE [], FTYPE *, FTYPE *, int) ) { FTYPE f, f_old, df, df_old, dx[NEWT_DIM], dx_old[NEWT_DIM], x_old[NEWT_DIM], errx, errx_old, errx_oldest; int n_iter, id,numdamped,allowdamp, numstable; FTYPE dampfactor, randtmp, xtmp; const int ltrace = 0; const int ltrace2 = 0; int is_nan_inf( FTYPE x ); dampfactor=1.0; errx = 1. ; errx_old = 2.; df = df_old = f = f_old = 1.; numstable = numdamped = 0; allowdamp = 1; n_iter = 0; while ( ( errx > NEWT_TOL ) && (n_iter < MAX_NEWT_ITER) ) { (*funcd) (x, dx, &f, &df, n); /* returns with new dx, f, df */ /* Check for bad untrapped divergences : */ xtmp = 0.; for( id = 0; id < n ; id++) xtmp += dx[id] ; if( is_nan_inf( f ) || is_nan_inf( df ) || is_nan_inf( xtmp ) ) return(2); if( dodamp && ( f >= f_old + alpha_newt*df*dampfactor ) && (allowdamp) && (dampfactor > dampfactor_min) && (n_iter >= preiterdamp) ){ /* Reduce stepsize and try again */ dampfactor *= dampfactorchange; /* Reset x */ for( id = 0; id < n ; id++) x[id] = x_old[id] ; numdamped++; n_iter--; if( numdamped >= numdampedtot ){ allowdamp=0; numdamped=0; numstable=0;} if( ltrace ) { fprintf(stderr,"general_newton_raphson(): f_old = %21.15g , f = %21.15g , dampfactor = %21.15g \n",f_old, f,dampfactor); fflush(stderr); } } else{ /* Normal Newton-Raphson step with damped stepsize */ if( dodamp ) { if(allowdamp==0) numstable++; if(allowdamp) numdamped++; // coming here counts as a general damped run if(numstable>=numstabletot){ allowdamp=1; numdamped=0; numstable=0;} if(numdamped>=numdampedtot){ allowdamp=0; numdamped=0; numstable=0;} } if( ((n_iter+1) % CYCLE_BREAK_PERIOD) == 0 ) { randtmp = ( (1.*rand())/(1.*RAND_MAX) ); for( id = 0; id < n ; id++) dx[id] *= randtmp; // for( id = 0; id < n ; id++) dx[id] *= ( (1.*rand())/(1.*RAND_MAX) ); } errx_oldest = errx_old; errx_old = errx; errx = 0.; for( id = 0; id < n ; id++) { x_old[id] = x[id] ; x[id] += dx[id] * dampfactor ; errx += (x[id]==0.) ? fabs(dx[id]) : fabs(dx[id]/x[id]); } errx /= 1.*n; validate_x( x, x_old, 3 ) ; #if( CHECK_FOR_STALL ) if( ( (errx_old == errx) || (errx_oldest == errx) ) && (errx < MIN_NEWT_TOL) ) errx = -errx; #endif if( ltrace ) { fprintf(stderr," general_newton_raphson(): niter = %d , f_old = %21.15g , f = %21.15g , errx_old = %21.15g , errx = %21.15g\n", n_iter,f_old,f,errx_old,errx ); fflush(stderr); } for( id = 0; id < n ; id++) dx_old[id] = dx[id] ; f_old = f; df_old = df; } n_iter++; nstroke++; // lntries++; } if (n_iter >= MAX_NEWT_ITER) { if( errx > MIN_NEWT_TOL){ if(ltrace2) { fprintf(stdout," totalcount = %d 0 \n",n_iter); fflush(stdout); } if(ltrace) { fprintf(stderr,"general_newton_raphson(): did not find solution \n"); fflush(stderr); } return(1); } else { if(ltrace2) { fprintf(stdout," totalcount = %d 1 \n",n_iter); fflush(stdout); } if(ltrace) { fprintf(stderr,"general_newton_raphson(): found minimal solution \n"); fflush(stderr); } return(0); } } else { if(ltrace2) { fprintf(stdout," totalcount = %d 2 \n",n_iter); fflush(stdout); } return(0); } }
/************************************************************ general_newton_raphson(): -- performs Newton-Rapshon method on an arbitrary system. -- inspired in part by Num. Rec.'s routine newt(); *****************************************************************/ static int general_newton_raphson( FTYPE x[], int n, int do_line_search, void (*funcd) (FTYPE [], FTYPE [], FTYPE [], FTYPE [][NEWT_DIM], FTYPE *, FTYPE *, int), FTYPE (*res_func) (FTYPE []) ) { FTYPE f, f_old, df, df_old, dx[NEWT_DIM], dx_old[NEWT_DIM], x_old[NEWT_DIM], resid[NEWT_DIM], jac[NEWT_DIM][NEWT_DIM]; FTYPE errx, errx_old, errx_oldest, x_orig[NEWT_DIM]; int n_iter, id, jd, i_extra, doing_extra; FTYPE randtmp, tmp; FTYPE dW,dvsq,vsq_old,vsq,W,W_old; FTYPE resid_norm, resid_check, grad_check; FTYPE res_func_val, res_func_old, res_func_new; FTYPE dn[NEWT_DIM], del_f[NEWT_DIM]; static void my_lnsrch(int, FTYPE [], FTYPE, FTYPE [], FTYPE [], FTYPE [], FTYPE *, FTYPE, FTYPE, int *, FTYPE (*res_func) (FTYPE [])); static void bin_newt_data( FTYPE errx, int niters, int conv_type, int print_now ) ; int keep_iterating, i_increase, retval2,retval = 0; const int ltrace = 0; const int ltrace2 = 1; retval = 0; errx = 1. ; errx_old = 2.; df = df_old = f = f_old = 1.; i_extra = doing_extra = 0; for( id = 0; id < n ; id++) x_old[id] = x_orig[id] = x[id] ; vsq_old = vsq = W = W_old = 0.; n_iter = 0; /* Start the Newton-Raphson iterations : */ keep_iterating = 1; while( keep_iterating ) { nstroke++; lntries++; (*funcd) (x, dx, resid, jac, &f, &df, n); /* returns with new dx, f, df */ #if(!OPTIMIZED) /* Check for bad untrapped divergences : */ if( (finite(f)==0) || (finite(df)==0) ) { if( debugfail >= 2 ) { dualfprintf(fail_file,"general_newton_raphson(): nan encountered in f or df!! \n"); dualfprintf(fail_file,"gnr nan(): f, df, x0, dx0 = %21.15g %21.15g %21.15g %21.15g \n", f,df,x[0],dx[0]); } return(1); } #endif #if(!OPTIMIZED) /* Randomly rescale Newton step to break out of iteration cycles: */ if( ((n_iter+1) % CYCLE_BREAK_PERIOD) == 0 ) { randtmp = ( (1.*rand())/(1.*RAND_MAX) ); for( id = 0; id < n ; id++) dx[id] *= randtmp; // for( id = 0; id < n ; id++) dx[id] *= ( (1.*rand())/(1.*RAND_MAX) ); } #endif /* Save old values before calculating the new: */ errx_oldest = errx_old; errx_old = errx; lerrx=errx; errx = 0.; f_old = f; for( id = 0; id < n ; id++) { x_old[id] = x[id] ; } /* Make the newton step: */ if( do_line_search == 1 ) { /* Compare the residual to its initial value */ if( n_iter == 0 ) { resid_norm = 0.0e0; for( id = 0; id < n ; id++) { resid_norm += fabs(resid[id]); } resid_norm /= 1.0*n ; if( resid_norm == 0.0 ) resid_norm = 1.0; } for( id = 0; id < n ; id++) { tmp = 0.; for( jd = 0; jd < n ; jd++) { tmp += jac[jd][id] * resid[jd]; } del_f[id] = tmp; } for( id = 0; id < n ; id++) { dn[id] = dx[id]; } my_lnsrch(n, x_old-1, f_old, del_f-1, dn-1, x-1, &f, TOL_LINE_STEP, SCALEMAX, &retval, res_func); /* dx is needed for errx calculation below: */ for( id = 0; id < n ; id++) { dx[id] = x[id] - x_old[id]; } #if(!OPTIMIZED) if( ltrace ) { res_func_val = res_func(x); res_func_old = res_func(x_old); dualfprintf(fail_file,"gnr(): f_old, f, res_func_old, res_func_val = %21.15g %21.15g %21.15g %21.15g \n", f_old, f, res_func_old, res_func_val ); dualfprintf(fail_file,"gnr(): x_old = "); for( id = 0; id < n ; id++) { dualfprintf(fail_file," %21.15g ",x_old[id]); } dualfprintf(fail_file,"\n "); dualfprintf(fail_file,"gnr(): x = "); for( id = 0; id < n ; id++) { dualfprintf(fail_file," %21.15g ",x[id]); } dualfprintf(fail_file,"\n "); dualfprintf(fail_file,"gnr(): dn = "); for( id = 0; id < n ; id++) { dualfprintf(fail_file," %21.15g ",dn[id]); } dualfprintf(fail_file,"\n "); dualfprintf(fail_file,"gnr(): del_f = "); for( id = 0; id < n ; id++) { dualfprintf(fail_file," %21.15g ",del_f[id]); } dualfprintf(fail_file,"\n "); } #endif /* Check to see if line search problem is because the residual vector is already small enough */ if( retval == 1 ) { resid_check = 0.0e0; for( id = 0; id < n ; id++) { resid_check += fabs(resid[id]); } resid_check /= 1.0*n; if( resid_check <= resid_norm * NEWT_FUNC_TOL ) { retval = 0; } if( ltrace && retval ) { dualfprintf(fail_file,"general_newton_raphson(): retval, resid_check = %4i %21.15g \n",retval, resid_check); } } /* If initial Newton step is bad, then try again without line searching: */ if( (retval == 2) && (USE_LINE_SEARCH == do_line_search) ) { #if(!OPTIMIZED) if( ltrace ) { dualfprintf(fail_file,"gnr(): bad first step: retval, f_old, f = %4i %21.15g %21.15g \n",retval,f_old,f); dualfprintf(fail_file,"gnr: doing recursive call, retval, errx = %4i %21.15g \n", retval, errx ); } #endif retval = general_newton_raphson( x_orig, n, ((do_line_search+1)%2), funcd, res_func ); for( id = 0; id < n ; id++) x[id] = x_orig[id] ; return( retval ); } /* Check to see if it is trapped in a local minimum, i.e. gradient is too small */ if( retval == 1 ) { grad_check = 0.0e0; for( id = 0; id < n ; id++) { resid_check = (x[id] == 0.) ? 1.0 : fabs(x[id]) ; grad_check += del_f[id] * resid_check ; } resid_check = (f == 0.) ? 1.0 : fabs(f) ; grad_check /= resid_check; /* Then we've most likely found a solution: */ if( grad_check > GRADMIN ) { retval = -1; } else if( ltrace ) { dualfprintf(fail_file,"general_newton_raphson(): retval, grad_check = %4i %21.15g \n",retval, grad_check); } } } else { /* don't use line search : */ for( id = 0; id < n ; id++) { x[id] += dx[id] ; } } /* End of "to do line search or not to do line search..." */ /****************************************/ /* Calculate the convergence criterion */ /****************************************/ /* For the new criterion, always look at error in "W" : */ // METHOD specific: #if( NEWCONVERGE == 1 ) errx = (x[0]==0.) ? fabs(dx[0]) : fabs(dx[0]/x[0]); /* For the old criterion, look at errors in each indep. variable(s) (except for 5D) : */ #else for( id = 0; id < n ; id++) { errx += (x[id]==0.) ? fabs(dx[id]) : fabs(dx[id]/x[id]); } errx /= 1.*n; #endif /****************************************/ /* Make sure that the new x[] is physical : */ /****************************************/ // METHOD specific: validate_x( x, x_old ) ; /****************************************/ /* Check to see if we're in a infinite loop with error function: */ /****************************************/ #if( CHECK_FOR_STALL ) if( ( (errx_old == errx) || (errx_oldest == errx) ) && (errx <= MIN_NEWT_TOL) ) errx = -errx; #endif /****************************************/ /* If there's a problem with line search, then stop iterating: */ /****************************************/ if( (retval == 1) || (retval == -1) ) errx = -errx; #if(!OPTIMIZED) if( ltrace ) { dualfprintf(fail_file," general_newton_raphson(): niter,f_old,f,errx_old,errx = %4i %21.15g %21.15g %21.15g %21.15g\n", n_iter,f_old,f,errx_old,errx ); dualfprintf(fail_file,"gnr(): x_old = "); for( id = 0; id < n ; id++) { dualfprintf(fail_file," %21.15g ",x_old[id]); } dualfprintf(fail_file,"\n "); dualfprintf(fail_file,"gnr(): x = "); for( id = 0; id < n ; id++) { dualfprintf(fail_file," %21.15g ",x[id]); } dualfprintf(fail_file,"\n "); dualfprintf(fail_file,"gnr(): dx = "); for( id = 0; id < n ; id++) { dualfprintf(fail_file," %21.15g ",dx[id]); } dualfprintf(fail_file,"\n "); } #endif /****************************************/ /* Prepare for the next iteration, set the "old" variables: */ /****************************************/ for( id = 0; id < n ; id++) dx_old[id] = dx[id] ; f_old = f; df_old = df; /****************************************/ /* If we've reached the tolerance level, then just do a few extra iterations before stopping */ /****************************************/ if( (fabs(errx) <= NEWT_TOL) && (doing_extra == 0) && (EXTRA_NEWT_ITER > 0) ) { doing_extra = 1; } if( doing_extra == 1 ) i_extra++ ; if( ((fabs(errx) <= NEWT_TOL)&&(doing_extra == 0)) || (i_extra > EXTRA_NEWT_ITER) || (n_iter >= (MAX_NEWT_ITER-1)) ) { keep_iterating = 0; } n_iter++; #if(CRAZYDEBUG) if(icurr==0 && jcurr==31 && nstep==9 && steppart==2){ dualfprintf(fail_file,"n_iter=%d errx=%21.15g %21.15g\n",n_iter,errx,MIN_NEWT_TOL); } #endif } // END of while(keep_iterating) /* Check for bad untrapped divergences : */ if( (finite(f)==0) || (finite(df)==0) || (finite(x[0])==0) || (finite(x[1])==0)) { #if(!OPTIMIZED) if( debugfail >= 2 ) { dualfprintf(fail_file,"general_newton_raphson(): nan encountered in f or df!! \n"); dualfprintf(fail_file,"gnr nan(): f, df, x0, dx0 = %21.15g %21.15g %21.15g %21.15g \n", f,df,x[0],dx[0]); } #endif return(1); } if( fabs(errx) > MIN_NEWT_TOL){ if( (do_line_search != USE_LINE_SEARCH) || (USE_LINE_SEARCH < 0) ) { #if(DOHISTOGRAM) bin_newt_data( errx, n_iter, 0, 0 ); #endif #if(!OPTIMIZED) if(ltrace2) { dualfprintf(fail_file," totalcount = %d 0 %d %d %d %21.15g \n",n_iter,retval,do_line_search,i_extra,errx); } if(ltrace) { dualfprintf(fail_file,"general_newton_raphson(): did not find solution \n"); if( retval == -1 ) { dualfprintf(fail_file,"general_newton_raphson(): lnsrch converged: x = "); for( id = 0; id < n ; id++) dualfprintf(fail_file," %21.15g ",x[id]); dualfprintf(fail_file,"\n"); dualfprintf(fail_file,"general_newton_raphson(): lnsrch converged: x_old = "); for( id = 0; id < n ; id++) dualfprintf(fail_file," %21.15g ",x_old[id]); dualfprintf(fail_file,"\n"); } } // dualfprintf(fail_file,"gnr retval2 = %4i \n", 1); #endif return(1); } else { /* If bad return and we tried line searching, try it without before giving up: */ // dualfprintf(fail_file,"gnr: doing recursive call, do_line_search, retval, errx = %4i %4i %21.15g \n", do_line_search, retval, errx ); // retval2 = general_newton_raphson( x_orig, n, ((do_line_search+1)%2), funcd, res_func ); for( id = 0; id < n ; id++) x[id] = x_orig[id] ; // dualfprintf(fail_file,"gnr retval3 = %4i \n", retval2); return( retval2 ); } } if( (fabs(errx) <= MIN_NEWT_TOL) && (fabs(errx) > NEWT_TOL) ){ #if(DOHISTOGRAM) bin_newt_data( errx, n_iter, 1, 0 ); #endif #if(!OPTIMIZED) if(ltrace2) { dualfprintf(fail_file," totalcount = %d 1 %d %d %d %21.15g \n",n_iter,retval,do_line_search,i_extra,errx); } if(ltrace) { dualfprintf(fail_file,"general_newton_raphson(): found minimal solution \n"); } // dualfprintf(fail_file,"gnr retval4 = %4i \n", 0); #endif return(0); } if( fabs(errx) <= NEWT_TOL ){ #if(DOHISTOGRAM) bin_newt_data( errx, n_iter, 2, 0 ); #endif #if(!OPTIMIZED) if(ltrace2) { dualfprintf(fail_file," totalcount = %d 2 %d %d %d %21.15g \n",n_iter,retval,do_line_search,i_extra, errx); } // dualfprintf(fail_file,"gnr retval5 = %4i \n", 0); #endif return(0); } #if(!OPTIMIZED) dualfprintf(fail_file,"gnr retval6 = %4i \n", 0); #endif return(0); }
/************************************************************ general_newton_raphson(): -- performs Newton-Rapshon method on an arbitrary system. -- inspired in part by Num. Rec.'s routine newt(); *****************************************************************/ static int general_newton_raphson( FTYPE x[], int n, void (*funcd) (FTYPE [], FTYPE [], FTYPE [], FTYPE [][NEWT_DIM], FTYPE *, FTYPE *, int) ) { FTYPE f, df, dx[NEWT_DIM], x_old[NEWT_DIM]; FTYPE resid[NEWT_DIM], jac[NEWT_DIM][NEWT_DIM]; FTYPE errx, x_orig[NEWT_DIM]; int n_iter, id, jd, i_extra, doing_extra; FTYPE dW,dvsq,vsq_old,vsq,W,W_old; int keep_iterating; // Initialize various parameters and variables: errx = 1. ; df = f = 1.; i_extra = doing_extra = 0; for( id = 0; id < n ; id++) x_old[id] = x_orig[id] = x[id] ; vsq_old = vsq = W = W_old = 0.; n_iter = 0; /* Start the Newton-Raphson iterations : */ keep_iterating = 1; while( keep_iterating ) { (*funcd) (x, dx, resid, jac, &f, &df, n); /* returns with new dx, f, df */ /* Save old values before calculating the new: */ errx = 0.; for( id = 0; id < n ; id++) { x_old[id] = x[id] ; } /* Make the newton step: */ for( id = 0; id < n ; id++) { x[id] += dx[id] ; } /****************************************/ /* Calculate the convergence criterion */ /****************************************/ errx = (x[0]==0.) ? fabs(dx[0]) : fabs(dx[0]/x[0]); //if 2D method, make sure both W and vsq converge //this is important in non-relativistic flows where //vsq could be << 1 if( n > 1 ) { errx += (x[1]==0.) ? fabs(dx[1]) : fabs(dx[1]/x[1]); } /****************************************/ /* Make sure that the new x[] is physical : */ /****************************************/ validate_x( x, x_old ) ; /*****************************************************************************/ /* If we've reached the tolerance level, then just do a few extra iterations */ /* before stopping */ /*****************************************************************************/ if( (fabs(errx) <= NEWT_TOL) && (doing_extra == 0) && (EXTRA_NEWT_ITER > 0) ) { doing_extra = 1; } if( doing_extra == 1 ) i_extra++ ; if( ((fabs(errx) <= NEWT_TOL)&&(doing_extra == 0)) || (i_extra > EXTRA_NEWT_ITER) || (n_iter >= (MAX_NEWT_ITER-1)) ) { keep_iterating = 0; } n_iter++; } // END of while(keep_iterating) /* Check for bad untrapped divergences : */ if( (finite(f)==0) || (finite(df)==0) ) { // fprintf(stderr,"failure, untrapped divergences, %g %g %g %g \n", f, df, x, dx); return(2); } if( fabs(errx) > MIN_NEWT_TOL){ return(1); // fprintf(stderr,"failure, tolerance not reached \n"); } if( (fabs(errx) <= MIN_NEWT_TOL) && (fabs(errx) > NEWT_TOL) ){ return(0); } if( fabs(errx) <= NEWT_TOL ){ return(0); } return(0); }
static void my_lnsrch( int n, FTYPE xold[], FTYPE fold, FTYPE g[], FTYPE p[], FTYPE x[], FTYPE *f, FTYPE TOLX, FTYPE stpmax, int *check, FTYPE (*func) (FTYPE []) ) { int i; FTYPE a,alam,alam2,alamin,b,disc,f2,fold2,rhs1,rhs2,slope,sum,temp,test,tmplam; int icount=0; int bad_step; FTYPE bad_step_factor = 2.0; const int ltrace = 0; *check=0; for (sum=0.0,i=1;i<=n;i++) sum += p[i]*p[i]; sum=sqrt(sum); if (sum > stpmax) for (i=1;i<=n;i++) p[i] *= stpmax/sum; for (slope=0.0,i=1;i<=n;i++) slope += g[i]*p[i]; test=0.0; for (i=1;i<=n;i++) { // temp=fabs(p[i])/max(fabs(xold[i]),1.0); temp= (xold[i] == 0.) ? fabs(p[i]) : fabs(p[i]/xold[i]); if (temp > test) test=temp; } alamin=TOLX/test; #if(!OPTIMIZED) if( ltrace ) { dualfprintf(fail_file,"my_lnsrch(): sum, slope, test, alamin = %21.15g %21.15g %21.15g %21.15g \n",sum,slope,test,alamin); } #endif alam=1.0; for (;;) { for (i=1;i<=n;i++) x[i]=xold[i]+alam*p[i]; // METHOD specific: validate_x( (x+1), (xold+1) ); *f=(*func)(x+1); bad_step = 0; if( finite(*f)==0 ) { bad_step = 1; } // if( bad_step ) alam /= bad_step_factor; // if (alam < alamin) bad_step = 0; if( bad_step ) { *check = 2; #if(!OPTIMIZED) dualfprintf(fail_file,"my_lnsrch(): bad_step = 1, f = %21.15g , alam = %21.15g \n", *f, alam); for( i = 1; i <= n; i++ ) { dualfprintf(fail_file,"my_lnsrch(): (xold[%d], x[%d], p[%d]) = %21.15g , %21.15g , %21.15g \n", i,i,i, xold[i],x[i],p[i]); } #endif return; } if (alam < alamin) { for (i=1;i<=n;i++) x[i]=xold[i]; *check=1; #if(!OPTIMIZED) if( ltrace ) { dualfprintf(fail_file,"my_lnsrch(): alam < alamin: alam, alamin = %21.15g %21.15g \n", alam,alamin); } #endif return; } else if (*f <= fold+ALF*alam*slope) { #if(!OPTIMIZED) if( ltrace ) { dualfprintf(fail_file,"my_lnsrch(): good exit: alam, alamin, f, fold = %21.15g %21.15g %21.15g %21.15g \n", alam,alamin, *f, fold); } #endif return; } else { if (alam == 1.0) { tmplam = -slope/(2.0*(*f-fold-slope)); #if(!OPTIMIZED) if( ltrace ) { dualfprintf(fail_file,"my_lnsrch(): setting tmplam!! tmplam, alam = %21.15g %21.15g !!\n", tmplam, alam); } #endif } else { rhs1 = *f-fold-alam*slope; rhs2=f2-fold2-alam2*slope; a=(rhs1/(alam*alam)-rhs2/(alam2*alam2))/(alam-alam2); b=(-alam2*rhs1/(alam*alam)+alam*rhs2/(alam2*alam2))/(alam-alam2); if (a == 0.0) tmplam = -slope/(2.0*b); else { disc=b*b-3.0*a*slope; if (disc<0.0) { #if(!OPTIMIZED) if( disc < -1.e-10 ) { if( ltrace ) dualfprintf(fail_file,"my_lnsrch(): Big Roundoff problem: disc = %21.15g \n", disc); } #endif disc = 0.; } else tmplam=(-b+sqrt(disc))/(3.0*a); } if (tmplam>0.5*alam) tmplam=0.5*alam; #if(!OPTIMIZED) if( ltrace ) { dualfprintf(fail_file,"my_lnsrch(): rhs1, rhs2, a, b, tmplam, alam = %21.15g %21.15g %21.15g %21.15g %21.15g %21.15g !!\n", rhs1, rhs2, a, b, tmplam, alam ); } #endif } } alam2=alam; f2 = *f; fold2=fold; alam=max(tmplam,0.1*alam); #if(!OPTIMIZED) if( ltrace ) { dualfprintf(fail_file,"my_lnsrch(): icount, alam, alam2, tmplam = %4i %21.15g %21.15g %21.15g \n", icount, alam, alam2, tmplam); } #endif icount++; } }