File: KSU.FT of Tape: Various/ETH/f4
(Source file text)
SUBROUTINE SUBFOU(INA) C COMMON /TITLE/ ADENT,GLOBAL,DITOMO,RUN,ICREAT COMMON /FITPAR/ JIT,FISTOP,AMARQI,UPMARQ,DNMARQ,VARI, $ UPVAR,DNVAR,VARMIN,MLOOP,LOOPLW,ISTART,ISTOP,ITEST,IDEFIX COMMON /PARAM/ DKHI,SHFACT(11),CHISQ,DK,DL,HANG $ ,HUP,HDOWN,CAPMO,AMI,PS,PT,SOLLT,TEMP,TV,ES,AKL,AKV,EICH COMMON /EFFMU/ FRE1(11),FRE2(11),PERMAS(11) 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 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 (DITOMO.EQ.1HD.OR.DITOMO.EQ.1HT) 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(L)*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