GEANT321/cgpack/cgfac2.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:19:43  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 *
  13       SUBROUTINE CGFAC2(TVVX,TVVY,TVVZ,IN)
  14 *
  15 ********************************************************************
  16 *                                                                  *
  17 * Function: Order edges in world coordinates for every face        *
  18 *                                                                  *
  19 * I/O parameters:                                                  *
  20 * TVVX,TVVY,TVVZ = set of edge's coordinates                       *
  21 * IN = number of edges *2.                                         *
  22 *                                                                  *
  23 * Author: S. Giani                                                 *
  24 *                                                                  *
  25 ********************************************************************
  26 *
  27 #include "geant321/gcbank.inc"
  28 #include "geant321/gcunit.inc"
  29 #include "geant321/cggpar.inc"
  30 #include "geant321/cgdelt.inc"
  31 #include "geant321/cghpar.inc"
  32 #include "geant321/cgctra.inc"
  33 #include "geant321/cgcedg.inc"
  34 #include "geant321/gcdraw.inc"
  35 #include "geant321/gcflag.inc"
  36 #include "geant321/gcspee.inc"
  37 *
  38       DIMENSION VVX(500),VVY(500),VVZ(500)
  39       DIMENSION TVVX(500),TVVY(500),TVVZ(500)
  40       DIMENSION IZ(500)
  41 *
  42       JSC=0
  43       VVX(1)=TVVX(1)
  44       VVY(1)=TVVY(1)
  45       VVZ(1)=TVVZ(1)
  46       VVX(2)=TVVX(2)
  47       VVY(2)=TVVY(2)
  48       VVZ(2)=TVVZ(2)
  49       IZ(1)=1
  50       IZ(2)=2
  51       KZ=3
  52       DO 143 II=3,IN,2
  53        DO 144 JJ=3,IN
  54         DO 9 KK=1,KZ-1
  55          IF(JJ.EQ.IZ(KK))GOTO 144
  56  9      CONTINUE
  57           C11=ABS(TVVX(JJ)-VVX(II-1))
  58           C12=ABS(TVVY(JJ)-VVY(II-1))
  59           C13=ABS(TVVZ(JJ)-VVZ(II-1))
  60           IF(C11.LT..001.AND.C12.LT..001.AND.C13.LT..001)THEN
  61             VVX(II)=TVVX(JJ)
  62             VVY(II)=TVVY(JJ)
  63             VVZ(II)=TVVZ(JJ)
  64             IZ(KZ)=JJ
  65             AJ=JJ*.5
  66             IAJ=AJ
  67             PDAJ=AJ-IAJ
  68             IF(PDAJ.GT..01)THEN
  69               VVX(II+1)=TVVX(JJ+1)
  70               VVY(II+1)=TVVY(JJ+1)
  71               VVZ(II+1)=TVVZ(JJ+1)
  72               IZ(KZ+1)=JJ+1
  73               KZ=KZ+2
  74             ELSE
  75               VVX(II+1)=TVVX(JJ-1)
  76               VVY(II+1)=TVVY(JJ-1)
  77               VVZ(II+1)=TVVZ(JJ-1)
  78               IZ(KZ+1)=JJ-1
  79               KZ=KZ+2
  80             ENDIF
  81             GOTO 143
  82           ENDIF
  83  144   CONTINUE
  84        DO 11 JJA=3,IN
  85         DO 10 I=1,KZ-1
  86         IF(JJA.EQ.IZ(I))GOTO 11
  87  10     CONTINUE
  88         JJAO=JJA
  89         GOTO 12
  90  11     CONTINUE
  91         PRINT *,'Error in CGFACO'
  92  12     CONTINUE
  93         VVX(II)=TVVX(JJAO)
  94         VVY(II)=TVVY(JJAO)
  95         VVZ(II)=TVVZ(JJAO)
  96         VVX(II+1)=TVVX(JJAO+1)
  97         VVY(II+1)=TVVY(JJAO+1)
  98         VVZ(II+1)=TVVZ(JJAO+1)
  99         IZ(KZ)=JJAO
 100         IZ(KZ+1)=JJAO+1
 101         KZ=KZ+2
 102         JSC=II-1
 103  143  CONTINUE
 104       DO 145 KK=1,IN
 105        TVVX(KK)=VVX(KK)
 106        TVVY(KK)=VVY(KK)
 107        TVVZ(KK)=VVZ(KK)
 108  145  CONTINUE
 109 *
 110  999  END
 111