Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / cgpack / cgwire.F
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 CGWIRE(CG,NTRAN,IFHIDE,NMAX,WIRE,ISHAPE,SHADE)
13 ************************************************************************
14 *                                                                      *
15 *     Name: CGWIRE                                                     *
16 *     Author: E. Chernyaev                       Date:    15.04.88     *
17 *     Revised by: S.Giani                        Date:    24.04.91     *
18 *                                                                      *
19 *     Function: Transfer CG-object to WIRE-object                      *
20 *                                                                      *
21 *     References: CGTSTR, CGFVIS, CGWSOR                               *
22 *                                                                      *
23 *     Input:  CG - CG-object                                           *
24 *             NT - number of transformation to screen coordinates      *
25 *         IFHIDE - flag ( 0 - all edges,-1 - only not hidden)          *
26 *          NMAX  - max-length of WIRE array                            *
27 *                                                                      *
28 *     Output: WIRE - WIRE-object                                       *
29 *                    WIRE(1) - length of WIRE-object                   *
30 *                        = 0 if error in CG-object structure           *
31 *                        < 0 if no space in WIRE array or error        *
32 *                            in parameters                             *
33 *     Errors: none                                                     *
34 *                                                                      *
35 ************************************************************************
36 #include "geant321/cggpar.inc"
37 #include "geant321/cgctra.inc"
38 *SG
39 #include "geant321/gcdraw.inc"
40 #include "geant321/gcgobj.inc"
41 #include "geant321/gcspee.inc"
42 *SG
43       REAL      CG(*),WIRE(*)
44       INTEGER   SHADE(*)
45 *-
46       LLEP=ABS(LEP)
47       WIRE(1)= 0.
48       IF(LLEP.NE.1)SHADE(1)=0.
49       MMM=1
50 *           T E S T   P A R A M E T E R S
51       IF (NTRAN .LE. 0)                 GOTO 999
52       IF (NTRAN .GT. NTMAX)             GOTO 999
53       IF (NMAX  .LE. 0)                 GOTO 999
54       CALL CGTSTR(CG,IREP)
55       IF (IREP .LT. 0)                  GOTO 999
56       NFACE  = CG(KCGNF)
57 *SG
58       IF (NFACE .EQ. 0)THEN
59          WIRE(KCGNF)=0
60          GOTO 999
61       ENDIF
62 *SG
63 *           I N I T I A L I S A T I O N
64       NWIRE  = 0
65       JCG    = LCGHEA
66       JWR    = LCGHEA
67 *
68 **          L O O P   A L O N G   F A C E S
69 *SG
70       NTIM=0
71 *SG
72       DO 300 NF=1,NFACE
73         JCGFAC = JCG
74         NEDGE  = CG(JCG+KCGNE)
75 *           D E F I N E   V A L U E   O F  "IFVIS"
76         IFVIS  = -1
77         IF (IFHIDE .NE. 0)              GOTO 200
78         JCG    = JCG + LCGFAC
79         DO 100 NE=1,NEDGE
80           IF (CG(JCG+KCGAE) .LT. 0.)    GOTO 200
81           JCG   = JCG + LCGEDG
82   100     CONTINUE
83         IFVIS = 0
84         GOTO 210
85 *
86 **           T E S T   F A C E   V I S I B I L I T Y
87 **           M O V E   E D G E S   T O   W I R E - O B J E C T
88 *
89   200   CALL CGFARE(NTRAN,CG(JCGFAC+1),IFVIS,ISHAPE)
90   210   IF (IFHIDE.NE.0 .AND. IFVIS.LT.0)       GOTO 290
91         JCG    = JCGFAC
92         AFACE  = CG(JCG+KCGAF)
93         JCG    = JCG + LCGFAC
94         DO 250 NE=1,NEDGE
95           IF (CG(JCG+KCGAE) .LT. 0.)            AEDGE =-AFACE - 1
96           IF (CG(JCG+KCGAE) .GE. 0.)            AEDGE = AFACE
97           IF (AEDGE.LT.0. .AND. IFVIS.LT.0)     GOTO 240
98           IF (NCLAS3+JWR+LCGEDG .GT. NMAX)             GOTO 220
99           WIRE(JWR+KCGAE) = AEDGE
100           WIRE(JWR+KCGX1) = CG(JCG+KCGX1)
101           WIRE(JWR+KCGY1) = CG(JCG+KCGY1)
102           WIRE(JWR+KCGZ1) = CG(JCG+KCGZ1)
103           WIRE(JWR+KCGX2) = CG(JCG+KCGX2)
104           WIRE(JWR+KCGY2) = CG(JCG+KCGY2)
105           WIRE(JWR+KCGZ2) = CG(JCG+KCGZ2)
106   220     NWIRE  = NWIRE + 1
107           JWR    = JWR + LCGEDG
108   240     JCG    = JCG + LCGEDG
109   250     CONTINUE
110         MMM=MMM+1
111         IF(LLEP.NE.1)SHADE(MMM)=NWIRE
112   290   JCG    = JCGFAC + LCGFAC + NEDGE*LCGEDG
113   300   CONTINUE
114 *
115 **          D E L E T E  V E R Y   S M A L L   W I R E S
116 **          S E T   N E E D E D   D I R E C T I O N
117 **          S O R T   W I R E S
118 *
119 *SG
120 *        Finding the total number of words needed to build
121 *        the whole Wire Structure.
122 *
123       NCLAS3=NCLAS3+JWR
124       IF(NCLAS3.GE.NMAX)THEN
125          KCGST=-8
126          GOTO 999
127       ENDIF
128 *SG
129       IF (JWR .GT. NMAX)        GOTO 998
130 *SG
131       LINFIL=IBITS(LINATT,13,3)
132       IF(LINFIL.EQ.0)CALL CGWSOR(NWIRE,WIRE(KCGNF+1))
133 *SG
134       WIRE(KCGSIZ) = LCGHEA + NWIRE*LCGEDG
135       IF(LLEP.NE.1)SHADE(1)=MMM
136       WIRE(KCGATT) = CG(KCGATT)
137       WIRE(KCGNF)  = NWIRE
138       GOTO 999
139 *
140   998 WIRE(KCGSIZ) = NMAX - JWR
141   999 RETURN
142       END