<div id='wikitext'>
<pre><b> File: DMAIN.FT of Tape: Various/ETH/prog1</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
CDC	DINGLE,9621,CM60000,CT15. 
CDC	PERMF,LGO.
CDC	FTN(BL,R).
CDC	CATALOG,LGO,DINGBN. 
CDC   PROGRAM DINGLE(OUTPUT=240B,TAPE4=OUTPUT,TAPE5,TAPE6)
      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 
      DIMENSION X(400),Y(400),NB(400) 
      REAL MU,KET 
      LOGICAL ERRMU,ERR 
C 
  100 FORMAT(I3)
  110 FORMAT(F10.1) 
  130 FORMAT((A6))
  200 FORMAT(///T8&#039;MU NEGATIV !!!!!!!!!!!!!!&#039;/1H1)
  420 FORMAT(/,&#039; A=&#039;,G10.3,&#039;  B=&#039;,G10.3,&#039;    AMU=&#039;,G10.3,//)
  430 FORMAT(1X,&#039;MEAN DINGLETEMP. = TDM = &#039;,G10.3,&#039; +/- &#039;,
     $G10.3,//)
  440 FORMAT(1X,&#039; AMPLITUDE CALCULATED FOR I0 = &#039;,1I3,//)
C 
      READ(5,100) MF
      READ(5,110) (FREQ(I),I=1,MF)
      READ(5,100) MR
      READ(5,130) (ADENT(I),I=1,MR)   
      READ(5,100) I0
      CALL INPUT
      CALL PRINT(1) 
C     WRITE(4,440) I0
C 
C 
      DO 10 I=1,MF
      IF=I
C 
      DO 50 J=1,MR
      AF0(J)=AF(I,J)
      ETA0(J)=ETA(I,J)
   50 CONTINUE
      AMU0=EMU(I,1)
      CALL MEAN
      CALL PRINT(2)
      CALL LOGAMP
      CALL LINREG(MR)
      CALL MEANTD
C     WRITE(4,430) TDM,DTDM
      AMU0=AMU
      CALL CHIRMSD
      CALL PRINT(3) 
      TMAX=0. 
      DO 51 J=1,MR
   51 TMAX= AMAX1(TMAX,T(J))
      LINT=(400-5*MR)/2 
      LMAX=LINT+3*MR
      DO 52 L=1,LINT
      X(L)=1.+(TMAX-1.)*(L-1)/FLOAT(LINT-1) 
      Y(L)=14.69*AMU0*(X(L)+TDM)
      NB(L)=5 
   52 CONTINUE
      DO 53 J=1,MR
      K=3*(J-1)+LINT+1
      X(K)=T(J) 
      Y(K)=ETA(I,J)+DETA(I,J)
      NB(K)=2 
      X(K+1)=T(J) 
      Y(K+1)=ETA(I,J)-DETA(I,J)
      NB(K+1)=2 
      X(K+2)=T(J) 
      Y(K+2)=ETA(I,J)
      NB(K+2)=1 
   53 CONTINUE
C     TEST: GOTO20
      GOTO 20
      INIT=1
      DCHI=(DAF(I,1)/1000.)**2. 
      DO 55 J=1,MR
      JR=J
      AMU0=EMU(I,J) 
      CALL LSAFTAU
   55 CONTINUE
      INIT=0
      AMU0=EMU(I,1) 
C 
   60 CONTINUE
      LS=1
      ERR=.F. 
      MU=AMIN1(AMU,AMU0)
      DMU=ABS(AMU-AMU0) 
   61 IF(MU.LE.0.) GOTO 96
   62 CALL ROOTS(MU,DMU)
      MU=MU-DMU 
      DMU=3.*DMU
      IF(ERRMU) GOTO 61 
      MU=MU+DMU/3.
      MU=FMU(MU)
      CALL MEANTD
      CALL MEAN 
      CALL CHIRMSD
      CALL PRINT(4) 
      DO 63 J=1,MR
      K=LMAX+J
      X(K)=T(J) 
      Y(K)=ETA0(J)
      NB(K)=3 
   63 CONTINUE
      LMAX=LMAX+MR
C 
   70 CONTINUE
      LS=0
      ERR=.F. 
      MU=AMU
      DMUS=SQRT(SA)/14.69 
      DMU=DMUS/3. 
      MU=MU-DMU/2.
   71 MU=MU-DMU 
      IF(MU.LE.0.) GOTO 97
   72 DMU=3.*DMU
      CALL ROOTS(MU,DMU)
      IF(ERRMU) GOTO 71 
      MU=FMU(MU)
      CALL MEANTD
      CALL CHIRMSD
      CALL PRINT(5) 
C 
   80 CONTINUE
      LMIN=LMAX+1 
      LMAX=LMAX+LINT
      DO 81 L=LMIN,LMAX 
      X(L)=1.+(TMAX-1.)*(L-LMIN)/FLOAT(LINT-1)
      Y(L)=A*X(L)+B 
      NB(L)=6 
   81 CONTINUE
      DO 82 J=1,MR
      K=LMAX+J
      X(K)=T(J) 
      Y(K)=ETA0(J)
      NB(K)=4 
   82 CONTINUE
      LMAX=LMAX+MR
      GOTO 20
C 
   96 IF(ERR) GOTO 90
      MU=EMU(I,1)/10
      ERR=.T.
      GOTO 62
   97 IF(ERR) GOTO 90
      MU=EMU(I,1)/10
      ERR=.T.
      GOTO 72
   90 CONTINUE
      WRITE(4,200)
C
   20 CALL GRAPH(X,Y,NB,LMAX)
C
   10 CONTINUE
      END
</pre>
<hr/>
</div>