GEANT321/geocad/gwrtre.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:47  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 GWRTRE (VLNAME, NVOL)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *       Routine to write out the GEANT tree in the .mat file
  17 C.    *       starting from the given volume                           *
  18 C.    *                                                                *
  19 C.    *                                                                *
  20 C.    *    ==>Called by : GTXSET
  21 C.    *
  22 C.    *       Author: Jouko Vuoskoski                                  *
  23 C.    *                                                                *
  24 C.    ******************************************************************
  25 C.
  26 #include "geant321/gcbank.inc"
  27 #include "geant321/gcnum.inc"
  28 #include "geant321/gcdlin.inc"
  29 #include "geant321/gcsetf.inc"
  30 C
  31       CHARACTER*4 VLNAME,VOLUNA
  32       CHARACTER*80   HELPST
  33 C
  34 C    this has to be changed:
  35       IF(JCADNT.EQ.0) THEN
  36          CALL MZBOOK(IXSTOR,JCADNT,JCADNT,1,'CADI',1,1,0,2,-1)
  37          CALL MZBOOK(IXSTOR,JBUF1,
  38      +               JCADNT,-1,'CAD1',0,0,NVOLUM,2,-1)
  39       ENDIF
  40       DO 10 JV=1,NVOLUM
  41          IQ(JBUF1+JV)=0
  42    10 CONTINUE
  43 C
  44 C     Load IVO numbers of this particular part of the tree
  45 C     First the volume where to be started
  46 C
  47       DO 20 IVO=1, NVOL
  48          JVVOLU=IQ(JVOLUM+IVO)
  49          CALL UHTOC(JVVOLU,4,VOLUNA,4)
  50          IF(VOLUNA.EQ.VLNAME) THEN
  51             IQ(JBUF1+1)=IVO
  52          ENDIF
  53    20 CONTINUE
  54 C
  55 C      Then all the others
  56 C
  57       JV=1
  58       DO 70 NH1=1, 15
  59          DO 60 NH2=1, JV
  60             JVO=LQ(JVOLUM-IQ(JBUF1+NH2))
  61             NIN=Q(JVO+3)
  62             IF(NIN.GT.0) THEN
  63                DO 40 IIN=1, NIN
  64                   JIN=LQ(JVO-IIN)
  65                   JVFLAG=0
  66                   DO 30 NH3=1, JV
  67                      IF(Q(JIN+2).EQ.IQ(JBUF1+NH3)) JVFLAG=1
  68    30             CONTINUE
  69                   IF(JVFLAG.EQ.0) THEN
  70                      JV=JV+1
  71                      IQ(JBUF1+JV)=Q(JIN+2)
  72                   ENDIF
  73    40          CONTINUE
  74             ELSEIF(NIN.LT.0) THEN
  75                JDIV=LQ(JVO-1)
  76                JVFLAG=0
  77                DO 50 NH3=1, JV
  78                   IF(Q(JDIV+2).EQ.IQ(JBUF1+NH3)) JVFLAG=1
  79    50          CONTINUE
  80                IF(JVFLAG.EQ.0) THEN
  81                   JV=JV+1
  82                   IQ(JBUF1+JV)=Q(JDIV+2)
  83                ENDIF
  84             ENDIF
  85    60    CONTINUE
  86    70 CONTINUE
  87 C
  88 C
  89 C     write out the volumes into the .mat file
  90 C
  91       WRITE (NUNIT2,*)
  92       WRITE (NUNIT2,*)
  93       WRITE (NUNIT2,*)'GEANT TREE'
  94       WRITE (NUNIT2,*)'----------'
  95       WRITE (NUNIT2,*)
  96       WRITE (NUNIT2,*)'The GEANT tree starting from the given volume'
  97       WRITE (NUNIT2,*)
  98 C
  99       DO 90 NH1=1, JV
 100          JVO=LQ(JVOLUM-IQ(JBUF1+NH1))
 101          NIN=Q(JVO+3)
 102          IF(NIN.GT.0) THEN
 103             I1=10
 104             I2=16
 105             WRITE (HELPST,'(A80)')' '
 106             WRITE (HELPST(1:4),10000)IQ(JVOLUM+IQ(JBUF1+NH1))
 107             WRITE (HELPST(6:10),10100)NIN
 108             DO 80 IIN=1, NIN
 109                JIN=LQ(JVO-IIN)
 110                IVO=Q(JIN+2)
 111                WRITE (HELPST(I1:I2),10200)IQ(JVOLUM+IVO)
 112                I1=I1+6
 113                I2=I2+6
 114                IF (I2.GE.73) THEN
 115                   WRITE(NUNIT2,'(A80)')HELPST
 116                   I1=10
 117                   I2=16
 118                   WRITE (HELPST,'(A80)')' '
 119                ENDIF
 120    80       CONTINUE
 121             WRITE(NUNIT2,'(A80)')HELPST
 122 C
 123          ELSEIF(NIN.LT.0) THEN
 124             JDIV=LQ(JVO-1)
 125             IVO=Q(JDIV+2)
 126             NUMDIV=Q(JDIV+3)
 127             WRITE(NUNIT2,10300)IQ(JVOLUM+IQ(JBUF1+NH1)),-NUMDIV,
 128      +      Q(JDIV+ 4),Q(JDIV+5),IQ(JVOLUM+IVO)
 129
 130          ENDIF
 131    90 CONTINUE
 132 C
 133       WRITE (NUNIT2,*)
 134       WRITE (NUNIT2,*)
 135       WRITE (NUNIT2,*)'  ------ end of file -------'
 136 C
 137 10000 FORMAT(A4)
 138 10100 FORMAT(I4)
 139 10200 FORMAT(2X,A4)
 140 10300 FORMAT(A4,1X,I4,2X,E15.8,2X,E15.8,2X,A4)
 141 C
 142       END