[u/mrichter/AliRoot.git] / ISAJET / code / ordecr.F

#include "isajet/pilot.h"
      SUBROUTINE ORDECR(IA,IB,N)
C----------------------------------------------------------------------
C-
C-   Purpose and Methods : 
C-        return an ordered array (by size of absolute values)
C-        Warning: input array is destroyed
C-
C-   Inputs  : 
C-   IA(N) = input array
C-   Outputs : 
C-   IB(N) = output ordered array
C-
C-   Created   9-MAY-1988   Serban D. Protopopescu
C-
C----------------------------------------------------------------------
#if defined(CERNLIB_IMPNONE)
      IMPLICIT NONE
#endif
      INTEGER IA(*),IB(*),N,I,J,JSEL
C----------------------------------------------------------------------
      DO 2 I=1,N
        JSEL=0
        IB(I)=0
        DO 1 J=1,N
          IF(IABS(IA(J)).GT.IABS(IB(I))) THEN
            IB(I)=IA(J)
            JSEL=J
          ENDIF
    1   CONTINUE
        IF(JSEL.GT.0) IA(JSEL)=0
    2 CONTINUE
  999 RETURN
      END
Commit	Line	Data
0795afa3	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