*-- Author : I.O.Skillicorn SUBROUTINE FXFIT(X,Y,SIG,NDATA,A,MA,LISTA,MFIT,COVAR,NCVM,CHISQ) SAVE C ADDED FOR RESIDUALS COMMON /FPRES/NPLA,RES(100),IPRES(100),THET(100) C ADDED FOR SCALE FACTOR COMMON /FPSCAL/SF1,SF2,WZER(100) PARAMETER (MMAX=100) DIMENSION X(NDATA),Y(NDATA),SIG(NDATA),A(MA),LISTA(MA), 1 COVAR(NCVM,NCVM),BETA(MMAX),AFUNC(MMAX) KK=MFIT+1 DO 12 J=1,MA IHIT=0 DO 11 K=1,MFIT IF(LISTA(K).EQ.J)IHIT=IHIT+1 11 CONTINUE IF(IHIT.EQ.0)THEN LISTA(KK)=J KK=KK+1 ELSEIF(IHIT.GT.1)THEN WRITE(*,*)' IMPROPER SET IN LISTA' RETURN ENDIF 12 CONTINUE IF(KK.NE.MA+1)THEN WRITE(*,*)' IMPROPER SET IN LISTA ' RETURN ENDIF DO 14 J=1,MFIT DO 13 K=1,MFIT COVAR(J,K)=0. 13 CONTINUE BETA(J)=0. 14 CONTINUE DO 18 I=1,NDATA CALL FFUNCS(I,AFUNC,MA) YM=Y(I) IF(MFIT.LT.MA)THEN DO 15 J=MFIT+1,MA YM=YM-A(LISTA(J))*AFUNC(LISTA(J)) 15 CONTINUE ENDIF SIG2I=1./SIG(I)**2 DO 17 J=1,MFIT WT=AFUNC(LISTA(J))*SIG2I DO 16 K=1,J COVAR(J,K)=COVAR(J,K)+WT*AFUNC(LISTA(K)) 16 CONTINUE BETA(J)=BETA(J)+YM*WT 17 CONTINUE 18 CONTINUE IF(MFIT.GT.1)THEN DO 21 J=2,MFIT DO 19 K=1,J-1 COVAR(K,J)=COVAR(J,K) 19 CONTINUE 21 CONTINUE ENDIF CALL FAUSSJ(COVAR,MFIT,NCVM,BETA,1,1) DO 22 J=1,MFIT A(LISTA(J))=BETA(J) 22 CONTINUE CHISQ=0. C ADDED FOR SCALE FACTOR 9/4/92 SF1=0. SF2=0. DO 24 I=1,NDATA CALL FFUNCS(I,AFUNC,MA) SUM=0. DO 23 J=1,MA SUM=SUM+A(J)*AFUNC(J) 23 CONTINUE CHISQ=CHISQ+((Y(I)-SUM)/SIG(I))**2 C ADDITION 2/3/92 RES(I)=(Y(I)-SUM)/SIG(I) IF(I.GT.NPLA)GOTO24 C ADDITION 9/4/92 C SF1=SF1+(Y(I)-WZER(I))*(SUM-WZER(I))/SIG(I)**2 C SF2=SF2+(SUM-WZER(I))**2/SIG(I)**2 C Y-WZER IS SIGNED DRIFT SF1=SF1+(Y(I)-WZER(I))/SIG(I)**2 SF2=SF2+(SUM-WZER(I))/SIG(I)**2 24 CONTINUE C CALL COVSRT(COVAR,NCVM,MA,LISTA,MFIT) RETURN END *