GEANT321/cgpack/cgbsor.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:19:42  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.31  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE CGBSOR(NEDGE,EDGE)
  13 ************************************************************************
  14 *                                                                      *
  15 *     Name: CGBSOR                                                     *
  16 *     Author: E. Chernyaev                       Date:    15.03.89     *
  17 *                                                Revised:              *
  18 *                                                                      *
  19 *     Function: Shell sort of edges                                    *
  20 *                                                                      *
  21 *     References: none                                                 *
  22 *                                                                      *
  23 *     Input:  NEDGE - number of edges                                  *
  24 *     Output: EDGE(*,*)  - edges                                       *
  25 *                                                                      *
  26 *     Output:                                                          *
  27 *                                                                      *
  28 *     Errors: none                                                     *
  29 *                                                                      *
  30 ************************************************************************
  31 #include "geant321/cggpar.inc"
  32 #include "geant321/cgdelt.inc"
  33       REAL      EDGE(LCGEDG,*)
  34 *-
  35       ERROR  = 1.5*EEWOR
  36       ATRINV = 4.
  37       CALL CGSHEL(ATRINV,ERROR,NEDGE,EDGE)
  38 *
  39 **          D E L E T E   D O U B L E   E D G E S
  40 **          A T R I B U T E   A N A L I S A T I O N
  41 *
  42       IF (NEDGE .LE. 0)                 GOTO 999
  43       IF (NEDGE .EQ. 1)                 GOTO 810
  44       J       = 1
  45       NSAME = 1
  46       DO 800 NE=2,NEDGE
  47         IF (J .EQ. 0)                   GOTO 720
  48         IF (ABS(EDGE(KCGX1,NE)-EDGE(KCGX1,J)) .GT. ERROR) GOTO 720
  49         IF (ABS(EDGE(KCGY1,NE)-EDGE(KCGY1,J)) .GT. ERROR) GOTO 720
  50         IF (ABS(EDGE(KCGZ1,NE)-EDGE(KCGZ1,J)) .GT. ERROR) GOTO 720
  51         IF (ABS(EDGE(KCGX2,NE)-EDGE(KCGX2,J)) .GT. ERROR) GOTO 720
  52         IF (ABS(EDGE(KCGY2,NE)-EDGE(KCGY2,J)) .GT. ERROR) GOTO 720
  53         IF (ABS(EDGE(KCGZ2,NE)-EDGE(KCGZ2,J)) .GT. ERROR) GOTO 720
  54 *           A T R I B U T E   A N A L I S A T I O N
  55         AJ     = EDGE(KCGAE,J)
  56         ANE    = EDGE(KCGAE,NE)
  57         IF (AJ .EQ. ANE)                GOTO 705
  58         IF (AJ.LE.-4. .AND. ANE.GT.-4.) GOTO 710
  59         IF (AJ.GT.-4. .AND. ANE.LE.-4.) GOTO 710
  60         IF (AJ .GT. ANE)                EDGE(KCGAE,J) = EDGE(KCGAE,NE)
  61   705   EDGE(KCGX1,J)=((EDGE(KCGX1,J)*NSAME)+EDGE(KCGX1,NE))/(NSAME+1)
  62         EDGE(KCGY1,J)=((EDGE(KCGY1,J)*NSAME)+EDGE(KCGY1,NE))/(NSAME+1)
  63         EDGE(KCGZ1,J)=((EDGE(KCGZ1,J)*NSAME)+EDGE(KCGZ1,NE))/(NSAME+1)
  64         EDGE(KCGX2,J)=((EDGE(KCGX2,J)*NSAME)+EDGE(KCGX2,NE))/(NSAME+1)
  65         EDGE(KCGY2,J)=((EDGE(KCGY2,J)*NSAME)+EDGE(KCGY2,NE))/(NSAME+1)
  66         EDGE(KCGZ2,J)=((EDGE(KCGZ2,J)*NSAME)+EDGE(KCGZ2,NE))/(NSAME+1)
  67         NSAME = NSAME + 1
  68         GOTO 800
  69 *
  70   710   J      = J - 1
  71         GOTO 800
  72 *
  73   720   J      = J + 1
  74         EDGE(KCGAE,J) = EDGE(KCGAE,NE)
  75         EDGE(KCGX1,J) = EDGE(KCGX1,NE)
  76         EDGE(KCGY1,J) = EDGE(KCGY1,NE)
  77         EDGE(KCGZ1,J) = EDGE(KCGZ1,NE)
  78         EDGE(KCGX2,J) = EDGE(KCGX2,NE)
  79         EDGE(KCGY2,J) = EDGE(KCGY2,NE)
  80         EDGE(KCGZ2,J) = EDGE(KCGZ2,NE)
  81         NSAME = 1
  82   800   CONTINUE
  83       NEDGE  = J
  84 *
  85   810 DO 900 NE=1,NEDGE
  86         ANE    = EDGE(KCGAE,NE)
  87         IF (ANE .GE. -3.)       GOTO 850
  88         ANE    = ANE + 4.
  89         X      = EDGE(KCGX1,NE)
  90         Y      = EDGE(KCGY1,NE)
  91         Z      = EDGE(KCGZ1,NE)
  92         EDGE(KCGX1,NE) = EDGE(KCGX2,NE)
  93         EDGE(KCGY1,NE) = EDGE(KCGY2,NE)
  94         EDGE(KCGZ1,NE) = EDGE(KCGZ2,NE)
  95         EDGE(KCGX2,NE) = X
  96         EDGE(KCGY2,NE) = Y
  97         EDGE(KCGZ2,NE) = Z
  98   850   IF (ANE .LT. -1.)       ANE = ANE + 2.
  99         EDGE(KCGAE,NE) = ANE
 100   900   CONTINUE
 101 *
 102   999 RETURN
 103       END