GEANT321/cgpack/cgwsor.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:19:45  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.32  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE CGWSOR(NWIRE,WIRE)
  13 ************************************************************************
  14 *                                                                      *
  15 *     Name: CGWSOR                                                     *
  16 *     Author: E. Chernyaev                       Date:    16.04.89     *
  17 *                                                Revised:              *
  18 *                                                                      *
  19 *     Function: Prepare wire array                                     *
  20 *                                                                      *
  21 *     References: CGSHEL                                               *
  22 *                                                                      *
  23 *     Input:  NWIRE - number of edges                                  *
  24 *     Output: WIRE(*,*)  - edges                                       *
  25 *                                                                      *
  26 *     Output:                                                          *
  27 *                                                                      *
  28 *     Errors: none                                                     *
  29 *                                                                      *
  30 ************************************************************************
  31 #include "geant321/cggpar.inc"
  32 #include "geant321/cgdelt.inc"
  33       REAL      WIRE(LCGEDG,*),SAVE(LCGEDG)
  34 *-
  35       ERROR  = 1.5*EEWOR
  36       NE     = 0
  37       ATRINV = 0.
  38       CALL CGSHEL(ATRINV,ERROR,NWIRE,WIRE)
  39       IF (NWIRE .LE. 0)                 GOTO 999
  40 *
  41 **          D E L E T E   U N V I S I B L E    D O U B L E  E D G E S
  42 **          A T R I B U T E   A N A L I S A T I O N
  43 *
  44       J      = 1
  45   100 IF (J .GT. NWIRE)                 GOTO 999
  46       A1          = WIRE(KCGAE,J)
  47       SAVE(KCGX1) = WIRE(KCGX1,J)
  48       SAVE(KCGY1) = WIRE(KCGY1,J)
  49       SAVE(KCGZ1) = WIRE(KCGZ1,J)
  50       SAVE(KCGX2) = WIRE(KCGX2,J)
  51       SAVE(KCGY2) = WIRE(KCGY2,J)
  52       SAVE(KCGZ2) = WIRE(KCGZ2,J)
  53       J     = J + 1
  54   150 IF (J .GT. NWIRE)                                 GOTO 200
  55       IF (ABS(WIRE(KCGX1,J)-SAVE(KCGX1)) .GT. ERROR)    GOTO 200
  56       IF (ABS(WIRE(KCGY1,J)-SAVE(KCGY1)) .GT. ERROR)    GOTO 200
  57       IF (ABS(WIRE(KCGZ1,J)-SAVE(KCGZ1)) .GT. ERROR)    GOTO 200
  58       IF (ABS(WIRE(KCGX2,J)-SAVE(KCGX2)) .GT. ERROR)    GOTO 200
  59       IF (ABS(WIRE(KCGY2,J)-SAVE(KCGY2)) .GT. ERROR)    GOTO 200
  60       IF (ABS(WIRE(KCGZ2,J)-SAVE(KCGZ2)) .GT. ERROR)    GOTO 200
  61 *           D O U B L E   W I R E
  62       A2     = WIRE(KCGAE,J)
  63       J      = J + 1
  64       IF (A1.LT.0. .AND. A2.LT.0.)                      GOTO 100
  65       IF (A1.LT.0.)                                     A1 =-A1 - 1.
  66       IF (A2.LT.0.)                                     A2 =-A2 - 1.
  67       IF (A2.GT.A1)                                     A1 = A2
  68       GOTO 150
  69 *           I N S E R T   I N   W I R E (*)
  70   200 NE      = NE + 1
  71       IF (A1.LT.0.)                                     A1 =-A1 - 1.
  72       WIRE(KCGAE,NE) = A1
  73       WIRE(KCGX1,NE) = SAVE(KCGX1)
  74       WIRE(KCGY1,NE) = SAVE(KCGY1)
  75       WIRE(KCGZ1,NE) = SAVE(KCGZ1)
  76       WIRE(KCGX2,NE) = SAVE(KCGX2)
  77       WIRE(KCGY2,NE) = SAVE(KCGY2)
  78       WIRE(KCGZ2,NE) = SAVE(KCGZ2)
  79       GOTO 100
  80 *
  81   999 NWIRE  = NE
  82       RETURN
  83       END