File: DLSAT.FT of Tape: Various/ETH/f4
(Source file text) 

      SUBROUTINE LSAFTAU
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) 
 1100 FORMAT(5X'LSAFTAU 'A6)
      Q3=AF0(JR)
      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) 
      E89=1./(1.-EXP(-Q4)) 
      E8=E89
      E9=EXP(-Q4/NP)
      E3=1.-E8
      IF(INIT.EQ.0) GOTO 50 
      DO 20 K=1,NP
      SQTFLD=SQRT(FLD1OV) 
      IF(IDENT.NE.1HM) SQTFLD=1./SQTFLD 
      AM=Q3*SQTFLD/(1.-EBH) 
      EX=Q4*E89 
      F(JR,K)=AM*EX 
      FLD1OV=FLD1OV+DKHI
      EBH=EBH*EBD 
      E89=E89*E9
   20 CONTINUE
      WRITE(4,1100) ADENT(JR)
      RETURN
   50 BR1=.0
      BR2=.0
      AR11=.0
      AR12=.0
      AR22=.0 
      CHISQL=CHISQ 
      CHISQ=.0
      DO 60 K=1,NP
      SQTFLD=SQRT(FLD1OV) 
      IF(IDENT.NE.1HM) SQTFLD=1./SQTFLD 
      AM=Q3*SQTFLD/(1.-EBH) 
      EX=Q4*E89 
      R1=F(JR,K)-AM*EX
      CHISQ=CHISQ+R1**2 
      DFDQ3=AM*EX/Q3
      DFDQ4=AM*E89*(1.+Q4*E3) 
      BR1=BR1+R1*DFDQ3
      BR2=BR2+R1*DFDQ4
      AR11=AR11+DFDQ3**2
      AR22=AR22+DFDQ4**2
      AR12=AR12+DFDQ3*DFDQ4 
      FLD1OV=FLD1OV+DKHI
      EBH=EBH*EBD 
      E89=E89*E9
      E3=E3-H2
   60 CONTINUE
      CHISQ=CHISQ/(NP-2)
      WRITE(4,1000) ADENT(JR),CHISQ 
      IF(ABS(CHISQ-CHISQL).LT.DCHI) GOTO 100 
      DET=AR11*AR22-AR12**2 
      Q3=Q3+(BR1*AR22-BR2*AR12)/DET 
      Q4=Q4+(BR2*AR11-BR1*AR12)/DET 
      GOTO 10 
  100 AF0(JR)=Q3
      ETA0(JR)=Q4/(DK*NP) 
      RETURN
      END