This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / cgpack / cgfac2.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:19:43  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 *
13       SUBROUTINE CGFAC2(TVVX,TVVY,TVVZ,IN)
14 *
15 ********************************************************************
16 *                                                                  *
17 * Function: Order edges in world coordinates for every face        *
18 *                                                                  *
19 * I/O parameters:                                                  *
20 * TVVX,TVVY,TVVZ = set of edge's coordinates                       *
21 * IN = number of edges *2.                                         *
22 *                                                                  *
23 * Author: S. Giani                                                 *
24 *                                                                  *
25 ********************************************************************
26 *
27 #include "geant321/gcbank.inc"
28 #include "geant321/gcunit.inc"
29 #include "geant321/cggpar.inc"
30 #include "geant321/cgdelt.inc"
31 #include "geant321/cghpar.inc"
32 #include "geant321/cgctra.inc"
33 #include "geant321/cgcedg.inc"
34 #include "geant321/gcdraw.inc"
35 #include "geant321/gcflag.inc"
36 #include "geant321/gcspee.inc"
37 *
38       DIMENSION VVX(500),VVY(500),VVZ(500)
39       DIMENSION TVVX(500),TVVY(500),TVVZ(500)
40       DIMENSION IZ(500)
41 *
42       JSC=0
43       VVX(1)=TVVX(1)
44       VVY(1)=TVVY(1)
45       VVZ(1)=TVVZ(1)
46       VVX(2)=TVVX(2)
47       VVY(2)=TVVY(2)
48       VVZ(2)=TVVZ(2)
49       IZ(1)=1
50       IZ(2)=2
51       KZ=3
52       DO 143 II=3,IN,2
53        DO 144 JJ=3,IN
54         DO 9 KK=1,KZ-1
55          IF(JJ.EQ.IZ(KK))GOTO 144
56  9      CONTINUE
57           C11=ABS(TVVX(JJ)-VVX(II-1))
58           C12=ABS(TVVY(JJ)-VVY(II-1))
59           C13=ABS(TVVZ(JJ)-VVZ(II-1))
60           IF(C11.LT..001.AND.C12.LT..001.AND.C13.LT..001)THEN
61             VVX(II)=TVVX(JJ)
62             VVY(II)=TVVY(JJ)
63             VVZ(II)=TVVZ(JJ)
64             IZ(KZ)=JJ
65             AJ=JJ*.5
66             IAJ=AJ
67             PDAJ=AJ-IAJ
68             IF(PDAJ.GT..01)THEN
69               VVX(II+1)=TVVX(JJ+1)
70               VVY(II+1)=TVVY(JJ+1)
71               VVZ(II+1)=TVVZ(JJ+1)
72               IZ(KZ+1)=JJ+1
73               KZ=KZ+2
74             ELSE
75               VVX(II+1)=TVVX(JJ-1)
76               VVY(II+1)=TVVY(JJ-1)
77               VVZ(II+1)=TVVZ(JJ-1)
78               IZ(KZ+1)=JJ-1
79               KZ=KZ+2
80             ENDIF
81             GOTO 143
82           ENDIF
83  144   CONTINUE
84        DO 11 JJA=3,IN
85         DO 10 I=1,KZ-1
86         IF(JJA.EQ.IZ(I))GOTO 11
87  10     CONTINUE
88         JJAO=JJA
89         GOTO 12
90  11     CONTINUE
91         PRINT *,'Error in CGFACO'
92  12     CONTINUE
93         VVX(II)=TVVX(JJAO)
94         VVY(II)=TVVY(JJAO)
95         VVZ(II)=TVVZ(JJAO)
96         VVX(II+1)=TVVX(JJAO+1)
97         VVY(II+1)=TVVY(JJAO+1)
98         VVZ(II+1)=TVVZ(JJAO+1)
99         IZ(KZ)=JJAO
100         IZ(KZ+1)=JJAO+1
101         KZ=KZ+2
102         JSC=II-1
103  143  CONTINUE
104       DO 145 KK=1,IN
105        TVVX(KK)=VVX(KK)
106        TVVY(KK)=VVY(KK)
107        TVVZ(KK)=VVZ(KK)
108  145  CONTINUE
109 *
110  999  END
111