This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / 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