COSMOS v7.655  COSMOSv7655
(AirShowerMC)
kqsorti.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine kqsorti (A, ORD, N)
 

Function/Subroutine Documentation

◆ kqsorti()

subroutine kqsorti ( integer, dimension(n A,
dimension(n ORD,
  N 
)

Definition at line 23 of file kqsorti.f.

References i, n, and p.

23 !
24 !==============SORTS THE ARRAY A(I),I=1,2,...,N BY PUTTING THE
25 ! ASCENDING ORDER VECTOR IN ORD. THAT IS ASCENDING ORDERED A
26 ! IS A(ORD(I)),I=1,2,...,N; DESCENDING ORDER A IS A(ORD(N-I+1)),
27 ! I=1,2,...,N . THIS SORT RUNS IN TIME PROPORTIONAL TO N LOG N .
28 !
29 !
30 ! ACM QUICKSORT - ALGORITHM #402 - IMPLEMENTED IN FORTRAN 66 BY
31 ! WILLIAM H. VERITY, WHV@PSUVM.PSU.EDU
32 ! CENTER FOR ACADEMIC COMPUTING
33 ! THE PENNSYLVANIA STATE UNIVERSITY
34 ! UNIVERSITY PARK, PA. 16802
35 !
36  IMPLICIT INTEGER (A-Z)
37 !
38  dimension ord(n),poplst(2,20)
39  INTEGER x,xx,z,zz,y
40 !
41 ! TO SORT DIFFERENT INPUT TYPES, CHANGE THE FOLLOWING
42 ! SPECIFICATION STATEMENTS; FOR EXAMPLE, FOR FORTRAN CHARACTER
43 ! USE THE FOLLOWING: CHARACTER *(*) A(N)
44 !
45  INTEGER a(n)
46 !
47  ndeep=0
48  u1=n
49  l1=1
50  DO 1 i=1,n
51  1 ord(i)=i
52  2 IF (u1.LE.l1) RETURN
53 !
54  3 l=l1
55  u=u1
56 !
57 ! PART
58 !
59  4 p=l
60  q=u
61 ! FOR CHARACTER SORTS, THE FOLLOWING 3 STATEMENTS WOULD BECOME
62 ! X = ORD(P)
63 ! Z = ORD(Q)
64 ! IF (A(X) .LE. A(Z)) GO TO 2
65 !
66 ! WHERE "CLE" IS A LOGICAL FUNCTION WHICH RETURNS "TRUE" IF THE
67 ! FIRST ARGUMENT IS LESS THAN OR EQUAL TO THE SECOND, BASED ON "LEN"
68 ! CHARACTERS.
69 !
70  x=a(ord(p))
71  z=a(ord(q))
72  IF (x.LE.z) GO TO 5
73  y=x
74  x=z
75  z=y
76  yp=ord(p)
77  ord(p)=ord(q)
78  ord(q)=yp
79  5 IF (u-l.LE.1) GO TO 15
80  xx=x
81  ix=p
82  zz=z
83  iz=q
84 !
85 ! LEFT
86 !
87  6 p=p+1
88  IF (p.GE.q) GO TO 7
89  x=a(ord(p))
90  IF (x.GE.xx) GO TO 8
91  GO TO 6
92  7 p=q-1
93  GO TO 13
94 !
95 ! RIGHT
96 !
97  8 q=q-1
98  IF (q.LE.p) GO TO 9
99  z=a(ord(q))
100  IF (z.LE.zz) GO TO 10
101  GO TO 8
102  9 q=p
103  p=p-1
104  z=x
105  x=a(ord(p))
106 !
107 ! DIST
108 !
109  10 IF (x.LE.z) GO TO 11
110  y=x
111  x=z
112  z=y
113  ip=ord(p)
114  ord(p)=ord(q)
115  ord(q)=ip
116  11 IF (x.LE.xx) GO TO 12
117  xx=x
118  ix=p
119  12 IF (z.GE.zz) GO TO 6
120  zz=z
121  iz=q
122  GO TO 6
123 !
124 ! OUT
125 !
126  13 CONTINUE
127  IF (.NOT.(p.NE.ix.AND.x.NE.xx)) GO TO 14
128  ip=ord(p)
129  ord(p)=ord(ix)
130  ord(ix)=ip
131  14 CONTINUE
132  IF (.NOT.(q.NE.iz.AND.z.NE.zz)) GO TO 15
133  iq=ord(q)
134  ord(q)=ord(iz)
135  ord(iz)=iq
136  15 CONTINUE
137  IF (u-q.LE.p-l) GO TO 16
138  l1=l
139  u1=p-1
140  l=q+1
141  GO TO 17
142  16 u1=u
143  l1=q+1
144  u=p-1
145  17 CONTINUE
146  IF (u1.LE.l1) GO TO 18
147 !
148 ! START RECURSIVE CALL
149 !
150  ndeep=ndeep+1
151  poplst(1,ndeep)=u
152  poplst(2,ndeep)=l
153  GO TO 3
154  18 IF (u.GT.l) GO TO 4
155 !
156 ! POP BACK UP IN THE RECURSION LIST
157 !
158  IF (ndeep.EQ.0) GO TO 2
159  u=poplst(1,ndeep)
160  l=poplst(2,ndeep)
161  ndeep=ndeep-1
162  GO TO 18
163 !
164 ! END SORT
165 ! END QSORT
166 !
nodes z
nodes i
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
latitude latitude this system is used *****************************************************************! type coord sequence union map real y
Definition: Zcoord.h:25
real(4), save a
Definition: cNRLAtmos.f:20
integer n
Definition: Zcinippxc.h:1
! structure defining a particle at production ! Basic idea of what is to be contained in ! the particle structue is that dynamical ones should be included those derivable from the particle code ! is not included ******************************************************type fmom momentum sequence union map real e endmap map real * x
Definition: Zptcl.h:21