Matrix<T> Matrix<T>::get(int rw, int cl, int nr, int nc) const { Matrix<T> getmat(nr,nc) ; if ( (rw+nr) > this->rows() || (cl+nc) > this->cols()) { #ifdef USE_EXCEPTION throw MatrixErr(); #else Error error("Matrix<T>::get") ; error << "Matrix of size "<< nr << ", " << nc << " not available at " << rw << ", " << cl << endl ; error.fatal() ; #endif } int i, j; #ifdef COLUMN_ORDER for(i=0;i<nr;++i) for(j=0;j<nc;++j) getmat(i,j) = this->elem(i+rw,j+cl) ; #else T *pptr,*aptr ; aptr = getmat.m-1; for (i = 0; i < nr; ++i) { pptr = &m[(i+rw)*cols()+cl]-1 ; for ( j = 0; j < nc; ++j) *(++aptr) = *(++pptr) ; } #endif return getmat ; }
fint lsqfitd_c( double *xdat , fint *xdim , double *ydat , double *wdat , fint *ndat , double *fpar , double *epar , fint *mpar , fint *npar , double *tol , fint *its , double *lab , fint *fopt ) /* * lsqfitd is exported, and callable from C as well as Fortran. */ { fint i; fint n; fint r; itc = 0; /* fate of fit */ found = 0; /* reset */ nfree = 0; /* number of free parameters */ nuse = 0; /* number of legal data points */ if (*tol < (DBL_EPSILON * 10.0)) { tolerance = DBL_EPSILON * 10.0; /* default tolerance */ } else { tolerance = *tol; /* tolerance */ } labda = fabs( *lab ) * LABFAC; /* start value for mixing parameter */ for (i = 0; i < (*npar); i++) { if (mpar[i]) { if (nfree > MAXPAR) return( -1 ); /* too many free parameters */ parptr[nfree++] = i; /* a free parameter */ } } if (nfree == 0) return( -2 ); /* no free parameters */ for (n = 0; n < (*ndat); n++) { if (wdat[n] > 0.0) nuse++; /* legal weight */ } if (nfree >= nuse) return( -3 ); /* no degrees of freedom */ if (labda == 0.0) { /* linear fit */ for (i = 0; i < nfree; fpar[parptr[i++]] = 0.0); getmat( xdat, xdim, ydat, wdat, ndat, fpar, epar, npar, fopt ); r = getvec( xdat, xdim, ydat, wdat, ndat, fpar, epar, npar, fopt ); if (r) return( r ); /* error */ for (i = 0; i < (*npar); i++) { fpar[i] = epar[i]; /* save new parameters */ epar[i] = 0.0; /* and set errors to zero */ } chi1 = sqrt( chi1 / (double) (nuse - nfree) ); for (i = 0; i < nfree; i++) { if ((matrix1[i][i] <= 0.0) || (matrix2[i][i] <= 0.0)) return( -7 ); epar[parptr[i]] = chi1 * sqrt( matrix2[i][i] ) / sqrt( matrix1[i][i] ); } } else { /* Non-linear fit */ /* * The non-linear fit uses the steepest descent method in combination * with the Taylor method. The mixing of these methods is controlled * by labda. In the outer loop (called the iteration loop) we build * the matrix and calculate the correction vector. In the inner loop * (called the interpolation loop) we check whether we have obtained * a better solution than the previous one. If so, we leave the * inner loop, else we increase labda (give more weight to the * steepest descent method), calculate the correction vector and check * again. After the inner loop we do a final check on the goodness of * the fit and if this satisfies the tolerance we calculate the * errors of the fitted parameters. */ while (!found) { /* iteration loop */ if (itc++ == (*its)) return( -4 ); /* increase iteration counter */ getmat( xdat, xdim, ydat, wdat, ndat, fpar, epar, npar, fopt ); /* * here we decrease labda since we may assume that each iteration * brings us closer to the answer. */ if (labda > LABMIN) labda /= LABFAC; /* decrease labda */ r = getvec( xdat, xdim, ydat, wdat, ndat, fpar, epar, npar, fopt ); if (r) return( r ); /* error */ while (chi1 >= chi2) { /* interpolation loop */ /* * The next statement is based on experience, not on the * mathematics of the problem although I (KGB) think that it * is correct to assume that we have reached convergence * when the pure steepest descent method does not produce * a better solution. Think about this somewhat more, anyway, * as already stated, the next statement is based on experience. */ if (labda > LABMAX) break; /* assume solution found */ labda *= LABFAC; /* Increase mixing parameter */ r = getvec( xdat, xdim, ydat, wdat, ndat, fpar, epar, npar, fopt ); if (r) return( r ); /* error */ } if (labda <= LABMAX) { /* save old parameters */ for (i = 0; i < (*npar); i++) fpar[i] = epar[i]; } if (fabs( chi2 - chi1 ) <= (tolerance * chi1) || (labda > LABMAX)) { /* * We have a satisfying solution, so now we need to calculate * the correct errors of the fitted parameters. This we do * by using the pure Taylor method because we are very close * to the real solution. */ labda = 0.0; /* for Taylor solution */ getmat( xdat, xdim, ydat, wdat, ndat, fpar, epar, npar, fopt ); r = getvec( xdat, xdim, ydat, wdat, ndat, fpar, epar, npar, fopt ); if (r) return( r ); /* error */ for (i = 0; i < (*npar); i++) { epar[i] = 0.0; /* and set error to zero */ } chi2 = sqrt( chi2 / (double) (nuse - nfree) ); for (i = 0; i < nfree; i++) { if ((matrix1[i][i] <= 0.0) || (matrix2[i][i] <= 0.0)) return( -7); epar[parptr[i]] = chi2 * sqrt( matrix2[i][i] ) / sqrt( matrix1[i][i] ); } found = 1; /* we found a solution */ } } } return( itc ); /* return number of iterations */ }