<div id='wikitext'>
<pre><b> File: DIAFOU.FT of Tape: Various/ETH/f2</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
	SUBROUTINE DIAFOU(NA)
C
	COMMON /TITLE/ ADENT,GLOBAL,RUN,ICREAT
	COMMON /FITPAR/ JIT,FISTOP,AMARQI,UPMARQ,DNMARQ,VARI,
     $  UPVAR,DNVAR,VARMIN,MLOOP,LOOPLW,ISTART,ISTOP,ITEST,IDEFIX
	COMMON /PARAM/ DKHI,SHFACT,CHISQ,ITORQ,IDILA,DK,DL,HANG
     $  ,HUP,HDOWN,AMI,PS,PT,SOLLT,TEMP,TV,ES,AKL,AKV,CAP,EICH
	COMMON /PEAKS/ TASWI,KBLOW,KBLOW1,KMAX,K1,K3,CHI,
     $  Q(11,4),HIGHT(21),INDEX(21)
	COMMON /VECT/ C(44),D1(11,4),DIAGEL(44),D(44),E(44)
	COMMON /DATIN/ F(512),NP
	COMMON /CONST/ PI,TWOPI
	COMMON /PLOTC/ PLTBUF(400)
	COMMON /FAF/ A(2049),B(2049),N
	DIMENSION AR(44,44),Z(44,44)
	EQUIVALENCE (A,AR),(B,Z)
	INTEGER RUN
	REAL K3
	LOGICAL ITORQ,IDILA,ITEST,TASWI
C
	DATA EPS/1.E-7/
C TEST OUTPUT
600	FORMAT(1H0,16(F7.2,1X))
601	FORMAT(1H )
602	FORMAT(1H ,16(F7.2,1X))
C
      IF(NA.LE.1) GO TO 219
      DO 201 I=2,NA        
      E(I-1)=E(I)        
201   CONTINUE        
      E(NA)=0.        
      BX=0.        
      FX=0.        
      J=0
      JIT=0
      DO 212 L=1,NA        
      J=0        
      H=EPS*(ABS(D(L))+ABS(E(L)))        
      IF(BX.LT.H) BX=H        
      DO 202 M=L,NA        
      IF(ABS(E(M))-BX)203,203,202        
202   CONTINUE        
203   CONTINUE        
      IF(M.EQ.L) GOTO 211        
204   CONTINUE        
      IF(J.EQ.30) GOTO 217        
      J=J+1        
      P=(D(L+1)-D(L))/(2.*E(L))        
      R=SQRT(P*P+1.)        
      H = D(L) - E(L)/(P+SIGN(R,P))        
      DO 205 I=L,NA        
      D(I)=D(I)-H        
205   CONTINUE        
      FX=FX+H        
      P=D(M)        
      CO=1.        
      S=0.        
      M1=M-1        
      ML=M1+L        
      DO 210 II=L,M1        
      I=ML-II        
      G=CO*E(I)        
      H=CO*P        
      IF(ABS(P)-ABS(E(I)))207,206,206        
206   CONTINUE        
      CO=E(I)/P        
      R=SQRT(CO*CO+1.)        
      E(I+1)=S*P*R        
      S=CO/R        
      CO=1./R        
      GO TO 208        
207   CONTINUE        
      CO=P/E(I)        
      R=SQRT(CO*CO+1.)        
      E(I+1)=S*E(I)*R        
      S=1./R        
      CO=CO/R        
208   CONTINUE        
      P=CO*D(I)-S*G        
      D(I+1)=H+S*(CO*G+S*D(I))        
      DO 209 K=1,NA        
      H=Z(K,I+1)        
      Z(K,I+1)=S*Z(K,I)+CO*H        
      Z(K,I)=CO*Z(K,I)-S*H        
209   CONTINUE        
210   CONTINUE        
      E(L)=S*P        
      D(L)=CO*P        
      IF(ABS(E(L))-BX)211,211,204        
211   CONTINUE        
      D(L)=D(L)+FX        
      JIT=JIT+J
212   CONTINUE        
      N1=NA-1        
      DO 216 I=1,N1        
      K=I        
      P=D(I)        
      II=I+1        
      DO 214 J=II,NA        
      IF(D(J)-P) 213,214,214        
213   CONTINUE        
      K=J        
      P=D(J)        
214   CONTINUE        
      IF(K.EQ.I) GOTO 216        
      D(K)=D(I)        
      D(I)=P        
      DO 215 J=1,NA        
      P=Z(J,I)        
      Z(J,I)=Z(J,K)        
      Z(J,K)=P        
215   CONTINUE        
216   CONTINUE        
219   CONTINUE
	IF (.NOT.ITEST) GO TO 360
	WRITE(3,600) (D(J),J=1,NA)
	WRITE(3,601)
	DO 301 K=1,NA
301	WRITE(3,602) (Z(K,J),J=1,NA)
360	RETURN        
217   CONTINUE        
      STOP 11111        
      END        
</pre>
<hr/>
</div>