GEANT321/gdraw/gdcghi.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:20  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.26  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GDCGHI(IMOD,NOBJ,NWWS,LSTEP,ISG,NTVOL,ISHAPE)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *       This routine allows :                                    *
  17 C.    *                                                                *
  18 C.    *          - Slicing by a plane if some cut has been set,        *
  19 C.    *          - Clipping by any kind of volume if one or more       *
  20 C.    *            clipping volumes have been defined                  *
  21 C.    *          - to Insert the CG Objects into the Hidden Structure  *
  22 C.    *          - to convert the CG Objects in Wire Objects           *
  23 C.    *                                                                *
  24 C.    *       Input Parameters:                                        *
  25 C.    *                                                                *
  26 C.    *          IMOD:  Number for indicating the task to be perfor-   *
  27 C.    *                 med.  See GDCGOB subroutine                    *
  28 C.    *          NOBJ:  Counter for CG objects                         *
  29 C.    *          NWWS:  Size of Wire Structure                         *
  30 C.    *          LSTEP:  N. of bodies forming each CG volume           *
  31 C.    *          ISG  :  i-th body forming a Pcon or Pgon              *
  32 C.    *          NTVOL: N. of bodies forming each Pcon or Pgon         *
  33 C.    *          ISHAPE:Shape of CG object                             *
  34 C.    *                                                                *
  35 C.    *                                                                *
  36 C.    *    ==>Called by : GDCGOB                                       *
  37 C.    *                                                                *
  38 C.    *       Authors :  J.Salt, S.Giani                               *
  39 C.    ******************************************************************
  40 C.
  41 *
  42 #include "geant321/gcbank.inc"
  43 #include "geant321/gcgobj.inc"
  44 #include "geant321/gcunit.inc"
  45 #include "geant321/gchiln.inc"
  46 #include "geant321/gcspee.inc"
  47 #include "geant321/gcmutr.inc"
  48       SAVE NFIRST, NSHA, IOLDNS
  49       DATA NFIRST/1/
  50       DATA NSHA/0/
  51       DATA IOLDNS/0/
  52 *
  53 *   Slicing or clipping Actions
  54 *
  55       LLEP=ABS(LEP)
  56       IVFUN=1
  57       LENGHT=4000
  58       ICPOIN=JCGOBJ+1
  59       IZPOIN=JCGOBJ+20000
  60       IF(ISHAPE.EQ.11.OR.ISHAPE.EQ.12)ICGP=ICGP+1
  61 *
  62       IF(IMOD.EQ.3)THEN
  63          IST=2
  64       ELSE IF(IMOD.EQ.4)THEN
  65          IST=3
  66          CALL CGSLIC(Q(ICPOIN),ABCD,LENGHT,Q(IZPOIN))
  67 **SG
  68       ELSE IF(IMOD.EQ.5)THEN
  69          IST=3
  70 *  Clip object
  71          CALL GDCGCL(ISHAPE)
  72 **SG
  73       ELSE
  74          WRITE(CHMAIL,10000)IMOD
  75          CALL GMAIL(0,0)
  76       ENDIF
  77 *
  78 **      IF(IVFUN.EQ.0)GOTO 999
  79 *
  80 ***SG
  81 *      Inserting CG object in the Hidden Structure
  82 *
  83       IHPOIN=JCG+1
  84       ICPOIN=JCGOBJ+1
  85       ISPOIN=JCGOBJ+8000
  86       IZPOIN=JCGOBJ+20000
  87       IF(ISHAPE.EQ.29.OR.ISHAPE.EQ.99)ICPOIN=ISPOIN
  88       IF(IMOD.EQ.4.OR.IMOD.EQ.5)ICPOIN=IZPOIN
  89 *
  90 *   Evaluate size of Hide Structure after all volumes
  91 *   If it's too big, go back to GDRAW
  92 *   If it's ok, build the Wire Structure
  93 *
  94       CALL CGHINS(Q(ICPOIN),Q(IHPOIN),ISHAPE)
  95       IF(KCGST.EQ.-8)THEN
  96          IF(NFIRST.EQ.1)THEN
  97            NFIRST=0
  98            WRITE(CHMAIL,10002)
  99            CALL GMAIL(0,0)
 100          ENDIF
 101          NNN=NOBJ+1
 102          IF(ISHAPE.EQ.11.OR.ISHAPE.EQ.12)THEN
 103            IF(ISG.EQ.NTVOL)NNN=NNN+LSTEP-1
 104          ENDIF
 105          IF(NNN.EQ.NCLAS2)THEN
 106            KCGST=-9
 107            NFIRST=1
 108          ENDIF
 109          GOTO 999
 110       ENDIF
 111 *
 112 *      Building Up the Wiring structure.
 113 *
 114       ILCG=ILCG+1
 115       IST=ILCG
 116       IF(IST.GE.IQ(JCOUNT-1))THEN
 117         WRITE(CHMAIL,10001)
 118         CALL GMAIL(0,0)
 119         GOTO 999
 120       ENDIF
 121       IF(LLEP.NE.1)THEN
 122        IQ(IMCOUN+IST)=IQ(IMCOUN+IST-1)+NSHA
 123       ENDIF
 124       IQ(JCOUNT+IST)=IQ(JCOUNT+IST-1)+NTCUR
 125       IF(IFCG.EQ.4.AND.ILCG.EQ.4)THEN
 126         IQ(JCOUNT+4)=IQ(JCOUNT+4)-8000+1
 127         IF(LLEP.NE.1)THEN
 128          IQ(IMCOUN+4)=IQ(IMCOUN+4)-8000+1
 129         ENDIF
 130       ENDIF
 131       IF(IFCG.EQ.3.AND.ILCG.EQ.3)THEN
 132         IQ(JCOUNT+3)=IQ(JCOUNT+3)-4000+1
 133         IF(LLEP.NE.1)THEN
 134          IQ(IMCOUN+3)=IQ(IMCOUN+3)-4000+1
 135         ENDIF
 136       ENDIF
 137       IF(LLEP.NE.1)THEN
 138        MMPOIN=IMPOIN+IQ(IMCOUN+IST)
 139       ENDIF
 140       IWPOIN=JCG+IQ(JCOUNT+IST)
 141       ICPOIN=JCGOBJ+1
 142       IF(ISHAPE.EQ.29.OR.ISHAPE.EQ.99) ICPOIN=JCGOBJ+8000
 143       IF(IMOD.EQ.4.OR.IMOD.EQ.5) ICPOIN=JCGOBJ+20000
 144 *
 145 *    Evaluate size of Wire structure after all volumes
 146 *    If it's too big, go back to GDRAW
 147 *    If it's ok, go on.
 148 *
 149       IF(LLEP.NE.1)THEN
 150       CALL CGWIRE(Q(ICPOIN),NTRCG,-1,NWWS,Q(IWPOIN),ISHAPE,IQ(MMPOIN))
 151       ELSE
 152       CALL CGWIRE(Q(ICPOIN),NTRCG,-1,NWWS,Q(IWPOIN),ISHAPE,0)
 153       ENDIF
 154       IF(KCGST.EQ.-8)THEN
 155          IF(NFIRST.EQ.1)THEN
 156            NFIRST=0
 157            WRITE(CHMAIL,10002)
 158            CALL GMAIL(0,0)
 159          ENDIF
 160         NNN=NOBJ+1
 161         IF(ISHAPE.EQ.11.OR.ISHAPE.EQ.12)THEN
 162            IF(ISG.EQ.NTVOL)NNN=NNN+LSTEP-1
 163         ENDIF
 164         IF(NNN.EQ.NCLAS2)THEN
 165           KCGST=-10
 166           NFIRST=1
 167         ENDIF
 168         NTCUR=0
 169         GOTO 999
 170       ENDIF
 171       ITSTCU=Q(IWPOIN)
 172       IF(LLEP.NE.1)NSHACU=IQ(MMPOIN)
 173       IF(ITSTCU.NE.0)THEN
 174        IOLDCU=ITSTCU
 175        IF(LLEP.NE.1)IOLDNS=NSHACU
 176       ENDIF
 177       NTCUR=Q(IWPOIN)
 178       IF(LLEP.NE.1)NSHA=IQ(MMPOIN)
 179       NFILT=NFILT+NTCUR
 180       IF(LLEP.NE.1)NTNEX=NTNEX+NSHA
 181       IF(NTCUR.EQ.0)THEN
 182         NTCUR=IOLDCU
 183         IF(LLEP.NE.1)NSHA=IOLDNS
 184         IF(IFCG.EQ.4.AND.ILCG.EQ.4)THEN
 185           IQ(JCOUNT+4)=IQ(JCOUNT+4)-8000+1
 186           IF(LLEP.NE.1)THEN
 187            IQ(IMCOUN+4)=IQ(IMCOUN+4)-8000+1
 188           ENDIF
 189         ENDIF
 190         IF(IFCG.EQ.3.AND.ILCG.EQ.3)THEN
 191           IQ(JCOUNT+3)=IQ(JCOUNT+3)-4000+1
 192           IF(LLEP.NE.1)THEN
 193            IQ(IMCOUN+3)=IQ(IMCOUN+3)-4000+1
 194           ENDIF
 195         ENDIF
 196         ILCG=ILCG-1
 197         ICGP=ICGP-1
 198       ENDIF
 199 ***SG
 200 10000    FORMAT('  IMOD  = ',I5,' is not defined  ')
 201 10001    FORMAT(' *** GDCGHI *** : Please, increase size of',
 202      +          ' the Zebra store; the drawing',
 203      +          ' will not be completed.')
 204 10002    FORMAT(' *** GDCGHI *** : The memory size is not enough;',
 205      +          ' the program is going on evaluating the number of',
 206      +          ' words missing.')
 207 *
 208   999 END