MINICERN/mathlib/gen/divon/modchl.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 MODCHL (N,NADIM,AHESS,ALPHA,Z,IFAIL)
  11       INTEGER N, NADIM, IFAIL
  12       DOUBLE PRECISION ALPHA
  13       DOUBLE PRECISION AHESS(NADIM,N), Z(N)
  14       INTEGER I, IB, IP1, J, K
  15       DOUBLE PRECISION A, BETA, DB, DI, GAMMA, P1, RMAX, T, W
  16 #if defined(CERNLIB_IBM)||defined(CERNLIB_SINGLE)
  17       RMAX=7.2D+75
  18 #endif
  19 #if (!defined(CERNLIB_IBM))&&(defined(CERNLIB_DOUBLE))
  20       RMAX= 1.0D+37
  21 #endif
  22       IFAIL=0
  23       A=ALPHA
  24       K=0
  25       DO 50 I=1,N
  26       P1=Z(I)
  27       DI=AHESS(I,I)
  28       T=A*P1
  29       DB=DI+T*P1
  30       AHESS(I,I)=DB
  31       IF(DB.GE.1.0D+0) GOTO 10
  32       IF(DB.GT.0.0D+0.AND.DI.LE.RMAX*DB) GOTO 10
  33       IFAIL=1
  34       RETURN
  35  10   GAMMA=DI/DB
  36       BETA=T/DB
  37       A=A*GAMMA
  38       K=K+I
  39       J=K
  40       IF(I.EQ.N) GOTO 50
  41       IP1=I+1
  42       IF(GAMMA.GE.2.5D-1) GOTO 30
  43       DO 20 IB=IP1,N
  44       T=AHESS(IB,I)
  45       AHESS(IB,I)=T*GAMMA+BETA*Z(IB)
  46       Z(IB)=Z(IB)-P1*T
  47  20   CONTINUE
  48       GOTO 50
  49  30   DO 40 IB=IP1,N
  50       T=AHESS(IB,I)
  51       W=Z(IB)-P1*T
  52       Z(IB)=W
  53       AHESS(IB,I)=BETA*W+T
  54  40   CONTINUE
  55  50   CONTINUE
  56       RETURN
  57       END