GEANT321/gcons/gstmed.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:17  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.19  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GSTMED(KTMED,NATMED,NMAT,ISVOL,IFIELD,FIELDM,TMAXFD,
  13      +        STEMAX,DEEMAX,EPSIL,STMIN,UBUF,NWBUF)
  14 *
  15 ***********************************************************************
  16 *                                                                     *
  17 *                                                                     *
  18 *       Store tracking media parameters                               *
  19 *                                                                     *
  20 *    Stores the  parameters of the tracking  medium ITMED in  the data*
  21 *  structure JTMED.                                                   *
  22 *  ITMED     tracking medium number 0<ITMED<100                       *
  23 *  NATMED    tracking medium name (up to 20 characters ended by $)    *
  24 *  NMAT      material number corresponding to ITMED                   *
  25 *  ISVOL     =0 if not a sensitive volume                             *
  26 *  IFIELD    = 0  if no magnetic field                                *
  27 *            = -1  reserved for user decision in GUSWIM               *
  28 *            = 1  tracking performed with GRKUTA                      *
  29 *            = 2  tracking performed with GHELIX                      *
  30 *            = 3  tracking performed with GHELX3                      *
  31 *  FIELDM    maximum field value (in Kilogauss)                       *
  32 *  TMAXFD    maximum  angle due  to field  permitted in  one step  (in*
  33 *            degrees)                                                 *
  34 *  STEMAX    Maximum step allowed                                     *
  35 *            (in cm)                                                  *
  36 *  DEEMAX    maximum fractional energy loss in one step               *
  37 *  EPSIL     tracking precision (in cm)                               *
  38 *  STMIN     minimum step  due to energy  loss or  multiple scattering*
  39 *            (in cm)                                                  *
  40 *  UBUF      array of NWBUF additional parameters                     *
  41 *  NWBUF                                                              *
  42 *                                                                     *
  43 *                                                                     *
  44 *          The Tracking Medium data structure JTMED                   *
  45 *          ----------------------------------------                   *
  46 *                                                                     *
  47 *                                         | JTMED                     *
  48 *    NTMED           ITMED                v                           *
  49 *     ..........................................................      *
  50 *     |               | |                | | Standard Trac.media      *
  51 *     ..........................................................      *
  52 *                      | JT                                           *
  53 *                      v                                              *
  54 *                    ..........................                       *
  55 *                    | 1 |                    |                       *
  56 *                    .....                    |                       *
  57 *                    | 2 |  Tracking medium   |                       *
  58 *                    |...|                    |                       *
  59 *                    | 3 |   Name             |                       *
  60 *                    |...|                    |                       *
  61 *                    | 4 |                    |                       *
  62 *                    |...|                    |                       *
  63 *                    | 5 |                    |                       *
  64 *                    ..........................                       *
  65 *                    | 6 |   NMAT             |                       *
  66 *                    |...|....................|                       *
  67 *                    | 7 |   ISVOL            |                       *
  68 *                    |...|....................|                       *
  69 *                    | 8 |   IFIELD           |                       *
  70 *                    |...|....................|                       *
  71 *                    | 9 |   FIELDM           |                       *
  72 *                    |...|....................|                       *
  73 *                    | 10|   TMAXFD           |                       *
  74 *                    |...|....................|                       *
  75 *                    | 11|   STEMAX           |                       *
  76 *                    |...|....................|                       *
  77 *                    | 12|   DEEMAX           |                       *
  78 *                    |...|....................|                       *
  79 *                    | 13|   EPSIL            |                       *
  80 *                    |...|....................|                       *
  81 *                    | 14|   STMIN            |                       *
  82 *                    |...|....................|                       *
  83 *                    | 15|   User words ....  |                       *
  84 *                    ..........................                       *
  85 *   JT = LQ(JTMED-ITMED) pointer to tracking medium ITMED             *
  86 *                                                                     *
  87 *    ==>Called by : <USER>, UGEOM    ,<GXINT> GINC3                   *
  88 *       Author    R.Brun  *********                                   *
  89 *                                                                     *
  90 ***********************************************************************
  91 *
  92 #include "geant321/gcbank.inc"
  93 #include "geant321/gccuts.inc"
  94 #include "geant321/gcphys.inc"
  95 #include "geant321/gconsp.inc"
  96 #include "geant321/gcunit.inc"
  97 #include "geant321/gcnum.inc"
  98 #include "geant321/gcmzfo.inc"
  99 #include "geant321/gctrak.inc"
 100       DIMENSION MECA(5,13)
 101       EQUIVALENCE (MECA(1,1),IPAIR)
 102       DIMENSION UBUF(1),CUTVEC(10)
 103       EQUIVALENCE (CUTVEC,CUTGAM)
 104       CHARACTER*(*) NATMED
 105       CHARACTER*20 NAME
 106 C.
 107 C.    ------------------------------------------------------------------
 108 C.
 109       ITMED=ABS(KTMED)
 110       IF(JTMED.LE.0)THEN
 111          CALL MZBOOK(IXCONS,JTMED,JTMED,1,'TMED',NTMED,NTMED,40,3,0)
 112          CALL UCOPY(CUTVEC,Q(JTMED+1),10)
 113          IQ(JTMED-5)=0
 114          DO 10 I=1,13
 115             Q(JTMED+10+I)=MECA(1,I)
 116    10    CONTINUE
 117          Q(JTMED+10+21)=ILABS
 118          Q(JTMED+10+22)=ISYNC
 119          Q(JTMED+10+23)=ISTRA
 120       ENDIF
 121       IF(ITMED.GT.NTMED)THEN
 122          CALL MZPUSH(IXCONS,JTMED,ITMED-NTMED,0,'I')
 123          NTMED=ITMED
 124          JTM1=0
 125       ELSE
 126          JTM1=LQ(JTMED-ITMED)
 127          IF(JTM1.GT.0) THEN
 128             WRITE(CHMAIL,10100)
 129             CALL GMAIL(1,0)
 130             CALL GPTMED(ITMED)
 131             CALL MZDROP(IXCONS,LQ(JTMED-ITMED),' ')
 132          ENDIF
 133       ENDIF
 134       NW=NWBUF+14
 135       CALL MZBOOK(IXCONS,JTM,JTMED,-ITMED,'TMED',10,10,NW,IOTMED,0)
 136 C
 137       NAME=NATMED
 138       NCH=LNBLNK(NAME)
 139       IF(NCH.GT.0)THEN
 140          IF(NAME(NCH:NCH).EQ.'$')NAME(NCH:NCH)=' '
 141       ENDIF
 142       CALL UCTOH(NAME,IQ(JTM+1),4,20)
 143 C
 144       EPS=EPSIL
 145       IF(EPSIL.LE.0.0) THEN
 146          WRITE(CHMAIL,10000) ITMED, EPSIL
 147          CALL GMAIL(0,0)
 148          EPS=1.E-4
 149       END IF
 150       IF(IFIELD.NE.0.AND.FIELDM.EQ.0.0) THEN
 151          WRITE(CHMAIL,10200) ITMED, IFIELD
 152          CALL GMAIL(0,0)
 153       END IF
 154       IF(IGAUTO.NE.0.AND.ITMED.GT.0)THEN
 155          DE=-1.
 156          ST=-1.
 157          SM=-1.
 158       ELSE
 159          DE=DEEMAX
 160          ST=STMIN
 161          SM=STEMAX
 162       ENDIF
 163       Q(JTM + 6) = NMAT
 164       Q(JTM + 7) = ISVOL
 165       Q(JTM + 8) = IFIELD
 166       Q(JTM + 9) = FIELDM
 167       Q(JTM + 10) = TMAXFD
 168       Q(JTM + 11) = SM
 169       Q(JTM + 12) = DE
 170       Q(JTM + 13) = EPS
 171       Q(JTM + 14) = ST
 172       IF(NWBUF.GT.0)CALL UCOPY(UBUF,Q(JTM+15),NWBUF)
 173 C
 174       IF(JTM1.GT.0) THEN
 175          CALL GPTMED(-ITMED)
 176       ENDIF
 177 C
 178 10000 FORMAT('0*** GSTMED *** Warning, medium = ',I5,
 179      +       ', value of EPSIL=',E10.3,' reset to 1 micron')
 180 10100 FORMAT(' *** GSTMED *** Warning, tracking medium redefinition:')
 181 10200 FORMAT('0*** GSTMED *** Warning, medium = ',I5,
 182      +       ', IFIELD = ',I3,' and FIELDM = 0.0 is illegal')
 183   999 END