MINICERN/packlib/kernlib/kerngen/tcgen/trchlu.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 TRCHLU (A,B,N)
  11 C
  12 C CERN PROGLIB# F112    TRCHLU          .VERSION KERNFOR  4.16  870601
  13 C ORIG. 18/12/74 W.HART
  14 C
  15 #if defined(CERNLIB_INTDOUBL)
  16       DOUBLE PRECISION SUM, R, DC
  17 #endif
  18       DIMENSION A(*),B(*)
  19 C
  20       IPIV = 0
  21 C
  22       I = 0
  23    10 I = I + 1
  24       IPIV = IPIV + I
  25       KPIV = IPIV
  26       R = A(IPIV)
  27 C
  28       DO 60 J=I,N
  29       SUM = 0.
  30       IF (I.EQ.1)             GO TO 40
  31       IF (R.EQ.0.)            GO TO 42
  32       ID = IPIV - I + 1
  33       KD = KPIV - I + 1
  34 C
  35    30 SUM = SUM + B(KD)*B(ID)
  36       KD = KD + 1
  37       ID = ID + 1
  38       IF (ID.LT.IPIV)         GO TO 30
  39 C
  40    40 SUM = A(KPIV) - SUM
  41    42 IF (J.NE.I)             GO TO 50
  42 #if !defined(CERNLIB_INTDOUBL)
  43       DC =  SQRT (SUM)
  44 #endif
  45 #if defined(CERNLIB_INTDOUBL)
  46       DC = DSQRT (SUM)
  47 #endif
  48       B(KPIV) = DC
  49       IF (R .GT. 0.0) R = 1./DC
  50         GO  TO                60
  51 C
  52    50 B(KPIV) = SUM*R
  53 C
  54    60 KPIV = KPIV + J
  55 C
  56       IF (I.LT.N)             GO TO 10
  57 C
  58       RETURN
  59       END