[u/mrichter/AliRoot.git] / GEANT321 / geocad / gtxset.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:20:47  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.32  by  S.Giani
*-- Author :
      SUBROUTINE GTXSET(FNAME,ANAME,NBINS,LUNIT,LUNIT2,
     +INST,SITE,DEPT,RESP)
C.
C.    ******************************************************************
C.    *                                                                *
C.    *  Writes out a description of the detector in SET file format.  *
C.    *  This is the main routine in the GEANT-SET interface           *
C.    *                                                                *
C.    *                    CADINT 1.20                                 *
C.    *                    ***********                                 *
C.    *    In this version VISIBLE VOLUMES are written out in a        *
C.    *    flat assembly.                                              *
C.    *    For questions, contact the authors.                         *
C.    *                                                                *
C.    *       Authors : NJ Hoimyr, J Vuoskoski     *********           *
C.    *                                                                *
C.    ******************************************************************
C.
#include "geant321/gcbank.inc"
#include "geant321/gcsetf.inc"
 
#include "geant321/gcdlin.inc"
#include "geant321/gcnum.inc"
#include "geant321/gcunit.inc"
*
      CHARACTER*24    INST,SITE,DEPT,RESP
      CHARACTER*24    FNAME
      CHARACTER*4     ANAME,NAME
      INTEGER         LUNIT,LUNIT2,NBINS
*     ------------------------------------------------------------
*
      WRITE(CHMAIL,'('' Starting to write SET file...'')')
      CALL GMAIL(1,0)
*
*     local zebra links
      CALL MZLINT(IXSTOR,'/GCDLIN/',NCWORD,JCDFRS,JCDLST)
*
*     number of volumes:
      NVOL=0
*     counter for SET blocks:
      N1=2
*     Assign logical unit for .set file:
      NUNIT1=LUNIT
*     Assign logical unit for .mat file:
      NUNIT2=LUNIT2
*
* *** I n i t i a l i z e  S E T f i l e
*
*     Starting blocks:
      CALL GSTSET(FNAME,ANAME,INST,SITE,DEPT,RESP)
      NPLACE=1
*
*     Starts material listing file:
      CALL GSTMAT(FNAME)
*
*     c a l q.  n u m. o f  v o l u m e s
   10 IF (LQ(JVOLUM-NVOL-1).EQ.0.OR.IQ(JVOLUM-2).EQ.NVOL) GOTO 20
      NVOL=NVOL+1
      GOTO 10
   20 CONTINUE
*
*     Is NAME an existing volume ?
      NAME = ANAME
      CALL GLOOK (NAME,IQ(JVOLUM+1),NVOLUM,IVO)
*
* *** Uses information given by the drawing package **
*
      CALL GDEXCA (NAME,NBINS)
*
* *** e n d  o f  S E T  f i l e
*
* *** write the tree
*
      CALL GWRTRE (NAME, NVOL)
      CALL GENSET
*
      WRITE(CHMAIL,'('' '')')
      CALL GMAIL(0,0)
      WRITE(CHMAIL,'('' The selected geometry is now converted '')')
      CALL GMAIL(0,0)
      WRITE(CHMAIL,'('' into the SET file format and the file '')')
      CALL GMAIL(0,0)
      WRITE(CHMAIL,'('' is in your current working directory '')')
      CALL GMAIL(0,0)
*
      IF(JCADNT.NE.0) THEN
         CALL MZDROP(IXSTOR, JCADNT, ' ')
      ENDIF
      NCWORD(1) = 0
*
      END
Commit	Line	Data
fe4da5cc	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