GEANT321/cgpack/cghmov.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 CGHMOV(CG,H,NVF,NVE,XYZ,IP,IFACE)
  13 ************************************************************************
  14 *                                                                      *
  15 *     Name: CGHMOV                                                     *
  16 *     Author: E. Chernyaev                       Date:    04.08.88     *
  17 *                                                Revised:              *
  18 *                                                                      *
  19 *     Function: Move visible faces from CG-object to HIDE-structure    *
  20 *                                                                      *
  21 *     References: CGHREN                                               *
  22 *                                                                      *
  23 *     Input :   CG - CG-object                                         *
  24 *                H - HIDE-structure                                    *
  25 *              NVF - number of visible faces                           *
  26 *              NVE - number of visible edges                           *
  27 *         XYZ(3,*) - array for new nodes coordinates                   *
  28 *          IP(2,*) - work array for node renumbering                   *
  29 *         IFACE(*) - faces array                                       *
  30 *                                                                      *
  31 *     Errors: none                                                     *
  32 *                                                                      *
  33 ************************************************************************
  34 #include "geant321/cggpar.inc"
  35 #include "geant321/cghpar.inc"
  36       REAL      CG(*),H(*),XYZ(6,*)
  37 *SG
  38       INTEGER   IP(2,*),IFACE(*)
  39 *SG
  40 *-
  41       JFACE  = H(KHSIZE)*I4SIZE-((H(KHNFAC)+NVF)+(H(KHNEDG)+NVE)*2)+1
  42       JF     = 0
  43       JE     = 0
  44       NN     = 0
  45       JCG    = LCGHEA
  46       NFACE  = CG(KCGNF)
  47       DO 400 NF=1,NFACE
  48         NEDGE = CG(JCG+KCGNE)
  49         IF (NEDGE .LT. 0)       GOTO 300
  50         IFACE(JFACE+JF) = NEDGE
  51         DO 100 I=1,NEDGE*2
  52           IFACE(JFACE+JF+I) = NN + I
  53   100     CONTINUE
  54         DO 200 I=1,NEDGE
  55           J     = JCG + LCGFAC + (I-1)*LCGEDG
  56           XYZ(1,JE+I) = CG(J+KCGX1)
  57           XYZ(2,JE+I) = CG(J+KCGY1)
  58           XYZ(3,JE+I) = CG(J+KCGZ1)
  59           XYZ(4,JE+I) = CG(J+KCGX2)
  60           XYZ(5,JE+I) = CG(J+KCGY2)
  61           XYZ(6,JE+I) = CG(J+KCGZ2)
  62   200     CONTINUE
  63         NN    = NN + NEDGE*2
  64         JF    = JF + NEDGE*2 + 1
  65         JE    = JE + NEDGE
  66   300   IF (NEDGE .LT. 0)       NEDGE =-NEDGE
  67         CG(JCG+KCGNE) = NEDGE
  68         JCG   = JCG + LCGFAC + NEDGE*LCGEDG
  69   400   CONTINUE
  70       NT     = H(KHNT)
  71       NOLD   = H(KHNXYZ)
  72       NNEW   = NVE*2
  73       CALL CGHREN(NT,NOLD,NNEW,NVF,XYZ,IP,IFACE(JFACE),NTOTAL)
  74       H(KHNXYZ) = NTOTAL
  75       H(KHNFAC) = H(KHNFAC) + NVF
  76       H(KHNEDG) = H(KHNEDG) + NVE
  77 *
  78   999 RETURN
  79       END