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