GEANT321/cgpack/cghshi.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 CGHSHI(NSIZE,NFACE,NEDGE,IHIDE,IFACE,IPFACE)
  13 ************************************************************************
  14 *                                                                      *
  15 *     Name: CGHSHI                                                     *
  16 *     Author: E. Chernyaev                       Date:    07.08.88     *
  17 *                                                Revised:              *
  18 *                                                                      *
  19 *     Function: Shift face array and set pointers to faces             *
  20 *                                                                      *
  21 *     References:                                                      *
  22 *                                                                      *
  23 *     Input : NSIZE - size of IHIDE array (in INTEGER*2 words)         *
  24 *     Output: NFACE - number of faces before and after shift           *
  25 *             NEDGE - number of edges before and after shift           *
  26 *          IHIDE(*) - old face array                                   *
  27 *          IFACE(*) - new face array                                   *
  28 *         IPFACE(*) - pointers to faces beginings in IFACE             *
  29 *                                                                      *
  30 *     Errors: none                                                     *
  31 *                                                                      *
  32 ************************************************************************
  33 *SG
  34       INTEGER  IHIDE(*),IFACE(*)
  35       INTEGER  IPFACE(*)
  36 *SG
  37 *-
  38       NF     = 0
  39       NE     = 0
  40       JHIDE  = NSIZE - (NFACE+NEDGE*2) + 1
  41       JFACE  = 1
  42       DO 200 NNF=1,NFACE
  43         IE     = 0
  44         IEDGE  = IHIDE(JHIDE)
  45         JHIDE  = JHIDE + 1
  46         JWF    = JFACE + 1
  47         DO 100 NNE=1,IEDGE
  48           N1     = IHIDE(JHIDE)
  49           N2     = IHIDE(JHIDE+1)
  50           JHIDE  = JHIDE + 2
  51           IF (N1 .EQ. N2)       GOTO 100
  52           IFACE(JWF)   = N1
  53           IFACE(JWF+1) = N2
  54           JWF    = JWF + 2
  55           IE     = IE + 1
  56   100     CONTINUE
  57         IF (IE .EQ. 0)          GOTO 200
  58         NF     = NF + 1
  59         NE     = NE + IE
  60         IFACE(JFACE) = IE
  61         IPFACE(NF)   = JFACE
  62         JFACE  = JWF
  63   200   CONTINUE
  64       NFACE  = NF
  65       NEDGE  = NE
  66       RETURN
  67       END