GEANT321/geocad/gelset.F

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