[u/mrichter/AliRoot.git] / GEANT321 / cgpack / cgwsor.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:19:45  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.32  by  S.Giani
*-- Author :
      SUBROUTINE CGWSOR(NWIRE,WIRE)
************************************************************************
*                                                                      *
*     Name: CGWSOR                                                     *
*     Author: E. Chernyaev                       Date:    16.04.89     *
*                                                Revised:              *
*                                                                      *
*     Function: Prepare wire array                                     *
*                                                                      *
*     References: CGSHEL                                               *
*                                                                      *
*     Input:  NWIRE - number of edges                                  *
*     Output: WIRE(*,*)  - edges                                       *
*                                                                      *
*     Output:                                                          *
*                                                                      *
*     Errors: none                                                     *
*                                                                      *
************************************************************************
#include "geant321/cggpar.inc"
#include "geant321/cgdelt.inc"
      REAL      WIRE(LCGEDG,*),SAVE(LCGEDG)
*-
      ERROR  = 1.5*EEWOR
      NE     = 0
      ATRINV = 0.
      CALL CGSHEL(ATRINV,ERROR,NWIRE,WIRE)
      IF (NWIRE .LE. 0)                 GOTO 999
*
**          D E L E T E   U N V I S I B L E    D O U B L E  E D G E S
**          A T R I B U T E   A N A L I S A T I O N
*
      J      = 1
  100 IF (J .GT. NWIRE)                 GOTO 999
      A1          = WIRE(KCGAE,J)
      SAVE(KCGX1) = WIRE(KCGX1,J)
      SAVE(KCGY1) = WIRE(KCGY1,J)
      SAVE(KCGZ1) = WIRE(KCGZ1,J)
      SAVE(KCGX2) = WIRE(KCGX2,J)
      SAVE(KCGY2) = WIRE(KCGY2,J)
      SAVE(KCGZ2) = WIRE(KCGZ2,J)
      J     = J + 1
  150 IF (J .GT. NWIRE)                                 GOTO 200
      IF (ABS(WIRE(KCGX1,J)-SAVE(KCGX1)) .GT. ERROR)    GOTO 200
      IF (ABS(WIRE(KCGY1,J)-SAVE(KCGY1)) .GT. ERROR)    GOTO 200
      IF (ABS(WIRE(KCGZ1,J)-SAVE(KCGZ1)) .GT. ERROR)    GOTO 200
      IF (ABS(WIRE(KCGX2,J)-SAVE(KCGX2)) .GT. ERROR)    GOTO 200
      IF (ABS(WIRE(KCGY2,J)-SAVE(KCGY2)) .GT. ERROR)    GOTO 200
      IF (ABS(WIRE(KCGZ2,J)-SAVE(KCGZ2)) .GT. ERROR)    GOTO 200
*           D O U B L E   W I R E
      A2     = WIRE(KCGAE,J)
      J      = J + 1
      IF (A1.LT.0. .AND. A2.LT.0.)                      GOTO 100
      IF (A1.LT.0.)                                     A1 =-A1 - 1.
      IF (A2.LT.0.)                                     A2 =-A2 - 1.
      IF (A2.GT.A1)                                     A1 = A2
      GOTO 150
*           I N S E R T   I N   W I R E (*)
  200 NE      = NE + 1
      IF (A1.LT.0.)                                     A1 =-A1 - 1.
      WIRE(KCGAE,NE) = A1
      WIRE(KCGX1,NE) = SAVE(KCGX1)
      WIRE(KCGY1,NE) = SAVE(KCGY1)
      WIRE(KCGZ1,NE) = SAVE(KCGZ1)
      WIRE(KCGX2,NE) = SAVE(KCGX2)
      WIRE(KCGY2,NE) = SAVE(KCGY2)
      WIRE(KCGZ2,NE) = SAVE(KCGZ2)
      GOTO 100
*
  999 NWIRE  = NE
      RETURN
      END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1995/10/24 10:19:45 cernlib
	6	* Geant
	7	*
	8	*
	9	#include "geant321/pilot.h"
	10	*CMZ : 3.21/02 29/03/94 15.41.32 by S.Giani
	11	*-- Author :
	12	SUBROUTINE CGWSOR(NWIRE,WIRE)
	13	************************************************************************
	14	* *
	15	* Name: CGWSOR *
	16	* Author: E. Chernyaev Date: 16.04.89 *
	17	* Revised: *
	18	* *
	19	* Function: Prepare wire array *
	20	* *
	21	* References: CGSHEL *
	22	* *
	23	* Input: NWIRE - number of edges *
	24	* Output: WIRE(,) - edges *
	25	* *
	26	* Output: *
	27	* *
	28	* Errors: none *
	29	* *
	30	************************************************************************
	31	#include "geant321/cggpar.inc"
	32	#include "geant321/cgdelt.inc"
	33	REAL WIRE(LCGEDG,*),SAVE(LCGEDG)
	34	*-
	35	ERROR = 1.5*EEWOR
	36	NE = 0
	37	ATRINV = 0.
	38	CALL CGSHEL(ATRINV,ERROR,NWIRE,WIRE)
	39	IF (NWIRE .LE. 0) GOTO 999
	40	*
	41	** D E L E T E U N V I S I B L E D O U B L E E D G E S
	42	** A T R I B U T E A N A L I S A T I O N
	43	*
	44	J = 1
	45	100 IF (J .GT. NWIRE) GOTO 999
	46	A1 = WIRE(KCGAE,J)
	47	SAVE(KCGX1) = WIRE(KCGX1,J)
	48	SAVE(KCGY1) = WIRE(KCGY1,J)
	49	SAVE(KCGZ1) = WIRE(KCGZ1,J)
	50	SAVE(KCGX2) = WIRE(KCGX2,J)
	51	SAVE(KCGY2) = WIRE(KCGY2,J)
	52	SAVE(KCGZ2) = WIRE(KCGZ2,J)
	53	J = J + 1
	54	150 IF (J .GT. NWIRE) GOTO 200
	55	IF (ABS(WIRE(KCGX1,J)-SAVE(KCGX1)) .GT. ERROR) GOTO 200
	56	IF (ABS(WIRE(KCGY1,J)-SAVE(KCGY1)) .GT. ERROR) GOTO 200
	57	IF (ABS(WIRE(KCGZ1,J)-SAVE(KCGZ1)) .GT. ERROR) GOTO 200
	58	IF (ABS(WIRE(KCGX2,J)-SAVE(KCGX2)) .GT. ERROR) GOTO 200
	59	IF (ABS(WIRE(KCGY2,J)-SAVE(KCGY2)) .GT. ERROR) GOTO 200
	60	IF (ABS(WIRE(KCGZ2,J)-SAVE(KCGZ2)) .GT. ERROR) GOTO 200
	61	* D O U B L E W I R E
	62	A2 = WIRE(KCGAE,J)
	63	J = J + 1
	64	IF (A1.LT.0. .AND. A2.LT.0.) GOTO 100
65	IF (A1.LT.0.) A1 =-A1 - 1.
66	IF (A2.LT.0.) A2 =-A2 - 1.
67	IF (A2.GT.A1) A1 = A2
68	GOTO 150
69	* I N S E R T I N W I R E (*)
70	200 NE = NE + 1
71	IF (A1.LT.0.) A1 =-A1 - 1.
72	WIRE(KCGAE,NE) = A1
73	WIRE(KCGX1,NE) = SAVE(KCGX1)
74	WIRE(KCGY1,NE) = SAVE(KCGY1)
75	WIRE(KCGZ1,NE) = SAVE(KCGZ1)
76	WIRE(KCGX2,NE) = SAVE(KCGX2)
77	WIRE(KCGY2,NE) = SAVE(KCGY2)
78	WIRE(KCGZ2,NE) = SAVE(KCGZ2)
79	GOTO 100
80	*
81	999 NWIRE = NE
82	RETURN
83	END