[u/mrichter/AliRoot.git] / MINICERN / packlib / kernlib / kerngen / tcgen / sortd.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/02/15 17:49:50  mclareni
* Kernlib
*
*
#include "kerngen/pilot.h"
#if defined(CERNLIB_QMIBMVF)
@PROCESS DIRECTIVE('*VDIR:') VECTOR
#endif
      SUBROUTINE SORTD(A,NC,NR,NS)
C
C CERN PROGLIB# M107    SORTD           .VERSION KERNFOR  4.21  890323
C ORIG. 15/11/88 FCA
C
      DOUBLE PRECISION A(NC,NR), HMIN, HMAX, TEMP
C
      NCS=ABS(NS)
      IF(NCS.EQ.0)  GO TO 999
      IF(NCS.GT.NC) GO TO 999
      IF(NR.LE.1)   GO TO 999
      IF(NS.LE.0)   GO TO 31

C----              Ascending order

      DO 30 J=1,NR-1
#if defined(CERNLIB_QMAPO)
        LMIN = (LVSDMI(A(NCS,J),NR-J+1,NC)-1)/NC+J
#else
        LMIN = J
        HMIN = A(NCS,J)
        DO 10 K=J+1,NR
          IF(HMIN.GT.A(NCS,K)) THEN
            HMIN = A(NCS,K)
            LMIN = K
          ENDIF
   10   CONTINUE
#endif
        IF(LMIN.NE.J) THEN
          DO 25 L=LMIN, J, -1
            IF(A(NCS,L).EQ.A(NCS,J)) THEN
#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMAPO)||(defined(CERNLIB_QMIBM)&&(!defined(CERNLIB_QMIBMVF)))
              CALL USWOP(A(1,LMIN),A(1,L),2*NC)
#else
              DO 20 K=1,NC
                TEMP      = A(K,LMIN)
                A(K,LMIN) = A(K,L)
                A(K,L)    = TEMP
   20         CONTINUE
#endif
              LMIN = L
            ENDIF
   25     CONTINUE
        ENDIF
   30 CONTINUE
      GO TO 999

C----              Descending order

   31 DO 60 J=1,NR-1
#if defined(CERNLIB_QMAPO)
        LMAX = (LVSDMX(A(NCS,J),NR-J+1,NC)-1)/NC+J
#else
        LMAX = J
        HMAX = A(NCS,J)
        DO 40 K=J+1,NR
          IF(HMAX.LT.A(NCS,K)) THEN
            HMAX = A(NCS,K)
            LMAX = K
          ENDIF
   40   CONTINUE
#endif
        IF(LMAX.NE.J) THEN
          DO 55 L=LMAX, J, -1
            IF(A(NCS,L).EQ.A(NCS,J)) THEN
#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMAPO)||(defined(CERNLIB_QMIBM)&&(!defined(CERNLIB_QMIBMVF)))
              CALL USWOP(A(1,LMAX),A(1,L),2*NC)
#else
              DO 50 K=1,NC
                TEMP      = A(K,LMAX)
                A(K,LMAX) = A(K,L)
                A(K,L)    = TEMP
   50         CONTINUE
#endif
              LMAX = L
            ENDIF
   55     CONTINUE
        ENDIF
   60 CONTINUE
  999 RETURN
      END
Commit	Line	Data
fe4da5cc	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 SORTD(A,NC,NR,NS)
	14	C
	15	C CERN PROGLIB# M107 SORTD .VERSION KERNFOR 4.21 890323
	16	C ORIG. 15/11/88 FCA
	17	C
	18	DOUBLE PRECISION 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 = (LVSDMI(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_QMVAX)\|\|defined(CERNLIB_QMAPO)\|\|(defined(CERNLIB_QMIBM)&&(!defined(CERNLIB_QMIBMVF)))
	45	CALL USWOP(A(1,LMIN),A(1,L),2*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 = (LVSDMX(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_QMVAX)\|\|defined(CERNLIB_QMAPO)\|\|(defined(CERNLIB_QMIBM)&&(!defined(CERNLIB_QMIBMVF)))
79	CALL USWOP(A(1,LMAX),A(1,L),2*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