This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / cgpack / cgpers.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:19:44  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 CGPERS(CG)
13 ************************************************************************
14 *                                                                      *
15 *     Name: CGPERS                                                     *
16 *     Author: S.Giani                            Date:    22.05.92     *
17 *                                                                      *
18 *     Function: Transform CG object according to  perspective view     *
19 *                                                                      *
20 *     References: none                                                 *
21 *                                                                      *
22 *     Input:  CG - CG-object                                           *
23 *     Output:                                                          *
24 *                                                                      *
25 *     Errors: none                                                     *
26 *                                                                      *
27 ************************************************************************
28 #include "geant321/cggpar.inc"
29 #include "geant321/cgdelt.inc"
30 #include "geant321/gcdraw.inc"
31       REAL      CG(*),GRAV(3)
32       COMMON/PROSP/SVN(3)
33 *-
34       IF (CG(KCGSIZ) .LE. 0.) GOTO 999
35       LENG  = CG(KCGSIZ)
36       CG(KCGSIZ) = 0.
37       IF (LENG .LE. LCGHEA) GOTO 999
38       NFACE  = CG(KCGNF)
39       IF (NFACE .LE. 0) GOTO 999
40       JCG    = LCGHEA
41       DO 20  NF=1,NFACE
42          JCGFAC = JCG
43          NEDGE = CG(JCG+KCGNE)
44          IF (NEDGE .LE. 0) GOTO 999
45          A = 0.
46          B = 0.
47          C = 0.
48          GRAV(1)= 0.
49          GRAV(2)= 0.
50          GRAV(3)= 0.
51          JCG = JCG + LCGFAC
52 *             C O M P U T E   F A C E   A R E A
53          DO 10  NE=1,NEDGE
54 *SG
55 *          PERSPECTIVE
56 *
57             CALL UCTOH('PERS',IPERS,4,4)
58             IF (IPRJ.EQ.IPERS) THEN
59                XYZ3=CG(JCG+KCGX1)*SVN(1)+CG(JCG+KCGY1)*SVN(2)+ CG(JCG+
60      +         KCGZ1)*SVN(3)
61                IF (XYZ3.GE.DPERS) XYZ3=DPERS-0.1
62                F=DPERS/(DPERS-XYZ3)
63                CG(JCG+KCGX1)=CG(JCG+KCGX1)*F
64                CG(JCG+KCGY1)=CG(JCG+KCGY1)*F
65                CG(JCG+KCGZ1)=CG(JCG+KCGZ1)*F
66                XYZ3=CG(JCG+KCGX2)*SVN(1)+CG(JCG+KCGY2)*SVN(2)+ CG(JCG+
67      +         KCGZ2)*SVN(3)
68                IF (XYZ3.GE.DPERS) XYZ3=DPERS-0.1
69                F=DPERS/(DPERS-XYZ3)
70                CG(JCG+KCGX2)=CG(JCG+KCGX2)*F
71                CG(JCG+KCGY2)=CG(JCG+KCGY2)*F
72                CG(JCG+KCGZ2)=CG(JCG+KCGZ2)*F
73             ENDIF
74 *SG
75             A = A + CG(JCG+KCGY1) * CG(JCG+KCGZ2) - CG(JCG+KCGY2) *
76      +      CG(JCG+KCGZ1)
77             B = B + CG(JCG+KCGZ1) * CG(JCG+KCGX2) - CG(JCG+KCGZ2) *
78      +      CG(JCG+KCGX1)
79             C = C + CG(JCG+KCGX1) * CG(JCG+KCGY2) - CG(JCG+KCGX2) *
80      +      CG(JCG+KCGY1)
81             GRAV(1)= GRAV(1) + CG(JCG+KCGX1) + CG(JCG+KCGX2)
82             GRAV(2)= GRAV(2) + CG(JCG+KCGY1) + CG(JCG+KCGY2)
83             GRAV(3)= GRAV(3) + CG(JCG+KCGZ1) + CG(JCG+KCGZ2)
84             JCG = JCG + LCGEDG
85    10    CONTINUE
86          GRAV(1) = GRAV(1) / (2*NEDGE)
87          GRAV(2) = GRAV(2) / (2*NEDGE)
88          GRAV(3) = GRAV(3) / (2*NEDGE)
89          AREA = SQRT(A*A + B*B + C*C)
90 *SG
91 *
92 *   Consider pyramid as a limit TRAP
93 *
94          IF (AREA .LT. EEWOR)AREA=.1
95 *
96          IF (AREA .LT. EEWOR) GOTO 999
97 *SG
98          D =-(A*GRAV(1) + B*GRAV(2) + C*GRAV(3)) / AREA
99          A = A / AREA
100          B = B / AREA
101          C = C / AREA
102          CG(JCGFAC+KCGAA) = A
103          CG(JCGFAC+KCGBB) = B
104          CG(JCGFAC+KCGCC) = C
105          CG(JCGFAC+KCGDD) = D
106    20 CONTINUE
107       CG(KCGSIZ) = LENG
108   999 END