This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / cgpack / cghren.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 CGHREN(NT,NOLD,NNEW,NFACE,XYZ,IP,IFACE,NXYZ)
13 ************************************************************************
14 *                                                                      *
15 *     Name: CGHREN                                                     *
16 *     Author: E. Chernyaev                       Date:    04.08.88     *
17 *                                                Revised:              *
18 *                                                                      *
19 *     Function: Transform coordinates to screen system and             *
20 *               make renumeration                                      *
21 *                                                                      *
22 *     References: none                                                 *
23 *                                                                      *
24 *     Input:    NT - number of transformation                          *
25 *             NOLD - number of old nodes                               *
26 *             NNEW - number of new nodes                               *
27 *            NFACE - number of new faces                               *
28 *         XYZ(3,*) - node coordinates                                  *
29 *          IP(2,*) - work array for renumbering                        *
30 *         IFACE(*) - faces                                             *
31 *                                                                      *
32 *     Output: NXYZ - total number of nodes after renumeration          *
33 *                                                                      *
34 *     Errors: none                                                     *
35 *                                                                      *
36 ************************************************************************
37 #include "geant321/cgdelt.inc"
38 #include "geant321/cgctra.inc"
39       REAL      XYZ(3,*),SXYZ(3)
40 *SG
41       INTEGER  IP(2,*),IFACE(*)
42 *SG
43 *
44 **          T R A N S F O R M   T O   S C R E E N   COORDINATES
45 **          D I S C R E T I S A T I O N
46 *
47       DO 200 I=1,NNEW
48         DO 100 K=1,3
49           SXYZ(K) = TSCRN(1,K,NT)*XYZ(1,I) + TSCRN(2,K,NT)*XYZ(2,I) +
50      +              TSCRN(3,K,NT)*XYZ(3,I) + TSCRN(4,K,NT)
51 *          IF (SXYZ(K) .GE. 0.) KK = (SXYZ(K) + DESCR) * DELSCR
52 *          IF (SXYZ(K) .LT. 0.) KK = (SXYZ(K) - DESCR) * DELSCR
53 *          SXYZ(K) = KK * EESCR
54   100     CONTINUE
55         IP(1,I) = I
56         XYZ(1,I) = SXYZ(1)
57         XYZ(2,I) = SXYZ(2)
58         XYZ(3,I) = SXYZ(3)
59   200   CONTINUE
60 *
61 **         S H E L L   S O R T   O F   C O O R D N A T E S
62 *
63 *      ISTEP  = 1
64 *  290 ISTEP  = ISTEP*3 + 1
65 *      IF (ISTEP*2 .LT. NNEW)    GOTO 290
66 *  300 ISTEP  = ISTEP/3
67 *      DO 500 M=1,NNEW-ISTEP
68 *        IF(XYZ(1,M)-XYZ(1,M+ISTEP))     500,310,350
69 *  310   IF(XYZ(2,M)-XYZ(2,M+ISTEP))     500,320,350
70 *  320   IF(XYZ(3,M)-XYZ(3,M+ISTEP))     500,500,350
71 **
72 *  350   SXYZ(1)    = XYZ(1,M+ISTEP)
73 *        SXYZ(2)    = XYZ(2,M+ISTEP)
74 *        SXYZ(3)    = XYZ(3,M+ISTEP)
75 *        IPCUR      =  IP(1,M+ISTEP)
76 *        I          = M
77 *  400   XYZ(1,I+ISTEP) = XYZ(1,I)
78 *        XYZ(2,I+ISTEP) = XYZ(2,I)
79 *        XYZ(3,I+ISTEP) = XYZ(3,I)
80 *        IP (1,I+ISTEP) =  IP(1,I)
81 *        I          = I - ISTEP
82 *        IF (I .LE. 0)           GOTO 450
83 *        IF (XYZ(1,I)-SXYZ(1))   450,410,400
84 *  410   IF (XYZ(2,I)-SXYZ(2))   450,420,400
85 *  420   IF (XYZ(3,I)-SXYZ(3))   450,450,400
86 *  450   XYZ(1,I+ISTEP) = SXYZ(1)
87 *        XYZ(2,I+ISTEP) = SXYZ(2)
88 *        XYZ(3,I+ISTEP) = SXYZ(3)
89 *        IP (1,I+ISTEP) = IPCUR
90 **
91 *  500   CONTINUE
92 *      IF (ISTEP .NE. 1)          GOTO 300
93 *
94 **          N O D E   R E N U M E R A T I O N
95 *
96       NN           = 1
97       NIP11=IP(1,1)
98       IP(2,NIP11)= NN + NOLD
99       DO 650 I=2,NNEW
100 *        IF (XYZ(1,I) .NE. XYZ(1,I-1)) GOTO 610
101 *        IF (XYZ(2,I) .NE. XYZ(2,I-1)) GOTO 610
102 *        IF (XYZ(3,I) .EQ. XYZ(3,I-1)) GOTO 620
103   610   NN = NN + 1
104         XYZ(1,NN) = XYZ(1,I)
105         XYZ(2,NN) = XYZ(2,I)
106         XYZ(3,NN) = XYZ(3,I)
107   620   NIP=IP(1,I)
108         IP(2,NIP)= NN + NOLD
109   650   CONTINUE
110 *
111 **          S E T   N E W   N O D E   N U M B E R S   I N   F A C E S
112 *
113       JF     = 1
114       DO 800 NF=1,NFACE
115         NEDGE  = IFACE(JF)
116         DO 700 NE=1,NEDGE*2
117           NIF=IFACE(JF+NE)
118           IFACE(JF+NE) = IP(2,NIF)
119   700     CONTINUE
120         JF = JF + 1 + NEDGE*2
121   800   CONTINUE
122 *
123       NXYZ   = NN + NOLD
124       RETURN
125       END