]> git.uio.no Git - u/mrichter/AliRoot.git/blame - MINICERN/mathlib/gen/divon/nmdchl.F
Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / divon / nmdchl.F
CommitLineData
fe4da5cc 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)
14C*NS INTEGER I, IB, IQ, J, JN1, JP1, K
15C*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