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

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:49:50  mclareni
   6 * Kernlib
   7 *
   8 *
   9 #include "kerngen/pilot.h"
  10 #if defined(CERNLIB_QMIBMVF)
  11 @PROCESS DIRECTIVE('*VDIR:') VECTOR
  12 #endif
  13       SUBROUTINE SORTI(A,NC,NR,NS)
  14 C
  15 C CERN PROGLIB# M107    SORTI           .VERSION KERNFOR  4.21  890323
  16 C ORIG. 15/11/88 FCA
  17 C
  18       INTEGER A(NC,NR), HMIN, HMAX, TEMP
  19 C
  20       NCS=ABS(NS)
  21       IF(NCS.EQ.0)  GO TO 999
  22       IF(NCS.GT.NC) GO TO 999
  23       IF(NR.LE.1)   GO TO 999
  24       IF(NS.LE.0)   GO TO 31
  25
  26 C----              Ascending order
  27
  28       DO 30 J=1,NR-1
  29 #if defined(CERNLIB_QMAPO)
  30         LMIN = (LVSIMI(A(NCS,J),NR-J+1,NC)-1)/NC+J
  31 #else
  32         LMIN = J
  33         HMIN = A(NCS,J)
  34         DO 10 K=J+1,NR
  35           IF(HMIN.GT.A(NCS,K)) THEN
  36             HMIN = A(NCS,K)
  37             LMIN = K
  38           ENDIF
  39    10   CONTINUE
  40 #endif
  41         IF(LMIN.NE.J) THEN
  42           DO 25 L=LMIN, J, -1
  43             IF(A(NCS,L).EQ.A(NCS,J)) THEN
  44 #if defined(CERNLIB_QMAPO)||defined(CERNLIB_QMVAX)||(defined(CERNLIB_QMIBM)&&(!defined(CERNLIB_QMIBMVF)))
  45               CALL USWOP(A(1,LMIN),A(1,L),NC)
  46 #else
  47              DO 20 K=1,NC
  48                 TEMP      = A(K,LMIN)
  49                 A(K,LMIN) = A(K,L)
  50                 A(K,L)    = TEMP
  51    20         CONTINUE
  52 #endif
  53               LMIN = L
  54             ENDIF
  55    25     CONTINUE
  56         ENDIF
  57    30 CONTINUE
  58       GO TO 999
  59
  60 C----              Descending order
  61
  62    31 DO 60 J=1,NR-1
  63 #if defined(CERNLIB_QMAPO)
  64         LMAX = (LVSIMX(A(NCS,J),NR-J+1,NC)-1)/NC+J
  65 #else
  66         LMAX = J
  67         HMAX = A(NCS,J)
  68         DO 40 K=J+1,NR
  69           IF(HMAX.LT.A(NCS,K)) THEN
  70             HMAX = A(NCS,K)
  71             LMAX = K
  72           ENDIF
  73    40   CONTINUE
  74 #endif
  75         IF(LMAX.NE.J) THEN
  76           DO 55 L=LMAX, J, -1
  77             IF(A(NCS,L).EQ.A(NCS,J)) THEN
  78 #if defined(CERNLIB_QMAPO)||defined(CERNLIB_QMVAX)||(defined(CERNLIB_QMIBM)&&(!defined(CERNLIB_QMIBMVF)))
  79               CALL USWOP(A(1,LMAX),A(1,L),NC)
  80 #else
  81               DO 50 K=1,NC
  82                 TEMP      = A(K,LMAX)
  83                 A(K,LMAX) = A(K,L)
  84                 A(K,L)    = TEMP
  85    50         CONTINUE
  86 #endif
  87               LMAX = L
  88             ENDIF
  89    55     CONTINUE
  90         ENDIF
  91    60 CONTINUE
  92   999 RETURN
  93       END