This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / geocad / gtxset.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 GTXSET(FNAME,ANAME,NBINS,LUNIT,LUNIT2,
13      +INST,SITE,DEPT,RESP)
14 C.
15 C.    ******************************************************************
16 C.    *                                                                *
17 C.    *  Writes out a description of the detector in SET file format.  *
18 C.    *  This is the main routine in the GEANT-SET interface           *
19 C.    *                                                                *
20 C.    *                    CADINT 1.20                                 *
21 C.    *                    ***********                                 *
22 C.    *    In this version VISIBLE VOLUMES are written out in a        *
23 C.    *    flat assembly.                                              *
24 C.    *    For questions, contact the authors.                         *
25 C.    *                                                                *
26 C.    *       Authors : NJ Hoimyr, J Vuoskoski     *********           *
27 C.    *                                                                *
28 C.    ******************************************************************
29 C.
30 #include "geant321/gcbank.inc"
31 #include "geant321/gcsetf.inc"
32  
33 #include "geant321/gcdlin.inc"
34 #include "geant321/gcnum.inc"
35 #include "geant321/gcunit.inc"
36 *
37       CHARACTER*24    INST,SITE,DEPT,RESP
38       CHARACTER*24    FNAME
39       CHARACTER*4     ANAME,NAME
40       INTEGER         LUNIT,LUNIT2,NBINS
41 *     ------------------------------------------------------------
42 *
43       WRITE(CHMAIL,'('' Starting to write SET file...'')')
44       CALL GMAIL(1,0)
45 *
46 *     local zebra links
47       CALL MZLINT(IXSTOR,'/GCDLIN/',NCWORD,JCDFRS,JCDLST)
48 *
49 *     number of volumes:
50       NVOL=0
51 *     counter for SET blocks:
52       N1=2
53 *     Assign logical unit for .set file:
54       NUNIT1=LUNIT
55 *     Assign logical unit for .mat file:
56       NUNIT2=LUNIT2
57 *
58 * *** I n i t i a l i z e  S E T f i l e
59 *
60 *     Starting blocks:
61       CALL GSTSET(FNAME,ANAME,INST,SITE,DEPT,RESP)
62       NPLACE=1
63 *
64 *     Starts material listing file:
65       CALL GSTMAT(FNAME)
66 *
67 *     c a l q.  n u m. o f  v o l u m e s
68    10 IF (LQ(JVOLUM-NVOL-1).EQ.0.OR.IQ(JVOLUM-2).EQ.NVOL) GOTO 20
69       NVOL=NVOL+1
70       GOTO 10
71    20 CONTINUE
72 *
73 *     Is NAME an existing volume ?
74       NAME = ANAME
75       CALL GLOOK (NAME,IQ(JVOLUM+1),NVOLUM,IVO)
76 *
77 * *** Uses information given by the drawing package **
78 *
79       CALL GDEXCA (NAME,NBINS)
80 *
81 * *** e n d  o f  S E T  f i l e
82 *
83 * *** write the tree
84 *
85       CALL GWRTRE (NAME, NVOL)
86       CALL GENSET
87 *
88       WRITE(CHMAIL,'('' '')')
89       CALL GMAIL(0,0)
90       WRITE(CHMAIL,'('' The selected geometry is now converted '')')
91       CALL GMAIL(0,0)
92       WRITE(CHMAIL,'('' into the SET file format and the file '')')
93       CALL GMAIL(0,0)
94       WRITE(CHMAIL,'('' is in your current working directory '')')
95       CALL GMAIL(0,0)
96 *
97       IF(JCADNT.NE.0) THEN
98          CALL MZDROP(IXSTOR, JCADNT, ' ')
99       ENDIF
100       NCWORD(1) = 0
101 *
102       END