| fe4da5cc |
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 |
git://git.uio.no / u / mrichter / AliRoot.git / blame