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