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

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:19:41  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.31  by  S.Giani
*-- Author :
      SUBROUTINE CGAFFI(TT,CG)
************************************************************************
*                                                                      *
*     Name: CGAFFI                                                     *
*     Author: E. Chernyaev                       Date:    24.08.88     *
*                                                Revised:              *
*                                                                      *
*     Function: Affine transformation of CG-object                     *
*                                                                      *
*     References: CGTSTR                                               *
*                                                                      *
*     Input:  T(4,3) - transformation matrix                           *
*     Output:  CG(*) - CG-object                                       *
*                                                                      *
*     Errors: none                                                     *
*                                                                      *
************************************************************************
#include "geant321/cggpar.inc"
#include "geant321/cgdelt.inc"
      REAL      TT(4,3),CG(*)
#if !defined(CERNLIB_SINGLE)
      DOUBLE PRECISION T(4,3),X1,Y1,Z1,X2,Y2,Z2,
     +                 A,B,C,Q,S,XGRAV,YGRAV,ZGRAV
#endif
#if defined(CERNLIB_SINGLE)
      REAL      T(4,3)
#endif
*-
      TDEL   = EEWOR / 10.
      CALL CGTSTR(CG,IREP)
      IF (IREP .LT. 0)          GOTO 999
      DO 20 J=1,3
        DO 10 I=1,4
          T(I,J) = TT(I,J)
          IF (ABS(TT(I,J))    .LT. TDEL)        T(I,J) = 0.
          IF (ABS(1.-TT(I,J)) .LT. TDEL)        T(I,J) = 1.
          IF (ABS(1.+TT(I,J)) .LT. TDEL)        T(I,J) =-1.
   10     CONTINUE
   20   CONTINUE
*
**          T R A N S F E R   C O O R D I N A T E S
*
      NFACE  = CG(KCGNF)
      IF (NFACE .EQ. 0)         GOTO 999
      JCG    = LCGHEA
      DO 200 NF=1,NFACE
        NEDGE  = CG(JCG+KCGNE)
        JCG    = JCG + LCGFAC
        DO 100 NE=1,NEDGE
          X1     = CG(JCG+KCGX1)
          Y1     = CG(JCG+KCGY1)
          Z1     = CG(JCG+KCGZ1)
          X2     = CG(JCG+KCGX2)
          Y2     = CG(JCG+KCGY2)
          Z2     = CG(JCG+KCGZ2)
          CG(JCG+KCGX1) = T(1,1)*X1 + T(2,1)*Y1 + T(3,1)*Z1 + T(4,1)
          CG(JCG+KCGY1) = T(1,2)*X1 + T(2,2)*Y1 + T(3,2)*Z1 + T(4,2)
          CG(JCG+KCGZ1) = T(1,3)*X1 + T(2,3)*Y1 + T(3,3)*Z1 + T(4,3)
          CG(JCG+KCGX2) = T(1,1)*X2 + T(2,1)*Y2 + T(3,1)*Z2 + T(4,1)
          CG(JCG+KCGY2) = T(1,2)*X2 + T(2,2)*Y2 + T(3,2)*Z2 + T(4,2)
          CG(JCG+KCGZ2) = T(1,3)*X2 + T(2,3)*Y2 + T(3,3)*Z2 + T(4,3)
          JCG    = JCG + LCGEDG
  100     CONTINUE
  200   CONTINUE
*
**          S E T   N E W   N O R M A L E S
*
      JCG    = LCGHEA
      DO 400 NF=1,NFACE
        JCGFAC = JCG
        NEDGE  = CG(JCG+KCGNE)
        A      = (T(2,2)*T(3,3) - T(3,2)*T(2,3))*CG(JCG+KCGAA) +
     +           (T(3,2)*T(1,3) - T(1,2)*T(3,3))*CG(JCG+KCGBB) +
     +           (T(1,2)*T(2,3) - T(2,2)*T(1,3))*CG(JCG+KCGCC)
        B      = (T(2,3)*T(3,1) - T(3,3)*T(2,1))*CG(JCG+KCGAA) +
     +           (T(3,3)*T(1,1) - T(1,3)*T(3,1))*CG(JCG+KCGBB) +
     +           (T(1,3)*T(2,1) - T(2,3)*T(1,1))*CG(JCG+KCGCC)
        C      = (T(2,1)*T(3,2) - T(3,1)*T(2,2))*CG(JCG+KCGAA) +
     +           (T(3,1)*T(1,2) - T(1,1)*T(3,2))*CG(JCG+KCGBB) +
     +           (T(1,1)*T(2,2) - T(2,1)*T(1,2))*CG(JCG+KCGCC)
*        IF (ABS(A) .LT. EEWOR/10.)   A=0.
*        IF (ABS(B) .LT. EEWOR/10.)   B=0.
*        IF (ABS(C) .LT. EEWOR/10.)   C=0.
        Q      = A*A + B*B + C*C
        S      = 1.
        IF (Q.GT.1+TDEL .OR. Q.LT.1-TDEL)       S = SQRT(Q)
        IF(S.LT.TDEL)S=TDEL
        XGRAV  = 0.
        YGRAV  = 0.
        ZGRAV  = 0.
        JCG    = JCG + LCGFAC
        DO 300 NE=1,NEDGE
          XGRAV  = XGRAV + CG(JCG+KCGX1) + CG(JCG+KCGX2)
          YGRAV  = YGRAV + CG(JCG+KCGY1) + CG(JCG+KCGY2)
          ZGRAV  = ZGRAV + CG(JCG+KCGZ1) + CG(JCG+KCGZ2)
          JCG    = JCG + LCGEDG
  300     CONTINUE
        XGRAV  = XGRAV / (2*NEDGE)
        YGRAV  = YGRAV / (2*NEDGE)
        ZGRAV  = ZGRAV / (2*NEDGE)
        CG(JCGFAC+KCGAA) = A / S
        CG(JCGFAC+KCGBB) = B / S
        CG(JCGFAC+KCGCC) = C / S
        CG(JCGFAC+KCGDD) =-(A*XGRAV + B*YGRAV + C*ZGRAV) / S
  400   CONTINUE
*
  999 RETURN
      END
Commit	Line	Data
fe4da5cc	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 = AA + BB + 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) =-(AXGRAV + BYGRAV + C*ZGRAV) / S
116	400 CONTINUE
117	*
118	999 RETURN
119	END