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