GEANT321/gdraw/gdtr0.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:28  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.27  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GDTR0(IVTREE,IROOT,LEVMAX,IER)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *       Steering routine to build geometric structure tree       *
  17 C.    *       (starting from JVOLUM structure until to have an         *
  18 C.    *       optimized tree on IQ(JNAM1),IQ(JBRO1),etc.)              *
  19 C.    *                                                                *
  20 C.    *       IVTREE= view bank used to store tree structure (input)   *
  21 C.    *       IROOT = root of the tree to be built up (input)          *
  22 C.    *       IER   = error flag to detect nodes overflow (output)     *
  23 C.    *                                                                *
  24 C.    *    ==>Called by : GDFSPC, GDTREE                               *
  25 C.    *       Author : P.Zanarini   *********                          *
  26 C.    *       Revised: S.Giani      *********                          *
  27 C.    *                                                                *
  28 C.    ******************************************************************
  29 C.
  30 #include "geant321/gcbank.inc"
  31 #include "geant321/gcflag.inc"
  32 #include "geant321/gcunit.inc"
  33 #include "geant321/gcdraw.inc"
  34       COMMON/GCLOCA/NLOCAL(2),JLOCA(19),JV
  35       COMMON /QUEST/ IQUEST(100)
  36       CHARACTER*4 NAMZ(16)
  37       SAVE NAMZ
  38       DATA NAMZ/'DNAM','DMOT','DXON','DBRO','DDUP','DSCA','DDVM','DPSM',
  39      +          'DNA1','DMO1','DXO1','DBR1','DDU1','DSC1','DUUU','DVVV'/
  40 C.
  41 C.    ------------------------------------------------------------------
  42 C.
  43       IF (IVTREE.LE.NKVIEW.AND.LQ(JDRAW-IVTREE).NE.0) THEN
  44          Q(JDRAW+IVTREE)=1.
  45          CALL GDELET(IVTREE)
  46       ELSEIF (IVTREE.GT.NKVIEW) THEN
  47          NDL=IVTREE-NKVIEW
  48          CALL MZNEED(IXCONS,2*NDL,'G')
  49          IF(IQUEST(11).LT.0) GOTO 50
  50          CALL MZPUSH(IXCONS,JDRAW,NDL,NDL,'I')
  51          DO 10 I=NKVIEW+1,IVTREE-1
  52             Q(JDRAW+I)=1.
  53    10    CONTINUE
  54          NKVIEW=IVTREE
  55       ENDIF
  56 C
  57 C             Open view number IVTREE
  58 C
  59       Q(JDRAW+IVTREE)=3.
  60       CALL MZBOOK(IXCONS,JV,JDRAW,-IVTREE,'DTRE',16,16,0,3,0)
  61       IF (JV.EQ.0) GO TO 40
  62 *
  63       MAXNOD=16000
  64    20 ND=(10+MAXNOD)*16
  65       LLL=50+ND
  66       CALL MZNEED(IXCONS,LLL,'G')
  67       IQUEST(1)=0
  68       IF (IQUEST(11).LT.0) THEN
  69          MAXNOD=MAXNOD*0.9
  70          GO TO 20
  71       ENDIF
  72 ***   PRINT *,'NEW MAXNOD',MAXNOD
  73 *
  74       DO 30 I=1,16
  75          CALL MZBOOK(IXCONS,LBANK,JV,-I,NAMZ(I),0,0,MAXNOD,3,0)
  76          JV=LQ(JDRAW-IVTREE)
  77          IF (LBANK.EQ.0) GO TO 40
  78    30 CONTINUE
  79 C
  80       GO TO 60
  81 C
  82    40 WRITE (CHMAIL,10000)
  83       CALL GMAIL(0,0)
  84       GO TO 999
  85 C
  86    50 WRITE (CHMAIL,10100)
  87       CALL GMAIL(0,0)
  88       GO TO 999
  89 C
  90    60 CONTINUE
  91 C
  92 C             1. Scan JVOLUM banks and build non-optimized tree structur
  93 C                with arrays of pointers JNAM,JMOT,JXON,JBRO,JDUP,JDVM
  94 C                Note : IQ(JDUP) is set >0 for multiplicity by positioni
  95 C                       (normal case is 1); IQ(JDVM) is set <0 for
  96 C                       multiplicity by dividing (or 0 if not)
  97 C
  98 C             2. Scan non-optimized tree and build optimized tree,
  99 C                with arrays of pointers JNAM1,JMOT1,JXON1,JBRO1,JDUP1
 100 C                Note : IQ(JDUP1) is set >0 for multiplicity by position
 101 C                       or <0 for multiplicity by dividing (normal case
 102 C
 103 C
 104 C             I = node pointer
 105 C
 106 C             IQ(JNAM+I) = node name (in non-optimized tree)
 107 C             IQ(JMOT+I) = mother (or 0 if top of tree)
 108 C             IQ(JXON+I) = first son (or 0 if any)
 109 C             IQ(JBRO+I) = next brother (or 0 if any)
 110 C             IQ(JDUP+I) = multiplicity (<0 for div. or >0 for pos.)
 111 C             IQ(JSCA+I) = service word (scan flag, etc.)
 112 C             IQ(JDVM+I) = division multiplicity (>0 for div. or 0 for n
 113 C             IQ(JPSM+I) = position multiplicity (>1 for pos. or 1 for d
 114 C
 115 C             IQ(JNAM1+I) = node name (in optimized tree)
 116 C             IQ(JMOT1+I) = mother (or 0 if top of tree)
 117 C             IQ(JXON1+I) = first son (or 0 if any)
 118 C             IQ(JBRO1+I) = next brother (or 0 if any)
 119 C             IQ(JDUP1+I) = multiplicity (<0 for div. or >0 for pos.)
 120 C             IQ(JSCA1+I) = service word (scan flag, etc.)
 121 C             IQ(JULEV+I) = u-coordinate of the node in the tree
 122 C             IQ(JVLEV+I) = v-coordinate of the node in the tree
 123 C
 124       JNAM=LQ(JV-1)
 125       JMOT=LQ(JV-2)
 126       JXON=LQ(JV-3)
 127       JBRO=LQ(JV-4)
 128       JDUP=LQ(JV-5)
 129       JSCA=LQ(JV-6)
 130       JDVM=LQ(JV-7)
 131       JPSM=LQ(JV-8)
 132       JNAM1=LQ(JV-9)
 133       JMOT1=LQ(JV-10)
 134       JXON1=LQ(JV-11)
 135       JBRO1=LQ(JV-12)
 136       JDUP1=LQ(JV-13)
 137       JSCA1=LQ(JV-14)
 138       JULEV=LQ(JV-15)
 139       JVLEV=LQ(JV-16)
 140 C
 141       DO 70  J=1,MAXNOD
 142          IQ(JSCA+J)=0
 143          IQ(JPSM+J)=1
 144          IQ(JDUP+J)=0
 145    70 CONTINUE
 146 C
 147 C             Scan JVOLUM banks and build non-optimized tree structure
 148 C
 149 C      WRITE (CHMAIL,5001)
 150 C      CALL GMAIL(0,0)
 151       CALL GDTR2(IROOT,JMAX,LEVMAX,IER)
 152       IF (IER.NE.0) GO TO 999
 153       NUMNOD=JMAX
 154 C
 155 C             Scan non-optimized tree and build optimized tree
 156 C
 157 C      WRITE (CHMAIL,5002)
 158 C      CALL GMAIL(0,0)
 159       CALL GDTR4
 160 C      WRITE (CHMAIL,5003)
 161 C      CALL GMAIL(0,0)
 162       CALL GDTR6(JMAX)
 163       NUMND1=JMAX
 164 C
 165 C      WRITE (CHMAIL,1500) NLEFT,MAXNOD,NUMNOD,NUMND1
 166 C      CALL GMAIL(0,0)
 167 C
 168 10000 FORMAT (' ERROR IN GDTR0: MEMORY OVERFLOW IN CREATING A BANK')
 169 10100 FORMAT (' ERROR IN GDTR0: MEMORY OVERFLOW IN PUSHING A BANK')
 170 C
 171   999 END