MINICERN/packlib/kernlib/kerngen/tcgen/trchul.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:49:54  mclareni
   6 * Kernlib
   7 *
   8 *
   9 #include "kerngen/pilot.h"
  10       SUBROUTINE TRCHUL (A,B,N)
  11 C
  12 C CERN PROGLIB# F112    TRCHUL          .VERSION KERNFOR  4.16  870601
  13 C ORIG. 18/12/74 WH
  14 C
  15 #if defined(CERNLIB_INTDOUBL)
  16       DOUBLE PRECISION SUM, R, DC
  17 #endif
  18       DIMENSION A(*),B(*)
  19 C
  20       KPIV = (N*N+N)/2
  21 C
  22       I = N
  23    10 IPIV = KPIV
  24       R = A(IPIV)
  25 C
  26    20 SUM = 0.
  27       IF (I.EQ.N)             GO TO 40
  28       IF (R.EQ.0.)            GO TO 42
  29       ID = IPIV
  30       KD = KPIV
  31       NSTEP = I
  32 C
  33    30 KD = KD + NSTEP
  34       ID = ID + NSTEP
  35       NSTEP = NSTEP + 1
  36       SUM = SUM + B(ID)*B(KD)
  37       IF (NSTEP.LT.N)         GO TO 30
  38 C
  39    40 SUM = A(KPIV) - SUM
  40    42 IF (KPIV.LT.IPIV)       GO TO 50
  41 #if !defined(CERNLIB_INTDOUBL)
  42       DC =  SQRT (SUM)
  43 #endif
  44 #if defined(CERNLIB_INTDOUBL)
  45       DC = DSQRT (SUM)
  46 #endif
  47       B(KPIV) = DC
  48       IF (R .GT. 0.0) R = 1./DC
  49         GO  TO                60
  50 C
  51    50 B(KPIV) = SUM*R
  52 C
  53    60 KPIV = KPIV - 1
  54       IF (KPIV.GT.IPIV-I)     GO TO 20
  55 C
  56       I = I - 1
  57       IF (I.GT.0)             GO TO 10
  58 C
  59       RETURN
  60       END