GEANT321/geocad/gelset.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1999/05/18 15:55:17  fca
   6 * AliRoot sources
   7 *
   8 * Revision 1.1.1.1  1995/10/24 10:20:46  cernlib
   9 * Geant
  10 *
  11 *
  12 #include "geant321/pilot.h"
  13 *CMZ :  3.21/02 29/03/94  15.41.32  by  S.Giani
  14 *-- Author :
  15       SUBROUTINE GELSET(PAR)
  16 C-
  17 C-   Created  26-JUL-1991   Nils Joar Hoimyr
  18 C-   Modified 21.02.1992  Jouko Vuoskoski
  19 C-
  20 C-   Writes out the elliptical section of a tube in SET, and generates
  21 C-   an extruded solid from the elliptical section (face).
  22 C-
  23 #include "geant321/gcsetf.inc"
  24
  25 C
  26       DIMENSION PAR(100)
  27       REAL DX1,DY,Z,DZ,A,B
  28 C
  29 C------------------------------------------------------
  30 C  Converts GEANT shape ELTU into SET format
  31 C
  32       A=PAR(1)
  33       B=PAR(2)
  34       DZ=PAR(3)
  35 C       SET conversion
  36       Z= 2*DZ
  37       DX1=0.0
  38       DY=0.0
  39 C *WRITE SET @103,N1..#11,A,B,0.0,360.0,0,0,0,0
  40 C *WRITE SET @100,N2,:5,2#143,!N!,0.0,0.0,1.0
  41 C *WRITE SET @302,N3,:5,2#317,0,0,-DZ
  42 C *WRITE SET @100,N4,:5,2,:9,'MATNAM'#101,!N1,!N2
  43 C
  44 C------------------------------------------------
  45 C
  46       WRITE(BLKSTR,10000)N1,A,B
  47       CALL GJWRIT
  48       N1=N1+1
  49       WRITE(BLKSTR,10100)N1,N1-1,Z
  50       CALL GJWRIT
  51       N1=N1+1
  52       WRITE(BLKSTR,10200)N1,-DX1,-DY,-DZ
  53       CALL GJWRIT
  54       N1=N1+1
  55       WRITE(BLKSTR,10300)N1,N1-2,N1-1
  56       CALL GJWRIT
  57 10000   FORMAT('@103,',I10,',:5,2#11,:14,1,',G14.7,',',G14.7,',
  58      +     0.0,360.0,0.0,0.0,0.0,0.0')
  59 10100   FORMAT('@100,',I10,',:5,2#143,!',I10,',0.,0.,',G14.7)
  60 10200   FORMAT('@302,',I10,'#317,',G14.7,',',G14.7,',',G14.7)
  61 10300   FORMAT('@100,',I10,',:5,2#101,!',I10,',!',I10)
  62 C
  63    10 RETURN
  64       END