File: DLST.FT of Tape: Various/ETH/prog1
(Source file text)
SUBROUTINE LSTAU C COMMON/INI/ ANF(10,10),DANF(10,10),PH(10,10),DPH(10,10) $,AF(10,10),DAF(10,10),ETA(10,10),DETA(10,10),EMU(10,10), $T(10),DT(10),ANFM(10),DANFM(10) $,F(5,256) COMMON/TESPAR/ A0M,DA0M,AMU0,AF0(10),ETA0(10),A0(10) $,TDJ(10),DTDJ(10),TDM,DTDM COMMON/PARAM/IDENT,HANG,HI,HF,DK,NP,PI,SQHI,DKHI,I0DH,H0AL COMMON/STEER/MR,ADENT(10),MF,FREQ(10),I0 COMMON /LINE/ A,B,DA,DB,SA,SB,SAB,TD,AMU,RR,RMSD,CHI COMMON /REGRES/ XL(10),YL(10),DY(10) COMMON/FRERUN/ IF,JR,INIT,LS COMMON/ACCUR/ DDMU1,DDMU2,DCHI,ERRMU C 1000 FORMAT(5X,A6' CHISQ ='E17.10) Q4=ETA0(JR)*DK*NP BE=2.*14.69*AMU0*T(JR) EBD=EXP(-BE*DK) H2=1./NP CHISQ=.0 10 FLD1OV=1. EBH=EXP(-BE/HI) E9=EXP(-Q4/NP) EX=EXP(-Q4/(HI*DK*NP)) H3=1./(HI*DK*NP) BR=.0 AR=.0 CHISQL=CHISQ CHISQ=.0 DO 20 K=1,NP SQTFLD=SQRT(FLD1OV) IF(IDENT.NE.1HM) SQTFLD=1./SQTFLD AM=A0M*T(JR)*SQTFLD/(SQHI*(1.-EBH)) R1=F(JR,K)-AM*EX CHISQ=CHISQ+R1**2 DFDQ4=-H3*AM*EX BR=BR+R1*DFDQ4 AR=AR+DFDQ4*DFDQ4 FLD1OV=FLD1OV+DKHI EBH=EBH*EBD EX=EX*E9 H3=H3+H2 20 CONTINUE CHISQ=CHISQ/(NP-1) C WRITE(4,1000) ADENT(JR),CHISQ IF(ABS(CHISQ-CHISQL).LT.DCHI) GOTO 30 Q4=Q4+BR/AR GOTO 10 30 ETA0(JR)=Q4/(DK*NP) RETURN END