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

	SUBROUTINE TRIFOU(NA)
C
	COMMON /TITLE/ ADENT,GLOBAL,DITOMO,RUN,ICREAT
	COMMON /FITPAR/ JIT,FISTOP,AMARQI,UPMARQ,DNMARQ,VARI,
     $  UPVAR,DNVAR,VARMIN,MLOOP,LOOPLW,ISTART,ISTOP,ITEST,IDEFIX
	COMMON /PARAM/ DKHI,SHFACT(11),CHISQ,DK,DL,HANG
     $  ,HUP,HDOWN,CAPMO,AMI,PS,PT,SOLLT,TEMP,TV,ES,AKL,AKV,EICH
	COMMON /EFFMU/ FRE1(11),FRE2(11),PERMAS(11)
	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 ITEST,TASWI
C
	DATA TOL/1.E-07/        
C TEST OUTPUT
600	FORMAT(1H0,16(F7.2,1X))
601	FORMAT(1H )
602	FORMAT(1H ,16(F7.2,1X))
C
	IF (.NOT.ITEST) GO TO 350
	WRITE(3,600) (C(J),J=1,NA)
	WRITE(3,601)
	DO 300 K=1,NA
300	WRITE(3,602) (AR(K,J),J=1,NA)
350      Z(1,1)=1.        
      IF(NA.LE.1) RETURN
      DO 1 I=1,NA        
      DO 1 J=1,NA        
      Z(J,I)=AR(I,J)        
1     CONTINUE        
C        
      DO 9 II=2,NA        
      L=NA-II        
      I=L+2        
      FX=Z(I,I-1)        
      G=0.        
      IF(L.EQ.0) GOTO 100        
      DO 2 K=1,L        
      G=G+Z(I,K)**2        
2     CONTINUE        
100   CONTINUE        
      H=G+FX*FX        
      IF(G.GT.TOL) GOTO 3        
      E(I)=FX        
      H=0.        
      GOTO 9        
3     L=L+1        
      G=-SIGN(SQRT(H),FX)        
      E(I)=G        
      H=H-FX*G        
      Z(I,I-1)=FX-G        
      FX=0.        
      DO 6 J=1,L        
      Z(J,I)=Z(I,J)/H        
      G=0.        
      DO 4 K=1,J        
      G=G+Z(J,K)*Z(I,K)        
4     CONTINUE        
      J1=J+1        
      IF(J1.GT.L) GOTO 110        
      DO 5 K=J1,L        
      G=G+Z(K,J)*Z(I,K)        
5     CONTINUE        
110   CONTINUE        
      E(J)=G/H        
      FX=FX+G*Z(J,I)        
6     CONTINUE        
      HH=FX/(H+H)        
      DO 8 J=1,L        
      FX=Z(I,J)        
      G=E(J)-HH*FX        
      E(J)=G        
      DO 7 K=1,J        
      Z(J,K)=Z(J,K)-FX*E(K)-G*Z(I,K)        
7     CONTINUE        
8     CONTINUE        
9     D(I)=H        
      D(1)=0.        
      E(1)=0.        
      DO 15 I=1,NA        
      L=I-1        
      IF(ABS(D(I)).LT.1.E-08)GO TO 13        
      IF(L.EQ.0) GOTO 13        
      DO 12 J=1,L        
      G=0.        
      DO 10 K=1,L        
      G=G+Z(I,K)*Z(K,J)        
10    CONTINUE        
      DO 11 K=1,L        
      Z(K,J)=Z(K,J)-G*Z(K,I)        
11    CONTINUE        
12    CONTINUE        
13    D(I)=Z(I,I)        
      Z(I,I)=1.        
      IF(L.EQ.0) GOTO 15        
      DO 14 J=1,L        
      Z(I,J)=0.        
      Z(J,I)=0.        
14    CONTINUE        
15    CONTINUE        
	RETURN
	END