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