File: SUBFOU.FT of Tape: Various/ETH/f2

(Source file text) 

---

	SUBROUTINE SUBFOU(INA)
C
	COMMON /TITLE/ ADENT,GLOBAL,RUN,ICREAT
	COMMON /FITPAR/ JIT,FISTOP,AMARQI,UPMARQ,DNMARQ,VARI,
     $  UPVAR,DNVAR,VARMIN,MLOOP,LOOPLW,ISTART,ISTOP,ITEST,IDEFIX
	COMMON /PARAM/ DKHI,SHFACT,CHISQ,ITORQ,IDILA,DK,DL,HANG
     $  ,HUP,HDOWN,AMI,PS,PT,SOLLT,TEMP,TV,ES,AKL,AKV,CAP,EICH
	COMMON /PEAKS/ TASWI,KBLOW,KBLOW1,KMAX,K1,K3,CHI,
     $  Q(11,4),HIGHT(21),INDEX(21)
	COMMON /VECT/ C(44),D1(11,4),DIAGEL(44),D(44),E(44)
	COMMON /DATIN/ F(512),NP
	COMMON /CONST/ PI,TWOPI
	COMMON /PLOTC/ PLTBUF(400)
	COMMON /FAF/ A(2049),B(2049),N
	DIMENSION AR(44,44),Z(44,44)
	EQUIVALENCE (A,AR),(B,Z)
	INTEGER RUN
	REAL K3
	LOGICAL ITORQ,IDILA,ITEST,TASWI
C
	LOGICAL INA
C
	CHISQ=0.
	DO 30 IX=1,NP
	I=IX-1
	H2=FLOAT(I)/NP
	H3=2.*H2-1.
	H4=6.*H2*H2-6.*H2+1.
	H5=20.*H2*H2*H2-30.*H2*H2+12.*H2-1.
	R1=-F(IX)+Q(1,1)+Q(1,2)*H3+Q(1,3)*H4+Q(1,4)*H5
	FLD1OV=1.+I*DKHI
	SQTFLD=SQRT(FLD1OV)
	IF (ITORQ) SQTFLD=1./SQTFLD
	IF (K1.LT.2) GO TO 20
	DO 40 L=2,K1
	QL1=Q(L,1)
	QL4=Q(L,4)
	CO=COS(I*QL1-Q(L,2))
	AM=Q(L,3)*SQTFLD/(1.-EXP(-SHFACT*QL1*FLD1OV))
	E8=1./(1.-EXP(-QL4))
	E9=EXP(-H2*QL4)
	EX=Q(L,4)*E8*E9
	R1=R1+AM*CO*EX
40	CONTINUE
20	CHISQ=CHISQ+R1*R1
	IF (INA) A(IX)=-R1
30	CONTINUE
	CHISQ=CHISQ/(NP-K1*4)
	CHI=SQRT(CHISQ)
	RETURN
	END

---