61 lines
1.6 KiB
Fortran
61 lines
1.6 KiB
Fortran
SUBROUTINE mrqmin(x,y,sig,ndata,a,ia,ma,covar,alpha,nca,chisq,
|
|
*funcs,alamda)
|
|
INTEGER ma,nca,ndata,ia(ma),MMAX
|
|
REAL alamda,chisq,funcs,a(ma),alpha(nca,nca),covar(nca,nca),
|
|
*sig(ndata),x(ndata),y(ndata)
|
|
PARAMETER (MMAX=20)
|
|
CU USES covsrt,gaussj,mrqcof
|
|
INTEGER j,k,l,mfit
|
|
REAL ochisq,atry(MMAX),beta(MMAX),da(MMAX)
|
|
SAVE ochisq,atry,beta,da,mfit
|
|
if(alamda.lt.0.)then
|
|
mfit=0
|
|
do 11 j=1,ma
|
|
if (ia(j).ne.0) mfit=mfit+1
|
|
11 continue
|
|
alamda=0.001
|
|
call mrqcof(x,y,sig,ndata,a,ia,ma,alpha,beta,nca,chisq,funcs)
|
|
ochisq=chisq
|
|
do 12 j=1,ma
|
|
atry(j)=a(j)
|
|
12 continue
|
|
endif
|
|
do 14 j=1,mfit
|
|
do 13 k=1,mfit
|
|
covar(j,k)=alpha(j,k)
|
|
13 continue
|
|
covar(j,j)=alpha(j,j)*(1.+alamda)
|
|
da(j)=beta(j)
|
|
14 continue
|
|
call gaussj(covar,mfit,nca,da,1,1)
|
|
if(alamda.eq.0.)then
|
|
call covsrt(covar,nca,ma,ia,mfit)
|
|
return
|
|
endif
|
|
j=0
|
|
do 15 l=1,ma
|
|
if(ia(l).ne.0) then
|
|
j=j+1
|
|
atry(l)=a(l)+da(j)
|
|
endif
|
|
15 continue
|
|
call mrqcof(x,y,sig,ndata,atry,ia,ma,covar,da,nca,chisq,funcs)
|
|
if(chisq.lt.ochisq)then
|
|
alamda=0.1*alamda
|
|
ochisq=chisq
|
|
do 17 j=1,mfit
|
|
do 16 k=1,mfit
|
|
alpha(j,k)=covar(j,k)
|
|
16 continue
|
|
beta(j)=da(j)
|
|
17 continue
|
|
do 18 l=1,ma
|
|
a(l)=atry(l)
|
|
18 continue
|
|
else
|
|
alamda=10.*alamda
|
|
chisq=ochisq
|
|
endif
|
|
return
|
|
END
|