[u/mrichter/AliRoot.git] / GEANT321 / gcons / gstmed.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:20:17  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.19  by  S.Giani
*-- Author :
      SUBROUTINE GSTMED(KTMED,NATMED,NMAT,ISVOL,IFIELD,FIELDM,TMAXFD,
     +        STEMAX,DEEMAX,EPSIL,STMIN,UBUF,NWBUF)
*
***********************************************************************
*                                                                     *
*                                                                     *
*       Store tracking media parameters                               *
*                                                                     *
*    Stores the  parameters of the tracking  medium ITMED in  the data*
*  structure JTMED.                                                   *
*  ITMED     tracking medium number 0<ITMED<100                       *
*  NATMED    tracking medium name (up to 20 characters ended by $)    *
*  NMAT      material number corresponding to ITMED                   *
*  ISVOL     =0 if not a sensitive volume                             *
*  IFIELD    = 0  if no magnetic field                                *
*            = -1  reserved for user decision in GUSWIM               *
*            = 1  tracking performed with GRKUTA                      *
*            = 2  tracking performed with GHELIX                      *
*            = 3  tracking performed with GHELX3                      *
*  FIELDM    maximum field value (in Kilogauss)                       *
*  TMAXFD    maximum  angle due  to field  permitted in  one step  (in*
*            degrees)                                                 *
*  STEMAX    Maximum step allowed                                     *
*            (in cm)                                                  *
*  DEEMAX    maximum fractional energy loss in one step               *
*  EPSIL     tracking precision (in cm)                               *
*  STMIN     minimum step  due to energy  loss or  multiple scattering*
*            (in cm)                                                  *
*  UBUF      array of NWBUF additional parameters                     *
*  NWBUF                                                              *
*                                                                     *
*                                                                     *
*          The Tracking Medium data structure JTMED                   *
*          ----------------------------------------                   *
*                                                                     *
*                                         | JTMED                     *
*    NTMED           ITMED                v                           *
*     ..........................................................      *
*     |               | |                | | Standard Trac.media      *
*     ..........................................................      *
*                      | JT                                           *
*                      v                                              *
*                    ..........................                       *
*                    | 1 |                    |                       *
*                    .....                    |                       *
*                    | 2 |  Tracking medium   |                       *
*                    |...|                    |                       *
*                    | 3 |   Name             |                       *
*                    |...|                    |                       *
*                    | 4 |                    |                       *
*                    |...|                    |                       *
*                    | 5 |                    |                       *
*                    ..........................                       *
*                    | 6 |   NMAT             |                       *
*                    |...|....................|                       *
*                    | 7 |   ISVOL            |                       *
*                    |...|....................|                       *
*                    | 8 |   IFIELD           |                       *
*                    |...|....................|                       *
*                    | 9 |   FIELDM           |                       *
*                    |...|....................|                       *
*                    | 10|   TMAXFD           |                       *
*                    |...|....................|                       *
*                    | 11|   STEMAX           |                       *
*                    |...|....................|                       *
*                    | 12|   DEEMAX           |                       *
*                    |...|....................|                       *
*                    | 13|   EPSIL            |                       *
*                    |...|....................|                       *
*                    | 14|   STMIN            |                       *
*                    |...|....................|                       *
*                    | 15|   User words ....  |                       *
*                    ..........................                       *
*   JT = LQ(JTMED-ITMED) pointer to tracking medium ITMED             *
*                                                                     *
*    ==>Called by : <USER>, UGEOM    ,<GXINT> GINC3                   *
*       Author    R.Brun  *********                                   *
*                                                                     *
***********************************************************************
*
#include "geant321/gcbank.inc"
#include "geant321/gccuts.inc"
#include "geant321/gcphys.inc"
#include "geant321/gconsp.inc"
#include "geant321/gcunit.inc"
#include "geant321/gcnum.inc"
#include "geant321/gcmzfo.inc"
#include "geant321/gctrak.inc"
      DIMENSION MECA(5,13)
      EQUIVALENCE (MECA(1,1),IPAIR)
      DIMENSION UBUF(1),CUTVEC(10)
      EQUIVALENCE (CUTVEC,CUTGAM)
      CHARACTER*(*) NATMED
      CHARACTER*20 NAME
C.
C.    ------------------------------------------------------------------
C.
      ITMED=ABS(KTMED)
      IF(JTMED.LE.0)THEN
         CALL MZBOOK(IXCONS,JTMED,JTMED,1,'TMED',NTMED,NTMED,40,3,0)
         CALL UCOPY(CUTVEC,Q(JTMED+1),10)
         IQ(JTMED-5)=0
         DO 10 I=1,13
            Q(JTMED+10+I)=MECA(1,I)
   10    CONTINUE
         Q(JTMED+10+21)=ILABS
         Q(JTMED+10+22)=ISYNC
         Q(JTMED+10+23)=ISTRA
      ENDIF
      IF(ITMED.GT.NTMED)THEN
         CALL MZPUSH(IXCONS,JTMED,ITMED-NTMED,0,'I')
         NTMED=ITMED
         JTM1=0
      ELSE
         JTM1=LQ(JTMED-ITMED)
         IF(JTM1.GT.0) THEN
            WRITE(CHMAIL,10100)
            CALL GMAIL(1,0)
            CALL GPTMED(ITMED)
            CALL MZDROP(IXCONS,LQ(JTMED-ITMED),' ')
         ENDIF
      ENDIF
      NW=NWBUF+14
      CALL MZBOOK(IXCONS,JTM,JTMED,-ITMED,'TMED',10,10,NW,IOTMED,0)
C
      NAME=NATMED
      NCH=LNBLNK(NAME)
      IF(NCH.GT.0)THEN
         IF(NAME(NCH:NCH).EQ.'$')NAME(NCH:NCH)=' '
      ENDIF
      CALL UCTOH(NAME,IQ(JTM+1),4,20)
C
      EPS=EPSIL
      IF(EPSIL.LE.0.0) THEN
         WRITE(CHMAIL,10000) ITMED, EPSIL
         CALL GMAIL(0,0)
         EPS=1.E-4
      END IF
      IF(IFIELD.NE.0.AND.FIELDM.EQ.0.0) THEN
         WRITE(CHMAIL,10200) ITMED, IFIELD
         CALL GMAIL(0,0)
      END IF
      IF(IGAUTO.NE.0.AND.ITMED.GT.0)THEN
         DE=-1.
         ST=-1.
         SM=-1.
      ELSE
         DE=DEEMAX
         ST=STMIN
         SM=STEMAX
      ENDIF
      Q(JTM + 6) = NMAT
      Q(JTM + 7) = ISVOL
      Q(JTM + 8) = IFIELD
      Q(JTM + 9) = FIELDM
      Q(JTM + 10) = TMAXFD
      Q(JTM + 11) = SM
      Q(JTM + 12) = DE
      Q(JTM + 13) = EPS
      Q(JTM + 14) = ST
      IF(NWBUF.GT.0)CALL UCOPY(UBUF,Q(JTM+15),NWBUF)
C
      IF(JTM1.GT.0) THEN
         CALL GPTMED(-ITMED)
      ENDIF
C
10000 FORMAT('0*** GSTMED *** Warning, medium = ',I5,
     +       ', value of EPSIL=',E10.3,' reset to 1 micron')
10100 FORMAT(' *** GSTMED *** Warning, tracking medium redefinition:')
10200 FORMAT('0*** GSTMED *** Warning, medium = ',I5,
     +       ', IFIELD = ',I3,' and FIELDM = 0.0 is illegal')
  999 END
Commit	Line	Data
fe4da5cc	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