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

Go to the source code of this file.

Functions/Subroutines

subroutine kqsort (compf, ORD, N)
 

Function/Subroutine Documentation

◆ kqsort()

subroutine kqsort ( external  compf,
dimension(n ORD,
  N 
)

Definition at line 198 of file kqsort.f.

References i, n, p, x, y, and z.

198 !
199 !==============SORTS THE ARRAY A(I),I=1,2,...,N BY PUTTING THE
200 ! ASCENDING ORDER VECTOR IN ORD. THAT IS ASCENDING ORDERED A
201 ! IS A(ORD(I)),I=1,2,...,N; DESCENDING ORDER A IS A(ORD(N-I+1)),
202 ! I=1,2,...,N . THIS SORT RUNS IN TIME PROPORTIONAL TO N LOG N .
203 !
204 !
205 ! ACM QUICKSORT - ALGORITHM #402 - IMPLEMENTED IN FORTRAN BY
206 ! WILLIAM H. VERITY
207 ! COMPUTATION CENTER
208 ! PENNSYLVANIA STATE UNIVERSITY
209 ! UNIVERSITY PARK, PA. 16802
210 !
211  IMPLICIT INTEGER (A-Z)
212 !
213  dimension ord(n),poplst(2,20)
214  external compf
215 !c INTEGER X,XX,Z,ZZ,Y
216 !c CHARACTER *(*) A(N)
217 !
218  ndeep=0
219  u1=n
220  l1=1
221  DO 1 i=1,n
222  1 ord(i)=i
223  2 IF (u1.GT.l1) GO TO 3
224  RETURN
225 !
226  3 l=l1
227  u=u1
228 !
229 ! PART
230 !
231  4 p=l
232  q=u
233  x=ord(p)
234  z=ord(q)
235 
236 ! IF (A(X).LE.A(Z)) GO TO 5
237  if( compf(x, z) .le. 0 ) goto 5
238  y=x
239  x=z
240  z=y
241  yp=ord(p)
242  ord(p)=ord(q)
243  ord(q)=yp
244  5 IF (u-l.LE.1) GO TO 15
245  xx=x
246  ix=p
247  zz=z
248  iz=q
249 !
250 ! LEFT
251 !
252  6 p=p+1
253  IF (p.GE.q) GO TO 7
254  x=ord(p)
255 ! IF (A(X).GE.A(XX)) GO TO 8
256  if( compf(x, xx) .ge. 0) goto 8
257  GO TO 6
258  7 p=q-1
259  GO TO 13
260 !
261 ! RIGHT
262 !
263  8 q=q-1
264  IF (q.LE.p) GO TO 9
265  z=ord(q)
266 ! IF (A(Z).LE.A(ZZ)) GO TO 10
267  if( compf(z, zz) .le. 0) goto 10
268  GO TO 8
269  9 q=p
270  p=p-1
271  z=x
272  x=ord(p)
273 !
274 ! DIST
275 !
276 ! 10 IF (A(X).LE.A(Z)) GO TO 11
277  10 IF ( compf(x, z) .le. 0) goto 11
278  y=x
279  x=z
280  z=y
281  ip=ord(p)
282  ord(p)=ord(q)
283  ord(q)=ip
284 ! 11 IF (A(X).LE.A(XX)) GO TO 12
285  11 IF ( compf( x, xx) .le. 0) goto 12
286  xx=x
287  ix=p
288 ! 12 IF (A(Z).GE.A(ZZ)) GO TO 6
289  12 IF ( compf(z, zz) .ge. 0) goto 6
290  zz=z
291  iz=q
292  GO TO 6
293 !
294 ! OUT
295 !
296  13 CONTINUE
297 ! IF (.NOT.(P.NE.IX.AND.A(X).NE.A(XX))) GO TO 14
298  IF (.NOT.(p.NE.ix.AND. compf(x, xx) .ne. 0) ) goto 14
299  ip=ord(p)
300  ord(p)=ord(ix)
301  ord(ix)=ip
302  14 CONTINUE
303 ! IF (.NOT.(Q.NE.IZ.AND.A(Z).NE.A(ZZ))) GO TO 15
304  IF (.NOT.(q.NE.iz.AND. compf(z, zz) .ne. 0) ) goto 15
305  iq=ord(q)
306  ord(q)=ord(iz)
307  ord(iz)=iq
308  15 CONTINUE
309  IF (u-q.LE.p-l) GO TO 16
310  l1=l
311  u1=p-1
312  l=q+1
313  GO TO 17
314  16 u1=u
315  l1=q+1
316  u=p-1
317  17 CONTINUE
318  IF (u1.LE.l1) GO TO 18
319 !
320 ! START RECURSIVE CALL
321 !
322  ndeep=ndeep+1
323  poplst(1,ndeep)=u
324  poplst(2,ndeep)=l
325  GO TO 3
326  18 IF (u.GT.l) GO TO 4
327 !
328 ! POP BACK UP IN THE RECURSION LIST
329 !
330  IF (ndeep.EQ.0) GO TO 2
331  u=poplst(1,ndeep)
332  l=poplst(2,ndeep)
333  ndeep=ndeep-1
334  GO TO 18
335 !
336 ! END SORT
337 ! END QSORT
338 !
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
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