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

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:49:56  mclareni
   6 * Kernlib
   7 *
   8 *
   9 #include "kerngen/pilot.h"
  10       SUBROUTINE TRPCK (S,U,N)
  11 C
  12 C CERN PROGLIB# F112    TRPCK           .VERSION KERNFOR  2.08  741218
  13 C ORIG. 18/12/74 WH
  14 C
  15       COMMON /SLATE/ I,IA,IND,IPIV,IDUM(36)
  16       DIMENSION S(*),U(*)
  17 C
  18       IA = 0
  19       IND = 0
  20       IPIV = 0
  21 C
  22       DO 20 I=1,N
  23       IPIV = IPIV + I
  24 C
  25    10 IA = IA + 1
  26       IND = IND + 1
  27       U(IND) = S(IA)
  28       IF (IND.LT.IPIV)        GO TO 10
  29 C
  30    20 IA = IA + N - I
  31 C
  32       RETURN
  33       END