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