<div id='wikitext'>
<pre><b> File: DMEATD.FT of Tape: Various/ETH/prog1</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
      SUBROUTINE MEANTD
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)
CDC  $,F(10,512)
      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/ I,JR,INIT,LS
      COMMON/ACCUR/ DDMU1,DDMU2,DCHI,ERRMU
C
      DIMENSION TDP(10)
C 
  431 FORMAT(1X,&#039;DMEATD DINGLET.= TDM =&#039;,G10.3,&#039; +/- &#039;,G10.3,//)
  440 FORMAT(1X,&#039;  J=&#039;,1I3,&#039;   TDJ=&#039;,F7.3,&#039;   DTDJ=&#039;,G10.3,
     $&#039;   SA=&#039;,G10.3,&#039;   SB=&#039;,G10.3,&#039;   SP=&#039;,G10.3)
      SP=0. 
      SA=0. 
      SB=0. 
      DO 10 J=1,MR
      TDJ(J)=ETA0(J)/14.69/AMU-T(J)
      TDP(J)=(DETA(I,J)/14.69/AMU)**2+(DT(J))**2
      DTDJ(J)=SQRT(TDP(J))
      TDP(J)=1./TDP(J)
      SA=SA+TDJ(J)*TDP(J)
      SB=SB+TDJ(J)**2*TDP(J)
      SP=SP+TDP(J)
C     WRITE(4,440) J,TDJ(J),DTDJ(J),SA,SB,SP
   10 CONTINUE
      TDM=SA/SP 
      SD=0
      DO 20 J=1,MR
      SD=SD+(TDJ(J)-TDM)**2*TDP(J)
   20 CONTINUE
      DTDM=SQRT(SD/SP/(MR-1))
C     WRITE(4,431) TDM,DTDM
      RETURN
      END 
</pre>
<hr/>
</div>