Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / cgpack / cgaffi.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:19:41  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 CGAFFI(TT,CG)
13 ************************************************************************
14 *                                                                      *
15 *     Name: CGAFFI                                                     *
16 *     Author: E. Chernyaev                       Date:    24.08.88     *
17 *                                                Revised:              *
18 *                                                                      *
19 *     Function: Affine transformation of CG-object                     *
20 *                                                                      *
21 *     References: CGTSTR                                               *
22 *                                                                      *
23 *     Input:  T(4,3) - transformation matrix                           *
24 *     Output:  CG(*) - CG-object                                       *
25 *                                                                      *
26 *     Errors: none                                                     *
27 *                                                                      *
28 ************************************************************************
29 #include "geant321/cggpar.inc"
30 #include "geant321/cgdelt.inc"
31       REAL      TT(4,3),CG(*)
32 #if !defined(CERNLIB_SINGLE)
33       DOUBLE PRECISION T(4,3),X1,Y1,Z1,X2,Y2,Z2,
34      +                 A,B,C,Q,S,XGRAV,YGRAV,ZGRAV
35 #endif
36 #if defined(CERNLIB_SINGLE)
37       REAL      T(4,3)
38 #endif
39 *-
40       TDEL   = EEWOR / 10.
41       CALL CGTSTR(CG,IREP)
42       IF (IREP .LT. 0)          GOTO 999
43       DO 20 J=1,3
44         DO 10 I=1,4
45           T(I,J) = TT(I,J)
46           IF (ABS(TT(I,J))    .LT. TDEL)        T(I,J) = 0.
47           IF (ABS(1.-TT(I,J)) .LT. TDEL)        T(I,J) = 1.
48           IF (ABS(1.+TT(I,J)) .LT. TDEL)        T(I,J) =-1.
49    10     CONTINUE
50    20   CONTINUE
51 *
52 **          T R A N S F E R   C O O R D I N A T E S
53 *
54       NFACE  = CG(KCGNF)
55       IF (NFACE .EQ. 0)         GOTO 999
56       JCG    = LCGHEA
57       DO 200 NF=1,NFACE
58         NEDGE  = CG(JCG+KCGNE)
59         JCG    = JCG + LCGFAC
60         DO 100 NE=1,NEDGE
61           X1     = CG(JCG+KCGX1)
62           Y1     = CG(JCG+KCGY1)
63           Z1     = CG(JCG+KCGZ1)
64           X2     = CG(JCG+KCGX2)
65           Y2     = CG(JCG+KCGY2)
66           Z2     = CG(JCG+KCGZ2)
67           CG(JCG+KCGX1) = T(1,1)*X1 + T(2,1)*Y1 + T(3,1)*Z1 + T(4,1)
68           CG(JCG+KCGY1) = T(1,2)*X1 + T(2,2)*Y1 + T(3,2)*Z1 + T(4,2)
69           CG(JCG+KCGZ1) = T(1,3)*X1 + T(2,3)*Y1 + T(3,3)*Z1 + T(4,3)
70           CG(JCG+KCGX2) = T(1,1)*X2 + T(2,1)*Y2 + T(3,1)*Z2 + T(4,1)
71           CG(JCG+KCGY2) = T(1,2)*X2 + T(2,2)*Y2 + T(3,2)*Z2 + T(4,2)
72           CG(JCG+KCGZ2) = T(1,3)*X2 + T(2,3)*Y2 + T(3,3)*Z2 + T(4,3)
73           JCG    = JCG + LCGEDG
74   100     CONTINUE
75   200   CONTINUE
76 *
77 **          S E T   N E W   N O R M A L E S
78 *
79       JCG    = LCGHEA
80       DO 400 NF=1,NFACE
81         JCGFAC = JCG
82         NEDGE  = CG(JCG+KCGNE)
83         A      = (T(2,2)*T(3,3) - T(3,2)*T(2,3))*CG(JCG+KCGAA) +
84      +           (T(3,2)*T(1,3) - T(1,2)*T(3,3))*CG(JCG+KCGBB) +
85      +           (T(1,2)*T(2,3) - T(2,2)*T(1,3))*CG(JCG+KCGCC)
86         B      = (T(2,3)*T(3,1) - T(3,3)*T(2,1))*CG(JCG+KCGAA) +
87      +           (T(3,3)*T(1,1) - T(1,3)*T(3,1))*CG(JCG+KCGBB) +
88      +           (T(1,3)*T(2,1) - T(2,3)*T(1,1))*CG(JCG+KCGCC)
89         C      = (T(2,1)*T(3,2) - T(3,1)*T(2,2))*CG(JCG+KCGAA) +
90      +           (T(3,1)*T(1,2) - T(1,1)*T(3,2))*CG(JCG+KCGBB) +
91      +           (T(1,1)*T(2,2) - T(2,1)*T(1,2))*CG(JCG+KCGCC)
92 *        IF (ABS(A) .LT. EEWOR/10.)   A=0.
93 *        IF (ABS(B) .LT. EEWOR/10.)   B=0.
94 *        IF (ABS(C) .LT. EEWOR/10.)   C=0.
95         Q      = A*A + B*B + C*C
96         S      = 1.
97         IF (Q.GT.1+TDEL .OR. Q.LT.1-TDEL)       S = SQRT(Q)
98         IF(S.LT.TDEL)S=TDEL
99         XGRAV  = 0.
100         YGRAV  = 0.
101         ZGRAV  = 0.
102         JCG    = JCG + LCGFAC
103         DO 300 NE=1,NEDGE
104           XGRAV  = XGRAV + CG(JCG+KCGX1) + CG(JCG+KCGX2)
105           YGRAV  = YGRAV + CG(JCG+KCGY1) + CG(JCG+KCGY2)
106           ZGRAV  = ZGRAV + CG(JCG+KCGZ1) + CG(JCG+KCGZ2)
107           JCG    = JCG + LCGEDG
108   300     CONTINUE
109         XGRAV  = XGRAV / (2*NEDGE)
110         YGRAV  = YGRAV / (2*NEDGE)
111         ZGRAV  = ZGRAV / (2*NEDGE)
112         CG(JCGFAC+KCGAA) = A / S
113         CG(JCGFAC+KCGBB) = B / S
114         CG(JCGFAC+KCGCC) = C / S
115         CG(JCGFAC+KCGDD) =-(A*XGRAV + B*YGRAV + C*ZGRAV) / S
116   400   CONTINUE
117 *
118   999 RETURN
119       END