home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / MRQCOF.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-29  |  1.4 KB  |  47 lines
  1. PROCEDURE mrqcof(x,y,sig: glndata; ndata: integer;
  2.        VAR a: glmma; mma: integer; lista: gllista;
  3.        mfit: integer; VAR alpha: glnalbynal;
  4.        VAR beta: glmma; nalp: integer; VAR chisq: real);
  5. (* Programs using routine MRQMIN must provide a
  6. PROCEDURE funcs(xx:real; a:glmma; yfit:real; dyda:glmma; mma:integer);
  7. that evaluates the fitting function yfit and its derivatives dyda
  8. with respect to the parameters a at point xx.  Also they
  9. must define the types
  10. TYPE
  11.    glndata = ARRAY [1..ndata] OF real;
  12.    glmma = ARRAY [1..mma] OF real;
  13.    gllista = ARRAY [1..mma] OF integer;
  14.    glnalbynal = ARRAY [1..nalp,1..nalp] OF real;
  15. in the main routine *)
  16. VAR
  17.    k,j,i: integer;
  18.    ymod,wt,sig2i,dy: real;
  19.    dyda: glmma;
  20. BEGIN
  21.    FOR j := 1 TO mfit DO BEGIN
  22.       FOR k := 1 TO j DO BEGIN
  23.          alpha[j,k] := 0.0
  24.       END;
  25.       beta[j] := 0.0
  26.    END;
  27.    chisq := 0.0;
  28.    FOR i := 1 TO ndata DO BEGIN
  29.       funcs(x[i],a,ymod,dyda,mma);
  30.       sig2i := 1.0/(sig[i]*sig[i]);
  31.       dy := y[i]-ymod;
  32.       FOR j := 1 TO mfit DO BEGIN
  33.          wt := dyda[lista[j]]*sig2i;
  34.          FOR k := 1 TO j DO BEGIN
  35.             alpha[j,k] := alpha[j,k]+wt*dyda[lista[k]]
  36.          END;
  37.          beta[j] := beta[j]+dy*wt
  38.       END;
  39.       chisq := chisq+dy*dy*sig2i
  40.    END;
  41.    FOR j := 2 TO mfit DO BEGIN
  42.       FOR k := 1 TO j-1 DO BEGIN
  43.          alpha[k,j] := alpha[j,k]
  44.       END
  45.    END
  46. END;
  47.