ISAJET/code/ordecr.F

   1 #include "isajet/pilot.h"
   2       SUBROUTINE ORDECR(IA,IB,N)
   3 C----------------------------------------------------------------------
   4 C-
   5 C-   Purpose and Methods :
   6 C-        return an ordered array (by size of absolute values)
   7 C-        Warning: input array is destroyed
   8 C-
   9 C-   Inputs  :
  10 C-   IA(N) = input array
  11 C-   Outputs :
  12 C-   IB(N) = output ordered array
  13 C-
  14 C-   Created   9-MAY-1988   Serban D. Protopopescu
  15 C-
  16 C----------------------------------------------------------------------
  17 #if defined(CERNLIB_IMPNONE)
  18       IMPLICIT NONE
  19 #endif
  20       INTEGER IA(*),IB(*),N,I,J,JSEL
  21 C----------------------------------------------------------------------
  22       DO 2 I=1,N
  23         JSEL=0
  24         IB(I)=0
  25         DO 1 J=1,N
  26           IF(IABS(IA(J)).GT.IABS(IB(I))) THEN
  27             IB(I)=IA(J)
  28             JSEL=J
  29           ENDIF
  30     1   CONTINUE
  31         IF(JSEL.GT.0) IA(JSEL)=0
  32     2 CONTINUE
  33   999 RETURN
  34       END