* * $Id: sortzv.F,v 1.1 2013/06/12 18:41:16 jamieson Exp $ * * $Log: sortzv.F,v $ * Revision 1.1 2013/06/12 18:41:16 jamieson * Further fixes to make compiling without cernlib possible for running on WCSim input * * Revision 1.1 2006/02/14 01:42:55 schubert * * First commit. geant321+_vmc Version 1.3 * * Revision 1.1.1.1 2002/07/24 15:56:27 rdm * initial import into CVS * * Revision 1.1.1.1 2002/06/16 15:18:47 hristov * Separate distribution of Geant3 * * Revision 1.1.1.1 1999/05/18 15:55:29 fca * AliRoot sources * * Revision 1.1.1.1 1996/02/15 17:49:50 mclareni * Kernlib * * * #include "kerngen/pilot.h" SUBROUTINE SORTZV (A,INDEX,N1,MODE,NWAY,NSORT) C C CERN PROGLIB# M101 SORTZV .VERSION KERNFOR 3.15 820113 C ORIG. 02/10/75 C DIMENSION A(N1),INDEX(N1) C C N = N1 IF (N.LE.0) RETURN IF (NSORT.NE.0) GO TO 2 DO 1 I=1,N 1 INDEX(I)=I C 2 IF (N.EQ.1) RETURN IF (MODE) 10,20,30 10 CALL SORTTI (A,INDEX,N) GO TO 40 C 20 CALL SORTTC(A,INDEX,N) GO TO 40 C 30 CALL SORTTF (A,INDEX,N) C 40 IF (NWAY.EQ.0) GO TO 50 N2 = N/2 DO 41 I=1,N2 ISWAP = INDEX(I) K = N+1-I INDEX(I) = INDEX(K) 41 INDEX(K) = ISWAP 50 RETURN END * ======================================== SUBROUTINE SORTTF (A,INDEX,N1) C DIMENSION A(N1),INDEX(N1) C N = N1 DO 3 I1=2,N I3 = I1 I33 = INDEX(I3) AI = A(I33) 1 I2 = I3/2 IF (I2) 3,3,2 2 I22 = INDEX(I2) IF (AI.LE.A (I22)) GO TO 3 INDEX (I3) = I22 I3 = I2 GO TO 1 3 INDEX (I3) = I33 4 I3 = INDEX (N) INDEX (N) = INDEX (1) AI = A(I3) N = N-1 IF (N-1) 12,12,5 5 I1 = 1 6 I2 = I1 + I1 IF (I2.LE.N) I22= INDEX(I2) IF (I2-N) 7,9,11 7 I222 = INDEX (I2+1) IF (A(I22)-A(I222)) 8,9,9 8 I2 = I2+1 I22 = I222 9 IF (AI-A(I22)) 10,11,11 10 INDEX(I1) = I22 I1 = I2 GO TO 6 11 INDEX (I1) = I3 GO TO 4 12 INDEX (1) = I3 RETURN END * ======================================== SUBROUTINE SORTTI (A,INDEX,N1) C INTEGER A,AI DIMENSION A(N1),INDEX(N1) C N = N1 DO 3 I1=2,N I3 = I1 I33 = INDEX(I3) AI = A(I33) 1 I2 = I3/2 IF (I2) 3,3,2 2 I22 = INDEX(I2) IF (AI.LE.A (I22)) GO TO 3 INDEX (I3) = I22 I3 = I2 GO TO 1 3 INDEX (I3) = I33 4 I3 = INDEX (N) INDEX (N) = INDEX (1) AI = A(I3) N = N-1 IF (N-1) 12,12,5 5 I1 = 1 6 I2 = I1 + I1 IF (I2.LE.N) I22= INDEX(I2) IF (I2-N) 7,9,11 7 I222 = INDEX (I2+1) IF (A(I22)-A(I222)) 8,9,9 8 I2 = I2+1 I22 = I222 9 IF (AI-A(I22)) 10,11,11 10 INDEX(I1) = I22 I1 = I2 GO TO 6 11 INDEX (I1) = I3 GO TO 4 12 INDEX (1) = I3 RETURN END * ======================================== SUBROUTINE SORTTC (A,INDEX,N1) C INTEGER A,AI DIMENSION A(N1),INDEX(N1) C N = N1 DO 3 I1=2,N I3 = I1 I33 = INDEX(I3) AI = A(I33) 1 I2 = I3/2 IF (I2) 3,3,2 2 I22 = INDEX(I2) IF(ICMPCH(AI,A(I22)))3,3,21 21 INDEX (I3) = I22 I3 = I2 GO TO 1 3 INDEX (I3) = I33 4 I3 = INDEX (N) INDEX (N) = INDEX (1) AI = A(I3) N = N-1 IF (N-1) 12,12,5 5 I1 = 1 6 I2 = I1 + I1 IF (I2.LE.N) I22= INDEX(I2) IF (I2-N) 7,9,11 7 I222 = INDEX (I2+1) IF (ICMPCH(A(I22),A(I222))) 8,9,9 8 I2 = I2+1 I22 = I222 9 IF (ICMPCH(AI,A(I22))) 10,11,11 10 INDEX(I1) = I22 I1 = I2 GO TO 6 11 INDEX (I1) = I3 GO TO 4 12 INDEX (1) = I3 RETURN END * ======================================== FUNCTION ICMPCH(IC1,IC2) C FUNCTION TO COMPARE TWO 4 CHARACTER EBCDIC STRINGS - IC1,IC2 C ICMPCH=-1 IF HEX VALUE OF IC1 IS LESS THAN IC2 C ICMPCH=0 IF HEX VALUES OF IC1 AND IC2 ARE THE SAME C ICMPCH=+1 IF HEX VALUES OF IC1 IS GREATER THAN IC2 I1=IC1 I2=IC2 IF(I1.GE.0.AND.I2.GE.0)GOTO 40 IF(I1.GE.0)GOTO 60 IF(I2.GE.0)GOTO 80 I1=-I1 I2=-I2 IF(I1-I2)80,70,60 40 IF(I1-I2)60,70,80 60 ICMPCH=-1 RETURN 70 ICMPCH=0 RETURN 80 ICMPCH=1 RETURN END