Initial commit

2016-02-03 18:52:05 +00:00
commit d40505e161
507 changed files with 91383 additions and 0 deletions
@@ -0,0 +1,48 @@
+      SUBROUTINE mrqcof(x,y,sig,ndata,a,ia,ma,alpha,beta,nalp,chisq,
+     *funcs)
+      INTEGER ma,nalp,ndata,ia(ma),MMAX
+      REAL chisq,a(ma),alpha(nalp,nalp),beta(ma),sig(ndata),x(ndata),
+     *y(ndata)
+      EXTERNAL funcs
+      PARAMETER (MMAX=20)
+      INTEGER mfit,i,j,k,l,m
+      REAL dy,sig2i,wt,ymod,dyda(MMAX)
+      mfit=0
+      do 11 j=1,ma
+        if (ia(j).ne.0) mfit=mfit+1
+11    continue
+      do 13 j=1,mfit
+        do 12 k=1,j
+          alpha(j,k)=0.
+12      continue
+        beta(j)=0.
+13    continue
+      chisq=0.
+      do 16 i=1,ndata
+        call funcs(x(i),a,ymod,dyda,ma)
+        sig2i=1./(sig(i)*sig(i))
+        dy=y(i)-ymod
+        j=0
+        do 15 l=1,ma
+          if(ia(l).ne.0) then
+            j=j+1
+            wt=dyda(l)*sig2i
+            k=0
+            do 14 m=1,l
+              if(ia(m).ne.0) then
+                k=k+1
+                alpha(j,k)=alpha(j,k)+wt*dyda(m)
+              endif
+14          continue
+            beta(j)=beta(j)+dy*wt
+          endif
+15      continue
+        chisq=chisq+dy*dy*sig2i
+16    continue
+      do 18 j=2,mfit
+        do 17 k=1,j-1
+          alpha(k,j)=alpha(j,k)
+17      continue
+18    continue
+      return
+      END