This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / divon / nmdchl.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1996/04/01 15:03:26  mclareni
6 * Mathlib gen
7 *
8 *
9 #include "gen/pilot.h"
10       SUBROUTINE NMDCHL (N,NADIM,AHESS,EPSMCH,Z,P)
11       INTEGER N, NADIM
12       DOUBLE PRECISION EPSMCH
13       DOUBLE PRECISION Z(N), AHESS(NADIM,N), P(N)
14 C*NS  INTEGER I, IB, IQ, J, JN1, JP1, K
15 C*NS  INTEGER I, IB,     J, JN1, JP1, K
16       DOUBLE PRECISION BETA, DJ, G, GAMMA, GAMMA1, PJ, T
17       GAMMA=0.0D+0
18       J=1
19       DO 30 I=1,N
20       T=Z(I)
21       IF(I.EQ.1) GOTO 20
22       K=I-1
23       DO 10 IB=1,K
24       T=T-P(IB)*AHESS(I,IB)
25  10   CONTINUE
26  20   P(I)=T
27       GAMMA=GAMMA+T*T/AHESS(I,I)
28  30   CONTINUE
29       GAMMA1=1.0D+0-GAMMA
30       GAMMA=EPSMCH
31       IF(GAMMA1.GT.EPSMCH) GAMMA=GAMMA1
32       IF(-GAMMA1.GT.EPSMCH) GAMMA=-GAMMA1
33       JN1=N+1
34       DO 50 I=1,N
35       J=JN1-I
36       PJ=P(J)
37       DJ=AHESS(J,J)
38       T=PJ/DJ
39       Z(J)=PJ
40       BETA=-T/GAMMA
41       G=GAMMA+PJ*T
42       AHESS(J,J)=DJ*GAMMA/G
43       GAMMA=G
44       IF(J.EQ.N) GOTO 50
45       JP1=J+1
46       DO 40 IB=JP1,N
47       T=AHESS(IB,J)
48       AHESS(IB,J)=T+BETA*Z(IB)
49       Z(IB)=Z(IB)+PJ*T
50  40   CONTINUE
51  50   CONTINUE
52       RETURN
53       END